DIRECTORY
BasicTime USING [GMT],
Convert USING [IntFromRope, RopeFromInt],
HashTable USING [EachPairAction, Fetch, Pairs, Store, Value],
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, Generic, Handle, UMProcNameProc, TABLES],
UserCredentials USING [Get];
Procs
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: Value;
madeUpName ← Rope.Concat[base, suffix];
[successful, value] ← HashTable.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: BOOL ← TRUE;
WHILE found
DO
h.uniqueNo ← h.uniqueNo + 1;
uniqueID ← Rope.Concat[prefix, Convert.RopeFromInt[h.uniqueNo]];
[found~found] ← HashTable.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
ROPE ←
NIL, runtime:
BOOL ←
FALSE]
~ {
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
'" => {
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:
ROPE ←
NIL, setup:
LIST
OF
ROPE ←
NIL] ~ {
SELECT type.class
FROM
array => {
childType: CType;
value: Value;
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;
[value~value] ← HashTable.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 };
boolean => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN };
bulkDataSink => {
ERROR;
};
bulkDataSource => {
ERROR;
};
cardinal => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN };
choice => {
tag, tConst: ROPE;
unionTypeName: ROPE;
value: Value;
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 {
[value~value] ← HashTable.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 };
enumeration => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN };
integer => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN };
longCardinal => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN };
longInteger => {
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;
IF numFields = 0
THEN {
mesaConst ← "NULL"; -- Avoid compiler bug. WILL THIS WORK ????
RETURN };
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: Value;
[value~value] ← HashTable.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 };
sequence => {
objTypeName: ROPE ← MadeUpName[UnDo[typeName, h.programKey], "Object"];
eltTypeName: ROPE;
value: Value;
eltType: CType;
uniqueProcName: ROPE ← MakeUpUniqueID[h, "InitProc"];
procText: ROPE;
procBody: LIST OF ROPE ← NIL;
i, length: INT;
eltTypeName ← type.children.type;
[value~value] ← HashTable.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 };
string => {
IF GetToken[] THEN NULL ELSE ERROR;
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
runtime ← TRUE;
RETURN };
unspecified => {
IF GetToken[] THEN mesaConst ← token ELSE ERROR;
RETURN };
};
[constExp, setup] ← MesaConst[type, typeName];
};
TypeExp:
PUBLIC
PROC [h: Handle, type: CType, typeName:
ROPE, level:
NAT]
RETURNS [typeExp:
ROPE, objTypeDecls:
LIST
OF
ROPE ←
NIL] ~ {
SELECT type.class
FROM
array => {
typeExp ← Rope.Cat[
"ARRAY [0..",
Convert.RopeFromInt[type.bound],
") OF ",
UnDo[type.children.type, h.programKey]
];
};
boolean => {
typeExp ← "BOOLEAN";
};
cardinal => {
typeExp ← "CARD16";
};
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]];
};
enumeration => {
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, "]"];
};
integer => {
typeExp ← "INT16";
};
longCardinal => {
typeExp ← "CARD32";
};
longInteger => {
typeExp ← "INT32";
};
procedure => {
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 [";
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, "]"];
};
sequence => {
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";
};
unspecified => {
typeExp ← "CARD16";
};
};
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: Value;
successful: BOOL;
SELECT type.class
FROM
choice, sequence => NULL;
ENDCASE => RETURN [NIL];
key ← Rope.Concat["<", typeName];
[successful, value] ← HashTable.Fetch[h.allTheTables.workTable, key];
IF
NOT successful
THEN {
value ←
NEW[UMProcEntryObject ← [
kind~unMarshal, generated~FALSE,
procName~MakeUpUniqueID[h, "UProc"],
type~type, typeName~typeName]];
[] ← HashTable.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: Value;
successful: BOOL;
SELECT type.class
FROM
choice, sequence => NULL;
ENDCASE => RETURN [NIL];
key ← Rope.Concat[">", typeName];
[successful, value] ← HashTable.Fetch[h.allTheTables.workTable, key];
IF
NOT successful
THEN {
value ←
NEW[UMProcEntryObject ← [
kind~marshal, generated~FALSE,
procName~MakeUpUniqueID[h, "MProc"],
type~type, typeName~typeName]];
[] ← HashTable.Store[h.allTheTables.workTable, key, value] };
RETURN [NARROW[value, UMProcEntry].procName];
};
GenerateUMProcs:
PUBLIC PROC [h: Handle, s:
STREAM, level:
NAT] ~ {
generatedAProc: BOOL;
GenerateAProc: HashTable.EachPairAction ~ {
procEntry: UMProcEntry ~ NARROW [value];
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;
[] ← HashTable.Pairs[h.allTheTables.workTable, GenerateAProc];
IF NOT generatedAProc THEN EXIT;
ENDLOOP;
};
Marshal:
PUBLIC
PROC [h: Handle, s:
STREAM, varName:
ROPE, type: CType, typeName:
ROPE, getProcName: UMProcNameProc, useProc:
BOOL, level:
NAT] ~ {
successful: BOOLEAN;
value: Value;
IF useProc
THEN {
specialProcName:
ROPE ~
IF getProcName = NIL THEN NIL ELSE getProcName[h, type, typeName];
IF
NOT Rope.IsEmpty[specialProcName]
THEN {
IF (type.class = record)
AND (type.children =
NIL)
-- empty record compiler bug --
THEN { IO.PutRope[s, "NULL;"]; RETURN };
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] ← HashTable.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;"];
};
boolean => {
IO.PutF[s, "CrRPC.PutBool[s, %g];",
IO.rope[varName]
];
};
bulkDataSink => {
IO.PutF[s, "CrRPC.PutBulkDataSink[h, s, %g];",
IO.rope[varName]
];
};
bulkDataSource => {
IO.PutF[s, "CrRPC.PutBulkDataSource[h, s, %g];",
IO.rope[varName]
];
};
cardinal => {
IO.PutF[s, "CrRPC.PutCard16[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] ← HashTable.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;"];
};
enumeration => {
IO.PutF[s, "CrRPC.PutCard16[s, ORD[%g]];",
IO.rope[varName]
];
};
integer => {
IO.PutF[s, "CrRPC.PutInt16[s, %g];",
IO.rope[varName]
];
};
longCardinal => {
IO.PutF[s, "CrRPC.PutCard32[s, %g];",
IO.rope[varName]
];
};
longInteger => {
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] ← HashTable.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;
};
sequence => {
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] ← HashTable.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;"];
};
string => {
IO.PutF[s, "CrRPC.PutRope[s, %g];",
IO.rope[varName]
];
};
unspecified => {
IO.PutF[s, "CrRPC.PutCard16[s, %g];",
IO.rope[varName]
];
};
ENDCASE => {
IO.PutRope[s, "--UNKNOWN--"];
ERROR;
};
};
UnMarshal:
PUBLIC
PROC [h: Handle, s:
STREAM, varName:
ROPE, type: CType, typeName:
ROPE, getProcName: UMProcNameProc, useProc:
BOOL, level:
NAT] ~ {
successful: BOOLEAN;
value: Value;
IF useProc
THEN {
specialProcName:
ROPE ~
IF getProcName = NIL THEN NIL ELSE getProcName[h, type, typeName];
IF
NOT Rope.IsEmpty[specialProcName]
THEN {
IF (type.class = record)
AND (type.children =
NIL)
-- empty record compiler bug --
THEN { IO.PutRope[s, "NULL;"]; RETURN };
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] ← HashTable.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;"];
};
boolean => {
IO.PutF[s, "%g ← CrRPC.GetBool[s];",
IO.rope[varName]
];
};
bulkDataSink => {
IO.PutF[s, "%g ← CrRPC.GetBulkDataSink[h, s];",
IO.rope[varName]
];
};
bulkDataSource => {
IO.PutF[s, "%g ← CrRPC.GetBulkDataSource[h, s];",
IO.rope[varName]
];
};
cardinal => {
IO.PutF[s, "%g ← CrRPC.GetCard16[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;
bodyExp: ROPE;
[successful, value] ← HashTable.Fetch[h.allTheTables.condensedTypeTable, list.type];
variantType ← NARROW [value];
IO.PutF[s, Nest["%g => {", (level+3)],
IO.rope[list.name]
];
Avoid the empty record compiler bug, sigh.
IF (variantType.class = record)
AND (variantType.children =
NIL)
THEN {
bodyExp ← "NULL";
}
ELSE {
bodyExp ← tempVarName;
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[bodyExp]
];
ENDLOOP;
IO.PutRope[s, Nest["ENDCASE => ERROR;", (level+1)]]; -- make this CrRPC.Error????
IO.PutRope[s, "};"];
};
enumeration => {
IO.PutF[s, "%g ← VAL[CrRPC.GetCard16[s]];",
IO.rope[varName]
];
};
integer => {
IO.PutF[s, "%g ← CrRPC.GetInt16[s];",
IO.rope[varName]
];
};
longCardinal => {
IO.PutF[s, "%g ← CrRPC.GetCard32[s];",
IO.rope[varName]
];
};
longInteger => {
IO.PutF[s, "%g ← CrRPC.GetInt32[s];",
IO.rope[varName]
];
};
record => {
IF (type.children =
NIL)
THEN {
IO.PutRope[s, "NULL; -- RECORD [] --"];
RETURN;
};
FOR list: CComponent ← type.children, list.sibling
WHILE list #
NIL
DO
[successful, value] ← HashTable.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;
};
sequence => {
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] ← HashTable.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, "};"];
};
string => {
IO.PutF[s, "%g ← CrRPC.GetRope[s];",
IO.rope[varName]
];
};
unspecified => {
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 (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[NIL, 0]];
};
Init:
PROC ~ {
date: BasicTime.GMT ~ Loader.BCDBuildTime[SiroccoPrivateImpl.Init]; -- incest!
Version ←
IO.PutFR["Sirocco [2.0] of %g",
IO.time[date]];
};