(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 (ash 1 maxbit) "\ Minimum permissable value of mantissa") (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!$= " [fnum second-bit-mask high-bit-mask _f0 0 zerop logand fashl] 9)) (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 "" [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 " \" \" \"! !@ @ AAZ\"\\AB!*" [f1 a1 a2 f2 fmax fmin same-sign fashr normalize ash] 11)) (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 " !@ !@ \"?! !\"!! !\"!! !\"!#! !\"! !\"!! !\"! !$ !VcT 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 ZW@ \"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ÂLA 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 Y $ [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 TH \"\"  Zf\" \" S\" \"! \"\" !T !!Y T) O O !%Y  SY   Z! PS)Y WK [Z!A PS, P)Y TO TOQ 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> HUKT0 Z O G Vs  HY  O|  GZ\\ !ނ\\傗\"!. \" \"\"    G^O! \" \\  W [   \"  \"V#SH#.\")+" [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))