source: project/release/5/fx-utils/trunk/fx-utils.scm @ 36574

Last change on this file since 36574 was 36572, checked in by Kon Lovett, 18 months ago

fix dir, split

File size: 2.9 KB
Line 
1;;;; fx-utils.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, May '17
4
5#>
6/* Integer log2 - high bit set */
7static C_uword
8C_uword_log2( C_uword n )
9{
10static const C_uword
11# define LT( n )  n, n, n, n, n, n, n, n, n, n, n, n, n, n, n, n
12  LogTable256[] = { /* 16 x 16 */
13    -1, 0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3,
14    LT( 4 ),
15    LT( 5 ), LT( 5 ),
16    LT( 6 ), LT( 6 ), LT( 6 ), LT( 6 ),
17    LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 )
18  };
19# undef LT
20
21# define rem( i, c )  ((i) >> (c))
22# define log( i )     (LogTable256[ (i) & 0xff ])
23
24  C_uword r;
25
26  C_uword tt, t;
27# ifdef C_SIXTY_FOUR
28  C_uword ttt;
29  if( (ttt = rem( n, 32 )) ) {
30    if( (tt = rem( ttt, 16 )) ) {
31      r = (t = rem( tt, 8 )) ? 56 + log( t ) : 48 + log( tt );
32    } else {
33      r = (t = rem( n, 8 )) ? 40 + log( t ) : 32 + log( n );
34    }
35  } else /*cont to 32-bit */
36# endif
37  if( (tt = rem( n, 16 )) ) {
38    r = (t = rem( tt, 8 )) ? 24 + log( t ) : 16 + log( tt );
39  } else {
40    r = (t = rem( n, 8 )) ? 8 + log( t ) : log( n );
41  }
42
43  C_return( r );
44
45# undef log
46# undef rem
47}
48<#
49
50(module fx-utils
51
52(;export
53  ;
54  fxrandom
55  fxlog2
56  fxpow2log2
57  ;
58  fxdistance fxdistance*
59  ;
60  fxquo-and-mod
61  fxmax-and-min)
62
63(import scheme
64  (chicken base)
65  (chicken fixnum)
66  (chicken foreign)
67  (chicken type))
68
69;;;
70
71(include "fx-inlines")  ;(chicken base) 7 not scheme?
72
73;;;
74
75(: C_uword_log2 (number --> number))
76;
77(define C_uword_log2 (foreign-lambda long C_uword_log2 unsigned-long))
78
79;;
80
81(: *fxrandom (fixnum -> fixnum))
82;
83(define-inline (*fxrandom x) (##core#inline "C_random_fixnum" x))
84
85#|
86(: C_pow2log2 (number --> number))
87;
88(define C_pow2log2
89  (foreign-lambda* unsigned-long ((long n))
90   "if( 0 == n ) return( -1 );
91   if( 1 == n ) return( 2 );
92   return( 2 << C_uword_log2( (C_uword) (n - 1) ) );"))
93|#
94
95;;
96
97(: fxrandom (#!optional fixnum fixnum -> fixnum))
98;
99(define (fxrandom #!optional (lim most-positive-fixnum) (low 0))
100  (fx+ low (*fxrandom (fx- lim low))) )
101
102;;
103
104(: fxlog2 (fixnum --> fixnum))
105;
106(define (fxlog2 n) (C_uword_log2 n))
107
108(: fxpow2log2 (fixnum --> fixnum))
109;
110(define (fxpow2log2 n)
111  (cond
112    ((fxzero? n)  -1)
113    ((fx= 1 n)    2)
114    (else         (fxshl 2 (fxlog2 (fxsub1 n)))) ) )
115
116;;
117
118(: fxdistance* (fixnum fixnum fixnum fixnum --> fixnum))
119;
120(define (fxdistance* x1 y1 x2 y2) (fx+ (fxsqr (fx- x1 x2)) (fxsqr (fx- y1 y2))))
121
122(: fxdistance (fixnum fixnum fixnum fixnum --> fixnum))
123;
124(define (fxdistance x1 y1 x2 y2) (fx/ (fxdistance* x1 y1 x2 y2) 2))
125
126;;
127
128(: fxquo-and-mod (fixnum fixnum --> fixnum fixnum))
129;
130(define (fxquo-and-mod fxn fxd) (values (fx/ fxn fxd) (fxmod fxn fxd)))
131
132;;
133
134(: fxmax-and-min (fixnum #!rest fixnum --> fixnum fixnum))
135;
136(define (fxmax-and-min fx . fxs)
137  (let loop ((fxs fxs) (mx fx) (mn fx))
138    (if (null? fxs)
139      (values mx mn)
140      (let ((cur (car fxs)))
141        (loop (cdr fxs) (fxmax mx cur) (fxmin mn cur)) ) ) ) )
142
143) ;fx-utils
Note: See TracBrowser for help on using the repository browser.