diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/Makefile.am | 3 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 40 | ||||
-rw-r--r-- | module/system/vm/disassembler.scm | 17 |
3 files changed, 30 insertions, 30 deletions
diff --git a/module/Makefile.am b/module/Makefile.am index 495d228af..6d3b31f2d 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -32,6 +32,9 @@ nobase_ccache_DATA += ice-9/eval.go EXTRA_DIST += 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 # We can compile these in any order, but it's fastest if we compile 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?))) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 3b95f196b..b339b5cbe 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -145,6 +145,11 @@ #'((not (zero? (logand word #x1))) (logand (ash word -1) #x7f) (unpack-s24 (ash word -8)))) + ((B1_X31) + #'((not (zero? (logand word #x1))))) + ((B1_X7_U24) + #'((not (zero? (logand word #x1))) + (ash word -8))) (else (error "bad kind" type))))) @@ -244,12 +249,14 @@ address of that offset." addr))) (('resolve-module dst name public) (list "~a" (if (zero? public) "private" "public"))) - (((or 'toplevel-ref 'toplevel-set!) _ var-offset mod-offset sym-offset) - (list "`~A'" (dereference-scm sym-offset))) - (((or 'module-ref 'module-set!) _ var-offset mod-name-offset sym-offset) + (('toplevel-box _ var-offset mod-offset sym-offset bound?) + (list "`~A'~A" (dereference-scm sym-offset) + (if bound? "" " (maybe unbound)"))) + (('module-box _ var-offset mod-name-offset sym-offset bound?) (let ((mod-name (reference-scm mod-name-offset))) - (list "`(~A ~A ~A)'" (if (car mod-name) '@ '@@) (cdr mod-name) - (dereference-scm sym-offset)))) + (list "`(~A ~A ~A)'~A" (if (car mod-name) '@ '@@) (cdr mod-name) + (dereference-scm sym-offset) + (if bound? "" " (maybe unbound)")))) (('load-typed-array dst type shape target len) (let ((addr (u32-offset->addr (+ offset target) context))) (list "~a bytes from #x~X" len addr))) |