mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +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

14
module/language/cps/compile-bytecode.scm
View file

@ -425,6 +425,12 @@
(binary op emit-je emit-jne a b))
(define (binary-< emit-<? a b)
(binary emit-<? emit-jl emit-jnl a b))
(define (binary-test/imm op a b)
(op asm (from-sp (slot a)) b)
(emit-branch emit-je emit-jne))
(define (binary-</imm op a b)
(op asm (from-sp (slot a)) b)
(emit-branch emit-jl emit-jnl))
(match exp
(($ $primcall 'heap-object? #f (a)) (unary emit-heap-object? a))
(($ $primcall 'null? #f (a)) (unary emit-null? a))
@ -451,9 +457,15 @@
(($ $primcall '< #f (a b)) (binary-< emit-<? a b))
(($ $primcall '= #f (a b)) (binary-test emit-=? a b))
(($ $primcall 'u64-< #f (a b)) (binary-< emit-u64<? a b))
(($ $primcall 'u64-imm-< b (a)) (binary-</imm emit-u64-imm<? a b))
(($ $primcall 'imm-u64-< b (a)) (binary-</imm emit-imm-u64<? a b))
(($ $primcall 'u64-= #f (a b)) (binary-test emit-u64=? a b))
(($ $primcall 'u64-imm-= b (a)) (binary-test/imm emit-s64-imm=? a b))
(($ $primcall 's64-= #f (a b)) (binary-test emit-u64=? a b))
(($ $primcall 's64-imm-= b (a)) (binary-test/imm emit-s64-imm=? a b))
(($ $primcall 's64-< #f (a b)) (binary-< emit-s64<? a b))
(($ $primcall 's64-= #f (a b)) (binary-test emit-s64=? a b))
(($ $primcall 's64-imm-< b (a)) (binary-</imm emit-s64-imm<? a b))
(($ $primcall 'imm-s64-< b (a)) (binary-</imm emit-imm-s64<? a b))
(($ $primcall 'f64-< #f (a b)) (binary-< emit-f64<? a b))
(($ $primcall 'f64-= #f (a b)) (binary-test emit-f64=? a b))))