-- File [Ivy]<Nelson>Lupine>LupineManagerImpl.mesa.
-- Last edited by BZM on 12-May-82 19:22:17.
-- Last eidted by Andrew Birrell on October 4, 1982 12:37 pm
DIRECTORY
-- Cedar-only interfaces used to write a sequential file:
ConvertUnsafe USING [ToRope],
FileIO USING [Open],
IO USING [Close, Handle, PutChar],
-- Mesa-compatible interfaces:
Ascii USING [BS, CR, FF, SP, TAB],
CWF USING [SetWriteProcedure, SWF1, SWF2, WF0, WF1, WF2, WFCR],
Directory USING [DeleteFile, Error, Lookup],
File USING [Capability, nullCapability],
Heap USING [systemZone],
LongString USING [AppendString],
LupineMakeRpcModules USING [
MakeRpcControlModule, MakeRpcClientModule,
MakeRpcClientBinderModule, MakeRpcServerModule ],
LupineManager USING [],
LupineManagerPrivate USING [
Abort, AllocString, Error,
ErrorCode, ErrorHandlerProc, ErrorType,
ExplanationProc, IsNull,
Language, MaxFilenameLength, MaxIdentifierLength,
ModuleTypes, Nest, Options, ParamPassingMethod,
SHORT, String, StringNIL, WFS, WFS1, WFSL],
LupineMarshal USING [ParameterProtocolVersions],
LupineSymbolTable USING [
CloseInterface, GetInterfaceInfo, GMT, InterfaceInfo,
MaxVersionStampStringLength,
OpenError, OpenInterface, VersionStampString, VersionStamp ],
Runtime USING [GetBcdTime],
Time USING [Current];
LupineManagerImpl: MONITOR
IMPORTS
ConvertUnsafe, CWF, Directory, FileIO, IO, Heap,
LupineMakeRpcModules, LupineManagerPrivate,
Marshal: LupineMarshal, Runtime, ST: LupineSymbolTable,
LongString, Time
EXPORTS LupineManager, LupineManagerPrivate =
BEGIN OPEN LupineManagerPrivate;
-- Top-level translator routine.
TranslateRemoteInterface: PUBLIC ENTRY PROCEDURE [
interfaceBcdFilename: String,
interfaceBcdCapability: File.Capability ← File.nullCapability,
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];
-- Can raise ST.OpenError.
BEGIN ENABLE UNWIND => {
ST.CloseInterface;
ClearErrorHandler };
interfaceNameString: AllocString = [MaxIdentifierLength];
interfaceName: String;
contents: ST.InterfaceInfo;
[contents: contents, moduleName: interfaceName] ←
ST.GetInterfaceInfo[moduleNameString: interfaceNameString];
MakeModuleNames[interfaceName, options.targetLanguage];
BEGIN ENABLE UNWIND => FreeModuleNames;
--DeleteExistingCodeFiles;
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: File.Capability ] =
BEGIN
IF interfaceCapability = File.nullCapability
THEN BEGIN
fileName: AllocString = [MaxFilenameLength];
LongString.AppendString[fileName, interfaceFilename];
AppendBcd[fileName];
interfaceCapability ← Directory.Lookup[
fileName: fileName
! Directory.Error => GOTO noFile ];
END;
ST.OpenInterface[interfaceFilename, interfaceCapability];
EXITS
noFile => Abort[code: NoSuchFile, problemText: interfaceFilename];
END;
AppendBcd: PROCEDURE [s: String] =
INLINE BEGIN
FOR i: CARDINAL IN [0..s.length-1) DO
IF s[i] = '. THEN EXIT;
REPEAT
FINISHED => LongString.AppendString[s, ".bcd"L];
ENDLOOP;
END;
-- Client-level error handling routines.
clientErrorHandler: ErrorHandlerProc ← NIL;
EstablishErrorHandler: PROCEDURE [handler: ErrorHandlerProc] =
INLINE {clientErrorHandler ← handler};
ClearErrorHandler: PROCEDURE = INLINE {clientErrorHandler ← NIL};
AbortTranslation: PRIVATE ERROR = CODE;
-- Raised by ReportError and caught by TranslateRemoteInterface.
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
-- This routine keeps explanations out of the global frame.
Explanation: PACKED ARRAY ErrorCode OF --explanation:-- String = [
AnonymousIdentifier:
"Unnamed item (probably record component) encountered; cannot marshal this anonymous item."L,
BadBcdFileFormat:
"Module or file has invalid BCD or symbols format."L,
BadBcdFileVersion:
"So-called BCD file has an incorrect version stamp."L,
ComputedVariant:
"Address-containing computed or overlaid variant record encountered; cannot marshal these records."L,
ComputedSequence:
"Computed sequence encountered; cannot marshal these sequences."L,
EmbeddedRESULT:
"VAR or RESULT parameter has embedded addresses; cannot marshal these parameters."L,
EmptyArray:
"Empty (hint for dynamic?) array encountered; use explicit descriptors and sequences instead."L,
HandleREF:
"REF-containing type being passed as a handle; this is extremely dangerous for the collector."L,
ImproperPassingMethod:
"Parameter uses call by VAR, VALUE, RESULT, or HANDLE improperly."L,
ImproperReadonlyRESULT:
"Readonly parameter cannot be called by VAR or RESULT."L,
ImproperRESULTResult:
"Result parameter called by VAR or RESULT; only arguments can be called by VAR and RESULT."L,
InterfaceVariables:
"Interface contains variables; interface variables are not supported."L,
InvalidHandle:
"Ref or pointer to unspecified, completely opaque, or ANY encountered; it must be passed as a HANDLE."L,
NoSuchFile:
"Could not find required file or module."L,
NotInterfaceModule:
"Specified file is not a DEFINITIONS module; PROGRAM module translation is not supported."L,
ProbablePointerRecursion:
"Probable list, tree, or graph detected; can only marshal explicit LIST OF types."L,
TransferParameter:
"Cannot YET marshal transfer (e.g., procedure) parameter."L,
SequenceInsideVariant:
"An arm of a variant record contains a sequence; this marshaling is not implemented."L,
ShortInterMdsPointers:
"Parameter of interMDS call contains short pointers; use long pointers instead."L,
UnimplementedMarshaling:
"Marshaling this type is either impossible or unimplemented."L,
Unknown:
"<No error description available.>"L,
UnsupportedTransfers:
"Interface contains PROCESSES, PROGRAMS, or PORTS; only procedures, signals, and errors are supported."L ];
explainer[Explanation[code]];
END;
-- Routines that construct the string names of important modules.
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"L, Mesa: "MesaRPC"L ];
MakeName: PROC [root: String, suffix: String←""L]
RETURNS[rootSuffix: String] =
BEGIN
StringLength: PROC [s: LONG STRING] RETURNS [CARDINAL] =
INLINE {RETURN[IF s=NIL THEN 0 ELSE s.length]};
rootSuffix ← Heap.systemZone.NEW[
StringBody[ StringLength[root] + StringLength[suffix] ] ];
CWF.SWF2[rootSuffix, "%LS%LS"L, root, suffix];
END; -- MakeName.
moduleNames[interface] ← MakeName[interfaceName];
moduleNames[openedInterface] ← MakeName[""L];
-- Global OPEN 'interfaceName'. if openedInterface=NIL; named otherwise.
moduleNames[control] ← MakeName[interfaceName, "RpcControl"L];
moduleNames[client] ← MakeName[interfaceName, "RpcClientImpl"L];
moduleNames[clientBinder] ← MakeName[interfaceName, "RpcBinderImpl"L];
moduleNames[server] ← MakeName[interfaceName, "RpcServerImpl"L];
moduleNames[rpcPublic] ← MakeName[RpcInterfaceName[language]];
-- OPEN RpcPublic: RPC (or MesaRPC).
moduleNames[rpcPrivate] ← MakeName["RPCLupine"L];
-- OPEN RpcPrivate: RPCLupine.
moduleNames[lupineRuntime] ← MakeName["LupineRuntime"L];
-- OPEN Lupine: LupineRuntime.
END;
FreeModuleNames: PROCEDURE [] =
BEGIN
FOR module: ModuleTypes IN ModuleTypes DO
IF moduleNames[module] # StringNIL
THEN Heap.systemZone.FREE[@moduleNames[module]];
ENDLOOP;
END;
-- Output file routines (via CWF) for the Mesa code that Lupine generates.
codeFilename: String ← NIL;
codeFilenameString: AllocString = [MaxFilenameLength];
codeStream: IO.Handle ← NIL;
codeStreamIndex: LONG INTEGER ← 0;
OpenCodeFile: PUBLIC PROCEDURE [codeModuleName: String] =
BEGIN
-- Not in PILOT:
-- File names always have a trailing ".".
-- Truncate so that whole file name is <40.
-- codeModuleName.length ← MIN[33, codeModuleName.length];
codeFilename ← ModuleDotMesa [
moduleName: codeModuleName, fileNameString: codeFilenameString ];
codeStream ← FileIO.Open[
fileName: ConvertUnsafe.ToRope[from: codeFilename],
accessOptions: overwrite ];
codeStreamIndex ← 0;
[] ← CWF.SetWriteProcedure[CodeLinePut];
InitializeCodeLinePut;
END;
CodeStreamPut: PROCEDURE [char: CHARACTER] =
INLINE BEGIN
codeStream.PutChar[char];
codeStreamIndex ← codeStreamIndex + 1;
END;
GetCodeFileName: PROC RETURNS [String] =
INLINE {RETURN[
IF IsNull[codeFilename] THEN StringNIL ELSE codeFilename ]};
GetCodeStreamIndex: PROC RETURNS [LONG INTEGER] =
INLINE {RETURN[codeStreamIndex]};
StampCodeFile: PUBLIC PROCEDURE [codeModuleName:String] =
BEGIN
moduleNameString: AllocString = [MaxIdentifierLength];
fileNameString: AllocString = [MaxFilenameLength];
versionString: AllocString = [ST.MaxVersionStampStringLength];
moduleName, fileName: String;
now: ST.GMT ← Time.Current[];
lupineTime: ST.GMT ← Runtime.GetBcdTime[];
moduleVersion: ST.VersionStamp;
moduleTime, sourceTime: ST.GMT;
[moduleName: moduleName, fileName: fileName, moduleVersion: moduleVersion,
moduleCreateTime: moduleTime, sourceCreateTime: sourceTime]
← ST.GetInterfaceInfo[
moduleNameString: moduleNameString, fileNameString: fileNameString];
-- NOT IN PILOT:
-- Remove final "." in fileName.
-- fileName.length ← fileName.length - 1;
WFS["-- Stub file "L, codeFilename, " was translated on "L];
CWF.WF2["%LT by Lupine of %LT.*N"L, @now, @lupineTime];
WFSL["*N-- Source interface "L, moduleName, " came from file "L, fileName];
CWF.WF1[", which was created on %LT with version stamp "L, @moduleTime];
WFS[ST.VersionStampString[stamp: moduleVersion, string: versionString]];
CWF.WF1[" from source of %LT.*N"L, @sourceTime];
END;
StampTranslationOptions: PUBLIC PROCEDURE [options: Options] =
BEGIN
LanguageString: ARRAY Language OF String = [Cedar: "Cedar"L, Mesa: "Mesa"L];
ParamPassingString: ARRAY ParamPassingMethod OF String = [
Var: "VAR"L, Value: "VALUE"L, Result: "RESULT"L,
Handle: "HANDLE"L, InterMds: "InterMds"L ];
BoolString: ARRAY BOOLEAN OF String = [TRUE: "TRUE"L, FALSE: "FALSE"L];
oldest, newest: LONG INTEGER;
[oldestSupported: oldest, newestSupported: newest]
← Marshal.ParameterProtocolVersions[];
WFSL["
-- The parameters for this translation are:
-- Target language = "L,
LanguageString[options.targetLanguage], ";
-- Default parameter passing = "L,
ParamPassingString[options.defaultParamPassing], ";
-- Deallocate server heap arguments = "L,
BoolString[options.freeServerArguments], ";
-- Inline RpcServerImpl dispatcher stubs = "L,
BoolString[options.inlineServerDispatcherStubs], ";
-- Maximum number of dynamic heap NEWs = "L ];
CWF.WF2[ "%LD, MDS NEWs = %LD"L,
@options.maxHeapAllocations, @options.maxMdsAllocations ];
WFS1[";
-- Acceptable parameter protocols = VersionRange"L ];
CWF.WF2["[%LD,%LD]"L, @oldest, @newest];
WFS1[".*N"L];
END; -- StampTranslationOptions.
CloseCodeFile: PUBLIC PROCEDURE =
-- It is VERY important to call CloseCodeFile on any relevant UNWINDs.
BEGIN
FinalizeCodeLinePut;
[] ← CWF.SetWriteProcedure[NIL];
codeStream.Close[];
codeStreamIndex ← 0;
codeFilename ← NIL;
END;
DeleteExistingCodeFiles: PROCEDURE =
BEGIN
DeleteOne: PROC [module: String] =
BEGIN
fileName: AllocString = [MaxFilenameLength];
Directory.DeleteFile [
fileName: ModuleDotMesa[module, fileName]
! Directory.Error => CONTINUE ];
END;
DeleteOne[ModuleName[control]];
DeleteOne[ModuleName[client]];
DeleteOne[ModuleName[server]];
END;
ModuleDotMesa: PROCEDURE [moduleName, fileNameString: String]
RETURNS [fileName: String] =
BEGIN
fileName ← fileNameString;
CWF.SWF1[fileName, "%LS.mesa"L, moduleName];
END;
-- Simple formatting routines for indenting and wrapping code lines.
SpacesPerNest: INTEGER = 2;
SpacesPerTab: INTEGER = 8;
ExtraSpacesOnWrap: INTEGER = 2*SpacesPerNest;
ApproxMaxIdentifierLength: INTEGER = 12;
stillLeadingSpaces, doingComment: BOOLEAN;
lineLength, spaces, lastHyphen, lineWrapThreshhold: INTEGER;
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: PROCEDURE[chr: CHARACTER] =
-- This routine WILL wrap comments and string constants. Lupine
-- generates no troublesome strings (i.e., strings that are too long
-- or contain one or more hyphens). Comments should be wrapped OK.
-- The BS character is specially interpreted to mean start a new line
-- and indent for a continuation (as in a multiline record declaration).
BEGIN
WrapLine: PROC =
-- If the current line is indented all the way to the RIGHT margin
-- (lineWrapThreshhold), any further attempts to indent are ignored.
BEGIN
IF stillLeadingSpaces
THEN lineLength ← spaces ← lineWrapThreshhold
ELSE BEGIN
indent: String = IndentInline[(spaces+ExtraSpacesOnWrap)/SpacesPerNest];
lineLength ← spaces;
IF spaces >= lineWrapThreshhold THEN stillLeadingSpaces ← TRUE;
CodeStreamPut[Ascii.CR];
FOR i: CARDINAL IN [0..indent.length) DO
CodeStreamPut[indent[i]] ENDLOOP;
IF doingComment THEN {
CodeStreamPut['-]; CodeStreamPut['-]; CodeStreamPut[' ];
lineLength ← lineLength + 3; lastHyphen ← -1 };
END;
END; -- WrapLine.
ExtendToNextTabStop: PROC [length: INTEGER]
RETURNS [--lengthAtStop:-- INTEGER] =
INLINE {RETURN[SpacesPerTab*(length/SpacesPerTab+1)]};
SELECT chr 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[chr] };
Ascii.BS => WrapLine; -- Special; BS not printed.
ENDCASE => {
stillLeadingSpaces ← FALSE;
lineLength ← lineLength + 1;
IF chr = '- THEN {
IF lastHyphen = lineLength-1
THEN doingComment ← ~doingComment ELSE lastHyphen ← lineLength };
CodeStreamPut[chr] };
END; -- CodeLinePut.
WFL, WriteFormattedLine: PUBLIC PROCEDURE [
nest: Nest, s01, s02, s03: String←StringNIL ] =
BEGIN
CWF.WF0[IndentInline[nest]]; WFS[s01, s02, s03]; CWF.WFCR[];
END;
WFL1, WriteFormattedLine1: PUBLIC PROCEDURE [nest: Nest, s01: String] =
BEGIN
CWF.WF0[IndentInline[nest]]; WFS1[s01]; CWF.WFCR[];
END;
WFLL, WriteFormattedLineLong: PUBLIC PROCEDURE [
nest: Nest, s01, s02, s03, s04, s05, s06: String←StringNIL ] =
BEGIN
CWF.WF0[IndentInline[nest]];
WFSL[s01, s02, s03, s04, s05, s06];
CWF.WFCR[];
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 = [
-- These constants must have SpacesPerNest spaces per nest.
--0..5-- "", " ", " ", " ", " ", " ",
--6..9-- " ", " ", " ", " ",
--10-- " ",
--11-- " ",
--12-- " ",
--13-- " ",
--14-- " ",
--15-- " ",
--16-- " ",
--17-- " ",
--18-- " ",
--19-- " ",
--20-- " ",
--21-- " ",
--22-- " ",
--23-- " ",
--24-- " ",
--25-- " ",
--26-- " ",
--27-- " ",
--28-- " ",
--29-- " ",
--30-- " " ];
-- No module initialization.
END. -- LupineManagerImpl.