suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix check of size of make-phantom-bytevector in 32 bits

Browse Source 
original commit: d44ab30993fdf085566ecd71b0f7db9a50eb0cc5
This commit is contained in:
Gustavo Massaccesi 2019-04-07 22:25:29 -03:00
parent 67f15c1d99
commit 25cfadaeec
2 changed files with 12 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
s/primdata.ss
View File

@ -1515,7 +1515,7 @@
(path-rest [sig [(pathname) -> (pathname)]] [flags true #;cp02])
(path-root [sig [(pathname) -> (pathname)]] [flags true #;cp02])
(phantom-bytevector? [sig [(ptr) -> (boolean)]] [flags pure mifoldable discard])
(phantom-bytevector-length [sig [(ptr) -> (ptr)]] [flags true])
(phantom-bytevector-length [sig [(ptr) -> (uptr)]] [flags true])
(port-bol? [sig [(textual-output-port) -> (boolean)]] [flags discard])
(port-closed? [sig [(port) -> (boolean)]] [flags discard])
(port-file-descriptor [sig [(port) -> (ufixnum)]] [flags discard])
@ -1596,7 +1596,7 @@
(set-binary-port-output-index! [sig [(binary-output-port sub-index) -> (void)]] [flags true])
(set-binary-port-output-size! [sig [(binary-output-port sub-length) -> (void)]] [flags true])
(set-box! [sig [(box ptr) -> (void)]] [flags true])
(set-phantom-bytevector-length! [sig [(ptr ptr) -> (void)]] [flags true])
(set-phantom-bytevector-length! [sig [(ptr uptr) -> (void)]] [flags true])
(set-port-bol! [sig [(textual-output-port ptr) -> (void)]] [flags true])
(set-port-eof! [sig [(input-port ptr) -> (void)]] [flags true])
(set-port-input-buffer! [sig [(input-port sub-ptr) -> (void)]] [flags true])

12
s/prims.ss
View File

@ -1880,7 +1880,11 @@
(set-who! make-phantom-bytevector
(lambda (n)
(unless (and ($integer-64? n) (>= n 0))
(define addr?
(constant-case ptr-bits
[(32) $integer-32?]
[(64) $integer-64?]))
(unless (and (addr? n) (>= n 0))
($oops who "~s is not a valid phantom bytevector length" n))
(let ([ph ($make-phantom-bytevector)])
($phantom-bytevector-adjust! ph n)
@ -1893,8 +1897,12 @@
(set-who! set-phantom-bytevector-length!
(lambda (ph n)
(define addr?
(constant-case ptr-bits
[(32) $integer-32?]
[(64) $integer-64?]))
(unless (phantom-bytevector? ph) ($oops who "~s is not a phantom bytevector" ph))
(unless (and ($integer-64? n) (>= n 0))
(unless (and (addr? n) (>= n 0))
($oops who "~s is not a valid phantom bytevector length" n))
($phantom-bytevector-adjust! ph n))))