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 instructions have no rest args

Browse source 
* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE):
* module/system/vm/assembler.scm (assembler):
* module/system/vm/disassembler.scm (disassembler): Remove support for
  RTL instructions with rest args.
This commit is contained in:
Andy Wingo 2013-07-21 17:11:18 +02:00
parent 746065c92e
commit 78ff784784
3 changed files with 1 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/instructions.c
View file

@ -52,7 +52,6 @@ SCM_SYMBOL (sym_bang, "!");
M(U8_X24) \
M(U8_U24) \
M(U8_L24) \
M(U8_R24) \
M(U8_U8_I16) \
M(U8_U8_U8_U8) \
M(U8_U12_U12) \
@ -66,7 +65,6 @@ SCM_SYMBOL (sym_bang, "!");
M(LO32) /* Label with offset. */ \
M(X8_U24) \
M(X8_U12_U12) \
M(X8_R24) \
M(X8_L24) \
M(B1_X7_L24) \
M(B1_U7_L24)

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

@ -351,9 +351,6 @@ later by the linker."
((U8_L24 label)
(record-label-reference asm label)
(emit asm opcode))
((U8_R24 rest)
(emit asm (pack-u8-u24 opcode (list rest)))
(for-each (lambda (x) (emit asm x)) rest))
((U8_U8_I16 a imm)
(emit asm (pack-u8-u8-u16 opcode a (object-address imm))))
((U8_U12_U12 a b)
@ -369,9 +366,6 @@ later by the linker."
((U8_L24 a label)
(record-label-reference asm label)
(emit asm a))
((U8_R24 rest)
(emit asm (pack-u8-u24 a (length rest)))
(for-each (lambda (x) (emit asm x)) rest))
((U8_U8_I16 a b imm)
(emit asm (pack-u8-u8-u16 a b (object-address imm))))
((U8_U12_U12 a b)
@ -408,9 +402,6 @@ later by the linker."
(emit asm (pack-u8-u24 0 a)))
((X8_U12_U12 a b)
(emit asm (pack-u8-u12-u12 0 a b)))
((X8_R24 rest)
(emit asm (pack-u8-u24 0 (length rest)))
(for-each (lambda (x) (emit asm x)) rest))
((X8_L24 label)
(record-label-reference asm label)
(emit asm 0))

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

@ -78,8 +78,6 @@
#'((ash word -8)))
((U8_L24)
#'((unpack-s24 (ash word -8))))
((U8_R24)
#'(#:rest (ash word -8)))
((U8_U8_I16)
#'((logand (ash word -8) #xff)
(ash word -16)))
@ -104,9 +102,6 @@
((U8_L24)
#'((logand word #xff)
(unpack-s24 (ash word -8))))
((U8_R24)
#'((logand word #xff)
#:rest (ash word -8)))
((U8_U8_I16)
#'((logand word #xff)
(logand (ash word -8) #xff)
@ -141,8 +136,6 @@
((X8_U12_U12)
#'((logand (ash word -8) #xfff)
(ash word -20)))
((X8_R24)
#'(#:rest (ash word -8)))
((X8_L24)
#'((unpack-s24 (ash word -8))))
((B1_X7_L24)
@ -191,18 +184,7 @@
;; -> len list
(define (disassemble-one buf offset)
(let ((first (u32-ref buf offset)))
(call-with-values
(lambda ()
((vector-ref disassemblers (logand first #xff)) buf offset first))
(lambda (len list)
(match list
((head ... #:rest rest)
(let lp ((n 0) (rhead (reverse head)))
(if (= n rest)
(values (+ len n) (reverse rhead))
(lp (1+ n)
(cons (u32-ref buf (+ offset len n)) rhead)))))
(_ (values len list)))))))
((vector-ref disassemblers (logand first #xff)) buf offset first)))
(define (u32-offset->addr offset context)
"Given an offset into an image in 32-bit units, return the absolute