-- Copyright (C) 1984 by Xerox Corporation. All rights reserved.
-- RPCPktStreams.mesa, HGM, 21-Jan-84 20:40:13
-- Cedar 5, HGM, 21-Jan-84 20:40:10
-- RPC: Call-oriented packet streams, based on PktExchange
-- RPCPktStreams.mesa
-- Andrew Birrell March 11, 1983 3:49 pm
DIRECTORY
Buffer USING [PupBuffer, ReturnBuffer],
Driver USING [GetInputBuffer],
Environment USING [wordsPerPage, PageNumber, PageCount],
Frame USING [GetReturnFrame, MyLocalFrame],
Heap USING [systemZone],
Inline USING [BITAND, BITXOR, LongCOPY],
ProcessOperations USING [HandleToIndex, ReadPSB],
PSB USING [PsbIndex, PsbNull],
PupDefs USING [GetLocalPupAddress, PupRouterSendThis],
PupTypes USING [PupAddress, PupHostID, PupNetID, PupSocketID],
MesaRPC USING [CallFailed, Conversation, unencrypted],
RPCInternal USING [
ConversationObject, DecryptPkt, EncryptPkt, exportTable, firstConversation,
GetConnectionState, ImportInstance],
MesaRPCLupine USING [
DataLength, Dispatcher, GetRPCPkt, Header, maxDataLength, maxPupWords,
pktOverhead, RPCPkt],
RPCPkt USING [
CallCount, ConnectionID, DispatcherDetails, EnqueueAgain, IdleReceive, Header,
Machine, noDispatcher, Outcome, PktExchange, pktLengthOverhead,
SetupResponse],
RPCPrivate USING [rpcSocket],
Space USING [
Allocate, Interval, PageFromLongPointer, Deallocate],
SpaceUsage USING [CommunicationUsage],
VM USING [Map, nullBackingStoreRuns, Unmap];
RPCPktStreams: MONITOR
IMPORTS
Buffer, Driver, Frame, Heap, Inline, ProcessOperations, PupDefs, MesaRPC, MesaRPCLupine,
RPCInternal, RPCPkt, Space, VM
EXPORTS
MesaRPC --Header,ConversationObject-- , RPCInternal --DoSignal, ServerMain-- ,
MesaRPCLupine --lots of things--
SHARES Buffer, MesaRPCLupine =
BEGIN
Header: PUBLIC TYPE = RPCPkt.Header;
ConcreteHeader: PROC [abstract: LONG POINTER TO MesaRPCLupine.Header]
RETURNS [LONG POINTER TO Header] = INLINE {RETURN[abstract]};
myHost: RPCPkt.Machine;
GiveBackBuffer: PROC [b: Buffer.PupBuffer] =
-- NOTE: calls of this must be made outside our monitor, because
-- RPCPrivate.ReturnBuffer acquires the EthernetDriver monitor,
-- and the EthernetDriver may call EnqueueRecvd which acquires
-- our monitor!
Buffer.ReturnBuffer;
-- ******** Caller ******** --
-- For each PSB that initiates a call, record last callee PSB,
-- and use that PSB as destPSB hint for next call, to obtain implicit ack of last
-- result packet. The fact that the destPSB will be wrong of we next talk to
-- a different server host is only a slight pessimization.
CallDestHint: TYPE = ARRAY PSB.PsbIndex OF PSB.PsbIndex;
lastCallDest: LONG POINTER TO CallDestHint = Heap.systemZone.NEW[
CallDestHint ← ALL[PSB.PsbNull]];
RecordCallDest: ENTRY PROC [header: LONG POINTER TO Header] = INLINE {
lastCallDest[header.destPSB --myPSB-- ] ← header.srcePSB};
ImportInstance: PUBLIC TYPE = RPCInternal.ImportInstance;
-- During a call, a single packet is used for buffering all data sent
-- and received. Whenever the client of MesaRPCLupine has possesion of
-- the buffer (after StartCall), the buffer is set up correctly for
-- transmitting. I.e. buffer.header.dest = the remote machine. Thus,
-- this is true on exit from StartCall, and on entry and exit to/from
-- SendPrelimPkt, ReceiveExtraPkt, Call, and the dispatchers. This
-- causes an extra call of SetupResponse in Call in the case where
-- there will be no subsequent call of ReceiveExtraPkt, but it
-- preserves my sanity.
ConversationObject: PUBLIC TYPE = RPCInternal.ConversationObject;
Conversation: TYPE = LONG POINTER TO ConversationObject;
MisusedConversation: ERROR = CODE;
StartCall: PUBLIC ENTRY PROC [
callPkt: MesaRPCLupine.RPCPkt, interface: LONG POINTER TO ImportInstance,
localConversation: Conversation ← MesaRPC.unencrypted] =
BEGIN
myPSB: PSB.PsbIndex = ProcessOperations.HandleToIndex[
ProcessOperations.ReadPSB[]];
header: LONG POINTER TO Header = @callPkt.header;
header.destHost ← interface.host;
header.destSoc ← RPCPrivate.rpcSocket;
header.destPSB ← lastCallDest[myPSB];
callPkt.convHandle ← localConversation;
IF localConversation = MesaRPC.unencrypted THEN
header.conv ← RPCInternal.firstConversation
ELSE
BEGIN
-- ?? header.conv ← RPCInternal.GetPktConversation[localConversation] --
header.conv ← [
localConversation.id.count.ls, caller, localConversation.id.count.ms];
IF localConversation.id.originator # myHost THEN
BEGIN
IF header.destHost # localConversation.id.originator THEN
ERROR MisusedConversation[ ! UNWIND => NULL];
header.conv.originator ← callee;
END;
END;
header.pktID.activity ← myPSB;
-- header.pktID.callSeq gets filled in by PktExchange --
header.pktID.pktSeq ← 0; -- => new call --
header.dispatcher ← interface.dispatcher;
END;
Call: PUBLIC PROC [
pkt: MesaRPCLupine.RPCPkt, callLength: MesaRPCLupine.DataLength,
maxReturnLength: MesaRPCLupine.DataLength,
signalHandler: MesaRPCLupine.Dispatcher ← NIL]
RETURNS [returnLength: MesaRPCLupine.DataLength, lastPkt: BOOLEAN] =
BEGIN
recvdHeader: LONG POINTER TO Header = @pkt.header;
returnLength ← RPCPkt.PktExchange[
pkt, callLength, maxReturnLength, call, signalHandler].newLength;
RecordCallDest[recvdHeader];
SELECT recvdHeader.outcome FROM
result => NULL;
unbound => ERROR MesaRPC.CallFailed[unbound];
protocol => ERROR MesaRPC.CallFailed[runtimeProtocol];
signal => ERROR -- handled inside RPCPkt.PktExchange -- ;
unwind => -- This is legal only if we were called to raise a remote signal;
-- UnwindRequested should be caught where we called the dispatcher
-- that noticed the signal
{RPCPkt.SetupResponse[recvdHeader]; ERROR UnwindRequested[]};
ENDCASE => --unwind,garbage-- ERROR MesaRPC.CallFailed[runtimeProtocol];
RPCPkt.SetupResponse[recvdHeader];
RETURN[returnLength, recvdHeader.type.eom = end]
END;
-- ******** Protocol implementation: multi-packet case ******** --
SendPrelimPkt: PUBLIC PROC [
pkt: MesaRPCLupine.RPCPkt, length: MesaRPCLupine.DataLength] = {
[] ← RPCPkt.PktExchange[pkt, length, 0, sending]};
ReceiveExtraPkt: PUBLIC PROC [pkt: MesaRPCLupine.RPCPkt]
RETURNS [length: MesaRPCLupine.DataLength, lastPkt: BOOLEAN] =
BEGIN
recvdHeader: LONG POINTER TO Header;
length ← RPCPkt.PktExchange[
pkt, 0, MesaRPCLupine.maxDataLength, receiving].newLength;
recvdHeader ← @pkt.header;
RPCPkt.SetupResponse[recvdHeader];
RETURN[length, recvdHeader.type.eom = end]
END;
GetFreeBuffer: PROCEDURE RETURNS [b: Buffer.PupBuffer] =
BEGIN
DO
b ← Driver.GetInputBuffer[TRUE];
IF b # NIL THEN EXIT;
ENDLOOP;
END;
-- ******** Protocol implementation: callee and packets-while-notWanting ******** --
idlerAckCount: CARDINAL ← 0;
idlerRequeueCount: CARDINAL ← 0;
GenerateIdlerResponse: PROC [recvd: MesaRPCLupine.RPCPkt] =
BEGIN
-- packet is encrypted! --
ackPkt: Buffer.PupBuffer = GetFreeBuffer[];
header: LONG POINTER TO Header = LOOPHOLE[@ackPkt.pup.pupLength];
recvdHeader: LONG POINTER TO Header = @recvd.header;
workerPSB: PSB.PsbIndex = recvdHeader.destPSB; -- as adjusted by FindCallee --
idlerAckCount ← idlerAckCount + 1;
RPCPkt.SetupResponse[recvdHeader];
header↑ ← recvdHeader↑;
header.length ← recvdHeader.length;
header.oddByte ← no;
header.type ← [0, rpc, end, dontAck, ack];
header.srceHost ← myHost;
header.srceSoc ← RPCPrivate.rpcSocket;
header.srcePSB ← workerPSB;
PupDefs.PupRouterSendThis[ackPkt];
END;
EnqueueForNewPSB: PROC [recvd: MesaRPCLupine.RPCPkt] =
BEGIN
-- packet is encrypted! --
pupPkt: Buffer.PupBuffer = GetFreeBuffer[];
header: LONG POINTER TO Header = LOOPHOLE[@pupPkt.pup.pupLength];
recvdHeader: LONG POINTER TO Header = @recvd.header;
idlerRequeueCount ← idlerRequeueCount + 1;
Inline.LongCOPY[from: recvdHeader, to: header, nwords: recvdHeader.length];
RPCPkt.EnqueueAgain[pupPkt];
END;
-- We must maintain globally accessible state indicating current calls in the
-- callee, so that the callee can respond to pings.
CalleeState: TYPE = RECORD [
next: POINTER TO CalleeState,
callee: PSB.PsbIndex,
state: LONG POINTER TO Header];
callees: POINTER TO CalleeState ← NIL;
EntryAddCallee: ENTRY PROC [stateBlock: POINTER TO CalleeState] = INLINE {
AddCallee[stateBlock]};
AddCallee: INTERNAL PROC [stateBlock: POINTER TO CalleeState] = INLINE {
stateBlock↑.next ← callees; callees ← stateBlock};
RemoveCallee: ENTRY PROC [stateBlock: POINTER TO CalleeState] =
BEGIN
FOR p: POINTER TO POINTER TO CalleeState ← @callees, @(p↑.next) DO
SELECT TRUE FROM
p↑ = stateBlock => {p↑ ← p↑.next; RETURN};
p↑ = NIL => ERROR;
ENDCASE => NULL;
ENDLOOP;
END;
FindCallee: ENTRY PROC [given: LONG POINTER TO Header] RETURNS [BOOLEAN] =
BEGIN
-- Returns TRUE iff there is a current callee for this call,
-- even if the callee's pktSeq differs. If result is TRUE, updates
-- "given"s destPSB to match callee's.
-- Assumes pkt has been decrypted.
FOR p: POINTER TO CalleeState ← callees, p.next DO
SELECT TRUE FROM
p = NIL => RETURN[FALSE];
p.state.conv = given.conv
--AND same originator .... --
AND p.state.pktID.activity = given.pktID.activity
AND p.state.pktID.callSeq = given.pktID.callSeq =>
BEGIN given↑.destPSB ← p.callee; RETURN[TRUE] END;
ENDCASE => NULL;
ENDLOOP;
END;
-- For each calling RPCPkt.ConnectionID we must maintain a sequence number,
-- being the last call initiated on that conversation, so that we can eliminate
-- duplicate call request packets.
-- This information is maintained as a hash table with linked overflow. The
-- hash function is (connection.caller XOR connection.activity) MOD 128.
-- The hash table is altered by LookupCaller and EndConnection, which are nested
-- inside ServerMain for sordid efficiency reasons, and by NoteCaller.
HashKey: TYPE = [0..127];
ConnectionData: TYPE = RECORD [
next: Connection,
id: RPCPkt.ConnectionID,
call: RPCPkt.CallCount,
conv: MesaRPC.Conversation -- NB: opaque type -- ];
Connection: TYPE = LONG POINTER TO ConnectionData;
connections: LONG POINTER TO ARRAY HashKey OF Connection =
Heap.systemZone.NEW[ARRAY HashKey OF Connection ← ALL[NIL]];
-- Received packets are dispatched to "ServerMain" processes (through IdleReceive)
-- if the addressed process is not wanting to receive any packets at the time,
-- or if the destPSB is PsbNull. Thus ServerMain serves both as the listener
-- waiting for RFC's on a conventional rendezvous protocol, and as the process
-- listening to the incoming per-connection socket in more heavyweight protocols.
-- There are several cases. The packet may be the first packet of a new call -
-- in this case, this process will handle the call. The packet may be an old
-- duplicate packet from a dead call - in this case the packet can be ignored. The
-- packet may be a retransmission in a current call - in this case an ack may be
-- required. Remember that packets can arrive here in both the caller and
-- callee hosts!
serverDataLength: MesaRPCLupine.DataLength = MesaRPCLupine.maxDataLength;
ServerMain: PUBLIC PROC =
BEGIN
myPSB: PSB.PsbIndex = ProcessOperations.HandleToIndex[
ProcessOperations.ReadPSB[]];
words: CARDINAL = serverDataLength + MesaRPCLupine.pktOverhead;
pages: Environment.PageCount =
(words + Environment.wordsPerPage - 1)/Environment.wordsPerPage;
interval: Space.Interval = Space.Allocate[pages];
page: Environment.PageNumber = Space.PageFromLongPointer[interval.pointer];
myPkt: MesaRPCLupine.RPCPkt = MesaRPCLupine.GetRPCPkt[interval.pointer];
recvdHeader: LONG POINTER TO Header = @myPkt.header;
myStateBlock: CalleeState ← [NIL, myPSB, recvdHeader];
newPkt: BOOLEAN ← FALSE; -- Whether packet is valid --
decrypted: BOOLEAN ← FALSE; -- if "newPkt", whether it's been decrypted --
newLength: MesaRPCLupine.DataLength; -- iff "newPkt" and "decrypted", pkt's length --
connection: Connection;
Cleanup: PROC =
BEGIN
VM.Unmap[Space.PageFromLongPointer[interval.pointer]];
Space.Deallocate[interval];
END;
LookupCaller: ENTRY PROC [id: RPCPkt.ConnectionID]
RETURNS [{new, old, phoney, unknown}] = INLINE
-- Implicitly, recvdHeader is a parameter of LookupCaller.
-- If pkt starts call and ConnectionID is unknown, returns "unknown";
-- If pkt starts call and isn't duplicate, adds us as callee, returns "new";
-- If pkt is part of some previously initiated call, returns "old";
-- If pkt is part of some call with unknown ConnectionID, returns "phoney"
-- If decrypted pkt is inconsistent, returns "phoney".
-- Otherwise, returns "old".
-- On entry, packet has previously been decrypted iff "decrypted".
-- On exit if result is "new", pkt is decrypted
-- On exit if "decrypted", then myPkt.convHandle is set.
-- Note that if result is "old", pkt may or may not be decrypted.
BEGIN
dataPtr: LONG POINTER TO Connection;
connection ←
(dataPtr ← @connections[
Inline.BITAND[Inline.BITXOR[id.caller, id.activity], LAST[HashKey]]])↑;
DO
SELECT TRUE FROM
connection = NIL =>
BEGIN
IF recvdHeader.type.class # call THEN RETURN[old];
RETURN[unknown];
END;
id.conv = connection.id.conv AND id.caller = connection.id.caller
AND recvdHeader.srcePSB = connection.id.activity =>
BEGIN
myPkt.convHandle ← connection.conv;
IF NOT decrypted THEN
BEGIN
IF connection.conv # MesaRPC.unencrypted THEN
BEGIN
ok: BOOLEAN;
[ok, newLength] ← RPCInternal.DecryptPkt[
recvdHeader, myPkt.convHandle];
decrypted ← TRUE;
IF NOT ok THEN RETURN[phoney];
END
ELSE
BEGIN
newLength ← recvdHeader.length - RPCPkt.pktLengthOverhead;
decrypted ← TRUE;
END;
END;
IF recvdHeader.pktID.activity # recvdHeader.srcePSB THEN
RETURN[phoney];
IF recvdHeader.type.class # call THEN RETURN[old];
IF recvdHeader.pktID.callSeq > connection.call THEN
BEGIN
IF recvdHeader.pktID.pktSeq # 1 THEN RETURN[phoney];
connection.call ← recvdHeader.pktID.callSeq;
AddCallee[@myStateBlock];
RETURN[new]
END
ELSE RETURN[old]
END;
ENDCASE => connection ← (dataPtr ← @connection.next)↑;
ENDLOOP;
END;
NoteConnection: ENTRY PROC [
id: RPCPkt.ConnectionID, call: RPCPkt.CallCount,
conv: MesaRPC.Conversation] =
BEGIN
dataPtr: LONG POINTER TO Connection;
connection ←
(dataPtr ← @connections[
Inline.BITAND[Inline.BITXOR[id.caller, id.activity], LAST[HashKey]]])↑;
DO
SELECT TRUE FROM
connection = NIL =>
BEGIN
dataPtr↑ ← Heap.systemZone.NEW[
ConnectionData ← [next: NIL, id: id, call: call - 1, conv: conv]];
EXIT
END;
id.conv = connection.id.conv AND id.caller = connection.id.caller
AND id.activity = connection.id.activity =>
-- already there! -- EXIT;
ENDCASE => connection ← (dataPtr ← @connection.next)↑;
ENDLOOP;
END;
VM.Map[
interval: [page, pages], transferProc: NIL,
backingStoreRuns: VM.nullBackingStoreRuns, swappability: resident,
class: data, usage: FIRST[SpaceUsage.CommunicationUsage]];
-- newPkt = TRUE at top of loop iff we have the first pkt of next call already.
-- At top of loop, myPkt is decrypted if newPkt = TRUE. --
DO
ENABLE { ABORTED => EXIT; UNWIND => Cleanup[]};
IF NOT newPkt THEN {
RPCPkt.IdleReceive[myPkt, MesaRPCLupine.maxPupWords];
newPkt ← TRUE;
decrypted ← FALSE};
SELECT LookupCaller[
id: [recvdHeader.conv, recvdHeader.srceHost, recvdHeader.srcePSB]] FROM
new => -- start of new call --
BEGIN
target: RPCPkt.DispatcherDetails = recvdHeader.dispatcher;
resultLength: MesaRPCLupine.DataLength;
RPCPkt.SetupResponse[recvdHeader];
IF target.dispatcherHint >= RPCInternal.exportTable.used
OR target.dispatcherID = RPCPkt.noDispatcher
OR target.dispatcherID # RPCInternal.exportTable[
target.dispatcherHint].id THEN {
Reject[myPkt, unbound]; resultLength ← 0}
ELSE
resultLength ← RPCInternal.exportTable[
target.dispatcherHint].dispatcher[
myPkt, newLength, recvdHeader.type.eom = end, connection.conv !
MesaRPC.CallFailed => {
newPkt ← FALSE; RemoveCallee[@myStateBlock]; LOOP};
UnwindRequested =>
-- The dispatcher raised a remote signal which the remote machine
-- is unwinding
{resultLength ← 0; CONTINUE};
RejectUnbound =>
-- The dispatcher wants caller to get CallFailed[unbound] --
{Reject[myPkt, unbound]; resultLength ← 0; CONTINUE};
RejectProtocol =>
-- The dispatcher wants caller to get CallFailed[badProtocol] --
{Reject[myPkt, protocol]; resultLength ← 0; CONTINUE};
UNWIND => RemoveCallee[@myStateBlock]];
RemoveCallee[@myStateBlock];
[newPkt, newLength] ← RPCPkt.PktExchange[
myPkt, resultLength, serverDataLength, endCall !
MesaRPC.CallFailed => {newPkt ← FALSE; CONTINUE}];
IF newPkt THEN decrypted ← TRUE;
-- now newPkt=FALSE or myPkt is decrypted and contains start of new call --
END;
unknown => -- need to ask other end for connection state --
BEGIN
ok: BOOLEAN;
id: RPCPkt.ConnectionID;
call: RPCPkt.CallCount;
conv: MesaRPC.Conversation;
l: MesaRPCLupine.DataLength;
[ok, id, call, conv, l] ← RPCInternal.GetConnectionState[
decrypted, myPkt ! MesaRPC.CallFailed => {newPkt ← FALSE; LOOP}];
IF ok THEN
BEGIN
IF NOT newPkt THEN ERROR;
IF NOT decrypted THEN {decrypted ← TRUE; newLength ← l};
NoteConnection[id, call, conv];
END
ELSE newPkt ← FALSE;
END;
phoney => -- ignorable packet --
newPkt ← FALSE;
old =>
BEGIN
-- Pkt may or may not have been decrypted.
-- If the packet came to us because it had an incorrect destPSB, we should try
-- correcting it and giving it to the correct process. This ensures that destPSB
-- is only a hint. Also, because of the restrictions on generating ack's (described
-- below), there are cases where an ack is required but only the correct worker
-- process is allowed to generate it.
oldDest: PSB.PsbIndex = recvdHeader.destPSB;
knownCallee: BOOL = decrypted AND FindCallee[recvdHeader]
--may alter destPSB-- ;
IF knownCallee AND recvdHeader.destPSB # oldDest THEN -- destPSB his was wrong: requeue pkt for correct process --
-- Note that if correct process doesn't want the packet right now, it
-- may come back to an idler process, but it will have correct destPSB --
BEGIN
IF decrypted THEN
recvdHeader.length ←
IF myPkt.convHandle = MesaRPC.unencrypted THEN
RPCPkt.pktLengthOverhead + newLength
ELSE RPCInternal.EncryptPkt[myPkt, newLength];
EnqueueForNewPSB[myPkt];
END
ELSE
BEGIN
-- We're here because the packet doesn't start a new call. We should respond if
-- the packet is a retransmission or a ping.
-- We generate an ack only if the packet has eom-end. Therefore,
-- the last packet in any direction may only be sent when the worker
-- process has generated the ack for the preceding packet in that
-- direction. Therefore, the last packet in any direction comes to
-- an idler process only after the worker process has received a
-- previous transmission of that packet (because of the way "wanting"
-- is set in PktExchange). We assume that class=data isn't used for
-- pings. If we're still working on the call, we
-- generate an ack containing the worker process's PSBIndex. Beware
-- when caller and callee are on the same host!
IF recvdHeader.type.ack = pleaseAck AND recvdHeader.type.eom = end
AND (recvdHeader.type.class = data OR knownCallee) THEN
BEGIN
recvdHeader.length ←
IF NOT decrypted OR myPkt.convHandle = MesaRPC.unencrypted THEN
RPCPkt.pktLengthOverhead ELSE RPCInternal.EncryptPkt[myPkt, 0];
GenerateIdlerResponse[myPkt];
END;
END;
newPkt ← FALSE;
END;
ENDCASE => ERROR;
ENDLOOP;
Cleanup[];
END;
-- ******** Remote signalling ******** --
StartSignal: PUBLIC PROC [signalPkt: MesaRPCLupine.RPCPkt] = {
ConcreteHeader[@signalPkt.header].outcome ← signal};
UnwindRequested: ERROR = CODE; -- internal: remote machine is unwinding a signal --
DoSignal: PUBLIC PROC [
b: Buffer.PupBuffer, pktLength: MesaRPCLupine.DataLength,
signalHandler: MesaRPCLupine.Dispatcher, convHandle: MesaRPC.Conversation]
RETURNS [
resumePkt: MesaRPCLupine.RPCPkt, resumeLength: MesaRPCLupine.DataLength,
myLocalFrame: POINTER] =
BEGIN
myPktSpace: ARRAY [1..serverDataLength + MesaRPCLupine.pktOverhead] OF WORD;
pkt: MesaRPCLupine.RPCPkt = MesaRPCLupine.GetRPCPkt[@myPktSpace];
recvdHeader: LONG POINTER TO Header = @pkt.header;
myPSB: PSB.PsbIndex = ProcessOperations.HandleToIndex[
ProcessOperations.ReadPSB[]];
-- We must register as a callee, in case other end pings during signal.
-- See comments in ServerMain.
myStateBlock: CalleeState ← [NIL, myPSB, recvdHeader];
BEGIN
-- copy from the Pup buffer into our frame --
IF pktLength > serverDataLength THEN
ERROR MesaRPC.CallFailed[runtimeProtocol ! UNWIND => GiveBackBuffer[b]];
Inline.LongCOPY[
from: @b.pup.pupLength, to: recvdHeader, nwords: pktLength + SIZE[Header]];
GiveBackBuffer[b];
END;
pkt.convHandle ← convHandle;
EntryAddCallee[@myStateBlock];
BEGIN
ENABLE UNWIND => RemoveCallee[@myStateBlock];
handlerFailed: BOOLEAN ← FALSE; -- CallFailed raised inside signalHandler! --
RPCPkt.SetupResponse[recvdHeader];
IF signalHandler = NIL THEN {Reject[pkt, unbound]; resumeLength ← 0}
ELSE
resumeLength ← signalHandler[
pkt, pktLength, recvdHeader.type.eom = end, convHandle !
MesaRPC.CallFailed => handlerFailed ← TRUE;
UNWIND =>
IF NOT handlerFailed THEN
BEGIN
recvdHeader.outcome ← unwind;
resumeLength ← RPCPkt.PktExchange[
pkt, 0, serverDataLength, call, signalHandler].newLength;
SELECT recvdHeader.outcome FROM
result => NULL -- let our UNWIND propagate -- ;
signal => ERROR -- handled inside RPCPkt.PktExchange-- ;
ENDCASE => --unbound,protocol,unwind,garbage--
ERROR MesaRPC.CallFailed[runtimeProtocol];
RPCPkt.SetupResponse[recvdHeader];
END
-- ELSE the UNWIND was in response to us raising CallFailed, so
-- there's no point in talking to the other machine -- ;
UnwindRequested => -- The signalHandler raised a remote signal which
-- the remote machine is unwinding!
{resumeLength ← 0; CONTINUE};
RejectUnbound => {Reject[pkt, unbound]; resumeLength ← 0; CONTINUE};
RejectProtocol => {Reject[pkt, protocol]; resumeLength ← 0; CONTINUE}; ];
END;
RemoveCallee[@myStateBlock];
-- Magic to return to my caller without freeing my local frame --
(LOOPHOLE[LONG[Frame.GetReturnFrame[]], PROC [
MesaRPCLupine.RPCPkt, MesaRPCLupine.DataLength, POINTER]])[
pkt, resumeLength, LOOPHOLE[Frame.MyLocalFrame[]]];
END;
-- ******** Remote call failure ******** --
RejectUnbound: PUBLIC ERROR = CODE;
RejectProtocol: PUBLIC ERROR = CODE;
Reject: PROC [pkt: MesaRPCLupine.RPCPkt, rejection: RPCPkt.Outcome] =
BEGIN
header: LONG POINTER TO Header = @pkt.header;
UNTIL header.type.eom = end DO
[, ] ← ReceiveExtraPkt[
pkt ! MesaRPC.CallFailed => {rejection ← protocol; EXIT}];
ENDLOOP;
header.outcome ← rejection;
END;
-- ******** Initialization ******** --
Initialize: ENTRY PROC =
BEGIN
myAddr: PupTypes.PupAddress = PupDefs.GetLocalPupAddress[
RPCPrivate.rpcSocket, NIL];
myHost ← [net: myAddr.net, host: myAddr.host];
END;
Initialize[];
END.