From 70560372b79bb7f00a4cb6eb342904a60aaa3cec Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 31 Oct 2009 02:19:57 +0000 Subject: [PATCH] unsafe-{string,bytes}-{ref,set,length} svn: r16490 --- collects/scribblings/reference/unsafe.scrbl | 29 ++++- collects/tests/mzscheme/optimize.ss | 5 + collects/tests/mzscheme/unsafe.ss | 20 ++- src/mzscheme/src/cstartup.inc | 82 ++++++------ src/mzscheme/src/eval.c | 18 +++ src/mzscheme/src/jit.c | 135 ++++++++++++++++++-- src/mzscheme/src/schminc.h | 2 +- src/mzscheme/src/schvers.h | 4 +- src/mzscheme/src/vector.c | 88 +++++++++++++ 9 files changed, 322 insertions(+), 61 deletions(-) diff --git a/collects/scribblings/reference/unsafe.scrbl b/collects/scribblings/reference/unsafe.scrbl index e1bb4a7692..f01ba82236 100644 --- a/collects/scribblings/reference/unsafe.scrbl +++ b/collects/scribblings/reference/unsafe.scrbl @@ -130,7 +130,7 @@ Unsafe variants of @scheme[car], @scheme[cdr], @scheme[mcar], @deftogether[( @defproc[(unsafe-vector-length [v vector?]) fixnum?] @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 @@ -139,10 +139,35 @@ Unsafe versions of @scheme[vector-length], @scheme[vector-ref], and 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[( @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 diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss index 9f9d3ba63e..f221dca2d6 100644 --- a/collects/tests/mzscheme/optimize.ss +++ b/collects/tests/mzscheme/optimize.ss @@ -553,6 +553,11 @@ (quote-syntax no!)) ''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) 10) (test-comp '(let ([x (values 10)]) diff --git a/collects/tests/mzscheme/unsafe.ss b/collects/tests/mzscheme/unsafe.ss index ea1c466a2b..71f7aac5ae 100644 --- a/collects/tests/mzscheme/unsafe.ss +++ b/collects/tests/mzscheme/unsafe.ss @@ -165,9 +165,25 @@ (test-bin 5 'unsafe-vector-ref #(1 5 7) 1) (test-un 3 'unsafe-vector-length #(1 5 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)) - #: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)) (let () diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index c515e3d6ff..e675158c0c 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -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, -16,0,21,0,28,0,41,0,44,0,48,0,53,0,60,0,67,0,72,0,78, + 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, +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, 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, 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, -110,101,72,112,97,114,97,109,101,116,101,114,105,122,101,62,111,114,63,108,101, -116,64,108,101,116,42,66,117,110,108,101,115,115,66,108,101,116,114,101,99,64, -119,104,101,110,65,113,117,111,116,101,29,94,2,13,68,35,37,107,101,114,110, +101,114,101,45,115,116,120,64,108,101,116,42,63,108,101,116,64,119,104,101,110, +64,99,111,110,100,63,97,110,100,66,108,101,116,114,101,99,62,111,114,72,112, +97,114,97,109,101,116,101,114,105,122,101,66,100,101,102,105,110,101,66,117,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, 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, 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, -35,11,8,240,207,68,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, -2,7,2,1,2,8,2,1,2,9,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, -2,161,2,1,36,2,2,2,1,2,2,96,11,11,8,240,207,68,0,0,16, -0,96,37,11,8,240,207,68,0,0,16,0,13,16,4,35,29,11,11,2,1, +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,9,2,1,2,3,2,1,2,4,2,1,2,5,2,1, +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,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,70,69,0,0,16, +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, -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, 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, 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, -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, -49,48,57,50,50,16,4,11,11,2,19,3,1,8,101,110,118,49,48,57,50, -51,93,8,224,215,68,0,0,95,9,8,224,215,68,0,0,2,1,27,248,22, +49,49,48,51,49,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,51, +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, 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, -21,2,21,249,22,67,2,7,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, -50,53,16,4,11,11,2,19,3,1,8,101,110,118,49,48,57,50,54,93,8, -224,216,68,0,0,95,9,8,224,216,68,0,0,2,1,248,22,137,4,193,27, +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,49,48, +51,52,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,51,53,93,8, +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, 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, @@ -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, 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, -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,201,248,22,69,202,27,248,22,69,248,22,137,4,23,197,1,27, +9,248,22,69,199,250,22,77,2,4,248,22,77,248,22,68,199,250,22,78,2, +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, 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, @@ -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, 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, -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, 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, -49,48,57,52,56,16,4,11,11,2,19,3,1,8,101,110,118,49,48,57,52, -57,93,8,224,217,68,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, +49,49,48,53,55,16,4,11,11,2,19,3,1,8,101,110,118,49,49,48,53, +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,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, 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, @@ -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, 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,16,1,33,32,10,16,5,2,10,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, +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,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, -2,3,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, -35,20,102,159,35,16,1,2,2,16,1,33,38,11,16,5,2,8,89,162,8, +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,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,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, -5,2,11,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, -20,102,159,35,16,1,2,2,16,0,11,16,5,2,6,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, +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,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,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,6, 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, 9,35,0}; 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, 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, @@ -341,12 +341,12 @@ 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, 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, 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,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, @@ -360,7 +360,7 @@ 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, 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, diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index dc1bdbe97b..e08624c04a 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -2957,6 +2957,18 @@ int scheme_compiled_duplicate_ok(Scheme_Object *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) { Scheme_Branch_Rec *b; @@ -3040,6 +3052,12 @@ static Scheme_Object *optimize_branch(Scheme_Object *o, Optimize_Info *info) return t; } + /* Try optimize: (if 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) for simple constants K. This is useful to expose simple tests to the JIT. */ diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index aa1efc5b06..62d02db681 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -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_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; } else if (IS_NAMED_PRIM(rator, "unbox")) { 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-struct-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 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); } else if (IS_NAMED_PRIM(rator, "string-ref")) 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; 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); CHECK_LIMIT(); - mz_rs_sync(); + if (!unsafe) + mz_rs_sync(); if (!which) { /* vector-ref is relatively simple and worth inlining */ generate_vector_op(jitter, 0, 0, base_offset, unsafe); CHECK_LIMIT(); } 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 { - (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 { 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); CHECK_LIMIT(); } 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 { - (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); @@ -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-struct-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 which, unsafe = 0, base_offset = ((int)&SCHEME_VEC_ELS(0x0)); 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); } else if (IS_NAMED_PRIM(rator, "string-set!")) 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; 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); CHECK_LIMIT(); } 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 { - (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 { 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); CHECK_LIMIT(); } 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 { - (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); + } } } diff --git a/src/mzscheme/src/schminc.h b/src/mzscheme/src/schminc.h index 719168ccde..35c3b7afb3 100644 --- a/src/mzscheme/src/schminc.h +++ b/src/mzscheme/src/schminc.h @@ -14,7 +14,7 @@ #define USE_COMPILED_STARTUP 1 #define EXPECTED_PRIM_COUNT 959 -#define EXPECTED_UNSAFE_COUNT 41 +#define EXPECTED_UNSAFE_COUNT 47 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index 53133e62eb..5ce9e8d09a 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.2.2.4" +#define MZSCHEME_VERSION "4.2.2.5" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 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_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/vector.c b/src/mzscheme/src/vector.c index 4eddbc1920..3a3d661da4 100644 --- a/src/mzscheme/src/vector.c +++ b/src/mzscheme/src/vector.c @@ -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_struct_ref (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 scheme_init_vector (Scheme_Env *env) @@ -165,6 +171,49 @@ scheme_init_unsafe_vector (Scheme_Env *env) 3, 3); SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED; 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 *)) @@ -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]; 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; +} +