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