// PupBSPOpenClose.bcpl -- Byte Stream Protocol
// Companion files are PupBSPProt, PupBSPStreams and PupBSPa
// This module contains infrequently executed code which can swap
//  without affecting performance.
// Copyright Xerox Corporation 1979, 1980, 1981
// Last modified October 29, 1981  5:22 PM by Taft

get "Pup.decl"
get "PupRTPInternal.decl"

external
[
// outgoing procedures
CreateBSPStream; CloseBSPSocket; BSPPutInterrupt; BSPHandleUncommonPup

// incoming procedures
BSPPupProc; BSPTimerProc; BSPForceOutput; BSPPrepareIPBI; BSPGetCleanup
BSPGetByte; BSPPutByte; BSPEndofs; BSPErrors; BSPCloses; SearchTQ
CloseRTPSocket; RTPFilter; RTPFSM; CloseLevel1Socket; SetTimeout
ReleasePBI; GetPBI; CompletePup; SetPupID; AppendStringToPup; MultEq
Noop; Zero; SetBlock; MoveBlock; SysErr; DoubleIncrement; DoubleDifference
SetTimer; TimerHasExpired; Block; Dismiss; Min
FlushQueue

// outgoing statics
lBSPSoc; offsetBSPStr

// incoming statics
defaultTimeout
]

static
[
lBSPSoc = lenBSPSoc
offsetBSPStr = offset BSPSoc.bspStr/16
]

//----------------------------------------------------------------------------
let CreateBSPStream(soc) = valof
//----------------------------------------------------------------------------
[
// initialize BSP socket
unless soc>>BSPSoc.state eq stateOpen % soc>>BSPSoc.state eq stateEndIn do
   resultis 0
Zero(soc+lenRTPSoc, lenBSPSoc-lenRTPSoc)
for i = 0 to 5 do
   MoveBlock(soc + (table
      [
      offset BSPSoc.userByteID/16
      offset BSPSoc.rcvByteID/16
      offset BSPSoc.rcvIntID/16
      offset BSPSoc.xmitIntID/16
      offset BSPSoc.xmitByteID/16
      offset BSPSoc.lastAckID/16
      ])!i, lv soc>>BSPSoc.connID, 2)
SetTimer(lv soc>>BSPSoc.bspTimer, 0)
SetTimer(lv soc>>BSPSoc.inactivityTimer, inactivityTimeout)
soc>>BSPSoc.bspOtherPupProc = soc>>BSPSoc.bspPupProc
soc>>BSPSoc.bspPupProc = BSPPupProc
soc>>BSPSoc.bspTimerProc = BSPTimerProc
soc>>BSPSoc.aDataTimeout = initialADataTimeout
soc>>BSPSoc.maxPupAlloc = Min(soc>>BSPSoc.maxOPBI, initialMaxPupAlloc)

// initialize BSP stream
let str = soc+offsetBSPStr
SetBlock(str, SysErr, lST)
str>>BSPStr.gets = BSPGetByte
str>>BSPStr.puts = BSPPutByte
str>>BSPStr.close = BSPCloses
str>>BSPStr.endof = BSPEndofs
str>>BSPStr.error = BSPErrors

resultis str
]

//----------------------------------------------------------------------------
and CloseBSPSocket(soc, timeout; numargs na) = valof
//----------------------------------------------------------------------------
[
if na le 1 then timeout = defaultTimeout
if soc>>BSPSoc.state eq stateOpen % soc>>BSPSoc.state eq stateEndIn then
   [  // wait til all queued output has been acknowledged
   BSPForceOutput(soc)
   let timer = nil; SetTimer(lv timer, timeout)
   while soc>>BSPSoc.unAckedPups ne 0 % soc>>BSPSoc.interruptOut do
      [
      BSPFlushInput(soc)  // flush waiting input
      switchon soc>>BSPSoc.state into
         [
         case stateOpen: case stateEndIn:
            unless TimerHasExpired(lv timer) endcase
         default:
            timeout = 0; break  // timed out or aborted
         ]
      Dismiss(1)
      ]
   ]

// close the socket, flushing BSP input while waiting
soc>>BSPSoc.bspTimerProc = BSPInputSuckerUpper
BSPInputSuckerUpper(soc)
timeout = CloseRTPSocket(soc, timeout)

// wait til all owned pbi's have returned before destroying socket
soc>>BSPSoc.bspPupProc = ReleasePBI  // turn off input
soc>>BSPSoc.bspTimerProc = Noop
if soc>>BSPSoc.oPBI ne 0 then ReleasePBI(soc>>BSPSoc.oPBI)
while soc>>BSPSoc.numOPBI ne soc>>BSPSoc.maxOPBI do
   [ FlushQueue(lv soc>>BSPSoc.bspTQ); Dismiss(1) ]
FlushQueue(lv soc>>BSPSoc.bspIQ)
CloseLevel1Socket(soc)
resultis timeout ne 0
]

//---------------------------------------------------------------------------
and BSPFlushInput(soc) be
//---------------------------------------------------------------------------
// called via BSPTimerProc entry to flush input during RTP close
[
let ec = BSPPrepareIPBI(soc, 0)
unless ec eq 0 % ec eq ecMarkEncountered return
BSPGetCleanup(soc)
] repeat

//---------------------------------------------------------------------------
and BSPInputSuckerUpper(soc) be
//---------------------------------------------------------------------------
// called via BSPTimerProc entry to flush input during RTP close
[
BSPFlushInput(soc)
SetTimer(lv soc>>BSPSoc.bspTimer, 10)
]

//---------------------------------------------------------------------------
and BSPPutInterrupt(soc, code, string, timeout; numargs na) = valof
//---------------------------------------------------------------------------
[
if na ls 4 then timeout = -1
let timer = nil; SetTimer(lv timer, timeout)
   [
   switchon soc>>BSPSoc.state into
      [
      case stateOpen: case stateEndIn:
         unless timeout ge 0 & TimerHasExpired(lv timer) endcase
      default:
         resultis false  // bad state or timed out
      ]
   if soc>>BSPSoc.numTPBI ne 0 & soc>>BSPSoc.numOPBI ne 0 &
      not soc>>BSPSoc.interruptOut then break
   Block()
   ] repeat

let pbi = GetPBI(soc)
pbi>>PBI.pup.words↑1 = code
AppendStringToPup(pbi, 3, string)
SetPupID(pbi, lv soc>>BSPSoc.xmitIntID)
pbi>>PBI.queue = lv soc>>BSPSoc.bspTQ  // keep pbi around
CompletePup(pbi, typeInterrupt)
soc>>BSPSoc.interruptOut = true
SetTimeout(soc)
resultis true
]

//---------------------------------------------------------------------------
and BSPHandleUncommonPup(soc, pbi) be
//---------------------------------------------------------------------------
// Called from BSPPupProc for Interrupt, InterruptReply, and End.
// Always disposes of pbi.
[
let passedSourceFilter = RTPFilter(pbi, true, false)
switchon pbi>>PBI.pup.type into
   [
   case typeInterruptReply:
      if passedSourceFilter &
       MultEq(lv pbi>>PBI.pup.id, lv soc>>BSPSoc.xmitIntID) &
       soc>>BSPSoc.interruptOut then
         [
         let npbi = SearchTQ(soc, true)  // Find interrupt on TQ
         if npbi ne 0 then
            [
            DoubleIncrement(lv soc>>BSPSoc.xmitIntID, 1)
            soc>>BSPSoc.interruptOut = false
            ReleasePBI(npbi)
            ]
         // If we can't find it, we must be retransmitting it now,
         // so just pretend the reply was lost and rely on the
         // retransmission to elicit a new reply
         ]
      endcase

   case typeInterrupt:
      if passedSourceFilter then
         [
         let d = DoubleDifference(lv soc>>BSPSoc.rcvIntID,
          lv pbi>>PBI.pup.id)
         test d eq 0
            ifso
               [  // This is a new interrupt so update id
               DoubleIncrement(lv soc>>BSPSoc.rcvIntID, 1)
               soc>>BSPSoc.interruptIn = true
               (soc>>BSPSoc.bspOtherPupProc)(pbi)  //pass it on
               ]
            ifnot ReleasePBI(pbi)
         if d ule 1 then
            [  // Generate InterruptReply for cases 0 and 1
            pbi = GetPBI(soc, true)
            if pbi ne 0 then
               [
               SetPupID(pbi, lv soc>>BSPSoc.rcvIntID)
               DoubleIncrement(lv pbi>>PBI.pup.id, -1)
               CompletePup(pbi, typeInterruptReply, pupOvBytes)
               ]
            ]
         return  // pbi already released
         ]
      endcase

   case typeEnd:
      // Already filtered by RTP.
      // If stream is idle then close connection immediately; otherwise
      // await local close.
      if soc>>BSPSoc.oPBI eq 0 & soc>>BSPSoc.unAckedPups eq 0 &
       not soc>>BSPSoc.interruptOut & soc>>BSPSoc.unReadPups eq 0 then
         RTPFSM(soc, CLSN)
      endcase
      ]

// above code should return before here if pbi is already disposed of
ReleasePBI(pbi)
]