From be8b62ca7f66f6acd1d342cd8576688cc33baf1c Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Sat, 26 Oct 2013 15:16:09 +0200 Subject: RTL compiler: Compile TC7 branches. * module/system/vm/assembler.scm: * module/system/vm/disassembler.scm (code-annotation): * module/language/cps/primitives.scm (*branching-primcall-arities*): * module/language/cps/compile-rtl.scm (emit-rtl-sequence): Add support for compiling symbol?, variable?, vector?, and string? branches. --- module/system/vm/disassembler.scm | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'module/system/vm/disassembler.scm') diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index 09ca337bf..a9209234e 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -214,9 +214,19 @@ address of that offset." (((or 'br 'br-if-nargs-ne 'br-if-nargs-lt 'br-if-nargs-gt 'br-if-true 'br-if-null 'br-if-nil 'br-if-pair 'br-if-struct - 'br-if-char 'br-if-tc7 'br-if-eq 'br-if-eqv 'br-if-equal + 'br-if-char 'br-if-eq 'br-if-eqv 'br-if-equal 'br-if-= 'br-if-< 'br-if-<= 'br-if-> 'br-if->=) _ ... target) (list "-> ~A" (vector-ref labels (- (+ offset target) start)))) + (('br-if-tc7 slot invert? tc7 target) + (list "~A -> ~A" + (let ((tag (case tc7 + ((5) "symbol?") + ((7) "variable?") + ((13) "vector?") + ((15) "string?") + (else (number->string tc7))))) + (if invert? (string-append "not " tag) tag)) + (vector-ref labels (- (+ offset target) start)))) (('prompt tag escape-only? proc-slot handler) ;; The H is for handler. (list "H -> ~A" (vector-ref labels (- (+ offset handler) start)))) -- cgit v1.2.3