
<<LupineDeclareUtilityImpl.mesa.>>
    <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
<<Last edited by>>
<<BZM on March 18, 1982  10:56 AM.>>
    <<Birrell, September 12, 1983 3:37 pm>>
    <<Swinehart, July 22, 1984 2:35:17 pm PDT>>
    <<Bob Hagmann February 8, 1985 5:02:41 pm PST>>

<<This module cooperates with LupineDeclare*Impl to export LupineDeclare.>>

DIRECTORY
Convert USING [RopeFromInt],
IO USING [PutFR],
LupineDeclare USING [
DirectoryItem, DirectoryList, DispatcherType,
EmptyDirectoryList, InterfaceUse, ModuleNameList ],
LupineDeclarePrivate USING [GetString, StringConstantType],
LupineManagerPrivate USING [
Error, Indent, IsNull, Language,
ModuleName,
Nest, NextOutputFile, Options, OutputToAllFiles, String, StringNIL,
WF1, WFC, WFL, WFL1, WFLL, WFS, WFS1, WFSL ],
LupineSymbolTable USING [
DirectoryProcedure, EnumerateDirectory, EnumerateTransfers,
IsAnonymous, PutTypeName, SymbolHandle, SymbolID,
SymbolName, SymbolType, SymbolUniqueID,
TransferProcedure, TypeHandle ],
Rope USING [Cat, Equal, Length, Substr];


LupineDeclareUtilityImpl: PROGRAM
IMPORTS
Convert, IO, LupineManagerPrivate,
Private: LupineDeclarePrivate, ST: LupineSymbolTable, Rope 
EXPORTS LupineDeclare, LupineDeclarePrivate
= BEGIN OPEN LupineManagerPrivate, LupineDeclare;


<<General symbol and type routines.>>

TransferName: PUBLIC PROCEDURE [transfer: ST.SymbolHandle]
RETURNS[name: String] =
BEGIN
IF ST.IsAnonymous[transfer]
THEN ERROR
ELSE RETURN[ST.SymbolName[transfer]];
END;

WriteTransferName: PUBLIC PROCEDURE [transfer: ST.SymbolHandle] =
BEGIN
WFS1[TransferName[transfer]];
END;

ParameterName: PUBLIC PROCEDURE [parameter: ST.SymbolHandle,
parameterNumber: INTEGER]
RETURNS [name: String] =
BEGIN
IF ST.IsAnonymous[parameter]
THEN BEGIN
paramID: LONG CARDINAL --ST.SymbolID-- _ ST.SymbolUniqueID[parameter];
name _ IO.PutFR["anonP%gid%g", [cardinal[parameterNumber]], [integer[paramID]]];
RETURN;
END
ELSE RETURN[ST.SymbolName[parameter]];
END;

WriteParameterName: PUBLIC PROCEDURE [
parameter: ST.SymbolHandle, parameterNumber: INTEGER] =
BEGIN
WFS1[ParameterName[parameter, parameterNumber]];
END;

WriteSymbolName: PUBLIC PROCEDURE [symbol: ST.SymbolHandle] =
BEGIN
IF ST.IsAnonymous[symbol]
THEN Error[AnonymousIdentifier]
ELSE WFS1[ST.SymbolName[symbol]];
END;

WriteSymbolType: PUBLIC PROCEDURE [symbol: ST.SymbolHandle] =
BEGIN
WriteTypeName[ST.SymbolType[symbol]];
END;

WriteTypeName: PUBLIC PROCEDURE [
type: ST.TypeHandle, includeReadonly: BOOLEAN_TRUE, extraFirstArg: String _ NIL ] =
BEGIN
Put: PROC[c: CHAR] =
{ WFC[c] };
ST.PutTypeName[
putProc: Put,
type: type,
includeReadonly: includeReadonly,
rootInterfaceOpenName: ModuleName[openedInterface],
extraFirstArg: extraFirstArg ];
END;


<<Directory and interface manipulation routines.>>

Directory: PUBLIC PROCEDURE [
includeInterfaceDirectory: BOOLEAN_TRUE,
extraDirectories: DirectoryList_EmptyDirectoryList,
options: Options,
nest: Nest_0 ] =
BEGIN
printedOne: BOOLEAN_FALSE;
maxExtraDirLength: INTEGER = 6*16;
duplicate: PACKED ARRAY [0..maxExtraDirLength) OF BOOLEAN _ ALL[FALSE];
PrintDirItem: PROCEDURE [dirItem: DirectoryItem, file: String_StringNIL] =
BEGIN
hasFileName: BOOLEAN =
~IsNull[file] AND ~Rope.Equal[dirItem.module, file, FALSE];
IF ~dirItem.forLanguage[options.targetLanguage] OR IsNull[dirItem.module] OR dirItem.inhibit THEN RETURN;
IF printedOne
THEN WFS[",\n", Indent[nest+1]]
ELSE BEGIN
WFSL["\n\n", Indent[nest], "DIRECTORY\n", Indent[nest+1]];
printedOne _ TRUE;
END;
WFS[dirItem.module];
IF hasFileName THEN WFS[": FROM """, file, """"];
SELECT TRUE FROM
dirItem.usingAll # StringNIL =>
WFS[" USING [", dirItem.usingAll, "]"];
dirItem.usingSome # StringNIL =>
WFS[" --USING SOME OF [", dirItem.usingSome, "]--"];
ENDCASE => NULL;
END;  -- PrintDirItem.
IF LENGTH[extraDirectories] > maxExtraDirLength THEN ERROR;
IF includeInterfaceDirectory
THEN BEGIN
PrintInterfaceDirItem: ST.DirectoryProcedure =
BEGIN
FOR dir: CARDINAL IN [0..LENGTH[extraDirectories]) DO
IF Rope.Equal[extraDirectories[dir].module, moduleName]
THEN {duplicate[dir] _ TRUE; EXIT};
ENDLOOP;
PrintDirItem[dirItem: [module: moduleName], file: fileName];
END;  -- PrintInterfaceDirItem.
IF options.inlineRopeMarshal THEN FOR dir: CARDINAL IN [0..LENGTH[extraDirectories]) DO
IF extraDirectories[dir].outOfLineMarshalOnly THEN { duplicate[dir] _ TRUE; EXIT; };
ENDLOOP;
[] _ ST.EnumerateDirectory[PrintInterfaceDirItem];
END;
FOR dir: CARDINAL IN [0..LENGTH[extraDirectories]) DO
<<Must do this list second so that USING conflicts are avoided.>>
IF ~duplicate[dir] THEN PrintDirItem[dirItem: extraDirectories[dir]];
ENDLOOP;
IF printedOne THEN WFS1[";\n"];
END;

ModuleHead: PUBLIC PROCEDURE [
moduleNames: ModuleNameList,
moduleType: String,
interfaceList: DirectoryList_EmptyDirectoryList,
options: Options,
nest: Nest_0,
noOutputFiles: INT _ 1 ] = 
BEGIN
UseKeywords: ARRAY InterfaceUse OF RECORD [begin, end: String] = [
imports: ["IMPORTS ", "\n"], exports: ["EXPORTS ", "\n"],
shares:  ["SHARES  ", "\n"], beginOpen: ["= BEGIN OPEN ", ";\n"] ];
hasThisUse: ARRAY InterfaceUse OF BOOLEAN _ ALL[FALSE];
IF LENGTH[moduleNames]=0 OR IsNull[moduleType] THEN ERROR;
FOR item: CARDINAL IN [0..LENGTH[interfaceList]) DO
FOR use: InterfaceUse IN InterfaceUse DO
IF options.inlineRopeMarshal AND interfaceList[item].outOfLineMarshalOnly THEN LOOP;
<<Don't consider interface item if marshaling inline and only used out of line>>
IF interfaceList[item].usedIn[use] THEN hasThisUse[use] _ TRUE;
ENDLOOP;
ENDLOOP;
WFS["\n\n", Indent[nest]];
IF noOutputFiles = 1 THEN WFS[moduleNames[0]]
 ELSE {
nameBeforeImpl: String = moduleNames[0].Substr[0, moduleNames[0].Length[]-4];
OutputToAllFiles[];
FOR no: INT IN [1..noOutputFiles] DO 
module: String = nameBeforeImpl.Cat[Convert.RopeFromInt[from: no, showRadix: FALSE] , "Impl"];
NextOutputFile[];

ENDLOOP;
OutputToAllFiles[];
};
WFS[": ", moduleType, "\n"];
FOR use: InterfaceUse IN InterfaceUse DO
IF hasThisUse[use] THEN
InterfaceList [ nest: nest+1,
use: use,
targetSystem: options.targetLanguage,
interfaceList: interfaceList,
beginText: UseKeywords[use].begin,
endText: UseKeywords[use].end,
options: options ]; 
ENDLOOP;
IF ~hasThisUse[beginOpen] THEN WFL1[nest+1, "= BEGIN"];
END;

InterfaceList: PUBLIC PROCEDURE [
use: InterfaceUse,
targetSystem: Language,
interfaceList: DirectoryList,
beginText, endText: String_StringNIL,
options: Options, 
nest: Nest ] = 
BEGIN
printedOne: BOOLEAN_FALSE;
WFS[Indent[nest], beginText];
FOR item: CARDINAL IN [0..LENGTH[interfaceList]) DO
interface: DirectoryItem = interfaceList[item];
IF   ~interface.usedIn[use]
OR interface.inhibit
OR ~interface.forLanguage[targetSystem]
OR IsNull[interface.module]
OR (options.inlineRopeMarshal AND interface.outOfLineMarshalOnly)
THEN LOOP;
IF printedOne THEN WFS1[", "] ELSE printedOne _ TRUE;
IF use=beginOpen OR (use=imports AND ~interface.usedIn[beginOpen])
THEN IF ~IsNull[interface.openName] THEN WFS[interface.openName, ": "];
WFS[interface.module];
ENDLOOP;
WFS1[endText];
END;


<<Other code generation routines.>>

LastLupineTransferIndex: INTEGER = 3B;

ProcedureIndex: PUBLIC PROCEDURE [nest: Nest_1] =
BEGIN
TransferEnumeration[ nest: nest,
enumerationName: Private.GetString[procedureIndex],
procs: TRUE ];
END;

SignalIndex: PUBLIC PROCEDURE [nest: Nest_1] =
BEGIN
TransferEnumeration[ nest: nest,
enumerationName: Private.GetString[signalIndex],
exceptions: TRUE ];
END;

TransferEnumeration: PROCEDURE [
enumerationName: String,
procs, exceptions: BOOLEAN _ FALSE,
nest: Nest ] =
BEGIN
index: INTEGER _ LastLupineTransferIndex;
WriteIndex: PROC =
{WF1[" (%g)", [integer[index]]];  index _ index + 1};
NameList: ST.TransferProcedure =
BEGIN
WFS1[IF transferIndex=1 THEN ",\B" ELSE ", "];
WriteTransferName[transfer];  WriteIndex;
END;
WFSL["\n", Indent[nest], enumerationName,
": PRIVATE TYPE = MACHINE DEPENDENT {\B",
"LupineUnusedIndex (0), LupineLastIndex" ];
WriteIndex;
[] _ ST.EnumerateTransfers[
proc: NameList, procs: procs, errors: exceptions, signals: exceptions ];
WFS1["};\n"];
END;


DispatcherHead: PUBLIC PROCEDURE [type: DispatcherType, nest: Nest] =
BEGIN
WFS1["\n"];
WFLL[nest, DispatcherName[type], ": --",
Private.GetString[dispatcherDeclaration], "-- RpcPrivate.Dispatcher ="];
WFL1[nest+1, "BEGIN"];
END;

DispatcherSelect: PUBLIC PROCEDURE [type: DispatcherType, nest: Nest] =
BEGIN
WFL[nest+1, "SELECT LOOPHOLE[pkt.data[0], RpcControl.",
(SELECT type FROM
server => Private.GetString[procedureIndex],
client => Private.GetString[signalIndex],
ENDCASE => ERROR),
"] FROM"];
END;

DispatcherTail: PUBLIC PROCEDURE [type: DispatcherType, nest: Nest] =
BEGIN
WFL1[nest+2, "ENDCASE => RETURN[Lupine.DispatchingError[]];\n"];
WFL[nest+1, "END;  -- ", DispatcherName[type]];
END;


<<Routines private to LupineDeclare*Impl via LupineDeclarePrivate.>>

DispatcherName: PUBLIC PROCEDURE [type: DispatcherType] RETURNS [String] =
BEGIN
RETURN[ SELECT type FROM
none => StringNIL,
client => GetString[clientDispatcher],
server => GetString[serverDispatcher],
callback => GetString[callbackDispatcher],
ENDCASE => ERROR ];
END;


StringConstants: PACKED ARRAY Private.StringConstantType OF String = [
clientDispatcher: "ClientDispatcher",
serverDispatcher: "ServerDispatcher",
callbackDispatcher: "CallbackDispatcher",
procedureIndex: "ProcedureIndex",
signalIndex: "SignalIndex",
dispatcherDeclaration: "PROCEDURE [pkt: RPCPkt, callLength: DataLength, lastPkt: BOOLEAN, localConversation: Conversation] RETURNS 
[returnLength: DataLength]",
dispatcherArgs: "pkt: pkt, callLength: callLength, lastPkt: lastPkt, localConversation: localConversation",
dispatcherResults: "returnLength: returnLength",
dispatcherPkt: "pkt",
dispatcherConversation: "localConversation",
dispatcherReturnLength: "returnLength" ];

GetString: PUBLIC PROCEDURE [type: Private.StringConstantType]
RETURNS [--string:-- String] =
BEGIN RETURN[StringConstants[type]] END;


END.  -- LupineDeclareUtilityImpl.