02/27/2006: mutandiz
[allegrocl] Add support for INPUT, OUTPUT, and INOUT typemaps. For OUTPUT variables, the lisp wrapper returns multiple values. git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@8911 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Mikel Bancroft
parent
e865390686
commit
6ee4d72a10
8 changed files with 479 additions and 40 deletions
15
SWIG/CHANGES
15
SWIG/CHANGES
|
|
@ -444,6 +444,21 @@ Version 1.3.28 (February 12, 2006)
|
|||
SWIG_exception(SWIG_RuntimeError,"unknown exception");
|
||||
}
|
||||
|
||||
01/09/2006: mutandiz
|
||||
[Allegrocl]
|
||||
|
||||
Fixes a number of SEGVs primarily in the handling of
|
||||
various anonymous types. Found in a pass through the
|
||||
swig test-suite. Still more to do here, but this is a
|
||||
good checkpoint.
|
||||
|
||||
Adds -cwrap and -nocwrap as an allegrocl specific
|
||||
command-line argument. Controls generating of a C
|
||||
wrapper file when wrapping C code. By default only a
|
||||
lisp file is created for C code wrapping.
|
||||
|
||||
Doc updates for the command-line arguments and fixes as
|
||||
pointed out on swig-devel
|
||||
|
||||
01/05/2006: wsfulton
|
||||
[Java] Fix unsigned long long and const unsigned long long & typemaps
|
||||
|
|
|
|||
|
|
@ -1,5 +1,11 @@
|
|||
Version 1.3.29 (In progress)
|
||||
============================
|
||||
02/27/2006: mutandiz
|
||||
[allegrocl]
|
||||
Add support for INPUT, OUTPUT, and INOUT typemaps.
|
||||
For OUTPUT variables, the lisp wrapper returns multiple
|
||||
values.
|
||||
|
||||
02/26/2006: mmatus
|
||||
|
||||
[Ruby] add argcargv.i library file.
|
||||
|
|
@ -24,7 +30,7 @@ Version 1.3.29 (In progress)
|
|||
|
||||
|
||||
This is the similar to the python version Lib/python/argcargv.i
|
||||
|
||||
|
||||
02/24/2006: mgossage
|
||||
|
||||
Small update Lua documents on troubleshooting problems
|
||||
|
|
|
|||
|
|
@ -1793,6 +1793,11 @@ return-val wrapper-name(parm0, parm1, ..., parmN)
|
|||
<li><tt>$out</tt> - expands to the name of the local variable
|
||||
assigned to this typemap
|
||||
</li>
|
||||
<li><tt>$in_fftype</tt> - the foreign function type of the C type.</li>
|
||||
<li><tt>$*in_fftype</tt> - the foreign function type of the C type
|
||||
with one pointer removed. If there is no pointer, then $*in_fftype
|
||||
is the same as $in_fftype.
|
||||
</li>
|
||||
<li><tt>$body</tt> - very important. Instructs SWIG where
|
||||
subsequent code generation steps should be inserted into the
|
||||
current typemap. Leaving out a <tt>$body</tt> reference
|
||||
|
|
|
|||
|
|
@ -10,10 +10,331 @@ srcdir = @srcdir@
|
|||
top_srcdir = @top_srcdir@
|
||||
top_builddir = @top_builddir@
|
||||
|
||||
include $(srcdir)/../common.mk
|
||||
# include $(srcdir)/../common.mk
|
||||
|
||||
#CPP_TEST_CASES +=
|
||||
#C_TEST_CASES +=
|
||||
# these cpp tests aren't working. Fix 'em
|
||||
# need to further separate these into tests requiring
|
||||
# std libraries, or the $ldestructor problem.
|
||||
CPP_TEST_BROKEN_ACL = \
|
||||
array_member \
|
||||
char_strings \
|
||||
class_ignore \
|
||||
constant_pointers \
|
||||
contract \
|
||||
cplusplus_throw \
|
||||
cpp_basic \
|
||||
cpp_enum \
|
||||
cpp_typedef \
|
||||
default_constructor \
|
||||
default_args \
|
||||
dynamic_cast \
|
||||
enum_thorough \
|
||||
extend_variable \
|
||||
global_vars \
|
||||
import_nomodule \
|
||||
kind \
|
||||
li_carrays \
|
||||
li_cdata \
|
||||
li_windows \
|
||||
namespace_class \
|
||||
namespace_spaces \
|
||||
naturalvar \
|
||||
operator_overload \
|
||||
overload_simple \
|
||||
register_par \
|
||||
sizet \
|
||||
smart_pointer_extend \
|
||||
smart_pointer_namespace \
|
||||
template \
|
||||
template_classes \
|
||||
template_default \
|
||||
template_default_inherit \
|
||||
template_enum \
|
||||
template_explicit \
|
||||
template_extend_overload \
|
||||
template_ns \
|
||||
template_ns4 \
|
||||
template_ns_enum \
|
||||
template_rename \
|
||||
template_retvalue \
|
||||
template_static \
|
||||
template_tbase_template \
|
||||
template_typedef \
|
||||
template_typedef_cplx \
|
||||
template_typedef_cplx2 \
|
||||
template_typedef_cplx3 \
|
||||
template_typedef_cplx4 \
|
||||
template_typedef_cplx5 \
|
||||
template_typedef_ns \
|
||||
template_typedef_rec \
|
||||
threads \
|
||||
typedef_array_member \
|
||||
typedef_sizet \
|
||||
typemap_namespace \
|
||||
union_scope \
|
||||
using_pointers \
|
||||
valuewrapper_opaque \
|
||||
varargs \
|
||||
virtual_poly \
|
||||
voidtest \
|
||||
wrapmacro
|
||||
|
||||
# these aren't working due to longlong support. (low hanging fruit)
|
||||
CPP_TEST_BROKEN_LONGLONG = \
|
||||
arrays_dimensionless \
|
||||
arrays_global \
|
||||
arrays_global_twodim \
|
||||
li_stdint \
|
||||
li_typemaps \
|
||||
long_long_apply \
|
||||
mixed_types \
|
||||
primitive_ref \
|
||||
reference_global_vars \
|
||||
template_default_arg
|
||||
|
||||
# These are currently unsupported.
|
||||
CPP_TEST_CASES_ACL_UNSUPPORTED = \
|
||||
aggregate \
|
||||
contract \
|
||||
director_abstract \
|
||||
director_basic \
|
||||
director_constructor \
|
||||
director_detect \
|
||||
director_default \
|
||||
director_enum \
|
||||
director_exception \
|
||||
director_frob \
|
||||
director_finalizer \
|
||||
director_nested \
|
||||
director_protected \
|
||||
director_redefined \
|
||||
director_unroll \
|
||||
director_using \
|
||||
director_wombat \
|
||||
exception_order \
|
||||
extern_throws \
|
||||
throw_exception
|
||||
|
||||
# C++ test cases. (Can be run individually using make testcase.cpptest.)
|
||||
CPP_TEST_CASES = \
|
||||
abstract_access \
|
||||
abstract_inherit \
|
||||
abstract_inherit_ok \
|
||||
abstract_signature \
|
||||
abstract_typedef \
|
||||
abstract_typedef2 \
|
||||
abstract_virtual \
|
||||
access_change \
|
||||
add_link \
|
||||
allowexcept \
|
||||
anonymous_bitfield \
|
||||
argout \
|
||||
array_typedef_memberin \
|
||||
arrayref \
|
||||
arrays_scope \
|
||||
bloody_hell \
|
||||
bools \
|
||||
casts \
|
||||
cast_operator \
|
||||
class_scope_weird \
|
||||
const_const_2 \
|
||||
constover \
|
||||
constructor_copy \
|
||||
constructor_exception \
|
||||
constructor_explicit \
|
||||
constructor_value \
|
||||
compactdefaultargs \
|
||||
conversion \
|
||||
conversion_namespace \
|
||||
conversion_ns_template \
|
||||
cpp_namespace \
|
||||
cpp_nodefault \
|
||||
cpp_static \
|
||||
defvalue_constructor \
|
||||
derived_byvalue \
|
||||
derived_nested \
|
||||
destructor_reprotected \
|
||||
disown \
|
||||
empty \
|
||||
enum_plus \
|
||||
enum_scope_template \
|
||||
enum_template \
|
||||
enum_var \
|
||||
evil_diamond \
|
||||
evil_diamond_ns \
|
||||
evil_diamond_prop \
|
||||
extend_default \
|
||||
extend_placement \
|
||||
extend_template \
|
||||
extend_template_ns \
|
||||
extern_namespace \
|
||||
features \
|
||||
friends \
|
||||
global_ns_arg \
|
||||
grouping \
|
||||
ignore_parameter \
|
||||
inherit \
|
||||
inherit_missing \
|
||||
inherit_same_name \
|
||||
inherit_void_arg \
|
||||
inline_initializer \
|
||||
langobj \
|
||||
li_attribute \
|
||||
li_cpointer \
|
||||
member_template \
|
||||
minherit \
|
||||
multiple_inheritance \
|
||||
name_cxx \
|
||||
name_warnings \
|
||||
namespace_enum \
|
||||
namespace_extend \
|
||||
namespace_nested \
|
||||
namespace_template \
|
||||
namespace_typedef_class \
|
||||
namespace_typemap \
|
||||
namespace_virtual_method \
|
||||
newobject1 \
|
||||
ordering \
|
||||
overload_copy \
|
||||
overload_extend \
|
||||
overload_rename \
|
||||
overload_subtype \
|
||||
overload_template \
|
||||
overload_template_fast \
|
||||
pointer_reference \
|
||||
private_assign \
|
||||
protected_rename \
|
||||
pure_virtual \
|
||||
redefined \
|
||||
refcount \
|
||||
rename_scope \
|
||||
return_const_value \
|
||||
return_value_scope \
|
||||
rname \
|
||||
smart_pointer_const \
|
||||
smart_pointer_const2 \
|
||||
smart_pointer_member \
|
||||
smart_pointer_multi \
|
||||
smart_pointer_multi_typedef \
|
||||
smart_pointer_namespace2 \
|
||||
smart_pointer_not \
|
||||
smart_pointer_overload \
|
||||
smart_pointer_protected \
|
||||
smart_pointer_rename \
|
||||
smart_pointer_simple \
|
||||
smart_pointer_static \
|
||||
smart_pointer_typedef \
|
||||
static_array_member \
|
||||
static_const_member \
|
||||
static_const_member_2 \
|
||||
struct_value \
|
||||
template_array_numeric \
|
||||
template_arg_replace \
|
||||
template_arg_scope \
|
||||
template_arg_typename \
|
||||
template_base_template \
|
||||
template_const_ref \
|
||||
template_construct \
|
||||
template_default2 \
|
||||
template_default_qualify \
|
||||
template_default_vw \
|
||||
template_enum_ns_inherit \
|
||||
template_enum_typedef \
|
||||
template_extend_overload_2 \
|
||||
template_extend1 \
|
||||
template_extend2 \
|
||||
template_forward \
|
||||
template_inherit \
|
||||
template_inherit_abstract \
|
||||
template_int_const \
|
||||
template_ns2 \
|
||||
template_ns3 \
|
||||
template_ns_enum2 \
|
||||
template_ns_inherit \
|
||||
template_ns_scope \
|
||||
template_partial_arg \
|
||||
template_qualifier \
|
||||
template_ref_type \
|
||||
template_specialization \
|
||||
template_specialization_defarg \
|
||||
template_specialization_enum \
|
||||
template_typedef_ptr \
|
||||
template_using \
|
||||
template_virtual \
|
||||
template_whitespace \
|
||||
typedef_class \
|
||||
typedef_funcptr \
|
||||
typedef_inherit \
|
||||
typedef_mptr \
|
||||
typedef_reference \
|
||||
typedef_scope \
|
||||
typedef_struct \
|
||||
typemap_ns_using \
|
||||
typemap_numinputs \
|
||||
typemap_variables \
|
||||
typemap_various \
|
||||
typename \
|
||||
using1 \
|
||||
using2 \
|
||||
using_composition \
|
||||
using_extend \
|
||||
using_inherit \
|
||||
using_namespace \
|
||||
using_private \
|
||||
using_protected \
|
||||
valuewrapper \
|
||||
valuewrapper_base \
|
||||
valuewrapper_const \
|
||||
virtual_destructor
|
||||
|
||||
# std lib support hasn't been done yet.
|
||||
SKIP_CPP_STD_CASES = Yes
|
||||
|
||||
C_TEST_CASES_ACL_BROKEN = \
|
||||
arrays \
|
||||
enums \
|
||||
extern_declaration \
|
||||
immutable \
|
||||
integers \
|
||||
li_cdata \
|
||||
typemap_subst
|
||||
|
||||
C_TEST_BROKEN_LONGLONG = \
|
||||
long_long
|
||||
|
||||
C_TEST_CASES = \
|
||||
char_constant \
|
||||
const_const \
|
||||
empty \
|
||||
function_typedef \
|
||||
inctest \
|
||||
lextype \
|
||||
li_carrays \
|
||||
li_cmalloc \
|
||||
li_constraints \
|
||||
li_cpointer \
|
||||
li_math \
|
||||
name \
|
||||
nested \
|
||||
newobject2 \
|
||||
overload_extend \
|
||||
overload_extendc \
|
||||
preproc \
|
||||
ret_by_value \
|
||||
sizeof_pointer \
|
||||
sneaky1 \
|
||||
struct_rename \
|
||||
typedef_struct \
|
||||
unions
|
||||
|
||||
NOT_BROKEN_TEST_CASES = $(CPP_TEST_CASES:=.cpptest) \
|
||||
$(C_TEST_CASES:=.ctest) \
|
||||
$(MULTI_CPP_TEST_CASES:=.multicpptest) \
|
||||
$(CUSTOM_TEST_CASES:=.customtest)
|
||||
|
||||
check: $(NOT_BROKEN_TEST_CASES)
|
||||
|
||||
include $(srcdir)/../common.mk
|
||||
|
||||
# Rules for the different types of tests
|
||||
%.cpptest:
|
||||
|
|
|
|||
|
|
@ -7,17 +7,19 @@
|
|||
%ffargs(strings_convert="t");
|
||||
|
||||
/* typemaps for argument and result type conversions. */
|
||||
%typemap(lin) SWIGTYPE "(let (($out $in))\n $body)";
|
||||
%typemap(lin,numinputs=1) SWIGTYPE "(let (($out $in))\n $body)";
|
||||
|
||||
%typemap(lout) bool, char, unsigned char, signed char,
|
||||
short, signed short, unsigned short,
|
||||
int, signed int, unsigned int,
|
||||
long, signed long, unsigned long,
|
||||
float, double, long double, char *, void *, void,
|
||||
enum SWIGTYPE "$body";
|
||||
float, double, long double, char *, void *,
|
||||
enum SWIGTYPE "(push $body ACL_result)";
|
||||
%typemap(lout) void "$body";
|
||||
%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
|
||||
SWIGTYPE & "(make-instance '$lclass :foreign-address $body)";
|
||||
%typemap(lout) SWIGTYPE "(let* ((address $body)\n (ACL_result (make-instance '$lclass :foreign-address address)))\n (unless (zerop address)\n (excl:schedule-finalization ACL_result #'$ldestructor))\n ACL_result)";
|
||||
SWIGTYPE & "(push (make-instance '$lclass :foreign-address $body) ACL_result)";
|
||||
|
||||
%typemap(lout) SWIGTYPE "(let* ((address $body)\n (new-inst (make-instance '$lclass :foreign-address address)))\n (unless (zerop address)\n (excl:schedule-finalization ACL_result #'$ldestructor))\n (push new-inst ACL_result))";
|
||||
|
||||
%typemap(lisptype) bool "boolean";
|
||||
%typemap(lisptype) char "character";
|
||||
|
|
@ -154,15 +156,15 @@ SWIG_TYPECHECK_STRING_ARRAY 1140
|
|||
%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
|
||||
|
||||
%typemap(in) wchar_t "$1 = $input;";
|
||||
%typemap(lin) wchar_t "(let (($out (char-code $in)))\n $body)";
|
||||
%typemap(lin) wchar_t* "(excl:with-native-string ($out $in
|
||||
%typemap(lin,numinputs=1) wchar_t "(let (($out (char-code $in)))\n $body)";
|
||||
%typemap(lin,numinputs=1) wchar_t* "(excl:with-native-string ($out $in
|
||||
:external-format #+little-endian :fat-le #-little-endian :fat)\n
|
||||
$body)"
|
||||
|
||||
%typemap(out) wchar_t "$result = $1;";
|
||||
%typemap(lout) wchar_t "(code-char $body)";
|
||||
%typemap(lout) wchar_t* "(excl:native-to-string $body
|
||||
:external-format #+little-endian :fat-le #-little-endian :fat)";
|
||||
%typemap(lout) wchar_t "(push (code-char $body) ACL_result)";
|
||||
%typemap(lout) wchar_t* "(push (excl:native-to-string $body
|
||||
:external-format #+little-endian :fat-le #-little-endian :fat) ACL_result)";
|
||||
|
||||
%typemap(ffitype) wchar_t ":unsigned-short";
|
||||
%typemap(lisptype) wchar_t "";
|
||||
|
|
@ -342,7 +344,7 @@ $body)"
|
|||
|
||||
(defmacro swig-defun ((name &optional (mangled-name name)
|
||||
&key (type :operator) class arity)
|
||||
ffargs kwargs
|
||||
arglist kwargs
|
||||
&body body)
|
||||
(let* ((symbol (id-convert-and-export name :type type
|
||||
:arity arity :class class))
|
||||
|
|
@ -355,9 +357,13 @@ $body)"
|
|||
else (intern mangled-name)))
|
||||
(defun-args (maybe-reorder-args
|
||||
symbol
|
||||
(mapcar #'car (and (not (equal ffargs '(:void)))
|
||||
ffargs))
|
||||
))
|
||||
(mapcar #'car (and (not (equal arglist '(:void)))
|
||||
(loop as i in arglist
|
||||
when (eq (car i) :p+)
|
||||
collect (cdr i))))))
|
||||
(ffargs (if (equal arglist '(:void))
|
||||
arglist
|
||||
(mapcar #'cdr arglist)))
|
||||
)
|
||||
(when (swig-anyvarargs-p ffargs)
|
||||
(setq ffargs '()))
|
||||
|
|
@ -380,11 +386,12 @@ $body)"
|
|||
(defmethod-args (maybe-reorder-args
|
||||
symbol
|
||||
(unless (equal ffargs '(:void))
|
||||
(loop for (name dispatch) in ffargs
|
||||
(loop for (lisparg name dispatch) in ffargs
|
||||
when (eq lisparg :p+)
|
||||
collect `(,name ,dispatch)))))
|
||||
(ffargs (if (equal ffargs '(:void))
|
||||
ffargs
|
||||
(loop for (name nil . ffi) in ffargs
|
||||
(loop for (nil name nil . ffi) in ffargs
|
||||
collect `(,name ,@ffi)))))
|
||||
`(eval-when (compile load eval)
|
||||
(excl::compiler-let ((*record-xref-info* nil))
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
*/
|
||||
|
||||
%typemap(in) long long, unsigned long long "$1 = $input;";
|
||||
%typemap(out) long long, unsigned long long "$result = $1;";
|
||||
%typemap(out) long long, unsigned long long "$result = &$1;";
|
||||
|
||||
%typemap(ffitype) long long "(:struct (l1 :long) (l2 :long))";
|
||||
%typemap(ffitype) unsigned long long "(:struct (l1 :unsigned-long)
|
||||
|
|
|
|||
|
|
@ -1 +1,5 @@
|
|||
/* Unused for Allegro CL module */
|
||||
|
||||
%include "inout_typemaps.i"
|
||||
%include "wchar_t.i"
|
||||
%include "longlongs.i"
|
||||
|
|
|
|||
|
|
@ -626,12 +626,15 @@ String *get_ffi_type(SwigType *ty, const String_or_char *name) {
|
|||
into lisp code to generate the def-foreign-type name */
|
||||
|
||||
#ifdef ALLEGROCL_TYPE_DEBUG
|
||||
Printf(stderr, "inside g_f_t: looking up %s\n", ty);
|
||||
Printf(stderr, "inside g_f_t: looking up '%s' '%s'\n", ty, name);
|
||||
#endif
|
||||
|
||||
String *found_type = lookup_defined_foreign_type(ty);
|
||||
|
||||
if (found_type) {
|
||||
#ifdef ALLEGROCL_TYPE_DEBUG
|
||||
Printf(stderr, "found_type '%s'\n", found_type);
|
||||
#endif
|
||||
return (Strcmp(found_type,"forward-reference") ?
|
||||
Copy(found_type) : NewString(":void"));
|
||||
} else {
|
||||
|
|
@ -639,7 +642,10 @@ String *get_ffi_type(SwigType *ty, const String_or_char *name) {
|
|||
|
||||
if (typemap) {
|
||||
String *typespec = Getattr(typemap, "code");
|
||||
|
||||
|
||||
#ifdef ALLEGROCL_TYPE_DEBUG
|
||||
Printf(stderr, "found typemap '%s'\n", typespec);
|
||||
#endif
|
||||
return NewString(typespec);
|
||||
}
|
||||
|
||||
|
|
@ -1066,9 +1072,10 @@ void emit_full_class(Node *n) {
|
|||
(!storage_type || Strcmp(storage_type,"typedef")))) {
|
||||
String *access = Getattr(c,"access");
|
||||
|
||||
// hack. why would decl have a value of "variableHandler"?
|
||||
// hack. why would decl have a value of "variableHandler" and now "0"?
|
||||
String *childDecl = Getattr(c,"decl");
|
||||
if(!Strcmp(childDecl,"variableHandler"))
|
||||
// Printf(stderr,"childDecl = '%s' (%s)\n", childDecl, Getattr(c,"view"));
|
||||
if(!Strcmp(childDecl,"0"))
|
||||
childDecl = NewString("");
|
||||
|
||||
SwigType *childType=NewStringf("%s%s", childDecl,
|
||||
|
|
@ -1487,6 +1494,8 @@ int ALLEGROCL :: top(Node *n) {
|
|||
" (:use :common-lisp :swig :ff :excl))\n\n",
|
||||
module);
|
||||
|
||||
// Swig_print_tree(n);
|
||||
|
||||
Language::top(n);
|
||||
|
||||
// SwigType_emit_type_table(f_cxx,f_cxx_wrapper);
|
||||
|
|
@ -1838,6 +1847,39 @@ Node *parent_node_skipping_extends(Node* n)
|
|||
return result;
|
||||
}
|
||||
|
||||
/* -----------------------------------------------------------------------------
|
||||
* emit_num_lin_arguments()
|
||||
*
|
||||
* Calculate the total number of arguments. This function is safe for use
|
||||
* with multi-valued typemaps which may change the number of arguments in
|
||||
* strange ways.
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
int emit_num_lin_arguments(ParmList *parms) {
|
||||
Parm *p = parms;
|
||||
int nargs = 0;
|
||||
|
||||
while (p) {
|
||||
// Printf(stderr,"enla: '%s' lin='%x'\n", Getattr(p,"name"), Getattr(p,"tmap:lin"));
|
||||
if (Getattr(p,"tmap:lin")) {
|
||||
nargs += GetInt(p,"tmap:lin:numinputs");
|
||||
p = Getattr(p,"tmap:lin:next");
|
||||
} else {
|
||||
p = nextSibling(p);
|
||||
}
|
||||
}
|
||||
|
||||
/* DB 04/02/2003: Not sure this is necessary with tmap:in:numinputs */
|
||||
/*
|
||||
if (parms && (p = Getattr(parms,"emit:varargs"))) {
|
||||
if (!nextSibling(p)) {
|
||||
nargs--;
|
||||
}
|
||||
}
|
||||
*/
|
||||
return nargs;
|
||||
}
|
||||
|
||||
String *id_converter_type(SwigType const *type)
|
||||
{
|
||||
SwigType *t = Copy(type);
|
||||
|
|
@ -1942,6 +1984,12 @@ static ParmList *parmlist_with_names(ParmList *pl)
|
|||
Setattr(p2, "name", Getattr(p2, "lname"));
|
||||
Setattr(p2, "name", strip_namespaces(Getattr(p2, "name")));
|
||||
Setattr(p2, "tmap:ctype", Getattr(p, "tmap:ctype"));
|
||||
|
||||
String *temp = Getattr(p,"tmap:lin");
|
||||
if (temp) {
|
||||
Setattr(p2, "tmap:lin", temp);
|
||||
Setattr(p2, "tmap:lin:next", Getattr(p,"tmap:lin:next"));
|
||||
}
|
||||
}
|
||||
return pl2;
|
||||
}
|
||||
|
|
@ -2059,7 +2107,8 @@ IDargs* id_converter_arguments(Node *n)
|
|||
if (Getattr(n, "sym:overloaded")) {
|
||||
if(result->arity) Delete(result->arity);
|
||||
result->arity = NewStringf("%d",
|
||||
emit_num_arguments(Getattr(n, "wrap:parms")));
|
||||
// emit_num_arguments(Getattr(n, "wrap:parms")));
|
||||
emit_num_lin_arguments(Getattr(n, "wrap:parms")));
|
||||
}
|
||||
|
||||
SetVoid(n, "allegrocl:id-converter-args", result);
|
||||
|
|
@ -2158,7 +2207,7 @@ int ALLEGROCL :: emit_dispatch_defun(Node *n) {
|
|||
|
||||
int last_arity = -1;
|
||||
for (Iterator i = First(overloads); i.item; i = Next(i)) {
|
||||
int arity = emit_num_arguments(Getattr(i.item, "wrap:parms"));
|
||||
int arity = emit_num_lin_arguments(Getattr(i.item, "wrap:parms"));
|
||||
if (arity == last_arity) continue;
|
||||
|
||||
Printf(f_clwrap, "%s%d", last_arity == -1 ? "" : " ", arity);
|
||||
|
|
@ -2200,10 +2249,11 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
|
|||
// attach typemap info.
|
||||
Wrapper *wrap = NewWrapper();
|
||||
Swig_typemap_attach_parms("lin", pl, wrap);
|
||||
// Swig_typemap_attach_parms("in", pl, wrap);
|
||||
Swig_typemap_lookup_new("lout",n,"result",0);
|
||||
|
||||
// prime the pump.
|
||||
Printf(wrap->code,"$body");
|
||||
// prime the pump, with support for OUTPUT, INOUT typemaps.
|
||||
Printf(wrap->code,"(let (ACL_result)\n $body\n (values-list ACL_result))");
|
||||
|
||||
Parm *p;
|
||||
int largnum = 0, argnum=0, first=1;
|
||||
|
|
@ -2224,7 +2274,8 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
|
|||
// Just C
|
||||
else
|
||||
{
|
||||
Printf(f_cl, "(swig-defun (\"%s\")\n", funcname);
|
||||
Printf(f_cl, "(swig-defun (\"%s\" \"%s\")\n", funcname,
|
||||
Generate_Wrapper ? mangled_name : "");
|
||||
}
|
||||
|
||||
//////////////////////////////////////
|
||||
|
|
@ -2243,7 +2294,8 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
|
|||
String *largs = NewString("");
|
||||
|
||||
for (p=pl; p; p=nextSibling(p), argnum++, largnum++) {
|
||||
SwigType *argtype=Getattr(p, "type");
|
||||
// SwigType *argtype=Getattr(p, "type");
|
||||
SwigType *argtype = Swig_cparse_type(Getattr(p,"tmap:ctype"));
|
||||
|
||||
if (!first) {
|
||||
Printf(f_cl, "\n ");
|
||||
|
|
@ -2254,8 +2306,20 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
|
|||
} else {
|
||||
String *argname=NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
|
||||
|
||||
// String *ffitype=get_ffi_type(argtype, argname);
|
||||
String *ffitype=compose_foreign_type(argtype);
|
||||
String *ffitype = compose_foreign_type(argtype);
|
||||
|
||||
String *deref_ffitype;
|
||||
String *temp = Copy(argtype);
|
||||
|
||||
if(SwigType_ispointer(temp)) {
|
||||
SwigType_pop(temp);
|
||||
deref_ffitype = compose_foreign_type(temp);
|
||||
} else {
|
||||
deref_ffitype = Copy(ffitype);
|
||||
}
|
||||
|
||||
Delete(temp);
|
||||
|
||||
String *lisptype=get_lisp_type(argtype, argname);
|
||||
|
||||
// while we're walking the parameters, generating LIN
|
||||
|
|
@ -2269,16 +2333,25 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
|
|||
Printf(largs," %s",lname);
|
||||
Replaceall(parm_code,"$in", argname);
|
||||
Replaceall(parm_code,"$out", lname);
|
||||
|
||||
Replaceall(parm_code,"$in_fftype", ffitype);
|
||||
Replaceall(parm_code,"$*in_fftype", deref_ffitype);
|
||||
Replaceall(wrap->code,"$body", parm_code);
|
||||
}
|
||||
|
||||
String *dispatchtype=Getattr(n, "sym:overloaded") ?
|
||||
dispatching_type(p) :
|
||||
NewString("");
|
||||
|
||||
Printf(f_cl, "(%s %s %s %s)", argname, dispatchtype, ffitype, lisptype);
|
||||
first=0;
|
||||
|
||||
// if this parameter has been removed from the C/++ wrapper
|
||||
// it shouldn't be in the lisp wrapper either.
|
||||
if(!checkAttribute(p,"tmap:in:numinputs","0")) {
|
||||
Printf(f_cl, "(%s %s %s %s %s)",
|
||||
// parms in the ff wrapper, but not in the lisp wrapper.
|
||||
(checkAttribute(p,"tmap:lin:numinputs","0") ? ":p-" : ":p+"),
|
||||
argname, dispatchtype, ffitype, lisptype);
|
||||
|
||||
first=0;
|
||||
}
|
||||
|
||||
Delete(ffitype);
|
||||
Delete(lisptype);
|
||||
|
|
@ -2329,8 +2402,11 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
|
|||
// Getattr(n,"name"), cl_t);
|
||||
// }
|
||||
|
||||
Replaceall(wrap->code,"$body", NewStringf("(swig-ff-call%s)",
|
||||
wrap->locals));
|
||||
Replaceall(wrap->code,"$body", NewStringf("(swig-ff-call%s)", wrap->locals));
|
||||
// Replaceall(wrap->code,"$body",
|
||||
// (!Strcmp(result_type,"void") ?
|
||||
// NewStringf("(swig-ff-call%s)", wrap->locals) :
|
||||
// NewStringf("(push (swig-ff-call%s) ACL_result)", wrap->locals)));
|
||||
String* ldestructor = Copy(lclass);
|
||||
if (ff_foreign_ptr)
|
||||
Replaceall(ldestructor, ldestructor, "identity");
|
||||
|
|
@ -2402,6 +2478,7 @@ int ALLEGROCL :: functionWrapper(Node *n) {
|
|||
|
||||
// Attach the standard typemaps
|
||||
Swig_typemap_attach_parms("ctype", parms, wrap);
|
||||
Swig_typemap_attach_parms("lin", parms, wrap);
|
||||
emit_attach_parmmaps(parms, wrap);
|
||||
|
||||
String *mangled = mangle_name(n);
|
||||
|
|
@ -2442,10 +2519,12 @@ int ALLEGROCL :: functionWrapper(Node *n) {
|
|||
int i; Parm *p;
|
||||
for (i = 0, p=parms; i < num_arguments; i++) {
|
||||
|
||||
while (checkAttribute(p,"tmap:in:numinputs","0")) {
|
||||
while (p && checkAttribute(p,"tmap:in:numinputs","0")) {
|
||||
p = Getattr(p,"tmap:in:next");
|
||||
}
|
||||
|
||||
if(!p) break;
|
||||
|
||||
SwigType *c_parm_type = Swig_cparse_type(Getattr(p, "tmap:ctype"));
|
||||
String *arg = NewStringf("l%s", Getattr(p,"lname"));
|
||||
|
||||
|
|
@ -2868,6 +2947,8 @@ int ALLEGROCL :: cppClassHandler(Node *n) {
|
|||
Getattr(c,"type"));
|
||||
if(!SwigType_isfunction(childType))
|
||||
Delete(compose_foreign_type(childType));
|
||||
|
||||
Delete(childType);
|
||||
}
|
||||
#ifdef ALLEGROCL_CLASS_DEBUG
|
||||
Printf(stderr, " MANUAL walk DONE.\n");
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue