1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +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:
Andy Wingo 2017-11-09 14:27:49 +01:00
parent 8b5f9648ff
commit a268c02fa0
2 changed files with 41 additions and 24 deletions

View file

@ -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)))

View file

@ -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))))