// IfsRSMgrRare.bcpl - Rendezvous Socket and Process Manager - Rare
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified September 17, 1982  10:44 AM by Taft

get "AltoDefs.d"
get "IfsRs.decl"
get "Pup0.decl"
get "Pup1.decl"
get "PupRTP.decl"

external
[
// outgoing procedures
AbortRSConnections; HandleKeys; RSSendAbort; AdjustPBIs; PerformIdleTasks

// incoming procedures
RecordMemoryError; ReturnRetainedFreePages; FlushBuffers
CloseRTPSocket; AppendStringToPup; ExchangePorts; CompletePup
Allocate; Free; Enqueue; Dequeue; Unqueue; Max; Dismiss

// incoming statics
jobT; lenJobT; numPBIs; haltFlag; entFlag
sysZone; numOverflowPBIs; maxOverflowPBIs; ovPBIQ; pbiFreeQ; lenPBI
]

//----------------------------------------------------------------------------
let HandleKeys() be
//----------------------------------------------------------------------------
// Called from ShiftSwatEvent if any key in word 177037b besides Lock is down
[
// Note that 177036b contains Ctrl and Left-shift and we require Ctrl to be
// up for a shift-swat abort.
if @177036b eq 177677b & (@177037b & 177577b) eq 177573b then
   [ AbortRSConnections(); finish ]

// Some other key in 177037b (e.g., space) is down.
// Flash screen to reassure observer that IFS is up.
(@displayListHead)>>DCB.background = 0  // white
Dismiss(1)
(@displayListHead)>>DCB.background = 1  // black
]

//----------------------------------------------------------------------------
and AbortRSConnections() be
//----------------------------------------------------------------------------
for i = 0 to lenJobT-1 do
   if jobT>>JobT↑i ne 0 & jobT>>JobT↑i>>RSCtx.connFlag then
      [
      jobT>>JobT↑i>>RSCtx.connFlag = false
      CloseRTPSocket(jobT>>JobT↑i>>RSCtx.bspSoc, 0)
      ]

//----------------------------------------------------------------------------
and RSSendAbort(pbi, string) be
//----------------------------------------------------------------------------
[
pbi>>PBI.pup.words↑1 = 0
AppendStringToPup(pbi, 3, string)
ExchangePorts(pbi)
CompletePup(pbi, typeAbort)
]

//----------------------------------------------------------------------------
and AdjustPBIs(committedPBIs) be
//----------------------------------------------------------------------------
// Attempts to increase or decrease the number of PBIs in the system
// to reflect committedPBIs.
[
// If now overcommitted, allocate new PBIs and add to pool
while committedPBIs gr numPBIs+numOverflowPBIs do
   [
   let ovPBI = Allocate(sysZone, lenPBI+1)
   Enqueue(ovPBIQ, ovPBI)
   Enqueue(pbiFreeQ, ovPBI+1)
   numOverflowPBIs = numOverflowPBIs +1
   maxOverflowPBIs = Max(maxOverflowPBIs, numOverflowPBIs)
   ]

// If now undercommitted, try to get rid of overflow PBIs
let ovPBI = ovPBIQ!0
while committedPBIs ls numPBIs+numOverflowPBIs & ovPBI ne 0 do
   [
   let nextOvPBI = ovPBI!0
   if Unqueue(pbiFreeQ, ovPBI+1) then
      [
      Unqueue(ovPBIQ, ovPBI)
      Free(sysZone, ovPBI)
      numOverflowPBIs = numOverflowPBIs-1
      ]
   ovPBI = nextOvPBI
   ]
]

//----------------------------------------------------------------------------
and PerformIdleTasks() be
//----------------------------------------------------------------------------
[
// Halt the system if haltFlag is true and no jobs currently exist.
// Unless halting, don't allow the system to go idle with entFlag = false.
if haltFlag then [ FlushBuffers(true); finish ]
entFlag = true

// Check for main memory errors recorded by hardware (Alto-II only).
// Depend on Alto-I returning zero when MESR is read.
if @MESR ne 0 & (not @MESR & 1374B) ne 0 then RecordMemoryError()

// Somebody occasionally clobbers location 0.  This makes debugging
// very difficult, so...
@0 = 77400B

// Give retained free pages back to VMem, just to get everything into a
// clean state.
ReturnRetainedFreePages()
]