summaryrefslogtreecommitdiff
path: root/module/system
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-12-03 09:01:24 +0100
committerAndy Wingo <wingo@pobox.com>2015-12-03 09:01:24 +0100
commit1d4b4ec39cc7a7fa18c9e352e5ff4cc59874e039 (patch)
treef7485a9e67c6cc49b8c33ce16ec1a85905867d9f /module/system
parent97755a1adecbb5af084f33b1ca816c70cb8cb2de (diff)
downloadguile-1d4b4ec39cc7a7fa18c9e352e5ff4cc59874e039.tar.gz
Add support for comparing u64 values with SCM values
* libguile/vm-engine.c (BR_U64_SCM_COMPARISON): New helper. (br-if-u64-<=-scm, br-if-u64-<-scm, br-if-u64-=-scm) (br-if-u64->-scm, br-if-u64->=-scm): New instructions, to compare an untagged u64 with a tagged SCM. Avoids many u64->scm operations. * module/language/cps/compile-bytecode.scm (compile-function): * module/language/cps/effects-analysis.scm: * module/language/cps/type-fold.scm: * module/system/vm/assembler.scm: * module/system/vm/disassembler.scm (code-annotation, compute-labels): * module/language/cps/primitives.scm (*branching-primcall-arities*): Add support for new opcodes. * module/language/cps/specialize-numbers.scm (specialize-u64-scm-comparison): New helper. * module/language/cps/specialize-numbers.scm (specialize-operations): Specialize u64 comparisons. * module/language/cps/types.scm (true-comparison-restrictions): New helper. (define-comparison-inferrer): Use the new helper. Add support for u64-<-scm et al.
Diffstat (limited to 'module/system')
-rw-r--r--module/system/vm/assembler.scm5
-rw-r--r--module/system/vm/disassembler.scm6
2 files changed, 10 insertions, 1 deletions
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index a4d5efc30..4fcf17296 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -98,6 +98,11 @@
emit-br-if-u64-=
emit-br-if-u64-<
emit-br-if-u64-<=
+ emit-br-if-u64-<-scm
+ emit-br-if-u64-<=-scm
+ emit-br-if-u64-=-scm
+ emit-br-if-u64->=-scm
+ emit-br-if-u64->-scm
(emit-mov* . emit-mov)
(emit-fmov* . emit-fmov)
(emit-box* . emit-box)
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 6c21ad609..b0867e665 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -196,6 +196,8 @@ address of that offset."
'br-if-char 'br-if-eq 'br-if-eqv
'br-if-= 'br-if-< 'br-if-<= 'br-if-> 'br-if->=
'br-if-u64-= 'br-if-u64-< 'br-if-u64-<=
+ 'br-if-u64-<-scm 'br-if-u64-<=-scm 'br-if-u64-=-scm
+ 'br-if-u64->-scm 'br-if-u64->=-scm
'br-if-logtest) _ ... target)
(list "-> ~A" (vector-ref labels (- (+ offset target) start))))
(('br-if-tc7 slot invert? tc7 target)
@@ -298,7 +300,9 @@ address of that offset."
br-if-true br-if-null br-if-nil br-if-pair br-if-struct
br-if-char br-if-tc7 br-if-eq br-if-eqv
br-if-= br-if-< br-if-<= br-if-> br-if->= br-if-logtest
- br-if-u64-= br-if-u64-< br-if-u64-<=)
+ br-if-u64-= br-if-u64-< br-if-u64-<=
+ br-if-u64-<-scm br-if-u64-<=-scm br-if-u64-=-scm
+ br-if-u64->-scm br-if-u64->=-scm)
(match arg
((_ ... target)
(add-label! (+ offset target) "L"))))