Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Added additional defs from ref impl

Browse source
This commit is contained in:
Justin Ethier 2017-08-08 15:33:21 +00:00
parent be11ed674f
commit 444f27a8a6
1 changed files with 45 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
srfi/143.sld
View file

@ -28,9 +28,10 @@
fxarithmetic-shift
fxarithmetic-shift-left fxarithmetic-shift-right
; fxbit-count fxlength
fxif fxbit-set? ;fxcopy-bit
; fxfirst-set-bit fxbit-field
; fxbit-field-rotate fxbit-field-reverse
fxif fxbit-set? fxcopy-bit
;fxfirst-set-bit
fxbit-field
fxbit-field-rotate fxbit-field-reverse
)
(inline
fx-width
@ -46,7 +47,10 @@
fxnot fxand fxior fxxor
fxarithmetic-shift
fxarithmetic-shift-left fxarithmetic-shift-right
fxif fxbit-set?
fxif fxbit-set? fxcopy-bit
;fxfirst-set-bit
fxbit-field
mask
)
(begin
(define (fx-width) 31)
@ -140,5 +144,42 @@
Cyc_check_fixnum(data, i);
int result = ((obj_obj2int(i)) & (1 << (obj_obj2int(index))));
return_closcall1(data, k, result ? boolean_t : boolean_f); ")
(define (fxcopy-bit index to bool)
(if bool
(fxior to (fxarithmetic-shift-left 1 index))
(fxand to (fxnot (fxarithmetic-shift-left 1 index)))))
;; Helper function
(define (mask start end) (fxnot (fxarithmetic-shift-left -1 (- end start))))
;(define (fxfirst-set-bit i) (- (fxbit-count (fxxor i (- i 1))) 1))
(define (fxbit-field n start end)
(fxand (mask start end) (fxarithmetic-shift n (- start))))
(define (fxbit-field-rotate n count start end)
(define width (fx- end start))
(set! count (modulo count width))
(let ((mask (fxnot (fxarithmetic-shift -1 width))))
(define zn (fxand mask (fxarithmetic-shift n (- start))))
(fxior (fxarithmetic-shift
(fxior (fxand mask (fxarithmetic-shift zn count))
(fxarithmetic-shift zn (- count width)))
start)
(fxand (fxnot (fxarithmetic-shift mask start)) n))))
(define (fxreverse k n)
(do ((m (if (negative? n) (fxnot n) n) (fxarithmetic-shift-right m 1))
(k (fx+ -1 k) (fx+ -1 k))
(rvs 0 (fxior (fxarithmetic-shift-left rvs 1) (fxand 1 m))))
((fxnegative? k) (if (fxnegative? n) (fxnot rvs) rvs))))
(define (fxbit-field-reverse n start end)
(define width (- end start))
(let ((mask (fxnot (fxarithmetic-shift-left -1 width))))
(define zn (fxand mask (fxarithmetic-shift-right n start)))
(fxior (fxarithmetic-shift-left (fxreverse width zn) start)
(fxand (fxnot (fxarithmetic-shift-left mask start)) n))))
))