mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 08:40:19 +02:00
Code Activity

Add support for comparisons against integer immediates

Browse source 
* libguile/vm-engine.c (s64-imm=?, u64-imm<?, imm-u64<?, s64-imm<?)
  (imm-s64<?): New instructions.
* libguile/instructions.c (FOR_EACH_INSTRUCTION_WORD_TYPE): Add new
  X8_S12_Z12 word type used by the new S64/immediate instructions.  A
  Z12 is a 12-bit signed integer immediate.
* module/system/vm/assembler.scm: Export new instructions, and add
  X8_S12_Z12 support.  Also, add missing shufflers for X8_S12_C12.
* module/language/bytecode.scm (compute-instruction-arity):
* module/system/vm/disassembler.scm (unpack-s12, disassembler): Add
  support for X8_S12_Z12.
* module/language/cps/types.scm (define-predicate-inferrer/param): New
  helper.
  (u64-=, u64-<, s64-<): Remove type checkers; this procedure does not
  cause &type-check.
  (u64-imm=?, s64-imm=?, u64-imm<?, imm-u64<?, s64-imm<?, imm-s64<?):
  New type inferrers.
* module/language/cps/type-fold.scm (define-unary-branch-folder*): New
  helper.
  (u64-imm=?, s64-imm=?, u64-imm<?, imm-u64<?, s64-imm<?, imm-s64<?):
  New branch folders.
* module/language/cps/reify-primitives.scm (reify-primitives): Reify
  constants for new immediate branching primcalls if values out of
  range.
* module/language/cps/effects-analysis.scm: Add support for new
  primcalls.
* module/language/cps/compile-bytecode.scm (compile-function): Add
  support for new primcalls and instructions.  Compile u64-imm-= to
  s64-imm=?.
This commit is contained in:
Andy Wingo 2017-11-14 10:41:24 +01:00
parent 4a0a930f1c
commit 294dbaad35
12 changed files with 225 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -66,8 +66,12 @@
emit-u64=?
emit-u64<?
emit-s64=?
emit-u64-imm<?
emit-imm-u64<?
emit-s64-imm=?
emit-s64<?
emit-s64-imm<?
emit-imm-s64<?
emit-f64=?
emit-f64<?
emit-=?
@ -341,6 +345,12 @@
(z (check-urange z #xfff)))
(logior x (ash y 8) (ash z 20))))
(define-inline (pack-u8-u12-s12 x y z)
(let ((x (check-urange x #xff))
(y (check-urange y #xfff))
(z (check-srange z #xfff)))
(logior x (ash y 8) (ash z 20))))
(define-inline (pack-u8-u8-u16 x y z)
(let ((x (check-urange x #xff))
(y (check-urange y #xff))
@ -617,6 +627,8 @@ later by the linker."
(emit asm (pack-u8-u12-u12 opcode a b)))
((X8_S12_C12 a b)
(emit asm (pack-u8-u12-u12 opcode a b)))
((X8_S12_Z12 a b)
(emit asm (pack-u8-u12-s12 opcode a b)))
((X8_C12_C12 a b)
(emit asm (pack-u8-u12-u12 opcode a b)))
((X8_F12_F12 a b)
@ -803,6 +815,14 @@ later by the linker."
(emit-push asm a)
(encode-X8_S12_S12-X8_C24 asm 0 0 const opcode)
(emit-pop asm dst))))
(define (encode-X8_S12_C12!/shuffle asm a const opcode)
(cond
((< a (ash 1 12))
(encode-X8_S12_C12 asm a const opcode))
(else
(emit-push asm a)
(encode-X8_S12_C12 asm 0 const opcode)
(emit-drop asm 1))))
(define (encode-X8_S12_C12<-/shuffle asm dst const opcode)
(cond
((< dst (ash 1 12))
@ -812,6 +832,14 @@ later by the linker."
(emit-push asm dst)
(encode-X8_S12_C12 asm 0 const opcode)
(emit-pop asm dst))))
(define (encode-X8_S12_Z12!/shuffle asm a const opcode)
(cond
((< a (ash 1 12))
(encode-X8_S12_Z12 asm a const opcode))
(else
(emit-push asm a)
(encode-X8_S12_Z12 asm 0 const opcode)
(emit-drop asm 1))))
(define (encode-X8_S8_I16<-/shuffle asm dst imm opcode)
(cond
((< dst (ash 1 8))
@ -877,7 +905,9 @@ later by the linker."
(('<- 'X8_S12_S12) #'encode-X8_S12_S12<-/shuffle)
(('! 'X8_S12_S12 'X8_C24) #'encode-X8_S12_S12-X8_C24!/shuffle)
(('<- 'X8_S12_S12 'X8_C24) #'encode-X8_S12_S12-X8_C24<-/shuffle)
(('! 'X8_S12_C12) #'encode-X8_S12_C12!/shuffle)
(('<- 'X8_S12_C12) #'encode-X8_S12_C12<-/shuffle)
(('! 'X8_S12_Z12) #'encode-X8_S12_Z12!/shuffle)
(('<- 'X8_S8_I16) #'encode-X8_S8_I16<-/shuffle)
(('! 'X8_S8_S8_S8) #'encode-X8_S8_S8_S8!/shuffle)
(('<- 'X8_S8_S8_S8) #'encode-X8_S8_S8_S8<-/shuffle)
@ -919,6 +949,7 @@ later by the linker."
('X8_S8_I16 #'(a imm))
('X8_S12_S12 #'(a b))
('X8_S12_C12 #'(a b))
('X8_S12_Z12 #'(a b))
('X8_C12_C12 #'(a b))
('X8_F12_F12 #'(a b))
('X8_S8_S8_S8 #'(a b c))