summaryrefslogtreecommitdiff
path: root/module/system/vm/assembler.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2013-08-11 16:42:06 +0200
committerAndy Wingo <wingo@pobox.com>2013-08-11 16:45:31 +0200
commitaf95414f1dcbacf7fd5311a3ee89a799b20fd17b (patch)
tree5810d5e2948259839704216a2d8b05eb0a251e26 /module/system/vm/assembler.scm
parent99983d544a931c29065ecb749acd349efc5f36c5 (diff)
downloadguile-af95414f1dcbacf7fd5311a3ee89a799b20fd17b.tar.gz
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.
Diffstat (limited to 'module/system/vm/assembler.scm')
-rw-r--r--module/system/vm/assembler.scm40
1 files changed, 15 insertions, 25 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 1eea3c05d..2c46c3b69 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -410,7 +410,11 @@ later by the linker."
(emit asm (pack-u1-u7-u24 (if a 1 0) 0 0)))
((B1_U7_L24 a b 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 ()
((_ name opcode word0 word* ...)
@@ -675,12 +679,12 @@ returned instead."
(cond
(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)))
(emit-assert-nargs-ee/locals asm nreq (- nlocals nreq)))
(else
(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)
(if alternate
@@ -693,7 +697,7 @@ returned instead."
(emit-br-if-nargs-gt asm (+ nreq nopt) alternate))
(else
(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
allow-other-keys? nlocals alternate)
@@ -711,41 +715,27 @@ returned instead."
(+ nreq nopt)
ntotal
kw-indices)
- (emit-reserve-locals asm nlocals)))
+ (emit-alloc-frame asm nlocals)))
(define-macro-assembler (label asm sym)
(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)))
- (emit-current-module asm tmp)
- (emit-static-set! asm tmp mod-label 0)))
-
-(define-macro-assembler (cached-toplevel-ref asm dst scope sym)
- (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-ref asm dst cell-label mod-label sym-label)))
+ (emit-static-set! asm module mod-label 0)))
-(define-macro-assembler (cached-toplevel-set! asm src scope sym)
+(define-macro-assembler (cached-toplevel-box asm dst scope sym 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)))
+ (emit-toplevel-box asm dst cell-label mod-label sym-label bound?)))
-(define-macro-assembler (cached-module-ref asm dst module-name public? sym)
+(define-macro-assembler (cached-module-box asm dst module-name sym public? bound?)
(let* ((sym-label (intern-non-immediate asm sym))
(key (cons public? module-name))
(mod-name-label (intern-constant asm key))
(cell-label (intern-cache-cell asm key sym)))
- (emit-module-ref asm dst cell-label mod-name-label sym-label)))
-
-(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)))
+ (emit-module-box asm dst cell-label mod-name-label sym-label bound?)))