[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 08/11: Add untag-fixnum instruction
From: |
Andy Wingo |
Subject: |
[Guile-commits] 08/11: Add untag-fixnum instruction |
Date: |
Sun, 29 Oct 2017 16:05:02 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit c9ec866ef90e3e920dea47919781ac9e47a89967
Author: Andy Wingo <address@hidden>
Date: Sun Oct 29 19:51:41 2017 +0100
Add untag-fixnum instruction
* libguile/vm-engine.c (untag-fixnum): New instruction.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/system/vm/assembler.scm (untag-fixnum):
* module/language/cps/slot-allocation.scm (compute-var-representations):
* module/language/cps/types.scm (untag-fixnum): Add compiler support for
untag-fixnum.
---
libguile/vm-engine.c | 12 +++++++++++-
module/language/cps/compile-bytecode.scm | 2 ++
module/language/cps/effects-analysis.scm | 3 ++-
module/language/cps/slot-allocation.scm | 3 ++-
module/language/cps/types.scm | 7 +++----
module/system/vm/assembler.scm | 2 ++
6 files changed, 22 insertions(+), 7 deletions(-)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 8a9f9bc..c6ffbef 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -4413,7 +4413,17 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
NEXT (1);
}
- VM_DEFINE_OP (214, unused_214, NULL, NOP)
+ VM_DEFINE_OP (214, untag_fixnum, "untag-fixnum", OP1 (X8_S12_S12) | OP_DST)
+ {
+ scm_t_uint16 dst, src;
+
+ UNPACK_12_12 (op, dst, src);
+
+ SP_SET_S64 (dst, SCM_I_INUM (SP_REF (src)));
+
+ NEXT (1);
+ }
+
VM_DEFINE_OP (215, unused_215, NULL, NOP)
VM_DEFINE_OP (216, unused_216, NULL, NOP)
VM_DEFINE_OP (217, unused_217, NULL, NOP)
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index 9c92eac..055cc83 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -272,6 +272,8 @@
(emit-atomic-box-compare-and-swap!
asm (from-sp dst) (from-sp (slot box))
(from-sp (slot expected)) (from-sp (slot desired))))
+ (($ $primcall 'untag-fixnum (src))
+ (emit-untag-fixnum asm (from-sp dst) (from-sp (slot src))))
(($ $primcall name args)
;; FIXME: Inline all the cases.
(let ((inst (prim-instruction name)))
diff --git a/module/language/cps/effects-analysis.scm
b/module/language/cps/effects-analysis.scm
index 641e420..87f8235 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -383,7 +383,8 @@ is or might be a read or a write to the same location as A."
((u64->scm _))
((scm->s64 _) &type-check)
((load-s64 _))
- ((s64->scm _)))
+ ((s64->scm _))
+ ((untag-fixnum _)))
;; Bytevectors.
(define-primitive-effects
diff --git a/module/language/cps/slot-allocation.scm
b/module/language/cps/slot-allocation.scm
index abde300..f223a50 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -810,7 +810,8 @@ are comparable with eqv?. A tmp slot may be used."
'ursh/immediate 'ulsh/immediate
'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
(intmap-add representations var 'u64))
- (($ $primcall (or 'scm->s64 'load-s64
+ (($ $primcall (or 'untag-fixnum
+ 'scm->s64 'load-s64
'bv-s8-ref 'bv-s16-ref 'bv-s32-ref 'bv-s64-ref))
(intmap-add representations var 's64))
(_
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 715ab74..05f6a8d 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -870,10 +870,9 @@ minimum, and maximum."
(define! result &s64 (&min/s64 scm) (&max/s64 scm)))
(define-type-aliases scm->s64 load-s64)
-(define-type-checker (s64->scm s64)
- #t)
-(define-type-inferrer (s64->scm s64 result)
- (define-exact-integer! result (&min/s64 s64) (&max/s64 s64)))
+(define-simple-type-checker (untag-fixnum &fixnum))
+(define-type-inferrer (untag-fixnum scm result)
+ (define! result &s64 (&min/s64 scm) (&max/s64 scm)))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 732e69f..e70d292 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -97,6 +97,8 @@
emit-undefined?
emit-eof-object?
+ emit-untag-fixnum
+
emit-pair?
emit-struct?
emit-symbol?
- [Guile-commits] branch master updated (9d1235a -> d1c69b5), Andy Wingo, 2017/10/29
- [Guile-commits] 01/11: Minor optimization compiling 'and', Andy Wingo, 2017/10/29
- [Guile-commits] 08/11: Add untag-fixnum instruction,
Andy Wingo <=
- [Guile-commits] 10/11: Inline u64/scm comparisons, Andy Wingo, 2017/10/29
- [Guile-commits] 02/11: Rename "number" tag to "heap-number", Andy Wingo, 2017/10/29
- [Guile-commits] 03/11: Simplify lowering of branching primcalls to CPS, Andy Wingo, 2017/10/29
- [Guile-commits] 11/11: Remove compiler support for u64-scm comparisons, Andy Wingo, 2017/10/29
- [Guile-commits] 05/11: Lower eqv? and equal? to new instructions., Andy Wingo, 2017/10/29
- [Guile-commits] 04/11: Add missing compiler support for heap-object? primcall et al., Andy Wingo, 2017/10/29
- [Guile-commits] 07/11: Add compiler support for fixnum? primcall predicate, Andy Wingo, 2017/10/29
- [Guile-commits] 06/11: Add compiler support for s64 comparisons., Andy Wingo, 2017/10/29
- [Guile-commits] 09/11: Add hacks around lack of allocation sinking, Andy Wingo, 2017/10/29