[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/15: Instruction explosion for f64->scm
From: |
Andy Wingo |
Subject: |
[Guile-commits] 04/15: Instruction explosion for f64->scm |
Date: |
Fri, 13 Apr 2018 04:41:11 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 997ecae1dfdb87b589a25f1a9cc52b94a86145a0
Author: Andy Wingo <address@hidden>
Date: Tue Apr 10 20:37:28 2018 +0200
Instruction explosion for f64->scm
* module/language/cps/reify-primitives.scm (reify-primitives): Reify
f64->scm via low-level operations.
---
module/language/cps/reify-primitives.scm | 33 ++++++++++++++++++++++++++++++++
1 file changed, 33 insertions(+)
diff --git a/module/language/cps/reify-primitives.scm
b/module/language/cps/reify-primitives.scm
index 84d75ca..c1ebd1c 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -31,6 +31,8 @@
#:use-module (language cps with-cps)
#:use-module (language cps intmap)
#:use-module (language bytecode)
+ #:use-module (system base target)
+ #:use-module (system base types internal)
#:export (reify-primitives))
(define (module-box cps src module name public? bound? val-proc)
@@ -270,6 +272,37 @@
(with-cps cps
(setk label ($kargs names vars ($continue k src ($call proc ()))))))
(($ $kargs names vars
+ ($ $continue k src ($ $primcall 'f64->scm #f (f64))))
+ (with-cps cps
+ (letv scm tag ptr uidx)
+ (letk kdone ($kargs () ()
+ ($continue k src ($values (scm)))))
+ (letk kinit ($kargs ('uidx) (uidx)
+ ($continue kdone src
+ ($primcall 'f64-set! 'flonum (scm ptr uidx f64)))))
+ (letk kidx ($kargs ('ptr) (ptr)
+ ($continue kinit src ($primcall 'load-u64 0 ()))))
+ (letk kptr ($kargs () ()
+ ($continue kidx src
+ ($primcall 'tail-pointer-ref/immediate
+ `(flonum . ,(match (target-word-size)
+ (4 2)
+ (8 1)))
+ (scm)))))
+ (letk ktag1 ($kargs ('tag) (tag)
+ ($continue kptr src
+ ($primcall 'word-set!/immediate '(flonum . 0) (scm
tag)))))
+ (letk ktag0 ($kargs ('scm) (scm)
+ ($continue ktag1 src
+ ($primcall 'load-u64 %tc16-flonum ()))))
+ (setk label ($kargs names vars
+ ($continue ktag0 src
+ ($primcall 'allocate-words/immediate
+ `(flonum . ,(match (target-word-size)
+ (4 4)
+ (8 2)))
+ ()))))))
+ (($ $kargs names vars
($ $continue k src ($ $primcall 'u64->scm/unlikely #f (u64))))
(with-cps cps
(setk label ($kargs names vars
- [Guile-commits] branch master updated (59f1f5a -> 79ba396), Andy Wingo, 2018/04/13
- [Guile-commits] 05/15: Disable f64->scm instruction, Andy Wingo, 2018/04/13
- [Guile-commits] 06/15: Remove scm->f64, f64->scm implementations, Andy Wingo, 2018/04/13
- [Guile-commits] 04/15: Instruction explosion for f64->scm,
Andy Wingo <=
- [Guile-commits] 03/15: Add reifier for fadd/immediate., Andy Wingo, 2018/04/13
- [Guile-commits] 02/15: Slim heap-allocated flonums, Andy Wingo, 2018/04/13
- [Guile-commits] 01/15: Add scm->f64 intrinsic, Andy Wingo, 2018/04/13
- [Guile-commits] 11/15: logsub is intrinsic, Andy Wingo, 2018/04/13
- [Guile-commits] 09/15: u64->scm, s64->scm intrinsics, Andy Wingo, 2018/04/13
- [Guile-commits] 08/15: Remove scm->u64, etc implementations, Andy Wingo, 2018/04/13
- [Guile-commits] 10/15: Remove implementations of obsolete s64->scm, u64->scm insts, Andy Wingo, 2018/04/13
- [Guile-commits] 12/15: Remove implementation of logsub VM op, Andy Wingo, 2018/04/13
- [Guile-commits] 07/15: scm->u64, scm->s64, scm->u64/truncate intrinsics, Andy Wingo, 2018/04/13
- [Guile-commits] 14/15: Remove implementation of atomic box ops, Andy Wingo, 2018/04/13