-- File LupineDeclareBindingImpl.mesa.
-- Last edited by BZM on 12-May-82 19:18:54.
-- Last edited by Andrew Birrell on February 18, 1983 11:06 am.
-- This module cooperates with LupineDeclare*Impl to export LupineDeclare.
DIRECTORY
CWF USING [WFC],
LupineDeclare USING [ImportExport, WriteTransferName, WriteTypeName],
LupineDeclarePrivate USING [DispatcherName],
LupineManagerPrivate USING [
AllocString, Indent, ModuleName,
Nest, Options, String, StringNIL, WFL, WFL1, WFS, WFS1, WFSL ],
LupineSymbolTable USING [
EnumerateTransfers, GetInterfaceInfo, GMT,
MaxVersionStampStringLength, TransferProcedure,
VersionStamp, VersionStampString ],
RPCLupine USING [maxShortStringLength];
LupineDeclareBindingImpl: PROGRAM
IMPORTS
CWF, Declare: LupineDeclare, LupineManagerPrivate,
Private: LupineDeclarePrivate, ST: LupineSymbolTable
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: "L, Safe[options], "PROCEDURE [
interfaceName: InterfaceName ← defaultInterfaceName,
parameterStorage: Zones ← standardZones ];
UnimportInterface: "L, Safe[options], "PROCEDURE;
ExportInterface: "L, Safe[options], "PROCEDURE [
interfaceName: InterfaceName ← defaultInterfaceName,
user: Principal,
password: EncryptionKey,
parameterStorage: Zones ← standardZones ];
UnexportInterface: "L, Safe[options], "PROCEDURE;
*F
-- Dynamic instantiation and binding.
ImportNewInterface: "L, Safe[options], "PROCEDURE [
interfaceName: InterfaceName ← defaultInterfaceName,
parameterStorage: Zones ← standardZones ]
RETURNS [interfaceRecord: InterfaceRecord];*N"L];
WFS1[ STL[options: options, mesa: "
UnimportNewInterface: PROCEDURE [interfaceRecord: InterfaceRecord];*N"L] ];
WFSL[ "
-- NewInterfaceRecord is necessary for Cedar clients who want to
-- manufacture a private interface instance, because
-- RpcBindingImpl has finalization on type InterfaceRecord.
NewInterfaceRecord: "L, Safe[options], "PROCEDURE
RETURNS [interfaceRecord: InterfaceRecord];*N"L];
InterfaceRecord[options];
END;
InterfaceRecord: PROCEDURE [options: Options, nest: Nest←1] =
BEGIN
WFSL["*N"L, Indent[nest],
"InterfaceRecord: TYPE = "L,
STL[options, "REF"L, "LONG POINTER TO"L], " InterfaceRecordObject;*N*N"L];
WFL1[nest, "InterfaceRecordObject: TYPE = RECORD ["L];
BEGIN
DeclareTransferField: ST.TransferProcedure =
BEGIN
WFS1[Indent[nest+2]]; Declare.WriteTransferName[transfer];
WFS1[": "L]; Declare.WriteTypeName[transferType]; WFS1[",*N"L];
END;
[] ← ST.EnumerateTransfers [
proc: DeclareTransferField, procs: TRUE, signals: TRUE, errors: TRUE ];
END;
WFL[nest+2, "lupineDetails: PRIVATE "L,
STL[options, "REF"L, "LONG POINTER TO"L], " LupineDetailsObject←NIL];*N"L];
WFL1[nest, "LupineDetailsObject: PRIVATE TYPE;"L];
END;
-- Standard interface binding code generator.
BindingRoutinesStandard: PUBLIC PROC [kind: ImportExport, options: Options] =
BEGIN
WFS["
*F
-- Standard remote binding routines.
bound: BOOLEAN ← FALSE;
myInterface: RpcPrivate."L,
(SELECT kind FROM
import => "Import"L, export => "Export"L, ENDCASE => ERROR),
"Handle ← NULL;
paramZones: RpcPublic.Zones ← RpcPublic.standardZones;*N"L];
SELECT kind FROM
import =>
BEGIN
WFSL["
ImportInterface: PUBLIC ENTRY "L, Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
parameterStorage: RpcPublic.Zones ] =
"L, Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IsNull: PROCEDURE [string: LONG STRING] RETURNS [BOOLEAN] =
INLINE {RETURN[ string=NIL OR string.length=0 ]};
IF bound THEN Lupine.BindingError;*N"L];
ImportCall[options];
ZoneAssignment[options];
WFSL[" bound ← TRUE;
END;
UnimportInterface: PUBLIC ENTRY "L, Safe[options], "PROCEDURE =
"L, Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IF ~bound THEN Lupine.BindingError;
myInterface ← RpcPrivate.UnimportInterface[myInterface];
paramZones ← RpcPublic.standardZones;
bound ← FALSE;
END;*N"L ];
END; -- import.
export =>
BEGIN
WFSL["
ExportInterface: PUBLIC ENTRY "L, Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
user: RpcPublic.Principal,
password: RpcPublic.EncryptionKey,
parameterStorage: RpcPublic.Zones ] =
"L, Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IsNull: PROCEDURE [string: LONG STRING] RETURNS [BOOLEAN] =
INLINE {RETURN[ string=NIL OR string.length=0 ]};
IF bound THEN Lupine.BindingError;*N"L];
ExportCall[options];
ZoneAssignment[options];
WFSL[" bound ← TRUE;
END;
UnexportInterface: PUBLIC ENTRY "L, Safe[options], "PROCEDURE =
"L, Trusted[options], "BEGIN ENABLE UNWIND => NULL;
IF ~bound THEN Lupine.BindingError;
myInterface ← RpcPrivate.UnexportInterface[myInterface];
paramZones ← RpcPublic.standardZones;
bound ← FALSE;
END;*N"L];
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"L];
SELECT kind FROM
import =>
BEGIN
WFSL["
ImportNewInterface: PUBLIC "L, Safe[options], "PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
parameterStorage: RpcPublic.Zones ]
RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
"L, Trusted[options], "BEGIN
interfaceRecord ← NewInterface[];
LupineDetails[interfaceRecord].module.ImportInterface [
interfaceName: interfaceName,
parameterStorage: parameterStorage
! UNWIND => FreeInterface[interfaceRecord] ];
END;
UnimportNewInterface: "L,
STL[options: options, mesa: "PUBLIC "L], Safe[options], "PROCEDURE [
interfaceRecord: RpcControl.InterfaceRecord ] =
"L, Trusted[options], "BEGIN
LupineDetails[interfaceRecord].module.UnimportInterface[];
FreeInterface[interfaceRecord];
END;*N"L ];
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 = "L,
STL[options, "REF"L, "LONG POINTER TO"L], " 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["L, 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 ← "L, 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←clientInterfaceCache) # NIL
THEN clientInterfaceCache ← LupineDetails[clientInterfaceCache].next;
END;*N"L,
STL[options: options, cedar:
" ReclaimInterfaces[];*N"L ],
" IF (interface ← GetCachedInterface[]) = NIL
THEN BEGIN
ChainNewInterface: ENTRY PROCEDURE =
INLINE BEGIN ENABLE UNWIND => NULL;
interface.lupineDetails ← "L, LupineZone[options], "NEW[
LupineDetailsObject ← [module: module, list: clientInterfaceList]];
clientInterfaceList ← interface;
END; -- ChainNewInterface.
module: ClientModule = NEW ClientPrototype;
interface ← NewInterfaceRecord[];
interface↑ ← [*B"L];
BEGIN
AssignTransferField: ST.TransferProcedure =
BEGIN
IF transferIndex > 1 THEN WFS1[", "L];
Declare.WriteTransferName[transfer];
WFS1[": module."L]; Declare.WriteTransferName[transfer];
END; -- AssignTransferField.
[] ← ST.EnumerateTransfers [
proc: AssignTransferField, procs: TRUE, signals: TRUE, errors: TRUE ];
END;
WFS["];
ChainNewInterface[];
END;
END;
FreeInterface: ENTRY PROCEDURE [interface: RpcControl.InterfaceRecord]=
INLINE BEGIN ENABLE UNWIND => NULL;
LupineDetails[interface].next ← clientInterfaceCache;
clientInterfaceCache ← interface;
END;*N"L];
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"L,
mesa: "
-- No module initialization.*N"L ] ];
END; -- import.
export =>
BEGIN
NULL;
END; -- export.
ENDCASE => ERROR;
END; -- BindingRoutinesPrivate.
-- Binding utility routines.
ImportCall: PROCEDURE [options: Options] =
BEGIN
Interface: PROC RETURNS [String] =
INLINE {RETURN[STL[options, ""L, "interfaceName."L]]};
WFSL[
STL[options: options, cedar:
" BEGIN
type: STRING = [RpcPrivate.maxShortStringLength];
instance: STRING = [RpcPrivate.maxShortStringLength];
ConvertUnsafe.AppendRope[to: type, from: interfaceName.type];
ConvertUnsafe.AppendRope[to: instance, from: interfaceName.instance];*N"L],
" myInterface ← RpcPrivate.ImportInterface [
interface: [
type: IF ~IsNull["L, Interface[], "type]
THEN "L, Interface[], "type ELSE "L];
DefaultInterfaceType[options]; WFSL[",
instance: "L, Interface[], "instance,
version: interfaceName.version ],
localOnly: RpcControl.InterMdsCallsOnly,
stubProtocol: RpcControl.LupineProtocolVersion ];*N"L,
STL[options: options, cedar: " END;*N"L] ];
END;
ExportCall: PROCEDURE [options: Options] =
BEGIN
Interface: PROC RETURNS [String] =
INLINE {RETURN[STL[options, ""L, "interfaceName."L]]};
WFSL[
STL[options: options, cedar:
" BEGIN
type: STRING = [RpcPrivate.maxShortStringLength];
instance: STRING = [RpcPrivate.maxShortStringLength];
userString: STRING = [RpcPrivate.maxPrincipalLength];
ConvertUnsafe.AppendRope[to: type, from: interfaceName.type];
ConvertUnsafe.AppendRope[to: instance, from: interfaceName.instance];
ConvertUnsafe.AppendRope[to: userString, from: user];*N"L],
" myInterface ← RpcPrivate.ExportInterface [
interface: [
type: IF ~IsNull["L, Interface[], "type]
THEN "L, Interface[], "type ELSE "L];
DefaultInterfaceType[options]; WFSL[",
instance: "L, Interface[], "instance,
version: interfaceName.version ],
user: "L, STL[options, "userString"L, "user"L], ", password: password,
dispatcher: "L, Private.DispatcherName[type: server], ",
localOnly: RpcControl.InterMdsCallsOnly,
stubProtocol: RpcControl.LupineProtocolVersion ];*N"L,
STL[options: options, cedar: " END;*N"L] ];
END;
LupineZone: PROC [options: Options] RETURNS [--zoneQualifier:-- String] =
INLINE {RETURN[ STL[options, ""L, "Heap.systemZone."L] ]};
ZoneAssignment: PROCEDURE [options: Options] =
BEGIN
WFS[
" paramZones ← [*N"L,
STL[options: options,
cedar:
" gc: IF parameterStorage.gc # NIL
THEN parameterStorage.gc ELSE SafeStorage.GetSystemZone[],
heap: IF parameterStorage.heap # NIL
THEN parameterStorage.heap ELSE UnsafeStorage.GetSystemUZone[],*N"L,
mesa:
" heap: IF parameterStorage.heap # NIL
THEN parameterStorage.heap ELSE Heap.systemZone,*N"L ],
" mds: IF parameterStorage.mds # NIL
THEN parameterStorage.mds ELSE Heap.systemMDSZone ];*N"L ];
END;
DefaultInterfaceType: PROCEDURE [options: Options] =
{WFS1[""""L]; WriteInterfaceNameDateID; WFS1["""L"L]};
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.
-- NEW: The stamp has the form "PilotDefs~0#0#000". (Compiler equivalent)
-- OLD: The stamp has the form "PilotDefs~1-Jan-81~00:00:00~0#0#000".
BEGIN
MaxIDLength: INTEGER = RPCLupine.maxShortStringLength;
MaxTimeStringLength: INTEGER = 0--18--; ZoneLength: INTEGER = 4;
DefaultRegistry: String = ""L; -- The stamp is not currently an RName.
Separator: String = "~"L;
module: String = ModuleName[interface];
maxModuleLength: INTEGER = MIN[
module.length,
MaxIDLength - (ST.MaxVersionStampStringLength + MaxTimeStringLength
+ DefaultRegistry.length + 2*Separator.length) ];
timeString: AllocString = [MaxTimeStringLength+ZoneLength];
stampString: AllocString = [ST.MaxVersionStampStringLength];
time: ST.GMT;
version: ST.VersionStamp;
[moduleVersion: version, moduleCreateTime: time] ← ST.GetInterfaceInfo[];
--CWF.SWF1[timeString, "%LT"L, @time];
--timeString.length ← MaxTimeStringLength;
--FOR i: CARDINAL IN [0..timeString.length) DO
-- Grapevine's Maintain program does not like spaces in RNames.
-- IF timeString[i] = ' THEN timeString[i] ← Separator[0] ENDLOOP;
FOR i: INTEGER IN [0..maxModuleLength) DO CWF.WFC[module[i]] ENDLOOP;
WFSL[
-- Module name (truncated if necessary) was written above,
--Separator, timeString,
Separator, ST.VersionStampString[version, stampString],
DefaultRegistry ];
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 "L]];
END;
Trusted: PROCEDURE [options: Options] RETURNS [String] =
INLINE BEGIN
RETURN[STL[options: options, cedar: "TRUSTED "L]];
END;
END. -- LupineDeclareBindingImpl.