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

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

SWIG/CHANGES.current

@@ -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.

SWIG/Doc/Manual/Allegrocl.html

@@ -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

SWIG/Examples/test-suite/allegrocl/Makefile.in

@@ -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 +=
+# these cpp tests aren't working. Fix 'em
-#C_TEST_CASES += 
+# 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: 

SWIG/Lib/allegrocl/allegrocl.swg

@@ -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,
+               float, double, long double, char *, void *,
-               enum SWIGTYPE    "$body";
+               enum SWIGTYPE    "(push $body ACL_result)";
+%typemap(lout) void "$body";
 %typemap(lout) SWIGTYPE[ANY], SWIGTYPE *,
-               SWIGTYPE &       "(make-instance '$lclass :foreign-address $body)";
+               SWIGTYPE &       "(push (make-instance '$lclass :foreign-address $body) ACL_result)";
-%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)";
+
+%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,numinputs=1)       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* "(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 "(push (code-char $body) ACL_result)";
-%typemap(lout)      wchar_t* "(excl:native-to-string $body
+%typemap(lout)      wchar_t* "(push (excl:native-to-string $body
-:external-format #+little-endian :fat-le #-little-endian :fat)";
+: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)))
+		      (mapcar #'car (and (not (equal arglist '(:void)))
-					      ffargs))
+					 (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))

SWIG/Lib/allegrocl/longlongs.i

@@ -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)

SWIG/Lib/allegrocl/typemaps.i

@@ -1 +1,5 @@
 /* Unused for Allegro CL module */
+
+%include "inout_typemaps.i"
+%include "wchar_t.i"
+%include "longlongs.i"

SWIG/Source/Modules/allegrocl.cxx

@@ -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 {
@@ -640,6 +643,9 @@ 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.
+  // prime the pump, with support for OUTPUT, INOUT typemaps.
-  Printf(wrap->code,"$body");
+  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,7 +2333,8 @@ 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);
 	}
 	
@@ -2277,8 +2342,16 @@ int ALLEGROCL :: emit_defun(Node *n, File *f_cl) {
 	  dispatching_type(p) :
 	  NewString("");
 
-	Printf(f_cl, "(%s %s %s %s)", argname, dispatchtype, ffitype, lisptype);
+	// if this parameter has been removed from the C/++ wrapper
-	first=0;
+	// 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)",
+  Replaceall(wrap->code,"$body", NewStringf("(swig-ff-call%s)", wrap->locals));
-                                            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");