mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-09-11 13:36:08 +03:00
[ performance ] bitops arithmetic speedup (#2081)
This commit is contained in:
parent
a4eb8b2ec3
commit
d1e90a5b8e
@ -49,6 +49,7 @@ schHeader prof libs = """
|
||||
(require racket/future) ; for parallelism/concurrency
|
||||
(require racket/math) ; for math ops
|
||||
(require racket/system) ; for system
|
||||
(require racket/unsafe/ops) ; for fast fixnum ops
|
||||
(require rnrs/bytevectors-6) ; for buffers
|
||||
(require rnrs/io/ports-6) ; for files
|
||||
(require srfi/19) ; for file handling and data
|
||||
|
@ -60,15 +60,13 @@
|
||||
default))
|
||||
|
||||
; primitives
|
||||
(define ct-toSignedInt
|
||||
(lambda (x bits)
|
||||
(if (logbit? bits x)
|
||||
(logor x (ash (- 1) bits))
|
||||
(logand x (- (ash 1 bits) 1)))))
|
||||
(define (ct-toSignedInt x bits)
|
||||
(if (logbit? bits x)
|
||||
(logor x (ash -1 bits))
|
||||
(logand x (sub1 (ash 1 bits)))))
|
||||
|
||||
(define ct-toUnsignedInt
|
||||
(lambda (x bits)
|
||||
(modulo x (ash 1 bits))))
|
||||
(define (ct-toUnsignedInt x bits)
|
||||
(logand x (sub1 (ash 1 bits))))
|
||||
|
||||
(define ct-u+ (lambda (x y bits)
|
||||
(let [(tag (vector-ref x 0))
|
||||
|
@ -19,15 +19,13 @@
|
||||
(void))
|
||||
res))))
|
||||
|
||||
(define blodwen-toSignedInt
|
||||
(lambda (x bits)
|
||||
(if (logbit? bits x)
|
||||
(logor x (ash (- 1) bits))
|
||||
(logand x (- (ash 1 bits) 1)))))
|
||||
(define (blodwen-toSignedInt x bits)
|
||||
(if (logbit? bits x)
|
||||
(logor x (ash -1 bits))
|
||||
(logand x (sub1 (ash 1 bits)))))
|
||||
|
||||
(define blodwen-toUnsignedInt
|
||||
(lambda (x bits)
|
||||
(modulo x (ash 1 bits))))
|
||||
(define (blodwen-toUnsignedInt x bits)
|
||||
(logand x (sub1 (ash 1 bits))))
|
||||
|
||||
|
||||
(define bu+ (lambda (x y bits) (blodwen-toUnsignedInt (+ x y) bits)))
|
||||
@ -40,26 +38,21 @@
|
||||
(define bs* (lambda (x y bits) (blodwen-toSignedInt (* x y) bits)))
|
||||
(define bs/ (lambda (x y bits) (blodwen-toSignedInt (quotient x y) bits)))
|
||||
|
||||
(define b+ (lambda (x y bits) (remainder (+ x y) (ash 1 bits))))
|
||||
(define b- (lambda (x y bits) (remainder (- x y) (ash 1 bits))))
|
||||
(define b* (lambda (x y bits) (remainder (* x y) (ash 1 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (ash 1 bits))))
|
||||
(define (integer->bits8 x) (logand x (sub1 (ash 1 8))))
|
||||
(define (integer->bits16 x) (logand x (sub1 (ash 1 16))))
|
||||
(define (integer->bits32 x) (logand x (sub1 (ash 1 32))))
|
||||
(define (integer->bits64 x) (logand x (sub1 (ash 1 64))))
|
||||
|
||||
(define integer->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define integer->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define integer->bits32 (lambda (x) (modulo x (expt 2 32))))
|
||||
(define integer->bits64 (lambda (x) (modulo x (expt 2 64))))
|
||||
(define (bits16->bits8 x) (logand x (sub1 (ash 1 8))))
|
||||
(define (bits32->bits8 x) (logand x (sub1 (ash 1 8))))
|
||||
(define (bits64->bits8 x) (logand x (sub1 (ash 1 8))))
|
||||
(define (bits32->bits16 x) (logand x (sub1 (ash 1 16))))
|
||||
(define (bits64->bits16 x) (logand x (sub1 (ash 1 16))))
|
||||
(define (bits64->bits32 x) (logand x (sub1 (ash 1 32))))
|
||||
|
||||
(define bits16->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits32->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits32->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define bits64->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits64->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define bits64->bits32 (lambda (x) (modulo x (expt 2 32))))
|
||||
(define (blodwen-bits-shl-signed x y bits) (blodwen-toSignedInt (ash x y) bits))
|
||||
|
||||
(define blodwen-bits-shl-signed (lambda (x y bits) (blodwen-toSignedInt (ash x y) bits)))
|
||||
|
||||
(define blodwen-bits-shl (lambda (x y bits) (remainder (ash x y) (ash 1 bits))))
|
||||
(define (blodwen-bits-shl x y bits) (logand (ash x y) (sub1 (ash 1 bits))))
|
||||
|
||||
(define blodwen-shl (lambda (x y) (ash x y)))
|
||||
(define blodwen-shr (lambda (x y) (ash x (- y))))
|
||||
|
@ -25,15 +25,13 @@
|
||||
(void))
|
||||
res))))
|
||||
|
||||
(define blodwen-toSignedInt
|
||||
(lambda (x bits)
|
||||
(if (bit-set? bits x)
|
||||
(bitwise-ior x (arithmetic-shift (- 1) bits))
|
||||
(bitwise-and x (- (arithmetic-shift 1 bits) 1)))))
|
||||
(define (blodwen-toSignedInt x bits)
|
||||
(if (bit-set? bits x)
|
||||
(bitwise-ior x (arithmetic-shift -1 bits))
|
||||
(bitwise-and x (- (arithmetic-shift 1 bits) 1))))
|
||||
|
||||
(define blodwen-toUnsignedInt
|
||||
(lambda (x bits)
|
||||
(modulo x (arithmetic-shift 1 bits))))
|
||||
(define (blodwen-toUnsignedInt x bits)
|
||||
(bitwise-and x (sub1 (arithmetic-shift 1 bits))))
|
||||
|
||||
(define bu+ (lambda (x y bits) (blodwen-toUnsignedInt (+ x y) bits)))
|
||||
(define bu- (lambda (x y bits) (blodwen-toUnsignedInt (- x y) bits)))
|
||||
@ -45,34 +43,23 @@
|
||||
(define bs* (lambda (x y bits) (blodwen-toSignedInt (* x y) bits)))
|
||||
(define bs/ (lambda (x y bits) (blodwen-toSignedInt (quotient x y) bits)))
|
||||
|
||||
(define-macro (b+ x y bits)
|
||||
(if (exact-integer? bits)
|
||||
`(remainder (+ ,x ,y) ,(arithmetic-shift 1 bits))
|
||||
`(remainder (+ ,x ,y) (arithmetic-shift 1 ,bits))))
|
||||
(define-macro (b- x y bits)
|
||||
(if (exact-integer? bits)
|
||||
`(remainder (- ,x ,y) ,(arithmetic-shift 1 bits))
|
||||
`(remainder (- ,x ,y) (arithmetic-shift 1 ,bits))))
|
||||
(define-macro (b* x y bits)
|
||||
(if (exact-integer? bits)
|
||||
`(remainder (* ,x ,y) ,(arithmetic-shift 1 bits))
|
||||
`(remainder (* ,x ,y) (arithmetic-shift 1 ,bits))))
|
||||
(define-macro (b/ x y bits)
|
||||
(if (exact-integer? bits)
|
||||
`(remainder (floor (/ ,x ,y)) ,(arithmetic-shift 1 bits))
|
||||
`(remainder (floor (/ ,x ,y)) (arithmetic-shift 1 ,bits))))
|
||||
; To match Chez
|
||||
(define (add1 x) (+ x 1))
|
||||
(define (sub1 x) (- x 1))
|
||||
(define (fxsub1 x) (fx- x 1))
|
||||
(define (fxsub1 x) (fx- x 1))
|
||||
|
||||
(define integer->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define integer->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define integer->bits32 (lambda (x) (modulo x (expt 2 32))))
|
||||
(define integer->bits64 (lambda (x) (modulo x (expt 2 64))))
|
||||
(define (integer->bits8 x) (bitwise-and x #xff))
|
||||
(define (integer->bits16 x) (bitwise-and x #xffff))
|
||||
(define (integer->bits32 x) (bitwise-and x #xffffffff))
|
||||
(define (integer->bits64 x) (bitwise-and x #xffffffffffffffff))
|
||||
|
||||
(define bits16->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits32->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits32->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define bits64->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits64->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define bits64->bits32 (lambda (x) (modulo x (expt 2 32))))
|
||||
(define (bits16->bits8 x) (bitwise-and x #xff))
|
||||
(define (bits32->bits8 x) (bitwise-and x #xff))
|
||||
(define (bits64->bits8 x) (bitwise-and x #xff))
|
||||
(define (bits32->bits16 x) (bitwise-and x #xffff))
|
||||
(define (bits64->bits16 x) (bitwise-and x #xffff))
|
||||
(define (bits64->bits32 x) (bitwise-and x #xffffffff))
|
||||
|
||||
(define blodwen-bits-shl-signed
|
||||
(lambda (x y bits) (blodwen-toSignedInt (arithmetic-shift x y) bits)))
|
||||
|
@ -60,15 +60,13 @@
|
||||
default))
|
||||
|
||||
; primitives
|
||||
(define ct-toSignedInt
|
||||
(lambda (x bits)
|
||||
(if (bitwise-bit-set? x bits)
|
||||
(bitwise-ior x (arithmetic-shift (- 1) bits))
|
||||
(bitwise-and x (- (arithmetic-shift 1 bits) 1)))))
|
||||
(define (ct-toSignedInt x bits)
|
||||
(if (bitwise-bit-set? x bits)
|
||||
(bitwise-ior x (arithmetic-shift (- 1) bits))
|
||||
(bitwise-and x (sub1 (arithmetic-shift 1 bits)))))
|
||||
|
||||
(define ct-toUnsignedInt
|
||||
(lambda (x bits)
|
||||
(modulo x (arithmetic-shift 1 bits))))
|
||||
(define (ct-toUnsignedInt x bits)
|
||||
(bitwise-and x (sub1 (arithmetic-shift 1 bits))))
|
||||
|
||||
(define ct-u+ (lambda (x y bits)
|
||||
(let [(tag (vector-ref x 0))
|
||||
|
@ -16,15 +16,13 @@
|
||||
(void))
|
||||
res))))
|
||||
|
||||
(define blodwen-toSignedInt
|
||||
(lambda (x bits)
|
||||
(if (bitwise-bit-set? x bits)
|
||||
(bitwise-ior x (arithmetic-shift (- 1) bits))
|
||||
(bitwise-and x (- (arithmetic-shift 1 bits) 1)))))
|
||||
(define (blodwen-toSignedInt x bits)
|
||||
(if (bitwise-bit-set? x bits)
|
||||
(bitwise-ior x (arithmetic-shift (- 1) bits))
|
||||
(bitwise-and x (sub1 (arithmetic-shift 1 bits)))))
|
||||
|
||||
(define blodwen-toUnsignedInt
|
||||
(lambda (x bits)
|
||||
(modulo x (arithmetic-shift 1 bits))))
|
||||
(define (blodwen-toUnsignedInt x bits)
|
||||
(bitwise-and x (sub1 (arithmetic-shift 1 bits))))
|
||||
|
||||
(define bu+ (lambda (x y bits) (blodwen-toUnsignedInt (+ x y) bits)))
|
||||
(define bu- (lambda (x y bits) (blodwen-toUnsignedInt (- x y) bits)))
|
||||
@ -36,22 +34,21 @@
|
||||
(define bs* (lambda (x y bits) (blodwen-toSignedInt (* x y) bits)))
|
||||
(define bs/ (lambda (x y bits) (blodwen-toSignedInt (quotient x y) bits)))
|
||||
|
||||
(define b+ (lambda (x y bits) (remainder (+ x y) (arithmetic-shift 1 bits))))
|
||||
(define b- (lambda (x y bits) (remainder (- x y) (arithmetic-shift 1 bits))))
|
||||
(define b* (lambda (x y bits) (remainder (* x y) (arithmetic-shift 1 bits))))
|
||||
(define b/ (lambda (x y bits) (remainder (exact-floor (/ x y)) (arithmetic-shift 1 bits))))
|
||||
; To match Chez
|
||||
(define (fxadd1 x) (unsafe-fx+ x 1))
|
||||
(define (fxsub1 x) (unsafe-fx- x 1))
|
||||
|
||||
(define integer->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define integer->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define integer->bits32 (lambda (x) (modulo x (expt 2 32))))
|
||||
(define integer->bits64 (lambda (x) (modulo x (expt 2 64))))
|
||||
(define (integer->bits8 x) (bitwise-and x #xff))
|
||||
(define (integer->bits16 x) (bitwise-and x #xffff))
|
||||
(define (integer->bits32 x) (bitwise-and x #xffffffff))
|
||||
(define (integer->bits64 x) (bitwise-and x #xffffffffffffffff))
|
||||
|
||||
(define bits16->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits32->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits32->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define bits64->bits8 (lambda (x) (modulo x (expt 2 8))))
|
||||
(define bits64->bits16 (lambda (x) (modulo x (expt 2 16))))
|
||||
(define bits64->bits32 (lambda (x) (modulo x (expt 2 32))))
|
||||
(define (bits16->bits8 x) (bitwise-and x #xff))
|
||||
(define (bits32->bits8 x) (bitwise-and x #xff))
|
||||
(define (bits64->bits8 x) (bitwise-and x #xff))
|
||||
(define (bits32->bits16 x) (bitwise-and x #xffff))
|
||||
(define (bits64->bits16 x) (bitwise-and x #xffff))
|
||||
(define (bits64->bits32 x) (bitwise-and x #xffffffff))
|
||||
|
||||
(define blodwen-bits-shl (lambda (x y bits) (remainder (arithmetic-shift x y) (arithmetic-shift 1 bits))))
|
||||
(define blodwen-shl (lambda (x y) (arithmetic-shift x y)))
|
||||
|
Loading…
Reference in New Issue
Block a user