emacs/lisp/float.elc
2017-10-18 13:31:44 -04:00

193 lines
7.9 KiB
Text
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(provide (quote float))
(defconst exp-base 2 "\
Base of exponent in this floating point representation.")
(defconst mantissa-bits 24 "\
Number of significant bits in this floating point representation.")
(defconst decimal-digits 6 "\
Number of decimal digits expected to be accurate.")
(defconst expt-digits 2 "\
Maximum permitted digits in a scientific notation exponent.")
(defconst maxbit (1- mantissa-bits) "\
Number of highest bit")
(defconst mantissa-maxval (1- (ash 1 maxbit)) "\
Maximum permissable value of mantissa")
(defconst mantissa-minval (1- (ash 1 maxbit)) "\
Minimum permissable value of mantissa")
(defconst mantissa-half-minval (ash (ash 1 maxbit) -1))
(defconst floating-point-regexp "^[ ]*\\(-?\\)\\([0-9]*\\)\\(\\.\\([0-9]*\\)\\|\\)\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ ]*$" "\
Regular expression to match floating point numbers. Extract matches:
1 - minus sign
2 - integer part
4 - fractional part
8 - minus sign for power of ten
9 - power of ten
")
(defconst high-bit-mask (ash 1 maxbit) "\
Masks all bits except the high-order (sign) bit.")
(defconst second-bit-mask (ash 1 (1- maxbit)) "\
Masks all bits except the highest-order magnitude bit")
(setq _f0 (quote (0 . 1)))
(setq _f1/2 (quote (4194304 . -23)))
(setq _f1 (quote (4194304 . -22)))
(setq _f10 (quote (5242880 . -19)))
(setq powers-of-10 (make-vector (1+ decimal-digits) _f1))
(aset powers-of-10 1 _f10)
(aset powers-of-10 2 (quote (6553600 . -16)))
(aset powers-of-10 3 (quote (8192000 . -13)))
(aset powers-of-10 4 (quote (5120000 . -9)))
(aset powers-of-10 5 (quote (6400000 . -6)))
(aset powers-of-10 6 (quote (8000000 . -3)))
(setq all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits)) highest-power-of-10 (aref powers-of-10 decimal-digits))
(defun fashl (fnum) (byte-code "Á@Â\"ASB‡" [fnum ash 1] 3))
(defun fashr (fnum) (byte-code "Á@Â\"ATB‡" [fnum ash -1] 3))
(defun normalize (fnum) (byte-code "@ÄVƒÅÆ@ \"!…Ç!‰ˆ:@ÄWƒ7@
V…4Ç!‰ˆ$: ˆ‡" [fnum second-bit-mask mantissa-half-minval _f0 0 zerop logand fashl] 7))
(defun abs (n) (byte-code "Á
 [‡" [n natnump] 2))
(defun fabs (fnum) (byte-code "ÁÂ@!AB!‡" [fnum normalize abs] 4))
(defun xor (a b) (byte-code "
?‡" [a b] 1))
(defun same-sign (a b) (byte-code "ÂÃ@!Ã @!\"?‡" [a b xor natnump] 5))
(defun extract-match (str i) (byte-code "ÀÁÂ<C381>‡" [nil (byte-code " !à !O‡" [str i match-beginning match-end] 5) ((error (byte-code "À‡" [""] 1)))] 3))
(setq halfword-bits (/ mantissa-bits 2) masklo (1- (ash 1 halfword-bits)) maskhi (lognot masklo) round-limit (ash 1 (/ halfword-bits 2)))
(defun hihalf (n) (byte-code "ÃÄ \"
[\"‡" [n maskhi halfword-bits ash logand] 4))
(defun lohalf (n) (byte-code "Â \"‡" [n masklo logand] 3))
(defun f+ (a1 a2) "\
Returns the sum of two floating point numbers." (byte-code " A
AVƒ
A
AVƒ
 Ä
\"…,Å!Å !‰ˆÆ @ AAZ\"\\AB!*‡" [f1 a1 a2 f2 same-sign fashr normalize ash] 9))
(defun f- (a1 &optional a2) "\
Returns the difference of two floating point numbers." (byte-code "ƒ
 Ã!\"Ä @[ AB!‡" [a2 a1 f+ f- normalize] 5))
(defun f* (a1 a2) "\
Returns the product of two floating point numbers." (byte-code "É !@É !@Ê \"?ËÌÍÎ
!\"!ÎÍÌ
!\"!ÎÍÎ
!\"!#ËÍÌ
!\"ÌÍÌ
!\"!ÌÍÎ
!\"!Ì
!$Î
!V…cT‰ˆÏ ƒo[qËÉ !AÉ !A#B!-‡" [i1 a1 i2 a2 sign prodlo prodhi round-limit mantissa-bits fabs same-sign + hihalf * lohalf normalize] 38))
(defun f/ (a1 a2) "\
Returns the quotient of two floating point numbers." (byte-code "È@!ƒÉÊË E\"v SÌÍ !@Í!@Î \"?Ï
!…Z
ZÌWƒ@Ð Ñ\"‰LÐ Ñ\"T
Z‰ˆÐ
Ñ\"
S‰ˆ(ˆÒƒf [g ÓÍ !AÍ!A S#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))
(defun f% (a1 a2) "\
Returns the remainder of first floating point number divided by second." (byte-code "ÂÃÄÅ \"! \"\"‡" [a1 a2 f- f* ftrunc f/] 7))
(defun f= (a1 a2) "\
Returns t if two floating point numbers are equal, nil otherwise." (byte-code "Â \"‡" [a1 a2 equal] 3))
(defun f> (a1 a2) "\
Returns t if first floating point number is greater than second,
nil otherwise." (byte-code "Ä@!… @ÅWƒÂL@ÅV… @ÅXƒ$ÂL@ÅX…/Ä @!ƒ6ÃLÆA A\"ƒGA AVL@ @V‡" [a1 a2 t nil natnump 0 /=] 5))
(defun f>= (a1 a2) "\
Returns t if first floating point number is greater than or equal to
second, nil otherwise." (byte-code "Â \"† Ã \"‡" [a1 a2 f> f=] 4))
(defun f< (a1 a2) "\
Returns t if first floating point number is less than second,
nil otherwise." (byte-code "Â \"?‡" [a1 a2 f>=] 3))
(defun f<= (a1 a2) "\
Returns t if first floating point number is less than or equal to
second, nil otherwise." (byte-code "Â \"?‡" [a1 a2 f>] 3))
(defun f/= (a1 a2) "\
Returns t if first floating point number is not equal to second,
nil otherwise." (byte-code "Â \"?‡" [a1 a2 f=] 3))
(defun fmin (a1 a2) "\
Returns the minimum of two floating point numbers." (byte-code "Â \"ƒ  ‡" [a1 a2 f<] 3))
(defun fmax (a1 a2) "\
Returns the maximum of two floating point numbers." (byte-code "Â \"ƒ  ‡" [a1 a2 f>] 3))
(defun fzerop (fnum) "\
Returns t if the floating point number is zero, nil otherwise." (byte-code "@ÁU‡" [fnum 0] 2))
(defun floatp (fnum) "\
Returns t if the arg is a floating point number, nil otherwise." (byte-code ":…Á@!…ÁA!‡" [fnum integerp] 3))
(defun f (int) "\
Convert the integer argument to floating point, like a C cast operator." (byte-code "ÁÂB!‡" [int normalize 0] 3))
(defun int-to-hex-string (int) "\
Convert the integer argument to a C-style hexadecimal string." (byte-code "ÄÅÆÇX…# È
ÉÊ \"Ë\"H!PÌ\\‰ˆˆ +‡" [shiftval str hex-chars int -20 "0x" "0123456789ABCDEF" 0 char-to-string logand lsh 15 4] 8))
(defun ftrunc (fnum) "\
Truncate the fractional part of a floating point number." (byte-code "ÅA!ƒ =A [XƒÆ‚=@AÇÅ !ƒ/ÈÈ \" [\"9ÈÈ [ \" [\"[ B!*‡" [fnum maxbit t mant exp natnump (0 . 1) normalize ash] 9))
(defun fint (fnum) "\
Convert the floating point number to integer, with truncation,
like a C cast operator." (byte-code "È !@A 
$ [Xƒ $É
\"+‡" [tf fnum tint texp mantissa-bits mantissa-maxval mantissa-minval t ftrunc ash] 4))
(defun float-to-string (fnum &optional sci) "\
Convert the floating point number to a decimal string.
Optional second argument non-nil means use scientific notation." (byte-code "Ó ! @ÔWÔÔÕÔÖ  \"ƒ\"×eØ\"ƒfÙÚ
\"‰\"…G  \\‰ˆ*ˆÙÚ \"‰\"…c T‰ˆH‚œÛÜ
\"‰\"…ƒ  Z‰ˆfˆÛ\"…œÜ \" S‰ˆ‚„ˆÚÜ\"
\"Ý!‰ˆÞÛß \"\"ƒÅà !T‰‚Ëà !‰ˆá!‰ˆâY…Þ T‰)ˆƒùã
ÔäOå
äÞOæá !%‰Y  SYƒ   Zç!…
×PS‰ˆ)Y ÔWƒK [èZç!…A×
PS‰ˆ,ˆé
P‰)Y
Ô TOå
TÞOQ‰ˆ
ƒdê
Pe
.‡" [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))
(defun string-to-float (str) "\
Convert the string to a floating point number.
Accepts a decimal string in scientific notation,
with exponent preceded by either E or e.
Only the 6 most significant digits of the integer and fractional parts
are used; only the first two digits of the exponent are used.
Negative signs preceding both the decimal number and the exponent
are recognized." (byte-code "× Ø#ƒ)ÉÙÚ Û\"Ú Ü\" PÝÚ Þ\"ß\"ØÉ G
Z‰ˆ
GW…>
HàU…KT‰ˆ0ˆ
Z
ÉO‰ˆ
G
Vƒs

HáY
Ø
O‰|

GZ\\‰ˆâãä
!ƒ‹Þ‚ŒØ\\ƒ–å‚—Þ\"!.Ú æ\" ÝÚ ç\"ß\" Ø
ØØÙãä Ø G^O! ƒÐå‚ÑÞ\"
\\‰
ˆ
ØW…è
[
艈é

\"ê

\"‰ˆØV…ë#S‰ˆ‚ûˆëH#.\")+‡" [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))