SiroccoPrivateImpl.mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Bhargava, August 11, 1986 10:48:02 am PDT
Bill Jackson (bj) June 6, 1987 10:15:00 pm PDT
Demers, January 6, 1987 4:07:02 pm PST
DIRECTORY
BasicTime USING [GMT],
Convert USING [IntFromRope, RopeFromInt],
Loader USING [BCDBuildTime],
IO USING [int, rope, time, PutF, PutFR, PutRope, STREAM],
Rope USING [ROPE, Cat, Concat, Equal, Fetch, Flatten, Index, InlineFetch, IsEmpty, Length, Substr],
RopeList USING [DAppend],
SiroccoPrivate USING [CComponent, CType, Handle, UMProcNameProc, TABLES],
SymTab USING [EachPairAction, Fetch, Pairs, Store, Val],
UserCredentials USING [Get];
SiroccoPrivateImpl: CEDAR PROGRAM
IMPORTS Convert, IO, Loader, Rope, RopeList, SymTab, UserCredentials
EXPORTS SiroccoPrivate ~ {
OPEN SiroccoPrivate;
ROPE: TYPE ~ Rope.ROPE;
Version: PUBLIC ROPE;
AquireState: PUBLIC SIGNAL RETURNS [Handle] ~ CODE;
EndItAll: PUBLIC ERROR ~ CODE;
MakeUpName: PUBLIC PROC [base: ROPE, suffix: ROPE, tables: TABLES]
RETURNS [madeUpName: ROPE] ~ {
Return a unique name constructed from base and suffix.
Check that the standard construction method — concatentation — doesn't cause collisions.
successful: BOOLEAN;
value: SymTab.Val;
madeUpName ← Rope.Concat[base, suffix];
[successful, value] ← SymTab.Fetch[tables.localTable, madeUpName];
IF successful THEN ERROR; -- ????
};
MadeUpName: PUBLIC PROC [base: ROPE, suffix: ROPE]
RETURNS [madeUpName: ROPE] ~ {
madeUpName ← Rope.Concat[base, suffix];
};
MakeUpUniqueID: PROC [h: Handle, prefix: ROPE] RETURNS [uniqueID: ROPE] ~ {
found: BOOLTRUE;
WHILE found DO
h.uniqueNo ← h.uniqueNo + 1;
uniqueID ← Rope.Concat[prefix, Convert.RopeFromInt[h.uniqueNo]];
[found: found] ← SymTab.Fetch[h.allTheTables.localTable, uniqueID];
ENDLOOP;
};
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)]];
};
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] ~ {
It doesn't matter whether programKey has a trailing dot or not ... but it's faster if it does.
len1: INT ~ Rope.Length[in];
len2: INT ← Rope.Length[programKey];
IF (len2 > 0) AND (Rope.Fetch[programKey, len2-1] # '.) THEN {
len2 ← len2 + 1;
programKey ← Rope.Concat[programKey, "."] };
IF (len1 >= len2) AND Rope.Equal[Rope.Substr[in, 0, len2], programKey] THEN
RETURN[out~Rope.Substr[in, len2, len1]];
RETURN[out: (SELECT TRUE FROM
Rope.Equal[in, "LONGCARDINAL"] => "CARD32",
Rope.Equal[in, "LONGINTEGER"] => "INT32",
Rope.Equal[in, "SINK"] => "CrRPC.BulkDataSink",
Rope.Equal[in, "SOURCE"] => "CrRPC.BulkDataSource",
Rope.Equal[in, "STRING"] => "ROPE",
Rope.Equal[in, "INTEGER"] => "INT16",
Rope.Equal[in, "CARDINAL"] => "CARD16",
Rope.Equal[in, "UNSPECIFIED"] => "CARD16",
ENDCASE => in)];
};
UnDoable: PUBLIC PROC [in: ROPE, programKey: ROPE]
RETURNS
[out: ROPE, yes: BOOLEAN] ~ {
It doesn't matter whether programKey has a trailing dot or not ... but it's faster if it does.
len1: INT ~ Rope.Length[in];
len2: INT ← Rope.Length[programKey];
IF (len2 > 0) AND (Rope.Fetch[programKey, len2-1] # '.) THEN {
len2 ← len2 + 1;
programKey ← Rope.Concat[programKey, "."] };
IF (len1 >= len2) AND Rope.Equal[Rope.Substr[in, 0, len2], programKey] THEN
RETURN[out: Rope.Substr[in, len2, len1], yes: TRUE];
RETURN[out: in, yes: FALSE];
};
ConstExp: PUBLIC PROC [h: Handle, const: ROPE, type: CType, typeName: ROPE, level: NAT] RETURNS [constExp: ROPE, setup: LIST OF ROPENIL, runtime: BOOLFALSE] ~ {
token: ROPE;
input: ROPE ← Rope.Flatten[const];
inputLen: NAT ~ Rope.Length[const];
inputCol: NAT ← 0;
GetToken: PROC RETURNS [ok: BOOL] ~ {
endCol: INT;
DO
IF inputCol >= inputLen THEN RETURN [FALSE];
SELECT Rope.InlineFetch[input, inputCol] FROM
' => {
NULL };
'" => {
endCol ← Rope.Index[input, inputCol+1, "\""] + 1;
EXIT };
ENDCASE => {
endCol ← Rope.Index[input, inputCol, " "];
EXIT };
inputCol ← inputCol.SUCC;
ENDLOOP;
token ← Rope.Substr[input, inputCol, (endCol-inputCol)];
inputCol ← endCol + 1;
RETURN [TRUE];
};
MesaConst: PROC [type: CType, typeName: ROPE]
RETURNS [mesaConst: ROPENIL, setup: LIST OF ROPENIL] ~ {
SELECT type.class FROM
array => {
childType: CType;
value: SymTab.Val;
childTypeName: ROPE;
i, bound: INT;
IF GetToken[] THEN bound ← Convert.IntFromRope[token] ELSE ERROR;
IF bound # INT[type.bound] THEN ERROR;
childTypeName ← type.children.type;
[val: value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, childTypeName];
childType ← NARROW[value];
mesaConst ← "[";
i ← 0;
WHILE i < bound DO
tConst: ROPE;
tSetup: LIST OF ROPE;
[tConst, tSetup] ← MesaConst[childType, childTypeName];
IF i > 0 THEN mesaConst ← Rope.Concat[mesaConst, ", "];
mesaConst ← Rope.Concat[mesaConst, tConst];
IF tSetup # NIL THEN setup ← RopeList.DAppend[tSetup, setup];
i ← i + 1;
ENDLOOP;
mesaConst ← Rope.Concat[mesaConst, "]"];
RETURN;
};
bool => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
card16 => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
card32 => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
choice => {
tag, tConst: ROPE;
unionTypeName: ROPE;
value: SymTab.Val;
unionTypeName ← MadeUpName[UnDo[typeName, h.programKey], "Object"];
IF GetToken[] THEN tag ← token ELSE ERROR;
FOR child: CComponent ← type.children.sibling, child.sibling DO
IF Rope.Equal[child.name, tag] THEN {
[val: value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, child.type];
[tConst, setup] ← MesaConst[type: NARROW[value], typeName: child.type];
EXIT };
ENDLOOP;
mesaConst ← IO.PutFR["NEW [%g.%g ← [%g[%g~%g]]]", IO.rope[unionTypeName], IO.rope[tag], IO.rope[tag], IO.rope[tag], IO.rope[tConst]];
runtime ← TRUE;
RETURN;
};
enum => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
int16 => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
int32 => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
record => {
numFields: NAT ← 0;
FOR list: CComponent ← type.children, list.sibling WHILE list # NIL DO
numFields ← numFields.SUCC;
ENDLOOP;
mesaConst ← "[";
FOR i: NAT IN [1..numFields] DO
fieldName: ROPE;
tConst: ROPE;
tSetup: LIST OF ROPE;
IF GetToken[] THEN fieldName ← token ELSE ERROR;
FOR child: CComponent ← type.children, child.sibling DO
IF Rope.Equal[child.name, fieldName] THEN {
value: SymTab.Val;
[val: value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, child.type];
[tConst, tSetup] ← MesaConst[type: NARROW[value], typeName: child.type];
EXIT };
ENDLOOP;
IF i > 1 THEN mesaConst ← Rope.Concat[mesaConst, ", "];
mesaConst ← Rope.Cat[mesaConst, fieldName, "~", tConst];
IF tSetup # NIL THEN setup ← RopeList.DAppend[tSetup, setup];
ENDLOOP;
mesaConst ← Rope.Concat[mesaConst, "]"];
RETURN;
};
seq => {
objTypeName: ROPE ← MadeUpName[UnDo[typeName, h.programKey], "Object"];
eltTypeName: ROPE;
value: SymTab.Val;
eltType: CType;
uniqueProcName: ROPE ← MakeUpUniqueID[h, "InitProc"];
procText: ROPE;
procBody: LIST OF ROPENIL;
i, length: INT;
eltTypeName ← type.children.type;
[val: value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, eltTypeName];
eltType ← NARROW[value];
IF NOT GetToken[] THEN ERROR;
length ← Convert.IntFromRope[token];
procText ← Rope.Concat[Nest[NIL, level+1], "};"];
procBody ← CONS[procText, NIL];
i ← 0;
WHILE i < length DO
tConst: ROPE;
tSetup: LIST OF ROPE;
[tConst, tSetup] ← MesaConst[eltType, eltTypeName];
IF tSetup # NIL THEN setup ← RopeList.DAppend[tSetup, setup];
procText ← IO.PutFR["%gresult.body[%g] ← %g;",
IO.rope[Nest[NIL, level+1]],
IO.int[i],
IO.rope[tConst]
];
procBody ← CONS[procText, procBody];
i ← i + 1;
ENDLOOP;
procText ← IO.PutFR["%gresult ← NEW[%g[%g]];",
IO.rope[Nest[NIL, level+1]],
IO.rope[objTypeName],
IO.int[length]
];
procBody ← CONS[procText, procBody];
procText ← IO.PutFR["%g%g: PROC RETURNS [result: %g] ~ {",
IO.rope[Nest[NIL, level]],
IO.rope[uniqueProcName],
IO.rope[UnDo[typeName, h.programKey]]
];
procBody ← CONS[procText, procBody];
IF setup = NIL
THEN setup ← procBody
ELSE setup ← RopeList.DAppend[setup, procBody];
mesaConst ← Rope.Concat[uniqueProcName, "[]"];
runtime ← TRUE;
RETURN;
};
sink => { ERROR; };
source => { ERROR; };
string => {
IF GetToken[] THEN NULL ELSE ERROR;
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
runtime ← TRUE;
RETURN;
};
unspec => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN;
};
ENDCASE => { ERROR; };
};
[constExp, setup] ← MesaConst[type, typeName];
};
TypeExp: PUBLIC PROC [h: Handle, type: CType, typeName: ROPE, level: NAT]
RETURNS [typeExp: ROPE, objTypeDecls: LIST OF ROPENIL] ~ {
SELECT type.class FROM
array => {
typeExp ← Rope.Cat[
"ARRAY [0..",
Convert.RopeFromInt[type.bound],
") OF ",
UnDo[type.children.type, h.programKey]
];
};
bool => { typeExp ← "BOOLEAN"; };
card16 => { typeExp ← "CARD16"; };
card32 => { typeExp ← "CARD32"; };
choice => {
list: CComponent ← type.children;
obj: ROPE ← MakeUpName[UnDo[typeName, h.programKey], "Object", h.allTheTables];
objDeclText: ROPE;
typeExp ← Rope.Concat["REF ", obj];
objDeclText ← IO.PutFR["%g%g: TYPE ~ RECORD [%gSELECT type: %g FROM",
IO.rope[Nest[NIL, level]],
IO.rope[obj],
IO.rope[Nest[NIL, level+1]],
IO.rope[UnDo[list.type, h.programKey]]
];
objTypeDecls ← CONS[objDeclText, NIL];
list ← list.sibling;
WHILE list # NIL DO
objDeclText ← IO.PutFR["%g%g => [%g: %g]",
IO.rope[Nest[NIL, level+2]],
IO.rope[list.name], IO.rope[list.name],
IO.rope[UnDo[list.type, h.programKey]]
];
IF list.sibling # NIL THEN objDeclText ← Rope.Concat[objDeclText, ","];
objTypeDecls ← RopeList.DAppend[objTypeDecls, CONS[objDeclText, NIL]];
list ← list.sibling;
ENDLOOP;
objDeclText ← IO.PutFR["%gENDCASE%g];",
IO.rope[Nest[NIL, level+2]],
IO.rope[Nest[NIL, level+1]]
];
objTypeDecls ← RopeList.DAppend[objTypeDecls, CONS[objDeclText, NIL]];
};
enum => {
typeExp ← "MACHINE DEPENDENT { ";
type.children ← Sort[type.children];
FOR child: CComponent ← type.children, child.sibling WHILE child # NIL DO
typeExp ← Rope.Cat[typeExp, child.name, "(", Convert.RopeFromInt[child.val], ")"];
IF child.sibling # NIL THEN typeExp ← Rope.Concat[typeExp, ", "];
ENDLOOP;
typeExp ← Rope.Concat[typeExp, "}"];
};
error => {
typeExp ← "ERROR [";
FOR child: CComponent ← type.children, child.sibling WHILE child # NIL DO
typeExp ← Rope.Cat[typeExp, child.name, ": ",
UnDo[child.type, h.programKey]];
IF child.sibling # NIL THEN typeExp ← Rope.Concat[typeExp, ", "];
ENDLOOP;
typeExp ← Rope.Concat[typeExp, "]"];
};
int16 => { typeExp ← "INT16"; };
int32 => { typeExp ← "INT32"; };
proc => {
child: CComponent ← type.children;
typeExp ← "PROC [h: CrRPC.Handle";
THROUGH [0..type.bound) DO
IF child = NIL THEN ERROR;
typeExp ← Rope.Cat[typeExp, ", ", child.name, ": ", UnDo[child.type, h.programKey]];
child ← child.sibling;
ENDLOOP;
IF child # NIL THEN {
typeExp ← Rope.Cat[typeExp, "] RETURNS [", child.name, ": ",
UnDo[child.type, h.programKey]];
child ← child.sibling;
};
WHILE child # NIL DO
typeExp ← Rope.Cat[typeExp, ", ", child.name, ": ",
UnDo[child.type, h.programKey]];
child ← child.sibling;
ENDLOOP;
typeExp ← Rope.Concat[typeExp, "]"];
};
record => {
typeExp ← "RECORD [";
IF type.children = NIL THEN
Avoid compiler bug for empty records.
typeExp ← Rope.Concat[typeExp, "null: CARDINAL ← 0"];
FOR child: CComponent ← type.children, child.sibling WHILE child # NIL DO
typeExp ← Rope.Cat[
typeExp,
Nest[NIL, level+1],
child.name,
": ",
UnDo[child.type, h.programKey]
];
IF child.sibling # NIL THEN typeExp ← Rope.Concat[typeExp, ","];
ENDLOOP;
typeExp ← Rope.Concat[typeExp, "]"];
};
seq => {
obj: ROPE ← MakeUpName[typeName, "Object", h.allTheTables];
objDeclText: ROPE;
typeExp ← Rope.Concat["REF ", obj];
objDeclText ← IO.PutFR["%g%g: TYPE ~ MACHINE DEPENDENT RECORD [%gbody: PACKED SEQUENCE length: CARDINAL OF %g%g];",
IO.rope[Nest[NIL, level]],
IO.rope[obj],
IO.rope[Nest[NIL, level+1]],
IO.rope[UnDo[type.children.type, h.programKey]],
IO.rope[Nest[NIL, level+1]]
];
objTypeDecls ← CONS[objDeclText, NIL];
};
string => { typeExp ← "ROPE"; };
unspec => { typeExp ← "CARD16"; };
ENDCASE => { ERROR; };
};
UMProcKind: TYPE ~ { unMarshal, marshal };
UMProcEntry: TYPE ~ REF UMProcEntryObject;
UMProcEntryObject: TYPE ~ RECORD [
kind: UMProcKind,
generated: BOOL,
procName: ROPE,
type: CType,
typeName: ROPE
];
GetUProcName: PUBLIC UMProcNameProc
[h: Handle, type: CType, typeName: ROPE] RETURNS [procName: ROPE]
~ {
key: ROPE;
value: SymTab.Val;
successful: BOOL;
SELECT type.class FROM
choice => NULL;
seq => NULL;
ENDCASE => RETURN [NIL];
key ← Rope.Concat["<", typeName];
[successful, value] ← SymTab.Fetch[h.allTheTables.workTable, key];
IF NOT successful THEN {
value ← NEW[UMProcEntryObject ← [
kind: unMarshal, generated: FALSE,
procName: MakeUpUniqueID[h, "UProc"],
type: type, typeName: typeName]];
[] ← SymTab.Store[h.allTheTables.workTable, key, value] };
RETURN [NARROW[value, UMProcEntry].procName];
};
GetMProcName: PUBLIC UMProcNameProc
[h: Handle, type: CType, typeName: ROPE] RETURNS [procName: ROPE]
~ {
key: ROPE;
value: SymTab.Val;
successful: BOOL;
SELECT type.class FROM
choice => NULL;
seq => NULL;
ENDCASE => RETURN [NIL];
key ← Rope.Concat[">", typeName];
[successful, value] ← SymTab.Fetch[h.allTheTables.workTable, key];
IF NOT successful THEN {
value ← NEW[UMProcEntryObject ← [
kind: marshal, generated: FALSE,
procName: MakeUpUniqueID[h, "MProc"],
type: type, typeName: typeName]];
[] ← SymTab.Store[h.allTheTables.workTable, key, value] };
RETURN [NARROW[value, UMProcEntry].procName];
};
GenerateUMProcs: PUBLIC PROC [h: Handle, s: IO.STREAM, level: NAT] ~ {
generatedAProc: BOOL;
GenerateAProc: SymTab.EachPairAction ~ {
procEntry: UMProcEntry ~ NARROW [val];
IF procEntry.generated THEN RETURN;
generatedAProc ← procEntry.generated ← TRUE;
IO.PutRope[s, Nest[NIL, level]];
SELECT procEntry.kind FROM
unMarshal => {
IO.PutF[s, "%g: PROC [h: CrRPC.Handle, s: CrRPC.STREAM] RETURNS [res: %g] ~ {%g",
IO.rope[procEntry.procName],
IO.rope[UnDo[procEntry.typeName, h.programKey]],
IO.rope[Nest[NIL, level+1]]
];
UnMarshal[h, s, "res", procEntry.type, procEntry.typeName, GetUProcName, FALSE, (level+1)];
};
marshal => {
IO.PutF[s, "%g: PROC [h: CrRPC.Handle, s: CrRPC.STREAM, val: %g] ~ {%g",
IO.rope[procEntry.procName],
IO.rope[UnDo[procEntry.typeName, h.programKey]],
IO.rope[Nest[NIL, level+1]]
];
Marshal[h, s, "val", procEntry.type, procEntry.typeName, GetMProcName, FALSE, level+1];
};
ENDCASE => ERROR;
IO.PutF[s, "%g};%g",
IO.rope[Nest[NIL, level+1]],
IO.rope[Nest[NIL, level]]
];
};
DO
generatedAProc ← FALSE;
[] ← SymTab.Pairs[h.allTheTables.workTable, GenerateAProc];
IF ( NOT generatedAProc ) THEN EXIT;
ENDLOOP;
};
Marshal: PUBLIC PROC [h: Handle, s: IO.STREAM, varName: ROPE, type: CType, typeName: ROPE, getProcName: UMProcNameProc, useProc: BOOL, level: NAT] ~ {
successful: BOOLEAN;
value: SymTab.Val;
IF ( useProc ) THEN {
specialProcName: ROPE ~
IF
( getProcName = NIL ) THEN NIL ELSE getProcName[h, type, typeName];
IF ( NOT Rope.IsEmpty[specialProcName] ) THEN {
IO.PutF[s, "%g[h, s, %g];",
IO.rope[specialProcName],
IO.rope[varName]
];
RETURN;
};
};
SELECT type.class FROM
array => {
uniqueLoopIndex: ROPE ← MakeUpUniqueID[h, "i"];
IO.PutF[s, Nest["FOR %g: CARDINAL IN [0..%g) DO", (level+1)],
IO.rope[uniqueLoopIndex],
IO.int[type.bound]
];
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
Marshal[h, s, Rope.Cat[varName, "[", uniqueLoopIndex, "]"],
NARROW [value], type.children.type, getProcName, TRUE,
(level+1)];
IO.PutRope[s, Nest[NIL, (level+1)]];
IO.PutRope[s, "ENDLOOP;"];
};
bool => { IO.PutF[s, "CrRPC.PutBool[s, %g];", IO.rope[varName] ]; };
card16 => { IO.PutF[s, "CrRPC.PutCard16[s, %g];", IO.rope[varName] ]; };
card32 => { IO.PutF[s, "CrRPC.PutCard32[s, %g];", IO.rope[varName] ]; };
choice => {
tag: ROPE ← MakeUpUniqueID[h, "tag"];
unionTypeName: ROPE ← MadeUpName[UnDo[typeName, h.programKey], "Object"];
IO.PutF[s, Nest["CrRPC.PutCard16[s, ORD[%g.type]];", level],
IO.rope[varName]
];
IO.PutF[s, Nest["WITH %g SELECT FROM", (level+1)],
IO.rope[varName]
];
FOR list: CComponent ← type.children.sibling, list.sibling WHILE (list # NIL) DO
IO.PutF[s, Nest["it: REF %g.%g => {", (level+2)],
IO.rope[unionTypeName],
IO.rope[list.name]
];
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
Marshal[h, s, Rope.Concat["it^.", list.name],
NARROW [value], list.type, getProcName, TRUE,
(level+2)];
IO.PutRope[s, Nest[NIL, (level+2)]];
IO.PutRope[s, Nest["};", (level+1)]];
ENDLOOP;
IO.PutRope[s, "ENDCASE;"];
};
enum => { IO.PutF[s, "CrRPC.PutCard16[s, ORD[%g]];", IO.rope[varName] ]; };
int16 => { IO.PutF[s, "CrRPC.PutInt16[s, %g];", IO.rope[varName] ]; };
int32 => { IO.PutF[s, "CrRPC.PutInt32[s, %g];", IO.rope[varName] ]; };
record => {
IF type.children = NIL
THEN IO.PutRope[s, "NULL; -- RECORD [] --"]
ELSE FOR list: CComponent ← type.children, list.sibling WHILE list # NIL DO
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
Marshal[h, s, Rope.Cat[varName, ".", list.name],
NARROW [value], list.type, getProcName, TRUE,
(level)]; -- a special case! (bj)
IF (list.sibling # NIL)
THEN IO.PutRope[s, Nest[NIL, (level)]];
ENDLOOP;
};
seq => {
uniqueLoopIndex: ROPE ← MakeUpUniqueID[h, "i"];
IO.PutF[s, Nest["CrRPC.PutCard16[s, %g.length];", level],
IO.rope[varName]
];
IO.PutF[s, Nest["FOR %g: CARDINAL IN [0..%g.length) DO", (level+1)],
IO.rope[uniqueLoopIndex],
IO.rope[varName]
];
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
Marshal[h, s, Rope.Cat[varName, ".body[", uniqueLoopIndex, "]"],
NARROW [value], type.children.type, getProcName, TRUE,
(level+1)];
IO.PutRope[s, Nest[NIL, (level+1)]];
IO.PutRope[s, "ENDLOOP;"];
};
sink => { IO.PutF[s, "CrRPC.PutBulkDataSink[h, s, %g];", IO.rope[varName] ]; };
source => { IO.PutF[s, "CrRPC.PutBulkDataSource[h, s, %g];", IO.rope[varName] ]; };
string => { IO.PutF[s, "CrRPC.PutRope[s, %g];", IO.rope[varName] ]; };
unspec => { IO.PutF[s, "CrRPC.PutCard16[s, %g];", IO.rope[varName] ]; };
ENDCASE => {
IO.PutRope[s, "--UNKNOWN--"];
ERROR;
};
};
UnMarshal: PUBLIC PROC [h: Handle, s: IO.STREAM, varName: ROPE, type: CType, typeName: ROPE, getProcName: UMProcNameProc, useProc: BOOL, level: NAT] ~ {
successful: BOOLEAN;
value: SymTab.Val;
IF ( useProc ) THEN {
specialProcName: ROPE ~
IF
getProcName = NIL THEN NIL ELSE getProcName[h, type, typeName];
IF ( NOT Rope.IsEmpty[specialProcName] ) THEN {
IO.PutF[s, "%g ← %g[h, s];",
IO.rope[varName],
IO.rope[specialProcName]
];
RETURN;
};
};
SELECT type.class FROM
array => {
uniqueLoopIndex: ROPE ← MakeUpUniqueID[h, "i"];
IO.PutF[s, "FOR %g: CARDINAL IN [0..%g) DO",
IO.rope[uniqueLoopIndex],
IO.int[type.bound]
];
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
IO.PutRope[s, Nest[NIL, (level+1)]];
UnMarshal[h, s, Rope.Cat[varName, "[", uniqueLoopIndex, "]"],
NARROW [value], type.children.type, getProcName, TRUE,
(level+1)];
IO.PutRope[s, Nest[NIL, (level+1)]];
IO.PutRope[s, "ENDLOOP;"];
};
bool => { IO.PutF[s, "%g ← CrRPC.GetBool[s];", IO.rope[varName] ]; };
card16 => { IO.PutF[s, "%g ← CrRPC.GetCard16[s];", IO.rope[varName] ]; };
card32 => { IO.PutF[s, "%g ← CrRPC.GetCard32[s];", IO.rope[varName] ]; };
choice => {
tag: ROPE ← MakeUpUniqueID[h, "tag"];
tempVarName: ROPE ← MakeUpUniqueID[h, "temp"];
tagTypeName: ROPE ← UnDo[type.children.type, h.programKey];
objTypeName: ROPE ← MadeUpName[UnDo[typeName, h.programKey], "Object"];
IO.PutRope[s, Nest["{", (level+1)]];
IO.PutF[s, Nest["%g: %g ~ VAL[CrRPC.GetCard16[s]];", (level+1)],
IO.rope[tag],
IO.rope[tagTypeName]
];
IO.PutF[s, Nest["SELECT %g FROM", (level+2)],
IO.rope[tag]
];
FOR list: CComponent ← type.children.sibling, list.sibling WHILE (list # NIL) DO
variantType: CType;
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
variantType ← NARROW [value];
IO.PutF[s, Nest["%g => {", (level+3)],
IO.rope[list.name]
];
IO.PutF[s, Nest["%g: %g;", (level+3)],
IO.rope[tempVarName],
IO.rope[UnDo[list.type, h.programKey]]
];
UnMarshal[h, s, tempVarName,
variantType, list.type, getProcName, TRUE,
(level+3)];
IO.PutRope[s, Nest[NIL, (level+3)]];
IO.PutF[s, Nest["%g ← NEW[%g.%g ← [%g[%g]]] };", (level+2)],
IO.rope[varName],
IO.rope[objTypeName],
IO.rope[list.name],
IO.rope[list.name],
IO.rope[tempVarName]
];
ENDLOOP;
IO.PutRope[s, Nest["ENDCASE => ERROR;", (level+1)]]; -- make this CrRPC.Error????
IO.PutRope[s, "};"];
};
enum => { IO.PutF[s, "%g ← VAL[CrRPC.GetCard16[s]];", IO.rope[varName] ]; };
int16 => { IO.PutF[s, "%g ← CrRPC.GetInt16[s];", IO.rope[varName] ]; };
int32 => { IO.PutF[s, "%g ← CrRPC.GetInt32[s];", IO.rope[varName] ]; };
record => {
IF (type.children = NIL) THEN
Avoid compiler bug for empty records.
IO.PutRope[s, Rope.Concat[varName, ".null ← 0;"]];
FOR list: CComponent ← type.children, list.sibling WHILE list # NIL DO
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, list.type];
UnMarshal[h, s, Rope.Cat[varName, ".", list.name],
NARROW [value], list.type, getProcName, TRUE,
(level)]; -- a special case! (bj)
IF (list.sibling # NIL)
THEN IO.PutRope[s, Nest[NIL, (level)]];
ENDLOOP;
};
seq => {
uniqueLoopIndex: ROPE ← MakeUpUniqueID[h, "i"];
uniqueName: ROPE ← MakeUpUniqueID[h, "length"];
objTypeName: ROPE ← MadeUpName[UnDo[typeName, h.programKey], "Object"];
IO.PutRope[s, Nest["{", (level+1)]];
IO.PutF[s, Nest["%g: CARDINAL ~ CrRPC.GetCard16[s];", (level+1)],
IO.rope[uniqueName]
];
IO.PutF[s, Nest["%g ← NEW[%g[%g]];", (level+1)],
IO.rope[varName],
IO.rope[objTypeName],
IO.rope[uniqueName]
];
IO.PutF[s, Nest["FOR %g: CARDINAL IN [0..%g) DO", (level+2)],
IO.rope[uniqueLoopIndex],
IO.rope[uniqueName]
];
[successful, value] ← SymTab.Fetch[h.allTheTables.condensedTypeTable, type.children.type];
UnMarshal[h, s, Rope.Cat[varName, ".body[", uniqueLoopIndex, "]"],
NARROW [value], type.children.type, getProcName, TRUE,
(level+2)];
IO.PutRope[s, Nest[NIL, (level+2)]];
IO.PutRope[s, Nest["ENDLOOP;", (level+1)]];
IO.PutRope[s, "};"];
};
sink => { IO.PutF[s, "%g ← CrRPC.GetBulkDataSink[h, s];", IO.rope[varName] ]; };
source => { IO.PutF[s, "%g ← CrRPC.GetBulkDataSource[h, s];", IO.rope[varName] ]; };
string => { IO.PutF[s, "%g ← CrRPC.GetRope[s];", IO.rope[varName] ]; };
unspec => { IO.PutF[s, "%g ← CrRPC.GetCard16[s];", IO.rope[varName] ]; };
ENDCASE => {
IO.PutF[s, " -- %g ← CrRPC.GetCard16[s]; (UNKNOWN)--", IO.rope[varName] ];
ERROR;
};
};
FileHeader: PUBLIC PROC [out: IO.STREAM, filename: ROPE] ~ {
IO.PutF[out, Nest["-- %g", 1], IO.rope[filename]];
IO.PutF[out, Nest["-- Copyright Ó 1987 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[NIL, 0]];
};
Init: PROC ~ {
date: BasicTime.GMT ~ Loader.BCDBuildTime[SiroccoPrivateImpl.Init]; -- incest!
Version ← IO.PutFR["Sirocco [2.1] of %g", IO.time[date] ];
Version 1.0: first try
Version 2.0: restructure with ref's for variant records
Version 2.1: hack in positional information for pretty interfaces
};
Init[];
}.