diff --git a/.makefile b/.makefile index 91319fb45d..42b4f11fde 100644 --- a/.makefile +++ b/.makefile @@ -338,7 +338,7 @@ RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) # This branch name changes each time the pb boot files are updated: -PB_BRANCH == circa-7.9.0.5-1 +PB_BRANCH == circa-7.9.0.6-1 PB_REPO = https://github.com/racket/pb # Alternative source for Chez Scheme boot files, normally set by diff --git a/Makefile b/Makefile index f1c1b5de86..173d502c9b 100644 --- a/Makefile +++ b/Makefile @@ -47,7 +47,7 @@ RACKETCS_SUFFIX = RACKET = RACKET_FOR_BOOTFILES = $(RACKET) RACKET_FOR_BUILD = $(RACKET) -PB_BRANCH = circa-7.9.0.5-1 +PB_BRANCH = circa-7.9.0.6-1 PB_REPO = https://github.com/racket/pb EXTRA_REPOS_BASE = CS_CROSS_SUFFIX = @@ -306,14 +306,14 @@ maybe-fetch-pb-as-is: echo done fetch-pb-from: mkdir -p racket/src/ChezScheme/boot - if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.5-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.5-1:remotes/origin/circa-7.9.0.5-1 ; fi - cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.5-1 + if [ ! -d racket/src/ChezScheme/boot/pb ] ; then git clone -q -b circa-7.9.0.6-1 $(PB_REPO) racket/src/ChezScheme/boot/pb ; else cd racket/src/ChezScheme/boot/pb && git fetch -q origin circa-7.9.0.6-1:remotes/origin/circa-7.9.0.6-1 ; fi + cd racket/src/ChezScheme/boot/pb && git checkout -q circa-7.9.0.6-1 pb-stage: - cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.5-1 - cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.5-1 + cd racket/src/ChezScheme/boot/pb && git branch circa-7.9.0.6-1 + cd racket/src/ChezScheme/boot/pb && git checkout circa-7.9.0.6-1 cd racket/src/ChezScheme/boot/pb && git add . && git commit --amend -m "new build" pb-push: - cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.5-1 + cd racket/src/ChezScheme/boot/pb && git push -u origin circa-7.9.0.6-1 win-cs-base: IF "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-bc-then-cs-base SETUP_BOOT_MODE=--boot WIN32_BUILD_LEVEL=bc PLAIN_RACKET=racket\racketbc DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETBC_SUFFIX="$(RACKETBC_SUFFIX)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" IF not "$(RACKET_FOR_BUILD)" == "" $(MAKE) win-just-cs-base SETUP_BOOT_MODE=--chain DISABLE_STATIC_LIBS="$(DISABLE_STATIC_LIBS)" EXTRA_REPOS_BASE="$(EXTRA_REPOS_BASE)" JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" RACKETCS_SUFFIX="$(RACKETCS_SUFFIX)" RACKET_FOR_BUILD="$(RACKET_FOR_BUILD)" diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 66877910ae..e5674fc84d 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "7.9.0.5") +(define version "7.9.0.6") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/fixnums.scrbl b/pkgs/racket-doc/scribblings/reference/fixnums.scrbl index 2ea03c8d7b..8815563656 100644 --- a/pkgs/racket-doc/scribblings/reference/fixnums.scrbl +++ b/pkgs/racket-doc/scribblings/reference/fixnums.scrbl @@ -68,9 +68,16 @@ result would not be a fixnum. @defproc[(fxrshift [a fixnum?] [b fixnum?]) fixnum?] )]{ -Safe versions of @racket[unsafe-fxand], @racket[unsafe-fxior], -@racket[unsafe-fxxor], @racket[unsafe-fxnot], -@racket[unsafe-fxlshift], and @racket[unsafe-fxrshift]. The +Like @racket[bitwise-and], @racket[bitwise-ior], +@racket[bitwise-xor], @racket[bitwise-not], and +@racket[arithmetic-shift], but constrained to consume @tech{fixnums}; +the result is always a @tech{fixnum}. The @racket[unsafe-fxlshift] and +@racket[unsafe-fxrshift] operations correspond to +@racket[arithmetic-shift], but require non-negative arguments; +@racket[unsafe-fxlshift] is a positive (i.e., left) shift, and +@racket[unsafe-fxrshift] is a negative (i.e., right) shift, where the +number of bits to shift must be no more than the number of bits used to +represent a @tech{fixnum}. The @exnraise[exn:fail:contract:non-fixnum-result] if the arithmetic result would not be a fixnum. @@ -78,6 +85,25 @@ result would not be a fixnum. and @racket[fxxor].}]} +@deftogether[( +@defproc[(fx+/wraparound [a fixnum?] [b fixnum?]) fixnum?] +@defproc[(fx-/wraparound [a fixnum?] [b fixnum?]) fixnum?] +@defproc[(fx*/wraparound [a fixnum?] [b fixnum?]) fixnum?] +@defproc[(fxlshift/wraparound [a fixnum?] [b fixnum?]) fixnum?] +)]{ + +Like @racket[fx+], @racket[fx-], @racket[fx*], and @racket[fxlshift], +but a fixnum result is produced for any allowed arguments (i.e., for +any fixnum argument, except that the second +@racket[fxlshift/wraparound] argument must be between 0 and the number +of bits in a fixnum, inclusive). The result is produced by simply discarding bits +that do not fit in a fixnum representation. The result is negative if +the highest of the retained bits is set---even, for example, if the +value was produced by adding two positive fixnums. + +@history[#:added "7.9.0.6"]} + + @deftogether[( @defproc[(fx= [a fixnum?] [b fixnum?] ...) boolean?] @defproc[(fx< [a fixnum?] [b fixnum?] ...) boolean?] @@ -88,9 +114,9 @@ result would not be a fixnum. @defproc[(fxmax [a fixnum?] [b fixnum?] ...) fixnum?] )]{ -Safe versions of @racket[unsafe-fx=], @racket[unsafe-fx<], - @racket[unsafe-fx>], @racket[unsafe-fx<=], @racket[unsafe-fx>=], - @racket[unsafe-fxmin], and @racket[unsafe-fxmax]. +Like @racket[=], @racket[<], @racket[>], +@racket[<=], @racket[>=], @racket[min], and @racket[max], but +constrained to consume @tech{fixnums}. @history/arity[]} diff --git a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl index 57aae3c85e..0c5236936a 100644 --- a/pkgs/racket-doc/scribblings/reference/unsafe.scrbl +++ b/pkgs/racket-doc/scribblings/reference/unsafe.scrbl @@ -51,13 +51,10 @@ operations can be prevented by adjusting the code inspector (see @defproc[(unsafe-fxabs [a fixnum?]) fixnum?] )]{ -For @tech{fixnums}: Like @racket[+], @racket[-], @racket[*], -@racket[quotient], @racket[remainder], @racket[modulo], and -@racket[abs], but constrained to consume @tech{fixnums} and produce a -@tech{fixnum} result. The mathematical operation on @racket[a] and -@racket[b] must be representable as a @tech{fixnum}. In the case of -@racket[unsafe-fxquotient], @racket[unsafe-fxremainder], and -@racket[unsafe-fxmodulo], @racket[b] must not be @racket[0]. +For @tech{fixnums}: Unchecked versions of @racket[fx+], @racket[fx-], +@racket[fx*], @racket[fxquotient], +@racket[fxremainder], @racket[fxmodulo], and +@racket[fxabs]. @history[#:changed "7.0.0.13" @elem{Allow zero or more arguments for @racket[unsafe-fx+] and @racket[unsafe-fx*] and allow one or more arguments for @racket[unsafe-fx-].}]} @@ -72,24 +69,28 @@ For @tech{fixnums}: Like @racket[+], @racket[-], @racket[*], @defproc[(unsafe-fxrshift [a fixnum?] [b fixnum?]) fixnum?] )]{ -For @tech{fixnums}: Like @racket[bitwise-and], @racket[bitwise-ior], -@racket[bitwise-xor], @racket[bitwise-not], and -@racket[arithmetic-shift], but constrained to consume @tech{fixnums}; -the result is always a @tech{fixnum}. The @racket[unsafe-fxlshift] and -@racket[unsafe-fxrshift] operations correspond to -@racket[arithmetic-shift], but require non-negative arguments; -@racket[unsafe-fxlshift] is a positive (i.e., left) shift, and -@racket[unsafe-fxrshift] is a negative (i.e., right) shift, where the -number of bits to shift must be no more than the number of bits used to -represent a @tech{fixnum}. In the case of @racket[unsafe-fxlshift], -bits in the result beyond the number of bits used to represent a -@tech{fixnum} are effectively replaced with a copy of the high bit. +For @tech{fixnums}: Unchecked versions of @racket[fxand], @racket[fxior], @racket[fxxor], +@racket[fxnot], @racket[fxlshift], and @racket[fxrshift]. @history[#:changed "7.0.0.13" @elem{Allow zero or more arguments for @racket[unsafe-fxand], @racket[unsafe-fxior], and @racket[unsafe-fxxor].}]} +@deftogether[( +@defproc[(unsafe-fx+/wraparound [a fixnum?] [b fixnum?]) fixnum?] +@defproc[(unsafe-fx-/wraparound [a fixnum?] [b fixnum?]) fixnum?] +@defproc[(unsafe-fx*/wraparound [a fixnum?] [b fixnum?]) fixnum?] +@defproc[(unsafe-fxlshift/wraparound [a fixnum?] [b fixnum?]) fixnum?] +)]{ + +For @tech{fixnums}: Unchecked versions of @racket[fx+/wraparound], +@racket[fx-/wraparound], @racket[fx*/wraparound], and +@racket[fxlshift/wraparound]. + +@history[#:added "7.9.0.6"]} + + @deftogether[( @defproc[(unsafe-fx= [a fixnum?] [b fixnum?] ...) boolean?] @defproc[(unsafe-fx< [a fixnum?] [b fixnum?] ...) boolean?] @@ -100,9 +101,9 @@ bits in the result beyond the number of bits used to represent a @defproc[(unsafe-fxmax [a fixnum?] [b fixnum?] ...) fixnum?] )]{ -For @tech{fixnums}: Like @racket[=], @racket[<], @racket[>], -@racket[<=], @racket[>=], @racket[min], and @racket[max], but -constrained to consume @tech{fixnums}. +For @tech{fixnums}: Unchecked versions of @racket[fx=], @racket[fx<], + @racket[fx>], @racket[fx<=], @racket[fx>=], + @racket[fxmin], and @racket[fxmax]. @history[#:changed "7.0.0.13" @elem{Allow one or more argument, instead of allowing just two.}]} diff --git a/pkgs/racket-test-core/tests/racket/fixnum.rktl b/pkgs/racket-test-core/tests/racket/fixnum.rktl index f694b7c418..92fc0d1149 100644 --- a/pkgs/racket-test-core/tests/racket/fixnum.rktl +++ b/pkgs/racket-test-core/tests/racket/fixnum.rktl @@ -22,6 +22,20 @@ (test #f fixnum-for-every-system? (sub1 (- (expt 2 29)))) (test #f fixnum-for-every-system? (expt 2 29)) +(define (wraparound op) + (lambda (x y) + (unless (fixnum? x) (raise-argument-error 'wraparound "fixnum?" x)) + (unless (fixnum? y) (raise-argument-error 'wraparound "fixnum?" y)) + (define v (op x y)) + (if (zero? (bitwise-and v (add1 (greatext-fixnum)))) + (bitwise-ior v (- -1 (greatest-fixnum))) + (bitwise-and v (greatest-fixnum))))) + +(define (lshift x y) + (unless (<= 0 y (integer-length (greatest-fixnum))) + (error 'lshift "bad shift")) + (arithmetic-shift x y)) + (define unary-table (list (list fxnot unsafe-fxnot) (list fxabs unsafe-fxabs) @@ -51,7 +65,15 @@ (define binary-table (list (list fxquotient unsafe-fxquotient) (list fxremainder unsafe-fxremainder) - (list fxmodulo unsafe-fxmodulo))) + (list fxmodulo unsafe-fxmodulo) + (list (wraparound +) fx+/wraparound) + (list (wraparound -) fx-/wraparound) + (list (wraparound *) fx*/wraparound) + (list (wraparound lshift) fxlshift/wraparound) + (list fx+/wraparound unsafe-fx+/wraparound) + (list fx-/wraparound unsafe-fx-/wraparound) + (list fx*/wraparound unsafe-fx*/wraparound) + (list fxlshift/wraparound unsafe-fxlshift/wraparound))) (define binary/small-second-arg-table (list (list fxlshift unsafe-fxlshift) @@ -165,6 +187,10 @@ ;; check a small range (same-results/range/table) +;; ---------------------------------------- + + + ;; ---------------------------------------- (err/rt-test (fxvector-ref (fxvector 4 5 6) 4) exn:fail:contract? #rx"[[]0, 2[]]") diff --git a/pkgs/racket-test-core/tests/racket/jitinline.rktl b/pkgs/racket-test-core/tests/racket/jitinline.rktl index 5305ab7f8e..5f38bcc0a3 100644 --- a/pkgs/racket-test-core/tests/racket/jitinline.rktl +++ b/pkgs/racket-test-core/tests/racket/jitinline.rktl @@ -107,11 +107,15 @@ (test v name ((eval `(lambda (y) (let ([x1 (fx+ (random 1) ',arg1)]) (,op x1 y)))) arg2)))))] - [bin-exact (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f] #:bad-value [bad-value 'bad]) - (check-error-message op (eval `(lambda (x) (,op x ',arg2))) #:bad-value bad-value) + [bin-exact (lambda (v op arg1 arg2 [check-fixnum-as-bad? #f] + #:bad-value [bad-value 'bad] + #:bad-as-second-only? [bad-as-second-only? #f]) + (unless bad-as-second-only? + (check-error-message op (eval `(lambda (x) (,op x ',arg2))) #:bad-value bad-value)) (check-error-message op (eval `(lambda (x) (,op ',arg1 x))) #:bad-value bad-value) (check-error-message op (eval `(lambda (x y) (,op x y))) #:first-arg arg1 #:bad-value bad-value) - (check-error-message op (eval `(lambda (x y) (,op x y))) #:second-arg arg2 #:bad-value bad-value) + (unless bad-as-second-only? + (check-error-message op (eval `(lambda (x y) (,op x y))) #:second-arg arg2 #:bad-value bad-value)) (when check-fixnum-as-bad? (check-error-message op (eval `(lambda (x) (,op x ',arg2))) #t) (check-error-message op (eval `(lambda (x) (,op x 10))) #t) @@ -565,6 +569,7 @@ (tri 13/2 '+ (lambda () 1) 5/2 3 void) (bin-exact 25 'fx+ 10 15) (tri-exact 33 'fx+ (lambda () 10) 15 8 void #f) + (bin-exact 25 'fx+/wraparound 10 15) (bin-exact 3.4 'fl+ 1.1 2.3 #t) (tri-exact 7.4 'fl+ (lambda () 1.1) 2.3 4.0 void #f) @@ -579,6 +584,7 @@ (tri 13/2 '- (lambda () 10) 3 1/2 void) (un-exact -3 'fx- 3) (bin-exact 13 'fx- 5 -8) + (bin-exact 13 'fx-/wraparound 5 -8) (tri-exact 14 'fx- (lambda () 5) -8 -1 void #f) (un-exact -3.6 'fl- 3.6) (bin-exact -0.75 'fl- 1.5 2.25 #t) @@ -599,6 +605,7 @@ (tri 5 '* (lambda () 2) 3 5/6 void) (un-exact 11 'fx* 11) (bin-exact 253 'fx* 11 23) + (bin-exact 253 'fx*/wraparound 11 23) (bin-exact 2.53 'fl* 1.1 2.3 #t) (tri-exact 506 'fx* (lambda () 11) 23 2 void #f) (tri-exact 7.59 'fl* (lambda () 1.1) 2.3 3.0 void #f) @@ -729,7 +736,15 @@ (bin-exact 2 'arithmetic-shift (expt 2 33) -32) (bin-exact 8 'arithmetic-shift (expt 2 33) -30) (bin-exact 4 'fxlshift 2 1) + (bin-exact 4 'fxlshift 2 1 #:bad-value -2 #:bad-as-second-only? #t) + (bin-exact 4 'fxlshift 2 1 #:bad-value 100 #:bad-as-second-only? #t) (bin-exact 1 'fxrshift 2 1) + (bin-exact 1 'fxrshift 2 1 #:bad-value -2 #:bad-as-second-only? #t) + (bin-exact 1 'fxrshift 2 1 #:bad-value 100 #:bad-as-second-only? #t) + + (bin-exact 4 'fxlshift/wraparound 2 1) + (bin-exact 4 'fxlshift/wraparound 2 1 #:bad-value -2 #:bad-as-second-only? #t) + (bin-exact 4 'fxlshift/wraparound 2 1 #:bad-value 100 #:bad-as-second-only? #t) (un-exact -1 'bitwise-not 0) (un-exact 0 'bitwise-not -1) diff --git a/pkgs/racket-test-core/tests/racket/number.rktl b/pkgs/racket-test-core/tests/racket/number.rktl index 1ef8998506..83527d5800 100644 --- a/pkgs/racket-test-core/tests/racket/number.rktl +++ b/pkgs/racket-test-core/tests/racket/number.rktl @@ -3552,7 +3552,7 @@ extra-p)) (define n3 (inexact->exact (exact->inexact n2))) (unless (= n3 (arithmetic-shift 53-bit-number (+ num-zeros 1 extra-p))) - (error 'random-exact->inexact "truncating round failed ~s" n2))) + (error 'random-exact->inexact "truncating round failed ~s ~s ~s" n2 53-bit-number (+ num-zeros 1 extra-p)))) (check-random-pairs check-shift-plus-bits-to-truncate) ;; If we add a one bit and then a non-zero bit anywhere later, diff --git a/pkgs/racket-test-core/tests/racket/unsafe.rktl b/pkgs/racket-test-core/tests/racket/unsafe.rktl index 403fa24eff..425b779543 100644 --- a/pkgs/racket-test-core/tests/racket/unsafe.rktl +++ b/pkgs/racket-test-core/tests/racket/unsafe.rktl @@ -151,6 +151,9 @@ (err/rt-test (unsafe-fxmodulo (error "bad") 1) exn:fail?) ; not 0 (err/rt-test (unsafe-fxmodulo 0 (error "bad")) exn:fail?) ; not 0 + (test-bin 60 'unsafe-fxlshift 15 2) + (test-bin 3 'unsafe-fxrshift 15 2) + (test-zero 0.0 'unsafe-fl+) (test-un 6.7 'unsafe-fl+ 6.7) (test-bin 3.4 'unsafe-fl+ 1.4 2.0) diff --git a/racket/collects/racket/fixnum.rkt b/racket/collects/racket/fixnum.rkt index 441f226ffd..ef28a13eef 100644 --- a/racket/collects/racket/fixnum.rkt +++ b/racket/collects/racket/fixnum.rkt @@ -9,9 +9,10 @@ (provide fx->fl fl->fx fxabs fx+ fx- fx* + fx+/wraparound fx-/wraparound fx*/wraparound fxquotient fxremainder fxmodulo fxand fxior fxxor - fxnot fxrshift fxlshift + fxnot fxrshift fxlshift fxlshift/wraparound fx>= fx> fx= fx< fx<= fxmin fxmax fixnum-for-every-system? diff --git a/racket/src/ChezScheme/makefiles/Mf-install.in b/racket/src/ChezScheme/makefiles/Mf-install.in index 0f48fbce13..24a2d15a61 100644 --- a/racket/src/ChezScheme/makefiles/Mf-install.in +++ b/racket/src/ChezScheme/makefiles/Mf-install.in @@ -62,7 +62,7 @@ InstallLZ4Target= # no changes should be needed below this point # ############################################################################### -Version=csv9.5.3.49 +Version=csv9.5.3.50 Include=boot/$m PetiteBoot=boot/$m/petite.boot SchemeBoot=boot/$m/scheme.boot diff --git a/racket/src/ChezScheme/rktboot/scheme-lang.rkt b/racket/src/ChezScheme/rktboot/scheme-lang.rkt index 1c3b00543a..d0a771c6d1 100644 --- a/racket/src/ChezScheme/rktboot/scheme-lang.rkt +++ b/racket/src/ChezScheme/rktboot/scheme-lang.rkt @@ -177,6 +177,11 @@ [write-string display-string] [call/ec call/1cc] [s:string->symbol string->symbol]) + ;; Wraparound behavior not needed to compile Chez Scheme itself: + (rename-out [fx+ fx+/wraparound] + [fx- fx-/wraparound] + [fx* fx*/wraparound] + [fxlshift fxsll/wraparound]) logbit? logbit1 logbit0 logtest (rename-out [logbit? fxlogbit?] [logbit1 fxlogbit1] diff --git a/racket/src/ChezScheme/s/cmacros.ss b/racket/src/ChezScheme/s/cmacros.ss index 93a3952c51..6be0728fdb 100644 --- a/racket/src/ChezScheme/s/cmacros.ss +++ b/racket/src/ChezScheme/s/cmacros.ss @@ -357,7 +357,7 @@ ;; --------------------------------------------------------------------- ;; Version and machine types: -(define-constant scheme-version #x09050331) +(define-constant scheme-version #x09050332) (define-syntax define-machine-types (lambda (x) @@ -2785,6 +2785,10 @@ (sub1 #f 1 #f #t) (-1+ #f 1 #f #t) (fx* #f 2 #t #t) + (fx*/wraparound #f 2 #t #t) + (fx+/wraparound #f 2 #t #t) + (fx-/wraparound #f 2 #t #t) + (fxsll/wraparound #f 2 #t #t) (dofargint64 #f 1 #f #f) (dofretint64 #f 1 #f #f) (dofretuns64 #f 1 #f #f) diff --git a/racket/src/ChezScheme/s/cp0.ss b/racket/src/ChezScheme/s/cp0.ss index c96d6c15a4..7eb1a613ef 100644 --- a/racket/src/ChezScheme/s/cp0.ss +++ b/racket/src/ChezScheme/s/cp0.ss @@ -2725,12 +2725,14 @@ (partial-folder plus + + 0 generic-nan?) (partial-folder plus fx+ + 0 (lambda (x) #f) 3) (r6rs-fixnum-partial-folder plus r6rs:fx+ fx+ + 0 (lambda (x) #f) 3) + (r6rs-fixnum-partial-folder plus fx+/wraparound fx+/wraparound + 0 (lambda (x) #f) 3) (partial-folder plus fl+ fl+ -0.0 fl-nan? #f obviously-fl?) (partial-folder plus cfl+ cfl+ -0.0 cfl-nan?) (partial-folder plus * * 1 exact-zero?) ; exact zero trumps nan (partial-folder plus fx* * 1 exact-zero? 3) (r6rs-fixnum-partial-folder plus r6rs:fx* fx* * 1 exact-zero? 3) + (r6rs-fixnum-partial-folder plus fx*/wraparound fx*/wraparound * 1 (lambda (x) #f) 3) (partial-folder plus fl* fl* 1.0 fl-nan? #f obviously-fl?) (partial-folder plus cfl* cfl* 1.0 cfl-nan?) @@ -2740,6 +2742,7 @@ (partial-folder minus - - 0) (partial-folder minus fx- - 0) (r6rs-fixnum-partial-folder minus r6rs:fx- fx- - 0) + (r6rs-fixnum-partial-folder plus fx-/wraparound fx-/wraparound - 0 (lambda (x) #f) 3) (partial-folder minus fl- fl- -0.0) (partial-folder minus cfl- cfl- -0.0) @@ -2883,6 +2886,7 @@ (fold (fxarithmetic-shift-left tfixnum? u x y) (fxnonfixnum2 'fx> x y)) diff --git a/racket/src/ChezScheme/s/mathprims.ss b/racket/src/ChezScheme/s/mathprims.ss index b5f54a126e..8c2996972e 100644 --- a/racket/src/ChezScheme/s/mathprims.ss +++ b/racket/src/ChezScheme/s/mathprims.ss @@ -348,6 +348,14 @@ [(x) (#2%r6rs:fx- x)] [(x y) (#2%r6rs:fx- x y)])) + (set-who! fx+/wraparound + (lambda (x1 x2) + (#2%fx+/wraparound x1 x2))) + + (set-who! fx-/wraparound + (lambda (x1 x2) + (#2%fx-/wraparound x1 x2))) + (set! fx1- (lambda (x) (#2%fx1- x))) @@ -403,6 +411,10 @@ (fxargerr who x2)) (fxargerr who x1)))) + (set-who! fx*/wraparound + (lambda (x1 x2) + (#2%fx*/wraparound x1 x2))) + (set! fxquotient (rec fxquotient (case-lambda @@ -518,16 +530,20 @@ (set! fxsll (lambda (x y) - (#2%fxsll x y))) + (#2%fxsll x y))) - (set! fxarithmetic-shift-left - (lambda (x y) - (#2%fxarithmetic-shift-left x y))) + (set-who! fxsll/wraparound + (lambda (x1 x2) + (#2%fxsll/wraparound x1 x2))) (set! fxsrl (lambda (x y) (#2%fxsrl x y))) + (set! fxarithmetic-shift-left + (lambda (x y) + (#2%fxarithmetic-shift-left x y))) + (set! fxsra (lambda (x y) (#2%fxsra x y))) diff --git a/racket/src/ChezScheme/s/primdata.ss b/racket/src/ChezScheme/s/primdata.ss index 9dcee223a3..bd75d41bd3 100644 --- a/racket/src/ChezScheme/s/primdata.ss +++ b/racket/src/ChezScheme/s/primdata.ss @@ -1365,8 +1365,11 @@ (ftype-pointer-null? [sig [(ftype-pointer) -> (boolean)]] [flags pure mifoldable discard]) (ftype-pointer->sexpr [sig [(ftype-pointer) -> (ptr)]] [flags]) (fx* [sig [(fixnum ...) -> (fixnum)]] [flags arith-op partial-folder]) ; not restricted to 2 arguments + (fx*/wraparound [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op partial-folder]) (fx+ [sig [(fixnum ...) -> (fixnum)]] [flags arith-op partial-folder]) ; not restricted to 2 arguments + (fx+/wraparound [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op partial-folder]) (fx- [sig [(fixnum fixnum ...) -> (fixnum)]] [flags arith-op partial-folder]) ; not restricted to 1 or 2 arguments + (fx-/wraparound [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op partial-folder]) (fx/ [sig [(fixnum fixnum ...) -> (fixnum)]] [flags arith-op partial-folder]) ; not restricted to 1 or 2 arguments (fx1+ [sig [(fixnum) -> (fixnum)]] [flags arith-op cp02]) (fx1- [sig [(fixnum) -> (fixnum)]] [flags arith-op cp02]) @@ -1394,6 +1397,7 @@ (fxquotient [sig [(fixnum fixnum ...) -> (fixnum)]] [flags arith-op partial-folder]) (fxremainder [sig [(fixnum fixnum) -> (fixnum)]] [flags arith-op cp02]) (fxsll [sig [(fixnum sub-ufixnum) -> (fixnum)]] [flags arith-op cp02]) + (fxsll/wraparound [sig [(fixnum sub-ufixnum) -> (fixnum)]] [flags arith-op cp02]) (fxsra [sig [(fixnum sub-ufixnum) -> (fixnum)]] [flags arith-op cp02]) (fxsrl [sig [(fixnum sub-ufixnum) -> (fixnum)]] [flags arith-op cp02]) (fxvector [sig [(fixnum ...) -> (fxvector)]] [flags alloc cp02 safeongoodargs]) diff --git a/racket/src/bc/src/jit.h b/racket/src/bc/src/jit.h index 8b348b109a..4441a92541 100644 --- a/racket/src/bc/src/jit.h +++ b/racket/src/bc/src/jit.h @@ -1650,7 +1650,7 @@ Scheme_Object *scheme_jit_continuation_apply_install(Apply_LWC_Args *args); #define ARITH_IOR 4 /* bitwise-xor, fxxor, unsafe-fxxor */ #define ARITH_XOR 5 -/* arithmetic-shift, fxlshift, unsafe-fxlshift */ +/* fxlshift, unsafe-fxlshift */ #define ARITH_LSH 6 /* fxrshift, unsafe-fxrshift */ #define ARITH_RSH -6 @@ -1675,6 +1675,16 @@ Scheme_Object *scheme_jit_continuation_apply_install(Apply_LWC_Args *args); #define ARITH_INEX_TRUNC_EX 16 /* flexpt */ #define ARITH_EXPT 17 +/* fx+/wraparound, unsafe-fl+/wraparound */ +#define ARITH_ADD_WRAP 18 +/* fx-/wraparound, unsafe-fx-/wraparound */ +#define ARITH_SUB_WRAP -18 +/* fx+/wraparound, unsafe-fx+/wraparound */ +#define ARITH_MUL_WRAP 19 +/* fxlshift/wraparound, unsafe-fxlshift/wraparound */ +#define ARITH_LSH_WRAP 20 +/* arithmetic-shift */ +#define ARITH_SH 21 /* Comparison codes. Used in jitarith.c and jitinline.c. */ diff --git a/racket/src/bc/src/jitarith.c b/racket/src/bc/src/jitarith.c index b3054f3858..d17a40e304 100644 --- a/racket/src/bc/src/jitarith.c +++ b/racket/src/bc/src/jitarith.c @@ -416,7 +416,7 @@ static jit_insn *generate_arith_slow_path(mz_jit_state *jitter, Scheme_Object *r *_ref = ref; *_ref4 = ref4; - if (arith == ARITH_LSH) { + if ((arith == ARITH_SH) || (arith == ARITH_LSH) || (arith == ARITH_LSH_WRAP)) { /* Add tag back to first arg, just in case. See arithmetic-shift branch to refslow. */ ref = jit_get_ip(); @@ -634,7 +634,7 @@ static int generate_float_point_arith(mz_jit_state *jitter, Scheme_Object *rator ref8 = ref9 = ref10 = NULL; } - if (!two_args && !second_const && ((arith == ARITH_MUL) || ((arith == ARITH_DIV) && reversed))) { + if (!two_args && !second_const && ((arith == ARITH_MUL) || (arith == ARITH_MUL_WRAP) || ((arith == ARITH_DIV) && reversed))) { /* Special case: multiplication by exact 0 */ (void)jit_movi_p(dest, scheme_make_integer(0)); } else { @@ -1400,10 +1400,14 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme if (rand2) { if (SCHEME_INTP(rand2) && SCHEME_INT_SMALL_ENOUGH(rand2) - && ((arith != ARITH_LSH) - || ((SCHEME_INT_VAL(rand2) <= MAX_TRY_SHIFT) - && (SCHEME_INT_VAL(rand2) >= -MAX_TRY_SHIFT))) - && ((cmp != 3) + && ((arith == ARITH_SH) + ? ((SCHEME_INT_VAL(rand2) <= MAX_TRY_SHIFT) + && (SCHEME_INT_VAL(rand2) >= -MAX_TRY_SHIFT)) + : (((arith == ARITH_LSH) || (arith == ARITH_LSH_WRAP) || (arith == ARITH_RSH)) + ? ((SCHEME_INT_VAL(rand2) <= MAX_TRY_SHIFT) + && (SCHEME_INT_VAL(rand2) >= 0)) + : 1)) + && ((cmp != CMP_BIT) || ((SCHEME_INT_VAL(rand2) <= MAX_TRY_SHIFT) && (SCHEME_INT_VAL(rand2) >= 0)))) { /* Second is constant, so use constant mode. @@ -1413,7 +1417,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme rand2 = NULL; } else if (SCHEME_INTP(rand) && SCHEME_INT_SMALL_ENOUGH(rand) - && (arith != ARITH_LSH) && (arith != ARITH_RSH) + && (arith != ARITH_SH) && (arith != ARITH_LSH) && (arith != ARITH_LSH_WRAP) && (arith != ARITH_RSH) && (cmp != CMP_BIT)) { /* First is constant; swap argument order and use constant mode. */ v = SCHEME_INT_VAL(rand); @@ -1619,33 +1623,33 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme if (rand2) { /* First arg is in JIT_R1, second is in JIT_R0 */ - if (arith == ARITH_ADD) { + if ((arith == ARITH_ADD) || (arith == ARITH_ADD_WRAP)) { jit_andi_ul(JIT_R2, JIT_R1, (~0x1)); - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_ADD_WRAP)) jit_addr_l(dest, JIT_R2, JIT_R0); else { (void)jit_boaddr_l(refslow, JIT_R2, JIT_R0); jit_movr_p(dest, JIT_R2); } - } else if (arith == ARITH_SUB) { + } else if ((arith == ARITH_SUB) || (arith == ARITH_SUB_WRAP)) { if (reversed) { jit_movr_p(JIT_R2, JIT_R0); - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_SUB_WRAP)) jit_subr_l(JIT_R2, JIT_R2, JIT_R1); else (void)jit_bosubr_l(refslow, JIT_R2, JIT_R1); } else { jit_movr_p(JIT_R2, JIT_R1); - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_SUB_WRAP)) (void)jit_subr_l(JIT_R2, JIT_R2, JIT_R0); else (void)jit_bosubr_l(refslow, JIT_R2, JIT_R0); } jit_ori_ul(dest, JIT_R2, 0x1); - } else if (arith == ARITH_MUL) { + } else if ((arith == ARITH_MUL) || (arith == ARITH_MUL_WRAP)) { jit_andi_ul(JIT_R2, JIT_R1, (~0x1)); jit_rshi_l(JIT_V1, JIT_R0, 0x1); - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_MUL_WRAP)) jit_mulr_l(JIT_V1, JIT_V1, JIT_R2); else (void)jit_bomulr_l(refslow, JIT_V1, JIT_R2); @@ -1738,7 +1742,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme /* xor */ jit_andi_ul(JIT_R0, JIT_R0, (~0x1)); jit_xorr_ul(dest, JIT_R1, JIT_R0); - } else if ((arith == ARITH_LSH) || (arith == ARITH_RSH)) { + } else if ((arith == ARITH_SH) || (arith == ARITH_LSH) || (arith == ARITH_LSH_WRAP) || (arith == ARITH_RSH)) { /* arithmetic-shift This is a lot of code, but if you're using arithmetic-shift, then you probably want it. */ @@ -1746,27 +1750,30 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme int v2 = (reversed ? JIT_R1 : JIT_R0); GC_CAN_IGNORE jit_insn *refi, *refc; - if ((arith != ARITH_RSH) && (!unsafe_fx || overflow_refslow)) + if (arith == ARITH_SH) refi = jit_bgei_l(jit_forward(), v2, (intptr_t)scheme_make_integer(0)); - else + else { refi = NULL; + if (!unsafe_fx || overflow_refslow) + (void)jit_blti_l(refslow, v2, scheme_make_integer(0)); + } - if (!unsafe_fx || overflow_refslow || (arith == ARITH_RSH)) { + if ((arith == ARITH_SH) || (arith == ARITH_RSH)) { /* Right shift */ if (!unsafe_fx || overflow_refslow) { /* check for a small enough shift */ if (arith == ARITH_RSH) { - (void)jit_blti_p(refslow, v2, scheme_make_integer(0)); - (void)jit_bgti_p(refslow, v2, scheme_make_integer(MAX_TRY_SHIFT)); - jit_rshi_l(JIT_V1, v2, 0x1); + (void)jit_bgti_l(refslow, v2, scheme_make_integer(MAX_TRY_SHIFT)); } else { - (void)jit_blti_p(refslow, v2, scheme_make_integer(-MAX_TRY_SHIFT)); - jit_notr_l(JIT_V1, v2); - jit_rshi_l(JIT_V1, JIT_V1, 0x1); - jit_addi_l(JIT_V1, JIT_V1, 0x1); + (void)jit_blti_l(refslow, v2, scheme_make_integer(-MAX_TRY_SHIFT)); } - } else { + } + if (arith == ARITH_RSH) jit_rshi_l(JIT_V1, v2, 0x1); + else { + jit_notr_l(JIT_V1, v2); + jit_rshi_l(JIT_V1, JIT_V1, 0x1); + jit_addi_l(JIT_V1, JIT_V1, 0x1); } CHECK_LIMIT(); #ifdef MZ_USE_JIT_I386 @@ -1786,7 +1793,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme refc = NULL; /* Left shift */ - if (!unsafe_fx || overflow_refslow || (arith == ARITH_LSH)) { + if ((arith == ARITH_SH) || (arith == ARITH_LSH) || (arith == ARITH_LSH_WRAP)) { if (refi) mz_patch_branch(refi); if (!unsafe_fx || overflow_refslow) @@ -1801,12 +1808,13 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme jit_lshr_l(JIT_R2, v1, JIT_V1); #endif CHECK_LIMIT(); - /* If shifting back right produces a different result, that's overflow... */ - jit_rshr_l(JIT_V1, JIT_R2, JIT_V1); - /* !! In case we go refslow, it needs to add back tag to v1 !! */ - if (!unsafe_fx || overflow_refslow) + if ((!unsafe_fx || overflow_refslow) && (arith != ARITH_LSH_WRAP)) { + /* If shifting back right produces a different result, that's overflow... */ + jit_rshr_l(JIT_V1, JIT_R2, JIT_V1); + /* !! In case we go refslow, it needs to add back tag to v1 !! */ (void)jit_bner_p(refslow, JIT_V1, v1); - /* No overflow. */ + } + /* No overflow (or we don't care) */ jit_ori_l(dest, JIT_R2, 0x1); } @@ -1833,24 +1841,24 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme } } else { /* Non-constant arg is in JIT_R0 */ - if (arith == ARITH_ADD) { - if (unsafe_fx && !overflow_refslow) + if ((arith == ARITH_ADD) || (arith == ARITH_ADD_WRAP)) { + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_ADD_WRAP)) jit_addi_l(dest, JIT_R0, (uintptr_t)v << 1); else { jit_movr_p(JIT_R2, JIT_R0); (void)jit_boaddi_l(refslow, JIT_R2, (uintptr_t)v << 1); jit_movr_p(dest, JIT_R2); } - } else if (arith == ARITH_SUB) { + } else if ((arith == ARITH_SUB) || (arith == ARITH_SUB_WRAP)) { if (reversed) { (void)jit_movi_p(JIT_R2, scheme_make_integer(v)); - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_SUB_WRAP)) jit_subr_l(JIT_R2, JIT_R2, JIT_R0); else (void)jit_bosubr_l(refslow, JIT_R2, JIT_R0); jit_addi_ul(dest, JIT_R2, 0x1); } else { - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_SUB_WRAP)) jit_subi_l(dest, JIT_R0, (uintptr_t)v << 1); else { jit_movr_p(JIT_R2, JIT_R0); @@ -1858,7 +1866,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme jit_movr_p(dest, JIT_R2); } } - } else if (arith == ARITH_MUL) { + } else if ((arith == ARITH_MUL) || (arith == ARITH_MUL_WRAP)) { if (v == 1) { /* R0 already is the answer */ jit_movr_p(dest, JIT_R0); @@ -1867,7 +1875,7 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme } else { (void)jit_movi_l(JIT_R2, ((intptr_t)scheme_make_integer(v) & (~0x1))); jit_rshi_l(JIT_V1, JIT_R0, 0x1); - if (unsafe_fx && !overflow_refslow) + if ((unsafe_fx && !overflow_refslow) || (arith == ARITH_MUL_WRAP)) jit_mulr_l(JIT_V1, JIT_V1, JIT_R2); else { (void)jit_movi_p(JIT_R1, scheme_make_integer(v)); /* for slow path */ @@ -1887,9 +1895,10 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme } else if (arith == ARITH_XOR) { /* xor */ jit_xori_ul(dest, JIT_R0, (uintptr_t)v << 1); - } else if ((arith == ARITH_LSH) || (arith == ARITH_RSH)) { + } else if ((arith == ARITH_SH) || (arith == ARITH_LSH) || (arith == ARITH_LSH_WRAP) || (arith == ARITH_RSH)) { /* arithmetic-shift */ - /* We only get here when v is between -MAX_TRY_SHIFT and MAX_TRY_SHIFT, inclusive */ + /* We only get here when v is in range, such as between -MAX_TRY_SHIFT and + MAX_TRY_SHIFT inclusive for ARITH_SH. */ if ((v <= 0) || (arith == ARITH_RSH)) { int amt = v; if (arith != ARITH_RSH) @@ -1899,13 +1908,13 @@ int scheme_generate_arith_for(mz_jit_state *jitter, Scheme_Object *rator, Scheme } else { jit_andi_l(JIT_R0, JIT_R0, (~0x1)); jit_lshi_l(JIT_R2, JIT_R0, v); - if (!unsafe_fx && !overflow_refslow) { + if ((!unsafe_fx || overflow_refslow) && (arith != ARITH_LSH_WRAP)) { /* If shifting back right produces a different result, that's overflow... */ jit_rshi_l(JIT_V1, JIT_R2, v); /* !! In case we go refslow, it nseed to add back tag to JIT_R0 !! */ (void)jit_bner_p(refslow, JIT_V1, JIT_R0); } - /* No overflow. */ + /* No overflow (or we don't care) */ jit_ori_l(dest, JIT_R2, 0x1); } } else if (arith == ARITH_NOT) { diff --git a/racket/src/bc/src/jitinline.c b/racket/src/bc/src/jitinline.c index 18492817a6..8eb33c6b11 100644 --- a/racket/src/bc/src/jitinline.c +++ b/racket/src/bc/src/jitinline.c @@ -2415,8 +2415,8 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in jit_movr_p(dest, JIT_R0); refdone = jit_jmpi(jit_forward()); mz_patch_branch(ref); - (void)jit_blti_p(refslow, JIT_R0, scheme_make_integer(0)); - (void)jit_bgti_p(refslow, JIT_R0, scheme_make_integer(255)); + (void)jit_blti_l(refslow, JIT_R0, scheme_make_integer(0)); + (void)jit_bgti_l(refslow, JIT_R0, scheme_make_integer(255)); jit_rshi_l(JIT_R0, JIT_R0, 1); jit_lshi_l(JIT_R2, JIT_R0, JIT_LOG_WORD_SIZE); @@ -3674,6 +3674,12 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i } else if (IS_NAMED_PRIM(rator, "fx+")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_ADD, 0, 0, NULL, 1, -1, 0, NULL, dest); return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-fx+/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_ADD_WRAP, 0, 0, NULL, 1, 1, 0, NULL, dest); + return 1; + } else if (IS_NAMED_PRIM(rator, "fx+/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_ADD_WRAP, 0, 0, NULL, 1, -1, 0, NULL, dest); + return 1; } else if (IS_NAMED_PRIM(rator, "unsafe-fl+")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_ADD, 0, 0, NULL, 1, 0, 1, NULL, dest); return 1; @@ -3689,6 +3695,12 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i } else if (IS_NAMED_PRIM(rator, "fx-")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_SUB, 0, 0, NULL, 1, -1, 0, NULL, dest); return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-fx-/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_SUB_WRAP, 0, 0, NULL, 1, 1, 0, NULL, dest); + return 1; + } else if (IS_NAMED_PRIM(rator, "fx-/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_SUB_WRAP, 0, 0, NULL, 1, -1, 0, NULL, dest); + return 1; } else if (IS_NAMED_PRIM(rator, "unsafe-fl-")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_SUB, 0, 0, NULL, 1, 0, 1, NULL, dest); return 1; @@ -3704,6 +3716,12 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i } else if (IS_NAMED_PRIM(rator, "fx*")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_MUL, 0, 0, NULL, 1, -1, 0, NULL, dest); return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-fx*/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_MUL_WRAP, 0, 0, NULL, 1, 1, 0, NULL, dest); + return 1; + } else if (IS_NAMED_PRIM(rator, "fx*/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_MUL_WRAP, 0, 0, NULL, 1, -1, 0, NULL, dest); + return 1; } else if (IS_NAMED_PRIM(rator, "unsafe-fl*")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_MUL, 0, 0, NULL, 1, 0, 1, NULL, dest); return 1; @@ -3804,7 +3822,7 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_XOR, 0, 0, NULL, 1, -1, 0, NULL, dest); return 1; } else if (IS_NAMED_PRIM(rator, "arithmetic-shift")) { - scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_LSH, 0, 0, NULL, 1, 0, 0, NULL, dest); + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_SH, 0, 0, NULL, 1, 0, 0, NULL, dest); return 1; } else if (IS_NAMED_PRIM(rator, "unsafe-fxlshift")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_LSH, 0, 0, NULL, 1, 1, 0, NULL, dest); @@ -3812,6 +3830,12 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i } else if (IS_NAMED_PRIM(rator, "fxlshift")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_LSH, 0, 0, NULL, 1, -1, 0, NULL, dest); return 1; + } else if (IS_NAMED_PRIM(rator, "unsafe-fxlshift/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_LSH_WRAP, 0, 0, NULL, 1, 1, 0, NULL, dest); + return 1; + } else if (IS_NAMED_PRIM(rator, "fxlshift/wraparound")) { + scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_LSH_WRAP, 0, 0, NULL, 1, -1, 0, NULL, dest); + return 1; } else if (IS_NAMED_PRIM(rator, "unsafe-fxrshift")) { scheme_generate_arith(jitter, rator, app->rand1, app->rand2, 2, ARITH_RSH, 0, 0, NULL, 1, 1, 0, NULL, dest); return 1; diff --git a/racket/src/bc/src/numarith.c b/racket/src/bc/src/numarith.c index 56e8ef08f0..2e2a7474a9 100644 --- a/racket/src/bc/src/numarith.c +++ b/racket/src/bc/src/numarith.c @@ -15,16 +15,22 @@ static Scheme_Object *rem_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *quotient_remainder (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_plus (int argc, Scheme_Object *argv[]); +static Scheme_Object *fx_plus_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_minus (int argc, Scheme_Object *argv[]); +static Scheme_Object *fx_minus_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_mult (int argc, Scheme_Object *argv[]); +static Scheme_Object *fx_mult_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_div (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_rem (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_mod (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_abs (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_plus (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_fx_plus_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_minus (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_fx_minus_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_mult (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_fx_mult_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_div (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_rem (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_mod (int argc, Scheme_Object *argv[]); @@ -168,6 +174,13 @@ void scheme_init_flfxnum_numarith(Scheme_Startup_Env *env) | SCHEME_PRIM_AD_HOC_OPT); scheme_addto_prim_instance("fx+", p, env); + p = scheme_make_folding_prim(fx_plus_wrap, "fx+/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_NARY_INLINED + | SCHEME_PRIM_PRODUCES_FIXNUM + | SCHEME_PRIM_AD_HOC_OPT); + scheme_addto_prim_instance("fx+/wraparound", p, env); + p = scheme_make_folding_prim(fx_minus, "fx-", 1, -1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED | SCHEME_PRIM_IS_BINARY_INLINED @@ -176,6 +189,14 @@ void scheme_init_flfxnum_numarith(Scheme_Startup_Env *env) | SCHEME_PRIM_AD_HOC_OPT); scheme_addto_prim_instance("fx-", p, env); + p = scheme_make_folding_prim(fx_minus_wrap, "fx-/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED + | SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_NARY_INLINED + | SCHEME_PRIM_PRODUCES_FIXNUM + | SCHEME_PRIM_AD_HOC_OPT); + scheme_addto_prim_instance("fx-/wraparound", p, env); + p = scheme_make_folding_prim(fx_mult, "fx*", 0, -1, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED | SCHEME_PRIM_IS_NARY_INLINED @@ -183,6 +204,13 @@ void scheme_init_flfxnum_numarith(Scheme_Startup_Env *env) | SCHEME_PRIM_AD_HOC_OPT); scheme_addto_prim_instance("fx*", p, env); + p = scheme_make_folding_prim(fx_mult_wrap, "fx*/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_NARY_INLINED + | SCHEME_PRIM_PRODUCES_FIXNUM + | SCHEME_PRIM_AD_HOC_OPT); + scheme_addto_prim_instance("fx*/wraparound", p, env); + p = scheme_make_folding_prim(fx_div, "fxquotient", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED | SCHEME_PRIM_PRODUCES_FIXNUM); @@ -346,6 +374,13 @@ void scheme_init_unsafe_numarith(Scheme_Startup_Env *env) | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_addto_prim_instance("unsafe-fx+", p, env); + p = scheme_make_folding_prim(unsafe_fx_plus_wrap, "unsafe-fx+/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_NARY_INLINED + | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL + | SCHEME_PRIM_PRODUCES_FIXNUM); + scheme_addto_prim_instance("unsafe-fx+/wraparound", p, env); + REGISTER_SO(scheme_unsafe_fx_minus_proc); p = scheme_make_folding_prim(unsafe_fx_minus, "unsafe-fx-", 1, -2, 1); scheme_unsafe_fx_minus_proc = p; @@ -356,6 +391,13 @@ void scheme_init_unsafe_numarith(Scheme_Startup_Env *env) | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_addto_prim_instance("unsafe-fx-", p, env); + p = scheme_make_folding_prim(unsafe_fx_minus_wrap, "unsafe-fx-/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_NARY_INLINED + | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL + | SCHEME_PRIM_PRODUCES_FIXNUM); + scheme_addto_prim_instance("unsafe-fx-/wraparound", p, env); + REGISTER_SO(scheme_unsafe_fx_times_proc); p = scheme_make_folding_prim(unsafe_fx_mult, "unsafe-fx*", 0, -1, 1); scheme_unsafe_fx_times_proc = p; @@ -365,6 +407,13 @@ void scheme_init_unsafe_numarith(Scheme_Startup_Env *env) | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_addto_prim_instance("unsafe-fx*", p, env); + p = scheme_make_folding_prim(unsafe_fx_mult_wrap, "unsafe-fx*/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_NARY_INLINED + | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL + | SCHEME_PRIM_PRODUCES_FIXNUM); + scheme_addto_prim_instance("unsafe-fx*/wraparound", p, env); + p = scheme_make_folding_prim(unsafe_fx_div, "unsafe-fxquotient", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL @@ -1219,6 +1268,20 @@ SAFE_FX(fx_div, "fxquotient", quotient, CHECK_SECOND_ZERO("fxquotient")) SAFE_FX(fx_rem, "fxremainder", rem_prim, CHECK_SECOND_ZERO("fxremainder")) SAFE_FX(fx_mod, "fxmodulo", scheme_modulo, CHECK_SECOND_ZERO("fxmodulo")) +#define SAFE_FX_WRAP(name, s_name, op) \ + static Scheme_Object *name(int argc, Scheme_Object *argv[]) \ + { \ + uintptr_t r; \ + if (!SCHEME_INTP(argv[0])) scheme_wrong_contract(s_name, "fixnum?", 0, argc, argv); \ + if (!SCHEME_INTP(argv[1])) scheme_wrong_contract(s_name, "fixnum?", 1, argc, argv); \ + r = ((uintptr_t)SCHEME_INT_VAL(argv[0]) op (uintptr_t)SCHEME_INT_VAL(argv[1])); \ + return scheme_make_integer(r); \ + } + +SAFE_FX_WRAP(fx_plus_wrap, "fx+/wraparound", +) +SAFE_FX_WRAP(fx_minus_wrap, "fx-/wraparound", -) +SAFE_FX_WRAP(fx_mult_wrap, "fx*/wraparound", *) + static Scheme_Object *fx_abs(int argc, Scheme_Object *argv[]) { Scheme_Object *o; @@ -1251,8 +1314,11 @@ static Scheme_Object *fx_abs(int argc, Scheme_Object *argv[]) } UNSAFE_FX(unsafe_fx_plus, +, fx_plus, scheme_make_integer(0), ) +UNSAFE_FX(unsafe_fx_plus_wrap, +, fx_plus, scheme_make_integer(0), ) UNSAFE_FX(unsafe_fx_minus, -, fx_minus, scheme_false, if (argc == 1) v = -v;) +UNSAFE_FX(unsafe_fx_minus_wrap, -, fx_minus, scheme_false, if (argc == 1) v = -v;) UNSAFE_FX(unsafe_fx_mult, *, fx_mult, scheme_make_integer(1), ) +UNSAFE_FX(unsafe_fx_mult_wrap, *, fx_mult, scheme_make_integer(1), ) UNSAFE_FX(unsafe_fx_div, /, fx_div, scheme_false, ) UNSAFE_FX(unsafe_fx_rem, %, fx_rem, scheme_false, ) diff --git a/racket/src/bc/src/number.c b/racket/src/bc/src/number.c index 0c2efa1df8..8369381dfe 100644 --- a/racket/src/bc/src/number.c +++ b/racket/src/bc/src/number.c @@ -118,6 +118,7 @@ static Scheme_Object *fx_xor (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_not (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_lshift (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_rshift (int argc, Scheme_Object *argv[]); +static Scheme_Object *fx_lshift_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *fx_to_fl (int argc, Scheme_Object *argv[]); static Scheme_Object *fl_to_fx (int argc, Scheme_Object *argv[]); @@ -162,6 +163,7 @@ static Scheme_Object *unsafe_fx_xor (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_not (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_lshift (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_rshift (int argc, Scheme_Object *argv[]); +static Scheme_Object *unsafe_fx_lshift_wrap (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fx_to_fl (int argc, Scheme_Object *argv[]); static Scheme_Object *unsafe_fl_to_fx (int argc, Scheme_Object *argv[]); static Scheme_Object *fl_ref (int argc, Scheme_Object *argv[]); @@ -894,6 +896,11 @@ void scheme_init_flfxnum_number(Scheme_Startup_Env *env) | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_addto_prim_instance("fxrshift", p, env); + p = scheme_make_folding_prim(fx_lshift_wrap, "fxlshift/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_PRODUCES_FIXNUM); + scheme_addto_prim_instance("fxlshift/wraparound", p, env); + p = scheme_make_folding_prim(fx_to_fl, "fx->fl", 1, 1, 1); if (scheme_can_inline_fp_op()) flags = SCHEME_PRIM_IS_UNARY_INLINED; @@ -1373,6 +1380,12 @@ void scheme_init_unsafe_number(Scheme_Startup_Env *env) | SCHEME_PRIM_PRODUCES_FIXNUM); scheme_addto_prim_instance("unsafe-fxlshift", p, env); + p = scheme_make_folding_prim(unsafe_fx_lshift_wrap, "unsafe-fxlshift/wraparound", 2, 2, 1); + SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED + | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL + | SCHEME_PRIM_PRODUCES_FIXNUM); + scheme_addto_prim_instance("unsafe-fxlshift/wraparound", p, env); + p = scheme_make_folding_prim(unsafe_fx_rshift, "unsafe-fxrshift", 2, 2, 1); SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED | SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL @@ -5260,6 +5273,11 @@ static Scheme_Object *neg_bitwise_shift(int argc, Scheme_Object *argv[]) return scheme_bitwise_shift(argc, a); } +static Scheme_Object *wrap_bitwise_shift(int argc, Scheme_Object *argv[]) +{ + return scheme_make_integer((intptr_t)((uintptr_t)SCHEME_INT_VAL(argv[0]) << SCHEME_INT_VAL(argv[1]))); +} + #define SAFE_FX(name, s_name, scheme_op, sec_p, sec_t, no_args) \ static Scheme_Object *name(int argc, Scheme_Object *argv[]) \ { \ @@ -5292,6 +5310,7 @@ SAFE_FX(fx_xor, "fxxor", bitwise_xor, SCHEME_INTP, "fixnum?", scheme_make_intege SAFE_FX(fx_lshift, "fxlshift", scheme_bitwise_shift, FIXNUM_WIDTH_P, FIXNUM_WIDTH_TYPE, scheme_false) SAFE_FX(fx_rshift, "fxrshift", neg_bitwise_shift, FIXNUM_WIDTH_P, FIXNUM_WIDTH_TYPE, scheme_false) +SAFE_FX(fx_lshift_wrap, "fxlshift/wraparound", wrap_bitwise_shift, FIXNUM_WIDTH_P, FIXNUM_WIDTH_TYPE, scheme_false) static Scheme_Object *fx_not (int argc, Scheme_Object *argv[]) { @@ -5501,6 +5520,7 @@ UNSAFE_FX(unsafe_fx_or, |, bitwise_or, intptr_t, scheme_make_integer(0)) UNSAFE_FX(unsafe_fx_xor, ^, bitwise_xor, intptr_t, scheme_make_integer(0)) UNSAFE_FX(unsafe_fx_lshift, <<, fold_fixnum_bitwise_shift, uintptr_t, scheme_false) UNSAFE_FX(unsafe_fx_rshift, >>, neg_bitwise_shift, intptr_t, scheme_false) +UNSAFE_FX(unsafe_fx_lshift_wrap, <<, fold_fixnum_bitwise_shift, uintptr_t, scheme_false) static Scheme_Object *unsafe_fx_not (int argc, Scheme_Object *argv[]) { diff --git a/racket/src/bc/src/schminc.h b/racket/src/bc/src/schminc.h index a319f7aaa5..f2bde91cc3 100644 --- a/racket/src/bc/src/schminc.h +++ b/racket/src/bc/src/schminc.h @@ -15,7 +15,7 @@ #define USE_COMPILED_STARTUP 1 -#define EXPECTED_PRIM_COUNT 1474 +#define EXPECTED_PRIM_COUNT 1482 #ifdef MZSCHEME_SOMETHING_OMITTED # undef USE_COMPILED_STARTUP diff --git a/racket/src/cs/primitive/flfxnum.ss b/racket/src/cs/primitive/flfxnum.ss index 3e0739a8ad..b9cfa0bb03 100644 --- a/racket/src/cs/primitive/flfxnum.ss +++ b/racket/src/cs/primitive/flfxnum.ss @@ -38,8 +38,11 @@ [flvector-set! (known-procedure/folding 8)] [flvector? (known-procedure/pure/folding 2)] [fx* (known-procedure/folding/limited -1 'fixnum)] + [fx*/wraparound (known-procedure/folding/limited 4 'fixnum)] [fx+ (known-procedure/folding/limited -1 'fixnum)] + [fx+/wraparound (known-procedure/folding/limited 4 'fixnum)] [fx- (known-procedure/folding/limited -2 'fixnum)] + [fx-/wraparound (known-procedure/folding/limited 4 'fixnum)] [fx->fl (known-procedure/has-unsafe/folding/limited 2 'unsafe-fx->fl 'fixnum)] [fx< (known-procedure/folding/limited -2 'fixnum)] [fx<= (known-procedure/folding/limited -2 'fixnum)] @@ -50,6 +53,7 @@ [fxand (known-procedure/folding/limited -1 'fixnum)] [fxior (known-procedure/folding/limited -1 'fixnum)] [fxlshift (known-procedure/folding/limited 4 'fixnum)] + [fxlshift/wraparound (known-procedure/folding/limited 4 'fixnum)] [fxmax (known-procedure/folding/limited -2 'fixnum)] [fxmin (known-procedure/folding/limited -2 'fixnum)] [fxmodulo (known-procedure/folding/limited 4 'fixnum)] diff --git a/racket/src/cs/primitive/unsafe.ss b/racket/src/cs/primitive/unsafe.ss index cbdbeb299a..8360008ca6 100644 --- a/racket/src/cs/primitive/unsafe.ss +++ b/racket/src/cs/primitive/unsafe.ss @@ -76,8 +76,11 @@ [unsafe-flvector-ref (known-procedure/succeeds 4)] [unsafe-flvector-set! (known-procedure/succeeds 8)] [unsafe-fx* (known-procedure/pure/folding-unsafe -1 'fx*)] + [unsafe-fx*/wraparound (known-procedure/pure/folding-unsafe 4 'fx*/wraparound)] [unsafe-fx+ (known-procedure/pure/folding-unsafe -1 'fx+)] + [unsafe-fx+/wraparound (known-procedure/pure/folding-unsafe 4 'fx+/wraparound)] [unsafe-fx- (known-procedure/pure/folding-unsafe -2 'fx-)] + [unsafe-fx-/wraparound (known-procedure/pure/folding-unsafe 4 'fx-/wraparound)] [unsafe-fx->extfl (known-procedure/pure/folding-unsafe 2 'fx->extfl)] [unsafe-fx->fl (known-procedure/pure/folding-unsafe 2 'fx->fl)] [unsafe-fx< (known-procedure/pure/folding-unsafe -2 'fx<)] @@ -89,6 +92,7 @@ [unsafe-fxand (known-procedure/pure/folding-unsafe -1 'fxand)] [unsafe-fxior (known-procedure/pure/folding-unsafe -1 'fxior)] [unsafe-fxlshift (known-procedure/pure/folding-unsafe 4 'fxlshift)] + [unsafe-fxlshift/wraparound (known-procedure/folding/limited 4 'fixnum)] [unsafe-fxmax (known-procedure/pure/folding-unsafe -2 'fxmax)] [unsafe-fxmin (known-procedure/pure/folding-unsafe -2 'fxmin)] [unsafe-fxmodulo (known-procedure/pure/folding-unsafe 4 'fxmodulo)] diff --git a/racket/src/cs/rumble.sls b/racket/src/cs/rumble.sls index 8b3458e574..d1687952e6 100644 --- a/racket/src/cs/rumble.sls +++ b/racket/src/cs/rumble.sls @@ -406,6 +406,7 @@ fx->fl fxrshift fxlshift + fxlshift/wraparound fl->fx ->fl fl->exact-integer @@ -529,6 +530,10 @@ unsafe-fxnot unsafe-fxrshift unsafe-fxlshift + unsafe-fx+/wraparound + unsafe-fx-/wraparound + unsafe-fx*/wraparound + unsafe-fxlshift/wraparound unsafe-fx= unsafe-fx< diff --git a/racket/src/cs/rumble/error-rewrite.ss b/racket/src/cs/rumble/error-rewrite.ss index 7bf46718be..f46cda4504 100644 --- a/racket/src/cs/rumble/error-rewrite.ss +++ b/racket/src/cs/rumble/error-rewrite.ss @@ -57,6 +57,7 @@ flonum->fixnum fl->fx fxarithmetic-shift-right fxrshift fxarithmetic-shift-left fxlshift + fxsll/wraparound fxlshift/wraparound real->flonum ->fl time-utc->date seconds->date) (set! rewrites-added? #t))) diff --git a/racket/src/cs/rumble/number.ss b/racket/src/cs/rumble/number.ss index 9d7e0f4c75..02d28da340 100644 --- a/racket/src/cs/rumble/number.ss +++ b/racket/src/cs/rumble/number.ss @@ -111,6 +111,7 @@ (define (fx->fl x) (#2%fixnum->flonum x)) (define (fxrshift x y) (#2%fxarithmetic-shift-right x y)) (define (fxlshift x y) (#2%fxarithmetic-shift-left x y)) +(define (fxlshift/wraparound x y) (#2%fxsll/wraparound x y)) (define (fl->fx x) (#2%flonum->fixnum x)) (define (->fl x) (#2%real->flonum x)) diff --git a/racket/src/cs/rumble/unsafe.ss b/racket/src/cs/rumble/unsafe.ss index 9ce4cd411a..90b8fda929 100644 --- a/racket/src/cs/rumble/unsafe.ss +++ b/racket/src/cs/rumble/unsafe.ss @@ -17,8 +17,11 @@ (define unsafe-char->integer (unsafe-primitive char->integer)) (define unsafe-fx+ (unsafe-primitive fx+)) +(define unsafe-fx+/wraparound (unsafe-primitive fx+/wraparound)) (define unsafe-fx- (unsafe-primitive fx-)) +(define unsafe-fx-/wraparound (unsafe-primitive fx-/wraparound)) (define unsafe-fx* (unsafe-primitive fx*)) +(define unsafe-fx*/wraparound (unsafe-primitive fx*/wraparound)) (define (unsafe-fxquotient n d) (#3%fxquotient n d)) (define unsafe-fxremainder (unsafe-primitive fxremainder)) (define unsafe-fxmodulo (unsafe-primitive fxmodulo)) @@ -29,6 +32,7 @@ (define unsafe-fxnot (unsafe-primitive fxnot)) (define unsafe-fxrshift (unsafe-primitive fxarithmetic-shift-right)) (define unsafe-fxlshift (unsafe-primitive fxarithmetic-shift-left)) +(define unsafe-fxlshift/wraparound (unsafe-primitive fxsll/wraparound)) (define unsafe-fx= (unsafe-primitive fx=)) (define unsafe-fx< (unsafe-primitive fx<)) diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 1115d7387b..c0dd7daa56 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 9 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 5 +#define MZSCHEME_VERSION_W 6 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x