-- 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.