132 lines
3.8 KiB
Plaintext
Executable File
132 lines
3.8 KiB
Plaintext
Executable File
#!/usr/bin/newlisp
|
|
|
|
; Test IEE compliance of some FP operations and handling of 'inf' and 'NaN'
|
|
; numbers. In all versions of newLISP (32Bit and 64Bit) floating point numbers
|
|
; are represented as IEE 754 64-bit: Double (binary64) numbers.
|
|
|
|
; Thanks to Nelson H.F. Beebe <beebe@math.utah.edu> for some of the tests
|
|
; in this file
|
|
|
|
(println)
|
|
(println "Testing floating point performance")
|
|
|
|
(set-locale "C")
|
|
|
|
(set 'aNan (sqrt -1))
|
|
(set 'aInf (div 1.0 0))
|
|
(set 'aNegInf (div -1 0))
|
|
|
|
; operation on NaN result in NaN
|
|
|
|
(set 'tests '(
|
|
"operation on NaN result in NaN"
|
|
(NaN? (mul 1.0 aNan))
|
|
(NaN? (div 1.0 aNan))
|
|
(NaN? (add 1.0 aNan))
|
|
(NaN? (sub 1.0 aNan))
|
|
(NaN? (sin aNan))
|
|
(NaN? (cos aNan))
|
|
(NaN? (tan aNan))
|
|
(NaN? (atan aNan))
|
|
"comparison with NaN is always nil"
|
|
(not (< 1.0 aNan))
|
|
(not (> 1.0 aNan))
|
|
(not (>= 1.0 aNan))
|
|
(not (<= 1.0 aNan))
|
|
(not (= aNan aNan))
|
|
"NaN is not equal to itself"
|
|
(not (= aNan aNan))
|
|
"integer operations assume NaN as 0"
|
|
(= (- 1 aNan) 1)
|
|
(= (+ 1 aNan) 1)
|
|
(= (* 1 aNan) 0)
|
|
(not (catch (/ 1 aNan) 'error))
|
|
(= (>> aNan) 0)
|
|
(= (<< aNan) 0)
|
|
"integer operations assume inf as max-int"
|
|
(= (* 1 aInf) 9223372036854775807)
|
|
(= (- aInf 1) 9223372036854775806)
|
|
(= (+ aInf 1) -9223372036854775808) ; wrap around
|
|
"FP division by inf results in 0"
|
|
(= (/ 1 aInf) 0)
|
|
(= (div 1 aInf) 0)
|
|
"inf specials"
|
|
(= aInf aInf)
|
|
(NaN? (sub aInf aInf))
|
|
"retain sign of -0.0"
|
|
(= (set 'tiny (div -1 aInf)) -0.0)
|
|
(= (sqrt tiny) -0.0)
|
|
(= (div -1 (div 1.0 0)) -0.0)
|
|
"inf is signed too"
|
|
(= aNegInf (div -1 0))
|
|
(!= aNegInf (div 1 0))
|
|
(= (int aNegInf) -9223372036854775808)
|
|
"mod with 0 divisor is NaN"
|
|
(NaN? (mod 10 0))
|
|
"% with 0 divisor throws error"
|
|
(not (catch (% 10 0) 'error))
|
|
)
|
|
)
|
|
|
|
|
|
(dolist (t tests)
|
|
(if (string? t)
|
|
(println (format "\n%-47s\n%s" t (dup "-" 47)))
|
|
(let (result (eval t))
|
|
(println (format "%40s => %s" (string t) (string result)))
|
|
(push result result-list))
|
|
)
|
|
)
|
|
|
|
(println)
|
|
|
|
(set 'result '())
|
|
(set 'u 1.0)
|
|
(while (> u 0.0) (set 'u (mul u 0.5)) (push u result))
|
|
(println "support of subnormals: " (0 2 result) " => (0 4.940656458e-324)")
|
|
|
|
|
|
(set 'epsilon 1.0)
|
|
(while (!= 1.0 (add 1.0 epsilon))
|
|
(set 'epsilon (mul epsilon 0.5))
|
|
)
|
|
(println "machine epsilon: " epsilon " => 1.110223025e-16")
|
|
|
|
(println)
|
|
(if
|
|
(and
|
|
;(= 2.2250738585072007e-308 2.2250738585072011e-308) ; true on OSX nil on FreeBSD and Win232
|
|
;(= 2.2250738585072011e-308 2.2250738585072012e-308) ; true on FreeBSD and Win32 nil on OSX
|
|
|
|
;(= (bits (first (unpack "Lu" (pack "lf" 2.2250738585072007e-308)))) ; true on FreeBSD and Win32 nil OSX
|
|
;"1111111111111111111111111111111111111111111111111110")
|
|
;(= (bits (first (unpack "Lu" (pack "lf" 2.2250738585072007e-308)))) ; true on OSX nil on FreeBSD and Win32
|
|
;"1111111111111111111111111111111111111111111111111111")
|
|
|
|
;(= (bits (first (unpack "Lu" (pack "lf" 2.2250738585072011e-308)))) ; true on OSX and Win32 nil on FreeBSD
|
|
;"1111111111111111111111111111111111111111111111111111") ; 52 bits
|
|
;(= (bits (first (unpack "Lu" (pack "lf" 2.2250738585072011e-308)))) ; true on FreeBS nil on OSX and Win32
|
|
;"10000000000000000000000000000000000000000000000000000") ; 53 bits
|
|
|
|
|
|
; work on FreeBSD and OSX but not on Win32 XP
|
|
; (= (bits 2.2250738585072007e-308) "0")
|
|
; (= (bits (first (unpack "Lu" (pack "lf" 2.2250738585072012e-308))))
|
|
; "10000000000000000000000000000000000000000000000000000") ; 53 bits
|
|
|
|
; works on FreeBSD, OSX and Win32
|
|
(= (bits (first (unpack "Lu" (pack "lf" (sqrt -1)))))
|
|
"1111111111111000000000000000000000000000000000000000000000000000") ; 64 bits
|
|
)
|
|
(println "bit patterns OK")
|
|
(println "problems in bit patterns")
|
|
)
|
|
|
|
(println)
|
|
(if-not (apply and result-list)
|
|
(println ">>>>> PROBLEM in floating point tests")
|
|
(println ">>>>> Floating point tests SUCCESSFUL")
|
|
)
|
|
|
|
(exit)
|