aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/Makefile.in15
-rw-r--r--src/interp/Makefile.pamphlet15
-rw-r--r--src/interp/c-util.boot18
-rw-r--r--src/interp/cfuns.lisp71
-rw-r--r--src/interp/compat.boot15
-rw-r--r--src/interp/g-util.boot15
-rw-r--r--src/interp/hashcode.boot1
-rw-r--r--src/interp/i-util.boot42
-rw-r--r--src/interp/interop.boot7
-rw-r--r--src/interp/nruncomp.boot2
-rw-r--r--src/interp/nrungo.boot3
-rw-r--r--src/interp/sys-os.boot3
12 files changed, 60 insertions, 147 deletions
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index a21b7bdb..158682b8 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -21,7 +21,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \
sys-driver.$(FASLEXT) sys-constants.$(FASLEXT) \
hash.$(FASLEXT) \
sys-globals.$(FASLEXT) vmlisp.$(FASLEXT) \
- cfuns.$(FASLEXT) sys-os.$(FASLEXT) \
+ sys-os.$(FASLEXT) \
sys-utility.$(FASLEXT) diagnostics.$(FASLEXT) \
union.$(FASLEXT) sys-macros.$(FASLEXT) \
macros.$(FASLEXT) metalex.$(FASLEXT) \
@@ -31,7 +31,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \
ht-util.$(FASLEXT) bc-util.$(FASLEXT) \
br-search.$(FASLEXT) \
alql.$(FASLEXT) buildom.$(FASLEXT) \
- g-util.$(FASLEXT) \
+ g-util.$(FASLEXT) hashcode.$(FASLEXT) \
simpbool.$(FASLEXT) g-timer.$(FASLEXT) \
cattable.$(FASLEXT) posit.$(FASLEXT) \
cformat.$(FASLEXT) \
@@ -121,7 +121,7 @@ TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT
autoload_objects += $(TRANOBJS)
-ASCOMP= hashcode.$(FASLEXT) as.$(FASLEXT) axext_l.$(FASLEXT)
+ASCOMP= as.$(FASLEXT) axext_l.$(FASLEXT)
ASAUTO= ${AUTO}/ax.$(FASLEXT)
@@ -307,8 +307,8 @@ compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \
pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
nrunopt.$(FASLEXT): c-util.$(FASLEXT)
nrunfast.$(FASLEXT): c-util.$(FASLEXT)
-nruncomp.$(FASLEXT): c-util.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
-nrungo.$(FASLEXT): c-util.$(FASLEXT)
+nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
+nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
iterator.$(FASLEXT): g-util.$(FASLEXT)
define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \
functor.$(FASLEXT) lisplib.$(FASLEXT) package.$(FASLEXT) \
@@ -323,7 +323,7 @@ compat.$(FASLEXT): pathname.$(FASLEXT)
simpbool.$(FASLEXT): macros.$(FASLEXT)
newfort.$(FASLEXT): macros.$(FASLEXT)
lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT)
-interop.$(FASLEXT): interop.boot c-util.$(FASLEXT)
+interop.$(FASLEXT): interop.boot c-util.$(FASLEXT) hashcode.$(FASLEXT)
c-doc.$(FASLEXT): c-util.$(FASLEXT)
## Interface with the Aldor compiler.
@@ -387,7 +387,6 @@ bits.$(FASLEXT): boot-pkg.$(FASLEXT)
dq.$(FASLEXT): types.$(FASLEXT)
## General support and utilities.
-cfuns.$(FASLEXT): boot-pkg.$(FASLEXT)
daase.$(FASLEXT): macros.$(FASLEXT) foam_l.$(FASLEXT)
spaderror.$(FASLEXT): macros.$(FASLEXT)
debug.$(FASLEXT): macros.$(FASLEXT) parsing.$(FASLEXT)
@@ -426,7 +425,7 @@ 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-os.$(FASLEXT): sys-constants.$(FASLEXT)
sys-constants.$(FASLEXT): types.$(FASLEXT)
hash.$(FASLEXT): types.$(FASLEXT)
union.$(FASLEXT): vmlisp.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 5c531e9d..8da04087 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -100,7 +100,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \
sys-driver.$(FASLEXT) sys-constants.$(FASLEXT) \
hash.$(FASLEXT) \
sys-globals.$(FASLEXT) vmlisp.$(FASLEXT) \
- cfuns.$(FASLEXT) sys-os.$(FASLEXT) \
+ sys-os.$(FASLEXT) \
sys-utility.$(FASLEXT) diagnostics.$(FASLEXT) \
union.$(FASLEXT) sys-macros.$(FASLEXT) \
macros.$(FASLEXT) metalex.$(FASLEXT) \
@@ -110,7 +110,7 @@ OBJS= boot-pkg.$(FASLEXT) types.$(FASLEXT) \
ht-util.$(FASLEXT) bc-util.$(FASLEXT) \
br-search.$(FASLEXT) \
alql.$(FASLEXT) buildom.$(FASLEXT) \
- g-util.$(FASLEXT) \
+ g-util.$(FASLEXT) hashcode.$(FASLEXT) \
simpbool.$(FASLEXT) g-timer.$(FASLEXT) \
cattable.$(FASLEXT) posit.$(FASLEXT) \
cformat.$(FASLEXT) \
@@ -258,7 +258,7 @@ autoload_objects += $(TRANOBJS)
The {\bf ASCOMP} list contains files used by the {\bf Aldor}
\cite{5} compiler. These files should probably be autoloaded.
<<environment>>=
-ASCOMP= hashcode.$(FASLEXT) as.$(FASLEXT) axext_l.$(FASLEXT)
+ASCOMP= as.$(FASLEXT) axext_l.$(FASLEXT)
@
@@ -556,8 +556,8 @@ compiler.$(FASLEXT): msgdb.$(FASLEXT) modemap.$(FASLEXT) \
pathname.$(FASLEXT) define.$(FASLEXT) iterator.$(FASLEXT)
nrunopt.$(FASLEXT): c-util.$(FASLEXT)
nrunfast.$(FASLEXT): c-util.$(FASLEXT)
-nruncomp.$(FASLEXT): c-util.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
-nrungo.$(FASLEXT): c-util.$(FASLEXT)
+nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
+nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
iterator.$(FASLEXT): g-util.$(FASLEXT)
define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \
functor.$(FASLEXT) lisplib.$(FASLEXT) package.$(FASLEXT) \
@@ -572,7 +572,7 @@ compat.$(FASLEXT): pathname.$(FASLEXT)
simpbool.$(FASLEXT): macros.$(FASLEXT)
newfort.$(FASLEXT): macros.$(FASLEXT)
lisplib.$(FASLEXT): nlib.$(FASLEXT) c-util.$(FASLEXT) debug.$(FASLEXT)
-interop.$(FASLEXT): interop.boot c-util.$(FASLEXT)
+interop.$(FASLEXT): interop.boot c-util.$(FASLEXT) hashcode.$(FASLEXT)
c-doc.$(FASLEXT): c-util.$(FASLEXT)
## Interface with the Aldor compiler.
@@ -636,7 +636,6 @@ bits.$(FASLEXT): boot-pkg.$(FASLEXT)
dq.$(FASLEXT): types.$(FASLEXT)
## General support and utilities.
-cfuns.$(FASLEXT): boot-pkg.$(FASLEXT)
daase.$(FASLEXT): macros.$(FASLEXT) foam_l.$(FASLEXT)
spaderror.$(FASLEXT): macros.$(FASLEXT)
debug.$(FASLEXT): macros.$(FASLEXT) parsing.$(FASLEXT)
@@ -675,7 +674,7 @@ 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-os.$(FASLEXT): sys-constants.$(FASLEXT)
sys-constants.$(FASLEXT): types.$(FASLEXT)
hash.$(FASLEXT): types.$(FASLEXT)
union.$(FASLEXT): vmlisp.$(FASLEXT)
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 4e91e700..c680e8b9 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -113,6 +113,24 @@ wantArgumentsAsTuple: (%List,%Signature) -> %Boolean
wantArgumentsAsTuple(args,sig) ==
isHomoegenousVarargSignature sig and #args ^= #sig
+
+devaluate d ==
+ not REFVECP d => d
+ QSGREATERP(QVSIZE d,5) and getShellEntry(d,3) is ['Category] =>
+ getShellEntry(d,0)
+ QSGREATERP(QVSIZE d,0) =>
+ d':=getShellEntry(d,0)
+ isFunctor d' => d'
+ d
+ d
+
+devaluateList l == [devaluate d for d in l]
+
+devaluateDeeply x ==
+ VECP x => devaluate x
+ atom x => x
+ [devaluateDeeply y for y in x]
+
--% Debugging Functions
--CONTINUE() == continue()
diff --git a/src/interp/cfuns.lisp b/src/interp/cfuns.lisp
deleted file mode 100644
index 84ce0ac3..00000000
--- a/src/interp/cfuns.lisp
+++ /dev/null
@@ -1,71 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-;;
-;; - Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; - Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in
-;; the documentation and/or other materials provided with the
-;; distribution.
-;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
-;; names of its contributors may be used to endorse or promote products
-;; derived from this software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-;; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-(import-module "boot-pkg")
-(in-package "BOOT")
-
-;;stolen from AXIOM-XL src/strops.c
-#+(AND KCL (NOT ELF))
-(Clines
-"MYHASH(s)"
-"char *s;"
-"{"
-" register unsigned int h = 0;"
-" register int c;"
-""
-" while ((c = *s++) != 0) {"
-" h ^= (h << 8);"
-" h += ((c) + 200041);"
-" h &= 0x3FFFFFFF;"
-" }"
-" return h;"
-"}"
-)
-#+(AND KCL (NOT ELF))
-(defentry |hashString| (string) (int "MYHASH"))
-#+(AND KCL ELF)
-(defun |hashString| (string) (system:|hashString| string))
-
-#+(AND KCL (NOT ELF))
-(Clines
-"int MYCOMBINE(i,j)"
-"int i,j;"
-"{"
-"return ( (((((unsigned int)j) & 16777215) << 6)+((unsigned int)i)) % 1073741789);"
-"}"
-)
-#+(AND KCL (NOT ELF))
-(defentry |hashCombine| (int int) (int "MYCOMBINE"))
-#+(AND KCL ELF)
-(defun |hashCombine| (x y) (system:|hashCombine| x y))
diff --git a/src/interp/compat.boot b/src/interp/compat.boot
index e7dde94e..f6e4f08b 100644
--- a/src/interp/compat.boot
+++ b/src/interp/compat.boot
@@ -38,21 +38,6 @@ namespace BOOT
-- some functions that may need to be changed on different lisp
-- systems.
--- tests if x is an identifier beginning with #
-
-isSharpVar x ==
- IDENTP x and SCHAR(SYMBOL_-NAME x,0) = char "#"
-
-isSharpVarWithNum x ==
- null isSharpVar x => nil
- (n := QCSIZE(p := PNAME x)) < 2 => nil
- ok := true
- c := 0
- for i in 1..(n-1) while ok repeat
- d := ELT(p,i)
- ok := DIGITP d => c := 10*c + DIG2FIX d
- if ok then c else nil
-
-- RREAD which takes erroval to return if key is missing
rread(key,rstream,errorval) ==
if IDENTP key then key := PNAME key
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 155d7985..1d0efd2a 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -47,6 +47,21 @@ $interpOnly := false
--% Utility Functions of General Use
+
+++ tests if x is an identifier beginning with #
+isSharpVar x ==
+ IDENTP x and SCHAR(SYMBOL_-NAME x,0) = char "#"
+
+isSharpVarWithNum x ==
+ null isSharpVar x => nil
+ (n := QCSIZE(p := PNAME x)) < 2 => nil
+ ok := true
+ c := 0
+ for i in 1..(n-1) while ok repeat
+ d := ELT(p,i)
+ ok := DIGITP d => c := 10*c + DIG2FIX d
+ if ok then c else nil
+
mkList u ==
u => ["LIST",:u]
nil
diff --git a/src/interp/hashcode.boot b/src/interp/hashcode.boot
index 95a56ce6..0dd8100e 100644
--- a/src/interp/hashcode.boot
+++ b/src/interp/hashcode.boot
@@ -88,7 +88,6 @@ hashType(type, percentHash) ==
hash
---The following are in cfuns.lisp
$hashModulus := 1073741789 -- largest 30-bit prime
-- Produce a 30-bit hash code. This function must produce the same codes
diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot
index cdfa2cfe..e4bae50d 100644
--- a/src/interp/i-util.boot
+++ b/src/interp/i-util.boot
@@ -143,54 +143,12 @@ Undef(:u) ==
APPLY(CAR ELT(domain',slot),[:u'',CDR ELT(domain',slot)])
throwKeyedMsg("S2IF0008",[formatOpSignature(op,sig),domain])
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-devaluate d ==
- not REFVECP d => d
- QSGREATERP(QVSIZE d,5) and getShellEntry(d,3) is ['Category] =>
- getShellEntry(d,0)
- QSGREATERP(QVSIZE d,0) =>
- d':=getShellEntry(d,0)
- isFunctor d' => d'
- d
- d
-
-devaluateList l == [devaluate d for d in l]
-
-devaluateDeeply x ==
- VECP x => devaluate x
- atom x => x
- [devaluateDeeply y for y in x]
-
---HasAttribute(domain,attrib) ==
----->
--- isNewWorldDomain domain => newHasAttribute(domain,attrib)
-----+
--- (u := LASSOC(attrib,domain.2)) and lookupPred(first u,domain,domain)
-
-HasSignature(domain,[op,sig]) ==
- compiledLookup(op,sig,domain)
-
---HasCategory(domain,catform') ==
--- catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
--- catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
--- catform:= devaluate catform'
--- domain0:=domain.0
--- isNewWorldDomain domain => newHasCategory(domain,catform)
--- slot4 := domain.4
--- catlist := slot4.1
--- member(catform,catlist) or
--- MEMQ(opOf(catform),'(Object Type)) or --temporary hack
--- or/[compareSigEqual(catform,cat,domain0,domain) for cat in catlist]
-
makeInitialModemapFrame() ==
COPY $InitialModemapFrame
isCapitalWord x ==
(y := PNAME x) and and/[UPPER_-CASE_-P y.i for i in 0..MAXINDEX y]
---------------------> NEW DEFINITION (see interop.boot.pamphlet)
-domainEqual(a,b) == VECP a and VECP b and a.0 = b.0
-
$newCompilerUnionFlag := true
orderUnionEntries l ==
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 2ad3991e..58b46b42 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -33,6 +33,7 @@
import c_-util
+import hashcode
namespace BOOT
-- note domainObjects are now (dispatchVector hashCode . domainVector)
@@ -583,6 +584,9 @@ getCatForm(catvec, index, domain) ==
NUMBERP(form := QVELT(catvec,index)) => domain.form
form
+HasSignature(domain,[op,sig]) ==
+ compiledLookup(op,sig,domain)
+
has(domain,catform') == HasCategory(domain,catform')
HasCategory(domain,catform') ==
@@ -606,3 +610,6 @@ HasCategory(domain,catform') ==
-- FBOUNDP(cnam) => "next"
-- SETF(SYMBOL_-FUNCTION cnam,mkAutoLoad(fn, cnam))
+domainEqual(a,b) ==
+ VECP a and VECP b and a.0 = b.0
+
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index d362a87f..620bcbf0 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -32,7 +32,7 @@
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-import c_-util
+import nrunopt
import simpbool
import profile
namespace BOOT
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index ddc448c2..2acad7a1 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -33,6 +33,9 @@
import c_-util
+import clam
+import interop
+
namespace BOOT
++
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index 58e42706..d41ccfc7 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -39,8 +39,9 @@
--
import sys_-constants
-import cfuns
+
namespace BOOT
+
module sys_-os
loadSystemRuntimeCore()
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 00:50:04 +0000