;;;; 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