DIRECTORY
Convert USING [CardFromRope, IntFromRope],
FS USING [StreamOpen],
HashTable USING [Create, EachPairAction, Fetch, HashRope, Insert, Pairs, RopeEqual, Table, Value],
IO USING [card, int, rope, BreakProc, CharClass, Close, CR, GetTokenRope, PutF, PutFR, STREAM],
ParserPrivateDef USING [MkCType, SendError],
Rope USING [ROPE, Cat, Concat, Equal, Length, Substr],
RopeList USING [Cons, Map],
SiroccoPrivate USING [AquireState, CComponent, CComponentBody, CType, CTypeBody, DirectoryEntry, FunctionList, Handle, TABLES, TablesBody],
WartDef USING [Generic, identifierNode, numberDNode, numberHNode, numberONode, RopeNode];
Procs
AddOne:
PUBLIC
PROC [in:
INT]
RETURNS [out:
INT] ~ {
out ← in+1;
};
Add:
PUBLIC
PROC [a, b:
INT]
RETURNS [c:
INT] ~ {
c ← a + b;
};
Subtract:
PUBLIC
PROC [a:
INT, b:
INT]
RETURNS [c:
INT] ~ {
c ← a - b;
};
card:
PUBLIC
PROC [in:
INT]
RETURNS [out:
CARD] ~ {
out ← CARD[in];
};
int:
PUBLIC
PROC [in:
CARD]
RETURNS [out:
INT] ~ {
out ← INT[in];
};
nat:
PUBLIC
PROC [in:
INT]
RETURNS [out:
NAT] ~ {
out ← NAT[in];
};
CheckResultsForSourceAndSink:
PUBLIC
PROC [list: CComponent]
RETURNS [final:
INT] ~ {
WHILE (list #
NIL)
DO
IF (Rope.Equal[list.type, "SOURCE"])
OR Rope.Equal[list.type, "SINK"]
THEN [] ← SendError["Result Has Source or Sink"];
list ← list.sibling
ENDLOOP;
final ← -1;
};
CheckCanonicalType:
PUBLIC
PROC [r1, r2:
ROPE, t:
TABLES]
RETURNS [checked:
TABLES] ~ {
IF
NOT (Rope.Equal[r1, r2])
THEN [] ← SendError[Rope.Cat["Type Mismatch Expected ", r2, " found ", r1]];
checked ← t;
};
ClassToRope:
PROC [class: Generic]
RETURNS [rope:
ROPE] ~ {
SELECT class
FROM
array => rope ← "ARRAY";
procedure => rope ← "PROCEDURE";
sequence => rope ← "SEQUENCE";
boolean => rope ← "BOOLEAN";
cardinal => rope ← "CARDINAL";
longCardinal => rope ← "LONGCARDINAL";
integer => rope ← "INTEGER";
longInteger => rope ← "LONGINTEGER";
string => rope ← "STRING";
unspecified => rope ← "UNSPECIFIED";
error => rope ← "ERROR";
enumeration => rope ← "ENUMERATION";
record => rope ← "RECORD";
choice => rope ← "CHOICE";
bulkDataSource => rope ← "SOURCE";
bulkDataSink => rope ← "SINK";
ENDCASE => ERROR;
};
Collapse:
PUBLIC
PROC ~ {
failure: BOOLEAN;
outStream: IO.STREAM;
tables: TABLES;
h: SiroccoPrivate.Handle;
AddUsedTypes: EachPairAction ~ {
success: BOOLEAN;
type: Value;
ctype: CType;
entry: REF DirectoryEntry;
TraverseCtype:
PUBLIC
PROC [type: CType] ~ {
list: CComponent ← type.children;
success: BOOLEAN;
value: Value;
ctype: CType;
WHILE (list #
NIL)
DO
IF
NOT (Rope.Equal["", list.type]
OR (list.type =
NIL))
THEN {
[success, value] ← HashTable.Fetch[tables.typeTable, list.type];
IF HashTable.Insert[tables.condensedTypeTable, list.type, value]
THEN {
ctype ← NARROW[value];
TraverseCtype[ctype];
};
};
list ← list.sibling;
ENDLOOP;
};
entry ← NARROW[value];
[success, type] ← HashTable.Fetch[tables.typeTable, entry.type];
IF HashTable.Insert[tables.condensedTypeTable, entry.type, type]
THEN {
ctype ← NARROW[type];
TraverseCtype[ctype];
}
ELSE RETURN[FALSE];
};
WriteOutLocalTableEntry: EachPairAction ~ {
keyRope: ROPE ← NARROW[key];
entry: REF DirectoryEntry ← NARROW[value];
FuctionsToDisk:
PROC[name:
ROPE] ~ {
IO.PutF[outStream, "%g|",
IO.rope[name]
];
};
IO.PutF[outStream, "|%g|%g|%g |\nFunctions|",
IO.rope[keyRope],
IO.rope[entry.type],
IO.rope[entry.constant]
];
RopeList.Map[entry.functions, FuctionsToDisk];
IO.PutF[outStream, "~~~~~\n"]
};
WriteOutTypeTableEntry: EachPairAction ~ {
type: CType ← NARROW[value];
keyRope: ROPE ← NARROW[key];
list: CComponent ← type.children;
IO.PutF[outStream, "TYPE|%g|%g|%g|\n",
IO.rope[keyRope],
IO.rope[ClassToRope[type.class]],
IO.card[type.bound]
];
WHILE (list #
NIL)
DO
IO.PutF[outStream, "%g |%g |%g |\n",
IO.rope[list.name],
IO.int[list.val],
IO.rope[list.type]
];
list ← list.sibling;
ENDLOOP;
};
WriteOutFunctionTableEntry: EachPairAction ~ {
IO.PutF[outStream, "%g|%g\n",
IO.rope[NARROW[key]],
IO.rope[NARROW[value]]
]
};
h ← SIGNAL SiroccoPrivate.AquireState;
tables ← h.allTheTables;
failure ← HashTable.Pairs[tables.localTable, AddUsedTypes];
outStream ← FS.StreamOpen[Rope.Concat[h.programKey,"Tables"], $create];
IO.PutF[outStream, "LocalTables\n"];
failure ← HashTable.Pairs[tables.localTable, WriteOutLocalTableEntry];
IO.PutF[outStream, "\nTypeTables\n"];
failure ← HashTable.Pairs[tables.condensedTypeTable, WriteOutTypeTableEntry];
IO.PutF[outStream, "\nTYPE|.\n"];
IO.PutF[outStream, "\nFunctions\n"];
failure ← HashTable.Pairs[tables.functionTable, WriteOutFunctionTableEntry];
IO.PutF[outStream, "\n.\n"];
IO.Close[outStream];
};
CompareTypes:
PUBLIC
PROC [first: CType, second: CType, tables:
TABLES]
RETURNS [
INT ← 1] ~ {
CompareCComponents:
PROC [first: CComponent, second: CComponent] ~ {
firstCtype: CType;
secondCtype: CType;
successful: BOOLEAN;
value: Value;
IF (first =
NIL
OR second =
NIL)
AND NOT (first = NIL AND second = NIL)
THEN ERROR
ELSE
IF first = NIL THEN RETURN;
IF
NOT Rope.Equal[first.name, second.name]
OR first.val # second.val
THEN
[] ← SendError["Type Mismatch"];
IF
NOT Rope.Equal[first.type, second.type]
THEN {
[successful, value] ← HashTable.Fetch[tables.typeTable, first.type];
firstCtype ← NARROW[value];
[successful, value] ← HashTable.Fetch[tables.typeTable, second.type];
secondCtype ← NARROW[value];
[] ← CompareTypes[firstCtype, secondCtype, tables];
};
CompareCComponents[first.sibling, second.sibling];
};
Check on status of unspecified
SELECT first.class
FROM
boolean,
cardinal,
longCardinal,
integer,
longInteger,
string,
unspecified => {
IF (first.class = second.class)
THEN RETURN[1--Just to return an INT--]
ELSE [] ← SendError["Type Mismatch"];
};
enumeration,
record,
choice => {
RETURN[1--Just to return an INT--]; -- Comparison of names already done
};
array,
sequence => {
IF (first.class = second.class)
AND (first.bound = second.bound)
THEN {
CompareCComponents[first.children, second.children];
IF (GetLengthOfCComponentList[first.children, first.bound] # 0)
THEN ERROR;
}
ELSE {
RETURN[1--Just to return an INT--];
};
};
procedure,
error => {
IF (second.class = cardinal)
THEN RETURN[1--Just to return an INT--]
ELSE {
IF (first.class = second.class)
AND (first.bound = second.bound)
THEN {
CompareCComponents[first.children, second.children];
RETURN[1--Just to return an INT--];
}
ELSE
[] ← SendError["Type Mismatch"];
};
};
ENDCASE => {
[] ← SendError["Type Mismatch"];
};
RETURN[1--Just to return an INT--];
};
CopyRope:
PUBLIC
PROC [in:
ROPE]
RETURNS [out:
ROPE] ~ {
out ← in;
};
CopyTables:
PUBLIC
PROC [t1:
TABLES]
RETURNS [t2:
TABLES] ~ {
t2 ← t1;
};
CopyFunctionList:
PUBLIC
PROC [in: FunctionList]
RETURNS [out: FunctionList] ~ {
out ← in;
};
CopyAll:
PUBLIC
PROC [in1:
ROPE, in2: FunctionList, in3:
TABLES]
RETURNS [out1:
ROPE, out2: FunctionList, out3:
TABLES] ~ {
out1 ← in1;
out2 ← in2;
out3 ← in3;
};
CreateCanonicalKey:
PUBLIC
PROC [id: identifierNode, progno: numberDNode, verno: numberDNode]
RETURNS [key:
ROPE] ~ {
h: SiroccoPrivate.Handle;
h ← SIGNAL SiroccoPrivate.AquireState;
h.versionNo ← Convert.IntFromRope[verno.text];
h.programNo ← Convert.IntFromRope[progno.text];
h.programName ← id.text;
h.programKeyWD ←
IO.PutFR["%gP%gV%g",
IO.rope[id.text],
IO.int[Convert.IntFromRope[progno.text]], -- to canonicalize it
IO.int[Convert.IntFromRope[verno.text]] -- ditto
];
key ← h.programKey ← Rope.Concat[h.programKeyWD, "."];
};
CreateKey:
PUBLIC
PROC [id: identifierNode]
RETURNS [key:
ROPE] ~ {
key ← id.text;
};
CreateTables:
PUBLIC
PROC
RETURNS [t:
TABLES] ~ {
h: SiroccoPrivate.Handle;
NewTable:
PROC
RETURNS [new: HashTable.Table] ~ {
new ← HashTable.Create[equal~HashTable.RopeEqual, hash~HashTable.HashRope];
};
InsertValue:
PROC [key:
ROPE, type: Generic]
RETURNS [ok:
BOOLEAN] ~ {
ok ← HashTable.Insert[h.allTheTables.typeTable, key, MkCType[type, 0, NIL]]
};
h ← SIGNAL SiroccoPrivate.AquireState;
h.allTheTables ← NEW[TablesBody];
h.allTheTables.globalTable ← NewTable[];
h.allTheTables.typeTable ← NewTable[];
h.allTheTables.localTable ← NewTable[];
h.allTheTables.unresolvedTypeTable ← NewTable[];
h.allTheTables.unresolvedConstantTable ← NewTable[];
h.allTheTables.workTable ← NewTable[];
h.allTheTables.directory ← NewTable[];
h.allTheTables.errors ← NewTable[];
h.allTheTables.procedures ← NewTable[];
h.allTheTables.condensedTypeTable ← NewTable[];
h.allTheTables.functionTable ← NewTable[];
h.allTheTables.condensedFunctionTable ← NewTable[]; XXXX
Put Predefined Values: integer, boolean, etc. into the table
IF NOT (InsertValue["BOOLEAN", boolean]) THEN ERROR;
IF NOT (InsertValue["CARDINAL", cardinal]) THEN ERROR;
IF NOT (InsertValue["LONGCARDINAL", longCardinal]) THEN ERROR;
IF NOT (InsertValue["INTEGER", integer]) THEN ERROR;
IF NOT (InsertValue["LONGINTEGER", longInteger]) THEN ERROR;
IF NOT (InsertValue["STRING", string]) THEN ERROR;
IF NOT (InsertValue["UNSPECIFIED", unspecified]) THEN ERROR;
IF NOT (InsertValue["SOURCE", bulkDataSource]) THEN ERROR;
IF NOT (InsertValue["SINK", bulkDataSink]) THEN ERROR;
RETURN[h.allTheTables] ;
};
DiskToTable:
PUBLIC
PROC [t1:
TABLES, id: identifierNode, progno: numberDNode, verno: numberDNode]
RETURNS [new:
TABLES] ~ {
info: REF DirectoryEntry;
keyRope: ROPE;
sibling: CComponent;
sourceStream: IO.STREAM ← FS.StreamOpen[Rope.Concat[ProgramFile[], ".Tables"]];
successful: BOOLEAN;
table: HashTable.Table ← HashTable.Create[equal~HashTable.RopeEqual, hash~HashTable.HashRope];
token: ROPE;
type: CType;
ProgramFile:
PROC
RETURNS [name:
ROPE] ~ {
name ←
IO.PutFR["%gP%gV%g",
IO.rope[id.text],
IO.int[Convert.IntFromRope[progno.text]],
IO.int[Convert.IntFromRope[verno.text]]
];
};
NextToken:
PROC
RETURNS [text:
ROPE] ~ {
charsSkipped: INT;
[text, charsSkipped] ← IO.GetTokenRope[sourceStream, Control];
};
Control:
IO.BreakProc ~ {
SELECT char
FROM
IO.CR, '| => RETURN[sepr];
ENDCASE => RETURN[other];
};
Normalize:
PROC [arg:
ROPE]
RETURNS [res:
ROPE] ~ {
length: INT ← Rope.Length[arg];
res ←
IF (length = 1)
THEN ""
ELSE Rope.Substr[arg, 0, length-1];
};
TokenToInt:
PROC [arg:
ROPE]
RETURNS [res:
INT] ~ {
length: INT ← Rope.Length[arg];
res ←
IF (length = 1)
THEN 0
ELSE Convert.IntFromRope[Rope.Substr[arg, 0, length-1]];
};
[] ← HashTable.Insert[t1.directory, id.text, ProgramFile[]];
token ← NextToken[]; -- Skip Heading
keyRope ← token ← NextToken[]; -- Get First Key
WHILE (
NOT Rope.Equal[keyRope, "TypeTables"])
DO
-- While Local Table is not exhausted
info ← NEW[DirectoryEntry];
info.type ← token ← NextToken[];
info.constant ← Normalize[token ← NextToken[]];
token ← NextToken[]; -- Throw away Function Header
token ← NextToken[];
WHILE
NOT Rope.Equal[token, "~~~~~"]
DO
info.functions ← RopeList.Cons[info.functions, token];
token ← NextToken[];
ENDLOOP;
info.value ← NIL;
successful ← HashTable.Insert[table, keyRope, info];
keyRope ← token ← NextToken[];
ENDLOOP;
[] ← HashTable.Insert[t1.globalTable, id.text, table]; -- Local Tables over
token ← NextToken[]; -- Skip Type Heading
keyRope ← token ← NextToken[]; -- Get First Type Name
WHILE (
NOT Rope.Equal[keyRope, "."])
DO
-- Process Type Table
type ← NEW[CTypeBody]; -- Allocate CType
type.class ← RopeToClass[token ← NextToken[]]; -- Get Class
type.bound ← Convert.CardFromRope[token ← NextToken[]]; -- Get bound
token ← NextToken[];
IF
NOT Rope.Equal[token, "TYPE"]
THEN {
-- Are there any children
sibling ← NEW[CComponentBody];
type.children ← sibling --First Child
};
WHILE (
NOT Rope.Equal[token, "TYPE"])
DO
sibling.name ← Normalize[token];
sibling.val ← TokenToInt[token ← NextToken[]];
sibling.type ← Normalize[token ← NextToken[]];
token ← NextToken[];
IF (
NOT Rope.Equal[token, "TYPE"])
THEN {
sibling.sibling ← NEW[CComponentBody]; --Rest Of the Children
sibling ← sibling.sibling;
}
ENDLOOP;
[] ← HashTable.Insert[t1.typeTable, keyRope, type]; -- Enter Type
keyRope ← token ← NextToken[]; -- Get Next Type Name
ENDLOOP;
token ← NextToken[]; --Skip Header
keyRope ← token ← NextToken[];
WHILE (
NOT Rope.Equal[keyRope, "."])
DO
token ← NextToken[];
[] ← HashTable.Insert[t1.functionTable, keyRope, token];
keyRope ← token ← NextToken[];
ENDLOOP;
new ← t1;
};
FetchFromGlobalTable:
PUBLIC
PROC [t1:
TABLES, key:
ROPE]
RETURNS [value: HashTable.Table] ~ {
successful: BOOLEAN;
temp: Value;
[successful, temp] ← HashTable.Fetch[t1.globalTable, key];
IF (NOT successful) THEN ERROR;
value ← NARROW[temp];
};
GetCardFromDecimal:
PUBLIC
PROC [decimal: numberDNode]
RETURNS [card:
CARD] ~ {
card ← Convert.CardFromRope[decimal.text];
};
GetCardFromHex:
PUBLIC
PROC [hex: numberHNode]
RETURNS [card:
CARD] ~ {
card ← Convert.CardFromRope[hex.text, 16];
};
GetCardFromOctal:
PUBLIC
PROC [octal: numberONode]
RETURNS [card:
CARD] ~ {
card ← Convert.CardFromRope[octal.text, 8];
};
GetCType:
PUBLIC
PROC [ id: identifierNode, list: CComponent, tables:
TABLES]
RETURNS [type: CType ←
NIL, name:
ROPE ← ""] ~ {
successful: BOOLEAN;
temp: Value;
templist: CComponent;
templist ← list;
WHILE (templist #
NIL)
AND (NOT Rope.Equal[id.text, templist.name]) DO
templist ← templist.sibling;
ENDLOOP;
IF (templist =
NIL)
THEN [] ← SendError["Type Mismatch"]
ELSE {
name ← templist.type;
[successful, temp] ← HashTable.Fetch[tables.typeTable, name];
IF
NOT successful
THEN ERROR -- COMILER ERROR
ELSE type ← NARROW[temp];
};
};
GetLengthOfCComponentList:
PUBLIC
PROC [list: CComponent, initial:
INT]
RETURNS [final:
INT] ~ {
WHILE (list #
NIL)
DO
initial ← initial - 1;
list ← list.sibling
ENDLOOP;
final ← 0 - initial;
IF (final >= 0)
THEN
{
final ← 0 - initial;
RETURN;
}
ELSE [] ← SendError["Type Mismatch"]; -- LIST OF INCORRECT LENGTH
final ← -1;
};
RopeToClass:
PROC [rope:
ROPE]
RETURNS [class: Generic] ~ {
SELECT
TRUE
FROM
Rope.Equal[rope, "ARRAY"] => class ← array;
Rope.Equal[rope, "PROCEDURE"] => class ← procedure;
Rope.Equal[rope, "SEQUENCE"] => class ← sequence;
Rope.Equal[rope, "BOOLEAN"] => class ← boolean;
Rope.Equal[rope, "CARDINAL"] => class ← cardinal;
Rope.Equal[rope, "LONGCARDINAL"] => class ← longCardinal;
Rope.Equal[rope, "INTEGER"] => class ← integer;
Rope.Equal[rope, "LONGINTEGER"] => class ← longInteger;
Rope.Equal[rope, "STRING"] => class ← string;
Rope.Equal[rope, "UNSPECIFIED"] => class ← unspecified;
Rope.Equal[rope, "ERROR"] => class ← error;
Rope.Equal[rope, "ENUMERATION"] => class ← enumeration;
Rope.Equal[rope, "RECORD"]=> class ← record;
Rope.Equal[rope, "CHOICE"] => class ← choice;
Rope.Equal[rope, "SOURCE"] => class ← bulkDataSource;
Rope.Equal[rope, "SINK"] => class ← bulkDataSink;
ENDCASE => ERROR;
};
RopeTokenToROPE:
PUBLIC
PROC [r: RopeNode]
RETURNS [rope:
ROPE] ~ {
quote: ROPE ~ """";
rope ← Rope.Cat[quote, r.text, quote];
};
SeeIfArrOrSeq:
PUBLIC
PROC [first: CType, size:
CARD, tables:
TABLES]
RETURNS [type: CType ←
NIL, name:
ROPE ← ""] ~ {
successful: BOOLEAN;
value: Value;
IF (first.class # array)
AND (first.class # sequence)
THEN [] ← SendError["Type Mismatch"]
ELSE {
[successful, value] ← HashTable.Fetch[tables.typeTable, first.children.type];
IF (NOT successful) THEN ERROR;
type ← NARROW[value];
IF (first.class = array)
AND (first.bound # size)
THEN [] ← SendError["Wrong No. Of Array Elements in Constant"];
IF (first.class = sequence)
AND (first.bound < size)
THEN [] ← SendError["No. Of Sequence Elements exceeds declared bound in Constant"];
name ← first.children.type;
}
};
}...