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𡤎mptyDirectoryList,
options: Options,
nest: Nest𡤀 ] =
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𡤎mptyDirectoryList,
options: Options,
nest: Nest𡤀,
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𡤁] =
BEGIN
TransferEnumeration[ nest: nest,
enumerationName: Private.GetString[procedureIndex],
procs: TRUE ];
END;
SignalIndex: PUBLIC PROCEDURE [nest: Nest𡤁] =
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.