<> <> <> <> <> <> DIRECTORY Ascii USING [BS, CR, FF, SP, TAB], BasicTime USING [earliestGMT, GMT, Now, Period, Unpack, Update], Convert USING [RopeFromInt], FileStream USING [OpenFileFromStream], FS USING[ Delete, Error, GetInfo, nullOpenFile, Open, OpenFile, SetByteCountAndCreatedTime, StreamOpen ], IO USING [Close, CreateStreamProcs, CreateStream, Flush, PutChar, PutF, PutFR, PutRope, STREAM, Value], Loader USING [BCDBuildTime], LupineMakeRpcModules USING [ MakeRpcControlModule, MakeRpcClientModule, MakeRpcClientBinderModule, MakeRpcServerModule ], LupineManager USING [], LupineManagerPrivate USING [ Abort, Error, ErrorCode, ErrorHandlerProc, ErrorType, ExplanationProc, IsNull, Language, ModuleTypes, Nest, Options, ParamPassingMethod, SHORT, String, StringNIL], LupineMarshal USING [ParameterProtocolVersions], LupineSymbolTable USING [ CloseInterface, GetInterfaceInfo, GMT, InterfaceInfo, OpenError, OpenInterface, VersionStampString, VersionStamp ], Rope USING [Cat, Find, Length, ROPE, Substr]; LupineManagerImpl: MONITOR IMPORTS BasicTime, Convert, FileStream, FS, IO, Loader, LupineMakeRpcModules, LupineManagerPrivate, Marshal: LupineMarshal, ST: LupineSymbolTable, Rope EXPORTS LupineManager, LupineManagerPrivate = BEGIN OPEN LupineManagerPrivate; LastCodeFileGMT: BasicTime.GMT _ BasicTime.earliestGMT; <<>> <> TranslateRemoteInterface: PUBLIC ENTRY PROCEDURE [ interfaceBcdFilename: String, interfaceBcdCapability: FS.OpenFile _ FS.nullOpenFile, errorHandler: ErrorHandlerProc, options: Options, desiredLineLength: LONG INTEGER ] = BEGIN ENABLE BEGIN UNWIND => NULL; AbortTranslation => GOTO AbortTranslation; ST.OpenError => -- This can come from ST.Open or MakeRpcXXX. Abort[ code: (SELECT why FROM badFileFormat => BadBcdFileFormat, badFileName => NoSuchFile, badFileVersion => BadBcdFileVersion, notInterfaceModule => NotInterfaceModule, ENDCASE => ERROR), problemText: fileOrModuleName]; END; -- ENABLE. EstablishErrorHandler[errorHandler]; SetCodeLineLength[desiredLineLength]; GetInterface[interfaceBcdFilename, interfaceBcdCapability]; <> BEGIN ENABLE UNWIND => { ST.CloseInterface; ClearErrorHandler }; interfaceName: String; contents: ST.InterfaceInfo; [contents: contents, moduleName: interfaceName] _ ST.GetInterfaceInfo[]; MakeModuleNames[interfaceName, options.targetLanguage]; BEGIN ENABLE UNWIND => FreeModuleNames[]; <> IF contents.variables THEN Error[InterfaceVariables, interfaceBcdFilename]; IF contents.transfers[Port] OR contents.transfers[Process] OR contents.transfers[Program] OR contents.transfers[Other] THEN Error[UnsupportedTransfers, interfaceBcdFilename]; BEGIN OPEN LupineMakeRpcModules; MakeRpcControlModule[options ! AbortTranslation => CONTINUE]; MakeRpcClientModule[options ! AbortTranslation => CONTINUE]; MakeRpcClientBinderModule[options ! AbortTranslation => CONTINUE]; MakeRpcServerModule[options ! AbortTranslation => CONTINUE]; END; END; -- ENABLE UNWIND => FreeModuleNames. FreeModuleNames[]; END; -- ENABLE UNWIND => ST.CloseInterface. ST.CloseInterface; ClearErrorHandler; EXITS AbortTranslation => NULL; -- The GOTO's UNWIND will cleanup. END; -- TranslateRemoteInterface. GetInterface: PROCEDURE [ interfaceFilename: String, interfaceCapability: FS.OpenFile ] = BEGIN IF interfaceCapability = FS.nullOpenFile THEN interfaceCapability _ FS.Open[AppendBcd[interfaceFilename] ! FS.Error => GOTO noFile ]; ST.OpenInterface[interfaceFilename, interfaceCapability]; EXITS noFile => Abort[code: NoSuchFile, problemText: interfaceFilename]; END; AppendBcd: PROCEDURE [s: String] RETURNS[new: String] = INLINE BEGIN IF Rope.Find[s, "."] >= 0 THEN new _ s ELSE new _ s.Cat[".bcd"] END;  <> clientErrorHandler: ErrorHandlerProc _ NIL; EstablishErrorHandler: PROCEDURE [handler: ErrorHandlerProc] = INLINE {clientErrorHandler _ handler}; ClearErrorHandler: PROCEDURE = INLINE {clientErrorHandler _ NIL}; AbortTranslation: PRIVATE ERROR = CODE; <> ReportError: PUBLIC PROCEDURE [ type: ErrorType, code: ErrorCode, problemText: String ] = BEGIN Report: ExplanationProc = BEGIN clientSaysAbort: BOOLEAN = clientErrorHandler[ type: type, code: code, codeExplanation: explanation, outputFileName: GetCodeFileName[], outputFileCharPosition: GetCodeStreamIndex[], problemCausingText: problemText ].abortTranslation; IF type=abort OR clientSaysAbort THEN ERROR AbortTranslation; END; -- Explainer. GiveExplanation[code: code, explainer: Report]; END; GiveExplanation: PUBLIC PROCEDURE [ code: ErrorCode, explainer: ExplanationProc ] = BEGIN Explanation: PACKED ARRAY ErrorCode OF --explanation:-- String = [ AnonymousIdentifier: "Unnamed item (probably record component) encountered; cannot marshal this anonymous item.", BadBcdFileFormat: "Module or file has invalid BCD or symbols format.", BadBcdFileVersion: "So-called BCD file has an incorrect version stamp.", ComputedVariant: "Address-containing computed or overlaid variant record encountered; cannot marshal these records.", ComputedSequence: "Computed sequence encountered; cannot marshal these sequences.", EmbeddedRESULT: "VAR or RESULT parameter has embedded addresses; cannot marshal these parameters.", EmptyArray: "Empty (hint for dynamic?) array encountered; use explicit descriptors and sequences instead.", HandleREF: "REF-containing type being passed as a handle; this is extremely dangerous for the collector.", ImproperPassingMethod: "Parameter uses call by VAR, VALUE, RESULT, or HANDLE improperly.", ImproperReadonlyRESULT: "Readonly parameter cannot be called by VAR or RESULT.", ImproperRESULTResult: "Result parameter called by VAR or RESULT; only arguments can be called by VAR and RESULT.", InterfaceVariables: "Interface contains variables; interface variables are not supported.", InvalidHandle: "Ref or pointer to unspecified, completely opaque, or ANY encountered; it must be passed as a HANDLE.", MdsAllocation: "Argument or result requires allocating short POINTER storage (in the MDS).", NoSuchFile: "Could not find required file or module.", NotInterfaceModule: "Specified file is not a DEFINITIONS module; PROGRAM module translation is not supported.", ProbablePointerRecursion: "Probable list, tree, or graph detected; can only marshal explicit LIST OF types.", TransferParameter: "Cannot YET marshal transfer (e.g., procedure) parameter.", SequenceInsideVariant: "An arm of a variant record contains a sequence; this marshaling is not implemented.", ShortInterMdsPointers: "Parameter of interMDS call contains short pointers; use long pointers instead.", UnimplementedMarshaling: "Marshaling this type is either impossible or unimplemented.", Unknown: "", UnsupportedTransfers: "Interface contains PROCESSES, PROGRAMS, or PORTS; only procedures, signals, and errors are supported." ]; explainer[Explanation[code]]; END;  <> moduleNames: ARRAY ModuleTypes OF String _ ALL[StringNIL]; ModuleName: PUBLIC PROC [module: ModuleTypes] RETURNS [--name:-- String] = BEGIN RETURN[moduleNames[module]] END; MakeModuleNames: PROCEDURE [interfaceName: String, language: Language] = BEGIN RpcInterfaceName: PACKED ARRAY Language OF String = [ Cedar: "RPC", Mesa: "MesaRPC" ]; RpcLupineInterfaceName: PACKED ARRAY Language OF String = [ Cedar: "RPCLupine", Mesa: "MesaRPCLupine" ]; MakeName: PROC [root: String, suffix: String_StringNIL] RETURNS[rootSuffix: String] = BEGIN RETURN[root.Cat[suffix]] END; -- MakeName. moduleNames[interface] _ MakeName[interfaceName]; moduleNames[openedInterface] _ MakeName[StringNIL]; <> moduleNames[control] _ MakeName[interfaceName, "RpcControl"]; moduleNames[client] _ MakeName[interfaceName, "RpcClientImpl"]; moduleNames[clientBinder] _ MakeName[interfaceName, "RpcBinderImpl"]; moduleNames[server] _ MakeName[interfaceName, "RpcServerImpl"]; moduleNames[rpcPublic] _ MakeName[RpcInterfaceName[language]]; <> moduleNames[rpcPrivate] _ MakeName[RpcLupineInterfaceName[language]]; <> moduleNames[lupineRuntime] _ MakeName["LupineRuntime"]; <> END; FreeModuleNames: PROCEDURE [] = BEGIN FOR module: ModuleTypes IN ModuleTypes DO moduleNames[module] _ NIL; ENDLOOP; END;  <

> codeFilename: String _ NIL; codeStream: ARRAY [1..9] OF IO.STREAM _ ALL[NIL]; codeStreamIndex: ARRAY [1..9] OF LONG INTEGER _ ALL[0]; OutputFileCount: INT _ 1; CurrentOutputFile: INT _ 1; OpenCodeFile: PUBLIC PROCEDURE [codeModuleName: String, numberOfOutputFiles: INT _ 1] = BEGIN OutputFileCount _ numberOfOutputFiles; IF OutputFileCount = 1 THEN { codeStream[1] _ FS.StreamOpen[ fileName: ModuleDotMesa[codeModuleName], accessOptions: $create ]; codeStreamIndex[1] _ 0; } ELSE { nameBeforeImpl: String = codeModuleName.Substr[0, codeModuleName.Length[]-4]; FOR no: INT IN [1..OutputFileCount] DO name: String = nameBeforeImpl.Cat[Convert.RopeFromInt[from: no, showRadix: FALSE] , "Impl.mesa"]; codeStream[no] _ FS.StreamOpen[ fileName: name, accessOptions: $create ]; codeStreamIndex[no] _ 0; ENDLOOP; }; InitializeCodeLinePut; CurrentOutputFile _ 0 ; END; OutputToAllFiles: PUBLIC PROCEDURE = { CurrentOutputFile _ 0 ; } ; NextOutputFile: PUBLIC PROCEDURE = { CurrentOutputFile _ CurrentOutputFile + 1; IF CurrentOutputFile > OutputFileCount THEN CurrentOutputFile _ 1; }; CodeStreamPut: PROCEDURE [char: CHARACTER] = INLINE BEGIN IF CurrentOutputFile = 0 THEN { FOR no: INT IN [1..OutputFileCount] DO codeStream[no].PutChar[char]; codeStreamIndex[no] _ codeStreamIndex[no] + 1; ENDLOOP; } ELSE { codeStream[CurrentOutputFile].PutChar[char]; codeStreamIndex[CurrentOutputFile] _ codeStreamIndex[CurrentOutputFile] + 1; }; END; CodeStreamPutRope: PROCEDURE [rope: String] = INLINE BEGIN IF CurrentOutputFile = 0 THEN { FOR no: INT IN [1..OutputFileCount] DO codeStream[no].PutRope[rope]; codeStreamIndex[no] _ codeStreamIndex[no] + rope.Length[]; ENDLOOP; } ELSE { codeStream[CurrentOutputFile].PutRope[rope]; codeStreamIndex[CurrentOutputFile] _ codeStreamIndex[CurrentOutputFile] + rope.Length[]; }; END; GetCodeFileName: PROC RETURNS [String] = INLINE { RETURN[IF IsNull[codeFilename] THEN StringNIL ELSE codeFilename ]}; GetCodeStreamIndex: PROC RETURNS [LONG INTEGER] = INLINE {IF CurrentOutputFile = 0 THEN RETURN [codeStreamIndex[1]] ELSE RETURN[codeStreamIndex[CurrentOutputFile]]}; StampCodeFile: PUBLIC PROCEDURE [codeModuleName:String] = BEGIN moduleName, fileName: String; now: ST.GMT = BasicTime.Now[]; year: INT = BasicTime.Unpack[now].year; lupineTime: ST.GMT _ Loader.BCDBuildTime[]; moduleVersion: ST.VersionStamp; moduleTime, sourceTime: ST.GMT; [moduleName: moduleName, fileName: fileName, moduleVersion: moduleVersion, moduleCreateTime: moduleTime, sourceCreateTime: sourceTime] _ ST.GetInterfaceInfo[]; CodeStreamPutRope[IO.PutFR["-- Copyright (C) %g by Xerox Corporation. All rights reserved.\n", [integer[year]]]]; CodeStreamPutRope[IO.PutFR[ "-- Stub file %g was translated on %g by Lupine of %g", [rope[codeFilename]], [time[now]], [time[lupineTime]] ]]; CodeStreamPutRope[IO.PutFR["\n-- Source interface %g came from file %g, which was created on %g with version stamp %g from source of %g.\n", [rope[moduleName]], [rope[fileName]], [time[moduleTime]], [rope[ST.VersionStampString[stamp: moduleVersion]]], [time[sourceTime]] ]]; END; StampTranslationOptions: PUBLIC PROCEDURE [options: Options] = BEGIN LanguageString: ARRAY Language OF String = [Cedar: "Cedar", Mesa: "Mesa"]; ParamPassingString: ARRAY ParamPassingMethod OF String = [ Var: "VAR", Value: "VALUE", Result: "RESULT", Handle: "HANDLE", InterMds: "InterMds" ]; BoolString: ARRAY BOOLEAN OF String = [TRUE: "TRUE", FALSE: "FALSE"]; oldest, newest: LONG INTEGER; [oldestSupported: oldest, newestSupported: newest] _ Marshal.ParameterProtocolVersions[]; CodeStreamPutRope[IO.PutFR[" -- The parameters for this translation are: -- Target language = %g -- Default parameter passing = %g -- Deallocate server heap arguments = %g -- Inline RpcServerImpl dispatcher stubs = %g -- Declare signals = %g", [rope[LanguageString[options.targetLanguage]]], [rope[ParamPassingString[options.defaultParamPassing]]], [rope[BoolString[options.freeServerArguments]]], [rope[BoolString[options.inlineServerDispatcherStubs]]], [rope[BoolString[options.declareSignals]]] ]]; CodeStreamPutRope[IO.PutFR[" -- Warn about short POINTER (\"MDS\") allocations = %g -- Maximum number of dynamic heap NEWs = %g, MDS NEWs = %g -- Acceptable parameter protocols = VersionRange[%g..%g].\n", [rope[BoolString[options.warnMDSAllocs]]], [integer[options.maxHeapAllocations]], [integer[options.maxMdsAllocations]], [integer[oldest]], [integer[newest]] ]]; END; -- StampTranslationOptions. CloseCodeFile: PUBLIC PROCEDURE = <> BEGIN FinalizeCodeLinePut[]; FOR no: INT IN [1..OutputFileCount] DO file: FS.OpenFile; bytes: INT; created: BasicTime.GMT _ BasicTime.earliestGMT; codeStream[no].Flush[]; <> file _ FileStream.OpenFileFromStream[codeStream[no]]; [bytes: bytes, created: created] _ file.GetInfo[]; IF BasicTime.Period[from: LastCodeFileGMT, to: created] <= 0 THEN { created _ BasicTime.Update[base: LastCodeFileGMT, period: 1]; file.SetByteCountAndCreatedTime[bytes: bytes, created: created]; }; LastCodeFileGMT _ created; codeStream[no].Close[]; codeStreamIndex[no] _ 0; ENDLOOP; codeFilename _ NIL; END; DeleteExistingCodeFiles: PROCEDURE = BEGIN DeleteOne: PROC [module: String] = BEGIN FS.Delete [ name: ModuleDotMesa[module] ! FS.Error => CONTINUE ]; END; DeleteOne[ModuleName[control]]; DeleteOne[ModuleName[client]]; DeleteOne[ModuleName[server]]; END; ModuleDotMesa: PROCEDURE [moduleName: String] RETURNS [String] = INLINE BEGIN RETURN[moduleName.Cat[".mesa"]] END;  <> SpacesPerNest: INTEGER = 2; SpacesPerTab: INTEGER = 4; ExtraSpacesOnWrap: INTEGER = 2*SpacesPerNest; ApproxMaxIdentifierLength: INTEGER = 12; stillLeadingSpaces, doingComment: BOOLEAN; lineLength, spaces, lastHyphen, lineWrapThreshhold: INTEGER; formattedStream: PUBLIC IO.STREAM _ IO.CreateStream[ streamProcs: IO.CreateStreamProcs[variety: output, class: $Lupine, putChar: CodeLinePut], streamData: NIL]; SetCodeLineLength: PROCEDURE [desiredLineLength: LONG INTEGER] = INLINE BEGIN lineWrapThreshhold _ MAX[ 28, SHORT[desiredLineLength]-ApproxMaxIdentifierLength-ExtraSpacesOnWrap ]; END; InitializeCodeLinePut, StartNewCodeLine: PROCEDURE = INLINE BEGIN stillLeadingSpaces _ TRUE; lineLength _ spaces _ 0; lastHyphen _ -1; doingComment _ FALSE; END; FinalizeCodeLinePut: PROCEDURE = INLINE {}; CodeLinePut: SAFE PROCEDURE[self: IO.STREAM, char: CHAR] = TRUSTED <> <> <> <> <> BEGIN WrapLine: PROC = <> <<(lineWrapThreshhold), any further attempts to indent are ignored.>> BEGIN IF stillLeadingSpaces THEN lineLength _ spaces _ lineWrapThreshhold ELSE BEGIN lineLength _ spaces; IF spaces >= lineWrapThreshhold THEN stillLeadingSpaces _ TRUE; CodeStreamPut[Ascii.CR]; CodeStreamPutRope[IndentInline[(spaces+ExtraSpacesOnWrap)/SpacesPerNest]]; IF doingComment THEN { CodeStreamPutRope["-- "]; lineLength _ lineLength + 3; lastHyphen _ -1 }; END; END; -- WrapLine. ExtendToNextTabStop: PROC [length: INTEGER] RETURNS [--lengthAtStop:-- INTEGER] = INLINE {RETURN[SpacesPerTab*(length/SpacesPerTab+1)]}; SELECT char FROM Ascii.SP => IF lineLength < lineWrapThreshhold THEN { lineLength _ lineLength + 1; IF stillLeadingSpaces THEN spaces _ spaces + 1; CodeStreamPut[Ascii.SP] } ELSE WrapLine; Ascii.TAB => IF lineLength < lineWrapThreshhold THEN { lineLength _ ExtendToNextTabStop[lineLength]; IF stillLeadingSpaces THEN spaces _ ExtendToNextTabStop[spaces]; CodeStreamPut[Ascii.TAB] } ELSE WrapLine; Ascii.CR, Ascii.FF => { StartNewCodeLine[]; CodeStreamPut[char] }; Ascii.BS => WrapLine; -- Special; BS not printed. ENDCASE => { stillLeadingSpaces _ FALSE; lineLength _ lineLength + 1; IF char = '- THEN { IF lastHyphen = lineLength-1 THEN doingComment _ ~doingComment ELSE lastHyphen _ lineLength }; CodeStreamPut[char] }; END; -- CodeLinePut. WF1: PUBLIC PROC[format: Rope.ROPE, v1: IO.Value] = BEGIN formattedStream.PutF[format, v1]; END; WFS, WriteFormattedStrings: PUBLIC PROCEDURE [ s01, s02, s03: String_StringNIL ] = BEGIN IF s01 # StringNIL THEN formattedStream.PutRope[s01]; IF s02 # StringNIL THEN formattedStream.PutRope[s02]; IF s03 # StringNIL THEN formattedStream.PutRope[s03]; END; WFSL, WriteFormattedStringsLong: PUBLIC PROCEDURE [ s01, s02, s03, s04, s05, s06, s07, s08, s09, s10, s11, s12, s13, s14, s15, s16, s17, s18: String_StringNIL] = BEGIN IF s01 # StringNIL THEN formattedStream.PutRope[s01]; IF s02 # StringNIL THEN formattedStream.PutRope[s02]; IF s03 # StringNIL THEN formattedStream.PutRope[s03]; IF s04 # StringNIL THEN formattedStream.PutRope[s04]; IF s05 # StringNIL THEN formattedStream.PutRope[s05]; IF s06 # StringNIL THEN formattedStream.PutRope[s06]; IF s07 # StringNIL THEN formattedStream.PutRope[s07]; IF s08 # StringNIL THEN formattedStream.PutRope[s08]; IF s09 # StringNIL THEN formattedStream.PutRope[s09]; IF s10 # StringNIL THEN formattedStream.PutRope[s10]; IF s11 # StringNIL THEN formattedStream.PutRope[s11]; IF s12 # StringNIL THEN formattedStream.PutRope[s12]; IF s13 # StringNIL THEN formattedStream.PutRope[s13]; IF s14 # StringNIL THEN formattedStream.PutRope[s14]; IF s15 # StringNIL THEN formattedStream.PutRope[s15]; IF s16 # StringNIL THEN formattedStream.PutRope[s16]; IF s17 # StringNIL THEN formattedStream.PutRope[s17]; IF s18 # StringNIL THEN formattedStream.PutRope[s18]; END; WFL, WriteFormattedLine: PUBLIC PROCEDURE [ nest: Nest, s01, s02, s03: String_StringNIL ] = BEGIN formattedStream.PutRope[IndentInline[nest]]; WFS[s01, s02, s03]; formattedStream.PutChar[Ascii.CR]; END; WFL1, WriteFormattedLine1: PUBLIC PROCEDURE [nest: Nest, s01: String] = BEGIN formattedStream.PutRope[IndentInline[nest]]; formattedStream.PutRope[s01]; formattedStream.PutChar[Ascii.CR]; END; WFLL, WriteFormattedLineLong: PUBLIC PROCEDURE [ nest: Nest, s01, s02, s03, s04, s05, s06: String_StringNIL ] = BEGIN formattedStream.PutRope[IndentInline[nest]]; WFSL[s01, s02, s03, s04, s05, s06]; formattedStream.PutChar[Ascii.CR]; END; Indent: PUBLIC PROCEDURE [nest: Nest] RETURNS [--tabsAndSpaces:-- String] = BEGIN RETURN[ IndentInline[nest] ]; END; IndentInline: PROCEDURE [nest: Nest] RETURNS [--tabsAndSpaces:-- String] = INLINE BEGIN RETURN[ NestTable[MIN[nest,LAST[NestTableIndex]]] ]; END; NestTableIndex: TYPE = Nest[0..30]; NestTable: PACKED ARRAY NestTableIndex OF String = [ <> --00-- "", --01-- " ", --02-- " ", --03-- " ", --04-- " ", --05-- " ", --06-- " ", --07-- " ", --08-- " ", --09-- " ", --10-- " ", --11-- " ", --12-- " ", --13-- " ", --14-- " ", --15-- " ", --16-- " ", --17-- " ", --18-- " ", --19-- " ", --20-- " ", --21-- " ", --22-- " ", --23-- " ", --24-- " ", --25-- " ", --26-- " ", --27-- " ", --28-- " ", --29-- " ", --30-- " " ]; <> END. -- LupineManagerImpl.