// PupRTPOpenClose.bcpl -- Rendezvous/Termination Protocol
// companion module is PupRTP.bcpl
// This module contains infrequently executed code which can swap
// without affecting performance.
// Copyright Xerox Corporation 1979, 1981
// last modified October 29, 1981 5:20 PM by Taft
get "Pup0.decl"
get "Pup1.decl"
get "PupRTPInternal.decl"
external
[
// outgoing procedures
OpenRTPSocket; CloseRTPSocket; CompleteRTPPup
RTPHandleUncommonPup; RTPFSM; BuildAbort
// incoming procedures
RTPSocketProcess; DefaultOtherPupProc; RTPFilter
CompletePup; AppendStringToPup; MultEq
SetPupDPort; SetPupID
InitializeContext; Block
Enqueue; Unqueue; InsertAfter
ReleasePBI; GetPBI
Zero; Allocate; Free; MoveBlock
DefaultArgs; Noop; SysErr
SetTimer; TimerHasExpired
// outgoing statics
lRTPSoc
// incoming statics
rtpStackSize; pupLevel1Ctx
pupZone; pupCtxQ; defaultTimeout
]
static [ lRTPSoc = lenRTPSoc ]
//----------------------------------------------------------------------------
let OpenRTPSocket(soc, ctxQ, openMode, connID, otherProc, timeout,
zone; numargs na) = valof
//----------------------------------------------------------------------------
[
let defaultID = vec 1; SetTimer(defaultID, 0); defaultID!1 = soc
DefaultArgs(lv na, -1, pupCtxQ, modeInitAndWait, defaultID,
DefaultOtherPupProc, defaultTimeout, pupZone)
let ctx = Allocate(zone, rtpStackSize)
InitializeContext(ctx, rtpStackSize, RTPSocketProcess, lenRTPCtxExtra)
ctx>>RTPCtx.socket = soc // link from context to socket
ctx>>RTPCtx.zone = zone // zone from which context allocated
ctx>>RTPCtx.ctxQ = ctxQ // queue on which context placed
test ctxQ eq pupCtxQ // same queue as PupLevel1's?
ifso InsertAfter(ctxQ, pupLevel1Ctx, ctx) // best position
ifnot Enqueue(ctxQ, ctx)
soc>>RTPSoc.ctx = ctx // link from socket to context
soc>>RTPSoc.connID↑1 = connID!0
soc>>RTPSoc.connID↑2 = connID!1
soc>>RTPSoc.rtpStatus = 0
soc>>RTPSoc.rtpOtherPupProc = otherProc
soc>>RTPSoc.rtpOtherTimerProc = Noop
let initState = nil
switchon openMode into
[
case modeInitAndWait: case modeInitAndReturn:
[
initState = RFCO
RTPFSM(soc, OPNC)
if openMode eq modeInitAndReturn then resultis true
endcase
]
case modeListenAndWait: case modeListenAndReturn:
[
initState = LIST; soc>>RTPSoc.wasListening = true
RTPFSM(soc, OPNL)
if openMode eq modeListenAndReturn then resultis true
endcase
]
case modeImmediateOpen:
[
RTPFSM(soc, OPNN)
resultis true
]
]
let openTimer, state = nil, nil; SetTimer(lv openTimer, timeout)
[
Block()
state = soc>>RTPSoc.state
] repeatuntil state ne initState % TimerHasExpired(lv openTimer)
if state eq OPEN % state eq ENDI then resultis true
CloseRTPSocket(soc, 0); resultis false
]
//----------------------------------------------------------------------------
and CloseRTPSocket(soc, timeout; numargs na) = valof
//----------------------------------------------------------------------------
// locally initiated close
[
if na ls 2 then timeout = defaultTimeout
if timeout ne 0 then RTPFSM(soc, CLSN)
let timer, state = nil, nil; SetTimer(lv timer, timeout)
[
state = soc>>RTPSoc.state
test state eq ABOR % TimerHasExpired(lv timer)
ifso [ RTPFSM(soc, CLST); timeout = 0 ]
ifnot Block()
] repeatuntil state eq CLOS
let ctx = soc>>RTPSoc.ctx
while ctx>>RTPCtx.unclean do Block()
Unqueue(ctx>>RTPCtx.ctxQ, ctx)
Free(ctx>>RTPCtx.zone, ctx)
resultis timeout ne 0
]
//----------------------------------------------------------------------------
and RTPHandleUncommonPup(soc, pbi) = valof
//----------------------------------------------------------------------------
// Called for all Pup known to RTP, namely RFC, End, EndReply, Abort, Error.
// Either releases the supplied PBI and returns true, or leaves it to be
// passed to the higher-level handler and returns false.
[
let event = nil
switchon pbi>>PBI.pup.type into
[
case typeRFC:
if pbi>>PBI.pup.bytes↑1 eq 0 then // default conn port net
pbi>>PBI.pup.bytes↑1 = pbi>>PBI.pup.sPort.net
test selecton soc>>RTPSoc.state into
[
case LIST: RTPFilter(pbi, false, false)
case RFCO: RTPFilter(pbi, true, true)
case OPEN:
case ENDO: RTPFilter(pbi, false, true) &
MultEq(lv pbi>>PBI.pup.words, lv soc>>RTPSoc.frnPort, 3)
default: false
]
ifso RTPFSM(soc, RRFC, pbi)
ifnot
[
let npbi = BuildAbort(soc, 0, "RFC refused")
SetPupID(npbi, lv pbi>>PBI.pup.id)
SetPupDPort(npbi, lv pbi>>PBI.pup.sPort)
CompletePup(npbi)
]
endcase
case typeEnd:
event = REND; docase -1
case typeEndReply:
event = RENR; docase -1
case typeAbort:
event = RABT; // docase -1
case -1: // End, EndReply, Abort common handling
if RTPFilter(pbi, true, true) then
[
RTPFSM(soc, event, pbi)
unless event eq RENR do
resultis false // Ends and Aborts passed on
]
endcase
case typeError:
if pbi>>PBI.pup.words↑11 eq 2 & RTPFilter(pbi, true, false) then
RTPFSM(soc, RABT, pbi) // treat type 2 same as Abort
resultis false // Errors passed on
]
// if we get here, dispose of the PBI locally
ReleasePBI(pbi)
resultis true // I did it
]
//----------------------------------------------------------------------------
and RTPFSM(soc, event, pbi) be
//----------------------------------------------------------------------------
// procedure to run the RTP finite state machine
[RTPFSM
structure Entry: [ action byte; nextState byte ]
structure FSM↑CLOS,ABOR↑OPNC,TIMO: @Entry
let fsm = table // state x event => action+nextstate
[
// current state:
// CLOS RFCO LIST OPEN ENDI ENDO DALY ABOR //event
SRF1+RFCO; LERR+RFCO; LERR+LIST; LERR+OPEN; LERR+ENDI; LERR+ENDO; LERR+DALY; LERR+ABOR //OPNC
NOOP+LIST; LERR+RFCO; LERR+LIST; LERR+OPEN; LERR+ENDI; LERR+ENDO; LERR+DALY; LERR+ABOR //OPNL
NOOP+OPEN; LERR+RFCO; LERR+LIST; LERR+OPEN; LERR+ENDI; LERR+ENDO; LERR+DALY; LERR+ABOR //OPNN
NOOP+CLOS; SABT+CLOS; NOOP+CLOS; SEND+ENDO; SENR+DALY; NOOP+ENDO; NOOP+DALY; NOOP+CLOS //CLSN
NOOP+CLOS; SABT+CLOS; NOOP+CLOS; SABT+CLOS; SABT+CLOS; SABT+CLOS; NOOP+CLOS; NOOP+CLOS //CLST
FERR+CLOS; OPNX+OPEN; SRF2+OPEN; SRF2+OPEN; FERR+ENDI; SRF2+ENDO; FERR+DALY; FERR+ABOR //RRFC
FERR+CLOS; NOOP+ABOR; FERR+LIST; NOOP+ABOR; NOOP+ABOR; NOOP+ABOR; NOOP+ABOR; NOOP+ABOR //RABT
FERR+CLOS; FERR+RFCO; FERR+LIST; NOOP+ENDI; NOOP+ENDI; SENR+DALY; SENR+DALY; FERR+ABOR //REND
FERR+CLOS; FERR+RFCO; FERR+LIST; FERR+OPEN; FERR+ENDI; SENR+CLOS; NOOP+CLOS; FERR+ABOR //RENR
NOOP+CLOS; SRF1+RFCO; NOOP+LIST; NOOP+OPEN; NOOP+ENDI; SEND+ENDO; NOOP+CLOS; NOOP+ABOR //TIMO
]
let timeout = table // timeout for state being entered
[
32000; 100; 32000; 32000; 32000; 100; 1000; 32000
]
let entry = fsm>>FSM↑event↑(soc>>RTPSoc.state)
RTPAction(entry<<Entry.action, soc, pbi)
soc>>RTPSoc.state = entry<<Entry.nextState
SetTimer(lv soc>>RTPSoc.rtpTimer, timeout!(soc>>RTPSoc.state))
]RTPFSM
//----------------------------------------------------------------------------
and RTPAction(action, soc, pbi) be
//----------------------------------------------------------------------------
// Actions invoked by the fsm
[
switchon action into
[
case SRF1 rshift 8: // send initiating rfc
pbi = GetPBI(soc)
MoveBlock(lv pbi>>PBI.pup.words, lv soc>>RTPSoc.lclPort, lenPort)
CompleteRTPPup(pbi, typeRFC, pupOvBytes+2*lenPort)
endcase
case SRF2 rshift 8: // send answering rfc
if soc>>RTPSoc.wasListening then
[
if soc>>RTPSoc.state eq LIST then
[
MoveBlock(lv soc>>RTPSoc.connID, lv pbi>>PBI.pup.id, 2)
MoveBlock(lv soc>>RTPSoc.frnPort, lv pbi>>PBI.pup.words, lenPort)
MoveBlock(lv soc>>RTPSoc.lclPort, lv pbi>>PBI.pup.dPort, lenPort)
]
let npbi = GetPBI(soc)
SetPupDPort(npbi, lv pbi>>PBI.pup.sPort)
MoveBlock(lv npbi>>PBI.pup.words, lv soc>>RTPSoc.lclPort, lenPort)
CompleteRTPPup(npbi, typeRFC, pupOvBytes+2*lenPort)
]
endcase
case OPNX rshift 8: // got answer back to our rfc
MoveBlock(lv soc>>RTPSoc.frnPort, lv pbi>>PBI.pup.words, lenPort)
endcase
case SABT rshift 8: // send abort
pbi = BuildAbort(soc, 0, (soc>>RTPSoc.state eq RFCO?
"Connection attempt aborted", "Connection aborted"))
SetPupID(pbi, lv soc>>RTPSoc.connID)
CompletePup(pbi)
endcase
case SEND rshift 8: // send end
case SENR rshift 8: // send end reply
pbi = GetPBI(soc)
// do this in-line to conserve stack space
SetPupID(pbi, lv pbi>>PBI.socket>>RTPSoc.connID)
CompletePup(pbi, (action eq SEND rshift 8? typeEnd, typeEndReply),
pupOvBytes)
endcase
case LERR rshift 8: // local error (my bug)
SysErr(soc, ecImproperStateForEvent)
case FERR rshift 8: // foreign error (his bug)
]
]
//----------------------------------------------------------------------------
and BuildAbort(soc, code, string) = valof
//----------------------------------------------------------------------------
[
let pbi = GetPBI(soc)
pbi>>PBI.pup.type = typeAbort
pbi>>PBI.pup.words↑1 = code
AppendStringToPup(pbi, 3, string)
resultis pbi
]
//----------------------------------------------------------------------------
and CompleteRTPPup(pbi, type, length) be
//----------------------------------------------------------------------------
[
SetPupID(pbi, lv pbi>>PBI.socket>>RTPSoc.connID)
CompletePup(pbi, type, length)
]