[gambit-list] Gambit-C 4.0 beta 12

Marc Feeley feeley at IRO.UMontreal.CA
Tue Jan 4 18:22:50 EST 2005


A new beta of Gambit-C 4.0 is now available in source form at this
address:

    http://www.iro.umontreal.ca/~feeley/gambc40b12.tar.gz

Here are the main changes:

   - The compiler now does constant folding and optimistic inlining of
     predefined procedures.  Constant folding is performed for the call
     (predef arg1 arg2...) when arg1, arg2... are constants (of the
     right type) and predef is a global variable that is known to be
     equal to a predefined procedure which does not have side effects
     (i.e. when a "standard-bindings" declaration is used and predef
     is not vector-set!, cons, etc).  So

        (declare (standard-bindings))
        (define pi (* 4 (atan 1)))

     expands to

        (define pi 3.141592653589793)

     Note that "standard-bindings" is off by default.  A new
     declaration, "run-time-bindings" (which is on by default), tells
     the compiler that it should check at run-time if the variable
     predef truly contains the corresponding predefined procedure,
     and call the predefined procedure if it is, otherwise perform
     a call using the global variable.  This is useful for improving
     the performance of arithmetic in the absence of unsafe declarations.
     For example the following definition of fib (with no declarations)

        (define (fib n) (if (< n 2) 1 (+ (fib (- n 1)) (fib (- n 2)))))

     is expanded to this code

        (define fib
          (lambda (n)
            (if (if (and (##eq? < '#<procedure #2 <>) (and (##fixnum? n) #t))
                    (##fixnum.< n 2)
                    (< n 2))
                1
                (let ((t1
                       (fib (or (and (##eq? - '#<procedure #3 ->)
                                     (and (##fixnum? n) (##fixnum.-? n 2)))
                                (- n 2))))
                      (t2
                       (fib (or (and (##eq? - '#<procedure #3 ->)
                                     (and (##fixnum? n) (##fixnum.-? n 1)))
                                (- n 1)))))
                  (or (and (##eq? + '#<procedure #4 +>)
                           (and (##fixnum? t2)
                                (and (##fixnum? t1) (##fixnum.+? t2 t1))))
                      (+ t2 t1))))))

     which runs about 8 times faster than the previous beta version
     of Gambit and half as fast as when using the declarations
     (declare (standard-bindings) (fixnum) (not safe)) .

   - A problem with the configure script which prevented dynamic loading
     of object files on Mac OS X has been fixed.

   - A "web-repl" example has been added.  It is a Java applet that
     implements an interface to Gambit's REPL (i.e. you can interact
     with the Gambit interpreter using a web browser).

   - The implementation of the C-interface has been improved to allow
     "struct", "union", and "class" (in C++) C types to be passed
     between Scheme and C.  The C-interface documentation has been
     updated to explain this feature.  An example is attached below.

Marc


; C-interface example.

(c-declare #<<c-declare-end

#include <stdio.h>

struct coord2d { int x; int y; };

struct coord2d make_coord2d (int x, int y)
{
  struct coord2d c;

  c.x = x;
  c.y = y;

  return c;
}

int coord2d_x (struct coord2d p) { return p.x; }
int coord2d_y (struct coord2d p) { return p.y; }

___SCMOBJ release_struct_coord2d (void *ptr)
{
  printf ("deleting struct coord2d at %p\n", ptr);
  ___DELETE_STRUCT(coord2d,ptr); /* in C++ expands to                     */
                                 /*   delete ___CAST(struct coord2d*,ptr) */
                                 /* in C expands to "___free_mem(ptr)"    */
  return ___FIX(___NO_ERR);
}

struct coord2d (*callback) (char *, struct coord2d) = NULL;

void set_callback (struct coord2d (*c) (char *, struct coord2d))
{
  ___EXT(___addref_function) (___CAST(void*,c));
    /* needed because a reference to the parameter c survives the */
    /* activation of the function set_callback                    */

  ___EXT(___release_function) (___CAST(void*,callback));
    /* the reference to the old callback is no longer active */

  callback = c;

  printf ("callback = %p\n", callback);
}

char *context = NULL;

void set_context (char *s)
{
  struct coord2d foo, ret;

  ___EXT(___addref_string) (___CAST(void*,s));
    /* needed because a reference to the parameter s survives the */
    /* activation of the function set_callback                    */

  ___EXT(___release_string) (___CAST(void*,context));
    /* the reference to the old context is no longer active */

  context = s;

  printf ("context = %s\n", context);

  foo.x = 33;
  foo.y = 44;

  ret = callback (context, foo);

  printf ("ret.x = %d  ret.y = %d\n", ret.x, ret.y);
}

c-declare-end
)

(c-define-type coord2d
  (struct "coord2d" struct-coord2d "release_struct_coord2d"))

; note: had the simpler definition (c-define-type coord2d (struct "coord2d"))
; been used, the tag would have been |struct coord2d| and a default
; release function which calls ___DELETE_STRUCT(coord2d,p) would have
; been used.

(define make-coord2d (c-lambda (int int) coord2d "make_coord2d"))
(define coord2d-x (c-lambda (coord2d) int "coord2d_x"))
(define coord2d-y (c-lambda (coord2d) int "coord2d_y"))

(define p (make-coord2d 11 22))

(pp (list p (coord2d-x p) (coord2d-y p)))

(pp (foreign-released? p))

(foreign-release! p) ; note: if the foreign object is not explicitly
                     ; released with a call to foreign-release!, the
                     ; runtime system will call the release function
                     ; when the program terminates

(pp (foreign-released? p))

(pp (list p))

(c-define (f s c) (char-string coord2d) coord2d "f" ""
  (pp (list 'in f 's= s 'c= c (coord2d-x c) (coord2d-y c)))
  (make-coord2d (* (coord2d-x c) 10) (* (coord2d-y c) 100)))

(define set-callback
  (c-lambda ((function (char-string coord2d) coord2d)) void "set_callback"))

(set-callback f) ; passing a c-define'd procedure is supported on all platforms

'
(let ((z (cons 1 2)))
  (set-callback (lambda (x y) (pp (list x y z))))) ; passing other procedures
                                                   ; (predefined procedures,
                                                   ; closures, etc) only works
                                                   ; on some platforms

(define set-context (c-lambda (char-string) void "set_context"))

(set-context "hello")
(set-context "world")

(display "triggering a garbage collection...\n")

(##gc)

(display "program is terminating...\n")

; This program's output is:
;
;  (#<struct-coord2d #2 0x501660> 11 22)
;  #f
;  deleting struct coord2d at 0x501660
;  #t
;  (#<struct-coord2d #2 0x0>)
;  callback = 0x502ba0
;  context = hello
;  (in #<procedure #3 f> s= "hello" c= #<struct-coord2d #4 0x501660> 33 44)
;  ret.x = 330  ret.y = 4400
;  context = world
;  (in #<procedure #3 f> s= "world" c= #<struct-coord2d #5 0x502D30> 33 44)
;  ret.x = 330  ret.y = 4400
;  triggering a garbage collection...
;  deleting struct coord2d at 0x502d70
;  deleting struct coord2d at 0x501670
;  program is terminating...
;  deleting struct coord2d at 0x502d30
;  deleting struct coord2d at 0x501660


More information about the Gambit-list mailing list