LupineDeclareBindingImpl.mesa.
Copyright © 1985 by Xerox Corporation. All rights reserved.
Last edited by BZM on 12-May-82 19:18:54.
Last edited by Andrew Birrell on September 14, 1983 8:22 am.
Bob Hagmann May 23, 1985 8:37:35 am PDT
Swinehart, February 21, 1986 5:45:09 pm PST
This module cooperates with LupineDeclare*Impl to export LupineDeclare.
DIRECTORY
LupineDeclare USING [GetArgResultInfo, GetTransferInfo, ImportExport, WriteTransferName, WriteParameterName, WriteTypeName],
LupineDeclarePrivate USING [DispatcherName],
LupineManagerPrivate USING [
Indent, ModuleName,
Nest, Options, String, StringNIL, WFL, WFL1, WFS, WFS1, WFSL ],
LupineMarshal USING [ EnumerateParams, ParamInfo, ParamProcedure],
LupineSymbolTable USING [
EnumerateTransfers, GetInterfaceInfo, GMT,
TransferProcedure, TypeInfo,
VersionStamp, VersionStampString ],
Rope USING[ Length, Substr ],
RPCLupine USING [maxShortStringLength];
LupineDeclareBindingImpl: PROGRAM
IMPORTS
Declare: LupineDeclare, LupineManagerPrivate,
Private: LupineDeclarePrivate, Marshal: LupineMarshal, ST: LupineSymbolTable, Rope
EXPORTS LupineDeclare
= BEGIN OPEN LupineManagerPrivate, LupineDeclare;
Binding interface code generator.
BindingInterface: PUBLIC PROCEDURE [options: Options] =
BEGIN
WFSL["

-- Public RPC types and constants.

InterfaceName: TYPE = RpcPublic.InterfaceName;
VersionRange: TYPE = RpcPublic.VersionRange;
Principal: TYPE = RpcPublic.Principal;
EncryptionKey: TYPE = RpcPublic.EncryptionKey;
Zones: TYPE = RpcPublic.Zones;

defaultInterfaceName: InterfaceName = RpcPublic.defaultInterfaceName;
standardZones: Zones = RpcPublic.standardZones;


-- Standard remote binding routines.

ImportInterface: ", Safe[options], "PROCEDURE [
", needInterface[options],
"interfaceName: InterfaceName ← defaultInterfaceName,
parameterStorage: Zones ← standardZones,
hostHint: RpcPrivateExtras.RPCHost←RpcPrivateExtras.noHost];
", IF options.targetLanguage = Mesa OR ~options.importMultiple THEN "
UnimportInterface: PROCEDURE;" ELSE "", "

ExportInterface: ", Safe[options], "PROCEDURE [
interfaceName: InterfaceName ← defaultInterfaceName,
user: Principal,
password: EncryptionKey,
parameterStorage: Zones ← standardZones ];

UnexportInterface: ", Safe[options], "PROCEDURE;


-- Dynamic instantiation and binding.

ImportNewInterface: ", Safe[options], "PROCEDURE [
interfaceName: InterfaceName ← defaultInterfaceName,
parameterStorage: Zones ← standardZones,
hostHint: RpcPrivateExtras.RPCHost←RpcPrivateExtras.noHost]
RETURNS [interfaceRecord: InterfaceRecord];\n"];
WFS1[ STL[options: options, mesa: "
UnimportNewInterface: PROCEDURE [interfaceRecord: InterfaceRecord];\n"] ];
WFSL[ "
-- NewInterfaceRecord is necessary for Cedar clients who want to
-- manufacture a private interface instance, because
-- RpcBindingImpl has finalization on type InterfaceRecord.
NewInterfaceRecord: ", Safe[options], "PROCEDURE
RETURNS [interfaceRecord: InterfaceRecord];\n"];
InterfaceRecord[options];
END;
InterfaceRecord: PROCEDURE [options: Options, nest: Nest𡤁] =
BEGIN
WFSL["\n", Indent[nest],
"InterfaceRecord: TYPE = ",
STL[options, "REF", "LONG POINTER TO"], " InterfaceRecordObject;\n\n"];
WFL1[nest, "InterfaceRecordObject: TYPE = RECORD ["];
IF options.targetLanguage = Cedar AND options.importMultiple THEN WFL1[nest+1, " myInterface: RpcPrivate.ImportHandle ← NIL,
paramZones: RpcPublic.Zones ← RpcPublic.standardZones,"];
BEGIN
DeclareTransferField: ST.TransferProcedure = BEGIN
extraFirstArg: String ← StringNIL;
WFS1[Indent[nest+2]];
SELECT kind FROM
Procedure => {
IF options.targetLanguage = Cedar AND options.importMultiple THEN extraFirstArg ← "interface: InterfaceRecord";
writeClientPrefix[options];
};
Error, Signal => {
};
ENDCASE;
Declare.WriteTransferName[transfer];
WFS1[": "];
Declare.WriteTypeName[
type: transferType,
extraFirstArg: extraFirstArg
];
WFS1[",\n"];
END;
[] ← ST.EnumerateTransfers [
proc: DeclareTransferField, procs: TRUE, signals: TRUE, errors: TRUE ];
END;
IF options.targetLanguage = Cedar AND options.importMultiple THEN {
TransferInfo: TYPE = Transfer ST.TypeInfo;
InlineTransfer: ST.TransferProcedure = {
transferInfo: TransferInfo = Declare.GetTransferInfo[transferType];
argInfo, resultInfo: Marshal.ParamInfo;
[argInfo, resultInfo] ← Declare.GetArgResultInfo[
transferInfo: transferInfo,
transferDeclaration: inRoutine,
transferSite: callee, pktSite: rpcRuntime,
options: options ];
WFS1[Indent[nest]];
Declare.WriteTransferName[transfer];
WFS1[": "];
Declare.WriteTypeName[type: transferType, extraFirstArg: "interface: InterfaceRecord"];
WFS1[" = "];
IF transferInfo.safe THEN WFS1["CHECKED "];
WFS1["INLINE"];
WFS1[Indent[nest]];
WFS1["{"];
IF resultInfo.paramCount > 0 THEN WFS1[" RETURN"];
WFS1[" interface."];
writeClientPrefix[options];
Declare.WriteTransferName[transfer];
WFS1["[interface"];
IF argInfo.paramCount > 0 THEN {
DoField: Marshal.ParamProcedure =
BEGIN
WFS1[", "];
Declare.WriteParameterName[paramName, paramIndex];
END; -- DoField.
Marshal.EnumerateParams[argInfo, DoField];
};
WFS1["]};\n "];
};
WFL[nest+2, "bound: BOOL ← FALSE];\n"];
[] ← ST.EnumerateTransfers [
proc: InlineTransfer, procs: TRUE, signals: FALSE, errors: FALSE ];
}
ELSE {
WFL[nest+2, "lupineDetails: PRIVATE ",
STL[options, "REF", "LONG POINTER TO"], " LupineDetailsObject←NIL];\n"];
WFL1[nest, "LupineDetailsObject: PRIVATE TYPE;"];
};
END;
Standard interface binding code generator.
BindingRoutinesStandard: PUBLIC PROC [kind: ImportExport, options: Options] =
BEGIN
WFS["

-- Standard remote binding routines.

"];
IF kind = export OR options.targetLanguage # Cedar OR ~options.importMultiple THEN {
WFS[" bound: BOOLEAN ← FALSE;
myInterface: RpcPrivate.",
(SELECT kind FROM
import => "Import", export => "Export", ENDCASE => ERROR),
"Handle;
paramZones: RpcPublic.Zones ← RpcPublic.standardZones;\n"];
};
SELECT kind FROM
import =>
BEGIN
WFSL["
ImportInterface: PUBLIC ENTRY ", Safe[options], "PROCEDURE [
", needLongInterface[options], "interfaceName: RpcPublic.InterfaceName,
parameterStorage: RpcPublic.Zones,
hostHint: RpcPrivateExtras.RPCHost←RpcPrivateExtras.noHost ] =
", Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IsNull: PROCEDURE [string: ",
STL[options, "Rope.ROPE", "LONG STRING"], "] RETURNS [BOOLEAN] =
INLINE {RETURN[",
STL[options, "string.Length[] = 0", "string=NIL OR string.length=0"], "]};
"
, "IF ", needInterfaceDot[options], "bound THEN Lupine.BindingError;\n"];
];
ImportCall[options];
ZoneAssignment[options, import];
WFS[" ", needInterfaceDot[options], "bound ← TRUE;
END;
"];
IF options.targetLanguage # Cedar OR ~options.importMultiple THEN {
WFSL["
UnimportInterface: PUBLIC ENTRY ", Safe[options], "PROCEDURE =
", Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IF ~bound THEN Lupine.BindingError;
myInterface ← RpcPrivate.UnimportInterface[myInterface];
paramZones ← RpcPublic.standardZones;
bound ← FALSE;
END;\n" ];
};
END; -- import.
export =>
BEGIN
WFSL["
ExportInterface: PUBLIC ENTRY ", Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
user: RpcPublic.Principal,
password: RpcPublic.EncryptionKey,
parameterStorage: RpcPublic.Zones ] =
", Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IsNull: PROCEDURE [string: ",
STL[options, "Rope.ROPE", "LONG STRING"], "] RETURNS [BOOLEAN] =
INLINE {RETURN[",
STL[options, "string.Length[] = 0", "string=NIL OR string.length=0"], "]};
IF bound THEN Lupine.BindingError;\n"];
ExportCall[options];
ZoneAssignment[options, export];
WFSL[" bound ← TRUE;
END;

UnexportInterface: PUBLIC ENTRY ", Safe[options], "PROCEDURE =
", Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IF ~bound THEN Lupine.BindingError;
myInterface ← RpcPrivate.UnexportInterface[myInterface];
paramZones ← RpcPublic.standardZones;
bound ← FALSE;
END;\n"];
END; -- export.
ENDCASE => ERROR;
END; -- BindingRoutinesStandard.
Dynamic interface record binding generator.
BindingRoutinesDynamic: PUBLIC PROC [kind: ImportExport, options: Options] =
BEGIN
WFS1["

-- Dynamic instantiation and binding routines.\n"];
SELECT kind FROM
import => {
IF options.targetLanguage = Cedar AND options.importMultiple THEN {
WFSL["
ImportNewInterface: PUBLIC ", Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
parameterStorage: RpcPublic.Zones,
hostHint: RpcPrivateExtras.RPCHost←RpcPrivateExtras.noHost ]
RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
", Trusted[options], "BEGIN
interfaceRecord ← NewInterfaceRecord[];
RpcControl.ImportInterface[
interface: interfaceRecord,
interfaceName: interfaceName,
hostHint: hostHint,
parameterStorage: parameterStorage];
END;

" ];
}
ELSE {
WFSL["
ImportNewInterface: PUBLIC ", Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
parameterStorage: RpcPublic.Zones,
hostHint: RpcPrivateExtras.RPCHost←RpcPrivateExtras.noHost ]
RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
", Trusted[options], "BEGIN
interfaceRecord ← NewInterface[];
LupineDetails[interfaceRecord].module.ImportInterface [
interfaceName: interfaceName,
parameterStorage: parameterStorage,
hostHint: hostHint
! UNWIND => FreeInterface[interfaceRecord] ];
END;

UnimportNewInterface: ",
STL[options: options, mesa: "PUBLIC "], Safe[options], "PROCEDURE [
interfaceRecord: RpcControl.InterfaceRecord ] =
", Trusted[options], "BEGIN
LupineDetails[interfaceRecord].module.UnimportInterface[];
FreeInterface[interfaceRecord];
END;" ];
};
}; -- import.
export =>
BEGIN
NULL;
END; -- export.
ENDCASE => ERROR;
END; -- BindingRoutinesDynamic.
BindingRoutinesPrivate: PUBLIC PROC [kind: ImportExport, options: Options] =
BEGIN
SELECT kind FROM
import => {
IF options.targetLanguage = Cedar AND options.importMultiple THEN {
WFSL["

-- Utility routines for interface instantiation and caching.

NewInterfaceRecord: PUBLIC ", Safe[options], "PROCEDURE
RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
", Trusted[options], "BEGIN
interfaceRecord ← NEW[RpcControl.InterfaceRecordObject];
END;

-- No module initialization.\n" ]
}
ELSE {
WFSL["

-- Utility routines for interface instantiation and caching.

ConcreteLupineDetails: TYPE = ",
STL[options, "REF", "LONG POINTER TO"], " LupineDetailsObject;

LupineDetailsObject: PUBLIC TYPE = RECORD [
module: ClientModule←NIL,
list: RpcControl.InterfaceRecord←NIL, --package reference
next: RpcControl.InterfaceRecord←NIL --free list -- ];

LupineDetails: PROCEDURE [abstractInterface: RpcControl.InterfaceRecord]
RETURNS [ConcreteLupineDetails] =
INLINE {RETURN[abstractInterface.lupineDetails]};

ClientModule: TYPE = POINTER TO FRAME[", ModuleName[client], "];


clientInterfaceCache: RpcControl.InterfaceRecord ← NIL; -- free interface records
clientInterfaceList: RpcControl.InterfaceRecord ← NIL; -- all interface records

NewInterfaceRecord: PUBLIC ", Safe[options], "PROCEDURE
RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
", Trusted[options], "BEGIN
interfaceRecord ← ", LupineZone[options], "NEW[RpcControl.InterfaceRecordObject];
END;

NewInterface: PROCEDURE RETURNS [interface: RpcControl.InterfaceRecord]=
BEGIN
GetCachedInterface: ENTRY PROCEDURE
RETURNS [cachedIR: RpcControl.InterfaceRecord] =
INLINE BEGIN ENABLE UNWIND => NULL;
IF (cachedIR𡤌lientInterfaceCache) # NIL
THEN clientInterfaceCache ← LupineDetails[clientInterfaceCache].next;
END;\n",
STL[options: options, cedar:
" ReclaimInterfaces[];\n" ],
" IF (interface ← GetCachedInterface[]) = NIL
THEN BEGIN
ChainNewInterface: ENTRY PROCEDURE =
INLINE BEGIN ENABLE UNWIND => NULL;
interface.lupineDetails ← ", LupineZone[options], "NEW[
LupineDetailsObject ← [module: module, list: clientInterfaceList]];
clientInterfaceList ← interface;
END; -- ChainNewInterface.
module: ClientModule = NEW ClientPrototype;
interface ← NewInterfaceRecord[];
interface^ ← [\B"];
BEGIN
AssignTransferField: ST.TransferProcedure =
BEGIN
IF transferIndex > 1 THEN WFS1[", "];
Declare.WriteTransferName[transfer];
WFS1[": "];
IF NOT options.declareSignals
AND (SELECT kind FROM Error, Signal => TRUE, ENDCASE => FALSE)
THEN WFS1[ModuleName[interface]]
ELSE WFS1["module"];
WFS1["."];
Declare.WriteTransferName[transfer];
END; -- AssignTransferField.
[] ← ST.EnumerateTransfers [
proc: AssignTransferField, procs: TRUE, signals: TRUE, errors: TRUE ];
END;
WFS["];
ChainNewInterface[];
END;
", STL[options: options, cedar: "RTT.EnableFinalization[interface];
"], "END;

FreeInterface: ENTRY PROCEDURE [interface: RpcControl.InterfaceRecord]=
INLINE BEGIN ENABLE UNWIND => NULL;
LupineDetails[interface].next ← clientInterfaceCache;
clientInterfaceCache ← interface;
END;\n"];
WFS1[ STL[options: options,
cedar: "

-- Finalization for dynamic interfaces. Just cache and reuse for now.

freedInterfaces: RTT.FinalizationQueue = RTT.NewFQ[20];

ReclaimInterfaces: PROCEDURE =
INLINE BEGIN
WHILE ~RTT.FQEmpty[freedInterfaces] DO
interface: RpcControl.InterfaceRecord =
NARROW[RTT.FQNext[freedInterfaces]];
IF interface.lupineDetails # NIL THEN
UnimportNewInterface[interface];
ENDLOOP;
END;


-- Module initialization.

RTT.EstablishFinalization[
type: CODE[RpcControl.InterfaceRecordObject],
npr: 1, fq: freedInterfaces ];\n",
mesa: "

-- No module initialization.\n" ] ];
};
}; -- import.
export =>
BEGIN
NULL;
END; -- export.
ENDCASE => ERROR;
END; -- BindingRoutinesPrivate.
Binding utility routines.
ImportCall: PROCEDURE [options: Options] =
BEGIN
IF options.targetLanguage = Cedar AND options.importMultiple THEN {
DeclareInterfaceProcStub: ST.TransferProcedure = {
IF needComma THEN WFS1[ ", "];
needComma ← TRUE;
IF kind = Procedure THEN writeClientPrefix[options];
Declare.WriteTransferName[transfer];
WFS1[ ": "];
IF kind = Procedure THEN writeClientPrefix[options];
Declare.WriteTransferName[transfer];
};
needComma: BOOL ← FALSE;
WFS1[ " interface^ ← ["];
[] ← ST.EnumerateTransfers[proc: DeclareInterfaceProcStub, procs: TRUE, signals: TRUE, errors: TRUE];
WFS1[ "];\n"];
WFS1[
" interface.myInterface ← RpcPrivateExtras.ImportInterfaceWithHost [
interface: [
type: IF ~IsNull[interfaceName.type]
THEN interfaceName.type ELSE "]; DefaultInterfaceType[options]; WFS1[",
instance: interfaceName.instance,
version: interfaceName.version ],
localOnly: RpcControl.InterMdsCallsOnly,
stubProtocol: RpcControl.LupineProtocolVersion,
hostHint: hostHint ];\n"];
}
ELSE {
WFS1[
" myInterface ← RpcPrivateExtras.ImportInterfaceWithHost [
interface: [
type: IF ~IsNull[interfaceName.type]
THEN interfaceName.type ELSE "]; DefaultInterfaceType[options]; WFS1[",
instance: interfaceName.instance,
version: interfaceName.version ],
localOnly: RpcControl.InterMdsCallsOnly,
stubProtocol: RpcControl.LupineProtocolVersion,
hostHint: hostHint ];\n"];
};
END;
ExportCall: PROCEDURE [options: Options] =
BEGIN
WFS1[
" myInterface ← RpcPrivate.ExportInterface [
interface: [
type: IF ~IsNull[interfaceName.type]
THEN interfaceName.type ELSE "]; DefaultInterfaceType[options]; WFSL[",
instance: interfaceName.instance,
version: interfaceName.version ],
user: user, password: password,
dispatcher: ", Private.DispatcherName[type: server], ",
localOnly: RpcControl.InterMdsCallsOnly,
stubProtocol: RpcControl.LupineProtocolVersion ];\n"];
END;
LupineZone: PROC [options: Options] RETURNS [--zoneQualifier:-- String] =
INLINE {RETURN[ STL[options, "", "Lupine.defaultZones.heap."] ]};
ZoneAssignment: PROCEDURE [options: Options, kind: ImportExport] =
BEGIN
IF kind = import AND options.targetLanguage = Cedar AND options.importMultiple THEN WFS1[" interface."]
ELSE WFS1[" "];
WFS1[
"paramZones ← [
gc: IF parameterStorage.gc # NIL
THEN parameterStorage.gc ELSE Lupine.defaultZones.gc,
heap: IF parameterStorage.heap # NIL
THEN parameterStorage.heap ELSE Lupine.defaultZones.heap,
mds: IF parameterStorage.mds # NIL
THEN parameterStorage.mds ELSE Lupine.defaultZones.mds ];\n" ];
END;
DefaultInterfaceType: PROCEDURE [options: Options] =
{WFS1[""""]; WriteInterfaceNameDateID[]; WFS1["\""]};
WriteInterfaceNameDateID: PROCEDURE =
A module's name-date-uid string is NOT an RName and must have
a maximum of 64 characters. The module name is shortened if necessary.
The stamp has the form "PilotDefs~0#0#000". (Compiler equivalent)
BEGIN
maxIDLength: INT = RPCLupine.maxShortStringLength;
module: String = ModuleName[interface];
truncMod: String;
sep: String = "~";
stamp: String;
time: ST.GMT;
version: ST.VersionStamp;
[moduleVersion: version, moduleCreateTime: time] ← ST.GetInterfaceInfo[];
stamp ← ST.VersionStampString[version];
truncMod ← module.Substr[
start: 0,
len: MIN[module.Length[],maxIDLength-stamp.Length[]-sep.Length[]]];
WFSL[truncMod, sep, stamp];
END;
STL, SelectTargetLanguage: PROCEDURE [
options: Options, cedar, mesa: String←StringNIL ]
RETURNS [--targetString:-- String] =
INLINE BEGIN
RETURN[ SELECT options.targetLanguage FROM
Cedar => cedar, Mesa => mesa, ENDCASE => ERROR ];
END;
Safe: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[STL[options: options, cedar: "SAFE "]];
END;
needInterfaceDot: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[IF options.targetLanguage = Cedar AND options.importMultiple
THEN "interface."
ELSE ""];
END;
needLongInterface: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[IF options.targetLanguage = Cedar AND options.importMultiple
THEN "interface: RpcControl.InterfaceRecord,
"
ELSE ""];
END;
needInterface: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[IF options.targetLanguage = Cedar AND options.importMultiple
THEN "interface: InterfaceRecord,
"
ELSE ""];
END;
writeClientPrefix: PROCEDURE [options: Options] =
INLINE BEGIN
IF options.targetLanguage = Cedar AND options.importMultiple THEN WFS1["clientStub"];
END;
Trusted: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[STL[options: options, cedar: "TRUSTED "]];
END;
END. -- LupineDeclareBindingImpl.
Bob Hagmann May 22, 1985 8:11:25 am PDT
changes to: BindingInterface
Bob Hagmann May 23, 1985 8:31:10 am PDT
changes to: BindingRoutinesStandard