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

unsafe-{string,bytes}-{ref,set,length}

Browse Source 
svn: r16490
This commit is contained in:
Matthew Flatt 2009-10-31 02:19:57 +00:00
parent b61029e089
commit 70560372b7
9 changed files with 322 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/scribblings/reference/unsafe.scrbl
View File

@ -130,7 +130,7 @@ Unsafe variants of @scheme[car], @scheme[cdr], @scheme[mcar],
@deftogether[( @deftogether[(
@defproc[(unsafe-vector-length [v vector?]) fixnum?] @defproc[(unsafe-vector-length [v vector?]) fixnum?]
@defproc[(unsafe-vector-ref [v vector?][k fixnum?]) any/c] @defproc[(unsafe-vector-ref [v vector?][k fixnum?]) any/c]
@defproc[(unsafe-vector-set! [v vector?][k fixnum?][val any/c]) any/c] @defproc[(unsafe-vector-set! [v vector?][k fixnum?][val any/c]) void?]
)]{ )]{
Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and
@ -139,10 +139,35 @@ Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and
fixnum).} fixnum).}
@deftogether[(
@defproc[(unsafe-string-length [str string?]) fixnum?]
@defproc[(unsafe-string-ref [str string?][k fixnum?])
(and/c char? (lambda (ch) (<= 0 (char->integer ch) 255)))]
@defproc[(unsafe-string-set! [str (and/c string? (not/c immutable?))][k fixnum?][ch char?]) void?]
)]{
Unsafe versions of @scheme[string-length], @scheme[string-ref], and
@scheme[string-set!]. The @scheme[unsafe-string-ref] procedure can be used
only when the result will be a Latin-1 character. A string's size can
never be larger than a @tech{fixnum} (so even @scheme[string-length]
always returns a fixnum).}
@deftogether[(
@defproc[(unsafe-bytes-length [bstr bytes?]) fixnum?]
@defproc[(unsafe-bytes-ref [bstr bytes?][k fixnum?]) byte?]
@defproc[(unsafe-bytes-set! [bstr (and/c bytes? (not/c immutable?))][k fixnum?][b byte?]) void?]
)]{
Unsafe versions of @scheme[bytes-length], @scheme[bytes-ref], and
@scheme[bytes-set!]. A bytes's size can never be larger than a
@tech{fixnum} (so even @scheme[bytes-length] always returns a
fixnum).}
@deftogether[( @deftogether[(
@defproc[(unsafe-struct-ref [v any/c][k fixnum?]) any/c] @defproc[(unsafe-struct-ref [v any/c][k fixnum?]) any/c]
@defproc[(unsafe-struct-set! [v any/c][k fixnum?][val any/c]) any/c] @defproc[(unsafe-struct-set! [v any/c][k fixnum?][val any/c]) void?]
)]{ )]{
Unsafe field access and update for an instance of a structure Unsafe field access and update for an instance of a structure

5
collects/tests/mzscheme/optimize.ss
View File

@ -553,6 +553,11 @@
(quote-syntax no!)) (quote-syntax no!))
''ok) ''ok)
(test-comp '(lambda (x) (if x x #f))
'(lambda (x) x))
(test-comp '(lambda (x) (if (cons 1 x) 78 78))
'(lambda (x) 78))
(test-comp '(values 10) (test-comp '(values 10)
10) 10)
(test-comp '(let ([x (values 10)]) (test-comp '(let ([x (values 10)])

20
collects/tests/mzscheme/unsafe.ss
View File

@ -165,9 +165,25 @@
(test-bin 5 'unsafe-vector-ref #(1 5 7) 1) (test-bin 5 'unsafe-vector-ref #(1 5 7) 1)
(test-un 3 'unsafe-vector-length #(1 5 7)) (test-un 3 'unsafe-vector-length #(1 5 7))
(let ([v (vector 0 3 7)]) (let ([v (vector 0 3 7)])
(test-tri 5 'unsafe-vector-set! v 2 5 (test-tri (list (void) 5) 'unsafe-vector-set! v 2 5
#:pre (lambda () (vector-set! v 2 0)) #:pre (lambda () (vector-set! v 2 0))
#:post (lambda (x) (vector-ref v 2)) #:post (lambda (x) (list x (vector-ref v 2)))
#:literal-ok? #f))
(test-bin 53 'unsafe-bytes-ref #"157" 1)
(test-un 3 'unsafe-bytes-length #"157")
(let ([v (bytes 0 3 7)])
(test-tri (list (void) 135) 'unsafe-bytes-set! v 2 135
#:pre (lambda () (bytes-set! v 2 0))
#:post (lambda (x) (list x (bytes-ref v 2)))
#:literal-ok? #f))
(test-bin #\5 'unsafe-string-ref "157" 1)
(test-un 3 'unsafe-string-length "157")
(let ([v (string #\0 #\3 #\7)])
(test-tri (list (void) #\5) 'unsafe-string-set! v 2 #\5
#:pre (lambda () (string-set! v 2 #\0))
#:post (lambda (x) (list x (string-ref v 2)))
#:literal-ok? #f)) #:literal-ok? #f))
(let () (let ()

82
src/mzscheme/src/cstartup.inc
View File

@ -1,43 +1,43 @@
{ {
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,50,50,0,0,0,1,0,0,3,0,12,0, static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,50,0,0,0,1,0,0,3,0,12,0,
16,0,21,0,28,0,41,0,44,0,48,0,53,0,60,0,67,0,72,0,78, 17,0,21,0,26,0,31,0,35,0,42,0,45,0,58,0,65,0,72,0,78,
0,92,0,106,0,109,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0, 0,92,0,106,0,109,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0,
177,0,179,0,193,0,4,1,33,1,44,1,55,1,65,1,101,1,134,1,167, 177,0,179,0,193,0,4,1,33,1,44,1,55,1,65,1,101,1,134,1,167,
1,226,1,36,2,114,2,180,2,185,2,205,2,96,3,116,3,167,3,233,3, 1,226,1,36,2,114,2,180,2,185,2,205,2,96,3,116,3,167,3,233,3,
118,4,4,5,56,5,79,5,158,5,0,0,105,7,0,0,29,11,11,68,104, 118,4,4,5,56,5,79,5,158,5,0,0,105,7,0,0,29,11,11,68,104,
101,114,101,45,115,116,120,63,97,110,100,64,99,111,110,100,66,100,101,102,105, 101,114,101,45,115,116,120,64,108,101,116,42,63,108,101,116,64,119,104,101,110,
110,101,72,112,97,114,97,109,101,116,101,114,105,122,101,62,111,114,63,108,101, 64,99,111,110,100,63,97,110,100,66,108,101,116,114,101,99,62,111,114,72,112,
116,64,108,101,116,42,66,117,110,108,101,115,115,66,108,101,116,114,101,99,64, 97,114,97,109,101,116,101,114,105,122,101,66,100,101,102,105,110,101,66,117,110,
119,104,101,110,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110, 108,101,115,115,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110,
101,108,11,29,94,2,13,68,35,37,112,97,114,97,109,122,11,62,105,102,65, 101,108,11,29,94,2,13,68,35,37,112,97,114,97,109,122,11,62,105,102,65,
98,101,103,105,110,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101, 98,101,103,105,110,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101,
115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109, 115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,
98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110, 98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,
45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97, 45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97,
35,11,8,240,207,68,0,0,95,159,2,15,35,35,159,2,14,35,35,159,2, 35,11,8,240,70,69,0,0,95,159,2,15,35,35,159,2,14,35,35,159,2,
14,35,35,16,20,2,3,2,1,2,4,2,1,2,5,2,1,2,6,2,1, 14,35,35,16,20,2,9,2,1,2,3,2,1,2,4,2,1,2,5,2,1,
2,7,2,1,2,8,2,1,2,9,2,1,2,10,2,1,2,11,2,1,2, 2,6,2,1,2,7,2,1,2,8,2,1,2,10,2,1,2,11,2,1,2,
12,2,1,97,36,11,8,240,207,68,0,0,93,159,2,14,35,36,16,2,2, 12,2,1,97,36,11,8,240,70,69,0,0,93,159,2,14,35,36,16,2,2,
2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,207,68,0,0,16, 2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,70,69,0,0,16,
0,96,37,11,8,240,207,68,0,0,16,0,13,16,4,35,29,11,11,2,1, 0,96,37,11,8,240,70,69,0,0,16,0,13,16,4,35,29,11,11,2,1,
11,18,16,2,99,64,104,101,114,101,8,31,8,30,8,29,8,28,8,27,93, 11,18,16,2,99,64,104,101,114,101,8,31,8,30,8,29,8,28,8,27,93,
8,224,214,68,0,0,95,9,8,224,214,68,0,0,2,1,27,248,22,137,4, 8,224,77,69,0,0,95,9,8,224,77,69,0,0,2,1,27,248,22,137,4,
195,249,22,130,4,80,158,38,35,251,22,77,2,16,248,22,92,199,12,249,22, 195,249,22,130,4,80,158,38,35,251,22,77,2,16,248,22,92,199,12,249,22,
67,2,17,248,22,94,201,27,248,22,137,4,195,249,22,130,4,80,158,38,35, 67,2,17,248,22,94,201,27,248,22,137,4,195,249,22,130,4,80,158,38,35,
251,22,77,2,16,248,22,92,199,249,22,67,2,17,248,22,94,201,12,27,248, 251,22,77,2,16,248,22,92,199,249,22,67,2,17,248,22,94,201,12,27,248,
22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22, 22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,
75,248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,251,22,77,2, 75,248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,251,22,77,2,
16,248,22,68,199,249,22,67,2,3,248,22,69,201,11,18,16,2,101,10,8, 16,248,22,68,199,249,22,67,2,7,248,22,69,201,11,18,16,2,101,10,8,
31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118, 31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,
49,48,57,50,50,16,4,11,11,2,19,3,1,8,101,110,118,49,48,57,50, 49,49,48,51,49,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,51,
51,93,8,224,215,68,0,0,95,9,8,224,215,68,0,0,2,1,27,248,22, 50,93,8,224,78,69,0,0,95,9,8,224,78,69,0,0,2,1,27,248,22,
69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,75, 69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,35,36,28,248,22,75,
248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,250,22,77,2,20, 248,22,69,194,248,22,68,193,249,22,130,4,80,158,38,35,250,22,77,2,20,
248,22,77,249,22,77,248,22,77,2,21,248,22,68,201,251,22,77,2,16,2, 248,22,77,249,22,77,248,22,77,2,21,248,22,68,201,251,22,77,2,16,2,
21,2,21,249,22,67,2,7,248,22,69,204,18,16,2,101,11,8,31,8,30, 21,2,21,249,22,67,2,9,248,22,69,204,18,16,2,101,11,8,31,8,30,
8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,49,48,57, 8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,49,49,48,
50,53,16,4,11,11,2,19,3,1,8,101,110,118,49,48,57,50,54,93,8, 51,52,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,51,53,93,8,
224,216,68,0,0,95,9,8,224,216,68,0,0,2,1,248,22,137,4,193,27, 224,79,69,0,0,95,9,8,224,79,69,0,0,2,1,248,22,137,4,193,27,
248,22,137,4,194,249,22,67,248,22,77,248,22,68,196,248,22,69,195,27,248, 248,22,137,4,194,249,22,67,248,22,77,248,22,68,196,248,22,69,195,27,248,
22,69,248,22,137,4,23,197,1,249,22,130,4,80,158,38,35,28,248,22,53, 22,69,248,22,137,4,23,197,1,249,22,130,4,80,158,38,35,28,248,22,53,
248,22,131,4,248,22,68,23,198,2,27,249,22,2,32,0,89,162,8,44,36, 248,22,131,4,248,22,68,23,198,2,27,249,22,2,32,0,89,162,8,44,36,
@ -51,8 +51,8 @@
249,22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,137,4,248,22, 249,22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,137,4,248,22,
68,201,248,22,69,198,27,248,22,69,248,22,137,4,196,27,248,22,137,4,248, 68,201,248,22,69,198,27,248,22,69,248,22,137,4,196,27,248,22,137,4,248,
22,68,195,249,22,130,4,80,158,39,35,28,248,22,75,195,250,22,78,2,20, 22,68,195,249,22,130,4,80,158,39,35,28,248,22,75,195,250,22,78,2,20,
9,248,22,69,199,250,22,77,2,8,248,22,77,248,22,68,199,250,22,78,2, 9,248,22,69,199,250,22,77,2,4,248,22,77,248,22,68,199,250,22,78,2,
9,248,22,69,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27, 3,248,22,69,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27,
249,22,1,22,81,249,22,2,22,137,4,248,22,137,4,248,22,68,199,249,22, 249,22,1,22,81,249,22,2,22,137,4,248,22,137,4,248,22,68,199,249,22,
130,4,80,158,39,35,251,22,77,1,22,119,105,116,104,45,99,111,110,116,105, 130,4,80,158,39,35,251,22,77,1,22,119,105,116,104,45,99,111,110,116,105,
110,117,97,116,105,111,110,45,109,97,114,107,2,24,250,22,78,1,23,101,120, 110,117,97,116,105,111,110,45,109,97,114,107,2,24,250,22,78,1,23,101,120,
@ -62,14 +62,14 @@
22,69,203,27,248,22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36, 22,69,203,27,248,22,69,248,22,137,4,196,28,248,22,75,193,20,15,159,36,
35,36,249,22,130,4,80,158,38,35,27,248,22,137,4,248,22,68,197,28,249, 35,36,249,22,130,4,80,158,38,35,27,248,22,137,4,248,22,68,197,28,249,
22,167,8,62,61,62,248,22,131,4,248,22,92,196,250,22,77,2,20,248,22, 22,167,8,62,61,62,248,22,131,4,248,22,92,196,250,22,77,2,20,248,22,
77,249,22,77,21,93,2,25,248,22,68,199,250,22,78,2,4,249,22,77,2, 77,249,22,77,21,93,2,25,248,22,68,199,250,22,78,2,6,249,22,77,2,
25,249,22,77,248,22,101,203,2,25,248,22,69,202,251,22,77,2,16,28,249, 25,249,22,77,248,22,101,203,2,25,248,22,69,202,251,22,77,2,16,28,249,
22,167,8,248,22,131,4,248,22,68,200,64,101,108,115,101,10,248,22,68,197, 22,167,8,248,22,131,4,248,22,68,200,64,101,108,115,101,10,248,22,68,197,
250,22,78,2,20,9,248,22,69,200,249,22,67,2,4,248,22,69,202,100,8, 250,22,78,2,20,9,248,22,69,200,249,22,67,2,6,248,22,69,202,100,8,
31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118, 31,8,30,8,29,8,28,8,27,16,4,11,11,2,18,3,1,8,101,110,118,
49,48,57,52,56,16,4,11,11,2,19,3,1,8,101,110,118,49,48,57,52, 49,49,48,53,55,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,53,
57,93,8,224,217,68,0,0,18,16,2,158,94,10,64,118,111,105,100,8,47, 56,93,8,224,80,69,0,0,18,16,2,158,94,10,64,118,111,105,100,8,47,
95,9,8,224,217,68,0,0,2,1,27,248,22,69,248,22,137,4,196,249,22, 95,9,8,224,80,69,0,0,2,1,27,248,22,69,248,22,137,4,196,249,22,
130,4,80,158,38,35,28,248,22,53,248,22,131,4,248,22,68,197,250,22,77, 130,4,80,158,38,35,28,248,22,53,248,22,131,4,248,22,68,197,250,22,77,
2,26,248,22,77,248,22,68,199,248,22,92,198,27,248,22,131,4,248,22,68, 2,26,248,22,77,248,22,68,199,248,22,92,198,27,248,22,131,4,248,22,68,
197,250,22,77,2,26,248,22,77,248,22,68,197,250,22,78,2,23,248,22,69, 197,250,22,77,2,26,248,22,77,248,22,68,197,250,22,78,2,23,248,22,69,
@ -81,25 +81,25 @@
2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,35, 2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,35,
45,36,11,11,11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0, 45,36,11,11,11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0,
16,0,35,35,16,11,16,5,2,2,20,15,159,35,35,35,35,20,102,159,35, 16,0,35,35,16,11,16,5,2,2,20,15,159,35,35,35,35,20,102,159,35,
16,0,16,1,33,32,10,16,5,2,10,89,162,8,44,36,52,9,223,0,33, 16,0,16,1,33,32,10,16,5,2,12,89,162,8,44,36,52,9,223,0,33,
33,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,12,89,162,8,44, 33,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,5,89,162,8,44,
36,52,9,223,0,33,34,35,20,102,159,35,16,1,2,2,16,0,11,16,5, 36,52,9,223,0,33,34,35,20,102,159,35,16,1,2,2,16,0,11,16,5,
2,3,89,162,8,44,36,52,9,223,0,33,35,35,20,102,159,35,16,1,2, 2,7,89,162,8,44,36,52,9,223,0,33,35,35,20,102,159,35,16,1,2,
2,16,1,33,36,11,16,5,2,7,89,162,8,44,36,55,9,223,0,33,37, 2,16,1,33,36,11,16,5,2,9,89,162,8,44,36,55,9,223,0,33,37,
35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,8,89,162,8, 35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,4,89,162,8,
44,36,57,9,223,0,33,41,35,20,102,159,35,16,1,2,2,16,0,11,16, 44,36,57,9,223,0,33,41,35,20,102,159,35,16,1,2,2,16,0,11,16,
5,2,11,89,162,8,44,36,52,9,223,0,33,43,35,20,102,159,35,16,1, 5,2,8,89,162,8,44,36,52,9,223,0,33,43,35,20,102,159,35,16,1,
2,2,16,0,11,16,5,2,9,89,162,8,44,36,53,9,223,0,33,44,35, 2,2,16,0,11,16,5,2,3,89,162,8,44,36,53,9,223,0,33,44,35,
20,102,159,35,16,1,2,2,16,0,11,16,5,2,6,89,162,8,44,36,54, 20,102,159,35,16,1,2,2,16,0,11,16,5,2,10,89,162,8,44,36,54,
9,223,0,33,45,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,4, 9,223,0,33,45,35,20,102,159,35,16,1,2,2,16,0,11,16,5,2,6,
89,162,8,44,36,57,9,223,0,33,46,35,20,102,159,35,16,1,2,2,16, 89,162,8,44,36,57,9,223,0,33,46,35,20,102,159,35,16,1,2,2,16,
1,33,48,11,16,5,2,5,89,162,8,44,36,53,9,223,0,33,49,35,20, 1,33,48,11,16,5,2,11,89,162,8,44,36,53,9,223,0,33,49,35,20,
102,159,35,16,1,2,2,16,0,11,16,0,94,2,14,2,15,93,2,14,9, 102,159,35,16,1,2,2,16,0,11,16,0,94,2,14,2,15,93,2,14,9,
9,35,0}; 9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2018); EVAL_ONE_SIZED_STR((char *)expr, 2018);
} }
{ {
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,50,59,0,0,0,1,0,0,13,0,18,0, static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,59,0,0,0,1,0,0,13,0,18,0,
35,0,50,0,68,0,84,0,94,0,112,0,132,0,148,0,166,0,197,0,226, 35,0,50,0,68,0,84,0,94,0,112,0,132,0,148,0,166,0,197,0,226,
0,248,0,6,1,12,1,26,1,31,1,41,1,49,1,77,1,109,1,154,1, 0,248,0,6,1,12,1,26,1,31,1,41,1,49,1,77,1,109,1,154,1,
199,1,223,1,6,2,8,2,65,2,155,3,196,3,31,5,135,5,239,5,100, 199,1,223,1,6,2,8,2,65,2,155,3,196,3,31,5,135,5,239,5,100,
@ -341,12 +341,12 @@
EVAL_ONE_SIZED_STR((char *)expr, 5006); EVAL_ONE_SIZED_STR((char *)expr, 5006);
} }
{ {
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,50,8,0,0,0,1,0,0,6,0,19,0, static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,8,0,0,0,1,0,0,6,0,19,0,
34,0,48,0,62,0,76,0,118,0,0,0,23,1,0,0,65,113,117,111,116, 34,0,48,0,62,0,76,0,118,0,0,0,23,1,0,0,65,113,117,111,116,
101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37, 101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37,
110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122, 110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122,
11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35, 11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35,
37,107,101,114,110,101,108,11,97,35,11,8,240,85,69,0,0,98,159,2,2, 37,107,101,114,110,101,108,11,97,35,11,8,240,204,69,0,0,98,159,2,2,
35,35,159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35, 35,35,159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,
35,159,2,6,35,35,16,0,159,35,20,102,159,35,16,1,11,16,0,83,158, 35,159,2,6,35,35,16,0,159,35,20,102,159,35,16,1,11,16,0,83,158,
41,20,100,144,69,35,37,98,117,105,108,116,105,110,29,11,11,11,11,11,18, 41,20,100,144,69,35,37,98,117,105,108,116,105,110,29,11,11,11,11,11,18,
@ -360,7 +360,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 316); EVAL_ONE_SIZED_STR((char *)expr, 316);
} }
{ {
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,50,56,0,0,0,1,0,0,11,0,38,0, static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,50,46,50,46,53,56,0,0,0,1,0,0,11,0,38,0,
44,0,57,0,66,0,73,0,95,0,117,0,143,0,155,0,173,0,193,0,205, 44,0,57,0,66,0,73,0,95,0,117,0,143,0,155,0,173,0,193,0,205,
0,221,0,244,0,0,1,31,1,38,1,43,1,48,1,53,1,58,1,67,1, 0,221,0,244,0,0,1,31,1,38,1,43,1,48,1,53,1,58,1,67,1,
72,1,76,1,84,1,93,1,101,1,204,1,249,1,13,2,42,2,73,2,129, 72,1,76,1,84,1,93,1,101,1,204,1,249,1,13,2,42,2,73,2,129,

18
src/mzscheme/src/eval.c
View File

@ -2957,6 +2957,18 @@ int scheme_compiled_duplicate_ok(Scheme_Object *fb)
|| SCHEME_PRIMP(fb)); || SCHEME_PRIMP(fb));
} }
static int equivalent_exprs(Scheme_Object *a, Scheme_Object *b)
{
if (SAME_OBJ(a, b))
return 1;
if (SAME_TYPE(SCHEME_TYPE(a), scheme_local_type)
&& SAME_TYPE(SCHEME_TYPE(b), scheme_local_type)
&& (SCHEME_LOCAL_POS(a) == SCHEME_LOCAL_POS(b)))
return 1;
return 0;
}
static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info) static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info)
{ {
Scheme_Branch_Rec *b; Scheme_Branch_Rec *b;
@ -3040,6 +3052,12 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info)
return t; return t;
} }
/* Try optimize: (if <omitable-expr> v v) => v */
if (scheme_omittable_expr(t, 1, 20, 0, NULL)
&& equivalent_exprs(tb, fb)) {
return tb;
}
/* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K) /* Convert: (if (if M N #f) M2 K) => (if M (if N M2 K) K)
for simple constants K. This is useful to expose simple for simple constants K. This is useful to expose simple
tests to the JIT. */ tests to the JIT. */

135
src/mzscheme/src/jit.c
View File

@ -5055,6 +5055,25 @@ static int generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
jit_lshi_l(JIT_R0, JIT_R0, 1); jit_lshi_l(JIT_R0, JIT_R0, 1);
jit_ori_l(JIT_R0, JIT_R0, 0x1); jit_ori_l(JIT_R0, JIT_R0, 0x1);
return 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-string-length")
|| IS_NAMED_PRIM(rator, "unsafe-bytes-length")) {
LOG_IT(("inlined string-length\n"));
mz_runstack_skipped(jitter, 1);
generate_non_tail(app->rand, jitter, 0, 1);
CHECK_LIMIT();
mz_runstack_unskipped(jitter, 1);
if (IS_NAMED_PRIM(rator, "unsafe-string-length"))
(void)jit_ldxi_i(JIT_R0, JIT_R0, &SCHEME_CHAR_STRLEN_VAL(0x0));
else
(void)jit_ldxi_i(JIT_R0, JIT_R0, &SCHEME_BYTE_STRLEN_VAL(0x0));
jit_lshi_l(JIT_R0, JIT_R0, 1);
jit_ori_l(JIT_R0, JIT_R0, 0x1);
return 1; return 1;
} else if (IS_NAMED_PRIM(rator, "unbox")) { } else if (IS_NAMED_PRIM(rator, "unbox")) {
GC_CAN_IGNORE jit_insn *reffail, *ref; GC_CAN_IGNORE jit_insn *reffail, *ref;
@ -5657,7 +5676,9 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
|| IS_NAMED_PRIM(rator, "unsafe-vector-ref") || IS_NAMED_PRIM(rator, "unsafe-vector-ref")
|| IS_NAMED_PRIM(rator, "unsafe-struct-ref") || IS_NAMED_PRIM(rator, "unsafe-struct-ref")
|| IS_NAMED_PRIM(rator, "string-ref") || IS_NAMED_PRIM(rator, "string-ref")
|| IS_NAMED_PRIM(rator, "bytes-ref")) { || IS_NAMED_PRIM(rator, "unsafe-string-ref")
|| IS_NAMED_PRIM(rator, "bytes-ref")
|| IS_NAMED_PRIM(rator, "unsafe-bytes-ref")) {
int simple; int simple;
int which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0)); int which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0));
@ -5672,7 +5693,13 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
base_offset = ((int)&((Scheme_Structure *)0x0)->slots); base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
} else if (IS_NAMED_PRIM(rator, "string-ref")) } else if (IS_NAMED_PRIM(rator, "string-ref"))
which = 1; which = 1;
else else if (IS_NAMED_PRIM(rator, "unsafe-string-ref")) {
which = 1;
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-bytes-ref")) {
which = 2;
unsafe = 1;
} else
which = 2; which = 2;
LOG_IT(("inlined vector-/string-/bytes-ref\n")); LOG_IT(("inlined vector-/string-/bytes-ref\n"));
@ -5684,16 +5711,38 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
generate_two_args(app->rand1, app->rand2, jitter, 1, 2); generate_two_args(app->rand1, app->rand2, jitter, 1, 2);
CHECK_LIMIT(); CHECK_LIMIT();
mz_rs_sync(); if (!unsafe)
mz_rs_sync();
if (!which) { if (!which) {
/* vector-ref is relatively simple and worth inlining */ /* vector-ref is relatively simple and worth inlining */
generate_vector_op(jitter, 0, 0, base_offset, unsafe); generate_vector_op(jitter, 0, 0, base_offset, unsafe);
CHECK_LIMIT(); CHECK_LIMIT();
} else if (which == 1) { } else if (which == 1) {
(void)jit_calli(string_ref_check_index_code); if (unsafe) {
jit_rshi_ul(JIT_R1, JIT_R1, 1);
jit_lshi_ul(JIT_R1, JIT_R1, LOG_MZCHAR_SIZE);
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldxr_p(JIT_R0, JIT_R0, JIT_R1);
(void)jit_movi_p(JIT_R1, scheme_char_constants);
jit_lshi_ul(JIT_R0, JIT_R0, JIT_LOG_WORD_SIZE);
jit_ldxr_p(JIT_R0, JIT_R1, JIT_R0);
CHECK_LIMIT();
} else {
(void)jit_calli(string_ref_check_index_code);
}
} else { } else {
(void)jit_calli(bytes_ref_check_index_code); if (unsafe) {
jit_rshi_ul(JIT_R1, JIT_R1, 1);
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldxr_c(JIT_R0, JIT_R0, JIT_R1);
jit_extr_uc_ul(JIT_R0, JIT_R0);
jit_lshi_l(JIT_R0, JIT_R0, 0x1);
jit_ori_l(JIT_R0, JIT_R0, 0x1);
CHECK_LIMIT();
} else {
(void)jit_calli(bytes_ref_check_index_code);
}
} }
} else { } else {
long offset; long offset;
@ -5718,9 +5767,26 @@ static int generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
generate_vector_op(jitter, 0, 1, base_offset, unsafe); generate_vector_op(jitter, 0, 1, base_offset, unsafe);
CHECK_LIMIT(); CHECK_LIMIT();
} else if (which == 1) { } else if (which == 1) {
(void)jit_calli(string_ref_code); if (unsafe) {
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldxr_p(JIT_R0, JIT_R0, JIT_V1);
(void)jit_movi_p(JIT_R1, scheme_char_constants);
jit_lshi_ul(JIT_R0, JIT_R0, JIT_LOG_WORD_SIZE);
jit_ldxr_p(JIT_R0, JIT_R1, JIT_R0);
CHECK_LIMIT();
} else {
(void)jit_calli(string_ref_code);
}
} else { } else {
(void)jit_calli(bytes_ref_code); if (unsafe) {
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldxr_c(JIT_R0, JIT_R0, JIT_V1);
jit_extr_uc_ul(JIT_R0, JIT_R0);
jit_lshi_l(JIT_R0, JIT_R0, 0x1);
jit_ori_l(JIT_R0, JIT_R0, 0x1);
} else {
(void)jit_calli(bytes_ref_code);
}
} }
mz_runstack_unskipped(jitter, 2); mz_runstack_unskipped(jitter, 2);
@ -5889,7 +5955,9 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
|| IS_NAMED_PRIM(rator, "unsafe-vector-set!") || IS_NAMED_PRIM(rator, "unsafe-vector-set!")
|| IS_NAMED_PRIM(rator, "unsafe-struct-set!") || IS_NAMED_PRIM(rator, "unsafe-struct-set!")
|| IS_NAMED_PRIM(rator, "string-set!") || IS_NAMED_PRIM(rator, "string-set!")
|| IS_NAMED_PRIM(rator, "bytes-set!")) { || IS_NAMED_PRIM(rator, "unsafe-string-set!")
|| IS_NAMED_PRIM(rator, "bytes-set!")
|| IS_NAMED_PRIM(rator, "unsafe-bytes-set!")) {
int simple, constval; int simple, constval;
int which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0)); int which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0));
int pushed; int pushed;
@ -5905,7 +5973,13 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
base_offset = ((int)&((Scheme_Structure *)0x0)->slots); base_offset = ((int)&((Scheme_Structure *)0x0)->slots);
} else if (IS_NAMED_PRIM(rator, "string-set!")) } else if (IS_NAMED_PRIM(rator, "string-set!"))
which = 1; which = 1;
else else if (IS_NAMED_PRIM(rator, "unsafe-string-set!")) {
which = 1;
unsafe = 1;
} else if (IS_NAMED_PRIM(rator, "unsafe-bytes-set!")) {
which = 2;
unsafe = 1;
} else
which = 2; which = 2;
LOG_IT(("inlined vector-set!\n")); LOG_IT(("inlined vector-set!\n"));
@ -5970,9 +6044,28 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
generate_vector_op(jitter, 1, 0, base_offset, unsafe); generate_vector_op(jitter, 1, 0, base_offset, unsafe);
CHECK_LIMIT(); CHECK_LIMIT();
} else if (which == 1) { } else if (which == 1) {
(void)jit_calli(string_set_check_index_code); if (unsafe) {
jit_rshi_ul(JIT_R1, JIT_R1, 1);
jit_lshi_ul(JIT_R1, JIT_R1, LOG_MZCHAR_SIZE);
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldr_p(JIT_R2, JIT_RUNSTACK);
jit_ldxi_i(JIT_R2, JIT_R2, &((Scheme_Small_Object *)0x0)->u.char_val);
jit_stxr_p(JIT_R1, JIT_R0, JIT_R2);
(void)jit_movi_p(JIT_R0, scheme_void);
} else {
(void)jit_calli(string_set_check_index_code);
}
} else { } else {
(void)jit_calli(bytes_set_check_index_code); if (unsafe) {
jit_rshi_ul(JIT_R1, JIT_R1, 1);
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_BYTE_STR_VAL((Scheme_Object *)0x0));
jit_ldr_p(JIT_R2, JIT_RUNSTACK);
jit_rshi_ul(JIT_R2, JIT_R2, 1);
jit_stxr_c(JIT_R1, JIT_R0, JIT_R2);
(void)jit_movi_p(JIT_R0, scheme_void);
} else {
(void)jit_calli(bytes_set_check_index_code);
}
} }
} else { } else {
long offset; long offset;
@ -5988,9 +6081,25 @@ static int generate_inlined_nary(mz_jit_state *jitter, Scheme_App_Rec *app, int
generate_vector_op(jitter, 1, 1, base_offset, unsafe); generate_vector_op(jitter, 1, 1, base_offset, unsafe);
CHECK_LIMIT(); CHECK_LIMIT();
} else if (which == 1) { } else if (which == 1) {
(void)jit_calli(string_set_code); if (unsafe) {
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldr_p(JIT_R2, JIT_RUNSTACK);
jit_ldxi_i(JIT_R2, JIT_R2, &((Scheme_Small_Object *)0x0)->u.char_val);
jit_stxr_p(JIT_V1, JIT_R0, JIT_R2);
(void)jit_movi_p(JIT_R0, scheme_void);
} else {
(void)jit_calli(string_set_code);
}
} else { } else {
(void)jit_calli(bytes_set_code); if (unsafe) {
jit_ldxi_p(JIT_R0, JIT_R0, &SCHEME_CHAR_STR_VAL((Scheme_Object *)0x0));
jit_ldr_p(JIT_R2, JIT_RUNSTACK);
jit_rshi_ul(JIT_R2, JIT_R2, 1);
jit_stxr_c(JIT_V1, JIT_R0, JIT_R2);
(void)jit_movi_p(JIT_R0, scheme_void);
} else {
(void)jit_calli(bytes_set_code);
}
} }
} }

2
src/mzscheme/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 959 #define EXPECTED_PRIM_COUNT 959
#define EXPECTED_UNSAFE_COUNT 41 #define EXPECTED_UNSAFE_COUNT 47
#ifdef MZSCHEME_SOMETHING_OMITTED #ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP # undef USE_COMPILED_STARTUP

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "4.2.2.4" #define MZSCHEME_VERSION "4.2.2.5"
#define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 2 #define MZSCHEME_VERSION_Z 2
#define MZSCHEME_VERSION_W 4 #define MZSCHEME_VERSION_W 5
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

88
src/mzscheme/src/vector.c
View File

@ -47,6 +47,12 @@ static Scheme_Object *unsafe_vector_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_vector_set (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_vector_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_struct_ref (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_struct_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_struct_set (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_struct_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_string_len (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_string_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_string_set (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_bytes_len (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_bytes_ref (int argc, Scheme_Object *argv[]);
static Scheme_Object *unsafe_bytes_set (int argc, Scheme_Object *argv[]);
void void
scheme_init_vector (Scheme_Env *env) scheme_init_vector (Scheme_Env *env)
@ -165,6 +171,49 @@ scheme_init_unsafe_vector (Scheme_Env *env)
3, 3); 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED; SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-struct-set!", p, env); scheme_add_global_constant("unsafe-struct-set!", p, env);
p = scheme_make_immed_prim(unsafe_string_len,
"unsafe-string-length",
1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("unsafe-string-length", p, env);
p = scheme_make_immed_prim(unsafe_string_ref,
"unsafe-string-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("unsafe-string-ref", p, env);
p = scheme_make_immed_prim(unsafe_string_set,
"unsafe-string-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-string-set!", p, env);
p = scheme_make_immed_prim(unsafe_string_ref,
"unsafe-string-ref",
2, 2);
p = scheme_make_immed_prim(unsafe_bytes_len,
"unsafe-bytes-length",
1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("unsafe-bytes-length", p, env);
p = scheme_make_immed_prim(unsafe_bytes_ref,
"unsafe-bytes-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("unsafe-bytes-ref", p, env);
p = scheme_make_immed_prim(unsafe_bytes_set,
"unsafe-bytes-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-bytes-set!", p, env);
p = scheme_make_immed_prim(unsafe_bytes_ref,
"unsafe-bytes-ref",
2, 2);
} }
#define VECTOR_BYTES(size) (sizeof(Scheme_Vector) + ((size) - 1) * sizeof(Scheme_Object *)) #define VECTOR_BYTES(size) (sizeof(Scheme_Vector) + ((size) - 1) * sizeof(Scheme_Object *))
@ -553,3 +602,42 @@ static Scheme_Object *unsafe_struct_set (int argc, Scheme_Object *argv[])
((Scheme_Structure *)argv[0])->slots[SCHEME_INT_VAL(argv[1])] = argv[2]; ((Scheme_Structure *)argv[0])->slots[SCHEME_INT_VAL(argv[1])] = argv[2];
return scheme_void; return scheme_void;
} }
static Scheme_Object *unsafe_string_len (int argc, Scheme_Object *argv[])
{
long n = SCHEME_CHAR_STRLEN_VAL(argv[0]);
return scheme_make_integer(n);
}
static Scheme_Object *unsafe_string_ref (int argc, Scheme_Object *argv[])
{
mzchar v;
v = SCHEME_CHAR_STR_VAL(argv[0])[SCHEME_INT_VAL(argv[1])];
return scheme_make_ascii_character(v);
}
static Scheme_Object *unsafe_string_set (int argc, Scheme_Object *argv[])
{
SCHEME_CHAR_STR_VAL(argv[0])[SCHEME_INT_VAL(argv[1])] = SCHEME_CHAR_VAL(argv[2]);
return scheme_void;
}
static Scheme_Object *unsafe_bytes_len (int argc, Scheme_Object *argv[])
{
long n = SCHEME_BYTE_STRLEN_VAL(argv[0]);
return scheme_make_integer(n);
}
static Scheme_Object *unsafe_bytes_ref (int argc, Scheme_Object *argv[])
{
long v;
v = (unsigned char)SCHEME_BYTE_STR_VAL(argv[0])[SCHEME_INT_VAL(argv[1])];
return scheme_make_integer(v);
}
static Scheme_Object *unsafe_bytes_set (int argc, Scheme_Object *argv[])
{
SCHEME_BYTE_STR_VAL(argv[0])[SCHEME_INT_VAL(argv[1])] = (char)SCHEME_INT_VAL(argv[2]);
return scheme_void;
}