;;;; fx-utils.scm
;;;; Kon Lovett, May '17

;;;; Issues
;;;;

#>
/* Integer log2 - high bit set */
static C_uword
C_uword_log2( C_uword n )
{
  static const C_uword
  LogTable256[] = { /* 16 x 16 */
    0, 0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3,
    4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
    5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
    5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
    6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7};

  C_uword r;

  if (0 == n) return 0;

# ifdef C_SIXTY_FOUR
  C_uword ttt;
  if ((ttt = n >> 32)) {
    C_uword tt;
    if ((tt = ttt >> 16)) {
      C_uword t;
      r = (t = tt >> 8) ? 48 + LogTable256[ t ] : 40 + LogTable256[ tt ];
    } else {
      C_uword t;
      r = (t = n >> 8) ? 32 + LogTable256[ t ] : 16 + LogTable256[ n ];
    }
  } else if ((ttt = ttt >> 16)) {
    C_uword t;
    r = (t = ttt >> 8) ? 24 + LogTable256[ t ] : 16 + LogTable256[ ttt ];
  } else {
    C_uword t;
    r = (t = ttt >> 8) ? 8 + LogTable256[ t ] : LogTable256[ n ];
  }
# else
  C_uword tt;
  if ((tt = n >> 16)) {
    C_uword t;
    r = (t = tt >> 8) ? 24 + LogTable256[ t ] : 16 + LogTable256[ tt ];
  } else {
    C_uword t;
    r = (t = n >> 8) ? 8 + LogTable256[ t ] : LogTable256[ n ];
  }
# endif

  return r + 1;
}
<#

(module fx-utils

(;export
  ;
  fxrandom
  ;
  fxzero? fxpositive? fxcardinal? fxnegative?
  ;
  fxclosed-right? fxclosed? fxclosed-left? fxclosedr? fxclosedl?
  ;
  fxabs
  ;
  fxadd1 fxsub1
  ;
  fxsqr fxcub
  fxpow2log2
  ;
  fxdistance fxdistance*
  ;
  fxmax-and-min)

(import scheme)

(import chicken foreign)

(declare
  (bound-to-procedure
    ##sys#flonum-fraction
    ##sys#check-inexact) )

;;;

(define C_uword_log2
  (foreign-lambda unsigned-long C_uword_log2 unsigned-long))

(define (*fxrandom x)
  (##core#inline "C_random_fixnum" x) )

(define (*fxadd1 fx)
  (##core#inline "C_fixnum_increase" fx) )

(define (*fxsub1 fx)
  (##core#inline "C_fixnum_decrease" fx) )

;;;

;;

(define (fxrandom #!optional (x most-positive-fixnum))
  (*fxrandom x) )

;;

(define (fxzero? n)
  (fx= 0 n) )

(define (fxpositive? n)
  (fx< 0 n) )

(define (fxcardinal? n)
  (fx<= 0 n) )

(define (fxnegative? n)
  (fx> 0 n) )

;;

(define (fxclosed-right? l x h)
  (and (fx< l x) (fx<= x h)) )

(define (fxclosed? l x h)
  (and (fx<= l x) (fx<= x h)) )

(define (fxclosed-left? l x h)
  (and (fx<= l x) (fx< x h)) )

(define fxclosedr? fxclosed-right?)
(define fxclosedl? fxclosed-left?)

;;;

;;

(define (fxabs n)
  (if (fxnegative? n) (fxneg n) n) )

;;

(define (fxadd1 n)
  (*fxadd1 n) )

(define (fxsub1 n)
  (*fxsub1 n) )

;;

(define (fxpow2log2 n)
  (fxshl 2 (C_uword_log2 n)) )

#;
(define *pow2log2
  (foreign-lambda* unsigned-long ((long n))
   "return( 2 << C_uword_log2( (C_uword) n ) );"))

(define (fxsqr n)
  (fx* n n) )

(define (fxcub n)
  (fx* n (fx* n n)) )

;;

(define (fxdistance x1 y1 x2 y2)
  (fx/ (fxdistance* x1 y1 x2 y2) 2) )

(define (fxdistance* x1 y1 x2 y2)
  (fx+ (fxsqr (fx- x1 x2)) (fxsqr (fx- y1 y2))) )

;;

(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