-;;; float.el --- floating point arithmetic package.
+;;; float.el --- obsolete floating point arithmetic package
+
+;; Copyright (C) 1986 Free Software Foundation, Inc.
;; Author: Bill Rosenblatt
;; Maintainer: FSF
-;; Last-Modified: 16 Mar 1992
;; Keywords: extensions
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; function string-to-float converts from string to floating point
;; function fint converts a floating point to integer (with truncation)
;; function float-to-string converts from floating point to string
-;;
+;;
;; Caveats:
-;; - Exponents outside of the range of +/-100 or so will cause certain
+;; - Exponents outside of the range of +/-100 or so will cause certain
;; functions (especially conversion routines) to take forever.
;; - Very little checking is done for fixed point overflow/underflow.
;; - No checking is done for over/underflow of the exponent
;; (hardly necessary when exponent can be 2**23).
-;;
+;;
;;
;; Bill Rosenblatt
;; June 20, 1986
"Number of highest bit")
(defconst mantissa-maxval (1- (ash 1 maxbit))
- "Maximum permissable value of mantissa")
+ "Maximum permissible value of mantissa")
(defconst mantissa-minval (ash 1 maxbit)
- "Minimum permissable value of mantissa")
+ "Minimum permissible value of mantissa")
(defconst floating-point-regexp
"^[ \t]*\\(-?\\)\\([0-9]*\\)\
"Masks all bits except the highest-order magnitude bit")
;; various useful floating point constants
-(setq _f0 '(0 . 1))
+(defconst _f0 '(0 . 1))
-(setq _f1/2 '(4194304 . -23))
+(defconst _f1/2 '(4194304 . -23))
-(setq _f1 '(4194304 . -22))
+(defconst _f1 '(4194304 . -22))
-(setq _f10 '(5242880 . -19))
+(defconst _f10 '(5242880 . -19))
;; support for decimal conversion routines
-(setq powers-of-10 (make-vector (1+ decimal-digits) _f1))
+(defvar powers-of-10 (make-vector (1+ decimal-digits) _f1))
(aset powers-of-10 1 _f10)
(aset powers-of-10 2 '(6553600 . -16))
(aset powers-of-10 3 '(8192000 . -13))
(aset powers-of-10 5 '(6400000 . -6))
(aset powers-of-10 6 '(8000000 . -3))
-(setq all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits))
- highest-power-of-10 (aref powers-of-10 decimal-digits))
+(defconst all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits)))
+(defconst highest-power-of-10 (aref powers-of-10 decimal-digits))
(defun fashl (fnum) ; floating-point arithmetic shift left
(cons (ash (car fnum) 1) (1- (cdr fnum))))
(setq fnum (fashl fnum)))
(setq fnum _f0))) ; "standard 0"
fnum)
-
+
(defun abs (n) ; integer absolute value
(if (>= n 0) n (- n)))
(error "")))
;; support for the multiplication function
-(setq halfword-bits (/ mantissa-bits 2) ; bits in a halfword
- masklo (1- (ash 1 halfword-bits)) ; isolate the lower halfword
- maskhi (lognot masklo) ; isolate the upper halfword
- round-limit (ash 1 (/ halfword-bits 2)))
+(defconst halfword-bits (/ mantissa-bits 2)) ; bits in a halfword
+(defconst masklo (1- (ash 1 halfword-bits))) ; isolate the lower halfword
+(defconst maskhi (lognot masklo)) ; isolate the upper halfword
+(defconst round-limit (ash 1 (/ halfword-bits 2)))
(defun hihalf (n) ; return high halfword, shifted down
(ash (logand n maskhi) (- halfword-bits)))
(if (zerop (car a2)) ; if divide by 0
(signal 'arith-error (list "attempt to divide by zero" a1 a2))
(let ((bits (1- maxbit))
- (quotient 0)
+ (quotient 0)
(dividend (car (fabs a1)))
(divisor (car (fabs a2)))
(sign (not (same-sign a1 a2))))
(normalize
(cons (if sign (- quotient) quotient)
(- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit)))))))
-
+
(defun f% (a1 a2)
"Returns the remainder of first floating point number divided by second."
(f- a1 (f* (ftrunc (f/ a1 a2)) a2)))
-
+
;; Comparison functions
(defun f= (a1 a2)
(defun f> (a1 a2)
"Returns t if first floating point number is greater than second,
nil otherwise."
- (cond ((and (natnump (car a1)) (< (car a2) 0))
+ (cond ((and (natnump (car a1)) (< (car a2) 0))
t) ; a1 nonnegative, a2 negative
((and (> (car a1) 0) (<= (car a2) 0))
t) ; a1 positive, a2 nonpositive
(> (car a1) (car a2))))) ; same exponents.
(defun f>= (a1 a2)
- "Returns t if first floating point number is greater than or equal to
+ "Returns t if first floating point number is greater than or equal to
second, nil otherwise."
(or (f> a1 a2) (f= a1 a2)))
(defun fmax (a1 a2)
"Returns the maximum of two floating point numbers."
(if (f> a1 a2) a1 a2))
-
+
(defun fzerop (fnum)
"Returns t if the floating point number is zero, nil otherwise."
(= (car fnum) 0))
(str "0x")
(hex-chars "0123456789ABCDEF"))
(while (<= shiftval 0)
- (setq str (concat str (char-to-string
+ (setq str (concat str (char-to-string
(aref hex-chars
(logand (lsh int shiftval) 15))))
shiftval (+ shiftval 4)))
'(0 . 1))
(t ; otherwise mask out fractional bits
(let ((mant (car fnum)) (exp (cdr fnum)))
- (normalize
+ (normalize
(cons (if (natnump mant) ; if negative, use absolute value
(ash (ash mant exp) (- exp))
(- (ash (ash (- mant) exp) (- exp))))
exp))))))
(defun fint (fnum) ; truncate and convert to integer
- "Convert the floating point number to integer, with truncation,
+ "Convert the floating point number to integer, with truncation,
like a C cast operator."
(let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf)))
(cond ((>= texp mantissa-bits) ; too high, return "maxint"
"Convert the floating point number to a decimal string.
Optional second argument non-nil means use scientific notation."
(let* ((value (fabs fnum)) (sign (< (car fnum) 0))
- (power 0) (result 0) (str "")
+ (power 0) (result 0) (str "")
(temp 0) (pow10 _f1))
(if (f= fnum _f0)
(concat "-" str)
str))))
-
+
;; string to float conversion.
;; accepts scientific notation, but ignores anything after the first two
;; digits of the exponent.
(defun string-to-float (str)
"Convert the string to a floating point number.
-Accepts a decimal string in scientific notation, with exponent preceded
+Accepts a decimal string in scientific notation, with exponent preceded
by either E or e. Only the six 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
(setq leading-0s (1+ leading-0s)))
(setq power (- power leading-0s)
digit-string (substring digit-string leading-0s))
-
+
; if more than 6 digits, round off
(if (> (length digit-string) decimal-digits)
(setq round-up (>= (aref digit-string decimal-digits) ?5)
(f (* (+ (string-to-int digit-string)
(if round-up 1 0))
(if mant-sign -1 1))))
-
+
; calculate the exponent (power of ten)
(let* ((expt-subst (extract-match str 9))
(expt-sign (equal (extract-match str 8) "-"))
(expt 0) (chunks 0) (tens 0) (exponent _f1)
(func 'f*))
-
+
(setq expt (+ (* (string-to-int
(substring expt-subst 0
(min expt-digits (length expt-subst))))
(setq chunks (/ expt decimal-digits)
tens (% expt decimal-digits))
; divide or multiply by "chunks" of 10**6
- (while (> chunks 0)
+ (while (> chunks 0)
(setq exponent (funcall func exponent highest-power-of-10)
chunks (1- chunks)))
; divide or multiply by remaining power of ten
(funcall func exponent (aref powers-of-10 tens)))))
-
+
_f0)) ; if invalid, return 0
(provide 'float)