1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00

Prepare for SP-addressed locals

* libguile/vm-engine.c: Renumber opcodes, and take the opportunity to
  fold recent additions into more logical places.  Be more precise when
  describing the encoding of operands, to shuffle local references only
  and not constants, immediates, or other such values.
  (SP_REF, SP_SET): New helpers.
  (BR_BINARY, BR_ARITHMETIC): Take full 24-bit operands.  Our shuffle
  strategy is to emit push when needed to bring far locals near, then
  pop afterwards, shuffling away far destination values as needed; but
  that doesn't work for conditionals, unless we introduce a trampoline.
  Let's just do the simple thing for now.  Native compilation will use
  condition codes.
  (push, pop, drop): Back from the dead!  We'll only use these for
  temporary shuffling though, when an opcode can't address the full
  24-bit range.
  (long-fmov): New instruction, like long-mov but relative to the frame
  pointer.
  (load-typed-array, make-array): Don't use a compressed encoding so
  that we can avoid the shuffling case.  It would be a pain, given that
  they have so many operands already.

* module/language/bytecode.scm (compute-instruction-arity): Update for
  new instrution word encodings.

* module/system/vm/assembler.scm: Update to expose some opcodes
  directly, without the need for shuffling wrappers.  Adapt to
  instruction word encodings change.

* module/system/vm/disassembler.scm (disassembler): Adapt to instruction
  coding change.
This commit is contained in:
Andy Wingo 2015-10-20 20:06:40 +02:00
parent 72353de77d
commit 0da0308b84
5 changed files with 494 additions and 386 deletions

View file

@ -80,70 +80,58 @@
(define (parse-first-word word type)
(with-syntax ((word word))
(case type
((U8_X24)
((X32)
#'())
((U8_U24)
((X8_S24 X8_F24 X8_C24)
#'((ash word -8)))
((U8_L24)
((X8_L24)
#'((unpack-s24 (ash word -8))))
((U8_U8_I16)
((X8_S8_I16)
#'((logand (ash word -8) #xff)
(ash word -16)))
((U8_U12_U12)
((X8_S12_S12
X8_S12_C12
X8_C12_C12
X8_F12_F12)
#'((logand (ash word -8) #xfff)
(ash word -20)))
((U8_U8_U8_U8)
((X8_S8_S8_S8
X8_S8_S8_C8
X8_S8_C8_S8)
#'((logand (ash word -8) #xff)
(logand (ash word -16) #xff)
(ash word -24)))
(else
(error "bad kind" type)))))
(error "bad head kind" type)))))
(define (parse-tail-word word type)
(with-syntax ((word word))
(case type
((U8_X24)
#'((logand word #ff)))
((U8_U24)
((C32 I32 A32 B32)
#'(word))
((N32 R32 L32 LO32)
#'((unpack-s32 word)))
((C8_C24)
#'((logand word #xff)
(ash word -8)))
((U8_L24)
#'((logand word #xff)
(unpack-s24 (ash word -8))))
((U32)
#'(word))
((I32)
#'(word))
((A32)
#'(word))
((B32)
#'(word))
((N32)
#'((unpack-s32 word)))
((S32)
#'((unpack-s32 word)))
((L32)
#'((unpack-s32 word)))
((LO32)
#'((unpack-s32 word)))
((X8_U24)
#'((ash word -8)))
((X8_L24)
#'((unpack-s24 (ash word -8))))
((B1_X7_L24)
#'((not (zero? (logand word #x1)))
(unpack-s24 (ash word -8))))
((B1_U7_L24)
((B1_C7_L24)
#'((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)
((B1_X7_S24 B1_X7_F24 B1_X7_C24)
#'((not (zero? (logand word #x1)))
(ash word -8)))
((B1_X7_L24)
#'((not (zero? (logand word #x1)))
(unpack-s24 (ash word -8))))
((B1_X31)
#'((not (zero? (logand word #x1)))))
((X8_S24 X8_F24 X8_C24)
#'((ash word -8)))
((X8_L24)
#'((unpack-s24 (ash word -8))))
(else
(error "bad kind" type)))))
(error "bad tail kind" type)))))
(syntax-case x ()
((_ name opcode word0 word* ...)