;;;; 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 ); } C_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)) ; (define C_uword_log2 (foreign-lambda long C_uword_log2 unsigned-long)) ;; (: *fxrandom (fixnum -> fixnum)) ; (define-inline (*fxrandom x) (##core#inline "C_random_fixnum" x)) #| (: C_pow2log2 (number --> number)) ; (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) ) );")) |# ;; (: fxrandom (#!optional fixnum fixnum -> fixnum)) ; (define (fxrandom #!optional (lim most-positive-fixnum) (low 0)) (fx+ low (*fxrandom (fx- lim low))) ) ;; (: fxlog2 (fixnum --> fixnum)) ; (define (fxlog2 n) (C_uword_log2 n)) (: fxpow2log2 (fixnum --> fixnum)) ; (define (fxpow2log2 n) (cond ((fxzero? n) -1) ((fx= 1 n) 2) (else (fxshl 2 (fxlog2 (fxsub1 n)))) ) ) ;; (: fxdistance* (fixnum fixnum fixnum fixnum --> fixnum)) ; (define (fxdistance* x1 y1 x2 y2) (fx+ (fxsqr (fx- x1 x2)) (fxsqr (fx- y1 y2)))) (: fxdistance (fixnum fixnum fixnum fixnum --> fixnum)) ; (define (fxdistance x1 y1 x2 y2) (fx/ (fxdistance* x1 y1 x2 y2) 2)) ;; (: fxquo-and-mod (fixnum fixnum --> fixnum fixnum)) ; (define (fxquo-and-mod fxn fxd) (values (fx/ fxn fxd) (fxmod fxn fxd))) ;; (: fxmax-and-min (fixnum #!rest fixnum --> fixnum fixnum)) ; (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)) ) ) ) ) ) ;fx-utils