* lisp/core.lisp.in (%fNaN?): New.

	* interp/spaderror.lisp (trapNumericErrors): Handle
	ARITHMETIC-ERROR too.
	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %fNaN?.
	* algebra/clip.spad.pamphlet (TwoDimensionalPlotClipping): Use it.
	* algebra/plot.spad.pamphlet (Plot): Likewise.

6 files changed, 28 insertions, 9 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index cd288cbc..77efe26f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,14 @@
 2011-06-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* lisp/core.lisp.in (%fNaN?): New.
+	* interp/spaderror.lisp (trapNumericErrors): Handle
+	ARITHMETIC-ERROR too.
+	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include %fNaN?.
+	* algebra/clip.spad.pamphlet (TwoDimensionalPlotClipping): Use it.
+	* algebra/plot.spad.pamphlet (Plot): Likewise.
+
+2011-06-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/spaderror.lisp ($numericFailure): Remove.
 	(trapNumericErrors): Define for non-GCL RTS.
 	Tidy GCL-based definition.
diff --git a/src/algebra/clip.spad.pamphlet b/src/algebra/clip.spad.pamphlet
index d4eaf937..6be59d84 100644
--- a/src/algebra/clip.spad.pamphlet
+++ b/src/algebra/clip.spad.pamphlet
@@ -89,10 +89,10 @@ TwoDimensionalPlotClipping(): Exports == Implementation where
     norm: Pt -> SF
     iClipParametric: (L L Pt,RN,RN) -> CLIPPED
     findPt: L L Pt -> Union(Pt,"failed")
-    Fnan?: SF ->Boolean
     Pnan?:Pt ->Boolean
 
-    Fnan? x == x~=x
+    Fnan?(x: SF): Boolean == %fNaN?(x)$Foreign(Builtin)
+
     Pnan? p == any?(Fnan?,p)
    
     iClipParametric(pointLists,fraction,scale) ==
diff --git a/src/algebra/plot.spad.pamphlet b/src/algebra/plot.spad.pamphlet
index 664e3036..4d3208fc 100644
--- a/src/algebra/plot.spad.pamphlet
+++ b/src/algebra/plot.spad.pamphlet
@@ -154,7 +154,6 @@ Plot(): Exports == Implementation where
     basicPlot      : (F -> P,R) -> C
     basicRefine    : (C,R) -> C
     pt             : (F,F) -> P
-    Fnan?           : F -> Boolean
     Pnan?           : P -> Boolean
 
 --% representation
@@ -175,7 +174,7 @@ Plot(): Exports == Implementation where
     ANGLEBOUND: F := cos inv (4::F)
     DEBUG: B := false
 
-    Fnan?(x) == x ~= x
+    Fnan?(x: F): Boolean == %fNaN?(x)$Foreign(Builtin)
     Pnan?(x) == any?(Fnan?,x)
 
 --% graphics output
@@ -284,7 +283,8 @@ Plot(): Exports == Implementation where
       xDiff = 0 or yDiff = 0 => curve
       l := lo tRange; h := hi tRange
       (tDiff := h-l) = 0 => curve
---      if (%sptreq(yDiff, quietDoubleNaN()$Lisp)$Foreign(Builtin)) then yDiff := 1::F
+      if %fNaN?(yDiff)$Foreign(Builtin) then
+        yDiff := 1@F
       t := curve.knots
       #t < 3 => curve
       p := curve.points; f := curve.source
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 39223218..f1dd8d2e 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -405,7 +405,7 @@ $VMsideEffectFreeOperators ==
     %irem %iquo %idivide %idec %irandom
     %feq %flt %fle %fgt %fge %fmul %fadd %fsub %fexp %fmin %fmax %float?
     %fpowi %fdiv %fneg %i2f %fminval %fmaxval %fbase %fprec %ftrunc
-    %fsqrt %fpowf %flog %flog2 %flog10 %fmanexp
+    %fsqrt %fpowf %flog %flog2 %flog10 %fmanexp %fNaN?
     %fsin  %fcos  %ftan  %fcot  
     %fasin %facos %fatan %facot 
     %fsinh  %fcosh  %ftanh 
diff --git a/src/interp/spaderror.lisp b/src/interp/spaderror.lisp
index 7d65b506..2967dc27 100644
--- a/src/interp/spaderror.lisp
+++ b/src/interp/spaderror.lisp
@@ -60,9 +60,8 @@
 
 #-:gcl
 (defmacro |trapNumericErrors| (form)
-  `(handler-bind ((division-by-zero
-		   #'(lambda (c) (declare (ignore c)) |%nothing|)))
-		 ,form))
+  `(handler-case ,form
+		 (arithmetic-error () |%nothing|)))
 
 ;; the following form embeds around the akcl error handler
 #+:gcl
diff --git a/src/lisp/core.lisp.in b/src/lisp/core.lisp.in
index 87155ec3..64dd3a7d 100644
--- a/src/lisp/core.lisp.in
+++ b/src/lisp/core.lisp.in
@@ -183,6 +183,9 @@
 	   "bootImport"
 	   "CONCAT"
 	   "$EditorProgram"
+
+	   ;; numeric support
+	   "%fNaN?"
            ))
 
 (in-package "AxiomCore")
@@ -1325,6 +1328,14 @@
    (pushnew #'shoe-provide-module sb-ext:*module-provider-functions*))
 
 ;; 
+;; -*-* Numerics support -*-
+;; 
+(defmacro |%fNaN?| (x)
+  #+:sbcl `(sb-ext:float-nan-p ,x)
+  #+:ecl `(ext:float-nan-p ,x)
+  #-(or :sbcl :ecl) `(/= ,x ,x))
+
+;; 
 ;; -*- Native Datatype correspondance -*-
 ;;