summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2015-11-12 21:44:24 +0100
committerAndy Wingo <wingo@pobox.com>2015-12-01 11:30:54 +0100
commitdfbe869e2421e6db03fd14c6fbfc0838e5e1988b (patch)
treeeb2344376bd382cbcd296c980c8c7b11d86dc1ea /module/language
parent58153e3a08c89fd9cc84dbf65e1df27119986cca (diff)
downloadguile-dfbe869e2421e6db03fd14c6fbfc0838e5e1988b.tar.gz
Add low-level support for unboxed 64-bit unsigned ints
* libguile/frames.c (enum stack_item_representation) * libguile/frames.c (scm_to_stack_item_representation): (scm_frame_local_ref, scm_frame_local_set_x): Support 'u64 slots. * libguile/frames.h (union scm_vm_stack_element): Add as_u64 member. * libguile/vm-engine.c (SP_REF_U64, SP_SET_U64): New helpers. (scm->u64, u64->scm): New instructions. * module/language/cps/cse.scm (compute-equivalent-subexpressions): Scalar replacement for u64->scm and scm->u64. * module/language/cps/effects-analysis.scm (scm->u64, u64->scm): Add cases. * module/language/cps/slot-allocation.scm (compute-var-representations): (allocate-slots): Represent the result of scm->u64 as a "u64" slot. * module/language/cps/types.scm (&u64): New type. (scm->u64, u64->scm): Add support for these ops. * module/system/vm/assembler.scm (write-arities): * module/system/vm/debug.scm (arity-definitions): Support u64 representations.
Diffstat (limited to 'module/language')
-rw-r--r--module/language/cps/cse.scm8
-rw-r--r--module/language/cps/effects-analysis.scm6
-rw-r--r--module/language/cps/slot-allocation.scm8
-rw-r--r--module/language/cps/types.scm17
4 files changed, 32 insertions, 7 deletions
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 2e47f379c..ad554faa0 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -307,6 +307,14 @@ false. It could be that both true and false proofs are available."
(match defs
((scm)
(add-def! `(primcall scm->f64 ,scm) f64))))
+ (('primcall 'scm->u64 scm)
+ (match defs
+ ((u64)
+ (add-def! `(primcall u64->scm ,u64) scm))))
+ (('primcall 'u64->scm u64)
+ (match defs
+ ((scm)
+ (add-def! `(primcall scm->u64 ,scm) u64))))
(_ #t))))
(define (visit-label label equiv-labels var-substs)
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index ae7a1a614..9c9334671 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -351,10 +351,12 @@ is or might be a read or a write to the same location as A."
((string->number _) (&read-object &string) &type-check)
((string-length s) &type-check))
-;; Unboxed floats.
+;; Unboxed floats and integers.
(define-primitive-effects
((scm->f64 _) &type-check)
- ((f64->scm _)))
+ ((f64->scm _))
+ ((scm->u64 _) &type-check)
+ ((u64->scm _)))
;; Bytevectors.
(define-primitive-effects
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 8d865d739..ca8e32123 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -53,8 +53,8 @@
;;
(slots allocation-slots)
- ;; A map of VAR to representation. A representation is either 'scm or
- ;; 'f64.
+ ;; A map of VAR to representation. A representation is 'scm, 'f64, or
+ ;; 'u64.
;;
(representations allocation-representations)
@@ -793,6 +793,8 @@ are comparable with eqv?. A tmp slot may be used."
(($ $primcall (or 'scm->f64 'bv-f32-ref 'bv-f64-ref
'fadd 'fsub 'fmul 'fdiv))
(intmap-add representations var 'f64))
+ (($ $primcall (or 'scm->u64))
+ (intmap-add representations var 'u64))
(_
(intmap-add representations var 'scm))))
(vars
@@ -874,7 +876,7 @@ are comparable with eqv?. A tmp slot may be used."
(#f slot-map)
(slot
(let ((desc (match (intmap-ref representations var)
- ('f64 slot-desc-live-raw)
+ ((or 'u64 'f64) slot-desc-live-raw)
('scm slot-desc-live-scm))))
(logior slot-map (ash desc (* 2 slot)))))))
live-vars 0))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 08e8ec8de..8482b9836 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -119,6 +119,7 @@
;; Untagged types.
&f64
+ &u64
infer-types
lookup-pre-type
@@ -169,7 +170,8 @@
&array
&hash-table
- &f64)
+ &f64
+ &u64)
(define-syntax &no-type (identifier-syntax 0))
@@ -678,7 +680,7 @@ minimum, and maximum."
;;;
-;;; Unboxed double-precision floating-point numbers.
+;;; Unboxed numbers.
;;;
(define-type-checker (scm->f64 scm)
@@ -692,6 +694,17 @@ minimum, and maximum."
(define-type-inferrer (f64->scm f64 result)
(define! result &flonum (&min f64) (&max f64)))
+(define-type-checker (scm->u64 scm)
+ (check-type scm &exact-integer 0 +inf.0))
+(define-type-inferrer (scm->u64 scm result)
+ (restrict! scm &exact-integer 0 +inf.0)
+ (define! result &u64 (&min scm) (&max scm)))
+
+(define-type-checker (u64->scm u64)
+ #t)
+(define-type-inferrer (u64->scm u64 result)
+ (define! result &exact-integer (&min u64) (&max u64)))
+