aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/compiler.boot4
-rw-r--r--src/interp/foam_l.lisp76
-rw-r--r--src/interp/fortcall.boot9
-rw-r--r--src/interp/sys-constants.boot28
4 files changed, 14 insertions, 103 deletions
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index f452d652..aa48b9aa 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1353,7 +1353,6 @@ getBasicFFIType t ==
t = $Int64 => bootDenotation "int64"
t = $UInt64 => bootDenotation "uint64"
t = $SingleInteger => bootDenotation "int"
- t = $SingleFloat => bootDenotation "float"
t = $DoubleFloat => bootDenotation "double"
t = $String => bootDenotation "string"
t = $SystemPointer => bootDenotation "pointer"
@@ -1370,8 +1369,7 @@ $FFIAggregableDataType ==
$Int16,$UInt16,
$Int32,$UInt32,
$Int64, $UInt64,
- $SingleFloat,
- $DoubleFloat]
+ $DoubleFloat]
++ Return the Boot denotation of an FFI datatype. This is either
++ a basic VM type, or a simple array of sized integer or floating
diff --git a/src/interp/foam_l.lisp b/src/interp/foam_l.lisp
index 55390f44..d2ca464c 100644
--- a/src/interp/foam_l.lisp
+++ b/src/interp/foam_l.lisp
@@ -1,6 +1,6 @@
;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007-2010, Gabriel Dos Reis.
+;; Copyright (C) 2007-2011, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -82,11 +82,11 @@
(export '(
compile-as-file cases
- |Clos| |Char| |Bool| |Byte| |HInt| |SInt| |BInt| |SFlo| |DFlo| |Ptr|
+ |Clos| |Char| |Bool| |Byte| |HInt| |SInt| |BInt| |DFlo| |Ptr|
|Word| |Arb| |Env| |Level| |Arr| |Record| |Nil|
|ClosInit| |CharInit| |BoolInit| |ByteInit| |HIntInit| |SIntInit|
- |BIntInit| |SFloInit| |DFloInit| |PtrInit| |WordInit| |ArbInit| |EnvInit|
+ |BIntInit| |DFloInit| |PtrInit| |WordInit| |ArbInit| |EnvInit|
|ArrInit| |RecordInit| |LevelInit|
|BoolFalse| |BoolTrue| |BoolNot| |BoolAnd| |BoolOr| |BoolEQ| |BoolNE|
@@ -95,13 +95,6 @@
|CharIsLetter| |CharEQ| |CharNE| |CharLT| |CharLE|
|CharLower| |CharUpper| |CharOrd| |CharNum| |CharCode0|
- |SFlo0| |SFlo1| |SFloMin| |SFloMax| |SFloEpsilon| |SFloIsZero|
- |SFloIsNeg| |SFloIsPos| |SFloEQ| |SFloNE| |SFloLT|
- |SFloLE| |SFloNegate| |SFloPrev| |SFloNext| |SFloPlus|
- |SFloMinus| |SFloTimes| |SFloTimesPlus| |SFloDivide|
- |SFloRPlus| |SFloRMinus| |SFloRTimes| |SFloRTimesPlus|
- |SFloRDivide| |SFloDissemble| |SFloAssemble|
-
|DFlo0| |DFlo1| |DFloMin| |DFloMax| |DFloEpsilon|
|DFloIsZero| |DFloIsNeg| |DFloIsPos| |DFloEQ| |DFloNE|
|DFloLT| |DFloLE| |DFloNegate| |DFloPrev| |DFloNext|
@@ -133,17 +126,17 @@
|PtrNil| |PtrIsNil| |PtrMagicEQ| |PtrEQ| |PtrNE|
- |FormatSFlo| |FormatDFlo| |FormatSInt| |FormatBInt|
+ |FormatDFlo| |FormatSInt| |FormatBInt|
|fgetss| |fputss|
- |ScanSFlo| |ScanDFlo| |ScanSInt| |ScanBInt|
+ |ScanDFlo| |ScanSInt| |ScanBInt|
- |SFloToDFlo| |DFloToSFlo| |ByteToSInt| |SIntToByte| |HIntToSInt|
- |SIntToHInt| |SIntToBInt| |BIntToSInt| |SIntToSFlo|
- |SIntToDFlo| |BIntToSFlo| |BIntToDFlo| |PtrToSInt|
+ |ByteToSInt| |SIntToByte| |HIntToSInt|
+ |SIntToHInt| |SIntToBInt| |BIntToSInt|
+ |SIntToDFlo| |BIntToDFlo| |PtrToSInt|
|SIntToPtr| |BoolToSInt|
- |ArrToSFlo| |ArrToDFlo| |ArrToSInt| |ArrToBInt|
+ |ArrToDFlo| |ArrToSInt| |ArrToBInt|
|PlatformRTE| |PlatformOS| |Halt|
@@ -159,9 +152,9 @@
|MakeEnv| |EnvLevel| |EnvNext| |EnvInfo| |SetEnvInfo| |FoamEnvEnsure|
|MakeLit| |MakeLevel|
- |printNewLine| |printChar| |printString| |printSInt| |printBInt| |printSFloat|
+ |printNewLine| |printChar| |printString| |printSInt| |printBInt|
|printDFloat|
- |strLength| |formatSInt| |formatBInt| |formatSFloat| |formatDFloat|
+ |strLength| |formatSInt| |formatBInt| |formatDFloat|
|ProgHashCode| |SetProgHashCode| |ProgFun|
|G-mainArgc| |G-mainArgv|
@@ -194,8 +187,6 @@
(deftype |BInt| () 'BOOT::|%Integer|)
-(deftype |SFlo| () 'BOOT::|%SingleFloat|)
-
(deftype |DFlo| () 'BOOT::|%DoubleFloat|)
(deftype |Level| () t) ;; structure??
@@ -216,7 +207,6 @@
(defconstant |HIntInit| (the |HInt| 0))
(defconstant |SIntInit| (the |SInt| 0))
(defconstant |BIntInit| (the |BInt| 0))
-(defconstant |SFloInit| (coerce 0 '|SFlo|))
(defconstant |DFloInit| (coerce 0 '|DFlo|))
(defconstant |PtrInit| (the |Ptr| nil))
(defconstant |ArrInit| (the |Arr| nil))
@@ -255,40 +245,6 @@
(defmacro |CharOrd| (x) `(CHAR-INT (the |Char| ,x)))
(defmacro |CharNum| (x) `(INT-CHAR (the |SInt| ,x)))
-(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)))
-(defmacro |SFloLT| (x y) `(< (the |SFlo| ,x) (the |SFlo| ,y)))
-(defmacro |SFloLE| (x y) `(<= (the |SFlo| ,x) (the |SFlo| ,y)))
-(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) |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)
- `(the |SFlo| (+ (* (the |SFlo| ,x) (the |SFlo| ,y)) (the |SFlo| ,z))))
-(defmacro |SFloDivide| (x y) `(the |SFlo| (/ (the |SFlo| ,x) (the |SFlo| ,y))))
-(defmacro |SFloRPlus| (x y r) `(error "unimplemented operation -- SFloRPlus"))
-(defmacro |SFloRMinus| (x y r) `(error "unimplemented operation -- SFloRTimes"))
-(defmacro |SFloRTimes| (x y r) `(error "unimplemented operation -- SFloRTimes"))
-(defmacro |SFloRTimesPlus| (x y z r) `(error "unimplemented operation -- SFloTimesPlus"))
-(defmacro |SFloRDivide|(x y r) `(error "unimplemented operation -- SFloDivide"))
-(defmacro |SFloDissemble| (x) `(error "unimplemented operation -- SFloDissemble"))
-(defmacro |SFloAssemble| (w x y) `(error "unimplemented operation -- SFloAssemble"))
-
-;; These are no longer foam builtins
-;;(defmacro |SFloRound| (x) `(the |BInt| (round (the |SFlo| ,x))))
-;;(defmacro |SFloTruncate| (x) `(the |BInt| (truncate (the |SFlo| ,x))))
-;;(defmacro |SFloFloor| (x) `(the |BInt| (floor (the |SFlo| ,x))))
-;;(defmacro |SFloCeiling| (x) `(the |BInt| (ceiling (the |SFlo| ,x))))
-
(defmacro |DFlo0| () (coerce 0 '|DFlo|))
(defmacro |DFlo1| () (coerce 1 '|DFlo|))
(defmacro |DFloMin| () BOOT::|$DoubleFloatMinimum|)
@@ -468,16 +424,12 @@
;; (setf (fill-pointer |FoamOutputString|) 0)
(+ i (length str))))
-(defmacro |FormatSFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
(defmacro |FormatDFlo| (c arr i) `(|FormatNumber| ,c ,arr ,i))
(defmacro |FormatSInt| (c arr i) `(|FormatNumber| ,c ,arr ,i))
(defmacro |FormatBInt| (c arr i) `(|FormatNumber| ,c ,arr ,i))
(set-syntax-from-char (code-char 0) #\space) ;;makes null char act like white space
-(defmacro |ScanSFlo| (arr i)
- `(read-from-string ,arr nil (|SFlo0|)
- :start ,i :preserve-whitespace t))
(defmacro |ScanDFlo| (arr i)
`(read-from-string ,arr nil (|DFlo0|)
:start ,i :preserve-whitespace t))
@@ -494,13 +446,10 @@
(defmacro |BoolToSInt| (x) `(if ,x 1 0))
(defmacro |BIntToSInt| (x) `(hacked-the |SInt| ,x))
(defmacro |SIntToBInt| (x) `(hacked-the |BInt| ,x))
-(defmacro |SIntToSFlo| (x) `(coerce (hacked-the |SInt| ,x) '|SFlo|))
(defmacro |SIntToByte| (x) `(coerce (hacked-the |SInt| ,x) '|Byte|))
(defmacro |SIntToHInt| (x) `(coerce (hacked-the |SInt| ,x) '|HInt|))
(defmacro |SIntToDFlo| (x) `(coerce (hacked-the |SInt| ,x) '|DFlo|))
-(defmacro |BIntToSFlo| (x) `(coerce (hacked-the |BInt| ,x) '|SFlo|))
(defmacro |BIntToDFlo| (x) `(coerce (hacked-the |BInt| ,x) '|DFlo|))
-(defmacro |ArrToSFlo| (x) `(read-from-string ,x nil (|SFlo0|)))
(defmacro |ArrToDFlo| (x) `(read-from-string ,x nil (|DFlo0|)))
(defmacro |ArrToSInt| (x) `(read-from-string ,x nil (|SInt0|)))
(defmacro |ArrToBInt| (x) `(read-from-string ,x nil (|BInt0|)))
@@ -706,7 +655,6 @@
((eq x '|HInt|) '|HIntInit|)
((eq x '|SInt|) '|SIntInit|)
((eq x '|BInt|) '|BIntInit|)
- ((eq x '|SFlo|) '|SFloInit|)
((eq x '|DFlo|) '|DFloInit|)
((eq x '|Ptr|) '|PtrInit|)
((eq x '|Word|) '|WordInit|)
@@ -736,7 +684,6 @@
(defun |formatSInt| (n) (format nil "~D" n))
(defun |formatBInt| (n) (format nil "~D" n))
-(defun |formatSFloat| (x) (format nil "~G" x))
(defun |formatDFloat| (x) (format nil "~G" x))
@@ -754,7 +701,6 @@
(defun |printSInt| (cs n) (format cs "~D" n))
(defun |printBInt| (cs n) (format cs "~D" n))
-(defun |printSFloat| (cs x) (format cs "~G" x))
(defun |printDFloat| (cs x) (format cs "~G" x))
(defun |fputc| (si cs)
diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot
index 4ccdf592..8abd1f77 100644
--- a/src/interp/fortcall.boot
+++ b/src/interp/fortcall.boot
@@ -528,13 +528,11 @@ 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" => "%SingleFloat"
u = "double" => "%DoubleFloat"
u = "double precision" => "DoubleFloat"
u = "integer" => "FIXNUM"
u = "logical" => "BOOLEAN"
u = "character" => "CHARACTER"
- u = "complex" => "%SingleFloat"
u = "double complex" => "%DoubleFloat"
error ['"Unrecognised Fortran type: ",u]
@@ -557,7 +555,6 @@ checkForBoolean u ==
u = "BOOLEAN" => "%Short"
u
-shortZero == COERCE(0,"%SingleFloat")
longZero == COERCE(0,"%DoubleFloat")
prepareResults(results,args,dummies,values,decls) ==
@@ -571,20 +568,18 @@ prepareResults(results,args,dummies,values,decls) ==
LISTP(type) and first(type) in ["complex","double complex"] =>
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 "%SingleFloat" else "%DoubleFloat" )
+ longZero),_
+ "%DoubleFloat" )
LISTP type => makeVector(_
makeList(
apply('_*,[getVal(tt,argNames,actual) for tt in rest(type)]),_
defaultValue(first type,argNames,actual)),_
checkForBoolean lispType first(type) )
type = "integer" => 0
- type = "real" => shortZero
type = "double" => longZero
type = "double precision" => longZero
type = "logical" => 0
type = "character" => makeString 1
- type = "complex" => makeVector([shortZero,shortZero],"%SingleFloat")
type = "double complex" => makeVector([longZero,longZero],"%DoubleFloat")
error ['"Unrecognised Fortran type: ",type]
reverse! data
diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot
index 7ffa4460..3812d378 100644
--- a/src/interp/sys-constants.boot
+++ b/src/interp/sys-constants.boot
@@ -56,30 +56,6 @@ $ShortMinimum ==
$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
@@ -430,10 +406,6 @@ $ComplexInteger ==
["Complex", $Integer]
-++ SingleFloat domain constructor form
-$SingleFloat ==
- '(SingleFloat)
-
++ Float domain constructor form
$Float ==
'(Float)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 17:37:11 +0000