DIRECTORY BasicTime USING [], FS USING [StreamOpen], HashTable USING [EachPairAction, Fetch, Pairs, Value], IO USING [int, rope, Close, PutF, PutFR, STREAM], Rope USING [ROPE, Cat, Concat, Equal], SiroccoPrivate USING [AquireState, CComponent, CType, DirectoryEntry, FileHeader, Handle, Marshal, Nest, TABLES, UnDo, UnMarshal]; GenerateServer: CEDAR PROGRAM IMPORTS Rope, HashTable, IO, FS, SiroccoPrivate EXPORTS SiroccoPrivate ~ { OPEN SiroccoPrivate; ROPE: TYPE ~ Rope.ROPE; Value: TYPE ~ HashTable.Value; GenSImpl: PUBLIC PROC [] ~ { failure: BOOLEAN; programKey: ROPE; programKeyWD: ROPE; sImplStream: IO.STREAM; allTheTables: TABLES; uniqueNo: NAT _ 0; h: SiroccoPrivate.Handle; GenerateProcBlock: HashTable.EachPairAction ~ { entry: REF DirectoryEntry _ NARROW [value]; name: ROPE _ NARROW [key]; id: ROPE; list: CComponent; successful: BOOLEAN; type: CType; value1: Value; code: ROPE; args: ROPE; res: ROPE; IO.PutF[sImplStream, Nest["%g => { -- %g", 3], IO.rope[entry.constant], IO.rope[name], ]; [successful, value1] _ HashTable.Fetch[allTheTables.condensedTypeTable, entry.type]; type _ NARROW[value1]; IF (type.children # NIL) THEN { list _ type.children; uniqueNo _ 0; args _ "[h"; FOR loopindex: CARD IN [0..type.bound) DO IO.PutF[sImplStream, Nest["%g: %g;", 3], IO.rope[list.name], IO.rope[SiroccoPrivate.UnDo[list.type, h.programKey]] ]; args _ Rope.Cat[args, ", ", list.name]; list _ list.sibling; ENDLOOP; args _ Rope.Concat[args, "]" ]; res _ "["; WHILE (list # NIL) DO IO.PutF[sImplStream, Nest["%g: %g;", 3], IO.rope[list.name], IO.rope[SiroccoPrivate.UnDo[list.type, h.programKey]] ]; res _ Rope.Concat[res, list.name]; list _ list.sibling; IF list # NIL THEN res _ Rope.Concat[res, ", "]; ENDLOOP; res _ Rope.Concat[res, "]"]; list _ type.children; uniqueNo _ 0; IO.PutF[sImplStream, Nest["", 3]]; FOR loopindex: CARD IN [0..type.bound) DO code _ ""; [successful, value1] _ HashTable.Fetch[allTheTables.condensedTypeTable, list.type]; type _ NARROW [value1]; IF ((type.class = bulkDataSource) OR (type.class = bulkDataSink)) THEN { IO.PutF[sImplStream, Nest["TRUSTED {", 4]]; [code, id] _ SiroccoPrivate.UnMarshal[h, type, list.type, list.name, code, uniqueNo, 4]; IO.PutF[sImplStream, Nest["%g", 4], IO.rope[code] ]; code _ "};"; } ELSE { [code, id] _ SiroccoPrivate.UnMarshal[h, type, list.type, list.name, code, uniqueNo, 3]; }; IO.PutF[sImplStream, Nest["%g", 3], IO.rope[code] ]; list _ list.sibling; ENDLOOP; IO.PutF[sImplStream, Nest["", 3]]; IO.PutF[sImplStream, Nest["%g _ %g%g;", 3], IO.rope[res], IO.rope[name], IO.rope[args] ]; IO.PutF[sImplStream, Nest["", 3]]; IO.PutF[sImplStream, Nest["beginReturn[h];", 3]]; IO.PutF[sImplStream, Nest["", 3]]; uniqueNo _ 0; WHILE (list # NIL) DO code _ ""; [successful, value1] _ HashTable.Fetch[allTheTables.condensedTypeTable, list.type]; type _ NARROW [value1]; [code, id] _ SiroccoPrivate.Marshal[h, type, list.type, list.name, code, uniqueNo, 3]; IO.PutF[sImplStream, Nest["%g", 3], IO.rope[code] ]; list _ list.sibling; ENDLOOP; } ELSE { IO.PutF[sImplStream, Nest["NULL;", 3]]; }; IO.PutF[sImplStream, Nest["};", 2]]; }; GenerateErrorBlock: HashTable.EachPairAction ~ { entry: REF DirectoryEntry _ NARROW [value]; name: ROPE _ NARROW [key]; id: ROPE; list: CComponent; successful: BOOLEAN; type: CType; value1: Value; IF Rope.Equal[entry.constant, ""] THEN RETURN; IO.PutF[sImplStream, Nest["%g%g => { -- (%g)", 3], IO.rope[h.programKey], IO.rope[name], IO.rope[entry.constant] ]; IO.PutF[sImplStream, Nest["beginError[h, %g];", 3], IO.rope[entry.constant] ]; [successful, value1] _ HashTable.Fetch[allTheTables.condensedTypeTable, entry.type]; type _ NARROW[value1]; list _ type.children; WHILE (list # NIL) DO { code: Rope.ROPE; [successful, value1] _ HashTable.Fetch[allTheTables.condensedTypeTable, list.type]; [code, id] _ SiroccoPrivate.Marshal[h, NARROW[value1], list.type, list.name, code, uniqueNo, 3]; IO.PutF[sImplStream, Nest["%g", 3], IO.rope[code] ]; list _ list.sibling; } ENDLOOP; IO.PutF[sImplStream, Nest["GO TO Finished;", 3]]; IO.PutF[sImplStream, Nest["};", 2]]; }; Heading: PROC [out: IO.STREAM] ~ { PutDirectory: HashTable.EachPairAction ~ { interface: ROPE ~ NARROW [value]; IO.PutF[out, Nest["%g,", 1], IO.rope[interface] ]; }; SiroccoPrivate.FileHeader[out, Rope.Concat[programKeyWD,"ServerImpl.Mesa"]]; IO.PutF[out, Nest["DIRECTORY", 1]]; IO.PutF[out, Nest["CrRPC,", 1]]; failure _ HashTable.Pairs[allTheTables.directory, PutDirectory]; IO.PutF[out, Nest["%g;", 0], IO.rope[programKeyWD]]; IO.PutF[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.PutF[out, Nest["", 0]]; }; h _ SIGNAL SiroccoPrivate.AquireState[]; allTheTables _ h.allTheTables; programKey _ h.programKey; programKeyWD _ IO.PutFR["%gP%gV%g", IO.rope[h.programName], IO.int[h.programNo], IO.int[h.versionNo] ]; sImplStream _ FS.StreamOpen[Rope.Concat[programKeyWD,"ServerImpl.Mesa"], $create]; Heading[sImplStream]; IO.PutF[sImplStream, Nest["Server: CrRPC.ServerProc ~ {", 1]]; IO.PutF[sImplStream, Nest["-- [h: Handle, pgm: CARD, pgmVersion: CARDINAL, proc: CARDINAL, beginReturn: BeginReturnProc, beginError: BeginErrorProc, beginReject: BeginRejectProc]", 1]]; IO.PutF[sImplStream, Nest["", 1]]; IO.PutF[sImplStream, Nest["ENABLE {", 2]]; failure _ HashTable.Pairs[allTheTables.errors, GenerateErrorBlock]; IO.PutF[sImplStream, Nest["};", 1]]; IO.PutF[sImplStream, Nest["", 1]]; IO.PutF[sImplStream, Nest["IF (pgmVersion # %g) THEN {", 2], IO.int[h.versionNo] ]; IO.PutF[sImplStream, Nest["beginReject[h, CrRPC.noSuchVersion];", 2]]; IO.PutF[sImplStream, Nest["CrRPC.PutCARDINAL[h, %g]; --low", 2], IO.int[h.versionNo] ]; IO.PutF[sImplStream, Nest["CrRPC.PutCARDINAL[h, %g]; --high", 2], IO.int[h.versionNo] ]; IO.PutF[sImplStream, Nest["RETURN", 2]]; IO.PutF[sImplStream, Nest["};", 1]]; IO.PutF[sImplStream, Nest["", 1]]; IO.PutF[sImplStream, Nest["SELECT proc FROM", 2]]; failure _ HashTable.Pairs[allTheTables.procedures, GenerateProcBlock]; IO.PutF[sImplStream, Nest["ENDCASE => {", 3]]; IO.PutF[sImplStream, Nest["beginReject[h, CrRPC.noSuchProcedure];", 3]]; IO.PutF[sImplStream, Nest["};", 1]]; IO.PutF[sImplStream, Nest["", 1]]; IO.PutF[sImplStream, Nest["EXITS", 2]]; IO.PutF[sImplStream, Nest["Finished => { NULL };", 1]]; IO.PutF[sImplStream, Nest["};", 0]]; IO.PutF[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.PutF[sImplStream, Nest["CrRPC.EnsureListener[class~$SPP];", 0]]; IO.PutF[sImplStream, Nest["}...", 0]]; IO.Close[sImplStream]; }; }... GenerateServer.mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Bhargava, August 11, 1986 11:58:12 am PDT Bill Jackson (bj) September 25, 1986 3:16:12 am PDT Demers, September 16, 1986 5:10:16 pm PDT Copied Types Procs proc index Set Context Argument Construction (while writing required temps) Result Construction (while writing required temps) Reset Context Acquring Arguments Perform local Call Transmit results IO.PutF[sImplStream, Nest["", 2]]; IO.PutF[out, Nest["CrRPCFriends,", 1]]; GenSImpl MAIN Κώ˜codešœ™Kšœ Οmœ1™Kšžœ·˜ΉKšžœ ˜"K˜Kšžœ(˜*KšœC˜CKšžœ"˜$Kšžœ ˜"K˜šžœ:˜˜@Kš ‘˜Kš‘˜—š ‘?˜AKš ‘˜Kš‘˜—Kšžœ&˜(Kšžœ"˜$Kšžœ ˜"K˜Kšžœ0˜2KšœF˜FKšžœ,˜.KšžœF˜HKšžœ"˜$Kšžœ ˜"K˜Kšžœ%˜'Kšžœ5˜7Kšžœ"˜$K˜Kšžœ ˜"šžœb˜dKšžœ˜Kšžœ˜Kšœ˜—KšžœA˜CKšžœ$˜&Kšžœ˜K˜——K˜Kšœ˜K˜—…—%¦