-- Stub file PDInterpControlRpcServerImpl.mesa was translated on 17-Nov-83
-- 16:30:30 PST by Lupine of 18-Feb-83 11:25:52 PST.
-- Source interface PDInterpControl came from file PDInterpControl.bcd,
-- which was created on 17-Nov-83 16:29:50 PST with version stamp 143#147#26343705132
-- from source of 16-Nov-83 14:49:41 PST.
-- The RPC stub modules for PDInterpControl are:
-- PDInterpControlRpcControl.mesa;
-- PDInterpControlRpcClientImpl.mesa;
-- PDInterpControlRpcBinderImpl.mesa;
-- PDInterpControlRpcServerImpl.mesa.
-- The parameters for this translation are:
-- Target language = Mesa;
-- Default parameter passing = VALUE;
-- Deallocate server heap arguments = TRUE;
-- Inline RpcServerImpl dispatcher stubs = TRUE;
-- Maximum number of dynamic heap NEWs = 50, MDS NEWs = 50;
-- Acceptable parameter protocols = VersionRange[1,1].
DIRECTORY
PDInterpControl,
PDInterpControlRpcControl USING [InterMdsCallsOnly, LupineProtocolVersion,
ProcedureIndex, SignalIndex],
MesaRPC USING [EncryptionKey, InterfaceName, Principal, standardZones,
Zones],
RPCLupine --USING SOME OF [Call, DataLength, Dispatcher, ExportHandle,
-- ExportInterface, GetStubPkt, maxDataLength, maxPrincipalLength,
-- maxShortStringLength, pktOverhead, ReceiveExtraPkt, SendPrelimPkt,
-- StartCall, StartSignal, StubPkt, UnexportInterface]--,
LupineRuntime --USING SOME OF [BindingError, CheckPktLength, CopyFromPkt,
-- CopyFromMultiplePkts, CopyToPkt, CopyToMultiplePkts, DispatchingError,
-- FinishThisPkt, ListHeader, MarshalingError, MarshalingExprError,
-- NilHeader, ProtocolError, RopeHeader, RpcPktDoubleWord, RuntimeError,
-- SequenceHeader, SHORT, StartNextPkt, StringHeader, StubPktDoubleWord,
-- TranslationError, UnmarshalingError, UnmarshalingExprError, WordsForChars]--,
Heap USING [systemZone, systemMDSZone];
PDInterpControlRpcServerImpl: MONITOR
IMPORTS PDInterpControl, RpcPrivate: RPCLupine, Lupine: LupineRuntime,
Heap
EXPORTS PDInterpControlRpcControl
SHARES PDInterpControl, PDInterpControlRpcControl
= BEGIN OPEN PDInterpControl, RpcControl: PDInterpControlRpcControl,
RpcPublic: MesaRPC;
-- Standard remote binding routines.
bound: BOOLEAN ← FALSE;
myInterface: RpcPrivate.ExportHandle ← NULL;
paramZones: RpcPublic.Zones ← RpcPublic.standardZones;
ExportInterface: PUBLIC ENTRY PROCEDURE [
interfaceName: RpcPublic.InterfaceName,
user: RpcPublic.Principal,
password: RpcPublic.EncryptionKey,
parameterStorage: RpcPublic.Zones ] =
BEGIN ENABLE UNWIND => NULL;
IsNull: PROCEDURE [string: LONG STRING] RETURNS [BOOLEAN] =
INLINE {RETURN[ string=NIL OR string.length=0 ]};
IF bound THEN Lupine.BindingError;
myInterface ← RpcPrivate.ExportInterface [
interface: [
type: IF ~IsNull[interfaceName.type]
THEN interfaceName.type ELSE "PDInterpControl~143#147#26343705132"L,
instance: interfaceName.instance,
version: interfaceName.version ],
user: user, password: password,
dispatcher: ServerDispatcher,
localOnly: RpcControl.InterMdsCallsOnly,
stubProtocol: RpcControl.LupineProtocolVersion ];
paramZones ← [
heap: IF parameterStorage.heap # NIL
THEN parameterStorage.heap ELSE Heap.systemZone,
mds: IF parameterStorage.mds # NIL
THEN parameterStorage.mds ELSE Heap.systemMDSZone ];
bound ← TRUE;
END;
UnexportInterface: PUBLIC ENTRY PROCEDURE =
BEGIN ENABLE UNWIND => NULL;
IF ~bound THEN Lupine.BindingError;
myInterface ← RpcPrivate.UnexportInterface[myInterface];
paramZones ← RpcPublic.standardZones;
bound ← FALSE;
END;
-- Public procedure dispatcher and public signal and error catcher.
ServerDispatcher: --PROCEDURE [pkt: RPCPkt, callLength: DataLength,
-- lastPkt: BOOLEAN, localConversation: Conversation] RETURNS [returnLength:
-- DataLength]-- RpcPrivate.Dispatcher =
BEGIN
-- Catch public signals.
ENABLE BEGIN
END; -- Catch public signals.
-- Call public procedures (still in dispatcher).
SELECT LOOPHOLE[pkt.data[0], RpcControl.ProcedureIndex] FROM
RequestService => RETURN[
RequestServiceStub[pkt: pkt, callLength: callLength, lastPkt:
lastPkt, localConversation: localConversation]];
ENDCASE => RETURN[Lupine.DispatchingError[]];
END; -- ServerDispatcher
-- Public procedure dispatcher stubs.
RequestServiceStub: --PROCEDURE [requestorName: LONG STRING, pageSpec:
-- PageSpec]-- RpcPrivate.Dispatcher =
INLINE BEGIN
requestorName: LONG STRING;
pageSpec: PageSpec;
ArgumentOverlay: TYPE = MACHINE DEPENDENT RECORD [
transferIndex (0): RpcControl.ProcedureIndex, pageSpec (1): PageSpec];
argPkt: LONG POINTER TO ArgumentOverlay = @pkt.data[0];
pktLength: RpcPrivate.DataLength ← 61;
MaxHeapAllocs: CARDINAL = 1;
heapAllocVector: ARRAY [1..MaxHeapAllocs] OF LONG POINTER←ALL[NIL];
BEGIN ENABLE UNWIND => BEGIN -- Free storage.
FOR ptr: CARDINAL IN [1..LENGTH[heapAllocVector]] DO
IF heapAllocVector[ptr] = NIL
THEN EXIT
ELSE paramZones.heap.FREE[@heapAllocVector[ptr]];
ENDLOOP;
END; -- Free storage.
BEGIN -- OnePkt.
onePkt: BOOLEAN = lastPkt;
IF ~onePkt THEN BEGIN -- Must move statics from pkt now.
[pageSpec: pageSpec] ← argPkt↑;
END;
BEGIN -- Unmarshal requestorName: LONG STRING from pkt.data[pktLength].
stringIsNIL: Lupine.NilHeader;
IF pktLength+3 > RpcPrivate.maxDataLength
THEN pktLength ← Lupine.FinishThisPkt[pkt: pkt, pktLength:
pktLength];
stringIsNIL ← pkt.data[pktLength]; pktLength ← pktLength+1;
IF stringIsNIL
THEN requestorName ← NIL
ELSE BEGIN
stringHeader: Lupine.StringHeader;
stringHeader.all ← Lupine.RpcPktDoubleWord[pkt, pktLength]↑;
pktLength ← pktLength + 2;
requestorName ← (heapAllocVector[1] ← paramZones.heap.NEW[StringBody[stringHeader.maxLength]]);
requestorName.length ← stringHeader.length;
pktLength ← Lupine.CopyFromPkt[pkt: pkt, pktLength: pktLength,
dataAdr: BASE[requestorName.text], dataLength: Lupine.WordsForChars[stringHeader.length],
alwaysOnePkt: FALSE];
END; -- IF stringIsNIL.
END; -- Unmarshal requestorName.
Lupine.CheckPktLength[pkt: pkt, pktLength: pktLength];
IF onePkt
THEN RequestService[requestorName, argPkt.pageSpec]
ELSE RequestService[requestorName, pageSpec];
END; -- OnePkt.
pktLength ← 0;
END; -- ENABLE UNWIND => Free storage.
FOR ptr: CARDINAL IN [1..LENGTH[heapAllocVector]] DO
IF heapAllocVector[ptr] = NIL
THEN EXIT
ELSE paramZones.heap.FREE[@heapAllocVector[ptr]];
ENDLOOP;
RETURN[returnLength: pktLength];
END; -- RequestServiceStub.
-- No module initialization.
END. -- PDInterpControlRpcServerImpl.