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

Last change on this file since 38103 was 38103, checked in by Kon Lovett, 6 weeks ago

canon import style

File size: 2.8 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(import (chicken base))
65(import (chicken fixnum))
66(import (chicken foreign))
67(import (chicken type))
68(import fx-inlines)
69
70;;;
71
72(: C_uword_log2 (number --> number))
73;
74(define C_uword_log2 (foreign-lambda long C_uword_log2 unsigned-long))
75
76;;
77
78(: *fxrandom (fixnum -> fixnum))
79;
80(define-inline (*fxrandom x) (##core#inline "C_random_fixnum" x))
81
82#|
83(: C_pow2log2 (number --> number))
84;
85(define C_pow2log2
86  (foreign-lambda* unsigned-long ((long n))
87   "if( 0 == n ) return( -1 );
88   if( 1 == n ) return( 2 );
89   return( 2 << C_uword_log2( (C_uword) (n - 1) ) );"))
90|#
91
92;;
93
94(: fxrandom (#!optional fixnum fixnum -> fixnum))
95;
96(define (fxrandom #!optional (lim most-positive-fixnum) (low 0))
97  (fx+ low (*fxrandom (fx- lim low))) )
98
99;;
100
101(: fxlog2 (fixnum --> fixnum))
102;
103(define (fxlog2 n) (C_uword_log2 n))
104
105(: fxpow2log2 (fixnum --> fixnum))
106;
107(define (fxpow2log2 n)
108  (cond
109    ((fxzero? n)  -1)
110    ((fx= 1 n)    2)
111    (else         (fxshl 2 (fxlog2 (fxsub1 n)))) ) )
112
113;;
114
115(: fxdistance* (fixnum fixnum fixnum fixnum --> fixnum))
116;
117(define (fxdistance* x1 y1 x2 y2) (fx+ (fxsqr (fx- x1 x2)) (fxsqr (fx- y1 y2))))
118
119(: fxdistance (fixnum fixnum fixnum fixnum --> fixnum))
120;
121(define (fxdistance x1 y1 x2 y2) (fx/ (fxdistance* x1 y1 x2 y2) 2))
122
123;;
124
125(: fxquo-and-mod (fixnum fixnum --> fixnum fixnum))
126;
127(define (fxquo-and-mod fxn fxd) (values (fx/ fxn fxd) (fxmod fxn fxd)))
128
129;;
130
131(: fxmax-and-min (fixnum #!rest fixnum --> fixnum fixnum))
132;
133(define (fxmax-and-min fx . fxs)
134  (let loop ((fxs fxs) (mx fx) (mn fx))
135    (if (null? fxs)
136      (values mx mn)
137      (let ((cur (car fxs)))
138        (loop (cdr fxs) (fxmax mx cur) (fxmin mn cur)) ) ) ) )
139
140) ;fx-utils
Note: See TracBrowser for help on using the repository browser.