aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog30
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/interp/Makefile.in8
-rw-r--r--src/interp/Makefile.pamphlet8
-rw-r--r--src/interp/boot-pkg.lisp7
-rw-r--r--src/interp/br-saturn.boot2
-rw-r--r--src/interp/buildom.boot4
-rw-r--r--src/interp/daase.lisp19
-rw-r--r--src/interp/debug.lisp16
-rw-r--r--src/interp/diagnostics.boot1
-rw-r--r--src/interp/fortcall.boot6
-rw-r--r--src/interp/hash.lisp6
-rw-r--r--src/interp/ht-util.boot6
-rw-r--r--src/interp/i-output.boot14
-rw-r--r--src/interp/macros.lisp2
-rw-r--r--src/interp/patches.lisp6
-rw-r--r--src/interp/pf2atree.boot2
-rw-r--r--src/interp/pf2sex.boot2
-rw-r--r--src/interp/server.boot4
-rw-r--r--src/interp/slam.boot4
-rw-r--r--src/interp/sys-globals.boot31
-rw-r--r--src/interp/vmlisp.lisp18
22 files changed, 117 insertions, 80 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 0a69a7cd..df65100f 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,35 @@
2008-03-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/vmlisp.lisp (DEFINE-FUNCTION): Move boot-pkg.lisp.
+ (BPINAME): Tidy.
+ * interp/slam.boot (reportFunctionCompilation): Tidy.
+ * interp/daase.lisp: Don't use anachronistic SET.
+ * interp/debug.lisp: Likewise.
+ * interp/br-saturn.boot: Substitute GENSYM for GENTEMP.
+ * interp/fortcall.boot: Likewise.
+ * interp/ht-util.boot: Likewise.
+ * interp/pf2sex.boot: Likewise.
+ * interp/server.boot: Likewise.
+ * interp/buildom.boot (UnionEqual): Tidy.
+ (coerceUn2E): Likewise.
+ * interp/boot-pkg.lisp (define-function): Define here.
+ * interp/Makefile.pamphlet (diagnostics.$(FASLEXT)): Tidy.
+ (hash.$(FASLEXT)): Likewise.
+ (vmlisp.$(FASLEXT)): Likewise.
+ * interp/diagnostics.boot: Import "types".
+ * interp/hash.lisp: Import "types" instead of "vmlisp".
+ * interp/i-output.boot ($algebraOutput): Move to sys-globals.boot.
+ (ERROROUTSTREAM): Likewise.
+ (ERRORINSTREAM): Likewise.
+ * interp/macros.lisp ($algebraOutputStream): Don't set here.
+ * interp/patches.lisp ($algebraOutputStream): Don't set here.
+ ($texOutputStream): Likewise.
+ ($fortranOutputStream): Likewise.
+ ($texOutputStream): Likewise.
+ ($formulaOutputStream): Likewise.
+
+2008-03-24 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
Add support for SBCL and CLisp.
* src/share/algebra: Updata databases.
* lisp/core.lisp.in ("AxiomCore"): Export CONCAT.
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index d3b9d2e0..62d826ff 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -227,6 +227,7 @@ for i in [ _
]
repeat SETF (GET(CAR i,'SHOETHETA),CDR i)
+
for i in [ _
["and", "AND"] , _
["append", "APPEND"] , _
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index fe8f7a2a..a66c5dad 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -719,8 +719,8 @@ sys-macros.$(FASLEXT): sys-macros.lisp diagnostics.$(FASLEXT) \
union.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
-diagnostics.$(FASLEXT): diagnostics.boot sys-constants.$(FASLEXT) \
- sys-globals.$(FASLEXT)
+diagnostics.$(FASLEXT): diagnostics.boot sys-globals.$(FASLEXT) \
+ vmlisp.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
sys-driver.$(FASLEXT): sys-driver.boot types.$(FASLEXT)
@@ -733,7 +733,7 @@ sys-globals.$(FASLEXT): sys-globals.boot sys-constants.$(FASLEXT) \
sys-constants.$(FASLEXT): sys-constants.boot types.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
-hash.$(FASLEXT): hash.lisp vmlisp.$(FASLEXT)
+hash.$(FASLEXT): hash.lisp types.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
union.$(FASLEXT): union.lisp vmlisp.$(FASLEXT)
@@ -751,7 +751,7 @@ foam_l.$(FASLEXT): foam_l.lisp vmlisp.$(FASLEXT)
sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) sys-os.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
-vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT)
+vmlisp.$(FASLEXT): vmlisp.lisp types.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
sys-os.$(FASLEXT): sys-os.boot types.$(FASLEXT) \
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index d4a82cee..378c6155 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -1021,8 +1021,8 @@ sys-macros.$(FASLEXT): sys-macros.lisp diagnostics.$(FASLEXT) \
union.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
-diagnostics.$(FASLEXT): diagnostics.boot sys-constants.$(FASLEXT) \
- sys-globals.$(FASLEXT)
+diagnostics.$(FASLEXT): diagnostics.boot sys-globals.$(FASLEXT) \
+ vmlisp.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
sys-driver.$(FASLEXT): sys-driver.boot types.$(FASLEXT)
@@ -1035,7 +1035,7 @@ sys-globals.$(FASLEXT): sys-globals.boot sys-constants.$(FASLEXT) \
sys-constants.$(FASLEXT): sys-constants.boot types.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
-hash.$(FASLEXT): hash.lisp vmlisp.$(FASLEXT)
+hash.$(FASLEXT): hash.lisp types.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
union.$(FASLEXT): union.lisp vmlisp.$(FASLEXT)
@@ -1053,7 +1053,7 @@ foam_l.$(FASLEXT): foam_l.lisp vmlisp.$(FASLEXT)
sys-utility.$(FASLEXT): sys-utility.boot vmlisp.$(FASLEXT) sys-os.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
-vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.$(FASLEXT)
+vmlisp.$(FASLEXT): vmlisp.lisp types.$(FASLEXT)
$(BOOTSYS) --compile --output=$@ --load-directory=. $<
sys-os.$(FASLEXT): sys-os.boot types.$(FASLEXT) \
diff --git a/src/interp/boot-pkg.lisp b/src/interp/boot-pkg.lisp
index 1454ba18..95c14b2f 100644
--- a/src/interp/boot-pkg.lisp
+++ b/src/interp/boot-pkg.lisp
@@ -44,6 +44,13 @@
"loadSystemRuntimeCore"))
(in-package "BOOT")
+
+(eval-when
+ #+:common-lisp (:compile-toplevel :load-toplevel :execute)
+ #-:common-lisp (compile load eval)
+ (defun define-function (f v)
+ (setf (symbol-function f) v)))
+
;; Below are some missing functions. There here for lack of better
;; place (sys-funs.lisp?)
diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot
index 51f61968..fe38e3cb 100644
--- a/src/interp/br-saturn.boot
+++ b/src/interp/br-saturn.boot
@@ -631,7 +631,7 @@ htInitPageNoHeading(propList) ==
--------------------> NEW DEFINITION <--------------------------
htpMakeEmptyPage(propList,:options) ==
- name := IFCAR options or GENTEMP()
+ name := IFCAR options or GENSYM()
if not $saturn then
$activePageList := [name, :$activePageList]
setDynamicBinding(name, val := VECTOR(name, nil, nil, nil, nil, nil, propList, nil))
diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot
index a264223b..f1ec268a 100644
--- a/src/interp/buildom.boot
+++ b/src/interp/buildom.boot
@@ -152,7 +152,7 @@ UnionEqual(x, y, dom) ==
predlist := mkPredList branches
same := false
for b in stripUnionTags branches for p in predlist while not same repeat
- typeFun := eval ["LAMBDA", '(_#1), p]
+ typeFun := COERCE(["LAMBDA", '(_#1), p],"FUNCTION")
FUNCALL(typeFun,x) and FUNCALL(typeFun,y) =>
STRINGP b => same := (x = y)
if p is ["EQCAR", :.] then (x := rest x; y := rest y)
@@ -167,7 +167,7 @@ coerceUn2E(x,source) ==
predlist := mkPredList branches
byGeorge := byJane := GENSYM()
for b in stripUnionTags branches for p in predlist repeat
- typeFun := eval ["LAMBDA", '(_#1), p]
+ typeFun := COERCE(["LAMBDA", '(_#1), p],"FUNCTION")
if FUNCALL(typeFun,x) then return
if p is ["EQCAR", :.] then x := rest x
-- STRINGP b => return x -- to catch "failed" etc.
diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp
index 59b36516..8c2efb59 100644
--- a/src/interp/daase.lisp
+++ b/src/interp/daase.lisp
@@ -1462,10 +1462,10 @@
;; (if sourcefile
;; (set (foam::axiomxl-file-init-name (pathname-name sourcefile))
;; NOPfuncall))))
- (set (foam::axiomxl-file-init-name "axiom") NOPfuncall)
+ (setf (symbol-value (foam::axiomxl-file-init-name "axiom")) NOPfuncall)
;; (set (foam::axiomxl-file-init-name "axclique") NOPfuncall)
- (set (foam::axiomxl-file-init-name "filecliq") NOPfuncall)
- (set (foam::axiomxl-file-init-name "attrib") NOPfuncall)
+ (setf (symbol-value (foam::axiomxl-file-init-name "filecliq")) NOPfuncall)
+ (setf (symbol-value (foam::axiomxl-file-init-name "attrib")) NOPfuncall)
;; following needs to happen inside restart since $AXIOM may change
(let ((asharprootlib (strconc (|systemRootDirectory|) "/aldor/lib/")))
(set-file-getter (strconc asharprootlib "runtime"))
@@ -1622,7 +1622,7 @@
#+:CCL
(defun asharpMkAutoLoadFunction (file asharpname)
- (set asharpname
+ (setf (symbol-value asharpname)
(cons
`(lambda (&rest l)
(let ((args (butlast l))
@@ -1632,7 +1632,7 @@
#-:CCL
(defun asharpMkAutoLoadFunction (file asharpname)
- (set asharpname
+ (setf (symbol-value asharpname)
(cons
#'(lambda (&rest l)
(let ((args (butlast l))
@@ -1650,7 +1650,7 @@
(defun set-file-getter (filename)
(let ((getter-name (file-getter-name filename)))
- (set getter-name
+ (setf (symbol-value getter-name)
(cons #'init-file-getter (cons getter-name filename)))))
(defun init-file-getter (env)
@@ -1664,7 +1664,7 @@
(defun set-lib-file-getter (filename cname)
(let ((getter-name (file-getter-name filename)))
- (set getter-name
+ (setf (symbol-value getter-name)
(cons #'init-lib-file-getter (cons getter-name cname)))))
(defun init-lib-file-getter (env)
@@ -1689,12 +1689,13 @@
(error (format nil "AxiomXL file ~s is missing!" stringname)))
(unless (or (not (numberp hcode)) (zerop hcode) (boundp asharpname))
(when (|constructor?| bootname)
- (set asharpname
+ (setf (symbol-value asharpname)
(if (getdatabase bootname 'niladic)
(|makeLazyOldAxiomDispatchDomain| (list bootname))
(cons '|runOldAxiomFunctor| bootname))))
(when (|attribute?| bootname)
- (set asharpname (|makeLazyOldAxiomDispatchDomain| bootname))))))
+ (setf (symbol-value asharpname)
+ (|makeLazyOldAxiomDispatchDomain| bootname))))))
diff --git a/src/interp/debug.lisp b/src/interp/debug.lisp
index 95d2145d..60be95ec 100644
--- a/src/interp/debug.lisp
+++ b/src/interp/debug.lisp
@@ -549,7 +549,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(SETQ WITHIN_CONDITION T)
(COND ((SETQ U (/GETTRACEOPTIONS OPTIONS 'WITHIN))
(SETQ G (INTERN (STRCONC (PNAME FN) "/" (PNAME (CADR U)))))
- (SET G 0)
+ (SETF (SYMBOL-VALUE G) 0)
(/TRACE-1
(LIST (CADR U))
`((WHEN NIL)
@@ -695,9 +695,9 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(SETQ |$letAssoc| (DELASC X |$letAssoc|))
(setq Y (if (IS_GENVAR X) (|devaluate| (EVAL X)) X))
(SETQ /TIMERLIST (REMOVE (STRINGIMAGE Y) /TIMERLIST :test 'equal))
- (SET (INTERN (STRCONC Y ",TIMER")) 0)
+ (SETF (SYMBOL-VALUE (INTERN (STRCONC Y ",TIMER"))) 0)
(SETQ /COUNTLIST (REMOVE (STRINGIMAGE Y) /COUNTLIST :test 'equal))
- (SET (INTERN (STRCONC Y ",COUNT")) 0)
+ (SETF (SYMBOL-VALUE (INTERN (STRCONC Y ",COUNT"))) 0)
(COND ((AND |$traceNoisely| (NOT (|isSubForRedundantMapName| Y)))
(|sayBrightly|
(LIST '|%b| (|rassocSub| Y |$mapSubNameAlist|)
@@ -944,8 +944,8 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(dcq (G1 TRACECODE BEFORE AFTER CONDITION TIMERNAM COUNTNAM TRACENAME BREAK) G5)
(SETQ G4 (macro-function G1))
(SETQ TRACECODE (OR TRACECODE "119"))
- (if COUNTNAM (SET COUNTNAM 0))
- (if TIMERNAM (SET TIMERNAM 0))
+ (if COUNTNAM (SETF (SYMBOL-VALUE COUNTNAM) 0))
+ (if TIMERNAM (SETF (SYMBOL-VALUE TIMERNAM) 0))
(EMBED
G1
(LIST
@@ -988,7 +988,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(SETQ C (digit-char-p (elt TRACECODE 0))
V (digit-char-p (elt TRACECODE 1))
A (digit-char-p (elt TRACECODE 2)))
- (if COUNTNAM (SET COUNTNAM (1+ (EVAL COUNTNAM))))
+ (if COUNTNAM (SETF (SYMBOL-VALUE COUNTNAM) (1+ (EVAL COUNTNAM))))
(SETQ NAMEID (INTERN NAME))
(SETQ NOT_TOP_LEVEL (ASSOC NAMEID |depthAlist| :test #'eq))
(if (NOT NOT_TOP_LEVEL)
@@ -1033,7 +1033,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(|stopTimer|)
(if TIMERNAM (SETQ EVAL_TIME (- (|clock|) INIT_TIME)) )
(if (AND TIMERNAM (NOT NOT_TOP_LEVEL))
- (SET TIMERNAM (+ (EVAL TIMERNAM) EVAL_TIME)))
+ (SETF (SYMBOL-VALUE TIMERNAM) (+ (EVAL TIMERNAM) EVAL_TIME)))
(if AFTER (MONITOR-EVALAFTER AFTER))
(if (AND YES |$TraceFlag|)
(PROG (|$TraceFlag|)
@@ -1086,7 +1086,7 @@ EXAMINE (SETQ RECNO (NOTE INPUTSTREAM))
(defun BPITRACE (BPI ALIAS &optional OPTIONS)
(let ((NEWNAME (GENSYM)))
(IF (identp bpi) (setq bpi (symbol-function bpi)))
- (SET NEWNAME BPI)
+ (SETF (SYMBOL-VALUE NEWNAME) BPI)
(SETF (symbol-function NEWNAME) BPI)
(/TRACE-0 (APPEND (LIST NEWNAME (LIST 'ALIAS ALIAS)) OPTIONS))
NEWNAME))
diff --git a/src/interp/diagnostics.boot b/src/interp/diagnostics.boot
index 6d9496f8..c679cf4c 100644
--- a/src/interp/diagnostics.boot
+++ b/src/interp/diagnostics.boot
@@ -40,6 +40,7 @@
import '"sys-constants"
import '"sys-globals"
+import '"vmlisp"
)package "BOOT"
diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot
index 4d7fa940..43dda14a 100644
--- a/src/interp/fortcall.boot
+++ b/src/interp/fortcall.boot
@@ -318,7 +318,7 @@ makeSpadFun(name,userArgs,args,dummies,decls,results,returnType,asps,aspInfo,
[["$elt","Lisp","construct"],:mkQuote results],resPar]
if asps then
-- Make a unique(ish) id for asp files
- aspId := STRCONC(getEnv('"SPADNUM"), GENTEMP('"NAG"))
+ aspId := STRCONC(getEnv('"SPADNUM"), GENSYM('"NAG"))
body := ["SEQ",:makeAspGenerators(asps,aspTypes,aspId),_
makeCompilation(asps,file,aspId),_
["pretend",call,fType] ]
@@ -670,9 +670,9 @@ readData(tmpFile,results) ==
results
generateDataName()==STRCONC($fortranTmpDir,getEnv('"HOST"),
- getEnv('"SPADNUM"), GENTEMP('"NAG"),'"data")
+ getEnv('"SPADNUM"), GENSYM('"NAG"),'"data")
generateResultsName()==STRCONC($fortranTmpDir,getEnv('"HOST"),
- getEnv('"SPADNUM"), GENTEMP('"NAG"),'"results")
+ getEnv('"SPADNUM"), GENSYM('"NAG"),'"results")
fortCall(objFile,data,results) ==
diff --git a/src/interp/hash.lisp b/src/interp/hash.lisp
index b462a621..b9f3463e 100644
--- a/src/interp/hash.lisp
+++ b/src/interp/hash.lisp
@@ -32,13 +32,9 @@
;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-(IMPORT-MODULE "vmlisp")
+(IMPORT-MODULE "types")
(in-package "BOOT")
-(export '(MAKE-HASHTABLE HGET HKEYS HCOUNT HPUT HPUT* HREM HCLEAR HREMPROP
- HASHEQ HASHUEQUAL HASHCVEC HASHID HASHTABLEP CVEC UEQUAL ID HPUTPROP
- HASHTABLE-CLASS))
-
;17.0 Operations on Hashtables
;17.1 Creation
diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot
index e2e4e61c..d12eef90 100644
--- a/src/interp/ht-util.boot
+++ b/src/interp/ht-util.boot
@@ -400,7 +400,7 @@ htBcLispLinks links ==
beforeAfter(x,u) == [[y for [y,:r] in tails u while x ^= y],r]
mkCurryFun(fun, val) ==
- name := GENTEMP()
+ name := GENSYM()
code :=
['DEFUN, name, '(arg), ['APPLY, MKQ fun, ['CONS, 'arg, MKQ val]]]
EVAL code
@@ -409,7 +409,7 @@ mkCurryFun(fun, val) ==
htRadioButtons [groupName, :buttons] ==
htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons],
: htpRadioButtonAlist $curPage])
- boxesName := GENTEMP()
+ boxesName := GENSYM()
iht ['"\newline\indent{5}\radioboxes{", boxesName,
'"}{\htbmfile{pick}}{\htbmfile{unpick}}\beginitems "]
defaultValue := '"1"
@@ -427,7 +427,7 @@ htRadioButtons [groupName, :buttons] ==
htBcRadioButtons [groupName, :buttons] ==
htpSetRadioButtonAlist($curPage, [[groupName, :buttonNames buttons],
: htpRadioButtonAlist $curPage])
- boxesName := GENTEMP()
+ boxesName := GENSYM()
iht ['"\radioboxes{", boxesName,
'"}{\htbmfile{pick}}{\htbmfile{unpick}} "]
defaultValue := '"1"
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 1ed56546..e1de03d9 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -213,19 +213,7 @@ MATBORCH == '"*"
_*TALLPAR := false
-$collectOutput := nil
-
-$algebraOutputStream :=
- DEFIOSTREAM([["DEVICE", :"CONSOLE"], ["MODE", :"OUTPUT"]], 255, 0)
-
-ERROROUTSTREAM :=
- DEFIOSTREAM([["DEVICE", :"CONSOLE"], ["MODE", :"OUTPUT"]], 80, 0)
-
-ERRORINSTREAM :=
- DEFIOSTREAM([["DEVICE", :"CONSOLE"], ["MODE", :"INPUT"],
- ["QUAL", :"T"]], 133, 1)
-
-
+$collectOutput := false
specialChar(symbol) ==
-- looks up symbol in $specialCharacterAlist, gets the index
diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp
index 0a61c975..922fa3ad 100644
--- a/src/interp/macros.lisp
+++ b/src/interp/macros.lisp
@@ -418,8 +418,6 @@
(progn (BRIGHTPRINT-0 X) (TERPRI) (force-output))
(progn (BRIGHTPRINT X) (TERPRI) (force-output))))
-(defvar |$algebraOutputStream| *standard-output*)
-
(defun |saySpadMsg| (X)
(if (NULL X) NIL (sayBrightly1 X |$algebraOutputStream|)))
diff --git a/src/interp/patches.lisp b/src/interp/patches.lisp
index 0c651acf..ad744c3a 100644
--- a/src/interp/patches.lisp
+++ b/src/interp/patches.lisp
@@ -130,12 +130,6 @@
(defun /EF (&rest foo)
(obey (concat "vi " (namestring (make-input-filename /EDITFILE)))))
-(setq |$algebraOutputStream|
- (setq |$fortranOutputStream|
- (setq |$texOutputStream|
- (setq |$formulaOutputStream|
- (setq |conOutStream|'*standard-output*)))))
-
;; non-interactive restarts...
(defun restart0 ()
(compressopen);; set up the compression tables
diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot
index 56d7a832..c3995a5e 100644
--- a/src/interp/pf2atree.boot
+++ b/src/interp/pf2atree.boot
@@ -547,7 +547,7 @@ pfCollect2Atree pf ==
--
-- pfSuchThat2Atree args ==
--- name := GENTEMP()
+-- name := GENSYM()
-- argList := pf0TupleParts args
-- lhsSex := pf2Atree1 CAR argList
-- rhsSex := pf2Atree CADR argList
diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot
index 0f82c889..122edc5e 100644
--- a/src/interp/pf2sex.boot
+++ b/src/interp/pf2sex.boot
@@ -472,7 +472,7 @@ pfRhsRule2Sex rhs ==
pf2Sex1 rhs
pfSuchThat2Sex args ==
- name := GENTEMP()
+ name := GENSYM()
argList := pf0TupleParts args
lhsSex := pf2Sex1 CAR argList
rhsSex := pf2Sex CADR argList
diff --git a/src/interp/server.boot b/src/interp/server.boot
index f7b78cfe..0462a5d4 100644
--- a/src/interp/server.boot
+++ b/src/interp/server.boot
@@ -64,7 +64,7 @@ serverReadLine(stream) ==
$NeedToSignalSessionManager := true
return l
action = $CreateFrame =>
- frameName := GENTEMP('"frame")
+ frameName := GENSYM('"frame")
addNewInterpreterFrame(frameName)
$frameAlist := [[$frameNumber,:frameName], :$frameAlist]
$currentFrameNum := $frameNumber
@@ -136,7 +136,7 @@ serverLoop() ==
FINISH_-OUTPUT()
sockSendInt($SessionManager, $EndOfOutput)
action = $CreateFrame =>
- frameName := GENTEMP('"frame")
+ frameName := GENSYM('"frame")
addNewInterpreterFrame(frameName)
$frameAlist := [[$frameNumber,:frameName], :$frameAlist]
$currentFrameNum := $frameNumber
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 835c74f6..c616b3f2 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -57,8 +57,8 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
cacheCount:= getCacheCount op
cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
cacheCount = 0 or null argl =>
- function:= [nam,["LAMBDA",[:argl,'envArg],body]]
- compileInteractive function
+ fun:= [nam,["LAMBDA",[:argl,'envArg],body]]
+ compileInteractive fun
nam
num :=
FIXP cacheCount =>
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index fc922a64..4272ef81 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -357,9 +357,6 @@ $libraryDirectory := "A"
$listingDirectory := "A"
++
-$texOutputStream := MAKE_-SYNONYM_-STREAM '_*STANDARD_-OUTPUT_*
-
-++
$UserLevel := "development"
++
@@ -457,3 +454,31 @@ $m := nil
++ ???
_/SOURCEFILES := []
_/SPACELIST := []
+
+--%
+
+$algebraOutputStream :=
+ MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+
+ERROROUTSTREAM :=
+ MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+
+
+ERRORINSTREAM :=
+ MAKE_-SYNONYM_-STREAM "*STANDARD-INPUT*"
+
+++
+$texOutputStream := MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+
+$fortranOutputStream :=
+ MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+
+$formulaOutputStream :=
+ MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+
+conOutStream :=
+ MAKE_-SYNONYM_-STREAM "*STANDARD-OUTPUT*"
+
+
+
+
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index fe3bb374..eced41c2 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -31,7 +31,7 @@
;; 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")
+(IMPORT-MODULE "types")
; VM LISP EMULATION PACKAGE
; Lars Ericson, Barry Trager, Martial Schor, tim daly, LVMCL, et al
@@ -552,12 +552,6 @@
;; defuns
-(eval-when
- #+:common-lisp (:compile-toplevel :load-toplevel :execute)
- #-:common-lisp (compile load eval)
- (defun define-function (f v)
- (setf (symbol-function f) v)))
-
(define-function 'tempus-fugit #'get-internal-run-time)
(defun $TOTAL-ELAPSED-TIME ()
@@ -1867,10 +1861,12 @@
#+(or :SBCL :clisp)
(defun BPINAME (x)
- (multiple-value-bind (l c n)
- (function-lambda-expression x)
- (declare (ignore l c))
- n))
+ (if (symbolp x)
+ x
+ (multiple-value-bind (l c n)
+ (function-lambda-expression x)
+ (declare (ignore l c))
+ n)))
(defun LISTOFQUOTES (bpi)
(declare (ignore bpi))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-04 06:46:03 +0000