mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Compiler uses target fixnum range
* module/system/base/target.scm (target-most-negative-fixnum): (target-most-positive-fixnum): New definitions. * module/language/cps/types.scm (constant-type, define-exact-integer!) (&min/fixnum, &max/fixnum): Use new definitions. (&max/vector): Use target-max-vector-length.
This commit is contained in:
parent
8b5f9648ff
commit
a268c02fa0
2 changed files with 41 additions and 24 deletions
|
@ -332,7 +332,9 @@ minimum, and maximum."
|
||||||
((number? val)
|
((number? val)
|
||||||
(cond
|
(cond
|
||||||
((exact-integer? val)
|
((exact-integer? val)
|
||||||
(return (if (<= most-negative-fixnum val most-positive-fixnum)
|
(return (if (<= (target-most-negative-fixnum)
|
||||||
|
val
|
||||||
|
(target-most-positive-fixnum))
|
||||||
&fixnum
|
&fixnum
|
||||||
&bignum)
|
&bignum)
|
||||||
val))
|
val))
|
||||||
|
@ -382,7 +384,9 @@ minimum, and maximum."
|
||||||
(define-syntax-rule (define-exact-integer! result min max)
|
(define-syntax-rule (define-exact-integer! result min max)
|
||||||
(let ((min* min) (max* max))
|
(let ((min* min) (max* max))
|
||||||
(define! result
|
(define! result
|
||||||
(if (<= most-negative-fixnum min* max* most-positive-fixnum)
|
(if (<= (target-most-negative-fixnum)
|
||||||
|
min* max*
|
||||||
|
(target-most-positive-fixnum))
|
||||||
&fixnum
|
&fixnum
|
||||||
&exact-integer)
|
&exact-integer)
|
||||||
min* max*)))
|
min* max*)))
|
||||||
|
@ -398,8 +402,8 @@ minimum, and maximum."
|
||||||
(define-syntax-rule (&max/u64 x) (min (&max x) &u64-max))
|
(define-syntax-rule (&max/u64 x) (min (&max x) &u64-max))
|
||||||
(define-syntax-rule (&min/s64 x) (max (&min x) &s64-min))
|
(define-syntax-rule (&min/s64 x) (max (&min x) &s64-min))
|
||||||
(define-syntax-rule (&max/s64 x) (min (&max x) &s64-max))
|
(define-syntax-rule (&max/s64 x) (min (&max x) &s64-max))
|
||||||
(define-syntax-rule (&min/fixnum x) (max (&min x) most-negative-fixnum))
|
(define-syntax-rule (&min/fixnum x) (max (&min x) (target-most-negative-fixnum)))
|
||||||
(define-syntax-rule (&max/fixnum x) (min (&max x) most-positive-fixnum))
|
(define-syntax-rule (&max/fixnum x) (min (&max x) (target-most-positive-fixnum)))
|
||||||
(define-syntax-rule (&max/size x) (min (&max x) (target-max-size-t)))
|
(define-syntax-rule (&max/size x) (min (&max x) (target-max-size-t)))
|
||||||
(define-syntax-rule (&max/scm-size x) (min (&max x) (target-max-size-t/scm)))
|
(define-syntax-rule (&max/scm-size x) (min (&max x) (target-max-size-t/scm)))
|
||||||
|
|
||||||
|
@ -606,13 +610,14 @@ minimum, and maximum."
|
||||||
(define-predicate-inferrer (fixnum? val true?)
|
(define-predicate-inferrer (fixnum? val true?)
|
||||||
(cond
|
(cond
|
||||||
(true?
|
(true?
|
||||||
(restrict! val &fixnum most-negative-fixnum most-positive-fixnum))
|
(restrict! val &fixnum
|
||||||
|
(target-most-negative-fixnum) (target-most-positive-fixnum)))
|
||||||
((type<=? (&type val) &exact-integer)
|
((type<=? (&type val) &exact-integer)
|
||||||
(cond
|
(cond
|
||||||
((<= (&max val) most-positive-fixnum)
|
((<= (&max val) (target-most-positive-fixnum))
|
||||||
(restrict! val &bignum -inf.0 (1- most-negative-fixnum)))
|
(restrict! val &bignum -inf.0 (1- (target-most-negative-fixnum))))
|
||||||
((>= (&min val) most-negative-fixnum)
|
((>= (&min val) (target-most-negative-fixnum))
|
||||||
(restrict! val &bignum most-positive-fixnum +inf.0))
|
(restrict! val &bignum (target-most-positive-fixnum) +inf.0))
|
||||||
(else
|
(else
|
||||||
(restrict! val &bignum -inf.0 +inf.0))))
|
(restrict! val &bignum -inf.0 +inf.0))))
|
||||||
(else
|
(else
|
||||||
|
@ -717,29 +722,28 @@ minimum, and maximum."
|
||||||
;;; Vectors.
|
;;; Vectors.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
;; This max-vector-len computation is a hack.
|
(define-syntax-rule (&max/vector x)
|
||||||
(define *max-vector-len* (ash most-positive-fixnum -5))
|
(min (&max x) (target-max-vector-length)))
|
||||||
(define-syntax-rule (&max/vector x) (min (&max x) *max-vector-len*))
|
|
||||||
|
|
||||||
(define-simple-type-checker (make-vector (&u64 0 *max-vector-len*)
|
(define-simple-type-checker (make-vector (&u64 0 (target-max-vector-length))
|
||||||
&all-types))
|
&all-types))
|
||||||
(define-type-inferrer (make-vector size init result)
|
(define-type-inferrer (make-vector size init result)
|
||||||
(restrict! size &u64 0 *max-vector-len*)
|
(restrict! size &u64 0 (target-max-vector-length))
|
||||||
(define! result &vector (&min/0 size) (&max/vector size)))
|
(define! result &vector (&min/0 size) (&max/vector size)))
|
||||||
|
|
||||||
(define-type-checker (vector-ref v idx)
|
(define-type-checker (vector-ref v idx)
|
||||||
(and (check-type v &vector 0 *max-vector-len*)
|
(and (check-type v &vector 0 (target-max-vector-length))
|
||||||
(check-type idx &u64 0 (1- (&min v)))))
|
(check-type idx &u64 0 (1- (&min v)))))
|
||||||
(define-type-inferrer (vector-ref v idx result)
|
(define-type-inferrer (vector-ref v idx result)
|
||||||
(restrict! v &vector (1+ (&min/0 idx)) *max-vector-len*)
|
(restrict! v &vector (1+ (&min/0 idx)) (target-max-vector-length))
|
||||||
(restrict! idx &u64 0 (1- (&max/vector v)))
|
(restrict! idx &u64 0 (1- (&max/vector v)))
|
||||||
(define! result &all-types -inf.0 +inf.0))
|
(define! result &all-types -inf.0 +inf.0))
|
||||||
|
|
||||||
(define-type-checker (vector-set! v idx val)
|
(define-type-checker (vector-set! v idx val)
|
||||||
(and (check-type v &vector 0 *max-vector-len*)
|
(and (check-type v &vector 0 (target-max-vector-length))
|
||||||
(check-type idx &u64 0 (1- (&min v)))))
|
(check-type idx &u64 0 (1- (&min v)))))
|
||||||
(define-type-inferrer (vector-set! v idx val)
|
(define-type-inferrer (vector-set! v idx val)
|
||||||
(restrict! v &vector (1+ (&min/0 idx)) *max-vector-len*)
|
(restrict! v &vector (1+ (&min/0 idx)) (target-max-vector-length))
|
||||||
(restrict! idx &u64 0 (1- (&max/vector v))))
|
(restrict! idx &u64 0 (1- (&max/vector v))))
|
||||||
|
|
||||||
(define-simple-type-checker (make-vector/immediate &all-types))
|
(define-simple-type-checker (make-vector/immediate &all-types))
|
||||||
|
@ -747,19 +751,19 @@ minimum, and maximum."
|
||||||
(define! result &vector size size))
|
(define! result &vector size size))
|
||||||
|
|
||||||
(define-type-checker/param (vector-ref/immediate idx v)
|
(define-type-checker/param (vector-ref/immediate idx v)
|
||||||
(and (check-type v &vector 0 *max-vector-len*) (< idx (&min v))))
|
(and (check-type v &vector 0 (target-max-vector-length)) (< idx (&min v))))
|
||||||
(define-type-inferrer/param (vector-ref/immediate idx v result)
|
(define-type-inferrer/param (vector-ref/immediate idx v result)
|
||||||
(restrict! v &vector (1+ idx) *max-vector-len*)
|
(restrict! v &vector (1+ idx) (target-max-vector-length))
|
||||||
(define! result &all-types -inf.0 +inf.0))
|
(define! result &all-types -inf.0 +inf.0))
|
||||||
|
|
||||||
(define-type-checker/param (vector-set!/immediate idx v val)
|
(define-type-checker/param (vector-set!/immediate idx v val)
|
||||||
(and (check-type v &vector 0 *max-vector-len*) (< idx (&min v))))
|
(and (check-type v &vector 0 (target-max-vector-length)) (< idx (&min v))))
|
||||||
(define-type-inferrer/param (vector-set!/immediate idx v val)
|
(define-type-inferrer/param (vector-set!/immediate idx v val)
|
||||||
(restrict! v &vector (1+ idx) *max-vector-len*))
|
(restrict! v &vector (1+ idx) (target-max-vector-length)))
|
||||||
|
|
||||||
(define-simple-type-checker (vector-length &vector))
|
(define-simple-type-checker (vector-length &vector))
|
||||||
(define-type-inferrer (vector-length v result)
|
(define-type-inferrer (vector-length v result)
|
||||||
(restrict! v &vector 0 *max-vector-len*)
|
(restrict! v &vector 0 (target-max-vector-length))
|
||||||
(define! result &u64 (&min/0 v) (&max/vector v)))
|
(define! result &u64 (&min/0 v) (&max/vector v)))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -30,7 +30,10 @@
|
||||||
|
|
||||||
target-max-size-t
|
target-max-size-t
|
||||||
target-max-size-t/scm
|
target-max-size-t/scm
|
||||||
target-max-vector-length))
|
target-max-vector-length
|
||||||
|
|
||||||
|
target-most-negative-fixnum
|
||||||
|
target-most-positive-fixnum))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -166,3 +169,13 @@ SCM words."
|
||||||
;; Vector size fits in first word; the low 8 bits are taken by the
|
;; Vector size fits in first word; the low 8 bits are taken by the
|
||||||
;; type tag. Additionally, restrict to 48-bit address space.
|
;; type tag. Additionally, restrict to 48-bit address space.
|
||||||
(1- (ash 1 (min (- (* (target-word-size) 8) 8) 48))))
|
(1- (ash 1 (min (- (* (target-word-size) 8) 8) 48))))
|
||||||
|
|
||||||
|
(define (target-most-negative-fixnum)
|
||||||
|
"Return the most negative integer representable as a fixnum on the
|
||||||
|
target platform."
|
||||||
|
(- (ash 1 (- (* (target-word-size) 8) 3))))
|
||||||
|
|
||||||
|
(define (target-most-positive-fixnum)
|
||||||
|
"Return the most positive integer representable as a fixnum on the
|
||||||
|
target platform."
|
||||||
|
(1- (ash 1 (- (* (target-word-size) 8) 3))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue