Add garbage collection support to the chicken module

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

CHANGES.current

@@ -1,6 +1,15 @@
 Version 1.3.25 (In progress)
 ============================
 
+03/15/2005: wuzzeb (John Lenz)
+	    [Chicken] Add support for adding finalizers garbage collected objects.
+	    Functions that return new objects should be marked with %newobject and
+	    input arguments which consume (or take ownership) of a pointer should
+	    be marked with the DISOWN typemap.
+
+	    Also add support for correctly checking the number of arguments passed
+	    to a function, and raising an error if the wrong number are passed.
+
 03/14/2005: wuzzeb (John Lenz)
             Add --without-alllang option to configure.in, which is the same as
             passing all the --without-python --without-perl5 etc... that Matthias added.

Doc/Manual/Chicken.html

@@ -46,6 +46,7 @@
       defined in the <i>Revised^5 Report on Scheme</i>.  Its main
       attributes are that it
     </p>
+
       <ol>
 	<li>generates portable C code</li>
 	<li>includes a customizable interpreter</li>
@@ -71,10 +72,9 @@
       CHICKEN support was introduced to SWIG in version 1.3.18.  SWIG
       relies on some recent additions to CHICKEN, which are only
       present in releases of CHICKEN with version number
-      <strong>greater than or equal to <tt>1.40</tt></strong>.
+      <strong>greater than or equal to 1.89</strong>.  
-
+      CHICKEN can be downloaded from 
-      <br> CHICKEN can be downloaded from <a
+      <a href="http://www.call-with-current-continuation.org/">http://www.call-with-current-continuation.org/</a>
-      href="http://www.call-with-current-continuation.org/">http://www.call-with-current-continuation.org/</a>
 
       You may want to look at any of the examples in Examples/chicken/
       or Examples/GIFPlot/Chicken for the basic steps to run SWIG
@@ -93,7 +93,7 @@
       the -chicken option.
       </p>
 
-      <div class="code">
+      <div class="shell">
 	<pre>% swig -chicken example.i</pre>
       </div>
 
@@ -105,7 +105,7 @@
       be compiled to C using your system's CHICKEN compiler.
       </p>
 
-      <div class="code">
+      <div class="shell">
 	<pre>% chicken example.scm -output-file oexample.c</pre>
       </div>
 
@@ -123,7 +123,7 @@
       the -chicken -c++ option.
       </p>
 
-      <div class="code">
+      <div class="shell">
 	<pre>% swig -chicken -c++ example.i</pre>
       </div>
 
@@ -133,7 +133,7 @@
       compiled to C using your system's CHICKEN compiler.
       </p>
 
-      <div class="code">
+      <div class="shell">
 	<pre>% chicken example.scm -output-file oexample.c</pre>
       </div>
 
@@ -156,9 +156,9 @@
       in CHICKEN as an identifier ending with
       <tt>Foo-Bar</tt>.  That is, an underscore is converted
       to a dash.
+    </p>
 
-      <br>
+    <p>
-
       You may control what the CHICKEN identifier will be by using the
       <tt>%rename</tt> SWIG directive in the SWIG interface file.
     </p>
@@ -312,7 +312,7 @@
       in example.i and the C functions being wrapped are in example_impl.c.
     </p>
 
-   <div class="code">
+   <div class="shell">
    <pre>
    $ swig -chicken example.i
    $ csc -svk example.scm example_impl.c example_wrap.c
@@ -336,7 +336,7 @@
 
    <p>Again, we can easily use csc to build a binary.</p>
 
-   <div class="code">
+   <div class="shell">
    <pre>
    $ swig -chicken example.i
    $ csc -vk example.scm example_impl.c example_wrap.c test_script.scm -o example
@@ -393,7 +393,6 @@
       <li>No exception handling.</li>
       <li>No director support.</li>
       <li>No support for c++ standard types like std::vector.</li>
-      <li>No support for automatic garbage collection of wrapped classes and structures. (Planned on adding in SWIG version 1.3.25) </li>
       <li>Importing multiple SWIG modules not working with TinyCLOS. (Planned on fixing for 1.3.25) </li>
       <li>Problems with complicated function overloading. (Planned on fixing for 1.3.25)</li>
     </ul>

Lib/chicken/chicken.swg

@@ -150,7 +150,11 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double),
 
 /* Pointers, references, and arrays */
 %typemap(in) SWIGTYPE *, SWIGTYPE [], SWIGTYPE &  {
-   $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, 0);
+   $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, $disown);
+}
+
+%typemap(in) SWIGTYPE *DISOWN {
+  $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, SWIG_POINTER_DISOWN);
 }
 
 /* Void pointer.  Accepts any kind of pointer */
@@ -159,7 +163,7 @@ SIMPLE_TYPEMAP(double, C_flonum_magnitude, C_flonum, C_swig_is_flonum, (double),
 }
 
 %typemap(varin) SWIGTYPE * {
-  $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0);
+  $1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, SWIG_POINTER_DISOWN);
 }
 
 %typemap(varin) SWIGTYPE & {
@@ -587,7 +591,7 @@ SWIGEXPORT(void) SWIG_init(int, C_word, C_word) C_noret;
 %insert(init) %{
 /* CHICKEN initialization function */
 SWIGEXPORT(void)
-SWIG_init(int argc, C_word closure, C_word continuation) {
+SWIG_init(C_word argc, C_word closure, C_word continuation) {
   int       i;
   C_word sym;
   C_word tmp;

Lib/chicken/chickenrun.swg

@@ -60,13 +60,17 @@ extern "C" {
     resultobjlast = tmp; \
   }
 
+#define SWIG_POINTER_DISOWN 1
+
 enum {
   SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
   SWIG_BARF1_ARGUMENT_NULL /* 1 arg */
 };
 
+typedef C_word (*swig_chicken_destructor)(C_word,C_word,C_word,C_word);
 typedef struct swig_chicken_clientdata {
   void *gc_proxy_create;
+  swig_chicken_destructor destroy;
 } swig_chicken_clientdata;
   
 static char *
@@ -166,6 +170,26 @@ SWIG_Chicken_Barf(int code, C_char *msg, ...)
   }
 }
 
+static void
+SWIG_Chicken_Finalizer(C_word argc, C_word closure, C_word continuation, C_word s)
+{
+  swig_type_info *type;
+  swig_chicken_clientdata *cdata;
+
+  if (argc == 3 && s != C_SCHEME_FALSE && C_swig_is_swigpointer(s)) {
+    type = (swig_type_info *) C_block_item(s, 1);
+    if (type) {
+      cdata = (swig_chicken_clientdata *) type->clientdata;
+      if (cdata && cdata->destroy) {
+	/* this will not return, but will continue correctly */
+        cdata->destroy(3,closure,continuation,s);
+      }
+    }
+  }
+  C_kontinue(continuation, C_SCHEME_UNDEFINED);
+}
+static C_word finalizer_obj[2] = {(C_word) (C_CLOSURE_TYPE|1), (C_word) SWIG_Chicken_Finalizer};
+
 static C_word
 SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data)
 {
@@ -175,6 +199,11 @@ SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **
     return C_SCHEME_FALSE;
   else {
     C_word cptr = C_swigmpointer(data, ptr, type);
+    /* add finalizer to object */
+    if (owner)
+      C_do_register_finalizer(cptr, (C_word) finalizer_obj);
+
+    /* wrap the result inside a proxy class if one is available */
     if (cdata && cdata->gc_proxy_create) {
       C_word closure = CHICKEN_gc_root_ref(cdata->gc_proxy_create);
       if (C_swig_is_closurep(closure)) {
@@ -195,24 +224,28 @@ SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags
 
   if (s == C_SCHEME_FALSE) {
     *result = NULL;
-    return 0;
   } else if (C_swig_is_swigpointer(s)) {
+    /* try and convert type */
     from = (swig_type_info *) C_block_item(s, 1);
     if (!from) return 1;
     if (type) {
       cast = SWIG_TypeCheckStruct(from, type);
       if (cast) {
         *result = SWIG_TypeCast(cast, (void *) C_block_item(s, 0));
-        return 0;
       } else {
         return 1;
       }
     } else {
       *result = (void *) C_block_item(s, 0);
-      return 0;
+    }
+
+    /* check if we are disowning this object */
+    if (flags & SWIG_POINTER_DISOWN) {
+      C_do_unregister_finalizer(s);
     }
   }
-  return 1;
+
+  return 0;
 }
 
 static SWIGINLINE void *

Source/Modules/chicken.cxx

@@ -61,6 +61,7 @@ static  String       *short_class_name  = 0;
 static  String       *clos_class_methods = 0;
 static  int          in_class = 0;
 static  int          have_constructor = 0;
+static  bool         exporting_destructor = false;
 static int           useclassprefix = 0;
 static String        *closprefix = 0;
 static String        *memberfunction_name = 0;
@@ -81,6 +82,7 @@ public:
   virtual int  memberfunctionHandler(Node *n);
   virtual int  membervariableHandler(Node *n);
   virtual int  constructorHandler(Node *n);
+  virtual int  destructorHandler(Node *n);
   virtual int  validIdentifier(String *s);
   virtual int  staticmembervariableHandler(Node *n);
   virtual int  staticmemberfunctionHandler(Node *n);
@@ -414,7 +416,7 @@ CHICKEN::functionWrapper(Node *n)
 	}
 
 	if (i >= num_required)
-	  Printv(get_pointers, "if (", source, ") {\n", NIL);
+	  Printv(get_pointers, "if (argc-2>", i, " && (", source, ")) {\n", NIL);
 	Printv(get_pointers,tm,"\n", NIL);
 	if (i >= num_required)
 	  Printv(get_pointers, "}\n", NIL);
@@ -467,6 +469,12 @@ CHICKEN::functionWrapper(Node *n)
   Printf(f->def,  ") {");
   Printf(declfunc, ")");
 
+  /* First check the number of arguments is correct */
+  if (num_arguments != num_required)
+    Printf(f->code, "if (argc-2<%i || argc-2>%i) C_bad_argc(argc,%i);\n", num_required, num_arguments, num_required+2);
+  else
+    Printf(f->code, "if (argc!=%i) C_bad_argc(argc,%i);\n", num_arguments+2, num_arguments+2);
+
   /* Now piece together the first part of the wrapper function */
   Printv(f->code, get_pointers, NIL);
 
@@ -572,7 +580,13 @@ CHICKEN::functionWrapper(Node *n)
   /* Now register the function with the interpreter.   */
   int exportclos = 0;
   if (!Getattr(n,"sym:overloaded")) {
-    addMethod(scmname, wname);
+    if (exporting_destructor) {
+      Printf(f_init,
+        "((swig_chicken_clientdata *)(SWIGTYPE%s->clientdata))->destroy = (swig_chicken_destructor) %s;\n",
+        swigtype_ptr, wname);
+    } else {
+      addMethod(scmname, wname);
+    }
     exportclos = 1;
   }
   else {
@@ -689,6 +703,8 @@ CHICKEN::variableWrapper(Node *n)  {
       
     Wrapper_add_local(f, "resultobj", "C_word resultobj");
 
+    Printf(f->code, "if (argc!=2||argc!=3) C_bad_argc(argc,2);\n");
+
     /* Check for a setting of the variable value */
     if (!Getattr(n,"feature:immutable")) {
       Printf(f->code, "if (argc > 2) {\n");
@@ -856,6 +872,8 @@ CHICKEN::constantWrapper(Node *n)
       
     Wrapper_add_local(f, "resultobj", "C_word resultobj");
 
+    Printf(f->code, "if (argc!=2) C_bad_argc(argc,2);\n");
+
     // Return the value of the variable
     if ((tm = Swig_typemap_lookup_new("varout",n,name,0))) {
 
@@ -981,13 +999,11 @@ CHICKEN::classHandler(Node *n)
   Printf(closcode, ")))\n");
 
   String *newmethod = NewStringf("new-%s", short_class_name);
-  String *delmethod = NewStringf("delete-%s", short_class_name);
 
   if (have_constructor) {
       Printv(closcode, "(define-method (initialize (obj ", class_name, ") initargs)\n",
                        "  (call-next-method)\n",
 		       "  (swig-initialize obj initargs ", chickenPrimitiveName(newmethod), ")\n",
-                       //"  (set-finalizer! obj (lambda (x) (", chickenPrimitiveName(delmethod), " (slot-ref x 'swig-this))))",
 		       ")\n",
                        NIL);
   } else {
@@ -998,7 +1014,6 @@ CHICKEN::classHandler(Node *n)
   }
 
   Delete(newmethod);
-  Delete(delmethod);
 
   Printf(closcode, "%s\n", clos_class_methods);
   Delete(clos_class_methods);
@@ -1014,6 +1029,7 @@ CHICKEN::classHandler(Node *n)
       Printv(f_wrappers, "static void ", funcname, "(C_word,C_word,C_word,C_word) C_noret;\n",
                          "static void ", funcname, "(C_word argc, C_word closure, C_word continuation, C_word cl) {\n",
                          "  C_trace(\"", funcname, "\");\n",
+			 "  if (argc!=3) C_bad_argc(argc,3);\n",
 			 "  swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) SWIGTYPE", swigtype_ptr,"->clientdata;\n",
 			 "  cdata->gc_proxy_create = CHICKEN_new_gc_root();\n",
                          "  CHICKEN_gc_root_set(cdata->gc_proxy_create, cl);\n",
@@ -1142,6 +1158,14 @@ CHICKEN::constructorHandler(Node *n)
   return SWIG_OK;
 }
 
+int CHICKEN::destructorHandler(Node *n) {
+  exporting_destructor = true;
+  Language::destructorHandler(n);
+  exporting_destructor = false;
+  return SWIG_OK;
+}
+
+
 void 
 CHICKEN::dispatchFunction(Node *n)
 {