diff options
author | dos-reis <gdr@axiomatics.org> | 2008-09-07 05:41:35 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-09-07 05:41:35 +0000 |
commit | 18b7b4b5d3511211092796bd8d593d5c9debec02 (patch) | |
tree | a90da73966bbb0311bf51c62e9ab8356465be694 /src/interp | |
parent | 52642d936f26a18f7d3818fcabe3fad2bff157ea (diff) | |
download | open-axiom-18b7b4b5d3511211092796bd8d593d5c9debec02.tar.gz |
Ensure SingleFloat is 32-bit, DoubleFloat 64-bit.
* interp/types.boot: Tidy.
* interp/sys-constants.boot: Define limits for builtin numeric types.
* interp/sys-os.boot: Import sys-constants.
* interp/foam_l.lisp: Import sys-constants. Align builtin numeric
types with OpenAxiom runtime's.
* interp/fortcall.boot: Tidy.
* interp/i-output.boot: Likewise.
* interp/Makefile.pamphlet (foam_l.$(FASLEXT)): Now require
sys-constants.$(FASLEXT).
* algebra/si.spad.pamphlet: Use $ShortMinimum and $ShortMaximum
for SingleInteger limits.
* algebra/sf.spad.pamphlet: Use $DoubleFloatMaximum,
$DoubleFloatMinimum for DoubleFloat limits.
* algebra/strap: Update cached Lisp translation.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/Makefile.in | 4 | ||||
-rw-r--r-- | src/interp/Makefile.pamphlet | 4 | ||||
-rw-r--r-- | src/interp/foam_l.lisp | 56 | ||||
-rw-r--r-- | src/interp/fortcall.boot | 26 | ||||
-rw-r--r-- | src/interp/i-output.boot | 2 | ||||
-rw-r--r-- | src/interp/sfsfun.boot | 2 | ||||
-rw-r--r-- | src/interp/sys-constants.boot | 49 | ||||
-rw-r--r-- | src/interp/sys-os.boot | 4 | ||||
-rw-r--r-- | src/interp/types.boot | 8 |
9 files changed, 101 insertions, 54 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 3563e592..4c3441a0 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -425,15 +425,15 @@ buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) diagnostics.$(FASLEXT): sys-globals.$(FASLEXT) vmlisp.$(FASLEXT) sys-driver.$(FASLEXT): sys-driver.boot types.$(FASLEXT) sys-globals.$(FASLEXT): sys-constants.$(FASLEXT) hash.$(FASLEXT) +sys-os.$(FASLEXT): sys-constants.$(FASLEXT) cfuns.$(FASLEXT) sys-constants.$(FASLEXT): types.$(FASLEXT) hash.$(FASLEXT): types.$(FASLEXT) union.$(FASLEXT): vmlisp.$(FASLEXT) ggreater.$(FASLEXT): vmlisp.$(FASLEXT) axext_l.$(FASLEXT): foam_l.$(FASLEXT) -foam_l.$(FASLEXT): vmlisp.$(FASLEXT) +foam_l.$(FASLEXT): vmlisp.$(FASLEXT) sys-constants.$(FASLEXT) sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-os.$(FASLEXT) vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT) -sys-os.$(FASLEXT): types.$(FASLEXT) cfuns.$(FASLEXT) types.$(FASLEXT): boot-pkg.$(FASLEXT) boot-pkg.$(FASLEXT): boot-pkg.lisp diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 7f159117..f46eab6c 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -674,15 +674,15 @@ buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) diagnostics.$(FASLEXT): sys-globals.$(FASLEXT) vmlisp.$(FASLEXT) sys-driver.$(FASLEXT): sys-driver.boot types.$(FASLEXT) sys-globals.$(FASLEXT): sys-constants.$(FASLEXT) hash.$(FASLEXT) +sys-os.$(FASLEXT): sys-constants.$(FASLEXT) cfuns.$(FASLEXT) sys-constants.$(FASLEXT): types.$(FASLEXT) hash.$(FASLEXT): types.$(FASLEXT) union.$(FASLEXT): vmlisp.$(FASLEXT) ggreater.$(FASLEXT): vmlisp.$(FASLEXT) axext_l.$(FASLEXT): foam_l.$(FASLEXT) -foam_l.$(FASLEXT): vmlisp.$(FASLEXT) +foam_l.$(FASLEXT): vmlisp.$(FASLEXT) sys-constants.$(FASLEXT) sys-utility.$(FASLEXT): vmlisp.$(FASLEXT) sys-os.$(FASLEXT) vmlisp.$(FASLEXT): types.$(FASLEXT) sys-globals.$(FASLEXT) -sys-os.$(FASLEXT): types.$(FASLEXT) cfuns.$(FASLEXT) types.$(FASLEXT): boot-pkg.$(FASLEXT) boot-pkg.$(FASLEXT): boot-pkg.lisp diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp index c948b274..8863d2d6 100644 --- a/src/interp/foam_l.lisp +++ b/src/interp/foam_l.lisp @@ -75,6 +75,7 @@ #+:gcl (in-package "BOOT") (in-package "AxiomCore") (import-module "vmlisp") +(import-module "sys-constants") (in-package "FOAM") @@ -184,24 +185,18 @@ ;; type defs for Foam types -(deftype |Char| () 'character) +(deftype |Char| () 'BOOT::|%Char|) (deftype |Clos| () 'list) (deftype |Bool| () '(member t nil)) -(deftype |Byte| () 'unsigned-byte) +(deftype |Byte| () 'BOOT::|%Byte|) (deftype |HInt| () '(integer #.(- (expt 2 15)) #.(1- (expt 2 15)))) -(deftype |SInt| () 'fixnum) +(deftype |SInt| () 'BOOT::|%Short|) -#+:AKCL -(deftype |BInt| () t) -#-:AKCL -(deftype |BInt| () 'integer) +(deftype |BInt| () 'BOOT::|%Integer|) -(deftype |SFlo| () 'short-float) +(deftype |SFlo| () 'BOOT::|%SingleFloat|) -#+:AKCL -(deftype |DFlo| () t) -#-:AKCL -(deftype |DFlo| () 'long-float) +(deftype |DFlo| () 'BOOT::|%DoubleFloat|) (deftype |Level| () t) ;; structure?? @@ -221,9 +216,8 @@ (defconstant |HIntInit| (the |HInt| 0)) (defconstant |SIntInit| (the |SInt| 0)) (defconstant |BIntInit| (the |BInt| 0)) -(defconstant |SFloInit| (the |SFlo| 0.0s0)) -;; FIXME: Revisit the definition of DFlo as long-double. -(defconstant |DFloInit| (the |DFlo| 0.0l0)) +(defconstant |SFloInit| (coerce 0 '|SFlo|)) +(defconstant |DFloInit| (coerce 0 '|DFlo|)) (defconstant |PtrInit| (the |Ptr| nil)) (defconstant |ArrInit| (the |Arr| nil)) (defconstant |RecordInit| (the |Record| nil)) @@ -261,11 +255,11 @@ (defmacro |CharOrd| (x) `(CHAR-INT (the |Char| ,x))) (defmacro |CharNum| (x) `(INT-CHAR (the |SInt| ,x))) -(defmacro |SFlo0| () 0.0s0) -(defmacro |SFlo1| () 1.0s0) -(defmacro |SFloMin| () most-negative-short-float) -(defmacro |SFloMax| () most-positive-short-float) -(defmacro |SFloEpsilon| () short-float-epsilon) +(defmacro |SFlo0| () (coerce 0 '|SFlo|)) +(defmacro |SFlo1| () (coerce 1 '|SFlo|)) +(defmacro |SFloMin| () BOOT::|$SingleFloatMinimum|) +(defmacro |SFloMax| () BOOT::|$SingleFloatMaximum|) +(defmacro |SFloEpsilon| () BOOT::|$SingleFloatEpsilon|) (defmacro |SFloIsZero| (x) `(zerop (the |SFlo| ,x))) (defmacro |SFloIsNeg| (x) `(minusp (the |SFlo| ,x))) (defmacro |SFloIsPos| (x) `(plusp (the |SFlo| ,x))) @@ -274,8 +268,8 @@ (defmacro |SFloEQ| (x y) `(= (the |SFlo| ,x) (the |SFlo| ,y))) (defmacro |SFloNE| (x y) `(/= (the |SFlo| ,x) (the |SFlo| ,y))) (defmacro |SFloNegate| (x) `(the |SFlo| (- (the |SFlo| ,x)))) -(defmacro |SFloNext| (x) `(the |SFlo| (+ (the |SFlo| ,x) 1.0s0))) -(defmacro |SFloPrev| (x) `(the |SFlo| (- (the |SFlo| ,x) 1.0s0))) +(defmacro |SFloNext| (x) `(the |SFlo| (+ (the |SFlo| ,x) |SFlo1|))) +(defmacro |SFloPrev| (x) `(the |SFlo| (- (the |SFlo| ,x) |SFlo1|))) (defmacro |SFloMinus| (x y) `(the |SFlo| (- (the |SFlo| ,x) (the |SFlo| ,y)))) (defmacro |SFloTimes| (x y) `(the |SFlo| (* (the |SFlo| ,x) (the |SFlo| ,y)))) (defmacro |SFloTimesPlus| (x y z) @@ -295,11 +289,11 @@ ;;(defmacro |SFloFloor| (x) `(the |BInt| (floor (the |SFlo| ,x)))) ;;(defmacro |SFloCeiling| (x) `(the |BInt| (ceiling (the |SFlo| ,x)))) -(defmacro |DFlo0| () 0.0d0) -(defmacro |DFlo1| () 1.0d0) -(defmacro |DFloMin| () most-negative-long-float) -(defmacro |DFloMax| () most-positive-long-float) -(defmacro |DFloEpsilon| () long-float-epsilon) +(defmacro |DFlo0| () (coerce 0 '|DFlo|)) +(defmacro |DFlo1| () (coerce 1 '|DFlo|)) +(defmacro |DFloMin| () BOOT::|$DoubleFloatMinimum|) +(defmacro |DFloMax| () BOOT::|$DoubleFloatMaximum|) +(defmacro |DFloEpsilon| () BOOT::|$DoubleFloatEpsilon|) (defmacro |DFloIsZero| (x) `(zerop (the |DFlo| ,x))) (defmacro |DFloIsNeg| (x) `(minusp (the |DFlo| ,x))) (defmacro |DFloIsPos| (x) `(plusp (the |DFlo| ,x))) @@ -308,8 +302,8 @@ (defmacro |DFloLT| (x y) `(< (the |DFlo| ,x) (the |DFlo| ,y))) (defmacro |DFloNE| (x y) `(/= (the |DFlo| ,x) (the |DFlo| ,y))) (defmacro |DFloNegate| (x) `(the |DFlo| (- (the |DFlo| ,x)))) -(defmacro |DFloNext| (x) `(the |DFlo| (+ (the |DFlo| ,x) 1.0d0))) -(defmacro |DFloPrev| (x) `(the |DFlo| (- (the |DFlo| ,x) 1.0d0))) +(defmacro |DFloNext| (x) `(the |DFlo| (+ (the |DFlo| ,x) |DFlo1|))) +(defmacro |DFloPrev| (x) `(the |DFlo| (- (the |DFlo| ,x) |DFlo1|))) (defmacro |DFloPlus| (x y) `(the |DFlo| (+ (the |DFlo| ,x) (the |DFlo| ,y)))) (defmacro |DFloMinus| (x y) `(the |DFlo| (- (the |DFlo| ,x) (the |DFlo| ,y)))) (defmacro |DFloTimes| (x y) `(the |DFlo| (* (the |DFlo| ,x) (the |DFlo| ,y)))) @@ -344,8 +338,8 @@ (defmacro |SInt0| () 0) (defmacro |SInt1| () 1) -(defmacro |SIntMin| () `(the |SInt| most-negative-fixnum)) -(defmacro |SIntMax| () `(the |SInt| most-positive-fixnum)) +(defmacro |SIntMin| () `(the |SInt| BOOT::|$ShortMinimum|)) +(defmacro |SIntMax| () `(the |SInt| BOOT::|$ShortMaximum|)) (defmacro |SIntIsZero| (x) `(zerop (the |SInt| ,x))) (defmacro |SIntIsNeg| (x) `(minusp (the |SInt| ,x))) (defmacro |SIntIsPos| (x) `(plusp (the |SInt| ,x))) diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 9d7d0d50..a8322d8f 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -399,11 +399,11 @@ vec2Lists u == [vec2Lists1 ELT(u,i) for i in 0..#u-1] spad2lisp(u) == -- Turn complexes into arrays of floats first first(u)="Complex" => - makeVector([makeVector([CADR u,CDDR u],'DOUBLE_-FLOAT)],NIL) + makeVector([makeVector([CADR u,CDDR u],"%DoubleFloat")],NIL) -- Turn arrays of complexes into arrays of floats so that tarnsposing -- them puts them in the correct fortran order first first(u)="Matrix" and first SECOND first(u) = "Complex" => - makeVector([makeVector(complexRows vec2Lists rest u,'DOUBLE_-FLOAT)],NIL) + makeVector([makeVector(complexRows vec2Lists rest u,"%DoubleFloat")],NIL) rest(u) invokeFortran(objFile,args,dummies,decls,results,actual) == @@ -526,14 +526,14 @@ spadify(l,results,decls,names,actual) == lispType u == -- Return the lisp type equivalent to the given Fortran type. LISTP u => lispType first u - u = "real" => "SHORT-FLOAT" - u = "double" => "DOUBLE-FLOAT" - u = "double precision" => "DOUBLE-FLOAT" + u = "real" => "%SingleFloat" + u = "double" => "%DoubleFloat" + u = "double precision" => "DoubleFloat" u = "integer" => "FIXNUM" u = "logical" => "BOOLEAN" u = "character" => "CHARACTER" - u = "complex" => "SHORT-FLOAT" - u = "double complex" => "DOUBLE-FLOAT" + u = "complex" => "%SingleFloat" + u = "double complex" => "%DoubleFloat" error ['"Unrecognised Fortran type: ",u] getVal(u,names,values) == @@ -552,11 +552,11 @@ prepareData(args,dummies,values,decls) == checkForBoolean u == - u = "BOOLEAN" => "FIXNUM" + u = "BOOLEAN" => "%Short" u -shortZero == COERCE(0.0,'SHORT_-FLOAT) -longZero == COERCE(0.0,'DOUBLE_-FLOAT) +shortZero == COERCE(0,"%SingleFloat") +longZero == COERCE(0,"%DoubleFloat") prepareResults(results,args,dummies,values,decls) == -- Create the floating point zeros (boot doesn't like 0.0d0, 0.0D0 etc) @@ -570,7 +570,7 @@ prepareResults(results,args,dummies,values,decls) == makeVector( makeList( 2*APPLY('_*,[getVal(tt,argNames,actual) for tt in rest(type)]),_ if first(type)="complex" then shortZero else longZero),_ - if first(type)="complex" then "SHORT-FLOAT" else "DOUBLE-FLOAT" ) + if first(type)="complex" then "%SingleFloat" else "%DoubleFloat" ) LISTP type => makeVector(_ makeList( APPLY('_*,[getVal(tt,argNames,actual) for tt in rest(type)]),_ @@ -582,8 +582,8 @@ prepareResults(results,args,dummies,values,decls) == type = "double precision" => longZero type = "logical" => 0 type = "character" => MAKE_-STRING(1) - type = "complex" => makeVector([shortZero,shortZero],'SHORT_-FLOAT) - type = "double complex" => makeVector([longZero,longZero],'LONG_-FLOAT) + type = "complex" => makeVector([shortZero,shortZero],"%SingleFloat") + type = "double complex" => makeVector([longZero,longZero],"%DoubleFloat") error ['"Unrecognised Fortran type: ",type] NREVERSE data diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index a3151587..a9a26e81 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -876,7 +876,7 @@ WIDTH u == negative := 0 -- Try and be fairly exact for smallish integers: u = 0 => 1 - u < MOST_-POSITIVE_-LONG_-FLOAT => 1+negative+FLOOR ((log10 u) + 0.0000001) + u < $DoubleFloatMaximum => 1+negative+FLOOR ((log10 u) + 0.0000001) -- Rough guess: integer-length returns log2 rounded up, so divide it by -- roughly log2(10). This should return an over-estimate, but for objects -- this big does it matter? diff --git a/src/interp/sfsfun.boot b/src/interp/sfsfun.boot index 8118fb4b..a740f3d5 100644 --- a/src/interp/sfsfun.boot +++ b/src/interp/sfsfun.boot @@ -370,7 +370,7 @@ rPsiW(n,x) == xmin := float(FLOOR(alpha + beta*n) + 1) if n>0 then - a := MIN(0,1.0/float(n)*LOG(DOUBLE_-FLOAT_-EPSILON/MIN(1.0,x))) + a := MIN(0,1.0/float(n)*LOG($DoubleFloatPrecision/MIN(1.0,x))) c := EXP(a) if ABS(a) >= 0.001 then diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index 12b11104..4bf36c9e 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.boot @@ -40,6 +40,55 @@ import types namespace BOOT +--% +--% Numeric limits +--% + +++ Minimum for %Short values. +$ShortMinimum == + MOST_-NEGATIVE_-FIXNUM + +++ Maximum for %Short values. +$ShortMaximum == + MOST_-POSITIVE_-FIXNUM + +++ Minimum for %SingleFloat values. +$SingleFloatMinimum == +)if %hasFeature KEYWORD::GCL + MOST_-NEGATIVE_-SHORT_-FLOAT +)else + MOST_-NEGATIVE_-SINGLE_-FLOAT +)endif + +++ Maximum for %SingleFloat values. +$SingleFloatMaximum == +)if %hasFeature KEYWORD::GCL + MOST_-POSITIVE_-SHORT_-FLOAT +)else + MOST_-POSITIVE_-SINGLE_-FLOAT +)endif + +++ Machine precision for %SingleFloat +$SingleFloatEpsilon == +)if %hasFeature KEYWORD::GCL + SHORT_-FLOAT_-EPSILON +)else + SINGLE_-FLOAT_-EPSILON +)endif + +++ Maximum for %DoubleFloat values +$DoubleFloatMinimum == + MOST_-NEGATIVE_-DOUBLE_-FLOAT + +++ Maximum for %DoubleFloat values +$DoubleFloatMaximum == + MOST_-POSITIVE_-DOUBLE_-FLOAT + +++ Machine precision for %DoubleFloat +$DoubleFloatEpsilon == + DOUBLE_-FLOAT_-EPSILON + +--% ++ Clock time unit per second. $timerTicksPerSecond == diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot index 9f22adf0..95342e27 100644 --- a/src/interp/sys-os.boot +++ b/src/interp/sys-os.boot @@ -38,7 +38,7 @@ -- supporting C runtime libopen-axiom-core. -- -import types +import sys_-constants import cfuns namespace BOOT module sys_-os @@ -181,7 +181,7 @@ $minusInfinity == SB_-EXT::DOUBLE_-FLOAT_-NEGATIVE_-INFINITY )else -- In general Common Lisp does not provide support for infinities -- and the like. -$plusInfinity == MOST_-POSITIVE_-DOUBLE_-FLOAT +$plusInfinity == $DoubleFloatMaximum $minusInfinity == -$plusInfinity )endif diff --git a/src/interp/types.boot b/src/interp/types.boot index 748e5070..6bb4a555 100644 --- a/src/interp/types.boot +++ b/src/interp/types.boot @@ -64,12 +64,16 @@ namespace BOOT INTEGER ++ Type of single precision floating point numbers. Most of the -++ time, this is a 32-bit datatype. +++ time, this is a 32-bit datatype on IEEE-754 host. %SingleFloat <=> +)if %hasFeature KEYWORD::GCL + SHORT_-FLOAT +)else SINGLE_-FLOAT +)endif ++ Type of double precision floating point numbers. Most of the time, -++ this is a 64-bit sized datatype. +++ this is a 64-bit sized datatype on IEEE-756 host. %DoubleFloat <=> DOUBLE_-FLOAT |