[allegrocl] see CHANGES.current

git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@9854 626c5289-ae23-0410-ae9c-e8d60b6d4f22

CHANGES.current

@@ -1,6 +1,11 @@
 Version 1.3.32 (in progress)
 ============================
 
+06/07/2007: mutandiz (Mikel Bancroft)
+	    [allegrocl]
+	    fix foreign-type constructor to properly look for ffitype typemap
+	    bindings. fix inout_typemaps.i for strings.
+
 06/06/2007: olly
 	    [Ruby]
 	    Use whichever of "long" or "long long" is the same size as "void*"

Lib/allegrocl/inout_typemaps.i

@@ -6,10 +6,14 @@
 */
 
 
+/* Note that this macro automatically adds a pointer to the type passed in.
+   As a result, INOUT typemaps for char are for 'char *'. The definition
+   of typemaps for 'char' takes advantage of this, believing that it's more
+   likely to see an INOUT argument for strings, than a single char. */
 %define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
 // OUTPUT map.
 %typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
-%{(let (($out (ff:allocate-fobject '$*in_fftype :c)))
+%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
      $body
      OUTresult_
      (ff:free-fobject $out)) %}
@@ -22,8 +26,11 @@
 
 
 // INOUT map.
+// careful here. the input string is converted to a C string
+// with length equal to the input string. This should be large
+// enough to contain whatever OUTPUT value will be stored in it.
 %typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
-%{(let (($out (ff:allocate-fobject '$*in_fftype :c)))
+%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
      INbind_
      $body
      OUTresult_
@@ -52,10 +59,11 @@ INOUT_TYPEMAP(unsigned short,
 INOUT_TYPEMAP(unsigned long,
 	      (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
 	      (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
-INOUT_TYPEMAP(char,
+// char * mapping for passing strings. didn't quite work
-	      (cl::push (code-char (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
+// INOUT_TYPEMAP(char,
-		    ACL_result),
+//              (cl::push (excl:native-to-string $out) ACL_result),
-	      (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
+//	      (cl::setf (ff:fslot-value-typed (cl::quote $in_fftype) :c $out)
+//		    (excl:string-to-native $in)))
 INOUT_TYPEMAP(float,
 	      (cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
 	      (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
@@ -67,14 +75,37 @@ INOUT_TYPEMAP(bool,
 		    ACL_result),
 	      (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) (if $in 1 0)));
 
-INOUT_TYPEMAP(char *,
-              (cl::push (ff:char*-to-string (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
-		    ACL_result),
-	      (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)
-		    (ff:string-to-char* $in)))
-
 %typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
 
 // long long support not yet complete
 // INOUT_TYPEMAP(long long);
 // INOUT_TYPEMAP(unsigned long long);
+
+// char *OUTPUT map.
+// for this to work, swig needs to know how large an array to allocate.
+// you can fake this by 
+// %typemap(ffitype) char *myarg	"(:array :char 30)";
+// %apply char *OUTPUT { char *myarg };
+%typemap(lin,numinputs=0) char *OUTPUT, char &OUTPUT
+%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
+     $body
+     (cl::push (excl:native-to-string $out) ACL_result)
+     (ff:free-fobject $out)) %}
+
+// char *INPUT map.
+%typemap(in) char *INPUT, char &INPUT
+%{ $1 = &$input; %}
+%typemap(ctype) char *INPUT, char &INPUT "$*1_ltype";
+
+// char *INOUT map.
+%typemap(lin,numinputs=1) char *INOUT, char &INOUT
+%{(cl::let (($out (excl:string-to-native $in)))
+     $body
+     (cl::push (excl:native-to-string $out) ACL_result)
+     (ff:free-fobject $out)) %}
+
+// uncomment this if you want INOUT mappings for chars instead of strings.
+// INOUT_TYPEMAP(char,
+// 	      (cl::push (code-char (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
+//		    ACL_result),
+//	      (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));

Source/Modules/allegrocl.cxx

@@ -628,7 +628,7 @@ String *get_ffi_type(SwigType *ty, const String_or_char *name) {
       String *typespec = Getattr(typemap, "code");
 
 #ifdef ALLEGROCL_TYPE_DEBUG
-      Printf(stderr, "found typemap '%s'\n", typespec);
+      Printf(stderr, "g-f-t: found ffitype typemap '%s'\n%s\n", typespec, typemap);
 #endif
       return NewString(typespec);
     }
@@ -733,12 +733,26 @@ String *internal_compose_foreign_type(SwigType *ty) {
   return ffiType;
 }
 
-String *compose_foreign_type(SwigType *ty) {
+String *compose_foreign_type(SwigType *ty, String *id = 0) {
 
 #ifdef ALLEGROCL_TYPE_DEBUG
   Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty);
+  String *id_ref = SwigType_str(ty, id);
+  Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0);
+  Printf(stderr, "looking up typemap for %s, found '%s'(%x)\n",
+	 id_ref, lookup_res ? Getattr(lookup_res, "code") : 0, lookup_res);
 #endif
-  /* should we allow named lookups in the typemap here? */
+  /* should we allow named lookups in the typemap here? YES! */
+  if(id) { /* and we should probably allow unnamed lookups here as well */
+    Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0);
+    if(lookup_res) {
+#ifdef ALLEGROCL_TYPE_DEBUG
+    Printf(stderr, "compose_foreign_type: EXIT-1 (%s)\n ", Getattr(lookup_res, "code"));
+#endif
+       return NewString(Getattr(lookup_res, "code"));
+    }
+  }
+
   SwigType *temp = SwigType_strip_qualifiers(ty);
   String *res = internal_compose_foreign_type(temp);
   Delete(temp);
@@ -780,35 +794,38 @@ static String *mangle_name(Node *n, char const *prefix = "ACL", String *ns = cur
 }
 
 /* utilities */
+
+/* remove a pointer from ffitype. non-destructive. 
+   (* :char) ==> :char
+   (* (:array :int 30)) ==> (:array :int 30) */
+String *dereference_ffitype(String *ffitype) {
+   char *start;
+   char *temp = Char(ffitype);
+   String *reduced_type = 0;
+
+   if(temp && temp[0] == '(' && temp[1] == '*') {
+      temp += 2;
+
+      // walk past start of pointer references
+      while(*temp == ' ') temp++;
+      start = temp;
+      // temp = Char(reduced_type);
+      reduced_type = NewString(start);
+      temp = Char(reduced_type);
+      // walk to end of string. remove closing paren
+      while(*temp != '\0') temp++;
+      *(--temp) = '\0';
+   }
+
+   return reduced_type ? reduced_type : Copy(ffitype);
+}
+
 /* returns new string w/ parens stripped */
 String *strip_parens(String *string) {
   string = Copy(string);
   Replaceall(string, "(", "");
   Replaceall(string, ")", "");
   return string;
-  /*
-     char *s=Char(string), *p;
-     int len=Len(string);
-     String *res;
-
-     if (len==0 || s[0] != '(' || s[len-1] != ')') {
-     return NewString(string);
-     }
-
-     p=(char *)malloc(len-2+1);
-     if (!p) {
-     Printf(stderr, "Malloc failed\n");
-     SWIG_exit(EXIT_FAILURE);
-     }
-
-     strncpy(p, s+1, len-1);
-     p[len-2]=0; // null terminate 
-
-     res=NewString(p);
-     free(p);
-
-     return res;
-   */
 }
 
 int ALLEGROCL::validIdentifier(String *s) {
@@ -2270,6 +2287,7 @@ 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("ffitype", pl, wrap);
   Swig_typemap_lookup_new("lout", n, "result", 0);
 
   SwigType *result_type = Swig_cparse_type(Getattr(n, "tmap:ctype"));
@@ -2322,8 +2340,14 @@ int ALLEGROCL::emit_defun(Node *n, File *f_cl) {
       } else {
 	String *argname = NewStringf("PARM%d_%s", largnum, Getattr(p, "name"));
 
-	String *ffitype = compose_foreign_type(argtype);
+	// Swig_print_node(p);
+	// Printf(stderr,"%s\n", Getattr(p,"tmap:lin"));
+	String *ffitype = compose_foreign_type(argtype, Getattr(p,"name"));
 	String *deref_ffitype;
+
+	deref_ffitype = dereference_ffitype(ffitype);
+
+/*
 	String *temp = Copy(argtype);
 
 	if (SwigType_ispointer(temp)) {
@@ -2334,7 +2358,7 @@ int ALLEGROCL::emit_defun(Node *n, File *f_cl) {
 	}
 
 	Delete(temp);
-
+*/
 	// String *lisptype=get_lisp_type(argtype, argname);
 	String *lisptype = get_lisp_type(Getattr(p, "type"), Getattr(p, "name"));
 
@@ -2352,9 +2376,9 @@ int ALLEGROCL::emit_defun(Node *n, File *f_cl) {
 	  String *lname = Getattr(p, "lname");
 
 	  Printf(largs, " %s", lname);
+	  Replaceall(parm_code, "$in_fftype", ffitype); // must come before $in
 	  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);
 	}
@@ -2402,6 +2426,7 @@ int ALLEGROCL::emit_defun(Node *n, File *f_cl) {
   Delete(out_temp);
 
   Delete(parsed);
+
   int isPtrReturn = 0;
 
   if (cl_t) {