updated for mzc --xform

svn: r972

collects/mzscheme/examples/README

@@ -3,41 +3,45 @@ examples are implemented directly in C. A few examples listed at the
 end use the mzc `c-lambda', etc. forms.
 
  * hello.c - returns the string "Hello, World!". Demonstrates creating
-   a Scheme value. (Works with 3m.)
+   a Scheme value.
 
  * fmod.c - defines the `fmod' procedure, which calculates modulo on
    floating-point numbers. Demonstrates creating Scheme procedures
-   from C and adding top-level definitions. (Works with 3m.)
+   from C and adding top-level definitions. (Manually instrumented for
+   3m, so do not use `mzc --xform'.)
 
  * curses.c - links MzScheme to the curses library. Demonstrates more
    procedures and definitions, a little more type dispatching, and
-   returning multiple values. (Works with 3m.)
+   returning multiple values. (Manually instrumented for 3m, so do not
+   use `mzc --xform'.)
 
  * makeadder.c - defines `make-adder', which takes a number and
    returns a procedure that takes another number to add to
    it. Demonstrates closure creation in C, getting Scheme global
    values, and calling Scheme procedures from C.
 
-   makeadder3m.c - the same, but works with 3m. Making the code
-   work with 3m requires several changes.
+   makeadder3m.c - the same, but manually instrumented 3m (so do not
+   use `mzc --xform'). Making the code work with 3m requires several
+   changes, but `mzc --xform' works on "makeadder.c" without changes.
 
  * catch.c - defined `eval-string/catch-error', which catches
    excpetions whil evaluating a string. Demonstrates how to catch
-   exceptions from C code. (Does not work with 3m.)
+   exceptions from C code.
 
  * bitmatrix.c - implements two-dimentional bit matrixes with some
    operations. Demonstrates defining a new Scheme data type, data
    allocation, fancy integer type checking, general exception raising,
-   and registering static variables. (Does not work with 3m.)
+   and registering static variables. Also demonstrates supplying
+   traversal functions for 3m (but still needs `mzc --xform'
+   preprocessing to build for 3m).
 
  * idmodule.c - Declares the module named `idmodule' that provides an
    `identity' function. Demonstrates implementing a primitive module
-   in C. (Does not work with 3m.)
+   in C.
 
  * helloprint.c - prints "Hello, World!" directly to the current
    output port rather than relying on the read-eval-print-loop.
-   Demonstrates using built-in Scheme parameter values from C.  (Does
-   not work with 3m.)
+   Demonstrates using built-in Scheme parameter values from C.
 
  * tree.cxx, tree-finish.ss - shows how to inject a C++ class into
    MzLib's class.ss world. (Does not work with 3m.)

collects/mzscheme/examples/bitmatrix.c

@@ -27,6 +27,23 @@ typedef struct {
   unsigned long *matrix;
 } Bitmatrix;
 
+#ifdef MZ_PRECISE_GC
+START_XFORM_SKIP;
+/* Traversal procedures for precise GC: */
+static long bm_size(void *p) { 
+  return gcBYTES_TO_WORDS(sizeof(Bitmatrix)); 
+}
+static long bm_mark(void *p) { 
+  gcMARK(((Bitmatrix *)p)->matrix);
+  return gcBYTES_TO_WORDS(sizeof(Bitmatrix));
+}
+static long bm_fixup(void *p) { 
+  gcFIXUP(((Bitmatrix *)p)->matrix);
+  return gcBYTES_TO_WORDS(sizeof(Bitmatrix));
+}
+END_XFORM_SKIP;
+#endif
+
 /* We'll get some Scheme primitives so we can calculate with numbers
    taht are potentially bignums: */
 static Scheme_Object *mult, *add, *sub, *modulo, *neg;
@@ -51,7 +68,7 @@ static int negative(Scheme_Object *o)
 Scheme_Object *make_bit_matrix(int argc, Scheme_Object **argv)
 {
   Scheme_Object *size, *rowlength, *a[2];
-  unsigned long w, h, s, l;
+  unsigned long w, h, s, l, *lp;
   Bitmatrix *bm;
 
   /* Really fancy: we allow any kind of positive integer for
@@ -92,25 +109,27 @@ Scheme_Object *make_bit_matrix(int argc, Scheme_Object **argv)
 
   /* Malloc the bit matrix structure. Since we use scheme_malloc, the
      bit matrix value is GC-able. */
-  bm = (Bitmatrix *)scheme_malloc(sizeof(Bitmatrix));
+  bm = (Bitmatrix *)scheme_malloc_tagged(sizeof(Bitmatrix));
   bm->type = bitmatrix_type;
 
   /* Try to allocate the bit matrix. Handle failure gracefully. Note
      that we use scheme_malloc_atomic since the allocated memory will
      never contain pointers to GC-allocated memory. */
   s = ((s + LONG_SIZE - 1) >> LOG_LONG_SIZE);
-  bm->matrix = (unsigned long *)scheme_malloc_fail_ok(scheme_malloc_atomic, 
-						      sizeof(long) * s);
-  if (!bm->matrix)
+  lp = (unsigned long *)scheme_malloc_fail_ok(scheme_malloc_atomic, 
+					      sizeof(long) * s);
+  if (!lp)
     scheme_raise_exn(MZEXN_FAIL, "make-bit-matrix: out of memory");
+  bm->matrix = lp;
 
   bm->w = w;
   bm->h = h;
   bm->l = l;
 
   /* Init matirx to all 0s: */
-  while (s--)
+  while (s--) {
     bm->matrix[s] = 0;
+  }
 
   return (Scheme_Object *)bm;
 }
@@ -209,8 +228,9 @@ Scheme_Object *bit_matrix_invert(int argc, Scheme_Object **argv)
   bm = (Bitmatrix *)argv[0];
   
   i = (bm->l * bm->h) >> LOG_LONG_SIZE;
-  while (i--)
+  while (i--) {
     bm->matrix[i] = ~bm->matrix[i];
+  }
 
   return scheme_void;
 }
@@ -228,8 +248,9 @@ Scheme_Object *bit_matrix_clear(int argc, Scheme_Object **argv)
   bm = (Bitmatrix *)argv[0];
 
   i = (bm->l * bm->h) >> LOG_LONG_SIZE;
-  while (i--)
+  while (i--) {
     bm->matrix[i] = 0;
+  }
 
   return scheme_void;
 }
@@ -275,6 +296,11 @@ Scheme_Object *scheme_initialize(Scheme_Env *env)
 {
   bitmatrix_type = scheme_make_type("<bit-matrix>");
 
+#ifdef MZ_PRECISE_GC
+  /* Register traversal procedures: */
+  GC_register_traversers(bitmatrix_type, bm_size, bm_mark, bm_fixup, 1, 0);
+#endif
+
   /* Get some Scheme primitives. Conservative garbage collection sees
      any local variables we use within a function, but we have to register
      static variables: */

collects/mzscheme/examples/catch.c

@@ -29,12 +29,14 @@ static Scheme_Object *exn_catching_apply, *exn_p, *exn_message;
 static void init_exn_catching_apply()
 {
   if (!exn_catching_apply) {
+    Scheme_Env *env;
     char *e = 
       "(lambda (thunk) "
 	"(with-handlers ([void (lambda (exn) (cons #f exn))]) "
 	  "(cons #t (thunk))))";
+
     /* make sure we have a namespace with the standard bindings: */
-    Scheme_Env *env = (Scheme_Env *)scheme_make_namespace(0, NULL);
+    env = (Scheme_Env *)scheme_make_namespace(0, NULL);
 
     scheme_register_extension_global(&exn_catching_apply, sizeof(Scheme_Object *));
     scheme_register_extension_global(&exn_p, sizeof(Scheme_Object *));

collects/mzscheme/examples/helloprint.c

@@ -6,7 +6,8 @@
 Scheme_Object *scheme_reload(Scheme_Env *env)
 {
   /* Make the string: */
-  Scheme_Object *hw = scheme_make_utf8_string("Hello, World!\n");
+  Scheme_Object *hw;
+  hw = scheme_make_utf8_string("Hello, World!\n");
 
   /* Display it: */
   scheme_display(hw, scheme_get_param(scheme_current_config(),