mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

rtl: propagate OP_DST to scheme

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2013-07-19 09:55:20 +02:00
parent ee0a2b5135
commit 2a294c7cd3
3 changed files with 7 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/instructions.c
View file

@ -41,6 +41,10 @@ struct scm_instruction {
}; };
SCM_SYMBOL (sym_left_arrow, "<-");
SCM_SYMBOL (sym_bang, "!");
#define OP_HAS_ARITY (1U << 0) #define OP_HAS_ARITY (1U << 0)
#define FOR_EACH_INSTRUCTION_WORD_TYPE(M) \ #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: case 1:
tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail); tail = scm_cons (word_type_symbols[WORD_TYPE (0, meta)], tail);
default: 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 (scm_from_int (ip[i].opcode), tail);
tail = scm_cons (ip[i].symname, tail); tail = scm_cons (ip[i].symname, tail);
break; break;

2
module/system/vm/assembler.scm
View file

@ -443,7 +443,7 @@ later by the linker."
(define-syntax define-assembler (define-syntax define-assembler
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ name opcode arg ...) ((_ name opcode kind arg ...)
(with-syntax ((emit (id-append #'name #'emit- #'name))) (with-syntax ((emit (id-append #'name #'emit- #'name)))
#'(define emit #'(define emit
(let ((emit (assembler name opcode arg ...))) (let ((emit (assembler name opcode arg ...)))

2
module/system/vm/disassembler.scm
View file

@ -181,7 +181,7 @@
(define-syntax define-disassembler (define-syntax define-disassembler
(lambda (x) (lambda (x)
(syntax-case x () (syntax-case x ()
((_ name opcode arg ...) ((_ name opcode kind arg ...)
(with-syntax ((parse (id-append #'name #'parse- #'name))) (with-syntax ((parse (id-append #'name #'parse- #'name)))
#'(let ((parse (disassembler name opcode arg ...))) #'(let ((parse (disassembler name opcode arg ...)))
(vector-set! disassemblers opcode parse))))))) (vector-set! disassemblers opcode parse)))))))