Date: Fri, 25 Jun 93 13:31:50 -0400 From: Jonathan Rees To: sheldon@lcs.mit.edu Cc: jar@martigny.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; }