mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 20:30:28 +02:00
Various RTL VM and calling convention tweaks
* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE): Allow for five-word instructions, and for new instruction word types. * libguile/vm-engine.c (RETURN_ONE_VALUE): Instead of returning the value in the fixed part of the call frame, return it in the same place multiple-value returns go: from slot 1. (BR_ARITHMETIC): Allow arithmetic tests to be negated. (rtl_vm_engine): Change calling convention to use the same location for single and multiple-value returns. Renumber all instructions. (halt, halt/values): Fold into a single instruction (halt). (call): Take the location of the procedure instead of the location of the call frame. Also take the number of args, and reset the sp before jumping to the procedure, so as to indicate the number of arguments. (call/values): Remove, as the new calling convention has RA == MVRA. (tail-call): Require the procedure to be shuffled down already, and take "nlocals" as an arg instead of "nargs". (receive, receive-values): New instructions, for receiving returned values from calls. (return-values): Rename from return/values. Remove "values". (alloc-frame): Rename from reserve-locals. (reset-frame): New instruction. (drop-locals): Remove. (br-if-=, br-if-<, br-if-<=): Allow these instructions to be negatable. (br-if->, br-if->=): Remove. Probably a bad idea, given NaN. (box-ref): Don't bother trying to do a reverse lookup -- the toplevel-box, module-box, and resolve instructions should handle that. (resolve): Add arg to check that the variable is bound. (toplevel-box, module-box): New instructions, replacing toplevel-ref, toplevel-set, module-ref, and module-set. * libguile/vm.c (rtl_boot_continuation_code, rtl_values_code): Adapt to instruction set changes. * module/Makefile.am: Make the assembler and disassembler dependent on vm-operations.h. * module/system/vm/assembler.scm: * module/system/vm/disassembler.scm: Adapt to instruction changes and new instruction word kinds. * test-suite/tests/rtl.test: Adapt to instruction set changes.
This commit is contained in:
parent
99983d544a
commit
af95414f1d
7 changed files with 373 additions and 559 deletions
|
@ -67,7 +67,9 @@ SCM_SYMBOL (sym_bang, "!");
|
||||||
M(X8_U12_U12) \
|
M(X8_U12_U12) \
|
||||||
M(X8_L24) \
|
M(X8_L24) \
|
||||||
M(B1_X7_L24) \
|
M(B1_X7_L24) \
|
||||||
M(B1_U7_L24)
|
M(B1_U7_L24) \
|
||||||
|
M(B1_X7_U24) \
|
||||||
|
M(B1_X31)
|
||||||
|
|
||||||
#define TYPE_WIDTH 5
|
#define TYPE_WIDTH 5
|
||||||
|
|
||||||
|
@ -105,6 +107,8 @@ static SCM word_type_symbols[] =
|
||||||
(OP (0, type0) | OP (1, type1) | OP (2, type2))
|
(OP (0, type0) | OP (1, type1) | OP (2, type2))
|
||||||
#define OP4(type0, type1, type2, type3) \
|
#define OP4(type0, type1, type2, type3) \
|
||||||
(OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3))
|
(OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3))
|
||||||
|
#define OP5(type0, type1, type2, type3, type4) \
|
||||||
|
(OP (0, type0) | OP (1, type1) | OP (2, type2) | OP (3, type3) | OP (4, type4))
|
||||||
|
|
||||||
#define OP_DST (1 << (TYPE_WIDTH * 5))
|
#define OP_DST (1 << (TYPE_WIDTH * 5))
|
||||||
|
|
||||||
|
@ -254,7 +258,9 @@ SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0,
|
||||||
|
|
||||||
/* Format: (name opcode word0 word1 ...) */
|
/* Format: (name opcode word0 word1 ...) */
|
||||||
|
|
||||||
if (WORD_TYPE (3, meta))
|
if (WORD_TYPE (4, meta))
|
||||||
|
len = 5;
|
||||||
|
else if (WORD_TYPE (3, meta))
|
||||||
len = 4;
|
len = 4;
|
||||||
else if (WORD_TYPE (2, meta))
|
else if (WORD_TYPE (2, meta))
|
||||||
len = 3;
|
len = 3;
|
||||||
|
@ -267,6 +273,8 @@ SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0,
|
||||||
|
|
||||||
switch (len)
|
switch (len)
|
||||||
{
|
{
|
||||||
|
case 5:
|
||||||
|
tail = scm_cons (word_type_symbols[WORD_TYPE (4, meta)], tail);
|
||||||
case 4:
|
case 4:
|
||||||
tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail);
|
tail = scm_cons (word_type_symbols[WORD_TYPE (3, meta)], tail);
|
||||||
case 3:
|
case 3:
|
||||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -599,22 +599,15 @@ static SCM rtl_apply;
|
||||||
static SCM rtl_values;
|
static SCM rtl_values;
|
||||||
|
|
||||||
static const scm_t_uint32 rtl_boot_continuation_code[] = {
|
static const scm_t_uint32 rtl_boot_continuation_code[] = {
|
||||||
SCM_PACK_RTL_24 (scm_rtl_op_halt_values, 0),
|
|
||||||
SCM_PACK_RTL_24 (scm_rtl_op_halt, 0)
|
SCM_PACK_RTL_24 (scm_rtl_op_halt, 0)
|
||||||
};
|
};
|
||||||
|
|
||||||
static scm_t_uint32* rtl_boot_multiple_value_continuation_code =
|
|
||||||
(scm_t_uint32 *) rtl_boot_continuation_code;
|
|
||||||
|
|
||||||
static scm_t_uint32* rtl_boot_single_value_continuation_code =
|
|
||||||
(scm_t_uint32 *) rtl_boot_continuation_code + 1;
|
|
||||||
|
|
||||||
static const scm_t_uint32 rtl_apply_code[] = {
|
static const scm_t_uint32 rtl_apply_code[] = {
|
||||||
SCM_PACK_RTL_24 (scm_rtl_op_apply, 0) /* proc in r1, args from r2, nargs set */
|
SCM_PACK_RTL_24 (scm_rtl_op_apply, 0) /* proc in r1, args from r2, nargs set */
|
||||||
};
|
};
|
||||||
|
|
||||||
static const scm_t_uint32 rtl_values_code[] = {
|
static const scm_t_uint32 rtl_values_code[] = {
|
||||||
SCM_PACK_RTL_24 (scm_rtl_op_values, 0) /* vals from r1 */
|
SCM_PACK_RTL_24 (scm_rtl_op_return_values, 0) /* vals from r1 */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -32,6 +32,9 @@ nobase_ccache_DATA += ice-9/eval.go
|
||||||
EXTRA_DIST += ice-9/eval.scm
|
EXTRA_DIST += ice-9/eval.scm
|
||||||
ETAGS_ARGS += ice-9/eval.scm
|
ETAGS_ARGS += ice-9/eval.scm
|
||||||
|
|
||||||
|
VM_TARGETS := system/vm/assembler.go system/vm/disassembler.go
|
||||||
|
$(VM_TARGETS): $(top_builddir)/libguile/vm-operations.h
|
||||||
|
|
||||||
ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm
|
ice-9/boot-9.go: ice-9/boot-9.scm ice-9/quasisyntax.scm ice-9/r6rs-libraries.scm
|
||||||
|
|
||||||
# We can compile these in any order, but it's fastest if we compile
|
# We can compile these in any order, but it's fastest if we compile
|
||||||
|
|
|
@ -410,7 +410,11 @@ later by the linker."
|
||||||
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
|
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
|
||||||
((B1_U7_L24 a b label)
|
((B1_U7_L24 a b label)
|
||||||
(record-label-reference asm label)
|
(record-label-reference asm label)
|
||||||
(emit asm (pack-u1-u7-u24 (if a 1 0) b 0)))))
|
(emit asm (pack-u1-u7-u24 (if a 1 0) b 0)))
|
||||||
|
((B1_X31 a)
|
||||||
|
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
|
||||||
|
((B1_X7_U24 a b)
|
||||||
|
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 b)))))
|
||||||
|
|
||||||
(syntax-case x ()
|
(syntax-case x ()
|
||||||
((_ name opcode word0 word* ...)
|
((_ name opcode word0 word* ...)
|
||||||
|
@ -675,12 +679,12 @@ returned instead."
|
||||||
(cond
|
(cond
|
||||||
(alternate
|
(alternate
|
||||||
(emit-br-if-nargs-ne asm nreq alternate)
|
(emit-br-if-nargs-ne asm nreq alternate)
|
||||||
(emit-reserve-locals asm nlocals))
|
(emit-alloc-frame asm nlocals))
|
||||||
((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12)))
|
((and (< nreq (ash 1 12)) (< (- nlocals nreq) (ash 1 12)))
|
||||||
(emit-assert-nargs-ee/locals asm nreq (- nlocals nreq)))
|
(emit-assert-nargs-ee/locals asm nreq (- nlocals nreq)))
|
||||||
(else
|
(else
|
||||||
(emit-assert-nargs-ee asm nreq)
|
(emit-assert-nargs-ee asm nreq)
|
||||||
(emit-reserve-locals asm nlocals))))
|
(emit-alloc-frame asm nlocals))))
|
||||||
|
|
||||||
(define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate)
|
(define-macro-assembler (opt-prelude asm nreq nopt rest? nlocals alternate)
|
||||||
(if alternate
|
(if alternate
|
||||||
|
@ -693,7 +697,7 @@ returned instead."
|
||||||
(emit-br-if-nargs-gt asm (+ nreq nopt) alternate))
|
(emit-br-if-nargs-gt asm (+ nreq nopt) alternate))
|
||||||
(else
|
(else
|
||||||
(emit-assert-nargs-le asm (+ nreq nopt))))
|
(emit-assert-nargs-le asm (+ nreq nopt))))
|
||||||
(emit-reserve-locals asm nlocals))
|
(emit-alloc-frame asm nlocals))
|
||||||
|
|
||||||
(define-macro-assembler (kw-prelude asm nreq nopt rest? kw-indices
|
(define-macro-assembler (kw-prelude asm nreq nopt rest? kw-indices
|
||||||
allow-other-keys? nlocals alternate)
|
allow-other-keys? nlocals alternate)
|
||||||
|
@ -711,41 +715,27 @@ returned instead."
|
||||||
(+ nreq nopt)
|
(+ nreq nopt)
|
||||||
ntotal
|
ntotal
|
||||||
kw-indices)
|
kw-indices)
|
||||||
(emit-reserve-locals asm nlocals)))
|
(emit-alloc-frame asm nlocals)))
|
||||||
|
|
||||||
(define-macro-assembler (label asm sym)
|
(define-macro-assembler (label asm sym)
|
||||||
(set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm))))
|
(set-asm-labels! asm (acons sym (asm-start asm) (asm-labels asm))))
|
||||||
|
|
||||||
(define-macro-assembler (cache-current-module! asm tmp scope)
|
(define-macro-assembler (cache-current-module! asm module scope)
|
||||||
(let ((mod-label (intern-module-cache-cell asm scope)))
|
(let ((mod-label (intern-module-cache-cell asm scope)))
|
||||||
(emit-current-module asm tmp)
|
(emit-static-set! asm module mod-label 0)))
|
||||||
(emit-static-set! asm tmp mod-label 0)))
|
|
||||||
|
|
||||||
(define-macro-assembler (cached-toplevel-ref asm dst scope sym)
|
(define-macro-assembler (cached-toplevel-box asm dst scope sym bound?)
|
||||||
(let ((sym-label (intern-non-immediate asm sym))
|
(let ((sym-label (intern-non-immediate asm sym))
|
||||||
(mod-label (intern-module-cache-cell asm scope))
|
(mod-label (intern-module-cache-cell asm scope))
|
||||||
(cell-label (intern-cache-cell asm scope sym)))
|
(cell-label (intern-cache-cell asm scope sym)))
|
||||||
(emit-toplevel-ref asm dst cell-label mod-label sym-label)))
|
(emit-toplevel-box asm dst cell-label mod-label sym-label bound?)))
|
||||||
|
|
||||||
(define-macro-assembler (cached-toplevel-set! asm src scope sym)
|
(define-macro-assembler (cached-module-box asm dst module-name sym public? bound?)
|
||||||
(let ((sym-label (intern-non-immediate asm sym))
|
|
||||||
(mod-label (intern-module-cache-cell asm scope))
|
|
||||||
(cell-label (intern-cache-cell asm scope sym)))
|
|
||||||
(emit-toplevel-set! asm src cell-label mod-label sym-label)))
|
|
||||||
|
|
||||||
(define-macro-assembler (cached-module-ref asm dst module-name public? sym)
|
|
||||||
(let* ((sym-label (intern-non-immediate asm sym))
|
(let* ((sym-label (intern-non-immediate asm sym))
|
||||||
(key (cons public? module-name))
|
(key (cons public? module-name))
|
||||||
(mod-name-label (intern-constant asm key))
|
(mod-name-label (intern-constant asm key))
|
||||||
(cell-label (intern-cache-cell asm key sym)))
|
(cell-label (intern-cache-cell asm key sym)))
|
||||||
(emit-module-ref asm dst cell-label mod-name-label sym-label)))
|
(emit-module-box asm dst cell-label mod-name-label sym-label bound?)))
|
||||||
|
|
||||||
(define-macro-assembler (cached-module-set! asm src module-name public? sym)
|
|
||||||
(let* ((sym-label (intern-non-immediate asm sym))
|
|
||||||
(key (cons public? module-name))
|
|
||||||
(mod-name-label (intern-non-immediate asm key))
|
|
||||||
(cell-label (intern-cache-cell asm key sym)))
|
|
||||||
(emit-module-set! asm src cell-label mod-name-label sym-label)))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -145,6 +145,11 @@
|
||||||
#'((not (zero? (logand word #x1)))
|
#'((not (zero? (logand word #x1)))
|
||||||
(logand (ash word -1) #x7f)
|
(logand (ash word -1) #x7f)
|
||||||
(unpack-s24 (ash word -8))))
|
(unpack-s24 (ash word -8))))
|
||||||
|
((B1_X31)
|
||||||
|
#'((not (zero? (logand word #x1)))))
|
||||||
|
((B1_X7_U24)
|
||||||
|
#'((not (zero? (logand word #x1)))
|
||||||
|
(ash word -8)))
|
||||||
(else
|
(else
|
||||||
(error "bad kind" type)))))
|
(error "bad kind" type)))))
|
||||||
|
|
||||||
|
@ -244,12 +249,14 @@ address of that offset."
|
||||||
addr)))
|
addr)))
|
||||||
(('resolve-module dst name public)
|
(('resolve-module dst name public)
|
||||||
(list "~a" (if (zero? public) "private" "public")))
|
(list "~a" (if (zero? public) "private" "public")))
|
||||||
(((or 'toplevel-ref 'toplevel-set!) _ var-offset mod-offset sym-offset)
|
(('toplevel-box _ var-offset mod-offset sym-offset bound?)
|
||||||
(list "`~A'" (dereference-scm sym-offset)))
|
(list "`~A'~A" (dereference-scm sym-offset)
|
||||||
(((or 'module-ref 'module-set!) _ var-offset mod-name-offset sym-offset)
|
(if bound? "" " (maybe unbound)")))
|
||||||
|
(('module-box _ var-offset mod-name-offset sym-offset bound?)
|
||||||
(let ((mod-name (reference-scm mod-name-offset)))
|
(let ((mod-name (reference-scm mod-name-offset)))
|
||||||
(list "`(~A ~A ~A)'" (if (car mod-name) '@ '@@) (cdr mod-name)
|
(list "`(~A ~A ~A)'~A" (if (car mod-name) '@ '@@) (cdr mod-name)
|
||||||
(dereference-scm sym-offset))))
|
(dereference-scm sym-offset)
|
||||||
|
(if bound? "" " (maybe unbound)"))))
|
||||||
(('load-typed-array dst type shape target len)
|
(('load-typed-array dst type shape target len)
|
||||||
(let ((addr (u32-offset->addr (+ offset target) context)))
|
(let ((addr (u32-offset->addr (+ offset target) context)))
|
||||||
(list "~a bytes from #x~X" len addr)))
|
(list "~a bytes from #x~X" len addr)))
|
||||||
|
|
|
@ -92,7 +92,7 @@
|
||||||
(begin-standard-arity (x) 4 #f)
|
(begin-standard-arity (x) 4 #f)
|
||||||
(br fix-body)
|
(br fix-body)
|
||||||
(label loop-head)
|
(label loop-head)
|
||||||
(br-if-= 2 1 out)
|
(br-if-= 2 1 #f out)
|
||||||
(add 3 2 3)
|
(add 3 2 3)
|
||||||
(add1 2 2)
|
(add1 2 2)
|
||||||
(br loop-head)
|
(br loop-head)
|
||||||
|
@ -144,12 +144,11 @@
|
||||||
(assemble-program
|
(assemble-program
|
||||||
'((begin-program call
|
'((begin-program call
|
||||||
((name . call)))
|
((name . call)))
|
||||||
(begin-standard-arity (f) 2 #f)
|
(begin-standard-arity (f) 7 #f)
|
||||||
(push-frame 2 1)
|
|
||||||
(mov 5 1)
|
(mov 5 1)
|
||||||
(call 2)
|
(call 5 1)
|
||||||
(return 2) ;; MVRA from call
|
(receive 2 5 7)
|
||||||
(return 2) ;; RA from call
|
(return 2)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
(call (lambda () 42))))
|
(call (lambda () 42))))
|
||||||
|
@ -159,13 +158,12 @@
|
||||||
(assemble-program
|
(assemble-program
|
||||||
'((begin-program call-with-3
|
'((begin-program call-with-3
|
||||||
((name . call-with-3)))
|
((name . call-with-3)))
|
||||||
(begin-standard-arity (f) 3 #f)
|
(begin-standard-arity (f) 7 #f)
|
||||||
(push-frame 2 2)
|
|
||||||
(mov 5 1)
|
(mov 5 1)
|
||||||
(load-constant 6 3)
|
(load-constant 6 3)
|
||||||
(call 2)
|
(call 5 2)
|
||||||
(return 2) ;; MVRA from call
|
(receive 2 5 7)
|
||||||
(return 2) ;; RA from call
|
(return 2)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
(call-with-3 (lambda (x) (* x 2))))))
|
(call-with-3 (lambda (x) (* x 2))))))
|
||||||
|
@ -177,7 +175,8 @@
|
||||||
'((begin-program call
|
'((begin-program call
|
||||||
((name . call)))
|
((name . call)))
|
||||||
(begin-standard-arity (f) 2 #f)
|
(begin-standard-arity (f) 2 #f)
|
||||||
(tail-call 0 1)
|
(mov 0 1)
|
||||||
|
(tail-call 1)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
(call (lambda () 3))))
|
(call (lambda () 3))))
|
||||||
|
@ -187,10 +186,10 @@
|
||||||
(assemble-program
|
(assemble-program
|
||||||
'((begin-program call-with-3
|
'((begin-program call-with-3
|
||||||
((name . call-with-3)))
|
((name . call-with-3)))
|
||||||
(begin-standard-arity (f) 3 #f)
|
(begin-standard-arity (f) 2 #f)
|
||||||
(mov 2 1) ;; R1 <- R0
|
(mov 0 1) ;; R0 <- R1
|
||||||
(load-constant 1 3) ;; R0 <- 3
|
(load-constant 1 3) ;; R1 <- 3
|
||||||
(tail-call 1 2)
|
(tail-call 2)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
(call-with-3 (lambda (x) (* x 2))))))
|
(call-with-3 (lambda (x) (* x 2))))))
|
||||||
|
@ -202,6 +201,7 @@
|
||||||
'((begin-program get-sqrt-trampoline
|
'((begin-program get-sqrt-trampoline
|
||||||
((name . get-sqrt-trampoline)))
|
((name . get-sqrt-trampoline)))
|
||||||
(begin-standard-arity () 2 #f)
|
(begin-standard-arity () 2 #f)
|
||||||
|
(current-module 1)
|
||||||
(cache-current-module! 1 sqrt-scope)
|
(cache-current-module! 1 sqrt-scope)
|
||||||
(load-static-procedure 1 sqrt-trampoline)
|
(load-static-procedure 1 sqrt-trampoline)
|
||||||
(return 1)
|
(return 1)
|
||||||
|
@ -211,8 +211,9 @@
|
||||||
(begin-program sqrt-trampoline
|
(begin-program sqrt-trampoline
|
||||||
((name . sqrt-trampoline)))
|
((name . sqrt-trampoline)))
|
||||||
(begin-standard-arity (x) 3 #f)
|
(begin-standard-arity (x) 3 #f)
|
||||||
(cached-toplevel-ref 2 sqrt-scope sqrt)
|
(cached-toplevel-box 2 sqrt-scope sqrt #t)
|
||||||
(tail-call 1 2)
|
(box-ref 0 2)
|
||||||
|
(tail-call 2)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
((get-sqrt-trampoline) 25.0))))
|
((get-sqrt-trampoline) 25.0))))
|
||||||
|
@ -227,6 +228,7 @@
|
||||||
'((begin-program make-top-incrementor
|
'((begin-program make-top-incrementor
|
||||||
((name . make-top-incrementor)))
|
((name . make-top-incrementor)))
|
||||||
(begin-standard-arity () 2 #f)
|
(begin-standard-arity () 2 #f)
|
||||||
|
(current-module 1)
|
||||||
(cache-current-module! 1 top-incrementor)
|
(cache-current-module! 1 top-incrementor)
|
||||||
(load-static-procedure 1 top-incrementor)
|
(load-static-procedure 1 top-incrementor)
|
||||||
(return 1)
|
(return 1)
|
||||||
|
@ -235,11 +237,12 @@
|
||||||
|
|
||||||
(begin-program top-incrementor
|
(begin-program top-incrementor
|
||||||
((name . top-incrementor)))
|
((name . top-incrementor)))
|
||||||
(begin-standard-arity () 2 #f)
|
(begin-standard-arity () 3 #f)
|
||||||
(cached-toplevel-ref 1 top-incrementor *top-val*)
|
(cached-toplevel-box 1 top-incrementor *top-val* #t)
|
||||||
(add1 1 1)
|
(box-ref 2 1)
|
||||||
(cached-toplevel-set! 1 top-incrementor *top-val*)
|
(add1 2 2)
|
||||||
(return/values 1)
|
(box-set! 1 2)
|
||||||
|
(return-values 0)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
((make-top-incrementor))
|
((make-top-incrementor))
|
||||||
|
@ -260,8 +263,9 @@
|
||||||
(begin-program sqrt-trampoline
|
(begin-program sqrt-trampoline
|
||||||
((name . sqrt-trampoline)))
|
((name . sqrt-trampoline)))
|
||||||
(begin-standard-arity (x) 3 #f)
|
(begin-standard-arity (x) 3 #f)
|
||||||
(cached-module-ref 2 (guile) #t sqrt)
|
(cached-module-box 2 (guile) sqrt #t #t)
|
||||||
(tail-call 1 2)
|
(box-ref 0 2)
|
||||||
|
(tail-call 2)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
((get-sqrt-trampoline) 25.0))))
|
((get-sqrt-trampoline) 25.0))))
|
||||||
|
@ -281,11 +285,12 @@
|
||||||
|
|
||||||
(begin-program top-incrementor
|
(begin-program top-incrementor
|
||||||
((name . top-incrementor)))
|
((name . top-incrementor)))
|
||||||
(begin-standard-arity () 2 #f)
|
(begin-standard-arity () 3 #f)
|
||||||
(cached-module-ref 1 (tests rtl) #f *top-val*)
|
(cached-module-box 1 (tests rtl) *top-val* #f #t)
|
||||||
(add1 1 1)
|
(box-ref 2 1)
|
||||||
(cached-module-set! 1 (tests rtl) #f *top-val*)
|
(add1 2 2)
|
||||||
(return 1)
|
(box-set! 1 2)
|
||||||
|
(return 2)
|
||||||
(end-arity)
|
(end-arity)
|
||||||
(end-program)))))
|
(end-program)))))
|
||||||
((make-top-incrementor))
|
((make-top-incrementor))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue