Release 18.59
[emacs.git] / lisp / float.elc
blob8f2e82dd36beb4b611e2be8cb47f6de24c519b30
2 (provide (quote float))
4 (defconst exp-base 2 "\
5 Base of exponent in this floating point representation.")
7 (defconst mantissa-bits 24 "\
8 Number of significant bits in this floating point representation.")
10 (defconst decimal-digits 6 "\
11 Number of decimal digits expected to be accurate.")
13 (defconst expt-digits 2 "\
14 Maximum permitted digits in a scientific notation exponent.")
16 (defconst maxbit (1- mantissa-bits) "\
17 Number of highest bit")
19 (defconst mantissa-maxval (1- (ash 1 maxbit)) "\
20 Maximum permissable value of mantissa")
22 (defconst mantissa-minval (1- (ash 1 maxbit)) "\
23 Minimum permissable value of mantissa")
25 (defconst mantissa-half-minval (ash (ash 1 maxbit) -1))
27 (defconst floating-point-regexp "^[     ]*\\(-?\\)\\([0-9]*\\)\\(\\.\\([0-9]*\\)\\|\\)\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[       ]*$" "\
28 Regular expression to match floating point numbers.  Extract matches:
29 1 - minus sign
30 2 - integer part
31 4 - fractional part
32 8 - minus sign for power of ten
33 9 - power of ten
36 (defconst high-bit-mask (ash 1 maxbit) "\
37 Masks all bits except the high-order (sign) bit.")
39 (defconst second-bit-mask (ash 1 (1- maxbit)) "\
40 Masks all bits except the highest-order magnitude bit")
42 (setq _f0 (quote (0 . 1)))
44 (setq _f1/2 (quote (4194304 . -23)))
46 (setq _f1 (quote (4194304 . -22)))
48 (setq _f10 (quote (5242880 . -19)))
50 (setq powers-of-10 (make-vector (1+ decimal-digits) _f1))
52 (aset powers-of-10 1 _f10)
54 (aset powers-of-10 2 (quote (6553600 . -16)))
56 (aset powers-of-10 3 (quote (8192000 . -13)))
58 (aset powers-of-10 4 (quote (5120000 . -9)))
60 (aset powers-of-10 5 (quote (6400000 . -6)))
62 (aset powers-of-10 6 (quote (8000000 . -3)))
64 (setq all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits)) highest-power-of-10 (aref powers-of-10 decimal-digits))
66 (defun fashl (fnum) (byte-code "Á\b@Â\"\bASB‡" [fnum ash 1] 3))
68 (defun fashr (fnum) (byte-code "Á\b@Â\"\bATB‡" [fnum ash -1] 3))
70 (defun normalize (fnum) (byte-code "\b@ÄVƒ\x1d\0ÅÆ\b@ \"!…\x1a\0Ç\b!‰\x10ˆ‚\a\0‚:\0\b@ÄWƒ7\0\b@
71 V…4\0Ç\b!‰\x10ˆ‚$\0‚:\0\v\x10ˆ\b‡" [fnum second-bit-mask mantissa-half-minval _f0 0 zerop logand fashl] 7))
73 (defun abs (n) (byte-code "Á\b
74 \0\b\f\0\b[‡" [n natnump] 2))
76 (defun fabs (fnum) (byte-code "ÁÂ\b@!\bAB!‡" [fnum normalize abs] 4))
78 (defun xor (a b) (byte-code "\b\x05\0       …\x0e\0\b\r\0 ?‡" [a b] 1))
80 (defun same-sign (a b) (byte-code "ÂÃ\b@!à      @!\"?‡" [a b xor natnump] 5))
82 (defun extract-match (str i) (byte-code "ÀÁÂ�‡" [nil (byte-code "\b     !à     !O‡" [str i match-beginning match-end] 5) ((error (byte-code "À‡" [""] 1)))] 3))
84 (setq halfword-bits (/ mantissa-bits 2) masklo (1- (ash 1 halfword-bits)) maskhi (lognot masklo) round-limit (ash 1 (/ halfword-bits 2)))
86 (defun hihalf (n) (byte-code "ÃÄ\b       \"
87 [\"‡" [n maskhi halfword-bits ash logand] 4))
89 (defun lohalf (n) (byte-code "Â\b        \"‡" [n masklo logand] 3))
91 (defun f+ (a1 a2) "\
92 Returns the sum of two floating point numbers." (byte-code "    A
93 AVƒ\f\0   ‚\r\0
94         A
95 AVƒ\x19\0
96 \x1a\0     \e\x18Ä     
97 \"…,\0Å\b!\x10Å\v!‰\x13ˆÆ\b\v@\vA\bAZ\"\\\bAB!*‡" [f1 a1 a2 f2 same-sign fashr normalize ash] 9))
99 (defun f- (a1 &optional a2) "\
100 Returns the difference of two floating point numbers." (byte-code "\bƒ\r\0        Ã\b!\"‚\x15\0Ä       @[      AB!‡" [a2 a1 f+ f- normalize] 5))
102 (defun f* (a1 a2) "\
103 Returns the product of two floating point numbers." (byte-code "É       !@\x18É\v!@\x1aÊ       \v\"?\x1cËÌÍÎ\b
104 !\"!ÎÍÌ\b
105 !\"!ÎÍÎ\b
106 !\"!#\x1dËÍÌ\b
107 !\"ÌÍÌ\b
108 !\"!ÌÍÎ\b
109 !\"!Ì\r!$\x1e\x06Î\r!\x0e\aV…c\0\x0e\x06T‰\x16\x06ˆÏ\fƒo\0\x0e\x06[‚q\0\x0e\x06ËÉ       !AÉ\v!A\x0e\b#B!-‡" [i1 a1 i2 a2 sign prodlo prodhi round-limit mantissa-bits fabs same-sign + hihalf * lohalf normalize] 38))
111 (defun f/ (a1 a2) "\
112 Returns the quotient of two floating point numbers." (byte-code "È\b@!ƒ\x11\0ÉÊË     \bE\"‚v\0\vSÌÍ     !@Í\b!@Π\b\"?\x1e\a\x1e\x06\x1d\x1c\x1aÏ
113 !…Z\0\r\x0e\x06ZÌWƒ@\0Ð\fÑ\"‰\x14‚L\0Ð\fÑ\"T\x14\r\x0e\x06Z‰\x15ˆÐ\rÑ\"\x15
114 S‰\x12ˆ‚(\0ˆÒ\x0e\aƒf\0\f[‚g\0\fÓÍ  !AÍ\b!A\vS#B!-‡" [a2 a1 bits maxbit quotient dividend divisor sign zerop signal arith-error "attempt to divide by zero" 0 fabs same-sign natnump ash 1 normalize -] 17))
116 (defun f% (a1 a2) "\
117 Returns the remainder of first floating point number divided by second." (byte-code "Â\bÃÄÅ\b     \"!     \"\"‡" [a1 a2 f- f* ftrunc f/] 7))
119 (defun f= (a1 a2) "\
120 Returns t if two floating point numbers are equal, nil otherwise." (byte-code "Â\b       \"‡" [a1 a2 equal] 3))
122 (defun f> (a1 a2) "\
123 Returns t if first floating point number is greater than second,
124 nil otherwise." (byte-code "Ä\b@!…\v\0     @ÅWƒ\x12\0‚L\0\b@ÅV…\x1d\0       @ÅXƒ$\0‚L\0\b@ÅX…/\0Ä      @!ƒ6\0ÂL\0Æ\bA    A\"ƒG\0\bA        AV‚L\0\b@ @V‡" [a1 a2 t nil natnump 0 /=] 5))
126 (defun f>= (a1 a2) "\
127 Returns t if first floating point number is greater than or equal to 
128 second, nil otherwise." (byte-code "Â\b  \"†\v\0Ã\b \"‡" [a1 a2 f> f=] 4))
130 (defun f< (a1 a2) "\
131 Returns t if first floating point number is less than second,
132 nil otherwise." (byte-code "Â\b  \"?‡" [a1 a2 f>=] 3))
134 (defun f<= (a1 a2) "\
135 Returns t if first floating point number is less than or equal to
136 second, nil otherwise." (byte-code "Â\b  \"?‡" [a1 a2 f>] 3))
138 (defun f/= (a1 a2) "\
139 Returns t if first floating point number is not equal to second,
140 nil otherwise." (byte-code "Â\b  \"?‡" [a1 a2 f=] 3))
142 (defun fmin (a1 a2) "\
143 Returns the minimum of two floating point numbers." (byte-code "Â\b      \"ƒ\v\0\b\f\0       ‡" [a1 a2 f<] 3))
145 (defun fmax (a1 a2) "\
146 Returns the maximum of two floating point numbers." (byte-code "Â\b      \"ƒ\v\0\b\f\0       ‡" [a1 a2 f>] 3))
148 (defun fzerop (fnum) "\
149 Returns t if the floating point number is zero, nil otherwise." (byte-code "\b@ÁU‡" [fnum 0] 2))
151 (defun floatp (fnum) "\
152 Returns t if the arg is a floating point number, nil otherwise." (byte-code "\b:…\x10\0Á\b@!…\x10\0Á\bA!‡" [fnum integerp] 3))
154 (defun f (int) "\
155 Convert the integer argument to floating point, like a C cast operator." (byte-code "Á\bÂB!‡" [int normalize 0] 3))
157 (defun int-to-hex-string (int) "\
158 Convert the integer argument to a C-style hexadecimal string." (byte-code "ÄÅÆ\x1a\x19\x18\bÇX…#\0 È
159 ÉÊ\v\b\"Ë\"H!P\x11\bÌ\\‰\x10ˆ‚\x06\0ˆ        +‡" [shiftval str hex-chars int -20 "0x" "0123456789ABCDEF" 0 char-to-string logand lsh 15 4] 8))
161 (defun ftrunc (fnum) "\
162 Truncate the fractional part of a floating point number." (byte-code "Å\bA!ƒ\v\0\b‚=\0\bA     [Xƒ\x17\0Æ‚=\0\b@\bA\x1c\eÇÅ\v!ƒ/\0ÈÈ\v\f\"\f[\"‚9\0ÈÈ\v[\f\"\f[\"[\fB!*‡" [fnum maxbit t mant exp natnump (0 . 1) normalize ash] 9))
164 (defun fint (fnum) "\
165 Convert the floating point number to integer, with truncation, 
166 like a C cast operator." (byte-code "È  !\x18\b@\x1a\bA\e\v\f\x14\0\r‚$\0\v\f[Xƒ \0\x0e\x06‚$\0É
167 \v\"+‡" [tf fnum tint texp mantissa-bits mantissa-maxval mantissa-minval t ftrunc ash] 4))
169 (defun float-to-string (fnum &optional sci) "\
170 Convert the floating point number to a decimal string.
171 Optional second argument non-nil means use scientific notation." (byte-code "Ó  !\x18      @ÔW\x1aÔ\eÔ\x1cÕ\x1dÔ\x1e\x06\x0e\b\x1e\aÖ      \x0e       \"ƒ\"\0ׂe\x01Ø\b\x0e\b\"ƒf\0ÙÚ\x0e\a\x0e
172 \"‰\x16\x06\b\"…G\0\x0e\x06\x16\a\v\x0e\v\\‰\x13ˆ‚*\0ˆÙÚ\x0e\a\x0e\f\"‰\x16\x06\b\"…c\0\x0e\x06\x16\a\vT‰\x13ˆ‚H\0‚œ\0ÛÜ\x0e\a\x0e
173 \"‰\x16\x06\b\"…ƒ\0\x0e\x06\x16\a\v\x0e\vZ‰\x13ˆ‚f\0ˆÛ\x0e\a\b\"…œ\0Ü\x0e\a\x0e\f\"\x16\a\vS‰\x13ˆ‚„\0ˆÚÜ\b\x0e\a\"\x0e\r\"\x10Ý\b!‰\x14ˆÞ\x1e\x0eÛß\b\f\"\x0e\x0f\"ƒÅ\0à\f!T‰\x16\x0e‚Ë\0à\f!‰\x16\x0eˆá\x0e\x0e!‰\x15ˆ\x0e\x0eâY…Þ\0\vT‰\x13\x0e\x10ƒù\0ã\rÔäOå\räÞOæá\v!%‰\x15‚Y\x01\v\x0e\vSYƒ \x01\v\x0e\vZ\x1e\x11ç\x0e\x11!…\x1c\x01\r×P\x15\x0e\x11S‰\x16\x11ˆ‚\a\x01)‚Y\x01\vÔWƒK\x01\v[èZ\x1e\x11ç\x0e\x11!…A\x01×\rP\x15\x0e\x11S‰\x16\x11ˆ‚,\x01ˆé\rP‰\x15)‚Y\x01\rÔ\vTOå\r\vTÞOQ‰\x15ˆ
174 ƒd\x01ê\rP‚e\x01\r.\a‡" [value fnum sign power result str temp pow10 _f1 _f0 highest-power-of-10 decimal-digits _f10 all-decimal-digs-minval int _f1/2 sci zeroes t fabs 0 "" f= "0" f>= f<= f* f> f/ ftrunc nil f- fint int-to-string 1000000 concat 1 "." "E" natnump 2 "0." "-"] 28))
176 (defun string-to-float (str) "\
177 Convert the string to a floating point number.
178 Accepts a decimal string in scientific notation, 
179 with exponent preceded by either E or e.
180 Only the 6 most significant digits of the integer and fractional parts
181 are used; only the first two digits of the exponent are used.
182 Negative signs preceding both the decimal number and the exponent
183 are recognized." (byte-code "×\b Ø#ƒ)\x01É\x1aÙÚ       Û\"\eÚ   Ü\"\x1c\v\fP\x1dÝÚ      Þ\"ß\"\x1e\x06Ø\x1e\aÉ\x1e\b\vG\x0e
184 Z‰\x12ˆ\x0e\a\rGW…>\0\r\x0e\aHàU…K\0\x0e\aT‰\x16\aˆ‚0\0ˆ
185 \x0e\aZ\x12\r\x0e\aÉO‰\x15ˆ\rG\x0e
186 Vƒs\0\r\x0e
187 HáY\x16\b\rØ\x0e
188 O‰\x15‚|\0
189 \x0e
190 \rGZ\\‰\x12ˆâãä\r!\x0e\bƒ‹\0Þ‚Œ\0Ø\\\x0e\x06ƒ–\0å‚—\0Þ\"!.\x06Ú       æ\"\x1e\vÝÚ ç\"ß\"\x1e\fØ\x1e\rØ\x1e\x0eØ\x1e\x0f\x0e\x11\x1e\x10Ù\x1e\x12ãä\x0e\vØ\x0e\x13\x0e\vG^O!\x0e\fƒÐ\0å‚Ñ\0Þ\"
191 \\‰\x16\rˆ\x0e\rØW…è\0\x0e\r[\x16\rè‰\x16\x12ˆé\x0e\r\x0e
192 \"\x16\x0eê\x0e\r\x0e
193 \"‰\x16\x0fˆ\x0e\x0eØV…\x16\x01ë\x0e\x12\x0e\x10\x0e\x14#\x16\x10\x0e\x0eS‰\x16\x0eˆ‚û\0ˆë\x0e\x12\x0e\x10\x0e\x15\x0e\x0fH#.\a\")‚+\x01\x0e\x16‡" [floating-point-regexp str power int-subst fract-subst digit-string mant-sign leading-0s round-up nil decimal-digits expt-subst expt-sign expt chunks tens exponent _f1 func expt-digits highest-power-of-10 powers-of-10 _f0 string-match 0 f* extract-match 2 4 equal 1 "-" 48 53 f * string-to-int -1 9 8 f/ / % funcall] 23))