
<<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>>

<<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 ];
", 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 ]
    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_1] =
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 ] =
    ", 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 ]
      RETURNS [interfaceRecord: RpcControl.InterfaceRecord] =
    ", Trusted[options], "BEGIN
    interfaceRecord _ NewInterfaceRecord[];
    RpcControl.ImportInterface[
        interface: interfaceRecord,
        interfaceName: interfaceName,
        parameterStorage: parameterStorage];
    END;

" ];

}
ELSE {
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;" ];
};
};  -- 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_clientInterfaceCache) # 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 _ 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"];
}
 ELSE {
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, 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>>
    <<>>