File LupineDeclareBindingImpl.mesa.
Last edited by BZM on 12-May-82 19:18:54.
Last edited by Andrew Birrell on September 14, 1983 8:22 am.
This module cooperates with LupineDeclare*Impl to export LupineDeclare.
DIRECTORY
LupineDeclare USING [ImportExport, WriteTransferName, WriteTypeName],
LupineDeclarePrivate USING [DispatcherName],
LupineManagerPrivate USING [
Indent, ModuleName,
Nest, Options, String, StringNIL, WFL, WFL1, WFS, WFS1, WFSL ],
LupineSymbolTable USING [
EnumerateTransfers, GetInterfaceInfo, GMT,
TransferProcedure,
VersionStamp, VersionStampString ],
Rope USING[ Length, Substr ],
RPCLupine USING [maxShortStringLength];
LupineDeclareBindingImpl: PROGRAM
IMPORTS
Declare: LupineDeclare, LupineManagerPrivate,
Private: LupineDeclarePrivate, 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 [
interfaceName: InterfaceName ← defaultInterfaceName,
parameterStorage: Zones ← standardZones ];

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

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 ]
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 ["];
BEGIN
DeclareTransferField: ST.TransferProcedure =
BEGIN
WFS1[Indent[nest+2]]; Declare.WriteTransferName[transfer];
WFS1[": "]; Declare.WriteTypeName[transferType]; WFS1[",\n"];
END;
[] ← ST.EnumerateTransfers [
proc: DeclareTransferField, procs: TRUE, signals: TRUE, errors: TRUE ];
END;
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.

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 [
interfaceName: RpcPublic.InterfaceName,
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"];
ImportCall[options];
ZoneAssignment[options];
WFSL[" bound ← TRUE;
END;

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];
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 =>
BEGIN
WFSL["
ImportNewInterface: PUBLIC ", Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
parameterStorage: RpcPublic.Zones ]
RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
", Trusted[options], "BEGIN
interfaceRecord ← NewInterface[];
LupineDetails[interfaceRecord].module.ImportInterface [
interfaceName: interfaceName,
parameterStorage: parameterStorage
! 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;" ];
END; -- import.
export =>
BEGIN
NULL;
END; -- export.
ENDCASE => ERROR;
END; -- BindingRoutinesDynamic.
BindingRoutinesPrivate: PUBLIC PROC [kind: ImportExport, options: Options] =
BEGIN
SELECT kind FROM
import =>
BEGIN
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" ] ];
END; -- import.
export =>
BEGIN
NULL;
END; -- export.
ENDCASE => ERROR;
END; -- BindingRoutinesPrivate.
Binding utility routines.
ImportCall: PROCEDURE [options: Options] =
BEGIN
WFS1[
" myInterface ← RpcPrivate.ImportInterface [
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 ];\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] =
BEGIN
WFS[
" 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;
Trusted: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[STL[options: options, cedar: "TRUSTED "]];
END;
END. -- LupineDeclareBindingImpl.