Changeset 14016 in project


Ignore:
Timestamp:
03/31/09 19:48:41 (11 years ago)
Author:
Kon Lovett
Message:

Updated inlines.

Location:
release/4/err5rs-arithmetic/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/err5rs-arithmetic/trunk/chicken-primitive-object-inlines.scm

    r13807 r14016  
    965965(define-inline (%number? x) (or (%fixnum? x) (%flonum? x)))
    966966(define-inline (%integer? x) (##core#inline "C_i_integerp" x))
    967 
    968 (define-inline (%= x y) ((##core#primitive "C_i_eqvp") x y))
    969 (define-inline (%< x y) ((##core#primitive "C_i_lessp") x y))
    970 (define-inline (%<= x y) ((##core#primitive "C_i_less_or_equalp") x y))
    971 (define-inline (%> x y) ((##core#primitive "C_i_greaterp") x y))
    972 (define-inline (%>= x y) ((##core#primitive "C_i_greater_or_equalp") x y))
     967(define-inline (%exact? x) (##core#inline "C_i_exactp" x))
     968(define-inline (%inexact? x) (##core#inline "C_i_inexactp" x))
     969
     970(define-inline (%= x y) (##core#inline "C_i_eqvp" x y))
     971(define-inline (%< x y) (##core#inline "C_i_lessp" x y))
     972(define-inline (%<= x y) (##core#inline "C_i_less_or_equalp" x y))
     973(define-inline (%> x y) (##core#inline "C_i_greaterp" x y))
     974(define-inline (%>= x y) (##core#inline "C_i_greater_or_equalp" x y))
    973975
    974976(define-inline (%zero? n) (##core#inline "C_i_zerop" n))
    975977(define-inline (%positive? n) (##core#inline "C_i_positivep" n))
    976978(define-inline (%negative? n) (##core#inline "C_i_negativep" n))
    977 (define-inline (%cardinal? n) (and (%integer? n) (%<= 0 n)))
    978979(define-inline (%odd? n) (##core#inline "C_i_oddp" n))
    979980(define-inline (%even? n) (##core#inline "C_i_evenp" n))
     981(define-inline (%cardinal? n) (and (%integer? n) (%<= 0 n)))
    980982
    981983(define-inline (%+ x y) ((##core#primitive "C_plus") x y))
  • release/4/err5rs-arithmetic/trunk/err5rs-arithmetic-fixnums.scm

    r14010 r14016  
    2424#>
    2525static int
    26 invalid_sum( C_word si1, C_word si2 )
     26C_invalid_sump( C_word si1, C_word si2 )
    2727{
    2828#if 0
     
    3838
    3939static int
    40 invalid_difference( C_word si1, C_word si2 )
     40C_invalid_differencep( C_word si1, C_word si2 )
    4141{
    4242#if 0
     
    4646                        & (1 << (C_WORD_SIZE - (1 + 1))))) - si2) ^ si2)) < 0 );
    4747#else
    48   return invalid_sum( si1, -si2 );
     48  return C_invalid_sump( si1, -si2 );
    4949#endif
    5050}
    5151
    5252static int
    53 invalid_product( C_word si1, C_word si2 )
     53C_invalid_productp( C_word si1, C_word si2 )
    5454{
    5555  if (si1 > 0) {
     
    6565
    6666static int
    67 invalid_division( C_word si1, C_word si2 )
     67C_invalid_divisionp( C_word si1, C_word si2 )
    6868{
    6969  return ( (si1 == C_MOST_NEGATIVE_FIXNUM) && (si2 == -1) );
     
    147147;; Arithmetic
    148148
    149 (define-inline (%fx/-check loc fxn fxd)
     149(define-inline (%fx/check loc fxn fxd)
    150150  (%check-fixnum loc fxn)
    151151  (%check-fixnum loc fxd)
    152152  (%check-zero-division loc fxn fxd)
    153   (when (invalid-division fxn fxd) (error-fixnum-representation loc fxn fxd))
     153  (when (invalid-division? fxn fxd) (error-fixnum-representation loc fxn fxd))
    154154  (%fx/ fxn fxd) )
     155
     156(define-inline (%fxmod-divisor fxd)
     157  (or (and (%fxnegative? fxd) (not (%fx= most-positive-fixnum fxd))
     158           (%fxneg fxd))
     159      fxd) )
    155160
    156161(define-inline (%fxdiv0 fxn fxd)
     
    227232  fxzero? fxpositive? fxnegative? fxodd? fxeven?
    228233  fxmax fxmin fxmax-and-min
    229   fxdiv fxmod fxdiv-and-mod fxdiv0 fxmod0 fxdiv0-and-mod0
     234  fxdiv fxmod fxdiv-and-mod
     235  fxdiv0 fxmod0 fxdiv0-and-mod0
    230236  fx*/carry fx+/carry fx-/carry
    231237  fxarithmetic-shift fxarithmetic-shift-left fxarithmetic-shift-right
     
    242248  fxrotate-bit-field
    243249  fxreverse-bit-field
     250  ;; Originals
     251  chicken:fxmax chicken:fxmin
     252  chicken:fxnot chicken:fxand chicken:fxior chicken:fxxor
     253  chicken:fx+ chicken:fx- chicken:fx* chicken:fx/ chicken:fxmod
    244254  ;; Extras
    245255  fx<>?
     
    435445;;
    436446
    437 (define invalid-sum (foreign-lambda bool "invalid_sum" int int))
    438 (define invalid-difference (foreign-lambda bool "invalid_difference" int int))
    439 (define invalid-product (foreign-lambda bool "invalid_product" int int))
    440 (define invalid-division (foreign-lambda bool "invalid_division" int int))
     447(define invalid-sum? (foreign-lambda bool "C_invalid_sump" int int))
     448(define invalid-difference? (foreign-lambda bool "C_invalid_differencep" int int))
     449(define invalid-product? (foreign-lambda bool "C_invalid_productp" int int))
     450(define invalid-division? (foreign-lambda bool "C_invalid_divisionp" int int))
    441451
    442452(define ($fx+ x y)
    443453  (%check-fixnum 'fx+ x)
    444454  (%check-fixnum 'fx+ y)
    445   (when (invalid-sum x y) (error-fixnum-representation 'fx+ x y))
     455  (when (invalid-sum? x y) (error-fixnum-representation 'fx+ x y))
    446456  (%fx+ x y) )
    447457
     
    450460  (cond (y
    451461         (%check-fixnum 'fx- y)
    452          (when (invalid-difference x y) (error-fixnum-representation 'fx- x y))
     462         (when (invalid-difference? x y) (error-fixnum-representation 'fx- x y))
    453463         (%fx- x y) )
    454464        ((%fx= x most-negative-fixnum)
     
    460470  (%check-fixnum 'fx* x)
    461471  (%check-fixnum 'fx* y)
    462   (when (invalid-product x y) (error-fixnum-representation 'fx* x y))
     472  (when (invalid-product? x y) (error-fixnum-representation 'fx* x y))
    463473  (%fx* x y) )
    464474
    465 (define ($fx/ x y)
    466   (%fx/-check 'fx/ x y) )
     475(define ($fx/ x y) (%fx/check 'fx/ x y))
    467476
    468477;;; ERR5RS
     
    530539(define fx- $fx-)
    531540(define fx* $fx*)
    532 (define (fxdiv fxn fxd) (%fx/-check 'fxquotient fxn fxd))
     541(define (fxdiv fxn fxd) (%fx/check 'fxdiv fxn fxd))
    533542
    534543(define (fxmod fxn fxd)
     
    536545  (%check-fixnum 'fxmod fxd)
    537546  (%check-zero-division 'fxmod fxn fxd)
    538   (%fxmod fxn (or (and (%fxnegative? fxd) (not (%fx= most-positive-fixnum fxd))
    539                        (%fxneg fxd))
    540                   fxd)) )
     547  (%fxmod fxn (%fxmod-divisor fxd)) )
    541548
    542549(define (fxdiv-and-mod fxn fxd)
     
    544551  (%check-fixnum 'fxdiv-and-mod fxd)
    545552  (%check-zero-division 'fxdiv fxn fxd)
    546   (when (invalid-division fxn fxd) (error-fixnum-representation 'fxdiv-and-mod fxn fxd))
    547   (values (%fx/ fxn fxd)
    548           (%fxmod fxn (or (and (%fxnegative? fxd) (not (%fx= most-positive-fixnum fxd))
    549                                (%fxneg fxd))
    550                           fxd))) )
     553  (when (invalid-division? fxn fxd) (error-fixnum-representation 'fxdiv-and-mod fxn fxd))
     554  (values (%fx/ fxn fxd) (%fxmod fxn (%fxmod-divisor fxd))) )
    551555
    552556;;
     
    582586  (%check-fixnum 'fx*/carry fx2)
    583587  (%check-fixnum 'fx*/carry fx3)
    584   (when (invalid-product fx1 fx2) (error-fixnum-representation 'fx*/carry fx1 fx2 fx3))
     588  (when (invalid-product? fx1 fx2) (error-fixnum-representation 'fx*/carry fx1 fx2 fx3))
    585589  (let ((prod (%fx* fx1 fx2)))
    586     (when (invalid-sum prod fx3) (error-fixnum-representation 'fx*/carry fx1 fx2 fx3))
     590    (when (invalid-sum? prod fx3) (error-fixnum-representation 'fx*/carry fx1 fx2 fx3))
    587591    (let ((res (%fx+ prod fx3)))
    588592      (values res (%fxcarry-bit (%+ prod (%- fx3 res)))) ) ) )
     
    592596  (%check-fixnum 'fx+/carry fx2)
    593597  (%check-fixnum 'fx+/carry fx3)
    594   (when (invalid-sum fx1 fx2) (error-fixnum-representation 'fx+/carry fx1 fx2 fx3))
     598  (when (invalid-sum? fx1 fx2) (error-fixnum-representation 'fx+/carry fx1 fx2 fx3))
    595599  (let ((sum (%fx+ fx1 fx2)))
    596     (when (invalid-sum sum fx3) (error-fixnum-representation 'fx+/carry fx1 fx2 fx3))
     600    (when (invalid-sum? sum fx3) (error-fixnum-representation 'fx+/carry fx1 fx2 fx3))
    597601    (let ((res (%fx+ sum fx3)))
    598602      (values res (%fxcarry-bit (%+ (%+ fx1 fx2) (%- fx3 res)))) ) ) )
     
    602606  (%check-fixnum 'fx-/carry fx2)
    603607  (%check-fixnum 'fx-/carry fx3)
    604   (when (invalid-difference fx1 fx2) (error-fixnum-representation 'fx-/carry fx1 fx2 fx3))
     608  (when (invalid-difference? fx1 fx2) (error-fixnum-representation 'fx-/carry fx1 fx2 fx3))
    605609  (let ((diff (%fx- fx1 fx2)))
    606     (when (invalid-difference diff fx3) (error-fixnum-representation 'fx-/carry fx1 fx2 fx3))
     610    (when (invalid-difference? diff fx3) (error-fixnum-representation 'fx-/carry fx1 fx2 fx3))
    607611    (let ((res (%fx- diff fx3)))
    608612      (values res (%fxcarry-bit (%- (%- fx1 fx2) (%+ res fx3)))) ) ) )
     
    704708(define (fxadd1 fx)
    705709  (%check-fixnum 'fxadd1 fx)
    706   (when (invalid-sum fx 1) (error-fixnum-representation 'fxadd1 fx))
     710  (when (invalid-sum? fx 1) (error-fixnum-representation 'fxadd1 fx))
    707711  (%fxadd1 fx) )
    708712
    709713(define (fxsub1 fx)
    710714  (%check-fixnum 'fxsub1 fx)
    711   (when (invalid-difference fx 1) (error-fixnum-representation 'fxsub1 fx))
     715  (when (invalid-difference? fx 1) (error-fixnum-representation 'fxsub1 fx))
    712716  (%fxsub1 fx) )
    713717
    714 (define (fx/ fxn fxd)
    715   (%fx/-check 'fx/ fxn fxd) )
    716 
    717 (define (fxquotient fxn fxd)
    718   (%fx/-check 'fxquotient fxn fxd) )
    719 
    720 (define (fxremainder fxn fxd)
    721   (%fx- fxn (%fx* (%fx/-check 'fxremainder fxn fxd) fxd)) )
     718(define (fx/ fxn fxd) (%fx/check 'fx/ fxn fxd))
     719
     720(define (fxquotient fxn fxd) (%fx/check 'fxquotient fxn fxd))
     721
     722(define (fxremainder fxn fxd) (%fx- fxn (%fx* (%fx/check 'fxremainder fxn fxd) fxd)))
    722723
    723724;;
Note: See TracChangeset for help on using the changeset viewer.