Make the garbage collector track the field at __FOREIGN_SIZE, if any.

I won't repeat what the point of this is. :)

I have checked that this minimal patch is enough to enable me to do the rest out of the Gambit source tree.  A self-contained usage example follows below (I have checked that the output is the expected one and the program is valgrind-clean.)  It's more complicated than the other ones but that's no problem at all for me as long as I can isolate users of my libraries from that complexity.

    (c-declare #<<c-declare-end

    typedef struct { int x; int y; } point;

    #define ___BEGIN_SFUN_DEPPOINTER_TO_SCMOBJ(c,s,i)___IF_CTOS3(___DEPPOINTER_to_SCMOBJ,(void*)c,&s,i){

    #define ___END_SFUN_DEPPOINTER_TO_SCMOBJ(c,s,i)___EXT(___release_scmobj)(s);}

    #define ___BEGIN_SFUN_SCMOBJ_TO_DEPPOINTER(s,c)___STOC4(___SCMOBJ_to_POINTER,s,&c,___FIELD(s,___FOREIGN_TAGS),___RETURN_POS);

    #define ___END_SFUN_SCMOBJ_TO_DEPPOINTER(s,c)

    #define ___BEGIN_CFUN_DEPPOINTER_TO_SCMOBJ(c,s)___IF_CTOS3(___DEPPOINTER_to_SCMOBJ,(void*)c,&s,___RETURN_POS){

    #define ___END_CFUN_DEPPOINTER_TO_SCMOBJ(c,s)___EXT(___release_scmobj)(s);}

    #define ___BEGIN_CFUN_SCMOBJ_TO_DEPPOINTER(s,c,i)___IF_STOC4(___SCMOBJ_to_POINTER,s,(void**)&c,___FIELD(s,___FOREIGN_TAGS),i){

    #define ___END_CFUN_SCMOBJ_TO_DEPPOINTER(s,c,i)}


    ___EXP_FUNC(___SCMOBJ,___DEPPOINTER_to_SCMOBJ)
       ___P((___processor_state ___ps,
             void *x,
             ___SCMOBJ *obj,
             int arg_num),
            (___ps,
             x,
             obj,
             arg_num)
    ___processor_state ___ps;
    void *x;
    ___SCMOBJ *obj;
    int arg_num;)
    {
      if (x == 0)
        *obj = ___FAL; /* #f counts as NULL */

        {
          ___SCMOBJ r = ___alloc_scmobj (___ps, ___sFOREIGN, (___FOREIGN_SIZE+1)<<___LWS);
          if (___FIXNUMP(r))
            {
              *obj = ___FAL;
              return ___FIX(___CTOS_HEAP_OVERFLOW_ERR+arg_num);
            }
          ___FIELD(r,___FOREIGN_TAGS) = ___FAL;
          ___FIELD(r,___FOREIGN_RELEASE_FN) = ___CAST(___SCMOBJ,___release_pointer);
          ___FIELD(r,___FOREIGN_PTR) = ___CAST(___SCMOBJ,x);
          ___FIELD(r,___FOREIGN_DEP) = ___NUL;
          *obj = r;
        }
      return ___FIX(___NO_ERR);
    }

    c-declare-end
    )

    (c-define-type point "point*" "DEPPOINTER_TO_SCMOBJ" "SCMOBJ_TO_DEPPOINTER" #f)

    ;XXX: make sure the tags are reachable.  The garbage collector will *NOT*
    ; scan the tags of a foreign object.
    (define tags '(point* point))

    (define (make-point)
      (let ((ret
              ((c-lambda () point
                "___result = ___EXT(___alloc_rc)(sizeof(point));"))))
        ((c-lambda (scheme-object scheme-object) void
                "___FIELD(___arg1,___FOREIGN_TAGS) = ___arg2;")
         ret
         tags)
        ; I could have set a release function similarly, but the default no-op one will be fine for most purposes.
        ret))

    (define p (make-point))

    (define foreign-dependencies
      ;XXX type checking
      (c-lambda (scheme-object) scheme-object
        "___result = ___FIELD(___arg1,___FOREIGN_DEP);"))

    (define (register-foreign-dependency! f o)
      ;XXX type checking
      ((c-lambda (scheme-object scheme-object) void
         "___FIELD(___arg1,___FOREIGN_DEP) = ___arg2;")
       f
       (cons o (foreign-dependencies f))))

    (print "p is a: ")
    (write p)
    (newline)
    (println "p has tags: ")
    (write (foreign-tags p))
    (newline)

    (define p-x
      (c-lambda (point)
                 int
         "___result = ((point*)___arg1)->x;"))

    (define p-y
      (c-lambda (point)
                 int
         "___result = ((point*)___arg1)->y;"))

    (define p-x-set!
      (c-lambda (point int) void
         "((point*)___arg1)->x = ___arg2;"))

    (define p-y-set!
      (c-lambda (point int) void
         "((point*)___arg1)->y = ___arg2;"))

    (p-x-set! p 3)
    (p-y-set! p 5)
    (println "p.x: " (p-x p) "; p.y: " (p-y p))
    (define o (list 1 2))
    (make-will o (lambda (x) (println "o checking out!")))
    (println "initial dependencies are:")
    (write (foreign-dependencies p))
    (newline)
    (register-foreign-dependency! p o)
    (println "dependencies are now:")
    (write (foreign-dependencies p))
    (newline)
    (println "losing global reference to o")
    (set! o #f)
    (##gc)
    (##gc)
    (##gc)
    (println "killing p")
    (set! p #f)
    (##gc)
    (println "done!")