GenSImpl:
PUBLIC
PROC [] ~ {
failure: BOOLEAN;
programKey: ROPE;
programKeyWD: ROPE;
sImplStream: IO.STREAM;
allTheTables: TABLES;
h: SiroccoPrivate.Handle;
GenerateProcProc: SymTab.EachPairAction ~ {
entry: REF InterfaceItem ← NARROW [val];
name: ROPE ← NARROW [key];
madeUpName: ROPE ← MakeUpName[name, "Caller", allTheTables];
list: CComponent;
successful: BOOLEAN;
type: CType;
value1: SymTab.Val;
args: ROPE;
res: ROPE;
proc header
IO.PutF[sImplStream, Nest["%g: PROC [h: CrRPC.Handle, s: CrRPC.STREAM, beginReturn: CrRPC.BeginReturnProc] ~ {", 1],
IO.rope[madeUpName]
];
[successful, value1] ← SymTab.Fetch[allTheTables.condensedTypeTable, entry.type];
type ← NARROW[value1];
IF (type.children #
NIL)
THEN {
Set Context
list ← type.children;
Argument Construction (while writing required temps)
args ← "[h";
THROUGH [0..type.bound)
DO
IO.PutF[sImplStream, Nest["%g: %g;", 1],
IO.rope[list.name],
IO.rope[SiroccoPrivate.UnDo[list.type, programKey]]
];
args ← Rope.Cat[args, ", ", list.name];
list ← list.sibling;
ENDLOOP;
args ← Rope.Concat[args, "]" ];
Result Construction (while writing required temps)
res ← "[";
WHILE (list #
NIL)
DO
IO.PutF[sImplStream, Nest["%g: %g;", 1],
IO.rope[list.name],
IO.rope[SiroccoPrivate.UnDo[list.type, programKey]]
];
res ← Rope.Concat[res, list.name];
list ← list.sibling;
IF list # NIL THEN res ← Rope.Concat[res, ", "];
ENDLOOP;
res ← Rope.Concat[res, "]"];
Reset Context
list ← type.children;
IO.PutF[sImplStream, Nest["", 1]];
Acqure Arguments
THROUGH [0..type.bound)
DO
[successful, value1] ← SymTab.Fetch[allTheTables.condensedTypeTable, list.type];
type ← NARROW [value1];
IF ( (type.class = source) OR (type.class = sink) )
THEN IO.PutRope[sImplStream, "TRUSTED "];
IO.PutRope[sImplStream, Nest["{", 2]];
UnMarshal[h, sImplStream, list.name, type, list.type, GetUProcName, TRUE, 2];
IO.PutRope[sImplStream, Nest["", 2]];
IO.PutRope[sImplStream, Nest["};", 1]];
list ← list.sibling;
ENDLOOP;
Perform local Call
IO.PutF[sImplStream, Nest["", 1]];
IO.PutF[sImplStream, Nest["%g ← %g%g;", 1],
IO.rope[res],
IO.rope[name],
IO.rope[args]
];
IO.PutF[sImplStream, Nest["", 1]];
Transmit results
IO.PutF[sImplStream, Nest["beginReturn[h];", 1]];
IO.PutF[sImplStream, Nest["", 1]];
WHILE ( list #
NIL )
DO
[successful, value1] ← SymTab.Fetch[allTheTables.condensedTypeTable, list.type];
type ← NARROW [value1];
IO.PutRope[sImplStream, Nest["{", 2]];
Marshal[h, sImplStream, list.name, type, list.type, GetMProcName, TRUE, 2];
IO.PutRope[sImplStream, Nest["", 2]];
IO.PutRope[sImplStream, Nest["};", 1]];
list ← list.sibling;
ENDLOOP;
}
ELSE {
IO.PutRope[sImplStream, Nest["NULL;", 1]];
};
IO.PutRope[sImplStream, Nest["};", 1]];
IO.PutRope[sImplStream, Nest["", 0]];
};
GenerateProcBlock: SymTab.EachPairAction ~ {
entry: REF InterfaceItem ← NARROW [val];
madeUpName: ROPE ← MadeUpName[NARROW [key], "Caller"];
IO.PutF[sImplStream, Nest["%g => %g[h, s, beginReturn];", 2],
IO.rope[entry.constant],
IO.rope[madeUpName]
];
};
GenerateErrorBlock: SymTab.EachPairAction ~ {
entry: REF InterfaceItem ← NARROW [val];
name: ROPE ← NARROW [key];
successful: BOOLEAN;
type: CType;
value1: SymTab.Val;
IF ( Rope.Equal[entry.constant, ""] ) THEN RETURN;
IO.PutF[sImplStream, Nest["%g%g => { -- (%g)", 3],
IO.rope[programKey],
IO.rope[name],
IO.rope[entry.constant]
];
IO.PutF[sImplStream, Nest["beginError[h, %g];", 3],
IO.rope[entry.constant]
];
[successful, value1] ← SymTab.Fetch[allTheTables.condensedTypeTable, entry.type];
type ← NARROW[value1];
FOR list: CComponent ← type.children, list.sibling
WHILE (list #
NIL)
DO
[successful, value1] ← SymTab.Fetch[allTheTables.condensedTypeTable, list.type];
Marshal[h, sImplStream, list.name, NARROW[value1], list.type, GetMProcName, TRUE, 3];
IO.PutRope[sImplStream, Nest["", 3]];
ENDLOOP;
IO.PutRope[sImplStream, Nest["GOTO Finished;", 3]];
IO.PutRope[sImplStream, Nest["};", 2]];
};
Heading:
PROC [out:
IO.
STREAM] ~ {
PutDirectory: SymTab.EachPairAction ~ {
interface: ROPE ~ NARROW [val];
IO.PutF[out, Nest["%g,", 1],
IO.rope[interface]
];
};
SiroccoPrivate.FileHeader[out, Rope.Concat[programKeyWD,"ServerImpl.Mesa"]];
IO.PutRope[out, Nest["DIRECTORY", 1]];
IO.PutRope[out, Nest["CrRPC,", 1]];
failure ← SymTab.Pairs[allTheTables.directory, PutDirectory];
IO.PutF[out, Nest["%g;", 0], IO.rope[programKeyWD]];
IO.PutRope[out, Nest["", 0]];
IO.PutF[out, Nest["%gServerImpl: CEDAR PROGRAM", 1], IO.rope[programKeyWD]];
IO.PutF[out, Nest["IMPORTS CrRPC, %g ~ {", 1], IO.rope[programKeyWD],];
IO.PutF[out, Nest["OPEN %g;", 0], IO.rope[programKeyWD]];
IO.PutRope[out, Nest["", 0]];
};
GenSImpl MAIN
h ← SIGNAL SiroccoPrivate.AquireState[];
allTheTables ← h.allTheTables;
programKey ← h.programKey;
programKeyWD ← h.programKeyWD;
sImplStream ← FS.StreamOpen[Rope.Concat[programKeyWD,"ServerImpl.Mesa"], $create];
Heading[sImplStream];
SymTab.Erase[allTheTables.workTable];
failure ← SymTab.Pairs[allTheTables.procedures, GenerateProcProc];
IO.PutRope[sImplStream, Nest["Server: CrRPC.ServerProc ~ {", 1]];
IO.PutRope[sImplStream, Nest["-- [h: Handle, s: STREAM, pgm: CARD32, pgmVersion: CARD16, proc: CARD16, beginReturn: BeginReturnProc, beginError: BeginErrorProc, beginReject: BeginRejectProc]", 1]];
IO.PutRope[sImplStream, Nest["", 1]];
IO.PutRope[sImplStream, Nest["ENABLE {", 2]];
failure ← SymTab.Pairs[allTheTables.errors, GenerateErrorBlock];
IO.PutRope[sImplStream, Nest["};", 1]];
IO.PutRope[sImplStream, Nest["", 1]];
IO.PutF[sImplStream, Nest["IF (pgmVersion # %g) THEN {", 2],
IO.int[h.versionNo]
];
IO.PutRope[sImplStream, Nest["beginReject[h, CrRPC.noSuchVersion];", 2]];
IO.PutF[sImplStream, Nest["CrRPC.PutCard16[s, %g]; --low", 2],
IO.int[h.versionNo]
];
IO.PutF[sImplStream, Nest["CrRPC.PutCard16[s, %g]; --high", 2],
IO.int[h.versionNo]
];
IO.PutRope[sImplStream, Nest["RETURN", 2]];
IO.PutRope[sImplStream, Nest["};", 1]];
IO.PutRope[sImplStream, Nest["", 1]];
IO.PutRope[sImplStream, Nest["SELECT proc FROM", 2]];
failure ← SymTab.Pairs[allTheTables.procedures, GenerateProcBlock];
IO.PutRope[sImplStream, Nest["ENDCASE => {", 3]];
IO.PutRope[sImplStream, Nest["beginReject[h, CrRPC.noSuchProcedure];", 3]];
IO.PutRope[sImplStream, Nest["};", 1]];
IO.PutRope[sImplStream, Nest["", 1]];
IO.PutRope[sImplStream, Nest["EXITS", 2]];
IO.PutRope[sImplStream, Nest["Finished => { NULL };", 1]];
IO.PutRope[sImplStream, Nest["};", 0]];
IF (SymTab.GetSize[allTheTables.workTable] > 0)
THEN {
IO.PutF[sImplStream, "%g-- Unmarshal / Marshal Procs --%g%g",
IO.rope[Nest[NIL, 1]],
IO.rope[Nest[NIL, 2]],
IO.rope[Nest[NIL, 2]]
];
GenerateUMProcs[h, sImplStream, 2];
IO.PutF[sImplStream, Nest[NIL, 0]];
};
IO.PutRope[sImplStream, Nest["", 1]];
IO.PutF[sImplStream, Nest["CrRPC.RegisterServerProc[pgm~%g, serverProc~Server, pgmVersion~%g];", 1],
IO.int[h.programNo],
IO.int[h.versionNo]
];
IO.PutRope[sImplStream, Nest["CrRPC.EnsureListener[class~$SPP];", 0]];
IO.PutRope[sImplStream, Nest["}...", 0]];
IO.Close[sImplStream];
};