[armedbear-cvs] r12950 - trunk/abcl/src/org/armedbear/lisp

[Erik Huelsmann]

Author: ehuelsmann
Date: Mon Oct  4 06:11:13 2010
New Revision: 12950

Log:
Add two functions to disable signalling of over- and underflow
conditions in floating point calculations; working toward CLHS
compliance while keeping Maxima fixed (it was, as of last weekend).

Modified:
   trunk/abcl/src/org/armedbear/lisp/Primitives.java
   trunk/abcl/src/org/armedbear/lisp/Symbol.java

Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Primitives.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Primitives.java	Mon Oct  4 06:11:13 2010
@@ -5777,4 +5777,50 @@
         }
     };
 
+    /* Added to ABCL because Maxima wants to be able to turn off
+     * underflow conditions. However, the Hyperspec says we have to
+     * signal them. So, we went for CLHS compliant with a switch for
+     * Maxima.
+     */
+    // ### float-underflow-mode
+    private static final Primitive FLOAT_UNDERFLOW_MODE
+        = new pf_float_underflow_mode();
+    private static final class pf_float_underflow_mode extends Primitive {
+        pf_float_underflow_mode() {
+            super(Symbol.FLOAT_UNDERFLOW_MODE, "&optional boolean");
+        }
+
+        @Override
+        public LispObject execute() {
+            return Lisp.TRAP_UNDERFLOW ? T : NIL;
+        }
+
+        @Override
+        public LispObject execute(LispObject arg) {
+            Lisp.TRAP_UNDERFLOW = (arg != NIL);
+            return arg;
+        }
+    };
+
+    /* Implemented for symmetry with the underflow variant. */
+    // ### float-overflow-mode
+    private static final Primitive FLOAT_OVERFLOW_MODE
+        = new pf_float_overflow_mode();
+    private static final class pf_float_overflow_mode extends Primitive {
+        pf_float_overflow_mode() {
+            super(Symbol.FLOAT_OVERFLOW_MODE, "&optional boolean");
+        }
+
+        @Override
+        public LispObject execute() {
+            return Lisp.TRAP_OVERFLOW ? T : NIL;
+        }
+
+        @Override
+        public LispObject execute(LispObject arg) {
+            Lisp.TRAP_OVERFLOW = (arg != NIL);
+            return arg;
+        }
+    };
+
 }

Modified: trunk/abcl/src/org/armedbear/lisp/Symbol.java
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/Symbol.java	(original)
+++ trunk/abcl/src/org/armedbear/lisp/Symbol.java	Mon Oct  4 06:11:13 2010
@@ -2982,6 +2982,10 @@
     PACKAGE_SYS.addExternalSymbol("ENVIRONMENT");
   public static final Symbol FORWARD_REFERENCED_CLASS =
     PACKAGE_SYS.addExternalSymbol("FORWARD-REFERENCED-CLASS");
+  public static final Symbol FLOAT_UNDERFLOW_MODE =
+    PACKAGE_SYS.addExternalSymbol("FLOAT-UNDERFLOW-MODE");
+  public static final Symbol FLOAT_OVERFLOW_MODE =
+    PACKAGE_SYS.addExternalSymbol("FLOAT-OVERFLOW-MODE");
   public static final Symbol CLASS_BYTES =
     PACKAGE_SYS.addExternalSymbol("CLASS-BYTES");
   public static final Symbol _CLASS_SLOTS =