;;;; fx-utils.scm -*- Scheme -*- ;;;; Kon Lovett, Jul '18 ;;;; Kon Lovett, May '17 #> /* Integer log2 - high bit set */ static C_uword C_uword_log2( C_uword n ) { static const C_uword # define LT( n ) n, n, n, n, n, n, n, n, n, n, n, n, n, n, n, n LogTable256[] = { /* 16 x 16 */ -1, 0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, LT( 4 ), LT( 5 ), LT( 5 ), LT( 6 ), LT( 6 ), LT( 6 ), LT( 6 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ) }; # undef LT # define rem( i, c ) ((i) >> (c)) # define log( i ) (LogTable256[ (i) & 0xff ]) C_uword r; C_uword tt, t; # ifdef C_SIXTY_FOUR C_uword ttt; if( (ttt = rem( n, 32 )) ) { if( (tt = rem( ttt, 16 )) ) { r = (t = rem( tt, 8 )) ? 56 + log( t ) : 48 + log( tt ); } else { r = (t = rem( n, 8 )) ? 40 + log( t ) : 32 + log( n ); } } else /*cont to 32-bit */ # endif if( (tt = rem( n, 16 )) ) { r = (t = rem( tt, 8 )) ? 24 + log( t ) : 16 + log( tt ); } else { r = (t = rem( n, 8 )) ? 8 + log( t ) : log( n ); } return( r ); # undef log # undef rem } <# (module fx-utils (;export ; fxrandom fxlog2 fxpow2log2 ; fxdistance fxdistance* ; fxquo-and-mod fxmax-and-min) (import scheme) (import (chicken base)) (import (chicken fixnum)) (import (chicken foreign)) (import (chicken type)) (import fx-inlines) ;;; (: C_uword_log2 (number -> number)) (: *fxrandom (fixnum -> fixnum)) #;(: C_pow2log2 (number -> number)) (: fxrandom (#!optional fixnum fixnum -> fixnum)) (: fxlog2 (fixnum -> fixnum)) (: fxpow2log2 (fixnum -> fixnum)) (: fxdistance* (fixnum fixnum fixnum fixnum -> fixnum)) (: fxdistance (fixnum fixnum fixnum fixnum -> fixnum)) (: fxquo-and-mod (fixnum fixnum -> fixnum fixnum)) (: fxmax-and-min (fixnum #!rest fixnum -> fixnum fixnum)) (: fx% (fixnum fixnum -> fixnum)) ;; (define C_uword_log2 (foreign-lambda long C_uword_log2 unsigned-long)) ;; (define-inline (*fxrandom x) (##core#inline "C_random_fixnum" x)) #| (define C_pow2log2 (foreign-lambda* unsigned-long ((long n)) "if( 0 == n ) return( -1 ); if( 1 == n ) return( 2 ); return( 2 << C_uword_log2( (C_uword) (n - 1) ) );")) |# ;; (define (fxrandom #!optional (lim most-positive-fixnum) (low 0)) (fx+ low (*fxrandom (fx- lim low))) ) ;; (define (fxlog2 n) (C_uword_log2 n)) (define (fxpow2log2 n) (cond ((fxzero? n) -1) ((fx= 1 n) 2) (else (fxshl 2 (fxlog2 (fxsub1 n)))) ) ) ;; (define (fxdistance* x1 y1 x2 y2) (fx+ (fxsqr (fx- x1 x2)) (fxsqr (fx- y1 y2)))) (define (fxdistance x1 y1 x2 y2) (fx/ (fxdistance* x1 y1 x2 y2) 2)) ;; (define (fxquo-and-mod fxn fxd) (values (fx/ fxn fxd) (fxmod fxn fxd))) ;; (define (fxmax-and-min fx . fxs) (let loop ((fxs fxs) (mx fx) (mn fx)) (if (null? fxs) (values mx mn) (let ((cur (car fxs))) (loop (cdr fxs) (fxmax mx cur) (fxmin mn cur)) ) ) ) ) ;; (define (fx% n p) (fx/ (fx* p n) 100)) #| ;; (: fx! (fixnum -> fixnum)) ; (define (fx! n) (cond ((fx>= 0 n) 0) ((fx= 1 n) 1) ((fx= 2 n) 1) (else (fx+ (fx! (fx- n 1)) (fx! (fx- n 2)))) ) ) |# ) ;fx-utils