Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 1104:8b464283e891

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-11-12 18:58:13 by james] Unconditionally compile the LISP_FLOAT_TYPE code. Remove all !LISP_FLOAT_TYPE code and the LISP_FLOAT_TYPE identifier itself.
author james
date Tue, 12 Nov 2002 18:58:41 +0000
parents c925bacdda60
children e22b0213b713
comparison
equal deleted inserted replaced
1103:80d9ab2e9855 1104:8b464283e891
46 */ 46 */
47 47
48 #include <config.h> 48 #include <config.h>
49 #include "lisp.h" 49 #include "lisp.h"
50 #include "syssignal.h" 50 #include "syssignal.h"
51
52 #ifdef LISP_FLOAT_TYPE
53
54 #include "sysfloat.h" 51 #include "sysfloat.h"
55 52
56 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT 53 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT
57 if `rint' exists but does not work right. */ 54 if `rint' exists but does not work right. */
58 #ifdef HAVE_RINT 55 #ifdef HAVE_RINT
209 if (INTP (num)) 206 if (INTP (num))
210 return (double) XINT (num); 207 return (double) XINT (num);
211 208
212 return extract_float (wrong_type_argument (Qnumberp, num)); 209 return extract_float (wrong_type_argument (Qnumberp, num));
213 } 210 }
214 #endif /* LISP_FLOAT_TYPE */
215
216 211
217 /* Trig functions. */ 212 /* Trig functions. */
218 #ifdef LISP_FLOAT_TYPE
219 213
220 DEFUN ("acos", Facos, 1, 1, 0, /* 214 DEFUN ("acos", Facos, 1, 1, 0, /*
221 Return the inverse cosine of NUMBER. 215 Return the inverse cosine of NUMBER.
222 */ 216 */
223 (number)) 217 (number))
300 domain_error ("tan", number); 294 domain_error ("tan", number);
301 #endif 295 #endif
302 IN_FLOAT (d = (sin (d) / c), "tan", number); 296 IN_FLOAT (d = (sin (d) / c), "tan", number);
303 return make_float (d); 297 return make_float (d);
304 } 298 }
305 #endif /* LISP_FLOAT_TYPE (trig functions) */
306
307 299
308 /* Bessel functions */ 300 /* Bessel functions */
309 #if 0 /* Leave these out unless we find there's a reason for them. */ 301 #if 0 /* Leave these out unless we find there's a reason for them. */
310 /* #ifdef LISP_FLOAT_TYPE */
311 302
312 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /* 303 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /*
313 Return the bessel function j0 of NUMBER. 304 Return the bessel function j0 of NUMBER.
314 */ 305 */
315 (number)) 306 (number))
377 368
378 #endif /* 0 (bessel functions) */ 369 #endif /* 0 (bessel functions) */
379 370
380 /* Error functions. */ 371 /* Error functions. */
381 #if 0 /* Leave these out unless we see they are worth having. */ 372 #if 0 /* Leave these out unless we see they are worth having. */
382 /* #ifdef LISP_FLOAT_TYPE */
383 373
384 DEFUN ("erf", Ferf, 1, 1, 0, /* 374 DEFUN ("erf", Ferf, 1, 1, 0, /*
385 Return the mathematical error function of NUMBER. 375 Return the mathematical error function of NUMBER.
386 */ 376 */
387 (number)) 377 (number))
414 #endif /* 0 (error functions) */ 404 #endif /* 0 (error functions) */
415 405
416 406
417 /* Root and Log functions. */ 407 /* Root and Log functions. */
418 408
419 #ifdef LISP_FLOAT_TYPE
420 DEFUN ("exp", Fexp, 1, 1, 0, /* 409 DEFUN ("exp", Fexp, 1, 1, 0, /*
421 Return the exponential base e of NUMBER. 410 Return the exponential base e of NUMBER.
422 */ 411 */
423 (number)) 412 (number))
424 { 413 {
431 else 420 else
432 #endif 421 #endif
433 IN_FLOAT (d = exp (d), "exp", number); 422 IN_FLOAT (d = exp (d), "exp", number);
434 return make_float (d); 423 return make_float (d);
435 } 424 }
436 #endif /* LISP_FLOAT_TYPE */
437
438 425
439 DEFUN ("expt", Fexpt, 2, 2, 0, /* 426 DEFUN ("expt", Fexpt, 2, 2, 0, /*
440 Return the exponential NUMBER1 ** NUMBER2. 427 Return the exponential NUMBER1 ** NUMBER2.
441 */ 428 */
442 (number1, number2)) 429 (number1, number2))
469 } 456 }
470 } 457 }
471 return make_int (retval); 458 return make_int (retval);
472 } 459 }
473 460
474 #ifdef LISP_FLOAT_TYPE
475 { 461 {
476 double f1 = extract_float (number1); 462 double f1 = extract_float (number1);
477 double f2 = extract_float (number2); 463 double f2 = extract_float (number2);
478 /* Really should check for overflow, too */ 464 /* Really should check for overflow, too */
479 if (f1 == 0.0 && f2 == 0.0) 465 if (f1 == 0.0 && f2 == 0.0)
483 domain_error2 ("expt", number1, number2); 469 domain_error2 ("expt", number1, number2);
484 # endif /* FLOAT_CHECK_DOMAIN */ 470 # endif /* FLOAT_CHECK_DOMAIN */
485 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2); 471 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2);
486 return make_float (f1); 472 return make_float (f1);
487 } 473 }
488 #else 474 }
489 CHECK_INT_OR_FLOAT (number1); 475
490 CHECK_INT_OR_FLOAT (number2);
491 return Fexpt (number1, number2);
492 #endif /* LISP_FLOAT_TYPE */
493 }
494
495 #ifdef LISP_FLOAT_TYPE
496 DEFUN ("log", Flog, 1, 2, 0, /* 476 DEFUN ("log", Flog, 1, 2, 0, /*
497 Return the natural logarithm of NUMBER. 477 Return the natural logarithm of NUMBER.
498 If second optional argument BASE is given, return the logarithm of 478 If second optional argument BASE is given, return the logarithm of
499 NUMBER using that base. 479 NUMBER using that base.
500 */ 480 */
567 else 547 else
568 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number); 548 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number);
569 #endif 549 #endif
570 return make_float (d); 550 return make_float (d);
571 } 551 }
572 #endif /* LISP_FLOAT_TYPE */
573
574 552
575 /* Inverse trig functions. */ 553 /* Inverse trig functions. */
576 #ifdef LISP_FLOAT_TYPE
577 /* #if 0 Not clearly worth adding... */
578 554
579 DEFUN ("acosh", Facosh, 1, 1, 0, /* 555 DEFUN ("acosh", Facosh, 1, 1, 0, /*
580 Return the inverse hyperbolic cosine of NUMBER. 556 Return the inverse hyperbolic cosine of NUMBER.
581 */ 557 */
582 (number)) 558 (number))
661 { 637 {
662 double d = extract_float (number); 638 double d = extract_float (number);
663 IN_FLOAT (d = tanh (d), "tanh", number); 639 IN_FLOAT (d = tanh (d), "tanh", number);
664 return make_float (d); 640 return make_float (d);
665 } 641 }
666 #endif /* LISP_FLOAT_TYPE (inverse trig functions) */
667 642
668 /* Rounding functions */ 643 /* Rounding functions */
669 644
670 DEFUN ("abs", Fabs, 1, 1, 0, /* 645 DEFUN ("abs", Fabs, 1, 1, 0, /*
671 Return the absolute value of NUMBER. 646 Return the absolute value of NUMBER.
672 */ 647 */
673 (number)) 648 (number))
674 { 649 {
675 #ifdef LISP_FLOAT_TYPE
676 if (FLOATP (number)) 650 if (FLOATP (number))
677 { 651 {
678 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))), 652 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))),
679 "abs", number); 653 "abs", number);
680 return number; 654 return number;
681 } 655 }
682 #endif /* LISP_FLOAT_TYPE */
683 656
684 if (INTP (number)) 657 if (INTP (number))
685 return (XINT (number) >= 0) ? number : make_int (- XINT (number)); 658 return (XINT (number) >= 0) ? number : make_int (- XINT (number));
686 659
687 return Fabs (wrong_type_argument (Qnumberp, number)); 660 return Fabs (wrong_type_argument (Qnumberp, number));
688 } 661 }
689 662
690 #ifdef LISP_FLOAT_TYPE
691 DEFUN ("float", Ffloat, 1, 1, 0, /* 663 DEFUN ("float", Ffloat, 1, 1, 0, /*
692 Return the floating point number numerically equal to NUMBER. 664 Return the floating point number numerically equal to NUMBER.
693 */ 665 */
694 (number)) 666 (number))
695 { 667 {
699 if (FLOATP (number)) /* give 'em the same float back */ 671 if (FLOATP (number)) /* give 'em the same float back */
700 return number; 672 return number;
701 673
702 return Ffloat (wrong_type_argument (Qnumberp, number)); 674 return Ffloat (wrong_type_argument (Qnumberp, number));
703 } 675 }
704 #endif /* LISP_FLOAT_TYPE */ 676
705
706
707 #ifdef LISP_FLOAT_TYPE
708 DEFUN ("logb", Flogb, 1, 1, 0, /* 677 DEFUN ("logb", Flogb, 1, 1, 0, /*
709 Return largest integer <= the base 2 log of the magnitude of NUMBER. 678 Return largest integer <= the base 2 log of the magnitude of NUMBER.
710 This is the same as the exponent of a float. 679 This is the same as the exponent of a float.
711 */ 680 */
712 (number)) 681 (number))
753 return make_int (val); 722 return make_int (val);
754 } 723 }
755 #endif /* ! HAVE_FREXP */ 724 #endif /* ! HAVE_FREXP */
756 #endif /* ! HAVE_LOGB */ 725 #endif /* ! HAVE_LOGB */
757 } 726 }
758 #endif /* LISP_FLOAT_TYPE */
759
760 727
761 DEFUN ("ceiling", Fceiling, 1, 1, 0, /* 728 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
762 Return the smallest integer no less than NUMBER. (Round toward +inf.) 729 Return the smallest integer no less than NUMBER. (Round toward +inf.)
763 */ 730 */
764 (number)) 731 (number))
765 { 732 {
766 #ifdef LISP_FLOAT_TYPE
767 if (FLOATP (number)) 733 if (FLOATP (number))
768 { 734 {
769 double d; 735 double d;
770 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number); 736 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number);
771 return (float_to_int (d, "ceiling", number, Qunbound)); 737 return (float_to_int (d, "ceiling", number, Qunbound));
772 } 738 }
773 #endif /* LISP_FLOAT_TYPE */
774 739
775 if (INTP (number)) 740 if (INTP (number))
776 return number; 741 return number;
777 742
778 return Fceiling (wrong_type_argument (Qnumberp, number)); 743 return Fceiling (wrong_type_argument (Qnumberp, number));
792 { 757 {
793 EMACS_INT i1, i2; 758 EMACS_INT i1, i2;
794 759
795 CHECK_INT_OR_FLOAT (divisor); 760 CHECK_INT_OR_FLOAT (divisor);
796 761
797 #ifdef LISP_FLOAT_TYPE
798 if (FLOATP (number) || FLOATP (divisor)) 762 if (FLOATP (number) || FLOATP (divisor))
799 { 763 {
800 double f1 = extract_float (number); 764 double f1 = extract_float (number);
801 double f2 = extract_float (divisor); 765 double f2 = extract_float (divisor);
802 766
804 Fsignal (Qarith_error, Qnil); 768 Fsignal (Qarith_error, Qnil);
805 769
806 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor); 770 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
807 return float_to_int (f1, "floor", number, divisor); 771 return float_to_int (f1, "floor", number, divisor);
808 } 772 }
809 #endif /* LISP_FLOAT_TYPE */
810 773
811 i1 = XINT (number); 774 i1 = XINT (number);
812 i2 = XINT (divisor); 775 i2 = XINT (divisor);
813 776
814 if (i2 == 0) 777 if (i2 == 0)
821 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); 784 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
822 785
823 return (make_int (i1)); 786 return (make_int (i1));
824 } 787 }
825 788
826 #ifdef LISP_FLOAT_TYPE
827 if (FLOATP (number)) 789 if (FLOATP (number))
828 { 790 {
829 double d; 791 double d;
830 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number); 792 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
831 return (float_to_int (d, "floor", number, Qunbound)); 793 return (float_to_int (d, "floor", number, Qunbound));
832 } 794 }
833 #endif /* LISP_FLOAT_TYPE */
834 795
835 return number; 796 return number;
836 } 797 }
837 798
838 DEFUN ("round", Fround, 1, 1, 0, /* 799 DEFUN ("round", Fround, 1, 1, 0, /*
839 Return the nearest integer to NUMBER. 800 Return the nearest integer to NUMBER.
840 */ 801 */
841 (number)) 802 (number))
842 { 803 {
843 #ifdef LISP_FLOAT_TYPE
844 if (FLOATP (number)) 804 if (FLOATP (number))
845 { 805 {
846 double d; 806 double d;
847 /* Screw the prevailing rounding mode. */ 807 /* Screw the prevailing rounding mode. */
848 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number); 808 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number);
849 return (float_to_int (d, "round", number, Qunbound)); 809 return (float_to_int (d, "round", number, Qunbound));
850 } 810 }
851 #endif /* LISP_FLOAT_TYPE */
852 811
853 if (INTP (number)) 812 if (INTP (number))
854 return number; 813 return number;
855 814
856 return Fround (wrong_type_argument (Qnumberp, number)); 815 return Fround (wrong_type_argument (Qnumberp, number));
860 Truncate a floating point number to an integer. 819 Truncate a floating point number to an integer.
861 Rounds the value toward zero. 820 Rounds the value toward zero.
862 */ 821 */
863 (number)) 822 (number))
864 { 823 {
865 #ifdef LISP_FLOAT_TYPE
866 if (FLOATP (number)) 824 if (FLOATP (number))
867 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound); 825 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound);
868 #endif /* LISP_FLOAT_TYPE */
869 826
870 if (INTP (number)) 827 if (INTP (number))
871 return number; 828 return number;
872 829
873 return Ftruncate (wrong_type_argument (Qnumberp, number)); 830 return Ftruncate (wrong_type_argument (Qnumberp, number));
874 } 831 }
875 832
876 /* Float-rounding functions. */ 833 /* Float-rounding functions. */
877 #ifdef LISP_FLOAT_TYPE
878 /* #if 1 It's not clear these are worth adding... */
879 834
880 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /* 835 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
881 Return the smallest integer no less than NUMBER, as a float. 836 Return the smallest integer no less than NUMBER, as a float.
882 \(Round toward +inf.\) 837 \(Round toward +inf.\)
883 */ 838 */
920 IN_FLOAT (d = floor (d), "ftruncate", number); 875 IN_FLOAT (d = floor (d), "ftruncate", number);
921 else 876 else
922 IN_FLOAT (d = ceil (d), "ftruncate", number); 877 IN_FLOAT (d = ceil (d), "ftruncate", number);
923 return make_float (d); 878 return make_float (d);
924 } 879 }
925
926 #endif /* LISP_FLOAT_TYPE (float-rounding functions) */
927
928 880
929 #ifdef LISP_FLOAT_TYPE
930 #ifdef FLOAT_CATCH_SIGILL 881 #ifdef FLOAT_CATCH_SIGILL
931 static SIGTYPE 882 static SIGTYPE
932 float_error (int signo) 883 float_error (int signo)
933 { 884 {
934 if (! in_float) 885 if (! in_float)
979 default: Fsignal (Qarith_error, args); break; 930 default: Fsignal (Qarith_error, args); break;
980 } 931 }
981 return 1; /* don't set errno or print a message */ 932 return 1; /* don't set errno or print a message */
982 } 933 }
983 #endif /* HAVE_MATHERR */ 934 #endif /* HAVE_MATHERR */
984 #endif /* LISP_FLOAT_TYPE */
985
986 935
987 void 936 void
988 init_floatfns_very_early (void) 937 init_floatfns_very_early (void)
989 { 938 {
990 #ifdef LISP_FLOAT_TYPE
991 # ifdef FLOAT_CATCH_SIGILL 939 # ifdef FLOAT_CATCH_SIGILL
992 EMACS_SIGNAL (SIGILL, float_error); 940 EMACS_SIGNAL (SIGILL, float_error);
993 # endif 941 # endif
994 in_float = 0; 942 in_float = 0;
995 #endif /* LISP_FLOAT_TYPE */
996 } 943 }
997 944
998 void 945 void
999 syms_of_floatfns (void) 946 syms_of_floatfns (void)
1000 { 947 {
1001 INIT_LRECORD_IMPLEMENTATION (float); 948 INIT_LRECORD_IMPLEMENTATION (float);
1002 949
1003 /* Trig functions. */ 950 /* Trig functions. */
1004 951
1005 #ifdef LISP_FLOAT_TYPE
1006 DEFSUBR (Facos); 952 DEFSUBR (Facos);
1007 DEFSUBR (Fasin); 953 DEFSUBR (Fasin);
1008 DEFSUBR (Fatan); 954 DEFSUBR (Fatan);
1009 DEFSUBR (Fcos); 955 DEFSUBR (Fcos);
1010 DEFSUBR (Fsin); 956 DEFSUBR (Fsin);
1011 DEFSUBR (Ftan); 957 DEFSUBR (Ftan);
1012 #endif /* LISP_FLOAT_TYPE */
1013 958
1014 /* Bessel functions */ 959 /* Bessel functions */
1015 960
1016 #if 0 961 #if 0
1017 DEFSUBR (Fbessel_y0); 962 DEFSUBR (Fbessel_y0);
1030 DEFSUBR (Flog_gamma); 975 DEFSUBR (Flog_gamma);
1031 #endif /* 0 */ 976 #endif /* 0 */
1032 977
1033 /* Root and Log functions. */ 978 /* Root and Log functions. */
1034 979
1035 #ifdef LISP_FLOAT_TYPE
1036 DEFSUBR (Fexp); 980 DEFSUBR (Fexp);
1037 #endif /* LISP_FLOAT_TYPE */
1038 DEFSUBR (Fexpt); 981 DEFSUBR (Fexpt);
1039 #ifdef LISP_FLOAT_TYPE
1040 DEFSUBR (Flog); 982 DEFSUBR (Flog);
1041 DEFSUBR (Flog10); 983 DEFSUBR (Flog10);
1042 DEFSUBR (Fsqrt); 984 DEFSUBR (Fsqrt);
1043 DEFSUBR (Fcube_root); 985 DEFSUBR (Fcube_root);
1044 #endif /* LISP_FLOAT_TYPE */
1045 986
1046 /* Inverse trig functions. */ 987 /* Inverse trig functions. */
1047 988
1048 #ifdef LISP_FLOAT_TYPE
1049 DEFSUBR (Facosh); 989 DEFSUBR (Facosh);
1050 DEFSUBR (Fasinh); 990 DEFSUBR (Fasinh);
1051 DEFSUBR (Fatanh); 991 DEFSUBR (Fatanh);
1052 DEFSUBR (Fcosh); 992 DEFSUBR (Fcosh);
1053 DEFSUBR (Fsinh); 993 DEFSUBR (Fsinh);
1054 DEFSUBR (Ftanh); 994 DEFSUBR (Ftanh);
1055 #endif /* LISP_FLOAT_TYPE */
1056 995
1057 /* Rounding functions */ 996 /* Rounding functions */
1058 997
1059 DEFSUBR (Fabs); 998 DEFSUBR (Fabs);
1060 #ifdef LISP_FLOAT_TYPE
1061 DEFSUBR (Ffloat); 999 DEFSUBR (Ffloat);
1062 DEFSUBR (Flogb); 1000 DEFSUBR (Flogb);
1063 #endif /* LISP_FLOAT_TYPE */
1064 DEFSUBR (Fceiling); 1001 DEFSUBR (Fceiling);
1065 DEFSUBR (Ffloor); 1002 DEFSUBR (Ffloor);
1066 DEFSUBR (Fround); 1003 DEFSUBR (Fround);
1067 DEFSUBR (Ftruncate); 1004 DEFSUBR (Ftruncate);
1068 1005
1069 /* Float-rounding functions. */ 1006 /* Float-rounding functions. */
1070 1007
1071 #ifdef LISP_FLOAT_TYPE
1072 DEFSUBR (Ffceiling); 1008 DEFSUBR (Ffceiling);
1073 DEFSUBR (Fffloor); 1009 DEFSUBR (Fffloor);
1074 DEFSUBR (Ffround); 1010 DEFSUBR (Ffround);
1075 DEFSUBR (Fftruncate); 1011 DEFSUBR (Fftruncate);
1076 #endif /* LISP_FLOAT_TYPE */
1077 } 1012 }
1078 1013
1079 void 1014 void
1080 vars_of_floatfns (void) 1015 vars_of_floatfns (void)
1081 { 1016 {
1082 #ifdef LISP_FLOAT_TYPE
1083 Fprovide (intern ("lisp-float-type")); 1017 Fprovide (intern ("lisp-float-type"));
1084 #endif 1018 }
1085 }