SiroccoBase2Impl.Mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Bhargava, August 11, 1986 10:36:33 am PDT
Demers, January 3, 1987 3:12:22 pm PST
Bill Jackson (bj) August 14, 1987 6:58:39 pm PDT
DIRECTORY
Convert USING [ RopeFromCard, RopeFromInt ],
IO USING [ card, int, rope, PutF, PutFR, STREAM ],
PriorityQueue USING [ Insert ],
Rope USING [ ROPE, Cat, Equal ],
SiroccoATDef USING [ ConstantNode, TypeNode ],
SiroccoBaseDef USING [ CreateTables ],
SiroccoCGDef USING [ Generic ],
SiroccoPrivate USING [ AquireState, CComponent, CType, EndItAll, Handle, MakeUpName, PQItem, TABLES, UnresolvedConstantTableEntry ],
SymTab USING [ Delete, Erase, GetSize, Insert ],
ThreeC4Support USING [ GetReportStream, GetSourceInfo ];
SiroccoBase2Impl:
CEDAR
PROGRAM
IMPORTS SiroccoBaseDef, Convert, IO, PriorityQueue, Rope, SiroccoPrivate, SymTab, ThreeC4Support
EXPORTS SiroccoBaseDef ~ {
OPEN SiroccoPrivate;
ROPE: TYPE ~ Rope.ROPE;
LocalConstantToRope: PUBLIC PROC [id: ROPE, constantType: ROPE,
tables: TABLES] RETURNS [rope: ROPE, tables1: TABLES] ~ {
tables1 ← tables;
WITH SymTab.Fetch[tables.localTable, id].val SELECT FROM
info: REF InterfaceItem => {
IF ( Rope.IsEmpty[info.constant] ) THEN {
const: SiroccoATDef.ConstantNode ~ NARROW[info.value];
[info.constant, tables1] ← const.procs.ConstantToRope[info.value, info.type, tables];
};
rope ← info.constant;
};
ENDCASE => {
rope ← Rope.Concat[id, " "]; -- Enumeration Constant
};
};
CanonicalLocalReferenceType: PUBLIC PROC [id: ROPE, t1: TABLES]
RETURNS [ cannonicalType: ROPE, typeTree: CType, t2: TABLES ] ~ {
h: SiroccoPrivate.Handle ← SIGNAL SiroccoPrivate.AquireState[];
ReturnCanonicalKey: PUBLIC PROC [id: ROPE] RETURNS [key: ROPE] ~ {
key ← Rope.Cat[h.programKey, id];
};
t2 ← t1;
WITH SymTab.Fetch[t1.localTable, id].val SELECT FROM
info: REF InterfaceItem => {
WITH SymTab.Fetch[t1.typeTable, info.type].val SELECT FROM
type: CType => {
cannonicalType ← info.type;
typeTree ← type;
RETURN;
};
ENDCASE => { [] ← SendError["Compiler Error"]; };
};
ENDCASE => { NULL }; -- fall thru
WITH SymTab.Fetch[t1.unresolvedTypeTable, id].val SELECT FROM
typeNode: SiroccoATDef.TypeNode => {
IF ( NOT SymTab.Store[t1.unresolvedTypeTable, id, NIL] )
THEN {
info: REF InterfaceItem;
successful: BOOLEAN;
[cannonicalType, typeTree, t1] ← typeNode.procs.CanonicalType[typeNode, t1];
IF ( Rope.Equal[cannonicalType, "DEFAULT"] )
THEN cannonicalType ← ReturnCanonicalKey[id];
successful ← SymTab.Insert[t1.typeTable, cannonicalType, typeTree];
Should Sucessful always be true? No As in the case of Integers
info ← NEW[InterfaceItem ← [type~cannonicalType, constant~"", functions~NIL, value~NIL]];
IF ( NOT SymTab.Insert[t1.localTable, id, info] )
THEN [] ← SendError["Compiler Error"];
-- (The Redeclaration should have been caught while entering stuff in the UnresolvedTypeTable)
RETURN;
}
ELSE [] ← SendError["Compiler Error"];
}
ENDCASE => {
[] ← SendError["Undeclared Identifier"];
};
};
CheckIfEmpty:
PUBLIC
PROC [tables:
TABLES]
RETURNS [empty
: BOOLEAN] ~ {
empty ← TRUE;
IF ( SymTab.GetSize[tables.workTable] # 0 )
THEN [] ← SendError["Missing Enumeration in Choice"];
};
ClearWorkTable:
PUBLIC
PROC [tables:
TABLES]
RETURNS [new:
TABLES] ~ {
SymTab.Erase[tables.workTable];
new ← tables;
};
CompareClass:
PUBLIC
PROC [first: CType, second: SiroccoCGDef.Generic]
RETURNS [comp: CComponent] ~ {
IF ( first.class # second ) THEN [] ← SendError["Type Mismatch"];
comp ← first.children;
};
EnterNamesIntoWorkTable:
PUBLIC
PROC [ctype: CType, tables:
TABLES]
RETURNS [new:
TABLES] ~ {
SymTab.Erase[tables.workTable];
FOR list: CComponent ← ctype.children, list.sibling
WHILE ( list #
NIL )
DO
IF ( NOT SymTab.Insert[tables.workTable, list.name, ""] ) THEN ERROR;
ENDLOOP;
new ← tables;
};
FillWorkTable:
PUBLIC
PROC [type: CType, tables:
TABLES]
RETURNS [new:
TABLES] ~ {
length: INT ← -1;
SymTab.Erase[tables.workTable];
FOR list: CComponent ← type.children, list.sibling
WHILE ( list #
NIL )
DO
IF ( NOT SymTab.Insert[tables.workTable, list.name, ""] ) THEN ERROR;
IF ( NOT SymTab.Insert[tables.workTable, Convert.RopeFromInt[list.val], ""] ) THEN ERROR;
length ← length.SUCC;
ENDLOOP;
WHILE ( length >= 0 )
DO
IF ( NOT SymTab.Delete[tables.workTable, Convert.RopeFromInt[length]] )
THEN [] ← SendError["Enumeration not Continuous, hence cannot be used as tag for Choice"];
length ← length.PRED;
ENDLOOP;
new ← tables;
};
GetConstantType: PUBLIC PROC [id: ROPE, t1: TABLES]
RETURNS [cannonicalType: ROPE, typeTree: CType,
constant: SiroccoATDef.ConstantNode, table: TABLES ] ~ {
h: SiroccoPrivate.Handle ← SIGNAL SiroccoPrivate.AquireState[];
ReturnCanonicalKey: PUBLIC PROC [id: ROPE] RETURNS [key: ROPE] ~ {
key ← Rope.Cat[h.programKey, id];
};
table ← t1;
WITH SymTab.Fetch[t1.localTable, id].val SELECT FROM
info: REF InterfaceItem => { -- Already resolved
WITH SymTab.Fetch[t1.typeTable, info.type].val SELECT FROM
ctype: CType => {
typeTree ← ctype;
cannonicalType ← info.type;
constant ← NARROW[info.value];
RETURN;
};
ENDCASE => {
[] ← SendError["Compiler Error"];
};
}
ENDCASE => { -- Unresolved
WITH SymTab.Fetch[t1.unresolvedConstantTable, id].val SELECT FROM
value: REF UnresolvedConstantTableEntry => {
Must be succesful if name was declared
IF ( NOT SymTab.Store[t1.unresolvedConstantTable, id, NIL] )
THEN { -- if new declaration
IF ( value # NIL )
THEN {
tNode: SiroccoATDef.TypeNode ~ NARROW[value.type];
cNode: SiroccoATDef.ConstantNode ~ NARROW[value.constant];
info: REF InterfaceItem ~ NEW[InterfaceItem];
successful: BOOLEAN;
[cannonicalType, typeTree, t1] ← tNode.procs.CanonicalType[value.type, t1];
IF ( Rope.Equal["DEFAULT", cannonicalType] )
THEN cannonicalType ← ReturnCanonicalKey[id];
successful ← SymTab.Insert[t1.typeTable, cannonicalType, typeTree];
t1 ← cNode.procs.Coerce[value.constant, typeTree, cannonicalType, t1];
info.type ← cannonicalType;
info.constant ← "";
info.functions ← NIL;
[info.constant, t1] ← cNode.procs.ConstantToRope[value.constant, cannonicalType, t1];
info.value ← value.constant;
constant ← NARROW[value.constant];
successful ← SymTab.Insert[t1.localTable, id, info];
RETURN;
}
ELSE { -- already being processed
[] ← SendError["Cyclic Dependancy"]
};
}
ELSE [] ← SendError["Compiler Error"];
}
ENDCASE => {
[] ← SendError["Undeclared Identifier"];
};
};
};
GetCTypeFirstChild:
PUBLIC
PROC [first: CType]
RETURNS [comp: CComponent] ~ {
comp ← first.children;
};
InsureErrorType: PUBLIC PROC [id: ROPE, t: TABLES]
RETURNS [new: TABLES] ~ {
type: CType;
cannonicalType: ROPE;
constant: SiroccoATDef.ConstantNode;
[cannonicalType, type, constant, t] ← GetConstantType[id, t];
IF ( NOT ( type.class = error ) )
THEN [] ← SendError["Identifier not declared as an ERROR"];
-- Identifier should be a declared error
new ← t;
};
BuildTypeDAG:
PUBLIC
PROC [key:
ROPE, index:
INT, node: SiroccoATDef.TypeNode]
RETURNS [new:
TABLES] ~ {
guy: REF PQItem ~ NEW [PQItem ← [index, key]];
new ← SiroccoBaseDef.CreateTables[];
IF ( NOT SymTab.Insert[new.unresolvedTypeTable, key, node] )
THEN [] ← SendError["Redeclared Identifier"];
PriorityQueue.Insert[new.index, guy];
};
BuildConstantDAG:
PUBLIC
PROC [key:
ROPE, index:
INT, type: SiroccoATDef.TypeNode, constant: SiroccoATDef.ConstantNode]
RETURNS [new:
TABLES] ~ {
guy: REF PQItem ~ NEW [PQItem ← [index, key]];
value: REF UnresolvedConstantTableEntry ~ NEW[UnresolvedConstantTableEntry];
new ← SiroccoBaseDef.CreateTables[];
value.type ← type;
value.constant ← constant;
IF ( NOT SymTab.Insert[new.unresolvedConstantTable, key, value] )
THEN [] ← SendError["Redeclared Identifier"];
PriorityQueue.Insert[new.index, guy];
};
IsEnumerationConstant:
PUBLIC
PROC [type: CType, id:
ROPE]
RETURNS [
INT ← 0] ~ {
FOR tail: CComponent ← type.children, tail.sibling
WHILE ( tail #
NIL )
DO
IF ( Rope.Equal[tail.name, id] ) THEN RETURN;
ENDLOOP;
[] ← SendError["Undeclared Enumeration"];
};
Remove:
PUBLIC
PROC [id:
ROPE, tables:
TABLES]
RETURNS [new:
TABLES] ~ {
IF ( NOT SymTab.Delete[tables.workTable, id] )
THEN [] ← SendError["Undeclared or Redeclared Identifier"];
new ← tables;
};
SeeIfDuplicated:
PUBLIC
PROC [tables:
TABLES, id:
ROPE, constant:
CARD]
RETURNS [new:
TABLES] ~ {
IF (
NOT SymTab.Insert[tables.workTable, id,""] )
THEN [] ← SendError[Rope.Cat["Duplicates in Enumerated Type, ", id, " redeclared"]];
IF (
NOT SymTab.Insert[tables.workTable, Convert.RopeFromCard[constant],""] )
THEN [] ← SendError["Two identifiers have the same value in Enumerated Type"];
new ← tables;
};
SeeIfInt:
PUBLIC
PROC [type: CType]
RETURNS [yes:
BOOLEAN ←
TRUE] ~ {
IF ( ( type.class = int16 )
OR ( type.class = int32 ) )
THEN NULL
ELSE [] ← SendError["Type Mismatch, negative number not expected"];
};
SendError:
PUBLIC
PROC [errMsg:
ROPE]
RETURNS [c:
CARD] ~ {
length: INT; position: INT;
outstream: IO.STREAM ← SIGNAL ThreeC4Support.GetReportStream;
[position, length] ← SIGNAL ThreeC4Support.GetSourceInfo;
IO.PutF[outstream, "\nError: %g at %g..%g\n",
IO.rope[errMsg],
IO.int[position],
IO.int[(position+length)]
];
ERROR SiroccoPrivate.EndItAll;
};
TryToCoerceNumber:
PUBLIC
PROC [first: CType, value:
CARD]
RETURNS [num:
INT] ~ {
IllegalValue:
PROC ~ {
[] ← SendError["Wrong Number"]; -- should be recovered from
};
num ← 1;
SELECT first.class
FROM
card32 => {
IF ( NOT value IN CARD32 ) THEN IllegalValue[];
};
int16 => {
IF ( NOT value IN [0..32768] ) THEN IllegalValue[];
};
int32 => {
IF ( NOT value IN [0..2147483648) ) THEN IllegalValue[];
};
proc, card16, error, unspec => {
IF ( NOT value IN CARD16 ) THEN IllegalValue[];
};
ENDCASE => {
IllegalValue[];
num ← 0;
};
};
GetObjectName:
PUBLIC
PROC [name:
ROPE, tables:
TABLES]
RETURNS [objectName:
ROPE] ~ {
RETURN [SiroccoPrivate.MakeUpName[name, "Object", tables]]
};
MakeUpFunctionName:
PUBLIC
PROC
RETURNS [madeUpName:
ROPE] ~ {
h: SiroccoPrivate.Handle ← SIGNAL SiroccoPrivate.AquireState;
madeUpName ←
IO.PutFR["P%gV%gFcn%g",
IO.card[h.programNo],
IO.card[h.versionNo],
IO.card[h.uniqueNo]
];
h.uniqueNo ← h.uniqueNo.SUCC;
};
AddFunctionList: PUBLIC PROC [value: SymTab.Val, list: FunctionList]
RETURNS [newList: FunctionList] ~{
entry: REF InterfaceItem;
entry ← NARROW[value];
newList ← RopeList.DAppend[list, entry.functions];
};
AddFunctionToTable: PUBLIC PROC [value: SymTab.Val, list: FunctionList, tables: TABLES] RETURNS [newTables: TABLES] ~{
ERROR;
};
ConsFunctionList: PUBLIC PROC [list: FunctionList, newElement: ROPE] RETURNS [newList: FunctionList] ~ {
ERROR;
};
}.