Mercurial > emacs

comparison src/floatfns.c @ 6375:212dcd2c06e4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros. (ceiling, floor, round, truncate): Use them.
author Karl Heuer <kwzh@gnu.org>
date Wed, 16 Mar 1994 06:14:56 +0000
parents 800c035273e9
children 9e627ca8f0a0
comparison
equal deleted inserted replaced
6374:71e61b314fe9 6375:212dcd2c06e4
178 #else 178 #else
179 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) 179 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
180 #define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0) 180 #define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0)
181 #endif 181 #endif
182 182
183 /* Convert float to Lisp_Int if it fits, else signal a range error
184 using the given arguments. */
185 #define FLOAT_TO_INT(x, i, name, num) \
186 do \
187 { \
188 if ((x) >= (1 << (VALBITS-1)) || (x) <= - (1 << (VALBITS-1)) - 1) \
189 range_error (name, num); \
190 XSET (i, Lisp_Int, (int)(x)); \
191 } \
192 while (0)
193 #define FLOAT_TO_INT2(x, i, name, num1, num2) \
194 do \
195 { \
196 if ((x) >= (1 << (VALBITS-1)) || (x) <= - (1 << (VALBITS-1)) - 1) \
197 range_error2 (name, num1, num2); \
198 XSET (i, Lisp_Int, (int)(x)); \
199 } \
200 while (0)
201
183 #define arith_error(op,arg) \ 202 #define arith_error(op,arg) \
184 Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) 203 Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
185 #define range_error(op,arg) \ 204 #define range_error(op,arg) \
186 Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) 205 Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
206 #define range_error2(op,a1,a2) \
207 Fsignal (Qrange_error, Fcons (build_string ((op)), \
208 Fcons ((a1), Fcons ((a2), Qnil))))
187 #define domain_error(op,arg) \ 209 #define domain_error(op,arg) \
188 Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) 210 Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil)))
189 #define domain_error2(op,a1,a2) \ 211 #define domain_error2(op,a1,a2) \
190 Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((a1), Fcons ((a2), Qnil)))) 212 Fsignal (Qdomain_error, Fcons (build_string ((op)), \
213 Fcons ((a1), Fcons ((a2), Qnil))))
191 214
192 /* Extract a Lisp number as a `double', or signal an error. */ 215 /* Extract a Lisp number as a `double', or signal an error. */
193 216
194 double 217 double
195 extract_float (num) 218 extract_float (num)
701 register Lisp_Object arg; 724 register Lisp_Object arg;
702 { 725 {
703 CHECK_NUMBER_OR_FLOAT (arg, 0); 726 CHECK_NUMBER_OR_FLOAT (arg, 0);
704 727
705 if (XTYPE (arg) == Lisp_Float) 728 if (XTYPE (arg) == Lisp_Float)
706 IN_FLOAT (XSET (arg, Lisp_Int, ceil (XFLOAT (arg)->data)), "ceiling", arg); 729 {
730 double d;
731
732 IN_FLOAT (d = ceil (XFLOAT (arg)->data), "ceiling", arg);
733 FLOAT_TO_INT (d, arg, "ceiling", arg);
734 }
707 735
708 return arg; 736 return arg;
709 } 737 }
710 738
711 #endif /* LISP_FLOAT_TYPE */ 739 #endif /* LISP_FLOAT_TYPE */
734 f2 = (XTYPE (divisor) == Lisp_Float 762 f2 = (XTYPE (divisor) == Lisp_Float
735 ? XFLOAT (divisor)->data : XINT (divisor)); 763 ? XFLOAT (divisor)->data : XINT (divisor));
736 if (f2 == 0) 764 if (f2 == 0)
737 Fsignal (Qarith_error, Qnil); 765 Fsignal (Qarith_error, Qnil);
738 766
739 IN_FLOAT2 (XSET (arg, Lisp_Int, floor (f1 / f2)), 767 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor);
740 "floor", arg, divisor); 768 FLOAT_TO_INT2 (f1, arg, "floor", arg, divisor);
741 return arg; 769 return arg;
742 } 770 }
743 #endif 771 #endif
744 772
745 i1 = XINT (arg); 773 i1 = XINT (arg);
758 return arg; 786 return arg;
759 } 787 }
760 788
761 #ifdef LISP_FLOAT_TYPE 789 #ifdef LISP_FLOAT_TYPE
762 if (XTYPE (arg) == Lisp_Float) 790 if (XTYPE (arg) == Lisp_Float)
763 IN_FLOAT (XSET (arg, Lisp_Int, floor (XFLOAT (arg)->data)), "floor", arg); 791 {
792 double d;
793 IN_FLOAT (d = floor (XFLOAT (arg)->data), "floor", arg);
794 FLOAT_TO_INT (d, arg, "floor", arg);
795 }
764 #endif 796 #endif
765 797
766 return arg; 798 return arg;
767 } 799 }
768 800
774 register Lisp_Object arg; 806 register Lisp_Object arg;
775 { 807 {
776 CHECK_NUMBER_OR_FLOAT (arg, 0); 808 CHECK_NUMBER_OR_FLOAT (arg, 0);
777 809
778 if (XTYPE (arg) == Lisp_Float) 810 if (XTYPE (arg) == Lisp_Float)
779 /* Screw the prevailing rounding mode. */ 811 {
780 IN_FLOAT (XSET (arg, Lisp_Int, rint (XFLOAT (arg)->data)), "round", arg); 812 double d;
813
814 /* Screw the prevailing rounding mode. */
815 IN_FLOAT (d = rint (XFLOAT (arg)->data), "round", arg);
816 FLOAT_TO_INT (d, arg, "round", arg);
817 }
781 818
782 return arg; 819 return arg;
783 } 820 }
784 821
785 DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0, 822 DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0,
789 register Lisp_Object arg; 826 register Lisp_Object arg;
790 { 827 {
791 CHECK_NUMBER_OR_FLOAT (arg, 0); 828 CHECK_NUMBER_OR_FLOAT (arg, 0);
792 829
793 if (XTYPE (arg) == Lisp_Float) 830 if (XTYPE (arg) == Lisp_Float)
794 XSET (arg, Lisp_Int, (int) XFLOAT (arg)->data); 831 {
832 double d;
833
834 d = XFLOAT (arg)->data;
835 FLOAT_TO_INT (d, arg, "truncate", arg);
836 }
795 837
796 return arg; 838 return arg;
797 } 839 }
798 840
799 /* It's not clear these are worth adding. */ 841 /* It's not clear these are worth adding. */