aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog67
-rw-r--r--src/algebra/view2D.spad.pamphlet24
-rw-r--r--src/algebra/view3D.spad.pamphlet12
-rw-r--r--src/interp/Makefile.in11
-rw-r--r--src/interp/Makefile.pamphlet11
-rw-r--r--src/interp/buildom.boot10
-rw-r--r--src/interp/category.boot2
-rw-r--r--src/interp/cfuns.lisp31
-rw-r--r--src/interp/daase.lisp6
-rw-r--r--src/interp/functor.boot10
-rw-r--r--src/interp/g-util.boot10
-rw-r--r--src/interp/i-syscmd.boot7
-rw-r--r--src/interp/i-toplev.boot5
-rw-r--r--src/interp/interop.boot8
-rw-r--r--src/interp/monitor.lisp8
-rw-r--r--src/interp/nlib.lisp3
-rw-r--r--src/interp/nruncomp.boot14
-rw-r--r--src/interp/nrunopt.boot8
-rw-r--r--src/interp/package.boot8
-rw-r--r--src/interp/patches.lisp12
-rw-r--r--src/interp/pspad1.boot8
-rw-r--r--src/interp/pspad2.boot8
-rw-r--r--src/interp/server.boot6
-rw-r--r--src/interp/sockio.lisp123
-rw-r--r--src/interp/spad.lisp6
-rw-r--r--src/interp/sys-driver.boot9
-rw-r--r--src/interp/sys-globals.boot8
-rw-r--r--src/interp/sys-os.boot96
-rw-r--r--src/interp/sys-utility.boot8
-rw-r--r--src/interp/template.boot35
-rw-r--r--src/interp/util.lisp90
-rw-r--r--src/interp/vmlisp.lisp10
32 files changed, 330 insertions, 344 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 323fc208..05260518 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,70 @@
+2008-03-19 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * interp/vmlisp.lisp (GETREFV): Set initial elements to NIL.
+ (MAKE-OUTSTREAM): Supersede existing files.
+ * interp/template.boot (makeTemplate): Use newDomainShell instead
+ of GETREFV.
+ (extendVectorSize): Likewise.
+ (mkSigPredVectors): Likewise.
+ (list2LongerVec): Likewise.
+ (measure): Remove.
+ (measureCommon): Likewise.
+ * interp/sys-utility.boot (loadNativeModule): New.
+ * interp/sys-os.boot: Import "cfuns" and "sockio".
+ (runProgram): New.
+ * interp/sys-globals.boot (/SOURCEFILES): Define here.
+ (/SPACELIST): Likewise.
+ * interp/sys-driver.boot ($OpenAxiomCoreModuleLoaded): New global
+ variable.
+ (AxiomCore::%sysInit): Load libopen-axiom-core if necessary.
+ ($defaultMsgDatabaseName): Define here.
+ * interp/spad.lisp (|New,ENTRY,1|): Tidy.
+ * interp/sockio.lisp: Move import declarations to sys-os.boot.
+ Remove unused codes.
+ * interp/server.boot (serverReadLine): Use coreQuit instead of BYE.
+ * interp/pspad1.boot (formatMDEF): Tidy.
+ * interp/pspad2.boot (formatIf1): Tidy.
+ * interp/patches.lisp: Import "sys-driver". Remove
+ $CURRENT-DIRECTORY.
+ * interp/nruncomp.boot (buildFunctor): Use newDomainShell instead
+ of GETREFV.
+ * interp/nrunopt.boot (makeDomainTemplate): Likewise.
+ * interp/package.boot (processFunctorOrPackage): Likewise.
+ * interp/nlib.lisp (rdefiostream): Tidy.
+ * interp/monitor.lisp (monitor-autoload): Define when GCL.
+ * interp/interop.boot (oldAxiomCategoryDevaluate): Tidy.
+ * interp/i-toplev.boot (start): Don't set $CURRENT-DIRECTORY.
+ * interp/i-syscmd.boot (close): Use newDomainShell.
+ (leaveScratchpad): Use coreQuit instead of BYE.
+ (compileAsharpArchiveCmd): Use GET-CURRENT-DIRECTORY.
+ * interp/g-util.boot (newDomainShell): Define.
+ * interp/functor.boot (NewbFVectorCopy): Use newDomainShell.
+ * interp/daase.lisp (asharp): Use runProgram.
+ * interp/cfuns.lisp: Remove unused codes.
+ (directoryp): Move import declaration to sys-os.bot.
+ (writeablep): Likewise.
+ * interp/buildom.boot (Record0): Use newDomainShell instead of
+ GETREFV.
+ (coerceRe2E): Likewise.
+ (Union): Likewise.
+ (Mapping): Likewise.
+ (Enumeration): Likewise.
+ * interp/category.boot (mkCategory): Likewise.
+ * interp/Makefile.pamphlet (patches.$(FASLEXT)): Require
+ sys-driver.$(FASLEXT).
+ (sys-os.$(FASLEXT)): Require cfuns.$(FASLEXT), sockio.$(FASLEXT).
+ * algebra/view2D.spad.pamphlet: Use $ViewportServer instead of
+ VIEWPORTSERVER. Use sockSendInt instead of SOCK-SEND-INT.
+ Use sockSendFloat instead of SEND-SEND-FLOAT. Use sockSendString
+ instead of SOCK-SEND-STRING. Use sockGetInt instead of
+ SOCK-GET-INT. Use sockGetFloat instead of SOCK-SEND-FLOAT.
+ * algebra/view3D.spad.pamphlet: Likewise.
+ * interp/util.lisp (fe): Remove.
+ (fc): Likewise.
+ (interp-make-directory): Simplify.
+ (OLD-BOOT::BOOT): Don't declare *PRINT-PRETTY* and *PRINT-LENGTH*
+ special.
+
2008-03-18 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/trace.boot (untraceDomainLocalOps): Tidy.
diff --git a/src/algebra/view2D.spad.pamphlet b/src/algebra/view2D.spad.pamphlet
index 5676019e..858de376 100644
--- a/src/algebra/view2D.spad.pamphlet
+++ b/src/algebra/view2D.spad.pamphlet
@@ -25,12 +25,12 @@
++ (to be displayed on TwoDimensionalViewports).
GraphImage (): Exports == Implementation where
- VIEW ==> VIEWPORTSERVER$Lisp
- sendI ==> SOCK_-SEND_-INT
- sendSF ==> SOCK_-SEND_-FLOAT
- sendSTR ==> SOCK_-SEND_-STRING
- getI ==> SOCK_-GET_-INT
- getSF ==> SOCK_-GET_-FLOAT
+ VIEW ==> _$ViewportServer$Lisp
+ sendI ==> sockSendInt
+ sendSF ==> sockSendFloat
+ sendSTR ==> sockSendString
+ getI ==> sockGetInt
+ getSF ==> sockGetFloat
typeGRAPH ==> 2
typeVIEW2D ==> 3
@@ -490,12 +490,12 @@ vp:=makeViewport2D(y1)
++ Description: TwoDimensionalViewport creates viewports to display graphs.
TwoDimensionalViewport ():Exports == Implementation where
- VIEW ==> VIEWPORTSERVER$Lisp
- sendI ==> SOCK_-SEND_-INT
- sendSF ==> SOCK_-SEND_-FLOAT
- sendSTR ==> SOCK_-SEND_-STRING
- getI ==> SOCK_-GET_-INT
- getSF ==> SOCK_-GET_-FLOAT
+ VIEW ==> _$ViewportServer$Lisp
+ sendI ==> sockSendInt
+ sendSF ==> sockSendFloat
+ sendSTR ==> sockSendString
+ getI ==> sockGetInt
+ getSF ==> sockGetFloat
typeGRAPH ==> 2
typeVIEW2D ==> 3
diff --git a/src/algebra/view3D.spad.pamphlet b/src/algebra/view3D.spad.pamphlet
index 2bcb53a7..226145a6 100644
--- a/src/algebra/view3D.spad.pamphlet
+++ b/src/algebra/view3D.spad.pamphlet
@@ -22,12 +22,12 @@
++ Keywords:
++ References:
++ Description: ThreeDimensionalViewport creates viewports to display graphs
-VIEW ==> VIEWPORTSERVER$Lisp
-sendI ==> SOCK_-SEND_-INT
-sendSF ==> SOCK_-SEND_-FLOAT
-sendSTR ==> SOCK_-SEND_-STRING
-getI ==> SOCK_-GET_-INT
-getSF ==> SOCK_-GET_-FLOAT
+VIEW ==> _$ViewportServer$Lisp
+sendI ==> sockSendInt
+sendSF ==> sockSendFloat
+sendSTR ==> sockSendString
+getI ==> sockGetInt
+getSF ==> sockGetFloat
typeVIEW3D ==> 1$I
typeVIEWTube ==> 4
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index b4ecdc27..fc51a361 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -328,7 +328,7 @@ hypertex.$(FASLEXT): hypertex.boot boot-pkg.$(FASLEXT)
## OpenAxiom's interpreter.
patches.$(FASLEXT): patches.lisp macros.$(FASLEXT) sockio.$(FASLEXT) \
- g-timer.$(FASLEXT)
+ g-timer.$(FASLEXT) sys-driver.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
setvars.$(FASLEXT): setvars.boot macros.$(FASLEXT) debug.$(FASLEXT)
@@ -639,9 +639,6 @@ property.$(FASLEXT): property.lisp sys-macros.$(FASLEXT)
nspadaux.$(FASLEXT): nspadaux.lisp sys-macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-sockio.$(FASLEXT): sockio.lisp sys-macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-
sfsfun-l.$(FASLEXT): sfsfun-l.lisp sys-macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
@@ -759,7 +756,11 @@ sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) sys-os.$(FASLEXT)
vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-sys-os.$(FASLEXT): sys-os.boot boot-pkg.$(FASLEXT)
+sys-os.$(FASLEXT): sys-os.boot boot-pkg.$(FASLEXT) \
+ cfuns.$(FASLEXT) sockio.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+sockio.$(FASLEXT): sockio.lisp boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
boot-pkg.$(FASLEXT): boot-pkg.lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 1a1971d6..d90814aa 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -642,7 +642,7 @@ hypertex.$(FASLEXT): hypertex.boot boot-pkg.$(FASLEXT)
## OpenAxiom's interpreter.
patches.$(FASLEXT): patches.lisp macros.$(FASLEXT) sockio.$(FASLEXT) \
- g-timer.$(FASLEXT)
+ g-timer.$(FASLEXT) sys-driver.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
setvars.$(FASLEXT): setvars.boot macros.$(FASLEXT) debug.$(FASLEXT)
@@ -953,9 +953,6 @@ property.$(FASLEXT): property.lisp sys-macros.$(FASLEXT)
nspadaux.$(FASLEXT): nspadaux.lisp sys-macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-sockio.$(FASLEXT): sockio.lisp sys-macros.$(FASLEXT)
- $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-
sfsfun-l.$(FASLEXT): sfsfun-l.lisp sys-macros.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
@@ -1073,7 +1070,11 @@ sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) sys-os.$(FASLEXT)
vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
-sys-os.$(FASLEXT): sys-os.boot boot-pkg.$(FASLEXT)
+sys-os.$(FASLEXT): sys-os.boot boot-pkg.$(FASLEXT) \
+ cfuns.$(FASLEXT) sockio.$(FASLEXT)
+ $(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
+
+sockio.$(FASLEXT): sockio.lisp boot-pkg.$(FASLEXT)
$(BOOTSYS) -- --compile --output=$@ --load-directory=. $<
boot-pkg.$(FASLEXT): boot-pkg.lisp
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index 5ec40d08..5b76b044 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -65,7 +65,7 @@ RecordInner args ==
Record0 VEC2LIST args
Record0 args ==
- dom := GETREFV 10
+ dom := newDomainShell 10
-- JHD added an extra slot to cache EQUAL methods
dom.0 := ["Record", :[["_:", CAR a, devaluate CDR a] for a in args]]
dom.1 :=
@@ -83,7 +83,7 @@ Record0 args ==
-- following is cache for equality functions
dom.9 := if (n:= LENGTH args) <= 2
then [NIL,:NIL]
- else GETREFV n
+ else newDomainShell n
dom
RecordEqual(x,y,dom) ==
@@ -129,7 +129,7 @@ coerceRe2E(x,source) ==
-- Want to eventually have the coerce to and from branch types.
Union(:args) ==
- dom := GETREFV 9
+ dom := newDomainShell 9
dom.0 := ["Union", :[(if a is ["_:",tag,domval] then ["_:",tag,devaluate domval]
else devaluate a) for a in args]]
dom.1 :=
@@ -182,7 +182,7 @@ coerceUn2E(x,source) ==
-- Want to eventually have elt: ($, args) -> target
Mapping(:args) ==
- dom := GETREFV 9
+ dom := newDomainShell 9
dom.0 := ["Mapping", :[devaluate a for a in args]]
dom.1 :=
[function lookupInTable,dom,
@@ -212,7 +212,7 @@ coerceMap2E(x) ==
--% Enumeration
Enumeration(:"args") ==
- dom := GETREFV 9
+ dom := newDomainShell 9
-- JHD added an extra slot to cache EQUAL methods
dom.0 := ["Enumeration", :args]
dom.1 :=
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 5ba5fb2a..e03956b2 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -93,7 +93,7 @@ mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) ==
repeat NewLocals:= delete(first u,NewLocals)
for u in NewLocals repeat
(OldLocals:= [[u,:count],:OldLocals]; count:= count+1)
- v:= GETREFV count
+ v:= newDomainShell count
v.(0):= nil
v.(1):= sigList
v.2:= attList
diff --git a/src/interp/cfuns.lisp b/src/interp/cfuns.lisp
index 03fcdb0d..9ae4f3bc 100644
--- a/src/interp/cfuns.lisp
+++ b/src/interp/cfuns.lisp
@@ -35,35 +35,6 @@
(import-module "boot-pkg")
(in-package "BOOT")
-#+(and :Lucid (not :ibm/370))
-(progn
-; (system:define-foreign-function :c '|findString| :fixnum)
- (system:define-foreign-function :c '|addtopath| :fixnum)
- (system:define-foreign-function :c '|chdir| :fixnum)
- (system:define-foreign-function :c '|writeablep| :fixnum)
- (system:define-foreign-function :c '|directoryp| :fixnum)
- (system:define-foreign-function :c '|copyEnvValue| :fixnum)
- )
-
-#+KCL
-(progn
- (defentry |directoryp| (string) (int "directoryp"))
- (defentry |writeablep| (string) (int "writeablep"))
-; (defentry |findString| (string string) (int "findString"))
- )
-
-#+:CCL
-(defun |directoryp| (fn)
- (cond ((not (probe-file fn)) -1)
- ((directoryp fn) 1)
- (t 0)))
-
-
-
-; (defun |findStringInFile| (str p)
-; (|findString| (namestring p) str) )
-
-
#+:GCL
(defun |getEnv| (var-name) (system::getenv var-name))
@@ -101,5 +72,3 @@
(defentry |hashCombine| (int int) (int "MYCOMBINE"))
#+(AND KCL ELF)
(defun |hashCombine| (x y) (system:|hashCombine| x y))
-
-
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 73c1c0a6..c8a7c7c0 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -303,9 +303,9 @@
(defun asharp (file &optional (flags *asharpflags*))
"call the asharp compiler"
- (system::system
- (concatenate 'string (|systemRootDirectory|) "/compiler/bin/axiomxl "
- flags " " file)))
+ (|runProgram|
+ (concatenate 'string (|systemRootDirectory|) "/compiler/bin/axiomxl"
+ (list flags file))))
(defun resethashtables ()
"set all -hash* to clean values. used to clean up core before saving system"
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index c9ae53d7..3e129534 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -227,7 +227,7 @@ compCategories1(u,v) ==
error 'compCategories1
NewbFVectorCopy(u,domName) ==
- v:= GETREFV SIZE u
+ v:= newDomainShell SIZE u
for i in 0..5 repeat v.i:= u.i
for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [function Undef,[domName,i],:first u.i]
v
@@ -550,7 +550,7 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) ==
'adding))^=nil]
--The code from here to the end is designed to replace repeated LOAD/STORE
--combinations (SETELT ...(ELT ..)) by MVCs where this is practicable
- copyvec:=GETREFV (1+n)
+ copyvec := newDomainShell (1+n)
for u in code repeat
if update(u,copyvec,[]) then code:=delete(u,code)
where update(code,copyvec,sofar) ==
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 97f96064..52c9a7fc 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -728,6 +728,10 @@ gensymInt g ==
for i in 2..#p-1 repeat n := 10 * n + charDigitVal p.i
n
+++
+newDomainShell: %Short -> SIMPLE_-ARRAY
+newDomainShell n ==
+ MAKE_-ARRAY(n,KEYWORD::INITIAL_-ELEMENT,nil)
-- Push into the BOOT package when invoked in batch mode.
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index f0005946..cb7e2536 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -405,7 +405,7 @@ close args ==
closeInterpreterFrame(NIL)
x := UPCASE queryUserKeyedMsg('"S2IZ0072", nil)
MEMQ(STRING2ID_-N(x,1), '(YES Y)) =>
- BYE()
+ coreQuit() -- ??? should be coreQuit errorCount()
nil
--% )constructor
@@ -636,7 +636,7 @@ compileAsharpArchiveCmd args ==
rc := mkdir namestring dir
rc ^= 0 => throwKeyedMsg("S2IL0027",[namestring dir, namestring args])
- curDir := $CURRENT_-DIRECTORY
+ curDir := GET_-CURRENT_-DIRECTORY()
-- cd to that directory and try to unarchive the .al file
@@ -2188,7 +2188,8 @@ quitSpad2Cmd() ==
sayKeyedMsg("S2IZ0032",NIL)
TERSYSCOMMAND ()
-leaveScratchpad () == BYE()
+leaveScratchpad () ==
+ coreQuit() -- ??? should be coreQuit errorCount()
--% )read
diff --git a/src/interp/i-toplev.boot b/src/interp/i-toplev.boot
index dd8332b5..c37510aa 100644
--- a/src/interp/i-toplev.boot
+++ b/src/interp/i-toplev.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -97,7 +97,6 @@ start(:l) ==
if $displayStartMsgs then sayKeyedMsg("S2IZ0053",['"history"])
initHist()
if functionp 'addtopath then addtopath CONCAT(systemRootDirectory(),'"bin")
- SETQ($CURRENT_-DIRECTORY,_*DEFAULT_-PATHNAME_-DEFAULTS_*)
if null(l) then
if $displayStartMsgs then
sayKeyedMsg("S2IZ0053",[namestring ['_.axiom,'input]])
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 994b7825..63ce4fd6 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -181,7 +181,7 @@ $oldAxiomPreCategoryDispatch :=
[nil])
oldAxiomCategoryDevaluate([[op,:args],:.], env) ==
- SExprToDName([op,:devaluateList args], T)
+ SExprToDName([op,:devaluateList args], true)
oldAxiomPreCategoryParents(catform,dom) ==
vars := ["$",:rest GETDATABASE(opOf catform, 'CONSTRUCTORFORM)]
diff --git a/src/interp/monitor.lisp b/src/interp/monitor.lisp
index c6f5c35b..167342cc 100644
--- a/src/interp/monitor.lisp
+++ b/src/interp/monitor.lisp
@@ -334,10 +334,10 @@
(monitor-file name))))
(defun monitor-autoload ()
- "traces autoload of algebra to monitor corresponding source files"
- (trace (loadvol
- :entrycond nil
- :exitcond (progn (monitor-dirname system::arglist) nil))))
+ "traces autoload of algebra to monitor corresponding source files"
+ #+:GCL(trace (loadvol
+ :entrycond nil
+ :exitcond (progn (monitor-dirname system::arglist) nil))))
(defun monitor-nrlib (nrlib)
"takes an nrlib name as a string (eg POLY) and returns a list of
diff --git a/src/interp/nlib.lisp b/src/interp/nlib.lisp
index 289fa580..00393de5 100644
--- a/src/interp/nlib.lisp
+++ b/src/interp/nlib.lisp
@@ -80,6 +80,9 @@
(-1 (|checkMkdir| fullname))
(0 (error (format nil "~s is an existing file, not a library" fullname)))
(otherwise))
+ ;; Make sure parent directory exists.
+ #-:GCL (ensure-directories-exist
+ (|ensureTrailingSlash| fullname))
(multiple-value-setq (stream indextable) (get-io-index-stream fullname))
(make-libstream :mode 'output :dirname fullname
:indextable indextable
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index d2730f29..2a3c719a 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -379,17 +379,17 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
-- category should be present. true => always
makeCatvecCode:= first catvecListMaker
emptyVector := VECTOR()
- domainShell := GETREFV ($NRTbase + $NRTdeltaLength)
+ domainShell := newDomainShell ($NRTbase + $NRTdeltaLength)
for i in 0..4 repeat domainShell.i := $domainShell.i
--we will clobber elements; copy since $domainShell may be a cached vector
$template :=
- $NRTvec = true => GETREFV ($NRTbase + $NRTdeltaLength)
+ $NRTvec = true => newDomainShell ($NRTbase + $NRTdeltaLength)
nil
$catvecList:= [domainShell,:[emptyVector for u in CADR domainShell.4]]
$catNames := ['$] -- for DescendCode -- to be changed below for slot 4
$maximalViews:= nil
- $SetFunctions:= GETREFV SIZE domainShell
- $MissingFunctionInfo:= GETREFV SIZE domainShell
+ $SetFunctions:= newDomainShell SIZE domainShell
+ $MissingFunctionInfo:= newDomainShell SIZE domainShell
$catNames:= ['$,:[GENVAR() for u in rest catvecListMaker]]
domname:='dv_$
@@ -426,7 +426,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
--$NRTdomainFormList is unused now
createDomainCode:=
['LET,domname,['LIST,MKQ CAR $definition,:ASSOCRIGHT $devaluateList]]
- createViewCode:= ['LET,'$,['GETREFV, $NRTbase + $NRTdeltaLength]]
+ createViewCode:= ['LET,'$,["newDomainShell", $NRTbase + $NRTdeltaLength]]
setVector0Code:=[$setelt,'$,0,'dv_$]
slot3Code := ['QSETREFV,'$,3,['LET,'pv_$,predBitVectorCode1]]
slamCode:=
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index a70168d9..2abaab77 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -53,7 +53,7 @@ getInfovecCode() ==
makeDomainTemplate vec ==
--NOTES: This function is called at compile time to create the template
-- (slot 0 of the infovec); called by getInfovecCode from compDefineFunctor1
- newVec := GETREFV SIZE vec
+ newVec := newDomainShell SIZE vec
for index in 0..MAXINDEX vec repeat
item := vec.index
null item => nil
diff --git a/src/interp/package.boot b/src/interp/package.boot
index 764630b8..87d33c5e 100644
--- a/src/interp/package.boot
+++ b/src/interp/package.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -96,7 +96,7 @@ processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
code:=[[($QuickCode=>'QSETREFV;'SETELT),"$",i,u'],:code]
nreverse code
code:=
- ["PROGN",:$getDomainCode,["LET","$",["GETREFV",#locals]],
+ ["PROGN",:$getDomainCode,["LET","$",["newDomainShell",#locals]],
--It is important to place this code here,
--after $ is set up
--slam functor with shell
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index cc49ba90..b08dd0b8 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -1,4 +1,4 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
@@ -15,7 +15,7 @@
;; the documentation and/or other materials provided with the
;; distribution.
;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;; - 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.
;;
@@ -34,6 +34,7 @@
(import-module "macros")
(import-module "sockio")
(import-module "g-timer")
+(import-module "sys-driver")
(in-package "BOOT")
;;patches for now
@@ -216,11 +217,6 @@
(define-function '|isUpperCaseLetter| #'UPPER-CASE-P)
(define-function '|isLetter| #'ALPHA-CHAR-P)
-#+(or :CCL (and :lucid :ibm/370))
-(setq $current-directory (truename "."))
-#-(or :CCL (and :lucid :ibm/370))
-(setq $current-directory (make-directory *default-pathname-defaults*))
-
(defvar *msghash* nil "hash table keyed by msg number")
(defun cacheKeyedMsg (file)
@@ -272,8 +268,6 @@
(unless (zerop returncode) (bye returncode)))))
#+:dos
-(setq $current-directory (truename "."))
-#+:dos
(defun user-homedir-pathname ()
(truename "."))
diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot
index 3fa01f97..889d3e73 100644
--- a/src/interp/pspad1.boot
+++ b/src/interp/pspad1.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -710,7 +710,7 @@ formatAdd ["add",a,:b] ==
--format "add " and formatRight("formatPreferPile",a,"add","Nud") --==> brace
formatMDEF ["MDEF",form,.,.,body] ==
- form is '(Rep) => formatDEF ["DEF",form,.,.,body]
+ form is '(Rep) => formatDEF ["DEF",form,nil,nil,body]
$insideEXPORTS: local := form = 'Exports
$insideTypeExpression: local := true
body := formatDeftran(body,false)
diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot
index bfcb317d..2a2fc03b 100644
--- a/src/interp/pspad2.boot
+++ b/src/interp/pspad2.boot
@@ -1,6 +1,6 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
--- Copyright (C) 2007, Gabriel Dos Reis.
+-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -350,7 +350,7 @@ formatIfThenElse x == formatSpill("formatIf1",x)
formatIf1 x ==
x is [[a,:r],:c] and null c =>
b:=
- r is [:l,s] and l => ['SEQ,:l,['exit,.,s]]
+ r is [:l,s] and l => ['SEQ,:l,['exit,nil,s]]
first r
isTrue a => format b
format "if " and format a and format " then " and format b
diff --git a/src/interp/server.boot b/src/interp/server.boot
index c37f072f..f7b78cfe 100644
--- a/src/interp/server.boot
+++ b/src/interp/server.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -97,7 +97,7 @@ serverReadLine(stream) ==
action = $NonSmanSession =>
$SpadServer := nil
action = $KillLispSystem =>
- BYE()
+ coreQuit() -- ??? should be coreQuit errorCount()
NIL
line => line
""
diff --git a/src/interp/sockio.lisp b/src/interp/sockio.lisp
index 48a99f29..ab963588 100644
--- a/src/interp/sockio.lisp
+++ b/src/interp/sockio.lisp
@@ -1,6 +1,6 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
-;; Copyright (C) 2007, Gabriel Dos Reis.
+;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
@@ -15,7 +15,7 @@
;; the documentation and/or other materials provided with the
;; distribution.
;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;; - 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.
;;
@@ -33,32 +33,11 @@
-(import-module "sys-macros")
+(import-module "boot-pkg")
(in-package "BOOT")
-#+(and :Lucid (not :ibm/370))
-(progn
- (system:define-foreign-function :c 'open_server :fixnum)
- (system:define-foreign-function :c 'sock_get_int :fixnum)
- (system:define-foreign-function :c 'sock_send_int :fixnum)
- (system:define-foreign-function :c 'sock_get_string_buf :fixnum)
- (system:define-foreign-function :c 'sock_send_string_len :fixnum)
- (system:define-foreign-function :c 'sock_get_float :single)
- (system:define-foreign-function :c 'sock_send_float :fixnum)
- (system:define-foreign-function :c 'sock_send_wakeup :fixnum)
- (system:define-foreign-function :c 'server_switch :fixnum)
- (system:define-foreign-function :c 'flush_stdout :fixnum)
- (system:define-foreign-function :c 'sock_send_signal :fixnum)
- (system:define-foreign-function :c 'print_line :fixnum)
- (system:define-foreign-function :c 'plus_infininty :single)
- (system:define-foreign-function :c 'minus_infinity :single)
- (system:define-foreign-function :c 'NANQ :single)
-)
-
#+KCL
(progn
- (clines "extern double plus_infinity(), minus_infinity(), NANQ();")
- (clines "extern double sock_get_float();")
;; GCL may pass strings by value. 'sock_get_string_buf' should fill
;; string with data read from connection, therefore needs address of
;; actual string buffer. We use 'sock_get_string_buf_wrapper' to
@@ -68,96 +47,12 @@
" if (x->st.st_fillp<j)"
" FEerror(\"string too small in sock_get_string_buf_wrapper\",0);"
" return sock_get_string_buf(i, x->st.st_self, j); }")
- (defentry open_server (string) (int "open_server"))
- (defentry sock_get_int (int) (int "sock_get_int"))
- (defentry sock_send_int (int int) (int "sock_send_int"))
- (defentry sock_get_string_buf (int object int)
+ (defentry |sockGetString| (int object int)
(int "sock_get_string_buf_wrapper"))
- (defentry sock_send_string_len (int string int) (int "sock_send_string_len"))
- (defentry sock_get_float (int) (double "sock_get_float"))
- (defentry sock_send_float (int double) (int "sock_send_float"))
- (defentry sock_send_wakeup (int int) (int "sock_send_wakeup"))
- (defentry server_switch () (int "server_switch"))
- (defentry flush_stdout () (int "flush_stdout"))
- (defentry sock_send_signal (int int) (int "sock_send_signal"))
- (defentry print_line (string) (int "print_line"))
- (defentry plus_infinity () (double "plus_infinity"))
- (defentry minus_infinity () (double "minus_infinity"))
- (defentry NANQ () (double "NANQ"))
)
-(defun open-server (name)
-#+(and :lucid :ibm/370) -2
-#-(and :lucid :ibm/370)
- (open_server name))
-(defun sock-get-int (type)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_get_int type))
-(defun sock-send-int (type val)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_int type val))
-(defun sock-get-string (type buf buf-len)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_get_string_buf type buf buf-len))
-(defun sock-send-string (type str)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_string_len type str (length str)))
-(defun sock-get-float (type)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_get_float type))
-(defun sock-send-float (type val)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_float type val))
-(defun sock-send-wakeup (type)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_wakeup type))
-(defun server-switch ()
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (server_switch))
-(defun sock-send-signal (type signal)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (sock_send_signal type signal))
-(defun print-line (str)
-#+(and :lucid :ibm/370) ()
-#-(and :lucid :ibm/370)
- (print_line str))
-(defun |plusInfinity| () (plus_infinity))
-(defun |minusInfinity| () (minus_infinity))
-
;; Macros for use in Boot
-(defun |openServer| (name)
- (open_server name))
-(defun |sockGetInt| (type)
- (sock_get_int type))
-(defun |sockSendInt| (type val)
- (sock_send_int type val))
-(defun |sockGetString| (type buf buf-len)
- (sock_get_string_buf type buf buf-len))
-(defun |sockSendString| (type str)
- (sock_send_string_len type str (length str)))
-(defun |sockGetFloat| (type)
- (sock_get_float type))
-(defun |sockSendFloat| (type val)
- (sock_send_float type val))
-(defun |sockSendWakeup| (type)
- (sock_send_wakeup type))
-(defun |serverSwitch| ()
- (server_switch))
-(defun |sockSendSignal| (type signal)
- (sock_send_signal type signal))
-(defun |printLine| (str)
- (print_line str))
-
;; Socket types. This list must be consistent with the one in com.h
(defconstant SessionManager 1)
@@ -231,11 +126,3 @@
(defconstant SIGUSR1 30) ;; user defined signal 1
(defconstant SIGUSR2 31) ;; user defined signal 2
)
-
-(setq |$NaNvalue| (NANQ))
-#-:ccl
- (setq |$plusInfinity| (* 1.1 MOST-POSITIVE-LONG-FLOAT))
-#+:ccl
- (setq |$plusInfinity| MOST-POSITIVE-LONG-FLOAT)
-(setq |$minusInfinity| (- |$plusInfinity|))
-
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 5ef272b0..0ef5b248 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -1,4 +1,4 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
@@ -15,7 +15,7 @@
;; the documentation and/or other materials provided with the
;; distribution.
;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;; - 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.
;;
@@ -352,7 +352,7 @@
XTOKENREADER STACK STACKX TRAPFLAG)
(SETQ XTRANS '|boot-New|
XTOKENREADER 'NewSYSTOK
- SYNTAX_ERROR 'SPAD_SYNTAX_ERROR)
+ Meta_Error_Handler 'SPAD_SYNTAX_ERROR)
(FLAG |boot-NewKEY| 'KEY)
(PROMPT)
(SETQ XCAPE '_)
diff --git a/src/interp/sys-driver.boot b/src/interp/sys-driver.boot
index 4cdeebf0..f1a39c85 100644
--- a/src/interp/sys-driver.boot
+++ b/src/interp/sys-driver.boot
@@ -57,12 +57,18 @@ $PrintCompilerMessageIfTrue := $verbose
++
$options := []
+$OpenAxiomCoreModuleLoaded := false
+
+++ Initialization routine run by the core system before handing off
+++ to the interpreter or compiler.
+++ ??? This part is still in flux.
AxiomCore::%sysInit() ==
SETQ(_*PACKAGE_*, FIND_-PACKAGE '"BOOT")
initMemoryConfig()
+ if not (%hasFeature KEYWORD::GCL or $OpenAxiomCoreModuleLoaded) then
+ loadNativeModule CONCAT(systemRootDirectory(),
+ '"lib/libopen-axiom-core.so")
+ $OpenAxiomCoreModuleLoaded := true
)if %hasFeature KEYWORD::GCL
SETQ(COMPILER::_*COMPILE_-VERBOSE_*,false)
SETQ(COMPILER::_*SUPPRESS_-COMPILER_-WARNINGS_*,true)
@@ -105,6 +111,9 @@ loadExposureGroupData() ==
KEYWORD::VERBOSE,false,KEYWORD::IF_-DOES_-NOT_-EXIST,nil) => "done"
"failed"
+++
+$defaultMsgDatabaseName := nil
+
++
REROOT: () -> %Thing
REROOT() ==
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 4c72a011..b6e28dee 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -453,3 +453,7 @@ INPUTSTREAM := "T"
$x := nil
$f := nil
$m := nil
+
+++ ???
+_/SOURCEFILES := []
+_/SPACELIST := []
diff --git a/src/interp/sys-os.boot b/src/interp/sys-os.boot
index d46e7741..b8125f80 100644
--- a/src/interp/sys-os.boot
+++ b/src/interp/sys-os.boot
@@ -39,6 +39,8 @@
--
import '"boot-pkg"
+import '"cfuns"
+import '"sockio"
)package "BOOT"
++ change current working directory.
@@ -57,3 +59,97 @@ import renameFile for
import mkdir for
oa__mkdir: string -> int -- 0: sucess, -1: failure.
+++ socket interface
+import openServer for
+ open__server: string -> int
+
+import sockGetInt for
+ sock__get__int: int -> int
+
+import sockSendInt for
+ sock__send__int: (int,int) -> int
+
+)if not %hasFeature KEYWORD::GCL
+import sockGetString for
+ sock__get__string__buf: (int,pointer,int) -> int
+)endif
+
+import doSendString for
+ sock__send__string__len: (int, string, int) -> int
+
+sockSendString(type,str) ==
+ doSendString(type, str, LENGTH str)
+
+import sockGetFloat for
+ sock__get__float: int -> double
+
+import sockSendFloat for
+ sock__send__float: (int,double) -> int
+
+import sockSendWakeup for
+ sock__send__wakeup: (int,int) -> int
+
+import serverSwitch for
+ server__switch: () -> int
+
+import flushStdout for
+ flush__stdout: () -> int
+
+import sockSendSignal for
+ sock__send__signal: (int,int) -> int
+
+import printLine for
+ print__line: string -> int
+
+--%
+import directoryp for
+ directoryp: string -> int
+
+import writeablep for
+ writeablep: string -> int
+
+++ run a program with specified arguments
+runProgram(prog,args) ==
+)if %hasFeature KEYWORD::GCL
+ SYSTEM::SYSTEM CONCAT/[prog,:[:['" ",a] for a in args]]
+)elseif %hasFeature KEYWORD::CLISP
+ EXT::RUN_-PROGRAM(prog,KEYWORD::ARGUMENTS,args)
+)elseif %hasFeature KEYWORD::SBCL
+ SB_-EXT::RUN_-PROGRAM(prog,args)
+)else
+ systemError '"don't how to execute external program with this Lisp"
+)endif
+
+
+++ numeric limits
+)if %hasFeature KEYWORD::GCL
+import plusInfinity for
+ plus__infinity: () -> double
+
+import minusInfinity for
+ minus__infinity: () -> double
+
+import NaNQ for
+ NANQ: () -> double
+
+$plusInfinity := plusInfinity()
+$minusInfinity := minusInfinity()
+$NaNValue := NaNQ()
+
+)elseif %hasFeature KEYWORD::SBCL
+$plusInfinity == SB_-EXT::DOUBLE_-FLOAT_-POSITIVE_-INFINITY
+
+$minusInfinity == SB_-EXT::DOUBLE_-FLOAT_-NEGATIVE_-INFINITY
+)else
+$plusInfinity == 1.1 * MOST_-POSITIVE_-LONG_-FLOAT()
+
+$minusInfinity == -$plusInfinity
+)endif
+
+)if not %hasFeature KEYWORD::GCL
+plusInfinity() ==
+ $plusInfinity
+
+minusInfinity() ==
+ $minusInfinity
+)endif
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index d74c74ba..8c80701d 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -175,3 +175,11 @@ checkMkdir path ==
++ return the pathname to the system module designated by `m'.
getSystemModulePath m ==
CONCAT(systemRootDirectory(),'"algebra/",m,'".",$faslType)
+
+++ Load native dynamically linked module
+loadNativeModule m ==
+)if %hasFeature KEYWORD::SBCL
+ SB_-ALIEN::LOAD_-SHARED_-OBJECT m
+)else
+ systemError '"don't know how to load a dynamically link module"
+)endif
diff --git a/src/interp/template.boot b/src/interp/template.boot
index ada43d26..c9c7f487 100644
--- a/src/interp/template.boot
+++ b/src/interp/template.boot
@@ -1,4 +1,4 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007-2008, Gabriel Dos Reis.
-- All rights reserved.
@@ -15,7 +15,7 @@
-- the documentation and/or other materials provided with the
-- distribution.
--
--- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+-- - 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.
--
@@ -130,7 +130,7 @@ makeTemplate vec ==
--called at instantiation time by setLoadTime
--the form ['makeTemplate,MKQ $template] is recorded by compDefineFunctor1
-- $template is set below in NRTdescendCodeTran and NRTaddDeltaOpt
- newVec := GETREFV SIZE vec
+ newVec := newDomainShell SIZE vec
for index in 0..MAXINDEX vec repeat
item := vec.index
null item => nil
@@ -192,7 +192,7 @@ putPredHash pred == --pred MUST have had addConsDB applied to it
extendVectorSize v ==
n:= MAXINDEX v
m:= (7*n)/5 -- make 40% longer
- newVec := GETREFV m
+ newVec := newDomainShell m
for i in 0..n repeat newVec.i := v.i
newVec
@@ -200,7 +200,7 @@ mkSigPredVectors() ==
$predHash:= MAKE_-HASHTABLE 'UEQUAL
$consDB:= MAKE_-HASHTABLE 'UEQUAL
$predVectorFrontier:= 1 --slot 0 in vector will be vacant
- $predVector:= GETREFV 100
+ $predVector:= newDomainShell 100
for nam in allConstructors() |
null (GETDATABASE(nam, 'CONSTRUCTORKIND) = 'package) repeat
for [op,:sigList] in GETDATABASE(nam,'OPERATIONALIST) repeat
@@ -210,7 +210,7 @@ mkSigPredVectors() ==
'done
list2LongerVec(u,n) ==
- vec := GETREFV ((7*n)/5) -- make 40% longer
+ vec := newDomainShell ((7*n)/5) -- make 40% longer
for i in 0.. for x in u repeat vec.i := x
vec
@@ -305,29 +305,6 @@ assignSlotToPred cond ==
cond is ['NOT,u] => ['NOT,assignSlotToPred u]
thisNeedsTOBeFilledIn()
-
-measure() ==
- pp MEASURE (f := SparseUnivariatePolynomial_;)
- pp MEASURE (o := SparseUnivariatePolynomial_;opDirect)
- pp MEASURE (t := SparseUnivariatePolynomial_;template)
- pp measureCommon [o,t]
- MEASURE [f,o,t]
-
-measureCommon u ==
---measures bytes which ARE on $consDB
- $table: local := MAKE_-HASHTABLE 'UEQUAL
- fn(u,0) where fn(u,n) == n +
- VECP u => +/[fn(u.i,0) for i in 0..MAXINDEX u]
- HASH_-TABLE_-P u =>
- +/[fn(key,0) + fn(HGET(u,key),0) for key in HKEYS u]
- PAIRP u =>
- HGET($table,u) => 0
- m := fn(first u,0) + fn(rest u,0)
- HGET($consDB,u) => 8 + m
- HPUT($table,u,'T)
- m
- 0
-
makeSpadConstant [fn,dollar,slot] ==
val := FUNCALL(fn,dollar)
u:= dollar.slot
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index 72d6166d..92b17621 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -1,4 +1,4 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
@@ -15,7 +15,7 @@
;; the documentation and/or other materials provided with the
;; distribution.
;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;; - 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.
;;
@@ -57,8 +57,6 @@
(import-module "parsing")
(in-package "BOOT")
-(export '($directory-list $current-directory reroot
- |makeAbsoluteFilename| |$msgDatabaseName| |$defaultMsgDatabaseName|))
(defun our-write-date (file) (and #+kcl (probe-file file)
(file-write-date file)))
@@ -85,30 +83,12 @@
direc))))
(defun interp-make-directory (direc)
- (setq direc (namestring direc))
- (if (string= direc "") $current-directory
- (if (or (memq :unix *features*)
- (memq 'unix *features*))
- (progn
- (if (char/= (char $current-directory (1-(length $current-directory))) #\/)
- (setq $current-directory (concat $current-directory "/")))
- (if (char/= (char direc 0) #\/)
- (setq direc (concat $current-directory direc)))
- (if (char/= (char direc (1- (length direc))) #\/)
- (setq direc (concat direc "/")))
- direc)
- (progn ;; Assume Windows conventions
- (if (not (or (char= (char $current-directory (1- (length $current-directory))) #\/)
- (char= (char $current-directory (1- (length $current-directory))) #\\ )))
- (setq $current-directory (concat $current-directory "\\")))
- (if (not (or (char= (char direc 0) #\/)
- (char= (char direc 0) #\\)
- (find #\: direc)))
- (setq direc (concat $current-directory direc)))
- (if (not (or (char= (char direc (1- (length direc))) #\/)
- (char= (char direc (1- (length direc))) #\\ )))
- (setq direc (concat direc "\\")))
- direc))))
+ (let ((current-dir (get-current-directory)))
+ (setq direc (namestring direc))
+ (|ensureTrailingSlash|
+ (if (string= direc "")
+ current-dir
+ (concat (|ensureTrailingSlash| current-dir direc))))))
;; Various lisps use different ``extensions'' on the filename to indicate
;; that a file has been compiled. We set this variable correctly depending
@@ -148,22 +128,6 @@
#'(lambda (fname) (spad fname (concat (pathname-name fname) ".out")))
files)))
-(defun fe (function file &optional (compflag nil) &aux (fn (pathname-name file)))
- (let ((tbootfile (concat "/tmp/" fn ".boot"))
- (tlispfile (concat "/tmp/" fn ".lisp")))
- (system::run-aix-program "fc"
- :arguments (list (string function)
- (namestring
- (merge-pathnames file
- (concat (|systemRootDirectory|)
- "nboot/.boot"))))
- :if-output-exists :supersede :output tbootfile)
- (boot tbootfile tlispfile)
- (if compflag (progn (compile-file tlispfile)
- (load (make-pathname :type *bin-path* :defaults tlispfile)))
- (load tlispfile))))
-(defun fc (function file) (fe function file t))
-
;; This function will compile any lisp code that has changed in a directory.
(defun recompile-directory (dir)
(let* ((direc (make-directory dir))
@@ -402,7 +366,6 @@
(in-package "BOOT")
(let (*print-level* *print-length* (fn (pathname-name file))
(bootfile (merge-pathnames file (concat (|systemRootDirectory|) "nboot/.boot"))))
- (declare (special *print-level* *print-length*))
(boot bootfile (make-pathname :type "lisp" :defaults bootfile))))
@@ -427,28 +390,29 @@
;; directory from the current {\bf AXIOM} shell variable.
(defvar $relative-library-directory-list '("/algebra/"))
-(in-package "OLD-BOOT")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ #-:GCL (defpackage "OLD-BOOT")
+ #+:GCL (in-package "OLD-BOOT"))
-(defun boot (file) ;; translates a single boot file
-#+:CCL
- (setq *package* (find-package "BOOT"))
+(defun
+#-:GCL old-boot::boot ;; translates a single boot file
+#+:GCL boot
+ (file)
#+:AKCL
(in-package "BOOT")
(let (*print-level*
*print-length*
(fn (pathname-name file))
(*print-pretty* t))
- (declare (special *print-level* *print-length*))
(boot::boot
file
(merge-pathnames (make-pathname :type "clisp") file))))
-
-(in-package "BOOT")
+#+:GCL (in-package "BOOT")
;; This is a little used subsystem to generate {\bf ALDOR} code
;; from {\bf Spad} code. Frankly, I'd be amazed if it worked.
-(setq translate-functions '(
+(defparameter translate-functions '(
;; .spad to .as translator, in particular
;; loadtranslate
|spad2AsTranslatorAutoloadOnceTrigger|
@@ -458,7 +422,7 @@
;; if you compile a {\bf .as} file rather than a {\bf .spad} file.
;; {\bf ALDOR} is an external compiler that gets automatically called
;; if the file extension is {\bf .as}.
-(setq asauto-functions '(
+(defparameter asauto-functions '(
loadas
;; |as| ;; now in as.boot
;; |astran| ;; now in as.boot
@@ -474,7 +438,7 @@
;; These are some {\bf debugging} functions that I use. I can't imagine
;; why you might autoload them but they don't need to be in a running
;; system.
-(setq debug-functions '(
+(defparameter debug-functions '(
loaddebug
|showSummary|
|showPredicates|
@@ -606,11 +570,11 @@
;; the following are for conditional reading
-#+:ieee-floating-point (setq $ieee t)
-#-:ieee-floating-point (setq $ieee nil)
-(setq |$opSysName| '"shell")
-#+:CCL (defun machine-type () "unknown")
-(setq |$machineType| (machine-type))
+#+:ieee-floating-point (defparameter $ieee t)
+#-:ieee-floating-point (defparameter $ieee nil)
+(defparameter |$opSysName| '"shell")
+
+(defconstant |$machineType| (machine-type))
; spad-clear-input patches around fact that akcl clear-input leaves newlines chars
(defun spad-clear-input (st) (clear-input st) (if (listen st) (read-char st)))
@@ -831,7 +795,7 @@
;; of the exposed constructors, is consistent with the actual libraries.
(defun libcheck (int)
"check that INTERP.EXPOSED and NRLIBs are consistent"
- (let (interp nrlibs)
+ (let (interp nrlibs abbrevs srcabbrevs srcconstructors constructors)
(labels (
(CONSTRUCTORNAME (nrlib)
"find the long name of a constructor given an abbreviation string"
@@ -907,7 +871,7 @@
(setq start (position #\space expr :from-end t :test #'char=)))
(throw 'done (string-trim '(#\space) (subseq expr start)))))))))
(SRCABBREVS (sourcefile)
- (let (in expr start end names longnames)
+ (let (in expr start end names longnames point mark)
(catch 'done
(with-open-file (in sourcefile)
(loop
@@ -924,7 +888,7 @@
(push (string-trim '(#\space) (subseq expr mark point)) names)))))
(values names longnames)))
(SRCSCAN ()
- (let (longnames names)
+ (let (longnames names spads long short)
(|changeDirectory| int)
(setq spads (directory "*.spad"))
(dolist (spad spads)
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index ddfc83ba..db6fc45b 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -1,4 +1,4 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+;; Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
;; All rights reserved.
;; Copyright (C) 2007-2008, Gabriel Dos Reis.
;; All rights reserved.
@@ -15,7 +15,7 @@
;; the documentation and/or other materials provided with the
;; distribution.
;;
-;; - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+;; - 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.
;;
@@ -990,7 +990,8 @@
(defun MAKE-VEC (n) (make-array n))
-(define-function 'GETREFV #'make-array)
+(defun GETREFV (n)
+ (make-array n :initial-element nil))
(defun LIST2VEC (list)
(if (consp list)
@@ -1559,7 +1560,8 @@
(declare (ignore width) (ignore recnum))
(cond ((numberp filespec) (make-synonym-stream '*terminal-io*))
((null filespec) (error "not handled yet"))
- (t (open (make-filename filespec) :direction :output))))
+ (t (open (make-filename filespec) :direction :output
+ :if-exists :supersede))))
(defun MAKE-APPENDSTREAM (filespec &optional (width nil) (recnum 0))
"fortran support"