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

fix swapped integer ref and set! for some platforms

Browse Source 
original commit: 35c1813738b8e7de9938021a7e7324cf8c785c30
This commit is contained in:
Matthew Flatt 2020-07-26 07:59:04 -06:00
parent 1defddb778
commit d04c53d6e1
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
s/record.ss
View File

@ -71,7 +71,8 @@
(let ([mk (lambda (base n) (let ([mk (lambda (base n)
(datum->syntax #'moi (string->symbol (format "~a-~a" base n))))]) (datum->syntax #'moi (string->symbol (format "~a-~a" base n))))])
(cond (cond
[(not (datum swap?)) [(or (not (datum swap?))
(fx= (datum wide-bits) (datum narrow-bits)))
(with-syntax ([signed-wide (mk (datum signed) (datum wide-bits))] (with-syntax ([signed-wide (mk (datum signed) (datum wide-bits))]
[unsigned-wide (mk 'unsigned (datum wide-bits))] [unsigned-wide (mk 'unsigned (datum wide-bits))]
[unsigned-middle (mk 'unsigned (datum middle-bits))] [unsigned-middle (mk 'unsigned (datum middle-bits))]
@ -124,11 +125,15 @@
(- (expt 2 middle-bits) 1)))) (- (expt 2 middle-bits) 1))))
(ref/set 'signed-narrow r (fx+ offset middle-bytes wide-bytes) (ref/set 'signed-narrow r (fx+ offset middle-bytes wide-bytes)
(bitwise-arithmetic-shift-right arg ... (+ wide-bits middle-bits))))])]) (bitwise-arithmetic-shift-right arg ... (+ wide-bits middle-bits))))])])
(if (not (datum swap?))
#'(native-endianness-case #'(native-endianness-case
[(big) big-case] [(big) big-case]
[(little) little-case])))] [(little) little-case])
#'(native-endianness-case
[(big) little-case]
[(little) big-case]))))]
[else [else
;; For swap mode, perform a sequence of byte reads or writes ;; For general swap mode, perform a sequence of byte reads or writes
(let ([mk (lambda (big?) (let ([mk (lambda (big?)
(let* ([bits (+ (datum wide-bits) (datum middle-bits) (datum narrow-bits))] (let* ([bits (+ (datum wide-bits) (datum middle-bits) (datum narrow-bits))]
[bytes (fxsrl bits 3)]) [bytes (fxsrl bits 3)])
@ -150,8 +155,8 @@
#,(gen 8 type shift delta) #,(gen 8 type shift delta)
#,(gen (- bits 8) (mk 'unsigned 8) (- shift 8) (+ delta (if big? 1 -1))))]))))]) #,(gen (- bits 8) (mk 'unsigned 8) (- shift 8) (+ delta (if big? 1 -1))))]))))])
#`(native-endianness-case #`(native-endianness-case
[(big) #,(mk #t)] [(big) #,(mk #f)]
[(little) #,(mk #f)]))]))]))) [(little) #,(mk #t)]))]))])))
; $record is hand-coded and is defined in prims.ss ; $record is hand-coded and is defined in prims.ss