Changeset 34820 in project


Ignore:
Timestamp:
10/31/17 18:10:06 (3 years ago)
Author:
Kon Lovett
Message:

fix log2

Location:
release/4/mathh/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/mathh/trunk/fx-utils.scm

    r34818 r34820  
    2222  ;
    2323  fxsqr fxcub
     24  fxlog2
    2425  fxpow2log2
    2526  ;
     
    4647C_uword_log2( C_uword n )
    4748{
    48   static const C_uword
     49static const C_uword
    4950  LogTable256[] = { /* 16 x 16 */
    50     0, 0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3,
    51     4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
    52     5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
    53     5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5,
    54     6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    55     6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    56     6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    57     6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6,
    58     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    59     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    60     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    61     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    62     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    63     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    64     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
    65     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7};
     51# define LT( n )  n, n, n, n, n, n, n, n, n, n, n, n, n, n, n, n
     52    -1, 0, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3,
     53    LT( 4 ),
     54    LT( 5 ), LT( 5 ),
     55    LT( 6 ), LT( 6 ), LT( 6 ), LT( 6 ),
     56    LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 ), LT( 7 )
     57# undef LT
     58  };
     59
     60# define rem( i, c )  ((i) >> (c))
     61# define log( i ) (LogTable256[ (i) & 0xff ])
    6662
    6763  C_uword r;
    6864
    69   if (0 == n) return 0;
    70 
     65  C_uword tt, t;
    7166# ifdef C_SIXTY_FOUR
    7267  C_uword ttt;
    73   if ((ttt = n >> 32)) {
    74     C_uword tt;
    75     if ((tt = ttt >> 16)) {
    76       C_uword t;
    77       r = (t = tt >> 8) ? 48 + LogTable256[ t ] : 40 + LogTable256[ tt ];
     68  if( (ttt = rem( n, 32 )) ) {
     69    if( (tt = rem( ttt, 16 )) ) {
     70      r = (t = rem( tt, 8 )) ? 56 + log( t ) : 48 + log( tt );
    7871    } else {
    79       C_uword t;
    80       r = (t = n >> 8) ? 32 + LogTable256[ t ] : 16 + LogTable256[ n ];
     72      r = (t = rem( n, 8 )) ? 40 + log( t ) : 32 + log( n );
    8173    }
    82   } else if ((ttt = ttt >> 16)) {
    83     C_uword t;
    84     r = (t = ttt >> 8) ? 24 + LogTable256[ t ] : 16 + LogTable256[ ttt ];
     74  } else /*cont to 32-bit */
     75# endif
     76  if( (tt = rem( n, 16 )) ) {
     77    r = (t = rem( tt, 8 )) ? 24 + log( t ) : 16 + log( tt );
    8578  } else {
    86     C_uword t;
    87     r = (t = ttt >> 8) ? 8 + LogTable256[ t ] : LogTable256[ n ];
     79    r = (t = rem( n, 8 )) ? 8 + log( t ) : log( n );
    8880  }
    89 # else
    90   C_uword tt;
    91   if ((tt = n >> 16)) {
    92     C_uword t;
    93     r = (t = tt >> 8) ? 24 + LogTable256[ t ] : 16 + LogTable256[ tt ];
    94   } else {
    95     C_uword t;
    96     r = (t = n >> 8) ? 8 + LogTable256[ t ] : LogTable256[ n ];
    97   }
    98 # endif
    99 
    100   return r + 1;
     81
     82  C_return( r );
     83
     84# undef log
     85# undef rem
    10186}
    10287<#
    10388
    10489(define C_uword_log2
    105   (foreign-lambda unsigned-long C_uword_log2 unsigned-long))
     90  (foreign-lambda long C_uword_log2 unsigned-long))
    10691
    10792;;
     
    118103(define (*fxsub1 fx)
    119104  (##core#inline "C_fixnum_decrease" fx) )
    120 
    121 ;;;
    122 
    123 ;;
    124 
    125 (: fxrandom (#!optional fixnum -> fixnum))
    126 (define (fxrandom #!optional (x most-positive-fixnum))
    127   (*fxrandom x) )
    128 
    129 ;;
    130 
    131 (: fxzero? (fixnum --> boolean))
    132 (define (fxzero? n)
    133   (fx= 0 n) )
    134 
    135 (: fxpositive? (fixnum --> boolean))
    136 (define (fxpositive? n)
    137   (fx< 0 n) )
    138 
    139 (: fxcardinal? (fixnum --> boolean))
    140 (define (fxcardinal? n)
    141   (fx<= 0 n) )
    142 
    143 (: fxnegative? (fixnum --> boolean))
    144 (define (fxnegative? n)
    145   (fx> 0 n) )
    146 
    147 (: fxnon-positive? (fixnum --> boolean))
    148 (define (fxnon-positive? n)
    149   (fx>= 0 n) )
    150 
    151 ;;
    152 
    153 (: fxclosed-right? (fixnum fixnum fixnum --> boolean))
    154 (define (fxclosed-right? l x h)
    155   (and (fx< l x) (fx<= x h)) )
    156 
    157 (: fxclosed? (fixnum fixnum fixnum --> boolean))
    158 (define (fxclosed? l x h)
    159   (and (fx<= l x) (fx<= x h)) )
    160 
    161 (: fxclosed-left? (fixnum fixnum fixnum --> boolean))
    162 (define (fxclosed-left? l x h)
    163   (and (fx<= l x) (fx< x h)) )
    164 
    165 (define fxclosedr? fxclosed-right?)
    166 (define fxclosedl? fxclosed-left?)
    167 
    168 ;;;
    169 
    170 ;;
    171 
    172 (: fxabs (fixnum --> fixnum))
    173 (define (fxabs n)
    174   (if (fxnegative? n) (fxneg n) n) )
    175 
    176 ;;
    177 
    178 (: fxadd1 (fixnum --> fixnum))
    179 (define (fxadd1 n)
    180   (*fxadd1 n) )
    181 
    182 (: fxsub1 (fixnum --> fixnum))
    183 (define (fxsub1 n)
    184   (*fxsub1 n) )
    185 
    186 ;;
    187 
    188 (: fxpow2log2 (fixnum --> fixnum))
    189 (define (fxpow2log2 n)
    190   (fxshl 2 (C_uword_log2 n)) )
    191105
    192106#|
     
    196110   "return( 2 << C_uword_log2( (C_uword) n ) );"))
    197111|#
     112
     113;;;
     114
     115;;
     116
     117(: fxrandom (#!optional fixnum -> fixnum))
     118(define (fxrandom #!optional (x most-positive-fixnum))
     119  (*fxrandom x) )
     120
     121;;
     122
     123(: fxzero? (fixnum --> boolean))
     124(define (fxzero? n)
     125  (fx= 0 n) )
     126
     127(: fxpositive? (fixnum --> boolean))
     128(define (fxpositive? n)
     129  (fx< 0 n) )
     130
     131(: fxcardinal? (fixnum --> boolean))
     132(define (fxcardinal? n)
     133  (fx<= 0 n) )
     134
     135(: fxnegative? (fixnum --> boolean))
     136(define (fxnegative? n)
     137  (fx> 0 n) )
     138
     139(: fxnon-positive? (fixnum --> boolean))
     140(define (fxnon-positive? n)
     141  (fx>= 0 n) )
     142
     143;;
     144
     145(: fxclosed-right? (fixnum fixnum fixnum --> boolean))
     146(define (fxclosed-right? l x h)
     147  (and (fx< l x) (fx<= x h)) )
     148
     149(: fxclosed? (fixnum fixnum fixnum --> boolean))
     150(define (fxclosed? l x h)
     151  (and (fx<= l x) (fx<= x h)) )
     152
     153(: fxclosed-left? (fixnum fixnum fixnum --> boolean))
     154(define (fxclosed-left? l x h)
     155  (and (fx<= l x) (fx< x h)) )
     156
     157(define fxclosedr? fxclosed-right?)
     158(define fxclosedl? fxclosed-left?)
     159
     160;;;
     161
     162;;
     163
     164(: fxabs (fixnum --> fixnum))
     165(define (fxabs n)
     166  (if (fxnegative? n) (fxneg n) n) )
     167
     168;;
     169
     170(: fxadd1 (fixnum --> fixnum))
     171(define (fxadd1 n)
     172  (*fxadd1 n) )
     173
     174(: fxsub1 (fixnum --> fixnum))
     175(define (fxsub1 n)
     176  (*fxsub1 n) )
     177
     178;;
     179
     180(: fxlog2 (fixnum --> fixnum))
     181(define (fxlog2 n)
     182  (C_uword_log2 n) )
     183
     184(: fxpow2log2 (fixnum --> fixnum))
     185(define (fxpow2log2 n)
     186  (cond
     187    ((fxzero? n)
     188      -1 )
     189    ((fx= 1 n)
     190      2 )
     191    (else
     192      (fxshl 2 (fxlog2 (fxsub1 n))) ) ) )
    198193
    199194(: fxsqr (fixnum --> fixnum))
  • release/4/mathh/trunk/tests/mathh-test.scm

    r34558 r34820  
    1010
    1111(require-extension mathh)
     12
     13(test-begin "mathh")
    1214
    1315;;
     
    9092;;;
    9193
     94;(import (prefix mathh-consts C:))
     95;(require-library mathh-consts)
     96;=> C:sqrt2 C:degree C:ln2 C:log2e C:e
     97(require-extension mathh-consts)
     98
     99(test-group "Math Constants"
     100
     101        ; Well, some
     102        (test sqrt2 (sqrt 2.0))
     103        (test degree (/ pi 180.0))
     104        (test ln2 (log 2.0))
     105        (test log2e (log2 e))
     106)
     107
     108;;;
     109
     110(test-group "Inline failure #1340"
     111  (define (factorial x)
     112    (gamma (+ 1 x)) )
     113  (test 362880.0 (factorial 9))
     114)
     115
     116;;;
     117
    92118(require-extension fp-utils)
    93119
     
    178204        (test 27 (fxcub 3))
    179205
    180         (test 8 (fxpow2log2 3))
     206        (test -1 (fxlog2 0))
     207        (test 0 (fxlog2 1))
     208        (test 1 (fxlog2 2))
     209        (test 1 (fxlog2 3))
     210        (test 2 (fxlog2 4))
     211
     212        (test -1 (fxpow2log2 0))
     213        (test 4 (fxpow2log2 3))
     214        (test 8 (fxpow2log2 7))
     215        (test 16 (fxpow2log2 15))
     216        (test 16 (fxpow2log2 16))
     217        (test 32 (fxpow2log2 17))
    181218
    182219        (test 16 (fxdistance 1 1 5 5))
     
    189226;;;
    190227
    191 ;(import (prefix mathh-consts C:))
    192 ;(require-library mathh-consts)
    193 ;=> C:sqrt2 C:degree C:ln2 C:log2e C:e
    194 (require-extension mathh-consts)
    195 
    196 (test-group "Math Constants"
    197 
    198         ; Well, some
    199         (test sqrt2 (sqrt 2.0))
    200         (test degree (/ pi 180.0))
    201         (test ln2 (log 2.0))
    202         (test log2e (log2 e))
    203 )
    204 
    205 ;;;
    206 
    207 (test-group "Inline failure #1340"
    208   (define (factorial x)
    209     (gamma (+ 1 x)) )
    210   (test 362880.0 (factorial 9))
    211 )
     228(test-end "mathh")
    212229
    213230;;;
Note: See TracChangeset for help on using the changeset viewer.