SiroccoPrivateImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Bhargava, August 11, 1986 10:48:02 am PDT
Bill Jackson (bj) September 25, 1986 3:11:42 am PDT
DIRECTORY
BasicTime USING [GMT],
Convert USING [RopeFromInt],
HashTable USING [Insert, Fetch, Value],
Loader USING [BCDBuildTime],
IO USING [int, rope, time, PutF, PutFR, STREAM],
Rope USING [ROPE, Cat, Concat, Equal, Fetch, Find, Length, Substr],
SiroccoPrivate USING [CComponent, CType, Generic, Handle, TABLES],
UserCredentials USING [Get];
SiroccoPrivateImpl: CEDAR PROGRAM
IMPORTS Convert, HashTable, IO, Loader, Rope, UserCredentials
EXPORTS SiroccoPrivate ~ {
OPEN SiroccoPrivate;
Version: PUBLIC ROPE;
Copied Types
ROPE: TYPE ~ Rope.ROPE;
Value: TYPE ~ HashTable.Value;
Signals
AquireState: PUBLIC SIGNAL RETURNS [Handle] ~ CODE;
EndItAll: PUBLIC ERROR ~ CODE;
Procs
MakeUpName: PUBLIC PROC [base: ROPE, postfix: ROPE, tables: TABLES] RETURNS [madeUpName: ROPE] ~ {
successful: BOOLEAN;
value: Value;
[successful, value] ← HashTable.Fetch[tables.madeUpNameTable, base];
IF successful
THEN madeUpName ← NARROW[value]
ELSE {
madeUpName ← Rope.Concat[base, postfix];
[successful, value] ← HashTable.Fetch[tables.localTable, madeUpName];
WHILE successful DO
madeUpName ← Rope.Concat[madeUpName, postfix];
[successful, value] ← HashTable.Fetch[tables.localTable, madeUpName];
ENDLOOP;
successful ← HashTable.Insert[tables.madeUpNameTable, base, madeUpName];
};
};
Merge: PROC [list1, list2: CComponent] RETURNS [comp: CComponent] ~ {
IF (list1 = NIL) THEN { comp ← list2; RETURN };
IF (list2 = NIL) THEN { comp ← list1; RETURN };
IF (list1.val > list2.val) THEN { comp ← Merge[list2, list1]; RETURN };
list2 ← Merge[list1.sibling, list2];
list1.sibling ← list2;
comp ← list1;
};
Nest: PUBLIC PROC [in: ROPE, level: NAT] RETURNS [out: ROPE] ~ {
INDENT: ROPE ~ "\n\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t";
out ← Rope.Concat[in, Rope.Substr[INDENT, 0, (level+1)]];
};
NewFcn: PUBLIC PROC [name: ROPE, obj: ROPE, size: INT] RETURNS [out: ROPE] ~ {
h: Handle ← SIGNAL AquireState;
line1: ROPE;
line2: ROPE;
programKeyWD: ROPE ← IO.PutFR["%gP%gV%g",
IO.rope[h.programName],
IO.int[h.programNo],
IO.int[h.versionNo]
];
obj ← UnDo[obj, programKeyWD];
line1 ← IO.PutFR[Nest["%g: PROC RETURNS [temp: REF %g] ~ {", 2],
IO.rope[name],
IO.rope[obj]
];
line2 ← IO.PutFR[Nest["temp ← NEW[%g[%g]];", 2],
IO.rope[obj],
IO.int[size],
];
out ← Rope.Concat[line1, line2]
};
Sort: PUBLIC PROC [list: CComponent] RETURNS [comp: CComponent] ~ {
longComp: CComponent;
shortComp: CComponent;
[longComp, shortComp] ← Split[list];
IF (longComp # NIL) AND (longComp.sibling # NIL)
THEN longComp ← Sort[longComp];
IF (shortComp # NIL)
THEN shortComp ← Sort[shortComp];
comp ← Merge[longComp, shortComp];
};
Split: PROC [list: CComponent] RETURNS [longComp: CComponent ← NIL, shortComp: CComponent ← NIL] ~ {
IF (list = NIL) THEN RETURN;
[shortComp, longComp] ← Split[list.sibling];
list.sibling ← longComp;
longComp ← list;
};
UnDo: PUBLIC PROC [in: ROPE, programKey: ROPE] RETURNS [out: ROPE] ~ {
len1: INT ~ Rope.Length[in];
len2: INT ~ Rope.Length[programKey];
prefix: ROPE;
IF (len1 <= len2) -- can't have "mumble."
OR (Rope.Fetch[in, (len2)] # '.)
THEN {
out ← SELECT TRUE FROM
Rope.Equal[in, "LONGCARDINAL"] => "CARD",
Rope.Equal[in, "LONGINTEGER"] => "INT",
Rope.Equal[in, "SINK"] => "CrRPC.BulkDataSink",
Rope.Equal[in, "SOURCE"] => "CrRPC.BulkDataSource",
Rope.Equal[in, "STRING"] => "ROPE",
Rope.Equal[in, "UNSPECIFIED"] => "CARDINAL",
ENDCASE => in;
RETURN;
};
out ← in;
prefix ← Rope.Substr[in, 0, len2];
IF Rope.Equal[prefix, programKey] THEN {
out ← Rope.Substr[in, (len2+1), len1];
};
};
UnDoable: PUBLIC PROC [in: ROPE, programKey: ROPE] RETURNS [out: ROPE, yes: BOOLEAN] ~ {
len1: INT ~ Rope.Length[in];
len2: INT ~ Rope.Length[programKey];
prefix: ROPE;
yes ← FALSE;
out ← in;
IF (len1 <= len2) THEN RETURN; -- can't have "mumble."
IF (Rope.Fetch[in, (len2)] # '.) THEN RETURN;
prefix ← Rope.Substr[in, 0, len2];
IF Rope.Equal[prefix, programKey] THEN {
yes ← TRUE;
out ← Rope.Substr[in, (len2+1), len1];
};
};
Marshal: PUBLIC PROC [h: SiroccoPrivate.Handle, type: CType, typeName: ROPE, name: ROPE, code: ROPE, uniqueNo: NAT, level: NAT ← 2] RETURNS [rc: ROPE, rn: ROPE] ~ {
list: CComponent;
successful: BOOLEAN;
tag: ROPE;
tagType: ROPE;
uniqueLoopIndex: ROPE;
value: Value;
programKey: ROPE;
allTheTables: TABLES;
UniqueID: PROC [prefix: ROPE] RETURNS [unique: ROPE] ~ {
unique ← Rope.Concat[prefix, Convert.RopeFromInt[uniqueNo]];
[successful, value] ← HashTable.Fetch[allTheTables.localTable, unique];
IF successful THEN ERROR; -- ERROR IN GENERATING NAME
uniqueNo ← uniqueNo + 1;
};
allTheTables ← h.allTheTables;
programKey ← h.programKey;
rc ← code;
SELECT type.class FROM
array => {
subscript: ROPE;
uniqueLoopIndex ← UniqueID["i"];
subscript ← IO.PutFR["%g[%g]",
IO.rope[name],
IO.rope[uniqueLoopIndex]
];
rc ← IO.PutFR[Nest["%gFOR %g: CARDINAL IN [0..%g) DO", (level+1)],
IO.rope[rc],
IO.rope[uniqueLoopIndex],
IO.int[type.bound]
];
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, type.children.type];
[rc, rn] ← Marshal[h, NARROW [value], type.children.type, subscript, rc, uniqueNo, (level+1)];
rc ← IO.PutFR[Nest["%g", (level+1)],
IO.rope[rc]
];
rc ← Rope.Concat[rc, "ENDLOOP;"];
};
boolean => {
rc ← IO.PutFR["%gCrRPC.PutBOOL[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
bulkDataSink => {
rc ← IO.PutFR["%gCrRPC.PutBulkDataSink[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
bulkDataSource => {
rc ← IO.PutFR["%gCrRPC.PutBulkDataSource[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
cardinal => {
rc ← IO.PutFR["%gCrRPC.PutCARDINAL[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
choice => {
tag ← UniqueID["tag"];
tagType ← UnDo[typeName, programKey];
rc ← IO.PutFR[Nest["%gCrRPC.PutCARDINAL[h, ORD[%g.type]];", level],
IO.rope[rc],
IO.rope[name]
];
rc ← IO.PutFR[Nest["%gWITH %g SELECT FROM", (level+1)],
IO.rope[rc],
IO.rope[name]
];
list ← type.children.sibling;
WHILE (list # NIL) DO
variant: ROPE ← Rope.Concat["it.", list.name];
rc ← IO.PutFR[Nest["%git: %g %g => {", (level+2)],
IO.rope[rc],
IO.rope[list.name],
IO.rope[tagType]
];
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, list.type];
[rc, rn] ← Marshal[h, NARROW [value], list.type, variant, rc, uniqueNo, (level+2)];
rc ← IO.PutFR[Nest["%g", (level+2)],
IO.rope[rc],
];
rc ← IO.PutFR[Nest["%g};", (level+1)],
IO.rope[rc],
];
list ← list.sibling;
ENDLOOP;
rc ← Rope.Concat[rc, "ENDCASE;"];
};
enumeration => {
rc ← IO.PutFR["%gCrRPC.PutCARDINAL[h, ORD[%g]];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
integer => {
rc ← IO.PutFR["%gCrRPC.PutINTEGER[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
longCardinal => {
rc ← IO.PutFR["%gCrRPC.PutCARD[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
longInteger => {
rc ← IO.PutFR["%gCrRPC.PutINT[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
record => {
IF (type.children = NIL) THEN {
rc ← IO.PutFR["%gNULL; -- RECORD []",
IO.rope[rc],
];
RETURN[rc, name];
};
list ← type.children;
WHILE (list # NIL) DO
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, list.type];
[rc, rn] ← Marshal[h, NARROW [value], list.type, Rope.Cat[name, ".", list.name], rc, uniqueNo, (level)]; -- a special case! (bj)
IF (list.sibling # NIL)
THEN rc ← IO.PutFR[Nest["%g", (level)], IO.rope[rc]];
list ← list.sibling;
ENDLOOP;
};
sequence => {
element: ROPE;
uniqueLoopIndex ← UniqueID["i"];
element ← IO.PutFR["%g.body[%g]",
IO.rope[name],
IO.rope[uniqueLoopIndex]
];
rc ← IO.PutFR[Nest["%gCrRPC.PutCARDINAL[h, %g.length];", level],
IO.rope[rc],
IO.rope[name]
];
rc ← IO.PutFR[Nest["%gFOR %g: CARDINAL IN [0..%g.length) DO", (level+1)],
IO.rope[rc],
IO.rope[uniqueLoopIndex],
IO.rope[name]
];
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, type.children.type];
[rc, rn] ← Marshal[h, NARROW [value], type.children.type, element, rc, uniqueNo, (level+1)];
rc ← Nest[rc, (level+1)];
rc ← Rope.Concat[rc, "ENDLOOP;"];
};
string => {
rc ← IO.PutFR["%gCrRPC.PutROPE[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
unspecified => {
rc ← IO.PutFR["%gCrRPC.PutCARDINAL[h, %g];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
ENDCASE => {
rc ← Rope.Concat[rc, "--UNKNOWN--"];
rn ← name;
ERROR;
};
};
UnMarshal: PUBLIC PROC [h: Handle, type: CType, typeName: ROPE, name: ROPE, code: ROPE, uniqueNo: NAT, level: NAT ← 2] RETURNS [rc: ROPE, rn: ROPE] ~ {
list: CComponent;
successful: BOOLEAN;
tag: ROPE;
tagType: ROPE;
tempRope: ROPE;
uniqueLoopIndex: ROPE;
value: Value;
variantType: CType;
programKey: ROPE;
allTheTables: TABLES;
RemoveAssign: PROC [in: ROPE] RETURNS [out: ROPE] ~ {
temp: INT;
temp ← Rope.Find[in, "←"] + 1;
out ← IF (temp = 0)
THEN in
ELSE Rope.Substr[in, temp, Rope.Length[in]];
};
SimpleType: PROC [typeClass: Generic] RETURNS [yes: BOOLEAN] ~ {
yes ← SELECT typeClass FROM
integer,
longInteger,
cardinal,
longCardinal,
unspecified,
boolean,
string,
enumeration => TRUE,
ENDCASE => FALSE;
};
UniqueID: PROC [prefix: ROPE] RETURNS [unique: ROPE] ~ {
unique ← Rope.Concat[prefix, Convert.RopeFromInt[uniqueNo]];
[successful, value] ← HashTable.Fetch[allTheTables.localTable, unique];
IF successful THEN ERROR; -- ERROR IN GENERATING NAME
uniqueNo ← uniqueNo + 1;
};
allTheTables ← h.allTheTables;
programKey ← h.programKey;
rc ← code;
SELECT type.class FROM
array => {
subscript: ROPE;
uniqueLoopIndex ← UniqueID["i"];
subscript ← IO.PutFR["%g[%g]",
IO.rope[name],
IO.rope[uniqueLoopIndex]
];
rc ← IO.PutFR["%gFOR %g: CARDINAL IN [0..%g) DO",
IO.rope[rc],
IO.rope[uniqueLoopIndex],
IO.int[type.bound]
];
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, type.children.type];
rc ← Nest[rc, (level+1)];
[rc, rn] ← UnMarshal[h, NARROW [value], type.children.type, subscript, rc, uniqueNo, (level+1)];
rc ← Nest[rc, (level+1)];
rc ← Rope.Concat[rc, "ENDLOOP;"];
};
boolean => {
rc ← IO.PutFR["%g%g ← CrRPC.GetBOOL[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
bulkDataSink => {
rc ← IO.PutFR["%g%g ← CrRPC.GetBulkDataSink[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
bulkDataSource => {
rc ← IO.PutFR["%g%g ← CrRPC.GetBulkDataSource[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
cardinal => {
rc ← IO.PutFR["%g%g ← CrRPC.GetCARDINAL[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
choice => {
tag ← UniqueID["tag"];
tagType ← UnDo[type.children.type, programKey];
rc ← Rope.Concat[rc, Nest[" TRUSTED {", (level+1)]];
rc ← IO.PutFR[Nest["%g%g: %g ~ VAL[CrRPC.GetCARDINAL[h]];", (level+1)],
IO.rope[rc],
IO.rope[tag],
IO.rope[tagType]
];
rc ← IO.PutFR[Nest["%gSELECT %g FROM", (level+2)],
IO.rope[rc],
IO.rope[tag]
];
list ← type.children.sibling;
WHILE (list # NIL) DO
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, list.type];
variantType ← NARROW [value];
IF SimpleType[variantType.class]
THEN {
rc ← IO.PutFR["%g%g => %g ← ",
IO.rope[rc],
IO.rope[list.name],
IO.rope[name]
];
[tempRope, rn] ← UnMarshal[h, variantType, list.type, name, "", uniqueNo, (level+2)];
tempRope ← RemoveAssign[tempRope];
tempRope ← Rope.Substr[tempRope, 0, (Rope.Length[tempRope]-1)];
rc ← IO.PutFR[Nest["%g[%g[%g]];", (level+2)],
IO.rope[rc],
IO.rope[list.name],
IO.rope[tempRope]
];
}
ELSE {
IF ((variantType.class = record) AND (variantType.children = NIL))
THEN {
Empty Record is a special case
rc ← IO.PutFR[Nest["%g%g => %g ← [%g[%g~]]; -- RECORD []", (level+2)],
IO.rope[rc],
IO.rope[list.name],
IO.rope[name],
IO.rope[list.name],
IO.rope[list.name]
];
}
ELSE {
uniqueName: ROPE ← UniqueID["x"];
rc ← IO.PutFR[Nest["%g%g => {", (level+3)],
IO.rope[rc],
IO.rope[list.name],
];
rc ← IO.PutFR[Nest["%g%g: %g;", (level+3)],
IO.rope[rc],
IO.rope[uniqueName],
IO.rope[UnDo[list.type, programKey]]
];
[rc, rn] ← UnMarshal[h, variantType, list.type, uniqueName, rc, uniqueNo, (level+3)];
rc ← IO.PutFR[Nest["%g", (level+3)],
IO.rope[rc]
];
rc ← IO.PutFR[Nest["%g%g ← [%g[%g]];", (level+3)],
IO.rope[rc],
IO.rope[name],
IO.rope[list.name],
IO.rope[uniqueName]
];
rc ← IO.PutFR[Nest["%g};", (level+2)],
IO.rope[rc]
];
};
};
list ← list.sibling;
ENDLOOP;
rc ← Rope.Concat[rc, Nest["ENDCASE;", (level+1)]];
rc ← Rope.Concat[rc, "};"];
};
enumeration => {
rc ← IO.PutFR["%g%g ← VAL[CrRPC.GetCARDINAL[h]];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
integer => {
rc ← IO.PutFR["%g%g ← CrRPC.GetINTEGER[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
longCardinal => {
rc ← IO.PutFR["%g%g ← CrRPC.GetCARD[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
longInteger => {
rc ← IO.PutFR["%g%g ← CrRPC.GetINT[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
record => {
IF (type.children = NIL) THEN {
rc ← IO.PutFR["%gNULL; -- RECORD []",
IO.rope[rc],
];
RETURN[rc, name];
};
list ← type.children;
WHILE (list # NIL) DO
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, list.type];
[rc, rn] ← UnMarshal[h, NARROW [value], list.type, Rope.Cat[name, ".", list.name], rc, uniqueNo, (level)]; -- a special case! (bj)
IF (list.sibling # NIL)
THEN rc ← IO.PutFR[Nest["%g", (level)], IO.rope[rc]];
list ← list.sibling;
ENDLOOP;
};
sequence => {
element: ROPE;
uniqueLoopIndex: ROPE ← UniqueID["i"];
uniqueName: ROPE ← UniqueID["length"];
element ← IO.PutFR["%g.body[%g]",
IO.rope[name],
IO.rope[uniqueLoopIndex]
];
rc ← Rope.Concat[rc, Nest["{", (level+1)]];
rc ← IO.PutFR[Nest["%g%g: CARDINAL ~ CrRPC.GetCARDINAL[h];", (level+1)],
IO.rope[rc],
IO.rope[uniqueName]
];
ASSUMES nameBody is the associated with name i.e name : REF nameObject
rc ← IO.PutFR[Nest["%g%g ← NEW[%gObject[%g]];", (level+1)],
IO.rope[rc],
IO.rope[name],
IO.rope[UnDo[typeName, programKey]],
IO.rope[uniqueName]
];
rc ← IO.PutFR[Nest["%gFOR %g: CARDINAL IN [0..%g) DO", (level+2)],
IO.rope[rc],
IO.rope[uniqueLoopIndex],
IO.rope[uniqueName]
];
[successful, value] ← HashTable.Fetch[allTheTables.condensedTypeTable, type.children.type];
[rc, rn] ← UnMarshal[h, NARROW [value], type.children.type, element, rc, uniqueNo, (level+2)];
rc ← Nest[rc, (level+2)];
rc ← Rope.Concat[rc, Nest["ENDLOOP;", (level+1)]];
rc ← Rope.Concat[rc, "};"];
};
string => {
rc ← IO.PutFR["%g%g ← CrRPC.GetROPE[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
unspecified => {
rc ← IO.PutFR["%g%g ← CrRPC.GetCARDINAL[h];",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
};
ENDCASE => {
rc ← IO.PutFR["%g -- %g ← CrRPC.GetCARDINAL[h]; (UNKNOWN)--",
IO.rope[rc],
IO.rope[name]
];
rn ← name;
ERROR;
};
};
FileHeader: PUBLIC PROC [out: IO.STREAM, filename: ROPE] ~ {
IO.PutF[out, Nest["-- %g", 1], IO.rope[filename]];
IO.PutF[out, Nest["-- Copyright (C) 1986 by Xerox Corporation. All rights reserved.", 1]];
IO.PutF[out, Nest["-- Generated by %g at %g", 1], IO.rope[UserCredentials.Get[].name], IO.time[]];
IO.PutF[out, Nest["-- using %g", 1], IO.rope[Version]];
IO.PutF[out, Nest["", 0]];
};
Init: PROC ~ {
date: BasicTime.GMT ~ Loader.BCDBuildTime[SiroccoPrivateImpl.Init]; -- incest!
Version ← IO.PutFR["Sirocco [1.0] of %g",
IO.time[date]];
};
Init[];
}...