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; 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; }; GetCTypeFirstChild: PUBLIC PROC [first: CType] RETURNS [comp: CComponent] ~ { comp _ first.children; }; 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; }; }. XSiroccoBase2Impl.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 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"]; }; }; 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"]; }; }; }; 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; }; 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; }; Κ w˜codešœ™KšœB™BK™)K™&K™0—K™šΟk ˜ Kšœœ˜,Kšœœ!œ˜2Kšœœ ˜Kšœœœ˜ Kšœ œ˜.Kšœœ˜&Kšœ œ ˜KšœœGœ!˜„Kšœœ$˜0Kšœœ$˜8—K˜šΟnœœ˜Kšœœ=˜`Kšœ˜Kšœ˜Kšœœœ˜K˜šžœœœœœ œœœ œ™yKšœ™šœ)œ™8šœœ™šœ!œ™)Kšœ#œ ™6KšœU™UK™—Kšœ™Kšœ™—šœ™ KšœΟc™4Kšœ™——K™K™—šžœœœœœœœœ™Kšœœ™?š žœœœœœœ™BKšœ!™!K™—K™šœ%œ™4šœœ™šœ+œ™:šœ™Kšœ™K™Kšœ™K™—Kšœ*™1—Kšœ™—KšœœŸ ™!—šœ.œ™=šœ$™$šœœ+œ™9šœ™Kšœœ™Kšœ œ™KšœL™LKšœ+œ)™ZšœC™CKšœ>™>—Kšœœ>œœ™YKšœœ*œ#Ÿ^™·Kšœ™Kšœ™—Kšœ"™&—Kšœ™—šœ™ Kšœ'Ÿ™(K™——K™Kšœ™—š ž œœœ œœ œ˜GKšœœ˜ Kšœ)œ1˜aKšœ˜K˜—š žœœœ œœœ˜FKšœ˜Kšœ ˜ K˜K˜—šž œœœ-œ˜eKšœœ!˜AKšœ˜K˜K˜—š žœœœœœœ˜]Kšœ˜šœ1œ œœ˜LKšœœ2œœ˜EKšœ˜—Kšœ ˜ K˜K˜—š ž œœœœœœ˜RKšœœ˜Kšœ˜šœ0œ œœ˜KKšœœ2œœ˜EKšœœFœœ˜YKšœœ˜Kšœ˜—šœœ˜Kšœœ?œV˜’Kšœœ˜Kšœ˜—Kšœ ˜ K˜K˜—šžœœœœœœœ?œ™œKšœœ™?š žœœœœœœ™BKšœ!™!K™—Kšœ ™ šœ%œ™4šœœŸ™0šœ+œ™:šœ™Kšœ™Kšœ™Kšœ œ ™Kšœ™K™—šœ™ Kšœ!™!K™——Kšœ™—šœŸ ™šœ2œ™Ašœœ"™,Kšœ&™&šœœ.œ™<šœŸ™šœ œ™šœ™Kšœœ ™2Kšœ#œ™:Kšœœœ™-Kšœ œ™KšœK™KKšœ*œ)™ZKšœC™CKšœF™FKšœ™Kšœ™Kšœœ™KšœU™UKšœ™Kšœ œ™"Kšœ4™4Kšœ™K™—šœŸ™!Kšœ#™#K™——K™—Kšœ"™&—Kšœ™—šœ™ Kšœ(™(K™——K™——K™K™—šžœœœœ˜MKšœ˜K˜K˜—šžœœœœœœœ™MK™ Kšœœ™Kšœ$™$Kšœ=™=Kšœœœ8Ÿ(™†K™K™K™—šž œœœœ œœœ˜hJšœœ œ˜.Jšœ$˜$Kšœœ4œ)˜jKšœ%˜%K˜K˜—šžœœœœ œCœœ˜’Jšœœ œ˜.Kšœœ œ˜LJšœ$˜$Kšœ˜Kšœ˜Kšœœ9œ)˜oKšœ%˜%K˜K˜—š žœœœœœœ ˜Pšœ1œ œ˜KKšœœœ˜-Kšœ˜—Kšœ)˜)K˜K˜—šžœœœœ œœœ˜HKšœœ&œ7˜jKšœ ˜ K˜K˜—šžœœœ œœ œœœ˜ašœœ*˜2KšœP˜T—šœœE˜MKšœK˜O—Kšœ ˜ K˜K˜—š žœœœœœœ˜Ešœœ˜7Kšœ˜ Kšœ?˜C—K˜K˜—š ž œœœ œœœ˜;Kšœœ œ˜Kšœ œœœ ˜=Kšœœ˜:šœ+˜-Kšœ˜Kšœ˜Kšœ˜Kšœ˜—Kšœ˜K˜K˜—š žœœœœœœ˜Qšž œœ˜Kšœ Ÿ˜;Kšœ˜—Kšœ˜šœ œ˜šœ ˜ Kš œœœœœ˜/K˜—šœ ˜ Kšœœœ œ˜3K˜—šœ ˜ Kšœœœœ˜8Kšœ˜—šœ ˜ Kš œœœœœ˜0K˜—šœ˜ Kšœ˜Kšœ˜Kšœ˜——Kšœ˜K˜—šž œœœœ œœœ˜VKšœ4˜:Kšœ˜K˜—š žœœœœœ˜>Kšœœ˜=šœ œ˜$Kšœ˜Kšœ˜Kšœ˜Kšœ˜—Kšœœ˜Kšœ˜K˜—šžœœœ(œ™gKšœœ™Kšœœ™Kšœ2™2K™K™—š žœœœ1œœ œ™vKšœ™Kšœ™K™—š žœœœ"œœ™hKšœ™Kšœ™K™—Kšœ˜K˜——…—€5O