DIRECTORY BasicTime USING [], FS USING [StreamOpen], IO USING [int, rope, Close, PutF, PutRope, STREAM], Rope USING [ROPE, Cat, Concat, Equal], SiroccoPrivate USING [AquireState, CComponent, CType, FileHeader, GenerateUMProcs, GetMProcName, GetUProcName, Handle, InterfaceItem, MakeUpName, MadeUpName, Marshal, Nest, TABLES, UnDo, UnMarshal], SymTab USING [EachPairAction, Erase, Fetch, GetSize, Pairs, Val]; GenerateServer: CEDAR PROGRAM IMPORTS Rope, IO, FS, SiroccoPrivate, SymTab EXPORTS SiroccoPrivate ~ { OPEN SiroccoPrivate; ROPE: TYPE ~ Rope.ROPE; 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; 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 { list _ type.children; 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, "]" ]; 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, "]"]; list _ type.children; IO.PutF[sImplStream, Nest["", 1]]; 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; 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]]; 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]]; }; 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]; }; }... ؤGenerateServer.mesa Copyright س 1986, 1987 by Xerox Corporation. All rights reserved. Bhargava, August 11, 1986 11:58:12 am PDT Bill Jackson (bj) June 11, 1987 1:21:02 am PDT Demers, January 5, 1987 11:52:56 am PST TODO: Procs proc header Set Context Argument Construction (while writing required temps) Result Construction (while writing required temps) Reset Context Acqure Arguments Perform local Call Transmit results GenSImpl MAIN ‌ت¢کcodeڑœ™KڑœB™BK™)K™.K™'K™K™—K™ڑدk ک Kڑœ ‌œکKڑ‌œ‌œکKڑ‌œ‌œ#‌œک3Kڑœ‌œ‌œک&Kڑœ‌œ™‌œکئKڑœ‌œ5کA—Kکڑدnœ‌œ‌کKڑ‌œ‌œ‌œک,Kڑ‌œکKڑ‌œک—کKڑ‌œ‌œ‌œکKک—™Kکڑ‍œ‌œ‌œکKڑœ ‌œکKڑœ‌œکKڑœ‌œکKڑœ ‌œ‌œکKڑœ‌œکKڑœککKک—ڑ‍œک+Kڑœ‌œ‌œک(Kڑœ‌œ‌œکKڑœ‌œ,کKڑں کKڑ ک—ڑں =ک?Kڑں کKڑ ک—Kڑ‌œ)ک+Kڑ‌œ%ک'Kڑ‌œ#ک%KکKڑ‌œ3ک5KڑœCکCKڑ‌œ/ک1Kڑ‌œIکKKڑ‌œ%ک'Kڑ‌œ#ک%KکKڑ‌œ(ک*Kڑ‌œ8ک:Kڑ‌œ%ک'Kکڑ‌œ.‌œک6ڑ‌œ;ک=Kڑ‌œ‌œکKڑ‌œ‌œکKڑ‌œ‌œکKڑœک—Kڑœ#ک#Kڑ‌œ‌œک#KکKک—Kڑ‌œ#ک%ڑ‌œbکdKڑ‌œکKڑ‌œکKڑœک—Kڑ‌œDکFKڑ‌œ'ک)Kڑ‌œکKک——KکKڑœکKک—…—†&ى