diff options
author | dos-reis <gdr@axiomatics.org> | 2008-03-25 04:07:32 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-03-25 04:07:32 +0000 |
commit | daed04c57b8ff8c3be53a5a183635c5687ab7bf6 (patch) | |
tree | be75f9d45dbdb2004578ad6b3c5c25b7e22803e6 /src/interp | |
parent | 55893dcd3118428f046d5f539d80e9aa5345b885 (diff) | |
download | open-axiom-daed04c57b8ff8c3be53a5a183635c5687ab7bf6.tar.gz |
* 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.
Diffstat (limited to 'src/interp')
-rw-r--r-- | src/interp/Makefile.in | 8 | ||||
-rw-r--r-- | src/interp/Makefile.pamphlet | 8 | ||||
-rw-r--r-- | src/interp/boot-pkg.lisp | 7 | ||||
-rw-r--r-- | src/interp/br-saturn.boot | 2 | ||||
-rw-r--r-- | src/interp/buildom.boot | 4 | ||||
-rw-r--r-- | src/interp/daase.lisp | 19 | ||||
-rw-r--r-- | src/interp/debug.lisp | 16 | ||||
-rw-r--r-- | src/interp/diagnostics.boot | 1 | ||||
-rw-r--r-- | src/interp/fortcall.boot | 6 | ||||
-rw-r--r-- | src/interp/hash.lisp | 6 | ||||
-rw-r--r-- | src/interp/ht-util.boot | 6 | ||||
-rw-r--r-- | src/interp/i-output.boot | 14 | ||||
-rw-r--r-- | src/interp/macros.lisp | 2 | ||||
-rw-r--r-- | src/interp/patches.lisp | 6 | ||||
-rw-r--r-- | src/interp/pf2atree.boot | 2 | ||||
-rw-r--r-- | src/interp/pf2sex.boot | 2 | ||||
-rw-r--r-- | src/interp/server.boot | 4 | ||||
-rw-r--r-- | src/interp/slam.boot | 4 | ||||
-rw-r--r-- | src/interp/sys-globals.boot | 31 | ||||
-rw-r--r-- | src/interp/vmlisp.lisp | 18 |
20 files changed, 86 insertions, 80 deletions
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)) |