diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/interp/ChangeLog | 187 | ||||
-rw-r--r-- | src/interp/Makefile.in | 26 | ||||
-rw-r--r-- | src/interp/Makefile.pamphlet | 26 | ||||
-rw-r--r-- | src/interp/bootfuns.lisp.pamphlet | 156 | ||||
-rw-r--r-- | src/interp/bootlex.lisp.pamphlet | 11 | ||||
-rw-r--r-- | src/interp/diagnostics.boot | 55 | ||||
-rw-r--r-- | src/interp/g-error.boot.pamphlet | 3 | ||||
-rw-r--r-- | src/interp/macros.lisp.pamphlet | 4 | ||||
-rw-r--r-- | src/interp/msgdb.boot.pamphlet | 4 | ||||
-rw-r--r-- | src/interp/nag-f01.boot.pamphlet | 4 | ||||
-rw-r--r-- | src/interp/patches.lisp.pamphlet | 4 | ||||
-rw-r--r-- | src/interp/setq.lisp.pamphlet | 195 | ||||
-rw-r--r-- | src/interp/spad.lisp.pamphlet | 3 | ||||
-rw-r--r-- | src/interp/sys-constants.boot | 519 | ||||
-rw-r--r-- | src/interp/sys-globals.boot | 47 | ||||
-rw-r--r-- | src/interp/varini.boot.pamphlet | 3 |
16 files changed, 872 insertions, 375 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 0ec27d3e..0fa67d1c 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,190 @@ +2007-08-20 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * g-error.boot.pamphlet: Import "diagnostics. + (errorSupervisor1): Call BUMPERRORCOUNT, not BUMPCOMPERRORCOUNT. + The latter no longer exists. + * msgdb.boot.pamphlet (throwKeyedErrorMsg): Likewise. + + * Makefile.pamphlet (${DEPSYS}): Depend also on + sys-constant.$(FASLEXT), sys-globals.$(FASLEXT), and + diagnostics.$(FASLEXT). + (bootfuns.$(FASLEXT)): Likewise. + (diagnostics.boot): New rule. + (sys-globals.boot): Likewise. + (sys-constants.boot): Likewise. + * Makefile.in: Regenerate. + + * diagnostics.boot: New. + (BUMPERRORCOUNT): Move from bootlex.lisp.pamphlet. Rewrite as + Boot code. + + * sys-constants.boot: New. + * sys-globals.boot: Likewise. + + * bootlex.lisp.pamphlet (BUMPERRORCOUNT): Move to diagnostics.boot. + * varini.boot.pamphlet ($NoValueMode): Don't duplicate define. + + * spad.lisp.pamphlet (S-PROCESS): Don't bind $LocalFrame here. + + * patches.lisp.pamphlet: Tidy. + + * nag-f01.boot.pamphlet (f01mafSolve): Use $EmptyMode to refer to + the wildcar type. + (f01brfSolve): Likewise. + + + * setq.lisp.pamphlet: Move variables already defined in + bootfuns.lisp.pamphlet to sys-contants, and merge initial values. + + ($SPAD_ERRORS): Move to sys-globals.boot. + + * bootfuns.lisp.pamphlet: Now import both "sys-constants" and + "sys-globals". + (|$timerTicksPerSecond|): Move to sys-constants.boot. + (|$quadSymbol|): Likewise. + ($escapeString): Likewise. + ($boxString): Likewise. + ($boldString): Likewise. + ($normalString): Likewise. + ($reverseVideoString): Likewise. + ($underlineString): Likewise. + ($COMPILE): Likewise. + ($BasicPredicates): Likewise. + ($BFTag): Likewise. + ($BigFloat): Likewise. + ($Boolean): Likewise. + ($Category): Likewise. + ($CategoryNames): Likewise. + ($Domain): Likewise. + ($DomainNames): Likewise. + ($DomainsInScope): Likewise. + ($DoubleQuote): Likewise. + ($DummyFunctorNames): Likewise. + ($EmptyEnvironment): Likewise. + ($EmptyList): Likewise. + ($EmptyMode): Likewise. + ($EmptyString): Likewise. + ($EmptyVector): Likewise. + ($Expression): Likewise. + ($Exit): Likewise. + ($failure): Likewise. + ($Float): Likewise. + ($FormalMapVariableList): Likewise. + ($ConstructorNames): Likewise. + ($InitialDomainsInScope): Likewise. + ($InitialModemapFrame): Likewise. + ($Integer): Likewise. + ($LocalFrame): Likewise. + ($NegativeInteger): Likewise. + ($NonNegativeInteger): Likewise. + ($NonPositiveInteger): Likewise. + ($NonMentionableDomainNames): Likewise. + ($noParseCommands): Likewise. + ($NoValueMode): Likewise. + ($NoValue): Likewise. + ($Mode): Likewise. + ($ModeVariableList): Likewise. + ($One): Likewise. + ($PatternVariableList): Likewise. + ($PositiveInteger): Likewise. + ($PrimitiveDomainNames): Likewise. + ($RationalNumber): Likewise. + ($SideEffectFreeFunctionList): Likewise. + ($SmallInteger): Likewise. + ($SpecialDomainNames): Likewise. + ($StringCategory): Likewise. + ($String): Likewise. + ($Symbol): Likewise. + ($systemCommands): Likewise. + ($ThrowAwayMode): Likewise. + ($tokenCommands): Likewise. + ($true): Likeiwse. + ($underDomainAlist): Likewise. + ($Void): Likewise. + ($Zero): Likewise. + (|$DomainVariableList|): Likewise. + + (|$quadSym|): Remove. + ($BigFloatOpt): Likewise. + ($BooleanOpt): Likewise. + ($EM): Likewise. + ($ExpressionOpt): Likewise. + ($FloatOpt): Likewise. + ($FormalMapVariableList2): Likewise. + ($IntegerOpt): Likewise. + ($NegativeIntegerOpt): Likewise. + ($NonNegativeIntegerOpt): Likewise. + ($NonPositiveIntegerOpt): Likewise. + ($PositiveIntegerOpt): Likewise. + ($RationalNumberOpt): Likewise. + ($SmallIntegerOpt): Likewise. + ($StringOpt): Likewise. + ($SymbolOpt): Likewise. + + * setq.lisp.pamphlet (|$timerTicksPerSecond|): Remove. + (|$quadSymbol|): Likewise. + ($escapeString): Likewise. + ($boxString): Likewise. + ($boldString): Likewise. + ($normalString): Likewise. + ($reverseVideoString): Likewise. + ($underlineString): Likewise. + ($COMPILE): Likewise. + ($BasicPredicates): Likewise. + ($BFTag): Likewise. + ($BigFloat): Likewise. + ($Boolean): Likewise. + ($Category): Likewise. + ($CategoryNames): Likewise. + ($Domain): Likewise. + ($DomainNames): Likewise. + ($DomainsInScope): Likewise. + ($DoubleQuote): Likewise. + ($DummyFunctorNames): Likewise. + ($EmptyEnvironment): Likewise. + ($EmptyList): Likewise. + ($EmptyMode): Likewise. + ($EmptyString): Likewise. + ($EmptyVector): Likewise. + ($Expression): Likewise. + ($Exit): Likewise. + ($failure): Likewise. + ($Float): Likewise. + ($FormalMapVariableList): Likewise. + ($ConstructorNames): Likewise. + ($InitialDomainsInScope): Likewise. + ($InitialModemapFrame): Likewise. + ($Integer): Likewise. + ($LocalFrame): Likewise. + ($NegativeInteger): Likewise. + ($NonNegativeInteger): Likewise. + ($NonPositiveInteger): Likewise. + ($NonMentionableDomainNames): Likewise. + ($noParseCommands): Likewise. + ($NoValueMode): Likewise. + ($NoValue): Likewise. + ($Mode): Likewise. + ($ModeVariableList): Likewise. + ($One): Likewise. + ($PatternVariableList): Likewise. + ($PositiveInteger): Likewise. + ($PrimitiveDomainNames): Likewise. + ($RationalNumber): Likewise. + ($SideEffectFreeFunctionList): Likewise. + ($SmallInteger): Likewise. + ($SpecialDomainNames): Likewise. + ($StringCategory): Likewise. + ($String): Likewise. + ($Symbol): Likewise. + ($systemCommands): Likewise. + ($ThrowAwayMode): Likewise. + ($tokenCommands): Likewise. + ($true): Likeiwse. + ($underDomainAlist): Likewise. + ($Void): Likewise. + ($Zero): Likewise. + (|$DomainVariableList|): Likewise. + 2007-08-19 Gabriel Dos Reis <gdr@cs.tamu.edu> * boot-pkg.lisp: New. diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 4c58aeab..5e4c168b 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -53,6 +53,7 @@ AXIOMSYS= $(axiom_target_bindir)/AXIOMsys$(EXEEXT) DEBUGSYS=$(axiom_build_bindir)/debugsys$(EXEEXT) OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ + diagnostics.$(FASLEXT) \ bootfuns.$(FASLEXT) macros.$(FASLEXT) \ unlisp.$(FASLEXT) setq.$(FASLEXT) \ astr.$(FASLEXT) bits.$(FASLEXT) \ @@ -344,6 +345,9 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ ggreater.$(FASLEXT) \ union.$(FASLEXT) \ boot-pkg.$(FASLEXT) \ + sys-constants.$(FASLEXT) \ + sys-globals.$(FASLEXT) \ + diagnostics.$(FASLEXT) \ bootfuns.$(FASLEXT) \ ${DEP} \ nocompil.$(FASLEXT) \ @@ -425,7 +429,18 @@ bookvol5.$(FASLEXT): bookvol5.lisp boot-pkg.$(FASLEXT) nocompil.$(FASLEXT): nocompil.lisp boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< -bootfuns.$(FASLEXT): bootfuns.lisp hash.$(FASLEXT) boot-pkg.$(FASLEXT) +bootfuns.$(FASLEXT): bootfuns.lisp hash.$(FASLEXT) \ + sys-constants.$(FASLEXT) sys-globals.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +diagnostics.$(FASLEXT): diagnostics.boot sys-constants.$(FASLEXT) \ + sys-globals.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +sys-globals.$(FASLEXT): sys-globals.boot boot-pkg.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +sys-constants.$(FASLEXT): sys-constants.boot boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< boot-pkg.$(FASLEXT): boot-pkg.lisp vmlisp.$(FASLEXT) @@ -453,6 +468,15 @@ vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.lisp: $(srcdir)/boot-pkg.lisp cp $< $@ +diagnostics.boot: $(srcdir)/diagnostics.boot + cp $< $@ + +sys-globals.boot: $(srcdir)/sys-globals.boot + cp $< $@ + +sys-constants.boot: $(srcdir)/sys-constants.boot + cp $< $@ + .PHONY: all-axiomsys all-axiomsys: ${AXIOMSYS} diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index e20283fe..bc536bac 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -347,6 +347,7 @@ interpreted) in [[depsys]]. <<environment>>= OBJS= vmlisp.$(FASLEXT) hash.$(FASLEXT) \ + diagnostics.$(FASLEXT) \ bootfuns.$(FASLEXT) macros.$(FASLEXT) \ unlisp.$(FASLEXT) setq.$(FASLEXT) \ astr.$(FASLEXT) bits.$(FASLEXT) \ @@ -992,6 +993,9 @@ ${DEPSYS}: vmlisp.$(FASLEXT) \ ggreater.$(FASLEXT) \ union.$(FASLEXT) \ boot-pkg.$(FASLEXT) \ + sys-constants.$(FASLEXT) \ + sys-globals.$(FASLEXT) \ + diagnostics.$(FASLEXT) \ bootfuns.$(FASLEXT) \ ${DEP} \ nocompil.$(FASLEXT) \ @@ -1072,7 +1076,18 @@ bookvol5.$(FASLEXT): bookvol5.lisp boot-pkg.$(FASLEXT) nocompil.$(FASLEXT): nocompil.lisp boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< -bootfuns.$(FASLEXT): bootfuns.lisp hash.$(FASLEXT) boot-pkg.$(FASLEXT) +bootfuns.$(FASLEXT): bootfuns.lisp hash.$(FASLEXT) \ + sys-constants.$(FASLEXT) sys-globals.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +diagnostics.$(FASLEXT): diagnostics.boot sys-constants.$(FASLEXT) \ + sys-globals.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +sys-globals.$(FASLEXT): sys-globals.boot boot-pkg.$(FASLEXT) + $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< + +sys-constants.$(FASLEXT): sys-constants.boot boot-pkg.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< boot-pkg.$(FASLEXT): boot-pkg.lisp vmlisp.$(FASLEXT) @@ -1100,6 +1115,15 @@ vmlisp.$(FASLEXT): vmlisp.lisp boot-pkg.lisp: $(srcdir)/boot-pkg.lisp cp $< $@ +diagnostics.boot: $(srcdir)/diagnostics.boot + cp $< $@ + +sys-globals.boot: $(srcdir)/sys-globals.boot + cp $< $@ + +sys-constants.boot: $(srcdir)/sys-constants.boot + cp $< $@ + @ \section{Building SAVESYS and AXIOMSYS} diff --git a/src/interp/bootfuns.lisp.pamphlet b/src/interp/bootfuns.lisp.pamphlet index 33b953e7..2a7d5b90 100644 --- a/src/interp/bootfuns.lisp.pamphlet +++ b/src/interp/bootfuns.lisp.pamphlet @@ -62,7 +62,8 @@ interpreter or algebra uses has to (cough, cough) appear here. <<*>>= <<license>> -(IMPORT-MODULE "boot-pkg") +(IMPORT-MODULE "sys-constants") +(IMPORT-MODULE "sys-globals") @ @@ -71,21 +72,6 @@ interpreter use is called [[BOOT]]. It should have been [[Spad]], or better yet [[Axiom]]. -\section{Constants} - -\subsection{\$EmptyMode} - -[[$EmptyMode]] is a contant whose value is [[$EmptyMode]]. -It is used by [[isPartialMode]] (in [[i-funsel.boot]]) to -decide if a modemap is partially constructed. If the [[$EmptyMode]] -constant occurs anywhere in the modemap structure at any depth -then the modemap is still incomplete. To find this constant the -[[isPartialMode]] function calls [[CONTAINED |$EmptyMode| Y]] -which will walk the structure $Y$ looking for this constant. -<<EmptyMode>>= -(def-boot-val |$EmptyMode| '|$EmptyMode| "compiler constant") -@ - \section{Portability issues} @@ -123,28 +109,7 @@ offer it as extensions. (defparameter ,p ,val ,where) (export '(,p) "BOOT"))) -#-:CCL -(def-boot-val |$timerTicksPerSecond| INTERNAL-TIME-UNITS-PER-SECOND - "for TEMPUS-FUGIT and $TOTAL-ELAPSED-TIME") -#+:CCL -(def-boot-val |$timerTicksPerSecond| 1000 - "for TEMPUS-FUGIT and $TOTAL-ELAPSED-TIME") -(def-boot-val $boxString - (concatenate 'string (list (code-char #x1d) (code-char #xe2))) - "this string of 2 chars displays as a box") -(def-boot-val |$quadSymbol| $boxString "displays an APL quad") -(def-boot-val |$quadSym| '|$quadSym| "unbound symbol referenced in format.boot") -(def-boot-val $escapeString (string (code-char 27)) - "string for single escape character") -(def-boot-val $boldString (concatenate 'string $escapeString "[12m") - "switch into bold font") -(def-boot-val $normalString (concatenate 'string $escapeString "[0;10m") - "switch back into normal font") -(def-boot-val $reverseVideoString (concatenate 'string $escapeString "[7m") - "switch into reverse video") -(def-boot-val $underlineString (concatenate 'string $escapeString "[4m") - "switch into underline mode") -(def-boot-val $COMPILE t "checked in COMP-2 to skip compilation") + (def-boot-var |$abbreviationTable| "???") (def-boot-val |$algebraList| '(|QuotientField| |Polynomial| @@ -157,20 +122,12 @@ offer it as extensions. (def-boot-val |$BasicDomains| '(|Integer| |Float| |Symbol| |Boolean| |String|) "???") -(def-boot-val |$BasicPredicates| - '(FIXP STRINGP FLOATP) "???") -(def-boot-val |$BFtag| '-BF- "big float marker") -(def-boot-val |$BigFloat| '(|Float|) "???") -(def-boot-val |$BigFloatOpt| '(|BigFloat| . OPT) "???") -(def-boot-val |$Boolean| '(|Boolean|) "???") -(def-boot-val |$BooleanOpt| '(|Boolean| . OPT) "???") (def-boot-val |$bootStrapMode| () "if T compCapsule skips body") (def-boot-var |$brightenCommentsFlag| "???") (def-boot-var |$brightenCommentsIfTrue| "???") (def-boot-val |$BreakMode| '|query| "error.boot") (def-boot-var |$cacheAlist| "Interpreter>System.boot") (def-boot-val |$cacheCount| 0 "???") -(def-boot-val |$Category| '(|Category|) "???") ; modemap:== ( <map> (p e) (p e) ... (p e) ) ; modemaplist:= ( modemap ... ) @@ -181,10 +138,6 @@ offer it as extensions. (((|Category|) (|Category|) (|List| |Category|)) (|Category|)) (T *)) ))))) "Compiler>CUtil.boot") -(def-boot-val |$CategoryNames| - '(|Category| |CATEGORY| |RecordCategory| |Join| - |StringCategory| |SubsetCategory| |UnionCategory|) - "???") (def-boot-val |$clamList| '((|getModemapsFromDatabase| |hash| UEQUAL |count|) (|getOperationAlistFromLisplib| |hash| UEQUAL |count|) @@ -215,55 +168,20 @@ offer it as extensions. (def-boot-val $delay 0 "???") (def-boot-var $Directory "???") (def-boot-var $DISPLAY "???") -(def-boot-val |$Domain| '(|Domain|) "???") (def-boot-var |$DomainFrame| "???") -(def-boot-val |$DomainNames| - '(|Integer| |Float| |Symbol| |Boolean| - |String| |Expression| - |Mapping| |SubDomain| |List| |Union| - |Record| |Vector|) "???") -(def-boot-val |$DomainsInScope| '(NIL) "???") (def-boot-val |$domainTraceNameAssoc| () "association list of trace domains") -(def-boot-val |$DomainVariableList| - '($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 - $12 $13 $14 $15) "???") -(def-boot-val |$DoubleQuote| "\"" "???") -(def-boot-val |$DummyFunctorNames| - '(|Boolean| |Mapping|) "???") (def-boot-var |$eltIfNil| "SpecialFunctions>PSpad.boot") -(def-boot-val |$EmptyEnvironment| '((NIL)) "???") -(def-boot-val |$EmptyList| () "???") -<<EmptyMode>> -(def-boot-val |$EM| |$EmptyMode| "???") -(def-boot-val |$EmptyString| "" "???") -(def-boot-val |$EmptyVector| '#() "???") -(def-boot-val |$Expression| '(|Expression|) "???") -(def-boot-val |$ExpressionOpt| - '(|Expression| . OPT) "???") (def-boot-var |$evalDomain| "???") -(def-boot-val |$Exit| '(Exit) "compiler constant") (def-boot-var |$exitMode| "???") (def-boot-var |$exitModeStack| "???") -(def-boot-val |$failure| (GENSYM) "Symbol denoting a failed operation.") (def-boot-val |$false| NIL "???") -(def-boot-val |$Float| '(|Float|) "???") -(def-boot-val |$FloatOpt| '(|Float| . OPT) "???") (def-boot-val |$FontTable| '(|FontTable|) "???") (def-boot-var |$forceDatabaseUpdate| "See load function.") (def-boot-var |$form| "???") -(def-boot-val |$FormalMapVariableList| - '(\#1 \#2 \#3 \#4 \#5 \#6 \#7 \#8 \#9 - \#10 \#11 \#12 \#13 \#14 \#15) "???") -(def-boot-val |$FormalMapVariableList2| - '(\#\#1 \#\#2 \#\#3 \#\#4 \#\#5 \#\#6 \#\#7 \#\#8 \#\#9 - \#\#10 \#\#11 \#\#12 \#\#13 \#\#14 \#\#15) "???") (def-boot-var |$fromSpadTrace| "Interpreter>Trace.boot") (def-boot-var $function "Interpreter>System.boot") (def-boot-var $FunName "???") (def-boot-var $FunName_Tail "???") -(def-boot-val |$ConstructorNames| - '(|SubDomain| |List| |Union| |Record| |Vector|) - "Used in isFunctor test, and compDefine.") (def-boot-val |$gauss01| '(|gauss| 0 1) "???") (def-boot-var |$genFVar| "???") (def-boot-val |$genSDVar| 0 "counter for genSomeVariable" ) @@ -271,10 +189,6 @@ offer it as extensions. (def-boot-var |$hasYield| "???") (def-boot-var |$ignoreCommentsIfTrue| "???") (def-boot-var |$Index| "???") -(def-boot-val |$InitialDomainsInScope| - '((|Boolean|) |$EmptyMode| |$NoValueMode|) - "???") -(def-boot-val |$InitialModemapFrame| '((NIL)) "???") (def-boot-var |$inLispVM| "Interpreter>Eval.boot") (def-boot-var |$insideCapsuleFunctionIfTrue| "???") (def-boot-var |$insideCategoryIfTrue| "???") @@ -285,8 +199,6 @@ offer it as extensions. (def-boot-var |$insideFunctorIfTrue| "???") (def-boot-var |$insideWhereIfTrue| "???") (def-boot-val |$instantRecord| (MAKE-HASHTABLE 'ID) "???") -(def-boot-val |$Integer| '(|Integer|) "???") -(def-boot-val |$IntegerOpt| '(|Integer| . OPT) "???") (def-boot-val |$InteractiveFrame| '((NIL)) "top level environment") (def-boot-var |$InteractiveMode| "Interactive>System.boot") (def-boot-val |$InteractiveModemapFrame| '((NIL)) "???") @@ -313,44 +225,25 @@ offer it as extensions. (def-boot-var |$lisplibSignatureAlist| "Compiler>LispLib.boot") (def-boot-var |$lisplibVariableAlist| "Compiler>LispLib.boot") (def-boot-var |$lisp2lispRenameAssoc| "???") -(def-boot-val |$LocalFrame| '((NIL)) "???") (def-boot-var |$mapSubNameAlist| "Interpreter>Trace.boot") (def-boot-var |$mathTrace| "Interpreter>Trace.boot") (def-boot-var |$mathTraceList| "Controls mathprint output for )trace.") (def-boot-var $maxlinenumber "???") -(def-boot-val |$Mode| '(Mode) "compiler constant") (def-boot-var |$ModemapFrame| "???") -(def-boot-val |$ModeVariableList| - '(&1 &2 &3 &4 &5 &6 &7 &8 &9 &10 &11 - &12 &13 &14 &15) "???") (def-boot-var |$mostRecentOpAlist| "???") (def-boot-var $NBOOT "???") -(def-boot-val |$NegativeIntegerOpt| '(|NegativeInteger| . OPT) "???") -(def-boot-val |$NegativeInteger| '(|NegativeInteger|) "???") (def-boot-val |$NETail| (CONS |$EmptyEnvironment| NIL) "???") (def-boot-var $NEWLINSTACK "???") (def-boot-var |$noEnv| "???") -(def-boot-val |$NonMentionableDomainNames| '($ |Rep| |Mapping|) "???") -(def-boot-val |$NonNegativeIntegerOpt| '(|NonNegativeInteger| . OPT) "???") -(def-boot-val |$NonNegativeInteger| '(|NonNegativeInteger|) "???") -(def-boot-val |$NonPositiveIntegerOpt| '(|NonPositiveInteger| . OPT) "???") -(def-boot-val |$NonPositiveInteger| '(|NonPositiveInteger|) "???") -(def-boot-var |$noParseCommands| "???") -(def-boot-val |$NoValueMode| '|$NoValueMode| "compiler literal") -(def-boot-val |$NoValue| '|$NoValue| "compiler literal") (def-boot-val $num_of_meta_errors 0 "Number of errors seen so far") (def-boot-var $OLDLINE "Used to output command lines.") (def-boot-val |$oldTime| 0 "???") -(def-boot-val |$One| '(|One|) "???") (def-boot-val |$OneCoef| '(1 1 . 1) "???") (def-boot-val |$operationNameList| NIL "op names for apropos") (def-boot-var |$opFilter| "Used to /s a function") (def-boot-var |OptionList| "???") (def-boot-val |$optionAlist| nil "info for trace boot") (def-boot-var |$OutsideStringIfTrue| "???") -(def-boot-val |$PatternVariableList| - '(*1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11 - *12 *13 *14 *15) "???") (def-boot-var |$PolyMode| "???") (def-boot-val |$Polvar| '(WRAPPED . ((1 . 1))) "???") (def-boot-var |$polyDefaultAssoc| "???") @@ -360,15 +253,10 @@ offer it as extensions. |DistributedMultivariatePolynomial| |HomogeneousDistributedMultivariatePolynomial|) "???") -(def-boot-val |$PositiveIntegerOpt| '(|PositiveInteger| . OPT) "???") -(def-boot-val |$PositiveInteger| '(|PositiveInteger|) "???") (def-boot-var |$postStack| "???") (def-boot-var |$prefix| "???") (def-boot-val |$PrettyPrint| nil "if t generated code is prettyprinted") (def-boot-var |$previousTime| "???") -(def-boot-val |$PrimitiveDomainNames| nil -"Used in mkCategory to avoid generating vector slot -for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val |$optimizableDomainNames| '(|FactoredForm| |List| |Vector| |Integer| |NonNegativeInteger| |PositiveInteger| @@ -384,8 +272,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val |$QuickCode| NIL "Controls generation of QREFELT, etc.") (def-boot-val |$QuickLet| NIL "Set to T for no LET tracing.") (def-boot-var |$QuietIfNil| "???") -(def-boot-val |$RationalNumberOpt| '(|RationalNumber| . OPT) "???") -(def-boot-val |$RationalNumber| '(|RationalNumber|) "???") (def-boot-var |$readingFile| "???") (def-boot-val |$report3| nil "addMap report info") (def-boot-var |$reportBottomUpFlag| "Interpreter>SetVarT.boot") @@ -401,13 +287,7 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-var |$scanModeFlag| "???") (def-boot-var |$semanticErrorStack| "???") (def-boot-val |$SetFunctions| nil "checked in SetFunctionSlots") -(def-boot-val |$SideEffectFreeFunctionList| - '(|null| |case| |Zero| |One| \: \:\: |has| |Mapping| - |elt| = \> \>= \< \<= MEMBER |is| |isnt| ATOM - $= $\> $\>= $\< $\<= $^= $MEMBER) "???") (def-boot-var |$slamFlag| "Interpreter>SetVars.boot") -(def-boot-val |$SmallInteger| '(|SmallInteger|) "???") -(def-boot-val |$SmallIntegerOpt| '(|SmallInteger| . OPT) "???") (def-boot-val |$sourceFileTypes| '(SPAD BOOT LISP LISP370 META) "Interpreter>System.boot") @@ -416,28 +296,17 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-val |$spadLibFT| 'LISPLIB "???") (def-boot-var |$spadOpList| "???") (def-boot-var |$spadSystemDisks| "Interpreter>Database.boot") -(def-boot-val |$SpecialDomainNames| - '(|add| |CAPSULE| |SubDomain| |List| |Union| |Record| |Vector|) - "Used in isDomainForm, addEmptyCapsuleIfnecessary.") (def-boot-var |$streamAlist| "???") (def-boot-val |$streamCount| 0 "???") (def-boot-var |$streamIndexing| "???") (def-boot-val |$StreamIndex| 0 "???") -(def-boot-val |$StringCategory| '(|StringCategory|) "???") -(def-boot-val |$StringOpt| '(|String| . OPT) "???") -(def-boot-val |$String| '(|String|) "???") (def-boot-var |$suffix| "???") -(def-boot-val |$Symbol| '(|Symbol|) "???") -(def-boot-val |$SymbolOpt| '(|Symbol| . OPT) "???") -(def-boot-var |$systemCommands| "Interpreter>System.boot") (def-boot-val |$systemCreation| (currenttime) "???") (def-boot-val |$systemLastChanged| |$systemCreation| "???") (def-boot-val |$tempCategoryTable| (MAKE-HASHTABLE 'UEQUAL) "???") -(def-boot-val |$ThrowAwayMode| '|$ThrowAwayMode| "interp constant") (def-boot-val |$timerOn| t "???") (def-boot-var |$topOp| "See displayPreCompilationErrors") -(def-boot-var |$tokenCommands| "???") (def-boot-var $TOKSTACK "???") (def-boot-val $TOP_LEVEL t "???") (def-boot-var $top_stack "???") @@ -449,24 +318,7 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-var |$traceNoisely| "Interpreter>Trace.boot") (def-boot-var |$TranslateOnly| "???") (def-boot-var |$tripleCache| "Compiler>Compiler.boot") -(def-boot-val |$true| ''T "???") (def-boot-var $Type "???") -(def-boot-val |$underDomainAlist| - '((|DistributedMultivariatePolynomial| . 2) - (|FactoredForm| . 1) - (|FactoredRing| . 1) - (|Gaussian| . 1) - (|List| . 1) - (|Matrix| . 1) - (|MultivariatePolynomial| . 2) - (|HomogeneousDistributedMultivariatePolynomial| . 2) - (|Polynomial| . 1) - (|QuotientField| . 1) - (|RectangularMatrix| . 3) - (|SquareMatrix| . 2) - (|UnivariatePoly| . 2) - (|Vector| . 1) - (|VVectorSpace| . 2)) "???") (def-boot-val |$updateCatTableIfTrue| T "update category table on load") (def-boot-var |$updateIfTrue| @@ -475,7 +327,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") "Determines whether to use BF as default floating point type.") (def-boot-val |$useDCQnotLET| () "checked in DEF-LET for use of DCQ") (def-boot-var |$VariableCount| "???") -(def-boot-val |$Void| '(|Void|) "compiler constant") (def-boot-var |$warningStack| "???") (def-boot-val |$whereList| () "referenced in format boot formDecl2String") (def-boot-var |$xCount| "???") @@ -485,7 +336,6 @@ for primitive domains. Also used by putInLocalDomainReferences and optCal.") (def-boot-var |$xyMax| "???") (def-boot-var |$xyMin| "???") (def-boot-var |$xyStack| "???") -(def-boot-val |$Zero| '(|Zero|) "???") (def-boot-val |$domainsWithUnderDomains| (mapcar #'car |$underDomainAlist|) "???") diff --git a/src/interp/bootlex.lisp.pamphlet b/src/interp/bootlex.lisp.pamphlet index 925fe24f..db7eaece 100644 --- a/src/interp/bootlex.lisp.pamphlet +++ b/src/interp/bootlex.lisp.pamphlet @@ -467,17 +467,6 @@ or the chracters ?, !, ' or %" (defun SPAD_ERROR_LOC (STR) (format str "******** Boot Syntax Error detected ********")) -(defun BUMPERRORCOUNT (KIND) - (unless |$InteractiveMode| - (LET ((INDEX (case KIND - (|syntax| 0) - (|precompilation| 1) - (|semantic| 2) - (T (ERROR "BUMPERRORCOUNT"))))) - (SETELT $SPAD_ERRORS INDEX (1+ (ELT $SPAD_ERRORS INDEX)))))) - - - @ \eject \begin{thebibliography}{99} diff --git a/src/interp/diagnostics.boot b/src/interp/diagnostics.boot new file mode 100644 index 00000000..2e5163ac --- /dev/null +++ b/src/interp/diagnostics.boot @@ -0,0 +1,55 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +-- Copyright (C) 2007 Gabriel Dos Reis +-- + +-- +-- This file defines functions related to diagnostics issuance, etc. +-- These routines are bused by both the interprerter and the compiler. +-- + +import '"sys-constants" +import '"sys-globals" +)package "BOOT" + + +++ This routine is used by the interperter to count syntax, or +++ precompilation, or semantics analysis errors. + +BUMPERRORCOUNT kind == + $InteractiveMode => + index := + kind = "syntax" => 0 + kind = "precompilation" => 1 + kind = "semantic" => 2 + ERROR '"BUMPERRORCOUNT: unknown error kind" + $SPAD__ERRORS.index := 1 + $SPAD__ERRORS.index diff --git a/src/interp/g-error.boot.pamphlet b/src/interp/g-error.boot.pamphlet index e9f9a30b..103b8b0a 100644 --- a/src/interp/g-error.boot.pamphlet +++ b/src/interp/g-error.boot.pamphlet @@ -49,6 +49,7 @@ <<*>>= <<license>> +import '"diagnostics" )package "BOOT" -- This file contains the error printing code used in BOOT and SPAD. @@ -93,7 +94,7 @@ errorSupervisor(errorType,errorMsg) == errorSupervisor1(errorType,errorMsg,$BreakMode) == $cclSystem and $BreakMode = 'trapNumerics => THROW('trapNumerics,$numericFailure) - BUMPCOMPERRORCOUNT() + BUMPERRORCOUNT "semantic" errorLabel := errorType = $SystemError => '"System error" errorType = $UserError => '"Apparent user error" diff --git a/src/interp/macros.lisp.pamphlet b/src/interp/macros.lisp.pamphlet index 743af743..c17defdb 100644 --- a/src/interp/macros.lisp.pamphlet +++ b/src/interp/macros.lisp.pamphlet @@ -1316,8 +1316,8 @@ LP (COND ((NULL X) (defvar |$highlightAllowed| nil "Used in BRIGHTPRINT and is a )set variable.") -(defvar |$highlightFontOn| $boldstring "switch to highlight font") -(defvar |$highlightFontOff| $normalstring "return to normal font") +(defvar |$highlightFontOn| |$boldString| "switch to highlight font") +(defvar |$highlightFontOff| |$normalString| "return to normal font") ;; the following are redefined in MSGDB BOOT diff --git a/src/interp/msgdb.boot.pamphlet b/src/interp/msgdb.boot.pamphlet index 29920edf..e5b10a14 100644 --- a/src/interp/msgdb.boot.pamphlet +++ b/src/interp/msgdb.boot.pamphlet @@ -386,7 +386,7 @@ throwListOfKeyedMsgs(descKey,descArgs,l) == -- a chance to play around in a break loop if $BreakMode is not 'nobreak breakKeyedMsg(key,args) == - BUMPCOMPERRORCOUNT() + BUMPERRORCOUNT "semantic" sayKeyedMsg(key,args) handleLispBreakLoop($BreakMode) @@ -399,7 +399,7 @@ saturnKeyedSystemError(key, args) == sayString '"\bgroup\color{red}" sayString '"\begin{verbatim}" sayKeyedMsg("S2GE0000",NIL) - BUMPCOMPERRORCOUNT() + BUMPERRORCOUNT "semantic" sayKeyedMsgAsTeX(key,args) sayString '"\end{verbatim}" sayString '"\egroup" diff --git a/src/interp/nag-f01.boot.pamphlet b/src/interp/nag-f01.boot.pamphlet index 0fa5c044..7751874b 100644 --- a/src/interp/nag-f01.boot.pamphlet +++ b/src/interp/nag-f01.boot.pamphlet @@ -179,7 +179,7 @@ f01brfSolve htPage == '(domainConditions (isDomain P (Polynomial $EmptyMode)) (isDomain S (String)) - (isDomain EM (EmptyMode)) + (isDomain EM ($EmptyMode)) (isDomain F (Float)) (isDomain PI (PositiveInteger))), :labelList,:abortList] @@ -503,7 +503,7 @@ f01mafSolve htPage == '(domainConditions (isDomain P (Polynomial $EmptyMode)) (isDomain S (String)) - (isDomain EM (EmptyMode)) + (isDomain EM ($EmptyMode)) (isDomain F (Float)) (isDomain PI (PositiveInteger))), :labelList,:abortList] diff --git a/src/interp/patches.lisp.pamphlet b/src/interp/patches.lisp.pamphlet index 96d8a2c0..142d19cc 100644 --- a/src/interp/patches.lisp.pamphlet +++ b/src/interp/patches.lisp.pamphlet @@ -240,8 +240,8 @@ previous definition. (setq |$localVars| ()) ;checked by isType -(setq |$highlightFontOn| (concat " " $BOLDSTRING)) -(setq |$highlightFontOff| (concat $NORMALSTRING " ")) +(setq |$highlightFontOn| (concat " " |$boldString|)) +(setq |$highlightFontOff| (concat |$normalString| " ")) (define-function 'SUBSTQ #'SUBSTEQ) ;; needed for substNames (always copy) #+(and :lucid (not :ibm/370)) (define-function 'RUN-AIX-PROGRAM #'SYS:RUN-AIX-PROGRAM) diff --git a/src/interp/setq.lisp.pamphlet b/src/interp/setq.lisp.pamphlet index 15d4d241..c3b3c927 100644 --- a/src/interp/setq.lisp.pamphlet +++ b/src/interp/setq.lisp.pamphlet @@ -128,7 +128,6 @@ (SETQ $FUNNAME_TAIL '(())) (SETQ $LASTPREFIX "S:") ;"default setting" (SETQ |$inLispVM| 'T) -(SETQ $SPAD_ERRORS (VECTOR 0 0 0)) (SETQ STAKCOLUMN -1) (SETQ ECHOMETA NIL) (SETQ |$checkParseIfTrue| 'NIL) @@ -194,88 +193,6 @@ (setq *print-pretty* nil) (setq *print-circle* nil) -;; $SYSCOMMANDS is now defined at the top of i-syscmd.boot - -(SETQ |$systemCommands| '( -;; COMMAND USER LEVEL - )set userlevel - (|abbreviations| . |compiler| ) - (|boot| . |development|) - (|cd| . |interpreter|) - (|clear| . |interpreter|) - (|close| . |interpreter|) - (|compiler| . |compiler| ) - (|copyright| . |interpreter|) - (|credits| . |interpreter|) - (|display| . |interpreter|) - (|edit| . |interpreter|) - (|fin| . |development|) - (|frame| . |interpreter|) - (|help| . |interpreter|) - (|history| . |interpreter|) -;; (|input| . |interpreter|) - (|lisp| . |development|) - (|library| . |interpreter|) - (|load| . |interpreter|) - (|ltrace| . |interpreter|) - (|pquit| . |interpreter|) - (|quit| . |interpreter|) - (|read| . |interpreter|) - (|savesystem| . |interpreter|) - (|set| . |interpreter|) - (|show| . |interpreter|) - (|spool| . |interpreter|) - (|summary| . |interpreter|) - (|synonym| . |interpreter|) - (|system| . |interpreter|) - (|trace| . |interpreter|) - (|undo| . |interpreter|) - (|what| . |interpreter|) - (|with| . |interpreter|) - (|workfiles| . |development|) - (|zsystemdevelopment| . |interpreter|) - )) - -(SETQ |$noParseCommands| '( - |boot| - |copyright| - |credits| - |fin| - |lisp| - |pquit| - |quit| - |suspend| - |synonym| - |system| - )) - -(SETQ |$tokenCommands| '( - |abbreviations| - |cd| - |clear| - |close| - |compiler| - |depends| - |display| - |edit| - |frame| - |frame| - |help| - |history| - |input| - |library| - |load| - |ltrace| - |read| - |savesystem| - |set| - |spool| - |undo| - |what| - |with| - |workfiles| - |zsystemdevelopment| - )) - (SETQ |S:SPADTOK| 'SPADSYSTOK) (SETQ APLMODE NIL) (SETQ RLGENSYMFG NIL) @@ -417,24 +334,11 @@ ; (|isSubDomain| |hash| UEQUAL |count|) )) -;; following is symbol denoting a failed operation -(SETQ |$failure| (GENSYM)) ;; the following symbol holds the canonical "failed" value (SETQ |$failed| "failed") (SETQ |$constructorDataTable| NIL) -(SETQ |$underDomainAlist| '()) -;;(SETQ |$underDomainAlist| '( -;; (|DistributedMultivariatePolynomial| . 2) -;; (|MultivariatePolynomial| . 2) -;; (|NewDistributedMultivariatePolynomial| . 2) -;; (|RectangularMatrix| . 3) -;; (|SquareMatrix| . 2) -;; (|UnivariatePoly| . 2) -;; (|VVectorSpace| . 2) -;;)) - (SETQ |$univariateDomains| '( |UnivariatePolynomial| |UnivariateTaylorSeries| @@ -475,26 +379,6 @@ (SETQ |$abbreviationTable| NIL) -(SETQ |$ConstructorNames| '( - |SubDomain| |List| |Union| |Record| |Vector| - )) - ;" Used in isFunctor test, and compDefine " - -(SETQ |$SpecialDomainNames| '( - |add| CAPSULE |SubDomain| |List| |Union| |Record| |Vector| - )) - ;" Used in isDomainForm, addEmptyCapsuleIfnecessary" - -(SETQ |$DomainNames| '( - |Integer| |Float| |Symbol| |Boolean| |String| |Expression| - |Mapping| |SubDomain| |List| |Union| |Record| |Vector| |Enumeration| - )) - -(SETQ |$CategoryNames| '( - |Category| |CATEGORY| |RecordCategory| |Join| |EnumerationCategory| - |StringCategory| |SubsetCategory| |UnionCategory| - )) - (|SETQ| |$BasicDomains| '(|Integer| |Float| |Symbol| |Boolean| |String|)) (SETQ |$PrintCompilerMessagesIfTrue| NIL) @@ -505,71 +389,29 @@ (SETQ |$opFilter| NIL) ;" used to |/s a function " (SETQ |$evalDomain| NIL) -(SETQ |$SideEffectFreeFunctionList| '( - |null| |case| |Zero| |One| \: |::| |has| |Mapping| - |elt| = |>| |>=| |<| |<=| MEMBER |is| |isnt| ATOM - $= |$>| |$>=| |$<| |$<=| $^= $MEMBER -)) - (SETQ |$AnonymousFunction| '(|AnonymousFunction|)) (SETQ |$Any| '(|Any|)) -(SETQ |$BFtag| '|:BF:|) -(SETQ |$Boolean| '(|Boolean|)) -(SETQ |$Category| '(|Category|)) -(SETQ |$Domain| '(|Domain|)) -(SETQ |$Exit| '(|Exit|)) -(SETQ |$Expression| '(|OutputForm|)) (SETQ |$OutputForm| '(|OutputForm|)) -(SETQ |$BigFloat| '(|Float|)) -(SETQ |$Float| '(|Float|)) -(SETQ |$DoubleFloat| '(|DoubleFloat|)) (SETQ |$FontTable| '(|FontTable|)) -(SETQ |$Integer| '(|Integer|)) (SETQ |$ComplexInteger| (LIST '|Complex| |$Integer|)) -(SETQ |$Mode| '(|Mode|)) -(SETQ |$NegativeInteger| '(|NegativeInteger|)) -(SETQ |$NonNegativeInteger| '(|NonNegativeInteger|)) -(SETQ |$NonPositiveInteger| '(|NonPositiveInteger|)) -(SETQ |$PositiveInteger| '(|PositiveInteger|)) -(SETQ |$RationalNumber| '(|Fraction| (|Integer|))) -(SETQ |$String| '(|String|)) -(SETQ |$StringCategory| '(|StringCategory|)) -(SETQ |$Symbol| '(|Symbol|)) -(SETQ |$Void| '(|Void|)) (SETQ |$QuotientField| '|Fraction|) (SETQ |$FunctionalExpression| '|Expression|) (SETQ |$defaultFunctionTargets| '(())) -;; Old names -(SETQ |$SmallInteger| '(|SingleInteger|)) - ;; New Names -(SETQ |$SingleFloat| '(|SingleFloat|)) -(SETQ |$DoubleFloat| '(|DoubleFloat|)) (SETQ |$SingleInteger| '(|SingleInteger|)) (SETQ $TOP_LEVEL T) (SETQ $NE (LIST (LIST NIL))) (SETQ |$InteractiveFrame| (LIST (LIST NIL))) (SETQ |$gauss01| '(|gauss| 0 1)) -(SETQ |$LocalFrame| (LIST (LIST NIL))) -(SETQ |$DomainsInScope| (LIST NIL)) -(SETQ |$EmptyEnvironment| '((NIL))) (SETQ |$NETail| (CONS |$EmptyEnvironment| NIL)) -(SETQ |$EmptyMode| '|$EmptyMode|) -(SETQ |$DummyFunctorNames| '(|Mapping|)) (SETQ |$form| NIL) -(SETQ |$DoubleQuote| '"\"") -(SETQ |$EmptyString| "") -(SETQ |$EmptyVector| (VECTOR)) -(SETQ |$EmptyList| ()) (SETQ |$Index| 0) -(SETQ |$true| ''T) (SETQ |$false| NIL) (SETQ |$suffix| NIL) -(SETQ |$BasicPredicates| '(INTEGERP STRINGP FLOATP)) (SETQ |$coerceIntByMapCounter| 0) (SETQ |$reportCoerce| NIL) (SETQ |$reportCompilation| NIL) @@ -581,24 +423,7 @@ (SETQ |$Polvar| '(WRAPPED . ((1 . 1)))) (SETQ |$OneCoef| '(1 1 . 1)) (SETQ |$Lisp| '(|Lisp|)) -(SETQ |$ExpressionOpt| '(|Expression| . OPT)) (SETQ |$formalArgList| ()) -(SETQ |$FormalMapVariableList| - '(|#1| |#2| |#3| |#4| |#5| |#6| |#7| |#8| |#9| |#10| - |#11| |#12| |#13| |#14| |#15| |#16| |#17| |#18| |#19| |#20| - |#21| |#22| |#23| |#24| |#25| |#26| |#27| |#28| |#29| |#30| - |#31| |#32| |#33| |#34| |#35| |#36| |#37| |#38| |#39| |#40| - |#41| |#42| |#43| |#44| |#45| |#46| |#47| |#48| |#49| |#50| - )) -(SETQ |$PatternVariableList| - '(*1 *2 *3 *4 *5 *6 *7 *8 *9 *10 *11 *12 *13 *14 *15 *16 *17 *18 *19 *20 - *21 *22 *23 *24 *25 *26 *27 *28 *29 *30 *31 *32 *33 *34 *35 *36 *37 *38 *39 *40 - *41 *42 *43 *44 *45 *46 *47 *48 *49 *50)) -(SETQ |$ModeVariableList| - '(dv$1 dv$2 dv$3 dv$4 dv$5 dv$6 dv$7 dv$8 dv$9 dv$10 dv$11 dv$12 dv$13 dv$14 dv$15 - dv$16 dv$17 dv$18 dv$19 dv$20)) -(SETQ |$DomainVariableList| - '($1 $2 $3 $4 $5 $6 $7 $8 $9 $10 $11 $12 $13 $14 $15 $16 $17 $18 $19 $20)) (SETQ |$TriangleVariableList| '(|t#1| |t#2| |t#3| |t#4| |t#5| |t#6| |t#7| |t#8| |t#9| |t#10| |t#11| |t#12| |t#13| |t#14| |t#15| |t#16| |t#17| |t#18| |t#19| |t#20| @@ -606,21 +431,6 @@ |t#31| |t#32| |t#33| |t#34| |t#35| |t#36| |t#37| |t#38| |t#39| |t#40| |t#41| |t#42| |t#43| |t#44| |t#45| |t#46| |t#47| |t#48| |t#49| |t#50|)) -(SETQ |$PrimitiveDomainNames| - '(|List| |Integer| |NonNegativeInteger| |PositiveInteger| - |SingleInteger| |String| |Boolean|)) - ;" used in mkCategory to avoid generating vector slots" - ;" for primitive domains " - ;" also used by putInLocalDomainReferences and optCall" -(SETQ |$optimizableConstructorNames| - '(|List| |Integer| |PositiveInteger| |NonNegativeInteger| |SingleInteger| - |String| |Boolean| |Symbol| |DoubleFloat| |PrimitiveArray| |Vector|)) - ;" used by optCallSpecially" -(SETQ |$Zero| '(|Zero|)) -(SETQ |$One| '(|One|)) -(SETQ |$NonMentionableDomainNames| - '($ |Rep| |Record| |Union| |Mapping| |Enumeration|)) - ;" modemap:== ( <map> (p e) (p e) ... (p e) ) " ;" modemaplist:= ( modemap ... ) " (SETQ |$CategoryFrame| '((( @@ -635,11 +445,6 @@ ))) )))) -(SETQ |$InitialDomainsInScope| - '(|$EmptyMode| |$NoValueMode|)) - -(SETQ |$InitialModemapFrame| '((NIL))) - (SETQ NRTPARSE NIL) (SETQ |$NRTflag| T) (SETQ |$NRTaddForm| NIL) diff --git a/src/interp/spad.lisp.pamphlet b/src/interp/spad.lisp.pamphlet index 6a9fa709..849e397f 100644 --- a/src/interp/spad.lisp.pamphlet +++ b/src/interp/spad.lisp.pamphlet @@ -371,8 +371,7 @@ (|$genFVar| 0) (|$genSDVar| 0) (|$VariableCount| 0) - (|$previousTime| (TEMPUS-FUGIT)) - (|$LocalFrame| '((NIL)))) + (|$previousTime| (TEMPUS-FUGIT))) (prog ((CURSTRM CUROUTSTREAM) |$s| |$x| |$m| u) (declare (special CURSTRM |$s| |$x| |$m| CUROUTSTREAM)) (SETQ $TRACEFLAG T) diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot new file mode 100644 index 00000000..f518d045 --- /dev/null +++ b/src/interp/sys-constants.boot @@ -0,0 +1,519 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +-- Copyright (C) 2007 Gabriel Dos Reis +-- + +-- +-- This file collects and documents some of the constants used by either +-- the interpreter or the compiler or both. +-- + +import '"boot-pkg" + +)package "BOOT" + + +++ Clock time unit per second. +$timerTicksPerSecond == + INTERNAL_-TIME_-UNITS_-PER_-SECOND + + +-- +-- Text formatting +-- + +++ Glyph for a box +$boxString == + CONCATENATE('STRING, [CODE_-CHAR 29, CODE_-CHAR 226]) + +++ Glyph for an APL quad +$quadSymbol == + $boxString + +--% ANSI Escape Sequences. Note that these days, people +--% will be talking of ISO/IEC 6429. The practical end result +--% is the same. +--% The next few definitions provide symbolic names for ANSI +--% espace sequences. + +++ The escape character, in string form +$escapeString == + STRING CODE_-CHAR 27 + +++ Marker to swicth to bold font +$boldString == + CONCATENATE('STRING, $escapeString, '"[12m") + +++ Marker to switch to normal font +$normalString == + CONCATENATE('STRING, $escapeString, '"[0;10m") + +++ Marker to switch to reverve video display +$reverseVideoString == + CONCATENATE('STRING, $escapeString, '"[7m") + +++ Marker to underline text +$underlineString == + CONCATENATE('STRING, $escapeString, '"[4m") + + +-- +-- User Interface +-- + +++ +++ FIXME: Eventually move this to i-syscmd.boot +$noParseCommands == + '(boot _ + copyright _ + credits _ + fin _ + lisp _ + pquit _ + quit _ + suspend _ + synonym _ + system) + +++ +$tokenCommands == + '(abbreviations _ + cd _ + clear _ + close _ + compiler _ + depends _ + display _ + edit _ + frame _ + frame _ + help _ + history _ + input _ + library _ + load _ + ltrace _ + read _ + savesystem _ + set _ + spool _ + undo _ + what _ + with _ + workfiles _ + zsystemdevelopment) + +++ +++ List of pair (command . user level) +$systemCommands == + '((abbreviations . compiler) _ + (boot . development) _ + (cd . interpreter) _ + (clear . interpreter) _ + (close . interpreter) _ + (compiler . compiler) _ + (copyright . interpreter) _ + (credits . interpreter) _ + (display . interpreter) _ + (edit . interpreter) _ + (fin . development) _ + (frame . interpreter) _ + (help . interpreter) _ + (history . interpreter) _ + (lisp . development) _ + (library . interpreter) _ + (load . interpreter) _ + (ltrace . interpreter) _ + (pquit . interpreter) _ + (quit . interpreter) _ + (read . interpreter) _ + (savesystem . interpreter) _ + (set . interpreter) _ + (show . interpreter) _ + (spool . interpreter) _ + (summary . interpreter) _ + (synonym . interpreter) _ + (system . interpreter) _ + (trace . interpreter) _ + (undo . interpreter) _ + (what . interpreter) _ + (with . interpreter) _ + (workfiles . development) _ + (zsystemdevelopment . interpreter)) + +-- +-- Old Parser data +-- + +++ The double quote character in string form +++ FIXME: This constant is used in only one place. Move it there. +$DoubleQuote == + '"_"" + +++ Internal type tag for big float values. +++ This must be consistent with the tag checked for in postBigFloat +++ and also set in property.lisp. +++ FIXME: Have all those places use this symbolic constants. +$BFtag == + ":BF:" + +-- +-- Compiler flags +-- + +++ True if the system should support compilation +++ This constant does not seem very terrible useful. +++ FIXME: Check if it can be removed. +$COMPILE == + true + +-- +-- Common system data +-- + +++ A list of precomputed formal function formal parameter names. +++ 50 parameters should be enough for everybody, right? +$FormalMapVariableList == + '(_#1 _#2 _#3 _#4 _#5 _#6 _#7 _#8 _#9 _#10 _ + _#11 _#12 _#13 _#14 _#15 _#16 _#17 _#18 _#19 _#20 _ + _#21 _#22 _#23 _#24 _#25 _#26 _#27 _#28 _#29 _#30 _ + _#31 _#32 _#33 _#34 _#35 _#36 _#37 _#38 _#39 _#40 _ + _#41 _#42 _#43 _#44 _#45 _#46 _#47 _#48 _#49 _#50) + + +++ List of precomputed pattern variable names. +$PatternVariableList == + '(_*1 _*2 _*3 _*4 _*5 _*6 _*7 _*8 _*9 _*10 _*11 _ + _*12 _*13 _*14 _*15 _*16 _*17 _*18 _*19 _*20 _ + _*21 _*22 _*23 _*24 _*25 _*26 _*27 _*28 _*29 _*30 _ + _*31 _*32 _*33 _*34 _*35 _*36 _*37 _*38 _*39 _*40 _ + _*41 _*42 _*43 _*44 _*45 _*46 _*47 _*48 _*49 _*50) + +$ModeVariableList == + '(dv_$1 dv_$2 dv_$3 dv_$4 dv_$5 dv_$6 dv_$7 dv_$8 _ + dv_$9 dv_$10 dv_$11 dv_$12 dv_$13 dv_$14 dv_$15 _ + dv_$16 dv_$17 dv_$18 dv_$19 dv_$20) + +$DomainVariableList == + '(_$1 _$2 _$3 _$4 _$5 _$6 _$7 _$8 _$9 _$10 _$11 _ + _$12 _$13 _$14 _$15 _$16 _$17 _$18 _$19 _$20) + + +++ List of basic predicates the system has a built-in optimization +++ support for. +$BasicPredicates == + '(INTEGERP STRINGP FLOATP) + + + +++ List of functions known to be free of side effects +++ FIXME: Check that the names on this list are not renamed. +$SideEffectFreeFunctionList == + '(_null _ + _case _ + Zero _ + One _ + _: _ + _:_: _ + _has _ + Mapping _ + _elt _ + _= _ + _> _ + _>_= _ + _< _ + _<_= _ + MEMBER _ + _is _ + _isnt _ + ATOM _ + $_= _ + $_> _ + $_>_= _ + $_< _ + $_<_= _ + $_^_= _ + $MEMBER) + +--% Types + +++ The Void domain constructor form +$Void == + '(Void) + +++ Boolean domain constructor form +$Boolean == + '(Boolean) + +++ The SmallInteger domain constructor form +$SmallInteger == + '(SingleInteger) + +++ The Integer domain constructor form. +$Integer == + '(Integer) + + +++ The NegativeInteger domain constructor form +$NegativeInteger == + '(NegativeInteger) + +++ The NonNegativeInteger domain constructor form +$NonNegativeInteger == + '(NonNegativeInteger) + +++ The NonPositiveInteger domain constructor form +$NonPositiveInteger == + '(NonPositiveInteger) + +++ The PositiveInteger domain constructor form +$PositiveInteger == + '(PositiveInteger) + +++ The RationalNumber domain constructor form +$RationalNumber == + '(Fraction (Integer)) + + +++ SingleFloat domain constructor form +$SingleFloat == + '(SingleFloat) + +++ Float domain constructor form +$Float == + '(Float) + +++ DoubleFloat domain constructor form +$DoubleFloat == + '(DoubleFloat) + +++ BigFloat domain constructor form +++ FIXME: This does not appear to be used anywhere in the +++ source codes. +$BigFloat == + '(Float) + + +++ The String constructor domain form +$String == + '(String) + +++ The Symbol constructor domain form +$Symbol == + '(Symbol) + + +++ The 'wildcar' for a type -- "?" in Spad syntax. This stands for +++ an unspecified type. +$EmptyMode == + "$EmptyMode" + +++ Expression domain constructor form +$Expression == + '(OutputForm) + +++ Exit domain constructor form +$Exit == + '(Exit) + +++ The ThrowAwayMode constructor form +$ThrowAwayMode == + "$ThrowAwayMode" + +++ This mode is used to indicate that the value of expression +++ can be thrown away. +$NoValueMode == + "$NoValueMode" + +--% + +++ Category constructor form +$Category == + '(Category) + +++ Domain constructor form +++ FIXME: Find where this is used in the system. +$Domain == + '(Domain) + +++ Mode constructor form +++ FIXME: Where is this used? +$Mode == + '(Mode) + + +++ StringCategory Constructor form +$StringCategory == + '(StringCategory) + + +++ List of categories that do not have entries in the constructor +++ database. So, they are mostly recognized by their names. +$CategoryNames == + '(Category _ + CATEGORY _ + RecordCategory _ + Join _ + EnumerationCategory _ + StringCategory _ + SubsetCategory _ + UnionCategory) + +++ List of domains that do not have entries in the constructor +++ database. So, they are mostly recognized by their names. +++ See also $CategoryNames. +$DomainNames == + '(Integer _ + Float _ + Symbol _ + Boolean _ + String _ + Expression _ + Mapping _ + SubDomain _ + List _ + Union _ + Record _ + Vector _ + Enumeration) + + +++ +$NonMentionableDomainNames == + '($ Rep Record Union Mapping Enumeration) + + +++ List of primitive domains +$PrimitiveDomainNames == + '(List _ + Integer _ + NonNegativeInteger _ + PositiveInteger _ + SingleInteger _ + String _ + Boolean) + +++ FIXME +$SpecialDomainNames == + '(add _ + CAPSULE _ + SubDomain _ + List _ + Union _ + Record _ + Vector) + + +$optimizableConstructorNames == + '(List _ + Integer _ + PositiveInteger _ + NonNegativeInteger _ + SingleInteger _ + String _ + Boolean _ + Symbol _ + DoubleFloat _ + PrimitiveArray _ + Vector) + +++ FIXME +$DomainsInScope == + '(NIL) + +++ List of domains in scope in fresh settings. +$InitialDomainsInScope == + '($EmptyMode _ + $NoValueMode) + + +++ FIXME +$underDomainAlist == + nil + + +++ List of constructors that do not have entries in the databases. +++ See also $CategoryNames and $DomainNames. +$ConstructorNames == + '(SubDomain _ + List _ + Union _ + Record _ + Vector) + +++ A list of functors that do not really have modemaps +$DummyFunctorNames == + '(Mapping) + +--% + +++ The empty environment +$EmptyEnvironment == + '((NIL)) + +++ +$LocalFrame == + '((NIL)) + +++ The empty string constant. +$EmptyString == + '"" +++ The empty vector constant +$EmptyVector == + VECTOR() + +++ A symbol denoting failure +$failure == + GENSYM() + +++ The initial modemap frame +$InitialModemapFrame == + '((NIL)) + + +++ The constant 0. +$Zero == + '(Zero) + +++ The constant 1. +$One == + '(One) + + +++ +$true == + ''T + +++ Indicate absence of value +$NoValue == + "$NoValue" + diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot new file mode 100644 index 00000000..2c576427 --- /dev/null +++ b/src/interp/sys-globals.boot @@ -0,0 +1,47 @@ +-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. +-- All rights reserved. +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- - Redistributions of source code must retain the above copyright +-- notice, this list of conditions and the following disclaimer. +-- +-- - Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in +-- the documentation and/or other materials provided with the +-- distribution. +-- +-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the +-- names of its contributors may be used to endorse or promote products +-- derived from this software without specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER +-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, +-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +-- +-- Copyright (C) 2007 Gabriel Dos Reis +-- + +-- +-- This file collects and documents some the global variables used by either +-- the interpreter or the compiler or both. +-- + +import '"boot-pkg" +)package "BOOT" + +++ FIXME +$saturn := false + +++ FIXME +$SPAD__ERRORS := VECTOR(0, 0, 0) diff --git a/src/interp/varini.boot.pamphlet b/src/interp/varini.boot.pamphlet index 0d7c050a..6e8c0314 100644 --- a/src/interp/varini.boot.pamphlet +++ b/src/interp/varini.boot.pamphlet @@ -173,7 +173,6 @@ $charNumSymVector := NIL -- Modes $ExitMode := 'ExitMode $FullMode := 'FullMode -$NoValueMode := 'NoValueMode $ValueMode := 'ValueMode --error message facility @@ -193,7 +192,6 @@ $sefoDerivedAttributes := [ 'type, 'tfinfo, 'signature, 'pooled ] --from NCMODE BOOT $ValueMode := 'ValueMode -$NoValueMode := 'NoValueMode $FullMode := 'FullMode $ExitMode := 'ExitMode @@ -230,7 +228,6 @@ $phaseAbTab := '( (Reporting . "Rp" ) ) -- Items from STATS BOOT --- $timerTicksPerSecond := INTERNAL_-TIME_-UNITS_-PER_-SECOND $LINELENGTH := 80 -- Items from MSG BOOT I |