Changeset 8565 in project


Ignore:
Timestamp:
02/19/08 08:57:45 (12 years ago)
Author:
felix winkelmann
Message:

fix for bitwise bug reported by Jeremy Sydik

Location:
release/3/numbers
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/numbers/numbers-compiler-macros.scm

    r5002 r8565  
    1717   args) )
    1818
     19(define-for-syntax numbers:bitwise-with-overflow
     20  (string>=? (chicken-version) "3.0.2"))
     21
    1922(define-compiler-macro (+ . args)
    2023  (numbers:fold-operator args '(##core#inline "C_i_o_fixnum_plus") 'numbers:+ 0) )
    2124
    2225(define-compiler-macro (bitwise-and . args)
    23   (numbers:fold-operator
    24    args '(##core#inline "C_fixnum_and") 'numbers:bitwise-and
    25    -1) )
     26  (if numbers:bitwise-with-overflow
     27      (numbers:fold-operator
     28       args
     29       '(##core#inline "C_i_o_fixnum_and")
     30       'numbers:bitwise-and
     31       -1)
     32      `(numbers:bitwise-and ,@args)))
    2633
    2734(define-compiler-macro (bitwise-ior . args)
    28   (numbers:fold-operator
    29    args '(##core#inline "C_fixnum_or") 'numbers:bitwise-ior
    30    0) )
     35  (if numbers:bitwise-with-overflow
     36      (numbers:fold-operator
     37       args
     38       '(##core#inline "C_i_o_fixnum_ior")
     39       'numbers:bitwise-ior
     40       0)
     41      `(numbers:bitwise-ior ,@args)))
    3142
    3243(define-compiler-macro (bitwise-xor . args)
    33   (numbers:fold-operator
    34    args '(##core#inline "C_fixnum_xor") 'numbers:bitwise-xor
    35    0) )
     44  (if numbers:bitwise-with-overflow
     45      (numbers:fold-operator
     46       args
     47       '(##core#inline "C_i_o_fixnum_xor")
     48       'numbers:bitwise-xor
     49       0)
     50      `(numbers:bitwise-xor ,@args)))
    3651
    3752(define-compiler-macro (bitwise-not n)
  • release/3/numbers/numbers.setup

    r6574 r8565  
    2020  `((syntax)
    2121    (documentation "numbers.html")
    22     (version "1.802")
     22    (version "1.803")
    2323    (static "numbers-static.o")
    2424    (static-options "-lgmp")
  • release/3/numbers/tests/numbers-test.scm

    r4463 r8565  
    395395 (test/equal "shift right" (arithmetic-shift #xf 2) 60)
    396396
     397 ;; by Jeremy Sydik
     398 (test-define "leftrot32" leftrot32
     399              (lambda (value amount)
     400                (let ((shifted (arithmetic-shift value amount)))
     401                  (let ((anded (bitwise-and (string->number "#xFFFFFFFF") shifted)))
     402                    (bitwise-ior anded
     403                                 (arithmetic-shift shifted -32)))) ) )
     404 (test/equal "leftrot32" (leftrot32 1 28) 268435456)
     405 (test/equal "leftrot32" (leftrot32 1 29) 536870912)
     406 (test/equal "leftrot32" (leftrot32 1 30) (string->number "1073741824"))
     407
    397408)
    398409
Note: See TracChangeset for help on using the changeset viewer.