diff --git a/scheme/ikarus.not-yet-implemented.ss b/scheme/ikarus.not-yet-implemented.ss index fbc9872..9036c75 100644 --- a/scheme/ikarus.not-yet-implemented.ss +++ b/scheme/ikarus.not-yet-implemented.ss @@ -3,7 +3,6 @@ (export bitwise-copy-bit-field bitwise-reverse-bit-field bitwise-rotate-bit-field bitwise-if fxreverse-bit-field - fxrotate-bit-field make-custom-binary-input/output-port make-custom-textual-input/output-port open-file-input/output-port output-port-buffer-mode @@ -18,7 +17,6 @@ (import (except (ikarus) bitwise-copy-bit-field bitwise-reverse-bit-field bitwise-rotate-bit-field bitwise-if fxreverse-bit-field - fxrotate-bit-field make-custom-binary-input/output-port make-custom-textual-input/output-port open-file-input/output-port output-port-buffer-mode @@ -57,7 +55,7 @@ string-downcase string-titlecase string-upcase bitwise-if bitwise-rotate-bit-field bitwise-copy-bit-field bitwise-reverse-bit-field - fxreverse-bit-field fxrotate-bit-field + fxreverse-bit-field ;;; not top priority at the moment make-eqv-hashtable make-hashtable equal-hash hashtable-hash-function hashtable-equivalence-function diff --git a/scheme/ikarus.numerics.ss b/scheme/ikarus.numerics.ss index 76e7424..4ee6aea 100644 --- a/scheme/ikarus.numerics.ss +++ b/scheme/ikarus.numerics.ss @@ -2731,21 +2731,24 @@ [($fx= x 1) 0] [($fx= x 0) (die 'log "undefined around 0")] [($fx> x 0) (foreign-call "ikrt_fx_log" x)] - [else (die 'log "negative argument" x)])] + [else (make-rectangular (log (- x)) (acos -1))])] [(flonum? x) (cond - [(>= x 0) (foreign-call "ikrt_fl_log" x)] - [else (die 'log "negative argument" x)])] + [(fl>=? x 0.0) (foreign-call "ikrt_fl_log" x)] + [else + (make-rectangular + (log (fl- 0.0 x)) + (acos -1))])] [(bignum? x) - (unless ($bignum-positive? x) - (die 'log "negative argument" x)) - (let ([v (log (inexact x))]) - (cond - [(infinite? v) - (let-values ([(s r) (exact-integer-sqrt x)]) - ;;; could the [dropped] residual ever affect the answer? - (fl* 2.0 (log s)))] - [else v]))] + (if ($bignum-positive? x) + (let ([v (log (inexact x))]) + (cond + [(infinite? v) + (let-values ([(s r) (exact-integer-sqrt x)]) + ;;; could the [dropped] residual ever affect the answer? + (fl* 2.0 (log s)))] + [else v])) + (make-rectangular (log (- x)) (acos -1)))] [(ratnum? x) ;;; FIXME: incorrect as per bug 180170 (- (log (numerator x)) (log (denominator x)))] @@ -3129,7 +3132,7 @@ (if (flfinite? x) (cond [(flonum? eps) - (if (flfinite? eps) (go x eps) +nan.0)] + (if (flfinite? eps) (go x eps) +0.0)] [(or (fixnum? eps) (bignum? eps) (ratnum? eps)) (go x eps)] [else (die who "not a number" eps)]) @@ -3142,7 +3145,7 @@ [(or (fixnum? x) (bignum? x) (ratnum? x)) (cond [(flonum? eps) - (if (flfinite? eps) (go x eps) +nan.0)] + (if (flfinite? eps) (go x eps) +0.0)] [(or (fixnum? eps) (bignum? eps) (ratnum? eps)) (go x eps)] [else (die who "not a number" eps)])] @@ -3430,7 +3433,7 @@ fxlength fxbit-set? fxcopy-bit - fxcopy-bit-field + fxcopy-bit-field fxrotate-bit-field fxbit-field) (import (ikarus system $fx) @@ -3442,7 +3445,7 @@ fxlength fxbit-set? fxcopy-bit - fxcopy-bit-field + fxcopy-bit-field fxrotate-bit-field fxbit-field)) (module (bitwise-first-bit-set fxfirst-bit-set) @@ -3652,6 +3655,36 @@ (die who "not a fixnum" i)) (die who "not a fixnum" x))) + (define ($fxrotate-bit-field x i j c w) + (let ([m ($fxsll ($fxsub1 ($fxsll 1 w)) i)]) + (let ([x0 ($fxlogand x m)]) + (let ([lt ($fxsll x0 c)] [rt ($fxsra x0 ($fx- w c))]) + (let ([x0 ($fxlogand ($fxlogor lt rt) m)]) + ($fxlogor x0 ($fxlogand x ($fxlognot m)))))))) + + (define (fxrotate-bit-field x i j c) + (define who 'fxrotate-bit-field) + (if (fixnum? x) + (if (fixnum? i) + (if ($fx>= i 0) + (if (fixnum? j) + (if ($fx< j (fixnum-width)) + (let ([w ($fx- j i)]) + (if ($fx>= w 0) + (if (fixnum? c) + (if (and ($fx>= c 0) ($fx< c w)) + ($fxrotate-bit-field x i j c w) + (die who "count is invalid" c)) + (die who "count is not a fixnum" c)) + (die who "field width is negative" i j))) + (die who "end index is out of range" j)) + (die who "end index is not a fixnum" j)) + (die who "start index is out of range" i)) + (die who "start index is not a fixnum" i)) + (die who "not a fixnum" x))) + + + (define (fxbit-field x i j) (define who 'fxbit-field) (if (fixnum? x) diff --git a/scheme/last-revision b/scheme/last-revision index 1fa85e6..9cb032d 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1557 +1558