fix bounds check on immutables values and an immediate index

original commit: fc064b5b91bc5c7da8b7c71441a37e3c05523986
This commit is contained in:
Matthew Flatt 2018-01-07 08:48:15 -07:00
parent 74fa386d2d
commit 1dba8c4624
5 changed files with 112 additions and 33 deletions

3
LOG
View File

@ -774,3 +774,6 @@
5_3.ss, 5_3.ms, fl.ms, root-experr*, patch*
- fix bug in date->time-utc caused by incorrect use of difftime in Windows
stats.c, date.ms, release_notes.stex
- fix bounds checking with an immediate index on immutable vectors,
fxvectors, strings, and bytevectors
cpnanopass.ss, 5_5.ms, 5_6.ms, bytevector.ms

View File

@ -428,17 +428,31 @@
)
(mat $string-ref-check?
(let ([s (make-string 3)] [not-s (make-vector 3)])
(let ([s (make-string 3)] [imm-s (string->immutable-string (make-string 3))] [not-s (make-vector 3)])
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
(and
(not (#%$string-ref-check? not-s i0))
(not (#%$string-ref-check? s ifalse))
(not (#%$string-ref-check? s i-1))
(not (#%$string-ref-check? imm-s i-1))
(#%$string-ref-check? s 0)
(#%$string-ref-check? s 1)
(#%$string-ref-check? s 2)
(#%$string-ref-check? imm-s 0)
(#%$string-ref-check? imm-s 1)
(#%$string-ref-check? imm-s 2)
(#%$string-ref-check? s i0)
(#%$string-ref-check? s i1)
(#%$string-ref-check? s i2)
(#%$string-ref-check? imm-s i0)
(#%$string-ref-check? imm-s i1)
(#%$string-ref-check? imm-s i2)
(not (#%$string-ref-check? s 3))
(not (#%$string-ref-check? s i3))
(not (#%$string-ref-check? s ibig)))))
(not (#%$string-ref-check? s ibig))
(not (#%$string-ref-check? imm-s 3))
(not (#%$string-ref-check? imm-s i3))
(not (#%$string-ref-check? imm-s ibig)))))
)
(mat string-ref

View File

@ -38,19 +38,35 @@
)
(mat $vector-ref-check?
(let ([v (make-vector 3)] [not-v (make-fxvector 3)])
(let ([v (make-vector 3)] [imm-v (vector->immutable-vector (make-vector 3))] [not-v (make-fxvector 3)])
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
(and
(not (#%$vector-ref-check? not-v i0))
(not (#%$vector-ref-check? v ifalse))
(not (#%$vector-ref-check? imm-v ifalse))
(not (#%$vector-ref-check? v i-1))
(not (#%$vector-ref-check? imm-v i-1))
(#%$vector-ref-check? v 0)
(#%$vector-ref-check? v 1)
(#%$vector-ref-check? v 2)
(#%$vector-ref-check? imm-v 0)
(#%$vector-ref-check? imm-v 1)
(#%$vector-ref-check? imm-v 2)
(#%$vector-ref-check? v i0)
(#%$vector-ref-check? v i1)
(#%$vector-ref-check? v i2)
(#%$vector-ref-check? imm-v i0)
(#%$vector-ref-check? imm-v i1)
(#%$vector-ref-check? imm-v i2)
(not (#%$vector-ref-check? v 3))
(not (#%$vector-ref-check? v i3))
(not (#%$vector-ref-check? v ibig)))))
(not (#%$vector-ref-check? v ibig))
(not (#%$vector-ref-check? imm-v 3))
(not (#%$vector-ref-check? imm-v i3))
(not (#%$vector-ref-check? imm-v ibig)))))
)
(mat vector-ref
(eqv? (vector-ref '#(a b c) 0) 'a)
(eqv? (vector-ref '#(a b c) 1) 'b)
@ -191,17 +207,31 @@
)
(mat $fxvector-ref-check?
(let ([fv (make-fxvector 3)] [not-fv (make-vector 3)])
(let ([fv (make-fxvector 3)] [imm-fv (fxvector->immutable-fxvector (make-fxvector 3))] [not-fv (make-vector 3)])
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
(and
(not (#%$fxvector-ref-check? not-fv i0))
(not (#%$fxvector-ref-check? fv ifalse))
(not (#%$fxvector-ref-check? fv i-1))
(not (#%$fxvector-ref-check? imm-fv i-1))
(#%$fxvector-ref-check? fv 0)
(#%$fxvector-ref-check? fv 1)
(#%$fxvector-ref-check? fv 2)
(#%$fxvector-ref-check? imm-fv 0)
(#%$fxvector-ref-check? imm-fv 1)
(#%$fxvector-ref-check? imm-fv 2)
(#%$fxvector-ref-check? fv i0)
(#%$fxvector-ref-check? fv i1)
(#%$fxvector-ref-check? fv i2)
(#%$fxvector-ref-check? imm-fv i0)
(#%$fxvector-ref-check? imm-fv i1)
(#%$fxvector-ref-check? imm-fv i2)
(not (#%$fxvector-ref-check? fv 3))
(not (#%$fxvector-ref-check? fv i3))
(not (#%$fxvector-ref-check? fv ibig)))))
(not (#%$fxvector-ref-check? fv ibig))
(not (#%$fxvector-ref-check? imm-fv 3))
(not (#%$fxvector-ref-check? imm-fv i3))
(not (#%$fxvector-ref-check? imm-fv ibig)))))
)
(mat fxvector-ref

View File

@ -203,19 +203,33 @@
)
(mat $bytevector-ref-check?
(let ([bv (make-bytevector 3)] [not-bv (make-fxvector 3)])
(let ([bv (make-bytevector 3)] [imm-bv (bytevector->immutable-bytevector (make-bytevector 3))] [not-bv (make-fxvector 3)])
(let ([i-1 -1] [i0 0] [i1 1] [i2 2] [i3 3] [ifalse #f] [ibig (+ (most-positive-fixnum) 1)])
(and
(not (#%$bytevector-ref-check? 8 not-bv i0))
(not (#%$bytevector-ref-check? 8 bv ifalse))
(not (#%$bytevector-ref-check? 8 bv i-1))
(not (#%$bytevector-ref-check? 8 imm-bv i-1))
(#%$bytevector-ref-check? 8 bv 0)
(#%$bytevector-ref-check? 8 bv 1)
(#%$bytevector-ref-check? 8 bv 2)
(#%$bytevector-ref-check? 8 imm-bv 0)
(#%$bytevector-ref-check? 8 imm-bv 1)
(#%$bytevector-ref-check? 8 imm-bv 2)
(#%$bytevector-ref-check? 8 bv i0)
(#%$bytevector-ref-check? 8 bv i1)
(#%$bytevector-ref-check? 8 bv i2)
(#%$bytevector-ref-check? 8 imm-bv i0)
(#%$bytevector-ref-check? 8 imm-bv i1)
(#%$bytevector-ref-check? 8 imm-bv i2)
(not (#%$bytevector-ref-check? 8 bv 3))
(not (#%$bytevector-ref-check? 8 bv i3))
(not (#%$bytevector-ref-check? 8 bv ibig)))))
(not (#%$bytevector-ref-check? 8 bv ibig))
(not (#%$bytevector-ref-check? 8 imm-bv 3))
(not (#%$bytevector-ref-check? 8 imm-bv i3))
(not (#%$bytevector-ref-check? 8 imm-bv ibig)))))
(let ([n 128])
(let ([bv (make-bytevector n)] [not-bv (make-fxvector n)])
(let ([bv (make-bytevector n)] [imm-bv (bytevector->immutable-bytevector (make-bytevector n))] [not-bv (make-fxvector n)])
(and
(let ([i 0])
(and (not (#%$bytevector-ref-check? 8 not-bv i))
@ -228,30 +242,48 @@
(not (#%$bytevector-ref-check? 16 bv i))
(not (#%$bytevector-ref-check? 32 bv i))
(not (#%$bytevector-ref-check? 64 bv i))
(not (#%$bytevector-ref-check? 8 imm-bv i))
(not (#%$bytevector-ref-check? 16 imm-bv i))
(not (#%$bytevector-ref-check? 32 imm-bv i))
(not (#%$bytevector-ref-check? 64 imm-bv i))
(f (fx* i 2)))))
(let f ([i 0])
(or (fx= i n)
(and (#%$bytevector-ref-check? 8 bv i)
(if (and (fx= (modulo i 2) 0) (fx<= (fx+ i 2) n))
(#%$bytevector-ref-check? 16 bv i)
(not (#%$bytevector-ref-check? 16 bv i)))
(and (#%$bytevector-ref-check? 16 bv i)
(#%$bytevector-ref-check? 16 imm-bv i))
(not (or (#%$bytevector-ref-check? 16 bv i)
(#%$bytevector-ref-check? 16 imm-bv i))))
(if (and (fx= (modulo i 4) 0) (fx<= (fx+ i 4) n))
(#%$bytevector-ref-check? 32 bv i)
(not (#%$bytevector-ref-check? 32 bv i)))
(and (#%$bytevector-ref-check? 32 bv i)
(#%$bytevector-ref-check? 32 imm-bv i))
(not (or (#%$bytevector-ref-check? 32 bv i)
(#%$bytevector-ref-check? 32 imm-bv i))))
(if (and (fx= (modulo i 8) 0) (fx<= (fx+ i 8) n))
(#%$bytevector-ref-check? 64 bv i)
(not (#%$bytevector-ref-check? 64 bv i)))
(and (#%$bytevector-ref-check? 64 bv i)
(#%$bytevector-ref-check? 64 imm-bv i))
(not (or (#%$bytevector-ref-check? 64 bv i)
(#%$bytevector-ref-check? 64 imm-bv i))))
(f (fx+ i 1)))))
(let ([i n])
(not (#%$bytevector-ref-check? 8 bv i))
(not (#%$bytevector-ref-check? 16 bv i))
(not (#%$bytevector-ref-check? 32 bv i))
(not (#%$bytevector-ref-check? 64 bv i)))
(and (not (#%$bytevector-ref-check? 8 bv i))
(not (#%$bytevector-ref-check? 16 bv i))
(not (#%$bytevector-ref-check? 32 bv i))
(not (#%$bytevector-ref-check? 64 bv i))
(not (#%$bytevector-ref-check? 8 imm-bv i))
(not (#%$bytevector-ref-check? 16 imm-bv i))
(not (#%$bytevector-ref-check? 32 imm-bv i))
(not (#%$bytevector-ref-check? 64 imm-bv i))))
(let ([i (+ (most-positive-fixnum) 1)])
(not (#%$bytevector-ref-check? 8 bv i))
(not (#%$bytevector-ref-check? 16 bv i))
(not (#%$bytevector-ref-check? 32 bv i))
(not (#%$bytevector-ref-check? 64 bv i))))))
(and (not (#%$bytevector-ref-check? 8 bv i))
(not (#%$bytevector-ref-check? 16 bv i))
(not (#%$bytevector-ref-check? 32 bv i))
(not (#%$bytevector-ref-check? 64 bv i))
(not (#%$bytevector-ref-check? 8 imm-bv i))
(not (#%$bytevector-ref-check? 16 imm-bv i))
(not (#%$bytevector-ref-check? 32 imm-bv i))
(not (#%$bytevector-ref-check? 64 imm-bv i)))))))
)
(mat bytevector-s8-ref

View File

@ -3614,7 +3614,7 @@
(%inline logor ,e (immediate ,type))))))
(define-syntax build-ref-check
(syntax-rules ()
[(_ type-disp maximum-length length-offset type mask)
[(_ type-disp maximum-length length-offset type mask immutable-flag)
(lambda (e-v e-i maybe-e-new)
; NB: caller must bind e-v, e-i, and maybe-e-new
(safe-assert (no-need-to-bind? #t e-v))
@ -3627,7 +3627,7 @@
[(expr->index e-i 1 (constant maximum-length)) =>
(lambda (index)
(let ([e (%inline u<
(immediate ,(logor (ash index (constant length-offset)) (constant type)))
(immediate ,(logor (ash index (constant length-offset)) (constant type) (constant immutable-flag)))
,t)])
(if (and (eqv? (constant type) (constant type-fixnum))
(eqv? (constant mask) (constant mask-fixnum)))
@ -7730,8 +7730,8 @@
[(e-name e-handler e-ib e-ob) (go e-name e-handler e-ib e-ob `(quote #f))]
[(e-name e-handler e-ib e-ob e-info) (go e-name e-handler e-ib e-ob e-info)]))))
(let ()
(define build-fxvector-ref-check (build-ref-check fxvector-type-disp maximum-fxvector-length fxvector-length-offset type-fxvector mask-fxvector))
(define build-fxvector-set!-check (build-ref-check fxvector-type-disp maximum-fxvector-length fxvector-length-offset type-mutable-fxvector mask-mutable-fxvector))
(define build-fxvector-ref-check (build-ref-check fxvector-type-disp maximum-fxvector-length fxvector-length-offset type-fxvector mask-fxvector fxvector-immutable-flag))
(define build-fxvector-set!-check (build-ref-check fxvector-type-disp maximum-fxvector-length fxvector-length-offset type-mutable-fxvector mask-mutable-fxvector fxvector-immutable-flag))
(define-inline 2 $fxvector-ref-check?
[(e-fv e-i) (bind #t (e-fv e-i) (build-fxvector-ref-check e-fv e-i #f))])
(define-inline 2 $fxvector-set!-check?
@ -7776,10 +7776,10 @@
(let ()
(define build-string-ref-check
(lambda (e-s e-i)
((build-ref-check string-type-disp maximum-string-length string-length-offset type-string mask-string) e-s e-i #f)))
((build-ref-check string-type-disp maximum-string-length string-length-offset type-string mask-string string-immutable-flag) e-s e-i #f)))
(define build-string-set!-check
(lambda (e-s e-i)
((build-ref-check string-type-disp maximum-string-length string-length-offset type-mutable-string mask-mutable-string) e-s e-i #f)))
((build-ref-check string-type-disp maximum-string-length string-length-offset type-mutable-string mask-mutable-string string-immutable-flag) e-s e-i #f)))
(define-inline 2 $string-ref-check?
[(e-s e-i) (bind #t (e-s e-i) (build-string-ref-check e-s e-i))])
(define-inline 2 $string-set!-check?
@ -7834,8 +7834,8 @@
(define-inline 3 $string-set-immutable!
[(e-s) ((build-set-immutable! string-type-disp string-immutable-flag) e-s)])))
(let ()
(define build-vector-ref-check (build-ref-check vector-type-disp maximum-vector-length vector-length-offset type-vector mask-vector))
(define build-vector-set!-check (build-ref-check vector-type-disp maximum-vector-length vector-length-offset type-mutable-vector mask-mutable-vector))
(define build-vector-ref-check (build-ref-check vector-type-disp maximum-vector-length vector-length-offset type-vector mask-vector vector-immutable-flag))
(define build-vector-set!-check (build-ref-check vector-type-disp maximum-vector-length vector-length-offset type-mutable-vector mask-mutable-vector vector-immutable-flag))
(define-inline 2 $vector-ref-check?
[(e-v e-i) (bind #t (e-v e-i) (build-vector-ref-check e-v e-i #f))])
(define-inline 2 $vector-set!-check?
@ -7909,7 +7909,7 @@
(lambda (index)
(%inline u<
(immediate ,(logor (ash (+ index (fx- bytes 1)) (constant bytevector-length-offset))
(constant type-bytevector)))
(constant type-bytevector) (constant bytevector-immutable-flag)))
,t))]
[else
(build-and