Date: Fri, 25 Jun 93 13:31:50 -0400
From: Jonathan Rees <jar@zurich.ai.mit.edu>
To: sheldon@lcs.mit.edu
Cc: jar@zurich.ai.mit.edu
Subject: call-back
Message-Id:  <9306251331.aa11673@mintaka.lcs.mit.edu>


Hmm... I think the convention is:

    1. Scheme calls C (e.g. the rpc server) as usual using EXTERNAL-CALL.
    2. C calls the VM's entry point restart(value).
    3. That causes the original Scheme code to think that your C function
       has returned value, when in fact it hasn't.
    4. If Scheme later executes a VM-RETURN instruction, then
       the C call to restart() will return with the specified value.
 
So you need to write some Scheme code that looks vaguely like this:

    (let ((communication-block (make-vector 100)))
      (let loop ((status (external-call rpc-server communication-block)))
        (if status    ;Boolean
	    (begin (store-somewhere-in-communication-block!
		     (apply (choose-a-procedure ...)
			    (extract-some-arguments ...)))
		   ;; communication-block might be moved by GC; give new
		   ;; address back to C
	           (loop (vm-return 0 communication-block))))))

The procedure, number of arguments, and the arguments themselves must
be encoded in the argument block somehow.  You must not put Scheme
values (including the argument block) in C variables that are live
across calls to the VM.  Therefore the procedures have to numbered
(stored in a vector, say) or something.

Apparently the first argument to VM-RETURN is ignored.

    (define-primitive op/vm-return (fixnum-> any->)  ;from vm/prim.scm
      (lambda (key value)
	(set! *val* value)
        ;; TTreturn_value = 0;
        ;; return(0L);}
	return-option/exit))            ; the VM returns this value

The relevant code from scheme48vm.c (actually, the source from
vm/resume.scm):

    long restart(long value)
    {
      (set! *val* value)
      (let loop ()
	(let ((option (interpret)))
	   ;; option_880X = TTrun_machine((long)Tinterpret);
	  (cond ((= option return-option/exit)
		 *val*)
		((= option return-option/external-call)
		 (set! *val* (call-external-value  ; type inference hack
			      (fetch (address-after-header
				       (external-value *val*)))
			      *nargs*
			      (pointer-to-top-of-stack)))
		 (stack-add (- 0 (+ *nargs* 1)))  ; remove proc and args
		 (loop))
		(else
		 (error "unkown VM return option" option)
		 -1))))
    }


The relevant code from unix.c:

    call_external_value( long proc, long nargs, long *args )
    {
      return ((long(*)())proc)(nargs, args);
    }

    /* Driver loop for tail-recursive calls */

    long TTreturn_value;

    long TTrun_machine(proc)
	 long (*proc) (void);
    {
      while (proc != 0)
	proc = (long (*) (void)) (*proc)();
      return TTreturn_value;
    }