39 |
;; function string-to-float converts from string to floating point |
;; function string-to-float converts from string to floating point |
40 |
;; function fint converts a floating point to integer (with truncation) |
;; function fint converts a floating point to integer (with truncation) |
41 |
;; function float-to-string converts from floating point to string |
;; function float-to-string converts from floating point to string |
42 |
;; |
;; |
43 |
;; Caveats: |
;; Caveats: |
44 |
;; - Exponents outside of the range of +/-100 or so will cause certain |
;; - Exponents outside of the range of +/-100 or so will cause certain |
45 |
;; functions (especially conversion routines) to take forever. |
;; functions (especially conversion routines) to take forever. |
46 |
;; - Very little checking is done for fixed point overflow/underflow. |
;; - Very little checking is done for fixed point overflow/underflow. |
47 |
;; - No checking is done for over/underflow of the exponent |
;; - No checking is done for over/underflow of the exponent |
48 |
;; (hardly necessary when exponent can be 2**23). |
;; (hardly necessary when exponent can be 2**23). |
49 |
;; |
;; |
50 |
;; |
;; |
51 |
;; Bill Rosenblatt |
;; Bill Rosenblatt |
52 |
;; June 20, 1986 |
;; June 20, 1986 |
131 |
(setq fnum (fashl fnum))) |
(setq fnum (fashl fnum))) |
132 |
(setq fnum _f0))) ; "standard 0" |
(setq fnum _f0))) ; "standard 0" |
133 |
fnum) |
fnum) |
134 |
|
|
135 |
(defun abs (n) ; integer absolute value |
(defun abs (n) ; integer absolute value |
136 |
(if (>= n 0) n (- n))) |
(if (>= n 0) n (- n))) |
137 |
|
|
204 |
(if (zerop (car a2)) ; if divide by 0 |
(if (zerop (car a2)) ; if divide by 0 |
205 |
(signal 'arith-error (list "attempt to divide by zero" a1 a2)) |
(signal 'arith-error (list "attempt to divide by zero" a1 a2)) |
206 |
(let ((bits (1- maxbit)) |
(let ((bits (1- maxbit)) |
207 |
(quotient 0) |
(quotient 0) |
208 |
(dividend (car (fabs a1))) |
(dividend (car (fabs a1))) |
209 |
(divisor (car (fabs a2))) |
(divisor (car (fabs a2))) |
210 |
(sign (not (same-sign a1 a2)))) |
(sign (not (same-sign a1 a2)))) |
218 |
(normalize |
(normalize |
219 |
(cons (if sign (- quotient) quotient) |
(cons (if sign (- quotient) quotient) |
220 |
(- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit))))))) |
(- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit))))))) |
221 |
|
|
222 |
(defun f% (a1 a2) |
(defun f% (a1 a2) |
223 |
"Returns the remainder of first floating point number divided by second." |
"Returns the remainder of first floating point number divided by second." |
224 |
(f- a1 (f* (ftrunc (f/ a1 a2)) a2))) |
(f- a1 (f* (ftrunc (f/ a1 a2)) a2))) |
225 |
|
|
226 |
|
|
227 |
;; Comparison functions |
;; Comparison functions |
228 |
(defun f= (a1 a2) |
(defun f= (a1 a2) |
232 |
(defun f> (a1 a2) |
(defun f> (a1 a2) |
233 |
"Returns t if first floating point number is greater than second, |
"Returns t if first floating point number is greater than second, |
234 |
nil otherwise." |
nil otherwise." |
235 |
(cond ((and (natnump (car a1)) (< (car a2) 0)) |
(cond ((and (natnump (car a1)) (< (car a2) 0)) |
236 |
t) ; a1 nonnegative, a2 negative |
t) ; a1 nonnegative, a2 negative |
237 |
((and (> (car a1) 0) (<= (car a2) 0)) |
((and (> (car a1) 0) (<= (car a2) 0)) |
238 |
t) ; a1 positive, a2 nonpositive |
t) ; a1 positive, a2 nonpositive |
244 |
(> (car a1) (car a2))))) ; same exponents. |
(> (car a1) (car a2))))) ; same exponents. |
245 |
|
|
246 |
(defun f>= (a1 a2) |
(defun f>= (a1 a2) |
247 |
"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 |
248 |
second, nil otherwise." |
second, nil otherwise." |
249 |
(or (f> a1 a2) (f= a1 a2))) |
(or (f> a1 a2) (f= a1 a2))) |
250 |
|
|
270 |
(defun fmax (a1 a2) |
(defun fmax (a1 a2) |
271 |
"Returns the maximum of two floating point numbers." |
"Returns the maximum of two floating point numbers." |
272 |
(if (f> a1 a2) a1 a2)) |
(if (f> a1 a2) a1 a2)) |
273 |
|
|
274 |
(defun fzerop (fnum) |
(defun fzerop (fnum) |
275 |
"Returns t if the floating point number is zero, nil otherwise." |
"Returns t if the floating point number is zero, nil otherwise." |
276 |
(= (car fnum) 0)) |
(= (car fnum) 0)) |
290 |
(str "0x") |
(str "0x") |
291 |
(hex-chars "0123456789ABCDEF")) |
(hex-chars "0123456789ABCDEF")) |
292 |
(while (<= shiftval 0) |
(while (<= shiftval 0) |
293 |
(setq str (concat str (char-to-string |
(setq str (concat str (char-to-string |
294 |
(aref hex-chars |
(aref hex-chars |
295 |
(logand (lsh int shiftval) 15)))) |
(logand (lsh int shiftval) 15)))) |
296 |
shiftval (+ shiftval 4))) |
shiftval (+ shiftval 4))) |
304 |
'(0 . 1)) |
'(0 . 1)) |
305 |
(t ; otherwise mask out fractional bits |
(t ; otherwise mask out fractional bits |
306 |
(let ((mant (car fnum)) (exp (cdr fnum))) |
(let ((mant (car fnum)) (exp (cdr fnum))) |
307 |
(normalize |
(normalize |
308 |
(cons (if (natnump mant) ; if negative, use absolute value |
(cons (if (natnump mant) ; if negative, use absolute value |
309 |
(ash (ash mant exp) (- exp)) |
(ash (ash mant exp) (- exp)) |
310 |
(- (ash (ash (- mant) exp) (- exp)))) |
(- (ash (ash (- mant) exp) (- exp)))) |
311 |
exp)))))) |
exp)))))) |
312 |
|
|
313 |
(defun fint (fnum) ; truncate and convert to integer |
(defun fint (fnum) ; truncate and convert to integer |
314 |
"Convert the floating point number to integer, with truncation, |
"Convert the floating point number to integer, with truncation, |
315 |
like a C cast operator." |
like a C cast operator." |
316 |
(let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf))) |
(let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf))) |
317 |
(cond ((>= texp mantissa-bits) ; too high, return "maxint" |
(cond ((>= texp mantissa-bits) ; too high, return "maxint" |
325 |
"Convert the floating point number to a decimal string. |
"Convert the floating point number to a decimal string. |
326 |
Optional second argument non-nil means use scientific notation." |
Optional second argument non-nil means use scientific notation." |
327 |
(let* ((value (fabs fnum)) (sign (< (car fnum) 0)) |
(let* ((value (fabs fnum)) (sign (< (car fnum) 0)) |
328 |
(power 0) (result 0) (str "") |
(power 0) (result 0) (str "") |
329 |
(temp 0) (pow10 _f1)) |
(temp 0) (pow10 _f1)) |
330 |
|
|
331 |
(if (f= fnum _f0) |
(if (f= fnum _f0) |
386 |
(concat "-" str) |
(concat "-" str) |
387 |
str)))) |
str)))) |
388 |
|
|
389 |
|
|
390 |
;; string to float conversion. |
;; string to float conversion. |
391 |
;; accepts scientific notation, but ignores anything after the first two |
;; accepts scientific notation, but ignores anything after the first two |
392 |
;; digits of the exponent. |
;; digits of the exponent. |
393 |
(defun string-to-float (str) |
(defun string-to-float (str) |
394 |
"Convert the string to a floating point number. |
"Convert the string to a floating point number. |
395 |
Accepts a decimal string in scientific notation, with exponent preceded |
Accepts a decimal string in scientific notation, with exponent preceded |
396 |
by either E or e. Only the six most significant digits of the integer |
by either E or e. Only the six most significant digits of the integer |
397 |
and fractional parts are used; only the first two digits of the exponent |
and fractional parts are used; only the first two digits of the exponent |
398 |
are used. Negative signs preceding both the decimal number and the exponent |
are used. Negative signs preceding both the decimal number and the exponent |
415 |
(setq leading-0s (1+ leading-0s))) |
(setq leading-0s (1+ leading-0s))) |
416 |
(setq power (- power leading-0s) |
(setq power (- power leading-0s) |
417 |
digit-string (substring digit-string leading-0s)) |
digit-string (substring digit-string leading-0s)) |
418 |
|
|
419 |
; if more than 6 digits, round off |
; if more than 6 digits, round off |
420 |
(if (> (length digit-string) decimal-digits) |
(if (> (length digit-string) decimal-digits) |
421 |
(setq round-up (>= (aref digit-string decimal-digits) ?5) |
(setq round-up (>= (aref digit-string decimal-digits) ?5) |
426 |
(f (* (+ (string-to-int digit-string) |
(f (* (+ (string-to-int digit-string) |
427 |
(if round-up 1 0)) |
(if round-up 1 0)) |
428 |
(if mant-sign -1 1)))) |
(if mant-sign -1 1)))) |
429 |
|
|
430 |
; calculate the exponent (power of ten) |
; calculate the exponent (power of ten) |
431 |
(let* ((expt-subst (extract-match str 9)) |
(let* ((expt-subst (extract-match str 9)) |
432 |
(expt-sign (equal (extract-match str 8) "-")) |
(expt-sign (equal (extract-match str 8) "-")) |
433 |
(expt 0) (chunks 0) (tens 0) (exponent _f1) |
(expt 0) (chunks 0) (tens 0) (exponent _f1) |
434 |
(func 'f*)) |
(func 'f*)) |
435 |
|
|
436 |
(setq expt (+ (* (string-to-int |
(setq expt (+ (* (string-to-int |
437 |
(substring expt-subst 0 |
(substring expt-subst 0 |
438 |
(min expt-digits (length expt-subst)))) |
(min expt-digits (length expt-subst)))) |
445 |
(setq chunks (/ expt decimal-digits) |
(setq chunks (/ expt decimal-digits) |
446 |
tens (% expt decimal-digits)) |
tens (% expt decimal-digits)) |
447 |
; divide or multiply by "chunks" of 10**6 |
; divide or multiply by "chunks" of 10**6 |
448 |
(while (> chunks 0) |
(while (> chunks 0) |
449 |
(setq exponent (funcall func exponent highest-power-of-10) |
(setq exponent (funcall func exponent highest-power-of-10) |
450 |
chunks (1- chunks))) |
chunks (1- chunks))) |
451 |
; divide or multiply by remaining power of ten |
; divide or multiply by remaining power of ten |
452 |
(funcall func exponent (aref powers-of-10 tens))))) |
(funcall func exponent (aref powers-of-10 tens))))) |
453 |
|
|
454 |
_f0)) ; if invalid, return 0 |
_f0)) ; if invalid, return 0 |
455 |
|
|
456 |
(provide 'float) |
(provide 'float) |