-- MDParseImpl.mesa
-- last edit by Schmidt, January 6, 1983 1:59 pm
-- last edit by Satterthwaite, February 9, 1983 10:37 am
-- Parser for the system modeller
DIRECTORY
CWF: TYPE USING [WF0, WF1, WF2, WFC],
Dir: TYPE USING [AddToDep, ADepRecord, DepSeq],
FileStream: TYPE USING [EndOf],
LongString: TYPE USING [EqualString],
MDModel: TYPE USING [
LISTSymbol, MODELSymbol, ParseLoc, Sym, Symbol, SymbolSeq, TraverseTree],
ModelParseData: TYPE,
P1: FROM "ModelParseDefs" USING [GuaranteeScannerCleanedUp, StreamId, TableId],
Runtime: TYPE USING [GetTableBase],
STPSubr: TYPE USING [StopSTP],
Stream: TYPE USING [Delete, GetChar, Handle],
Subr: TYPE USING [
AllocateString, FreeString, GetChar, LongZone, NewStream, Read, strcpy,
TTYProcs, Write],
TypeScript: TYPE USING [TS],
UnsafeSTP: TYPE USING [Error];
MDParseImpl: PROGRAM
IMPORTS
CWF, Dir, FileStream, LongString, MDModel, ModelParseData, P1, Runtime,
STP: UnsafeSTP, STPSubr, Stream, Subr
EXPORTS MDModel, P1 = {
-- be sure to update array TokString if you change this
Token: TYPE = {
tokBAD, tokEOF, tokLB, tokRB, tokDOT, tokCOLON, tokCOMMA,
tokEQ, tokTWIDDLE, tokSEMI, tokID, tokNUM, tokTYPE, tokRETURNS,
tokSTRLIT, tokFROM, tokDIR, tokIMPORTS, tokEXPORTS, tokPROGRAM,
tokBEGIN, tokDEFINITIONS, tokCONFIG, tokEND, tokUSING, tokSHARES,
tokMONITOR, tokCEDAR};
-- MDS usage!!!
tablesegptr: LONG POINTER; -- ??
logsh: Stream.Handle ← NIL;
streamstack: ARRAY[0 .. 15) OF Stream.Handle ← ALL[NIL];
streaminx: CARDINAL ← 0;
parseRoot: PUBLIC MDModel.LISTSymbol ← NIL; -- exported to MDModel
-- for config scanner
peektok: Token;
peekvalue: LONG STRING;
nextchar: CHAR;
init: BOOL ← FALSE;
savestr: LONG STRING ← NIL;
toksave: LONG STRING ← NIL;
-- the parser will close sh for you!!!
ModelParse: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, typeScript: TypeScript.TS,
ttywindow: Subr.TTYProcs] = {
Cleanup: PROC = {
IF logsh ~= NIL THEN Stream.Delete[logsh];
logsh ← NIL;
streaminx ← 0;
P1.GuaranteeScannerCleanedUp[]};
{
ENABLE {
UNWIND => Cleanup[];
STP.Error => {
CWF.WF0["FTP Error. "L];
IF error ~= NIL THEN CWF.WF1["message: %s\n"L,error];
Cleanup[];
GOTO leave};
};
nerrors: CARDINAL;
[symmodel: symbolseq.toploc.nestedmodel, nerrors: nerrors] ←
(symbolseq.toploc).ParseLoc[typeScript, ttywindow];
-- close connections in case any files were brought over
STPSubr.StopSTP[];
P1.GuaranteeScannerCleanedUp[];
IF logsh ~= NIL THEN {
sh: Stream.Handle;
Stream.Delete[logsh]; logsh ← NIL;
-- since there were parsing errors,
-- get rid of the internal data structures
symbolseq.toploc.nestedmodel ← NIL;
CWF.WF0["Parser error log stored on 'ModelParser.ErrLog'\n"L];
sh ← Subr.NewStream["ModelParser.ErrLog"L, Subr.Read];
UNTIL FileStream.EndOf[sh] DO
CWF.WFC[Stream.GetChar[sh]];
ENDLOOP;
Stream.Delete[sh]};
IF symbolseq.toploc.nestedmodel ~= NIL THEN CheckDefined[symbolseq];
streaminx ← 0;
EXITS
leave => NULL;
}};
PushInputStream: PUBLIC PROC[sh: Stream.Handle] = {
IF streaminx >= streamstack.LENGTH THEN ERROR;
streamstack[streaminx] ← sh;
streaminx ← streaminx + 1};
StreamPop: PROC RETURNS[sh: Stream.Handle] = {
IF streaminx = 0 THEN ERROR;
streaminx ← streaminx - 1;
RETURN[streamstack[streaminx]]};
-- exported to P1, called by P1.Parse[]
AcquireStream: PUBLIC PROC [id: P1.StreamId] RETURNS [Stream.Handle] = {
SELECT id FROM
$source => RETURN[streamstack[streaminx-1]];
$log => {
IF logsh = NIL THEN logsh ← Subr.NewStream["ModelParser.ErrLog"L, Subr.Write];
RETURN[logsh]};
ENDCASE => ERROR};
ReleaseStream: PUBLIC PROC [id: P1.StreamId] = {
SELECT id FROM
$source => {
-- this is currently not used because the
-- scanner frees these in ResetScanIndex in ModelScannerImpl
sh: Stream.Handle ← StreamPop[];
Stream.Delete[sh]};
$log => NULL
ENDCASE => ERROR};
AcquireTable: PUBLIC PROC [id: P1.TableId] RETURNS [LONG POINTER] = {
RETURN[IF id = $parse THEN tablesegptr ELSE ERROR]};
ReleaseTable: PUBLIC PROC [id: P1.TableId] = {
IF id = $parse THEN NULL ELSE ERROR};
--
CheckDefined: PROC[symbolseq: MDModel.SymbolSeq] = {
Proc: PROC[sp: MDModel.Symbol, spmodel: MDModel.MODELSymbol]
RETURNS[proceed: BOOL ← TRUE] = {
SELECT sp.stype FROM
$typeTYPE, $typePROC, $typeAPPL =>
IF ~sp.defn THEN
CWF.WF2["In %s: %s not defined.\n"L, spmodel.modelfilename, MDModel.Sym[sp]];
$typeLET => RETURN[FALSE];
ENDCASE => NULL};
(symbolseq.toploc).TraverseTree[symbolseq, Proc]};
-- produces depseq where bcdfilename[i] does not end in "bcd"
-- parse the stream handle,
-- it turns out we ignore IMPORTS and EXPORTS since those entries must appear
-- in the DIRECTORY clause
ParseUnit: PUBLIC PROC[sh: Stream.Handle, depseq: Dir.DepSeq, sfn: LONG STRING] = {
tok: Token ← $tokBAD;
tokvalue: LONG STRING;
str: LONG STRING;
stemp: STRING ← [100];
imp, isconfig, isdefns: BOOL ← FALSE;
savename: STRING ← [100];
formal: STRING ← [100];
ScanInit[sh];
WHILE tok ~= $tokBEGIN AND tok ~= $tokEOF DO
SELECT tok FROM
$tokDIR => [tok, tokvalue] ← Direct[sh, depseq, sfn];
$tokCONFIG => {
IF savename.length # 0 THEN
depseq.moduleName ← depseq.CopyString[savename];
isconfig ← TRUE;
[tok,tokvalue] ← NextTok[sh]};
$tokPROGRAM, $tokMONITOR => {
IF savename.length # 0 THEN
depseq.moduleName ← depseq.CopyString[savename];
isconfig ← FALSE;
[tok,tokvalue] ← NextTok[sh]};
$tokDEFINITIONS => {
IF savename.length # 0 THEN
depseq.moduleName ← depseq.CopyString[savename];
isdefns ← TRUE;
[tok,tokvalue] ← NextTok[sh]};
$tokIMPORTS, $tokEXPORTS => {
imp ← tok = $tokIMPORTS;
[tok, tokvalue] ← NextTok[sh];
WHILE tok = $tokID OR tok = $tokCOMMA DO
IF tok = $tokID THEN {
adeprecord: Dir.ADepRecord ← [relation: IF imp THEN $imports ELSE $exports];
str ← tokvalue;
Subr.strcpy[formal, str];
-- str: str
-- formal: str
IF peektok = $tokCOLON THEN {
[tok, tokvalue] ← NextTok[sh];
[tok, tokvalue] ← NextTok[sh];
str ← tokvalue};
-- bcdFileName is the formal
-- moduleName is the type name
adeprecord.bcdFileName ← depseq.CopyString[formal];
adeprecord.moduleName ← depseq.CopyString[str];
Dir.AddToDep[depseq, @adeprecord]};
[tok, tokvalue] ← NextTok[sh];
ENDLOOP};
$tokID => { -- this may be the module name
Subr.strcpy[savename, tokvalue];
[tok,tokvalue] ← NextTok[sh]};
ENDCASE => [tok,tokvalue] ← NextTok[sh];
ENDLOOP;
depseq.isconfig ← isconfig;
depseq.isdefns ← isdefns;
-- currently do not need to parse the body of a config
-- IF isconfig THEN tok ← ConfigBody[sh, sfn, depseq];
RETURN};
-- Interface: FROM "FileName": TYPE USING [a,b,c],;
-- Interface: TYPE USING [a,b,c],;
-- Interface ,;
-- FileName: TYPE Interface
-- FileName: TYPE
Direct: PROC [sh: Stream.Handle, depseq: Dir.DepSeq, sfn: LONG STRING]
RETURNS[tok: Token, tokvalue: LONG STRING] = {
CheckTok: PROC[tokshouldbe: Token] = {
IF tok ~= tokshouldbe THEN {
CWF.WF0["Token is "L]; PrintTok[tok];
CWF.WF0[", should be "L]; PrintTok[tokshouldbe];
CWF.WF1[", in file %s\n"L, sfn]}};
[tok,tokvalue] ← NextTok[sh];
WHILE tok ~= $tokPROGRAM AND tok ~= $tokEOF AND tok ~= $tokDEFINITIONS
AND tok ~= $tokSEMI AND tok~= $tokCONFIG DO
IF tok = $tokID THEN {
adeprecord: Dir.ADepRecord ← [relation: $directory];
filename: LONG STRING ← tokvalue;
interface: STRING ← [100];
Subr.strcpy[interface, filename];
[tok, tokvalue] ← NextTok[sh];
IF tok = $tokCOLON THEN {
[tok, tokvalue] ← NextTok[sh];
SELECT tok FROM
$tokTYPE => {
IF peektok = $tokID THEN {
stemp: STRING ← [40];
[tok, tokvalue] ← NextTok[sh];
filename ← tokvalue;
Subr.strcpy[stemp, filename];
Subr.strcpy[filename, interface];
Subr.strcpy[interface, stemp]}};
$tokFROM => {
IF peektok = $tokSTRLIT THEN [tok, tokvalue] ← NextTok[sh];
Subr.strcpy[filename, interface]};
ENDCASE => CheckTok[$tokTYPE]};
-- filename will not have ".bcd" at end
adeprecord.bcdFileName ← depseq.CopyString[filename];
adeprecord.moduleName ← depseq.CopyString[interface];
Dir.AddToDep[depseq, @adeprecord];
WHILE tok ~= $tokCOMMA AND tok ~= $tokSEMI AND tok ~= $tokEOF
AND tok ~= $tokPROGRAM AND tok ~= $tokDEFINITIONS AND
tok ~= $tokCONFIG DO
IF tok = $tokLB THEN {
WHILE tok ~= $tokEOF AND tok ~= $tokRB DO
[tok,tokvalue] ← NextTok[sh];
ENDLOOP;
CheckTok[$tokRB]};
[tok,tokvalue] ← NextTok[sh];
ENDLOOP}
ELSE [tok,tokvalue] ← NextTok[sh];
ENDLOOP;
RETURN};
-- initiallizes the various data structures
ScanInit: PROC [st: Stream.Handle] = {
IF ~init THEN Init[];
peektok ← $tokBAD;
peekvalue ← NIL;
nextchar ← '\n;
[] ← NextTok[st]};
-- to free this memory, simply call StopScanner
Init: PROC = {
longzone: UNCOUNTED ZONE = Subr.LongZone[];
init ← TRUE;
savestr ← Subr.AllocateString[200];
toksave ← Subr.AllocateString[200]};
-- frees memory as needed, call only once
StopScanner: PUBLIC PROC = {
longzone: UNCOUNTED ZONE = Subr.LongZone[];
IF ~init THEN RETURN; -- Init never called
Subr.FreeString[toksave];
Subr.FreeString[savestr];
savestr ← toksave ← NIL;
init ← FALSE};
-- NOTE: this checks the type of Token in case the string literal must be saved
NextTok: PROC [st: Stream.Handle] RETURNS[tok: Token, tokvalue: LONG STRING] = {
tok ← peektok;
IF tok = $tokID OR tok = $tokSTRLIT THEN {
Subr.strcpy[toksave,peekvalue];
tokvalue ← toksave}
ELSE tokvalue ← peekvalue;
[peektok,peekvalue] ← ReadTok[st];
RETURN};
ReadTok: PROC [st: Stream.Handle] RETURNS[toktype: Token, tokval: LONG STRING] = {
i: CARDINAL;
lastchar: CHAR;
DO
WHILE nextchar = ' OR nextchar = '\n OR nextchar = '\t OR nextchar = '\f DO
nextchar ← Subr.GetChar[st]
ENDLOOP;
IF IsAlpha[nextchar] THEN {
i ← 0;
WHILE (IsAlpha[nextchar] OR IsDigit[nextchar]) AND i <= savestr.maxlength DO
savestr[i] ← nextchar;
i ← i + 1;
nextchar ← Subr.GetChar[st];
ENDLOOP;
savestr.length ← i;
toktype ← KeywordLookup[savestr];
RETURN (IF toktype ~= $tokBAD THEN [toktype,NIL] ELSE [$tokID,savestr])}
ELSE IF IsDigit[nextchar] THEN {
i ← 0;
WHILE IsDigit[nextchar] AND i <= savestr.maxlength DO
savestr[i] ← nextchar;
i ← i+1;
nextchar ← Subr.GetChar[st];
ENDLOOP;
savestr.length ← i;
RETURN[$tokNUM,savestr]}
ELSE {
lastchar ← nextchar;
nextchar ← Subr.GetChar[st];
SELECT lastchar FROM
'[ => toktype ← $tokLB;
'] => toktype ← $tokRB;
'{ => toktype ← $tokBEGIN;
'} => toktype ← $tokEND;
'. => toktype ← $tokDOT;
': => toktype ← $tokCOLON;
', => toktype ← $tokCOMMA;
'; => toktype ← $tokSEMI;
'~ => toktype ← $tokTWIDDLE;
'\000 => toktype ← $tokEOF; -- Tioga
'= => toktype ← $tokEQ;
'- => {
IF nextchar ~= '- THEN CWF.WF0["bad comment\n"L];
nextchar ← Subr.GetChar[st];
WHILE nextchar ~= '\n AND nextchar ~= '\000 DO
IF nextchar = '- THEN {
nextchar ← Subr.GetChar[st];
IF nextchar = '- THEN EXIT};
nextchar ← Subr.GetChar[st];
ENDLOOP;
nextchar ← Subr.GetChar[st];
LOOP};
'" => {
i ← 0;
WHILE i < savestr.maxlength DO
savestr[i] ← nextchar;
nextchar ← Subr.GetChar[st];
i ← i + 1;
IF nextchar = '" THEN {
nextchar ← Subr.GetChar[st];
IF nextchar = '" THEN LOOP;
EXIT};
REPEAT
FINISHED => CWF.WF0["String literal too long\n"L];
ENDLOOP;
savestr.length ← i;
RETURN[$tokSTRLIT, savestr]};
ENDCASE => {
i: INTEGER ← lastchar.ORD;
CWF.WF1["unknown char %c\n"L,@i];
toktype ← $tokEOF};
RETURN[toktype,NIL]};
ENDLOOP};
KeywordLookup: PROC[str: LONG STRING] RETURNS[tok: Token] = {
-- return the tok if found, return $tokBAD if error
OPEN LongString;
SELECT str.length FROM
3 =>
IF EqualString[str,"END"L] THEN RETURN[$tokEND];
4 => {
IF EqualString[str,"FROM"L] THEN RETURN[$tokFROM];
IF EqualString[str,"TYPE"L] THEN RETURN[$tokTYPE]};
5 => {
IF EqualString[str,"BEGIN"L] THEN RETURN[$tokBEGIN];
IF EqualString[str,"CEDAR"L] THEN RETURN[$tokCEDAR];
IF EqualString[str,"USING"L] THEN RETURN[$tokUSING]};
6 =>
IF EqualString[str,"SHARES"L] THEN RETURN[$tokSHARES];
7 => {
IF EqualString[str,"EXPORTS"L] THEN RETURN[$tokEXPORTS];
IF EqualString[str,"IMPORTS"L] THEN RETURN[$tokIMPORTS];
IF EqualString[str,"MONITOR"L] THEN RETURN[$tokMONITOR];
IF EqualString[str,"PROGRAM"L] THEN RETURN[$tokPROGRAM];
IF EqualString[str,"RETURNS"L] THEN RETURN[$tokRETURNS]};
9 =>
IF EqualString[str,"DIRECTORY"L] THEN RETURN[$tokDIR];
11 =>
IF EqualString[str,"DEFINITIONS"L] THEN RETURN[$tokDEFINITIONS];
13 =>
IF EqualString[str,"CONFIGURATION"L] THEN RETURN[$tokCONFIG];
ENDCASE => NULL;
RETURN[$tokBAD]};
PrintTok: PROC [tok: Token] = {
TokString: ARRAY Token OF STRING = [
"ErrorToken"L, "EndOfFile"L, "["L, "]"L, "."L, ":"L, ","L,
"="L, "~"L, ";"L, "Identifier"L, "Number"L, "TYPE"L, "RETURNS"L,
"StringLiteral"L, "FROM"L, "DIRECTORY"L,"IMPORTS"L, "EXPORTS"L, "PROGRAM"L,
"{"L, "DEFINITIONS"L, "CONFIGURATION", "END"L, "USING"L, "SHARES"L,
"MONITOR"L, "CEDAR"L];
CWF.WF0[TokString[tok]]};
IsDigit: PROC[c: CHAR] RETURNS[BOOL] = INLINE {
RETURN[c IN ['0 .. '9]]};
IsAlpha: PROC[c: CHAR] RETURNS[BOOL] = INLINE {
RETURN[c IN ['a .. 'z] OR c IN ['A .. 'Z]]};
-- START code
tablesegptr ← Runtime.GetTableBase[LOOPHOLE[ModelParseData]];
}.