Changeset 392
- Timestamp:
- Jan 25, 2004, 2:06:12 PM (21 years ago)
- Location:
- trunk/ccl
- Files:
-
- 4 edited
-
level-0/l0-float.lisp (modified) (14 diffs)
-
level-0/l0-numbers.lisp (modified) (6 diffs)
-
level-1/l1-numbers.lisp (modified) (17 diffs)
-
lib/numbers.lisp (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/level-0/l0-float.lisp
r307 r392 344 344 ; maybe do usual first, catching error 345 345 (if (not (or (bignump num)(bignump den))) 346 ( with-stack-short-floats ((fnum num)347 (fden den))346 (ppc32::with-stack-short-floats ((fnum num) 347 (fden den)) 348 348 (%short-float/-2! fnum fden result)) 349 349 (let* ((numlen (integer-length num)) … … 355 355 #|(not (minusp exp))|# 356 356 (<= (abs exp) IEEE-single-float-mantissa-width)) 357 ( with-stack-short-floats ((fnum num)358 357 (ppc32::with-stack-short-floats ((fnum num) 358 (fden den)) 359 359 (%short-float/-2! fnum fden result)) 360 360 (if (> exp IEEE-single-float-mantissa-width) … … 386 386 387 387 388 388 #+ppc32-target 389 389 (defun %short-float (number &optional result) 390 390 (number-case number … … 399 399 (ratio 400 400 (%short-float-ratio number result)))) 401 402 #+ppc64-target 403 (defun %short-float (number) 404 (number-case number 405 (short-float number) 406 (double-float (%double-float->short-float number)) 407 (fixnum (%fixnum-sfloat number)) 408 (bignum (%bignum-sfloat number)) 409 (ratio (%short-float-ratio number)))) 401 410 402 411 … … 508 517 (if (typep x 'double-float) 509 518 (%double-float-sin! x (%make-dfloat)) 510 ( with-stack-short-floats ((sx x))519 (ppc32::with-stack-short-floats ((sx x)) 511 520 (%single-float-sin! sx (%make-sfloat)))))) 512 521 … … 519 528 (if (typep x 'double-float) 520 529 (%double-float-cos! x (%make-dfloat)) 521 ( with-stack-short-floats ((sx x))530 (ppc32::with-stack-short-floats ((sx x)) 522 531 (%single-float-cos! sx (%make-sfloat)))))) 523 532 … … 527 536 (if (typep x 'double-float) 528 537 (%double-float-tan! x (%make-dfloat)) 529 ( with-stack-short-floats ((sx x))538 (ppc32::with-stack-short-floats ((sx x)) 530 539 (%single-float-tan! sx (%make-sfloat)))))) 531 540 … … 540 549 (dx x)) 541 550 (%df-atan2 dy dx)) 542 ( with-stack-short-floats ((sy y)551 (ppc32::with-stack-short-floats ((sy y) 543 552 (sx x)) 544 553 (%sf-atan2 sy sx))) … … 549 558 (if (typep y 'double-float) 550 559 (%double-float-atan! y (%make-dfloat)) 551 ( with-stack-short-floats ((sy y))560 (ppc32::with-stack-short-floats ((sy y)) 552 561 (%single-float-atan! sy (%make-sfloat))))))) 553 562 … … 585 594 (%double-float-log! dx (%make-dfloat))))) 586 595 (t 587 ( with-stack-short-floats ((sx x))596 (ppc32::with-stack-short-floats ((sx x)) 588 597 (if (minusp x) 589 598 (complex (%single-float-log! (%%short-float-abs sx sx) (%make-sfloat)) … … 597 606 (complex (* (exp (realpart x)) (cis (imagpart x)))) 598 607 (double-float (%double-float-exp! x (%make-dfloat))) 599 (t ( with-stack-short-floats ((sx x))608 (t (ppc32::with-stack-short-floats ((sx x)) 600 609 (%single-float-exp! sx (%make-sfloat)))))) 601 610 … … 614 623 (e1 e)) 615 624 (%double-float-expt! b1 e1 (%make-dfloat))) 616 ( with-stack-short-floats ((b1 b)625 (ppc32::with-stack-short-floats ((b1 b) 617 626 (e1 e)) 618 627 (%single-float-expt! b1 e1 (%make-sfloat))))) … … 635 644 (* (setq b (isqrt d)) b))))) 636 645 (/ a b)) 637 (t ( with-stack-short-floats ((f1))646 (t (ppc32::with-stack-short-floats ((f1)) 638 647 (fsqrt (%short-float x f1)))))) 639 648 … … 677 686 (%double-float-acos! x (%make-sfloat)) 678 687 (- double-float-half-pi (asin x)))) 679 ( with-stack-short-floats ((sx x))688 (ppc32::with-stack-short-floats ((sx x)) 680 689 (locally 681 690 (declare (type short-float sx)) -
trunk/ccl/level-0/l0-numbers.lisp
r308 r392 424 424 (if (and (eq int 0)(= sfloat 0.0s0)) 425 425 0 426 ( with-stack-short-floats ((tem int))426 (ppc32::with-stack-short-floats ((tem int)) 427 427 (if (= tem sfloat) 428 428 0 … … 988 988 (%double-float--2 fnum (%double-float*-2! (%double-float res f2) ,divisor f2)))))) 989 989 (truncate-rat-sfloat (number divisor) 990 `( with-stack-short-floats ((fnum ,number)990 `(ppc32::with-stack-short-floats ((fnum ,number) 991 991 (f2)) 992 992 (let ((res (%unary-truncate (%short-float/-2! fnum ,divisor f2)))) … … 1028 1028 (number-case divisor 1029 1029 (short-float 1030 ( with-stack-short-floats ((f2))1030 (ppc32::with-stack-short-floats ((f2)) 1031 1031 (let ((res (%unary-truncate (%short-float/-2! number divisor f2)))) 1032 1032 (values res … … 1035 1035 (%short-float*-2! (%short-float res f2) divisor f2)))))) 1036 1036 ((fixnum bignum ratio) 1037 ( with-stack-short-floats ((fdiv divisor)1037 (ppc32::with-stack-short-floats ((fdiv divisor) 1038 1038 (f2)) 1039 1039 (let ((res (%unary-truncate (%short-float/-2! number fdiv f2)))) … … 1085 1085 (%unary-truncate (%double-float/-2! fnum ,divisor f2)))) 1086 1086 (truncate-rat-sfloat (number divisor) 1087 `( with-stack-short-floats ((fnum ,number)1087 `(ppc32::with-stack-short-floats ((fnum ,number) 1088 1088 (f2)) 1089 1089 (%unary-truncate (%short-float/-2! fnum ,divisor f2))))) … … 1139 1139 (number-case divisor 1140 1140 ((fixnum bignum ratio) 1141 ( with-stack-short-floats ((fdiv divisor)1141 (ppc32::with-stack-short-floats ((fdiv divisor) 1142 1142 (f2)) 1143 1143 (let ((res (%unary-truncate (%short-float/-2! number fdiv f2)))) 1144 1144 RES))) 1145 1145 (short-float 1146 ( with-stack-short-floats ((ddiv divisor)1146 (ppc32::with-stack-short-floats ((ddiv divisor) 1147 1147 (f2)) 1148 1148 (%unary-truncate (%short-float/-2! number ddiv f2)))) -
trunk/ccl/level-1/l1-numbers.lisp
r315 r392 431 431 (defun %single-float-expt! (b e result) 432 432 (declare (single-float b e result)) 433 ( with-stack-short-floats ((temp))433 (ppc32::with-stack-short-floats ((temp)) 434 434 (%setf-short-float temp (#_powf b e)) 435 435 (%sf-check-exception-2 'expt b e (%ffi-exception-status)) … … 456 456 (defun %single-float-sin! (n result) 457 457 (declare (single-float n result)) 458 ( with-stack-short-floats ((temp))458 (ppc32::with-stack-short-floats ((temp)) 459 459 (%setf-short-float TEMP (#_sinf n)) 460 460 (%sf-check-exception-1 'sin n (%ffi-exception-status)) … … 479 479 (defun %single-float-cos! (n result) 480 480 (declare (single-float n result)) 481 ( with-stack-short-floats ((temp))481 (ppc32::with-stack-short-floats ((temp)) 482 482 (%setf-short-float TEMP (#_cosf n)) 483 483 (%sf-check-exception-1 'cos n (%ffi-exception-status)) … … 502 502 (defun %single-float-acos! (n result) 503 503 (declare (single-float n result)) 504 ( with-stack-short-floats ((temp))504 (ppc32::with-stack-short-floats ((temp)) 505 505 (%setf-short-float TEMP (#_acosf n)) 506 506 (%sf-check-exception-1 'acos n (%ffi-exception-status)) … … 525 525 (defun %single-float-asin! (n result) 526 526 (declare (single-float n result)) 527 ( with-stack-short-floats ((temp))527 (ppc32::with-stack-short-floats ((temp)) 528 528 (%setf-short-float TEMP (#_asinf n)) 529 529 (%sf-check-exception-1 'asin n (%ffi-exception-status)) … … 548 548 (defun %single-float-cosh! (n result) 549 549 (declare (single-float n result)) 550 ( with-stack-short-floats ((temp))550 (ppc32::with-stack-short-floats ((temp)) 551 551 (%setf-short-float TEMP (#_coshf n)) 552 552 (%sf-check-exception-1 'cosh n (%ffi-exception-status)) … … 571 571 (defun %single-float-log! (n result) 572 572 (declare (single-float n result)) 573 ( with-stack-short-floats ((temp))573 (ppc32::with-stack-short-floats ((temp)) 574 574 (%setf-short-float TEMP (#_logf n)) 575 575 (%sf-check-exception-1 'log n (%ffi-exception-status)) … … 594 594 (defun %single-float-tan! (n result) 595 595 (declare (single-float n result)) 596 ( with-stack-short-floats ((temp))596 (ppc32::with-stack-short-floats ((temp)) 597 597 (%setf-short-float TEMP (#_tanf n)) 598 598 (%sf-check-exception-1 'tan n (%ffi-exception-status)) … … 618 618 (defun %single-float-atan! (n result) 619 619 (declare (single-float n result)) 620 ( with-stack-short-floats ((temp))620 (ppc32::with-stack-short-floats ((temp)) 621 621 (%setf-short-float TEMP (#_atanf n)) 622 622 (%sf-check-exception-1 'atan n (%ffi-exception-status)) … … 642 642 (defun %single-float-atan2! (x y result) 643 643 (declare (single-float x y result)) 644 ( with-stack-short-floats ((temp))644 (ppc32::with-stack-short-floats ((temp)) 645 645 (%setf-short-float TEMP (#_atan2f x y)) 646 646 (%sf-check-exception-2 'atan2 x y (%ffi-exception-status)) … … 666 666 (defun %single-float-exp! (n result) 667 667 (declare (single-float n result)) 668 ( with-stack-short-floats ((temp))668 (ppc32::with-stack-short-floats ((temp)) 669 669 (%setf-short-float TEMP (#_expf n)) 670 670 (%sf-check-exception-1 'exp n (%ffi-exception-status)) … … 689 689 (defun %single-float-sinh! (n result) 690 690 (declare (single-float n result)) 691 ( with-stack-short-floats ((temp))691 (ppc32::with-stack-short-floats ((temp)) 692 692 (%setf-short-float TEMP (#_sinhf n)) 693 693 (%sf-check-exception-1 'sinh n (%ffi-exception-status)) … … 715 715 (defun %single-float-tanh! (n result) 716 716 (declare (single-float n result)) 717 ( with-stack-short-floats ((temp))717 (ppc32::with-stack-short-floats ((temp)) 718 718 (%setf-short-float TEMP (#_tanhf n)) 719 719 (%sf-check-exception-1 'tanh n (%ffi-exception-status)) … … 739 739 (defun %single-float-asinh! (n result) 740 740 (declare (single-float n result)) 741 ( with-stack-short-floats ((temp))741 (ppc32::with-stack-short-floats ((temp)) 742 742 (%setf-short-float TEMP (#_asinhf n)) 743 743 (%sf-check-exception-1 'asinh n (%ffi-exception-status)) … … 763 763 (defun %single-float-acosh! (n result) 764 764 (declare (single-float n result)) 765 ( with-stack-short-floats ((temp))765 (ppc32::with-stack-short-floats ((temp)) 766 766 (%setf-short-float TEMP (#_acoshf n)) 767 767 (%sf-check-exception-1 'acosh n (%ffi-exception-status)) … … 786 786 (defun %single-float-atanh! (n result) 787 787 (declare (single-float n result)) 788 ( with-stack-short-floats ((temp))788 (ppc32::with-stack-short-floats ((temp)) 789 789 (%setf-short-float TEMP (#_atanhf n)) 790 790 (%sf-check-exception-1 'atanh n (%ffi-exception-status)) … … 809 809 (defun %single-float-sqrt! (n result) 810 810 (declare (single-float n result)) 811 ( with-stack-short-floats ((temp))811 (ppc32::with-stack-short-floats ((temp)) 812 812 (%setf-short-float TEMP (#_sqrtf n)) 813 813 (%sf-check-exception-1 'sqrt n (%ffi-exception-status)) -
trunk/ccl/lib/numbers.lisp
r325 r392 591 591 (if (typep x 'double-float) 592 592 (%double-float-sinh! x (%make-dfloat)) 593 ( with-stack-short-floats ((sx x))593 (ppc32::with-stack-short-floats ((sx x)) 594 594 (%single-float-sinh! sx (%make-sfloat)))))) 595 595 … … 600 600 (if (typep x 'double-float) 601 601 (%double-float-cosh! x (%make-dfloat)) 602 ( with-stack-short-floats ((sx x))602 (ppc32::with-stack-short-floats ((sx x)) 603 603 (%single-float-cosh! sx (%make-sfloat)))))) 604 604 … … 608 608 (if (typep x 'double-float) 609 609 (%double-float-tanh! x (%make-dfloat)) 610 ( with-stack-short-floats ((sx x))610 (ppc32::with-stack-short-floats ((sx x)) 611 611 (%single-float-tanh! sx (%make-sfloat)))))) 612 612 … … 616 616 (if (typep x 'double-float) 617 617 (%double-float-asinh! x (%make-dfloat)) 618 ( with-stack-short-floats ((sx x))618 (ppc32::with-stack-short-floats ((sx x)) 619 619 (%single-float-asinh! sx (%make-sfloat)))))) 620 620 … … 623 623 (if (typep x 'double-float) 624 624 (%double-float-acosh! x (%make-dfloat)) 625 ( with-stack-short-floats ((sx x))625 (ppc32::with-stack-short-floats ((sx x)) 626 626 (%single-float-acosh! sx (%make-sfloat)))) 627 627 (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2)))))))
Note:
See TracChangeset
for help on using the changeset viewer.
