88 lines
2.7 KiB
Plaintext
88 lines
2.7 KiB
Plaintext
|
Date: Fri, 25 Jun 93 13:31:50 -0400
|
||
|
|
From: Jonathan Rees <jar@martigny.ai.mit.edu>
|
||
|
|
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;
|
||
|
|
}
|