From 6a7022d0c0be54f3411ee07663765f60691c5f0c Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Sun, 23 Oct 2011 21:53:39 +0000
Subject: 	* interp/g-opt.boot ($VMsideEffectFreeOperators): Include
 %fdecode. 	* interp/lisp-backend.boot: Expand it. 	*
 algebra/sf.spad.pamphlet (DoubleFloat): Remove %fmanexpr import. 	Use
 %fdecode to access Lisp-level double-float decoding. 	[mantissa]: Rewrite. 
 [exponent]: Likewise. 	[negative?]: Likewise. 	[positive?]: Likewise. 
 [manexp]: Likewise. 	* algebra/view2D.spad.pamphlet
 (TwoDimensionalViewport): Tidy.

---
 src/algebra/sf.spad.pamphlet     | 33 ++++++++++++++++-----------------
 src/algebra/view2D.spad.pamphlet |  2 +-
 2 files changed, 17 insertions(+), 18 deletions(-)

(limited to 'src/algebra')

diff --git a/src/algebra/sf.spad.pamphlet b/src/algebra/sf.spad.pamphlet
index e15fdddd..fc01b769 100644
--- a/src/algebra/sf.spad.pamphlet
+++ b/src/algebra/sf.spad.pamphlet
@@ -286,7 +286,6 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing,
    import %fmaxval: () -> %             from Foreign Builtin
    import %fbase: () -> PositiveInteger from Foreign Builtin
    import %fprec: () -> PositiveInteger from Foreign Builtin
-   import %fmanexp: % -> Record(man: %,exp: Integer) from Foreign Builtin
    import %i2f: Integer -> %            from Foreign Builtin
    import %fabs: % -> %                 from Foreign Builtin
    import %fneg: % -> %                 from Foreign Builtin
@@ -327,12 +326,16 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing,
    import %fatanh: % -> %               from Foreign Builtin
    import %fcstpi: () -> %              from Foreign Builtin
    import %fNaN?: % -> Boolean          from Foreign Builtin
-
-   manexp: % -> MER
+   import %fdecode: % -> List Integer   from Foreign Builtin
+   import %lfirst: List Integer -> Integer from Foreign Builtin
+   import %lsecond: List Integer -> Integer from Foreign Builtin
+   import %lthird: List Integer -> Integer from Foreign Builtin
 
    base()           == %fbase()
-   mantissa x       == manexp(x).MANTISSA
-   exponent x       == manexp(x).EXPONENT
+   mantissa x       ==
+     fp := %fdecode x
+     %lfirst fp * %lthird fp
+   exponent x       == %lsecond %fdecode x
    precision()      == %fprec()
    bits()           ==
      base() = 2 => precision()
@@ -394,7 +397,7 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing,
    acoth x          == atanh(1/x)
    asech x          == acosh(1/x)
    x:% / y:%        == %fdiv(x,y)
-   negative? x      == x < 0
+   negative? x      == sign x < 0
    zero? x          == x = 0
    one? x           == x = 1
    hash x           == %hash x
@@ -438,18 +441,14 @@ DoubleFloat(): Join(FloatingPointSystem, DifferentialRing,
      x = (%i2f(n := wholePart x)) => n
      "failed"
 
-   sign(x) == retract FLOAT_-SIGN(x,1)$Lisp
+   sign(x) == %lthird %fdecode x
    abs x   == %fabs x
-   positive? x == 0 < x
-   manexp(x) ==
-      zero? x => [0,0]
-      s := sign x
-      x := abs x
-      if x > max()$% then
-        return [s*mantissa(max())+1,exponent max()]
-      me: Record(man: %,exp: Integer) := %fmanexp x
-      two53 := base()**precision()
-      [s*wholePart(two53 * me.man ),me.exp-precision()]
+   positive? x == sign x > 0
+   manexp(x: %): MER ==
+      fp := %fdecode x
+      m := %lfirst fp
+      zero? m => [m,0]
+      [%lfirst fp * %lthird fp, %lsecond fp]
 
 -- rationalApproximation(y,d,b) ==
 --    this is the quotient remainder algorithm (requires wholePart operation)
diff --git a/src/algebra/view2D.spad.pamphlet b/src/algebra/view2D.spad.pamphlet
index 5a032a44..bdd63f5e 100644
--- a/src/algebra/view2D.spad.pamphlet
+++ b/src/algebra/view2D.spad.pamphlet
@@ -779,7 +779,7 @@ TwoDimensionalViewport ():Exports == Implementation where
         -- the viewports in its list. a -1 means it doesn't
         -- exist.
       sendI(VIEW,viewport.key)$Lisp
-      i := getI(VIEW)$Lisp
+      i: Integer := getI(VIEW)$Lisp
       negative? i => 
         viewport.key := 0$I
         error "This viewport has already been closed!"
-- 
cgit v1.2.3