
<<MBParse.mesa  >>
<<Edited by Sandman on 6-Aug-81 15:42:09>>
<<Edited by Lewis on 18-Sep-81 15:00:15>>
<<Edited by Levin on April 5, 1983 3:35 pm>>

DIRECTORY
Ascii USING [ControlZ, CR, NUL],
BcdOps USING [FPHandle, MTHandle, SPHandle],
Environment USING [wordsPerPage],
Heap USING [Create, Delete],
Inline USING [BITAND, BITXOR, LongCOPY],
LongString USING [AppendChar, AppendString, EqualString, InvalidNumber, StringToDecimal],
MB USING [
Abort, BHandle, DoAllBCDs, DoAllFramePacks, DoAllSpaces, Error, GetFrameWeight, GetFsiChain, Handle, InstanceToMTHandle, ListType, 
NameToCTHandle, NameToFPHandle, NameToG, NameToMTHandle, DoAllModules, NameToSPHandle, ResetConfig, SetConfig, SetFrameWeight, 
SetFsiChain],
MBStorage USING [FreePages, Pages, PagesForWords],
MBOut USING [Char, CR, Decimal, Line, LongNumber, Number, SP, Spaces, Text, Time],
MBTTY USING [PutChar, PutCR, PutDecimal, PutString],
PrincOps USING [FrameSizeIndex, FrameVec, GFTIndex, GlobalFrameHandle, StateVector],
PSB USING [Priority, PsbIndex],
Segments USING [FileNameProblem, GetFileTimes],
Streams USING [Destroy, End, FileFromStream, GetChar, NewStream, Handle],
Time USING [Packed];

MBParse: PROGRAM
IMPORTS
Heap, Inline, MB, MBOut, MBStorage, MBTTY, Segments, Streams, String: LongString
EXPORTS MB =

BEGIN

OPEN MB;

<<Syntax for RESIDENT, RESIDENTDESCRIPTOR, IN, and NOTRAP:>>
<<Resident    ::=    RESIDENT : list ;>>
<<ResidentDescriptor    ::=    RESIDENTDESCRIPTOR : list ;>>
<<In    ::=    IN : list ;>>
<<NoTrap    ::=    NOTRAP : moduleList ;>>
<<list    ::=    listItem | list , listItem>>
<<listItem    ::=    configPart | CODE [ configPartList ]>>
<<        GLOBALFRAME [ configPartList ]>>
<<        SPACE [ nameList ] | CODEPACK [ nameList ] |>>
<<        FRAME [ nameList ] | FRAMEPACK [ nameList ] |>>
<<        BCD [ nameList ] |>>
<<configPartList    ::=    configPart | configPartList , configPart>>
<<configPart    ::=    module | configName [ moduleList ]>>
<<moduleList    ::=    module | moduleList , module>>
<<module    ::=    name | name . instance>>
<<nameList    ::=    name | nameList , name>>


NUL: CHARACTER = Ascii.NUL;
CR: CHARACTER = Ascii.CR;

data: MB.Handle _ NIL;
source: Streams.Handle;
z: UNCOUNTED ZONE _ NIL;

noTrapList: Node;
stateLists: ARRAY ListType OF Node;  -- circularly linked, pointer is to last element
wartConfig, wartModule: Hash;
DoneParsing: SIGNAL = CODE;

Node: TYPE = LONG POINTER TO Item;
Item: TYPE = RECORD [
link: Node,
body: SELECT type: * FROM
name => [name: Hash],
dot => [module, instance: Hash],
config => [name: Hash, list: Node],
space => [list: Node],
frame => [list: Node],
globalframe => [list: Node],
code => [list: Node],
bcd => [list: Node],
ENDCASE
];

keywords: ARRAY Keyword OF Symbol;
Keyword: TYPE = {
resident, resDesc, in, frame, framepack, space, codepack, globalFrame, code,
bcd, wart, noTrap, frameweight, framecount, gft, mdsbase, codebase, pdabase, pdapages,
framePages, processes, svSize, nSV, all};
Symbol: TYPE = RECORD [
SELECT type: * FROM
hash => [hash: Hash],
sep => [sep: CHARACTER],
ENDCASE
];

SemiColon: Symbol = [sep[';]];
Colon: Symbol = [sep[':]];
Comma: Symbol = [sep[',]];
CloseBracket: Symbol = [sep[']]];
OpenBracket: Symbol = [sep['[]];
Dot: Symbol = [sep['.]];
NullSymbol: Symbol = [sep[NUL]];

InputFile: TYPE = LONG POINTER TO InputFileNode;
InputFileNode: TYPE = RECORD [
next: InputFile,
name: LONG STRING,
create: Time.Packed];

inputFiles: InputFile;

<<Bootmesa file parsing>>

InitParse: PUBLIC PROC [h: MB.Handle] = {
data _ h;
CreateHash[2];
EnterKeywords[];
noTrapList _ NIL;
stateLists _ ALL[NIL];
wartConfig _ wartModule _ NullHash;
z _ Heap.Create[initial: 4];
source _ NIL;
inputFiles _ NIL};

EnterKeywords: PROC = {
names: ARRAY Keyword OF STRING = [
"RESIDENT"L, "RESIDENTDESCRIPTOR"L, "IN"L, "FRAME"L, "FRAMEPACK"L, "SPACE"L, "CODEPACK"L, "GLOBALFRAME"L, "CODE"L, "BCD"L, "WART"L, 
"NOTRAP"L, "FRAMEWEIGHT"L, "FRAMECOUNT"L, "GFT"L, "MDSBASE"L, "CODEBASE"L, "PDABASE"L, "PDAPAGES"L, "FRAMEPAGES"L, "PROCESSES"L, 
"STATEVECTORSIZE"L, "STATEVECTORCOUNT"L, "ALL"L];
FOR key: Keyword IN Keyword DO
keywords[key] _ [hash[Lookup[s: names[key], insert: TRUE].h]];
ENDLOOP;
};

FinishParse: PUBLIC PROC = {
DestroyHash[];
IF z # NIL THEN {Heap.Delete[z: z]; z _ NIL};
data _ NIL;
};

ProcessInput: PUBLIC PROC [file: LONG STRING] = {
name: STRING _ [40];
inputFile: InputFile = z.NEW[InputFileNode];
String.AppendString[name, file];
source _ Streams.NewStream[name !
Segments.FileNameProblem[] => Error["Parameter file not found!"L]];
inputFile.name _ z.NEW[StringBody[file.length]];
String.AppendString[inputFile.name, file];
inputFile.create _ Segments.GetFileTimes[Streams.FileFromStream[source]].create;
indexInSource _ 0;
currentChar _ Get[];
currentSymbol _ NullSymbol;
ParseInput[];
Streams.Destroy[source];
<<put at end of list for printing by EchoInput>>
IF inputFiles = NIL THEN inputFile.next _ inputFile
ELSE {inputFile.next _ inputFiles.next; inputFiles.next _ inputFile};
inputFiles _ inputFile;
};

EchoInput: PUBLIC PROC = {
OPEN MBOut;
LongOctal: PROC [val: LONG UNSPECIFIED] = INLINE {
LongNumber[val, [8, FALSE, TRUE, 0]]; Char['B];
};
EchoList: PROC [tail: Node, topLevel: BOOL _ TRUE] = {
KeyToString: PROC [key: Keyword] RETURNS [LONG STRING] = {
WITH keywords[key] SELECT FROM
hash => RETURN[TempString[hash]];
ENDCASE => ERROR;
};
p: Node _ tail;
IF topLevel THEN Spaces[4] ELSE Char['[];
IF p ~= NIL THEN
DO
p _ p.link;
WITH p SELECT FROM
name => Text[TempString[name]];
dot => {Text[TempString[module]]; Char['.]; Text[TempString[instance]]};
config => {Text[TempString[name]]; EchoList[list, FALSE]};
space => {Text[KeyToString[codepack]]; EchoList[list, FALSE]};
frame => {Text[KeyToString[framepack]]; EchoList[list, FALSE]};
globalframe => {Text[KeyToString[globalFrame]]; EchoList[list, FALSE]};
code => {Text[KeyToString[code]]; EchoList[list, FALSE]};
bcd => {Text[KeyToString[bcd]]; EchoList[list, FALSE]};
ENDCASE;
IF p = tail THEN EXIT;
Char[',]; IF topLevel THEN {CR[]; Spaces[4]} ELSE SP[];
ENDLOOP;
IF topLevel THEN {Char[';]; CR[]}
ELSE Char[']];
};
IF inputFiles ~= NIL THEN {
inputFile: InputFile _ inputFiles.next;
Text["Parameter File"L];
IF inputFile ~= inputFiles THEN Char['s];
Char[':]; CR[]; CR[];
DO
Spaces[2]; Text[inputFile.name, 39]; Spaces[2]; Time[inputFile.create]; CR[];
IF inputFile = inputFiles THEN EXIT;
inputFile _ inputFile.next;
ENDLOOP;
CR[];
};
Line["Input Parameters:"L]; CR[];
Text["  GFT length = "L]; Decimal[data.gftLength]; CR[];
Text["  PDA pages = "L]; Decimal[data.pdaPages]; CR[];
Text["  Processes = "L]; Decimal[data.nProcesses]; CR[];
Text["  MDS base = page "L]; Decimal[data.mdsBase];
Text[" ["L]; LongOctal[LONG[data.mdsBase]*Environment.wordsPerPage]; Char[']]; CR[];
Text["  Code base = page "L]; Decimal[data.codeBase];
Text[" ["L]; LongOctal[LONG[data.codeBase]*Environment.wordsPerPage]; Char[']]; CR[];
CR[];
Text["  Statevector length = "L]; Decimal[data.svSize]; CR[];
Line["  Statevector counts:"L];
FOR i: CARDINAL IN PSB.Priority DO
Number[i, [10, FALSE, FALSE, 6]]; Text[":  "L];
Decimal[data.stateVectorCounts[i]]; CR[];
ENDLOOP;
CR[];
Text["  Frame heap pages = "L]; Decimal[data.framePages]; CR[];
Text["  Frame distribution:  [ FSI (words): "L];
Text[IF data.framePages = 0 THEN "count"L ELSE "weight"L];
Line[", next FSI ]"L];
FOR i: PrincOps.FrameSizeIndex IN PrincOps.FrameSizeIndex DO
Spaces[2];
Number[i, [10, FALSE, FALSE, 3]]; Text[" ("L];
Number[PrincOps.FrameVec[i], [10, FALSE, FALSE, 4]]; Text["):  "L];
Decimal[MB.GetFrameWeight[i]]; Text[", "L];
Decimal[MB.GetFsiChain[i]]; CR[];
ENDLOOP;
CR[];
Text["  Wart: "L]; Text[TempString[wartModule]];
IF wartConfig ~= NullHash THEN {Text[" in configuration "L]; Text[TempString[wartConfig]]};
CR[]; CR[];
Line["  Resident:"L]; EchoList[stateLists[resident]]; CR[];
Line["  Resident Descriptor:"L]; EchoList[stateLists[resDesc]]; CR[];
Line["  Initially In:"L]; EchoList[stateLists[in], TRUE]; CR[];
Line["  No Trap:"L]; EchoList[noTrapList, TRUE]; CR[];
CR[];
};

ParseInput: PROC = {
DO
SELECT GetKeyword[ ! DoneParsing => EXIT] FROM
gft => {
length: CARDINAL _
GetNumber[low: FIRST[PrincOps.GFTIndex]+1, high: LAST[PrincOps.GFTIndex]+1];
GetRequiredSep[SemiColon];
data.gftLength _ length;
};
mdsbase => {
base: CARDINAL _ GetNumber[];
GetRequiredSep[SemiColon];
data.mdsBase _ base;
};
codebase => {
base: CARDINAL _ GetNumber[];
GetRequiredSep[SemiColon];
data.codeBase _ base;
};
framePages => {
pages: CARDINAL _ GetNumber[low: 0, high: 255];
GetRequiredSep[SemiColon];
data.framePages _ pages;
};
pdabase => {
pages: CARDINAL _ GetNumber[];
GetRequiredSep[SemiColon];
};
pdapages => {
pages: CARDINAL _ GetNumber[low: 1, high: 256];
GetRequiredSep[SemiColon];
data.pdaPages _ pages;
};
processes => {
number: CARDINAL _ GetNumber[low: FIRST[PSB.PsbIndex]+1, high: LAST[PSB.PsbIndex]+1];
GetRequiredSep[SemiColon];
data.nProcesses _ number;
};
nSV => {
count: CARDINAL;
svIndex: CARDINAL _ GetNumber[low: FIRST[PSB.Priority], high: LAST[PSB.Priority]];
GetRequiredSep[Comma];
count _ GetNumber[];
GetRequiredSep[SemiColon];
data.stateVectorCounts[svIndex] _ count;
};
svSize => {
number: CARDINAL _ GetNumber[low: SIZE[PrincOps.StateVector]];
GetRequiredSep[SemiColon];
data.svSize _ number;
};
frameweight, framecount => {
Fsi: TYPE = PrincOps.FrameSizeIndex;
frameIndex: Fsi _ GetNumber[low: FIRST[Fsi], high: LAST[Fsi]];
sep: Symbol;
GetRequiredSep[Comma];
MB.SetFrameWeight[index: frameIndex, weight: GetNumber[]];
sep _ GetSep[];
SELECT sep FROM
SemiColon => NULL;
Comma =>
MB.SetFsiChain[
index: frameIndex, fsiNext: GetNumber[low: FIRST[Fsi], high: LAST[Fsi]]];
ENDCASE => ErrorMsg["Unexpected separator '%'"L, sep];
};
wart => {
id: hash Symbol _ GetSym[];
sep: Symbol = GetSep[];
SELECT sep FROM
SemiColon => {wartConfig _ NullHash; wartModule _ id.hash};
OpenBracket => {
wartConfig _ id.hash;
id _ GetSym[];
GetRequiredSep[CloseBracket];
GetRequiredSep[SemiColon];
wartModule _ id.hash};
ENDCASE => SyntaxError[wart];
};
resident => {
stateLists[resident] _ GetGeneralList[stateLists[resident]];
GetRequiredSep[SemiColon];
};
resDesc => {
stateLists[resDesc] _ GetGeneralList[stateLists[resDesc]];
GetRequiredSep[SemiColon];
};
in => {
stateLists[in] _ GetGeneralList[stateLists[in]];
GetRequiredSep[SemiColon];
};
noTrap => {
noTrapList _ GetModuleList[noTrapList];
GetRequiredSep[SemiColon];
};
ENDCASE;
ENDLOOP;
};

GetKeyword: PROC RETURNS [key: Keyword] = {
sym: Symbol _ Scan[];
IF sym = [sep[NUL]] THEN SIGNAL DoneParsing;
IF GetSep[] # Colon THEN ErrorMsg["No colon following keyword '%'"L, sym];
FOR key IN Keyword DO IF sym = keywords[key] THEN RETURN[key]; ENDLOOP;
ErrorMsg["Unrecognizable keyword '%'"L, sym];
};

GetNumber: PROC [low: CARDINAL _ FIRST[CARDINAL], high: CARDINAL _ LAST[CARDINAL]]
RETURNS [number: CARDINAL] = {
sym: hash Symbol _ GetSym[];
number _ String.StringToDecimal[TempString[sym.hash] !
String.InvalidNumber => ErrorMsg["'%' should be numeric"L, sym]];
IF ~(number IN [low..high]) THEN ErrorMsg["'%' is out of range"L, sym];
};

GetRequiredSep: PROC [esep: Symbol] = {
sep: Symbol = GetSep[];
IF sep ~= esep THEN ErrorMsg["Expected separator '%' not found"L, esep];
};

GetSym: PROC RETURNS [h: hash Symbol] = {
sym: Symbol _ Scan[];
WITH s: sym SELECT FROM 
hash => RETURN[s]; 
ENDCASE => ErrorMsg["Separator '%' not permitted"L, sym];
};

GetSep: PROC RETURNS [sep: sep Symbol] = {
sym: Symbol _ Scan[];
WITH s: sym SELECT FROM 
sep => RETURN[s]; 
ENDCASE => ErrorMsg["Missing separator preceding '%'"L, sym];
};

GetGeneralList: PROC [oldList: Node] RETURNS [list: Node] = {
list _ oldList;
DO
sep: sep Symbol;
list _ AppendNode[list, GetListItem[]];
IF (sep _ GetSep[]) ~= Comma THEN {BackupScan[sep]; EXIT};
ENDLOOP;
};

GetListItem: PROC RETURNS [item: Node] = {
sym: Symbol = GetSym[];
SELECT sym FROM
keywords[space], keywords[codepack] =>
item _ z.NEW[Item _ [link: NIL, body: space[list: GetBracketedNameList[]]]];
keywords[frame], keywords[framepack] =>
item _ z.NEW[Item _ [link: NIL, body: frame[list: GetBracketedNameList[]]]];
keywords[bcd] =>
item _ z.NEW[Item _ [link: NIL, body: bcd[list: GetBracketedNameList[]]]];
keywords[globalFrame] =>
item _ z.NEW[Item _ [link: NIL, body: globalframe[list: GetBracketedConfigPartList[]]]];
keywords[code] =>
item _ z.NEW[Item _ [link: NIL, body: code[list: GetBracketedConfigPartList[]]]];
ENDCASE => {BackupScan[sym]; item _ GetConfigPart[]};
};

GetBracketedConfigPartList: PROC RETURNS [list: Node] = {
GetRequiredSep[OpenBracket];
list _ GetConfigPartList[];
GetRequiredSep[CloseBracket];
};

GetConfigPartList: PROC RETURNS [list: Node] = {
list _ NIL;
DO
sep: sep Symbol;
list _ AppendNode[list, GetConfigPart[]];
IF (sep _ GetSep[]) ~= Comma THEN {BackupScan[sep]; EXIT};
ENDLOOP;
};

GetConfigPart: PROC RETURNS [item: Node] = {
sym: hash Symbol = GetSym[];
sep: Symbol = GetSep[];
IF sep = OpenBracket THEN {
item _ z.NEW[Item _ [link: NIL, body: config[name: sym.hash, list: GetModuleList[]]]];
GetRequiredSep[CloseBracket]}
ELSE {BackupScan[sep]; item _ GetModule[first: sym]};
};

GetModuleList: PROC [oldList: Node _ NIL] RETURNS [list: Node] = {
list _ oldList;
DO
sep: sep Symbol;
list _ AppendNode[list, GetModule[]];
IF (sep _ GetSep[]) ~= Comma THEN {BackupScan[sep]; EXIT};
ENDLOOP;
};

GetModule: PROC [first: Symbol _ NullSymbol] RETURNS [node: Node] = {
sep: sep Symbol;
IF first = NullSymbol THEN first _ GetSym[];
WITH module: first SELECT FROM
hash =>
IF (sep _ GetSep[]) = Dot THEN
node _ z.NEW[Item _ [link: NIL, body: dot[module: module.hash, instance: GetSym[].hash]]]
ELSE {BackupScan[sep]; node _ z.NEW[Item _ [link: NIL, body: name[name: module.hash]]]};
ENDCASE => ERROR;
};

GetBracketedNameList: PROC RETURNS [list: Node] = {
GetRequiredSep[OpenBracket];
list _ GetNameList[];
GetRequiredSep[CloseBracket];
};

GetNameList: PROC RETURNS [list: Node] = {
list _ NIL;
DO
sep: sep Symbol;
list _ AppendNode[list, GetName[]];
IF (sep _ GetSep[]) ~= Comma THEN {BackupScan[sep]; EXIT};
ENDLOOP;
};

GetName: PROC RETURNS [Node] = {
RETURN[z.NEW[Item _ [link: NIL, body: name[name: GetSym[].hash]]]]};

AppendNode: PROC [list: Node, node: Node] RETURNS [newList: Node] = {
IF list = NIL THEN node.link _ node
ELSE {node.link _ list.link; list.link _ node};
RETURN[node]
};

<<Lexical Analysis>>

indexInSource: CARDINAL;
currentChar: CHARACTER;
currentSymbol: Symbol;

Scan: PROC RETURNS [sym: Symbol] = {
char: CHARACTER _ currentChar;
s: STRING _ [40];
IF currentSymbol ~= NullSymbol THEN {
sym _ currentSymbol;
currentSymbol _ NullSymbol;
RETURN
};
DO
WHILE char IN [NUL..' ] DO
SELECT char FROM
Ascii.ControlZ =>
DO SELECT Get[] FROM NUL => GOTO eof; CR => EXIT; ENDCASE ENDLOOP;
NUL => GOTO eof;
ENDCASE;
char _ Get[];
ENDLOOP;
SELECT char FROM
IN ['a..'z], IN ['A..'Z], IN ['0..'9] => {
s.length _ 0;
String.AppendChar[s, char];
DO
char _ Get[];
SELECT char FROM
IN ['a..'z], IN ['A..'Z], IN ['0..'9] =>
String.AppendChar[s, char];
ENDCASE => EXIT;
ENDLOOP;
sym _ [hash[Lookup[s: s, insert: TRUE].h]];
EXIT};
'., '[, '], ':, ';, ', => {sym _ [sep[char]]; char _ Get[]; EXIT};
'- => {
IF (char _ Get[]) # '- THEN InvalidCharacter[char];
DO
SELECT char _ Get[] FROM
NUL => GOTO eof;
'- => IF (char _ Get[]) = '- THEN EXIT;
CR => EXIT;
ENDCASE;
ENDLOOP;
char _ Get[]};
ENDCASE => InvalidCharacter[char];
REPEAT eof => sym _ NullSymbol;
ENDLOOP;
currentChar _ char;
};

BackupScan: PROC [sym: Symbol] = {
IF currentSymbol ~= NullSymbol THEN ERROR;
currentSymbol _ sym;
};

Get: PROC RETURNS [c: CHARACTER] = {
c _ Streams.GetChar[source ! Streams.End[] => GO TO fakeIt];
indexInSource _ indexInSource + 1;
EXITS
fakeIt => RETURN[NUL];
};

<<Symbol management>>

parseTable: PRIVATE Base _ NIL;
Base: TYPE = LONG BASE POINTER TO HashRegion;
HashRegion: TYPE = RECORD [
hVec: ARRAY [0..HVSize) OF Hash,
nPages: CARDINAL,
caseHeed: BOOL,
nextAvail: Hash,
firstAvail: HashBlock
<<as many more HashBlocks as will fit in nPages>>
];

Hash: TYPE = Base RELATIVE ORDERED POINTER [0..37777B] TO HashBlock;
HashBlock: TYPE = RECORD [
next: Hash,
string: StringBody
];

NullHash: Hash = LOOPHOLE[0];
FirstAvailSlot: Hash = LOOPHOLE[HVSize + 3];  --@firstAvail
HVSize: CARDINAL = 71;

Lookup: PROC [s: STRING, insert: BOOL] RETURNS [h: Hash, old: BOOL] = {
i: [0..HVSize) _ HashFn[s];
h _ parseTable.hVec[i];
WHILE h # NullHash DO
IF String.EqualString[s, @parseTable[h].string] THEN RETURN [h, TRUE];
h _ parseTable[h].next;
ENDLOOP;
IF insert THEN parseTable.hVec[i] _ h _ NewEntry[s, parseTable.hVec[i]]
ELSE h _ NullHash;
RETURN[h, FALSE]
};

HashFn: PROC [s: STRING] RETURNS [[0..HVSize)] = {
CharBits: PROC [CHARACTER, WORD] RETURNS [WORD] = LOOPHOLE[Inline.BITAND];
Mask: WORD = 337B;                -- masks out ASCII case shifts
n: CARDINAL = s.length;
v: WORD  _ CharBits[s[0], Mask]*177B + CharBits[s[n-1], Mask];
RETURN[Inline.BITXOR[v, n*17B] MOD HVSize]
};

NewEntry: PROC [s: STRING, next: Hash] RETURNS [h: Hash] = {
w: CARDINAL = SIZE[HashBlock] + (s.length+1)/2;
IF LOOPHOLE[parseTable.nextAvail+w, CARDINAL] > 
parseTable.nPages*Environment.wordsPerPage THEN {  -- make more space
np, nw: CARDINAL;
oldData: Base _ parseTable;
np _ oldData.nPages + MAX[MBStorage.PagesForWords[w], 2];
nw _ LOOPHOLE[oldData.nextAvail];
parseTable.nPages _ np; -- so the COPY doesn't smash new value
parseTable _ NIL; -- so Create doesn't throw away old
CreateHash[np];
Inline.LongCOPY[from: oldData, to: parseTable, nwords: nw];
MBStorage.FreePages[oldData];
};
h _ parseTable.nextAvail; parseTable.nextAvail _ parseTable.nextAvail+w;
parseTable[h] _ [next: next, string: [length: 0, maxlength: s.length, text:]];
String.AppendString[@parseTable[h].string, s];
};

CreateHash: PROC [nPages: CARDINAL] = {
IF parseTable # NIL THEN DestroyHash[];
parseTable _ MBStorage.Pages[nPages];
parseTable.nPages _ nPages;
FOR i: CARDINAL IN [0..HVSize) DO parseTable.hVec[i] _ NullHash; ENDLOOP;
parseTable.nextAvail _ FirstAvailSlot;
};

DestroyHash: PROC = {
MBStorage.FreePages[parseTable];
parseTable _ NIL;
};

TempString: PROC [h: Hash] RETURNS [LONG STRING] = {
RETURN[@parseTable[h].string]
};

<<Error processing>>

SyntaxError: PROC [key: Keyword] = {ErrorMsg["Bad specification for '%'"L, keywords[key]]};

InvalidCharacter: PROC [c: CHARACTER] = {ErrorMsg["'%' is an invalid character"L, [sep[c]]]};

ErrorMsg: PROC [msg: STRING, sym: Symbol] = {
Opening[];
FOR i: CARDINAL IN [0..msg.length) DO
c: CHARACTER = msg[i];
SELECT c FROM
'% =>
WITH sym SELECT FROM
hash => PutHash[hash];
sep => MBTTY.PutChar[h: data.ttyHandle, c: sep];
ENDCASE;
ENDCASE => MBTTY.PutChar[h: data.ttyHandle, c: c];
ENDLOOP;
Closing[];
};

Opening: PROC = {
MBTTY.PutCR[h: data.ttyHandle];
MBTTY.PutString[h: data.ttyHandle, s: "!Syntax Error ["L];
MBTTY.PutDecimal[h: data.ttyHandle, n: indexInSource];
MBTTY.PutString[h: data.ttyHandle, s: "]: "L];
};

Closing: PROC = {
MBTTY.PutCR[h: data.ttyHandle];
SIGNAL MB.Abort;
};

PutHash: PROC [hash: Hash] = {
MBTTY.PutString[
h: data.ttyHandle, s: IF hash ~= NullHash THEN TempString[hash] ELSE "???"L];
};

<<Bootmesa file interrogation>>

WartFrame: PUBLIC PROC RETURNS [g: PrincOps.GlobalFrameHandle] = {
IF wartConfig # NullHash THEN MB.SetConfig[TempString[wartConfig]];
g _ MB.NameToG[TempString[wartModule]];
MB.ResetConfig[];
};

EnumerateCode: PUBLIC PROC [
state: ListType, proc: PROC [bh: BHandle, mth: BcdOps.MTHandle] RETURNS [BOOL]] = {
PackageableOnly: PROC [bh: BHandle, mth: BcdOps.MTHandle] RETURNS [BOOL] = {
RETURN[IF mth.packageable THEN proc[bh, mth] ELSE FALSE]};
[] _ DoModules[stateLists[state], PackageableOnly];
};

EnumerateGlobalFrames: PUBLIC PROC [
state: ListType, proc: PROC [bh: BHandle, mth: BcdOps.MTHandle] RETURNS [BOOL]] = {
PackageableOnly: PROC [bh: BHandle, mth: BcdOps.MTHandle] RETURNS [BOOL] = {
RETURN[IF mth.packageable THEN proc[bh, mth] ELSE FALSE]};
p: Node _ stateLists[state];
IF p ~= NIL THEN
DO
p _ p.link;
WITH p SELECT FROM
globalframe => IF DoModules[list, PackageableOnly] THEN EXIT;
ENDCASE;
IF p = stateLists[state] THEN EXIT;
ENDLOOP;
};

EnumerateFramePacks: PUBLIC PROC [
state: ListType, proc: PROC [bh: BHandle, fph: BcdOps.FPHandle] RETURNS [BOOL]] = {
p: Node _ stateLists[state];
IF p ~= NIL THEN
DO
p _ p.link;
WITH p SELECT FROM
frame => {
PassItOn: PROC [name: LONG STRING] RETURNS [BOOL] = {
bh: BHandle;
fph: BcdOps.FPHandle;
IF String.EqualString[name, "ALL"L] THEN {
[] _ DoAllFramePacks[proc];
RETURN[TRUE]
};
[bh: bh, fph: fph] _ NameToFPHandle[name];
RETURN[proc[bh, fph]]
};
IF DoNames[list, PassItOn] THEN EXIT;
};
ENDCASE;
IF p = stateLists[state] THEN EXIT;
ENDLOOP;
};

EnumerateSpaces: PUBLIC PROC [
state: ListType, proc: PROC [bh: BHandle, sph: BcdOps.SPHandle, index: CARDINAL] RETURNS [BOOL]] = {
p: Node _ stateLists[state];
IF p ~= NIL THEN
DO
p _ p.link;
WITH p SELECT FROM
space => {
PassItOn: PROC [name: LONG STRING] RETURNS [BOOL] = {
bh: BHandle;
sph: BcdOps.SPHandle;
index: CARDINAL;
IF String.EqualString[name, "ALL"L] THEN {
[] _ DoAllSpaces[proc];
RETURN[TRUE]
};
[bh: bh, sph: sph, index: index] _ NameToSPHandle[name];
RETURN[proc[bh, sph, index]]
};
IF DoNames[list, PassItOn] THEN EXIT;
};
ENDCASE;
IF p = stateLists[state] THEN EXIT;
ENDLOOP;
};

EnumerateBCDs: PUBLIC PROC [state: ListType, proc: PROC [bh: BHandle] RETURNS [BOOL]] = {
p: Node _ stateLists[state];
IF p ~= NIL THEN
DO
p _ p.link;
WITH p SELECT FROM
bcd => {
PassItOn: PROC [name: LONG STRING] RETURNS [BOOL] = {
IF String.EqualString[name, "ALL"L] THEN {
[] _ DoAllBCDs[proc];
RETURN[TRUE]
};
RETURN[proc[NameToCTHandle[name].bh]]
};
IF DoNames[list, PassItOn] THEN EXIT;
};
ENDCASE;
IF p = stateLists[state] THEN EXIT;
ENDLOOP;
};

EnumerateNoTrapModules: PUBLIC PROC [
proc: PROC [bh: BHandle, mth: BcdOps.MTHandle] RETURNS [BOOL]] = {
[] _ DoModules[noTrapList, proc];
};

DoModules: PROC [
tail: Node, proc: PROC [bh: BHandle, mth: BcdOps.MTHandle] RETURNS [BOOL]]
RETURNS [stopped: BOOL] = {
p: Node _ tail;
stopped _ TRUE;
IF p = NIL THEN RETURN[FALSE];
DO
bh: MB.BHandle;
mth: BcdOps.MTHandle;
p _ p.link;
WITH p SELECT FROM
name =>
IF Symbol[hash[name]] = keywords[all] THEN {
IF MB.DoAllModules[proc] THEN RETURN}
ELSE {
[bh: bh, mth: mth] _ NameToMTHandle[TempString[name]];
IF bh ~= NIL AND proc[bh, mth] THEN RETURN;
};
dot => {
[bh: bh, mth: mth] _ InstanceToMTHandle[
module: TempString[module], instance: TempString[instance]];
IF bh ~= NIL AND proc[bh, mth] THEN RETURN;
};
config => {
done: BOOL;
MB.SetConfig[TempString[name]];
<<The syntax equations ensure that we will not recur under the>>
<<following call of DoModules.  This is important since SetConfig>>
<<and ResetConfig do not follow a stack discipline.>>
done _ DoModules[list, proc];
MB.ResetConfig[];
IF done THEN RETURN;
};
code => IF DoModules[list, proc] THEN RETURN;
ENDCASE;  -- skip over space, frame, globalframe, bcd
IF p = tail THEN EXIT;
ENDLOOP;
RETURN[FALSE]
};

DoNames: PROC [tail: Node, proc: PROC [name: LONG STRING] RETURNS [BOOL]]
RETURNS [BOOL] = {
p: Node _ tail;
IF p ~= NIL THEN
DO
p _ p.link;
WITH p SELECT FROM
name => IF proc[TempString[name]] THEN RETURN[TRUE];
ENDCASE => ERROR;
IF p = tail THEN EXIT;
ENDLOOP;
RETURN[FALSE]
};

END.