diff options
author | Andy Wingo <wingo@pobox.com> | 2013-07-19 09:55:20 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-07-21 17:12:22 +0200 |
commit | 2a294c7cd3c27dd3159da840df3d004da4fc4094 (patch) | |
tree | bde36cabdb5b727cf2fd7d3b5eabbf429c600b14 | |
parent | ee0a2b5135d78203a65ddf3247a74e0014f9d48f (diff) | |
download | guile-2a294c7cd3c27dd3159da840df3d004da4fc4094.tar.gz |
rtl: propagate OP_DST to scheme
* libguile/instructions.c (scm_rtl_instruction_list): Add an element to
the list to indicate that an instruction outputs to its first
argument.
* module/system/vm/assembler.scm:
* module/system/vm/disassembler.scm: Adapt.
-rw-r--r-- | libguile/instructions.c | 5 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 2 | ||||
-rw-r--r-- | module/system/vm/disassembler.scm | 2 |
3 files changed, 7 insertions, 2 deletions
diff --git a/libguile/instructions.c b/libguile/instructions.c index 9e8ccb49e..9bb50f4b4 100644 --- a/libguile/instructions.c +++ b/libguile/instructions.c @@ -41,6 +41,10 @@ struct scm_instruction { }; +SCM_SYMBOL (sym_left_arrow, "<-"); +SCM_SYMBOL (sym_bang, "!"); + + #define OP_HAS_ARITY (1U << 0) #define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \ @@ -274,6 +278,7 @@ SCM_DEFINE (scm_rtl_instruction_list, "rtl-instruction-list", 0, 0, 0, case 1: tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail); default: + tail = scm_cons ((meta & OP_DST) ? sym_left_arrow : sym_bang, tail); tail = scm_cons (scm_from_int (ip[i].opcode), tail); tail = scm_cons (ip[i].symname, tail); break; diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 556f58920..ad65be48a 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -443,7 +443,7 @@ later by the linker." (define-syntax define-assembler (lambda (x) (syntax-case x () - ((_ name opcode arg ...) + ((_ name opcode kind arg ...) (with-syntax ((emit (id-append #'name #'emit- #'name))) #'(define emit (let ((emit (assembler name opcode arg ...))) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index b815c1e2a..1c6a0976c 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -181,7 +181,7 @@ (define-syntax define-disassembler (lambda (x) (syntax-case x () - ((_ name opcode arg ...) + ((_ name opcode kind arg ...) (with-syntax ((parse (id-append #'name #'parse- #'name))) #'(let ((parse (disassembler name opcode arg ...))) (vector-set! disassemblers opcode parse))))))) |