// SwatFailSysB.bcpl -- exception handlers of all sorts
//		companion file is SwatFailSysA.asm
// Copyright Xerox Corporation 1979, 1982
// Last modified March 29, 1982  1:36 AM by Boggs

// FailSys is a package for handling errors in an orderly way,
//  like LISP's errorset.
// Typical use:
// SetFailPt(restore)
//    ...
// ... critical section ...
//    ...
// UnSetFailPt()
//    ...
// restore: ... restore invariant ...; FAIL()

get "Swat.decl"
get "AltoDefs.d"

external
[
// outgoing procedures
InitFailSys; InitInternalTraps
TrapHandler; SysErr
SetFailPt; UnSetFailPt
Fail; ReportFail; ReportBug
CheckInterruptSystem; Enable; Disable

// incoming procedures from swat
ReadFromKeys; AllocatorWarning
ParityError; SwatTrap; SwatInterrupt
PrintError; PutTemplate; Ws; DisplayState
OsFinish; CallSwat; InLd; OutLd

// incoming procedures from OS
Allocate; CreateDiskStream; Usc
CallersFrame; GotoLabel; ReturnTo
EnableInterrupts; DisableInterrupts; StartIO

// outgoing statics
failAC2

//incoming statics
sysZone; lvUserFinishProc; lvSysErr; lvAbortFlag; dsp; debugFlag
]

manifest
[
swatTrapNo = 37b
lenFailPtStack = 16
swatInterruptLevel = 8	//must agree with SysInternals.d
]

static
[
failPtStack	// stack of fail points
currFailPt	// current fail point
failAC2		// stack to use when failing

argVec		// see SysErr
TeleInLd; TeleOutLd
shouldBeActive	// what should be in activeInterrupts
]

//----------------------------------------------------------------------------
let InitFailSys() be
//----------------------------------------------------------------------------
[
//TeleSwat.asm redefines InLd and OutLd.  The old definitions for disk world
//  swapping are pointed at by OS top statics.  We need these, of course!
let topStatics = @176777b
TeleOutLd = OutLd; OutLd = topStatics!35b
TeleInLd = InLd; InLd = topStatics!36b

// Init fail point mechanism
failPtStack = Allocate(sysZone, lenFailPtStack)
currFailPt = -2
]

//----------------------------------------------------------------------------
and SetFailPt(label) be
//----------------------------------------------------------------------------
[
currFailPt = currFailPt +2
if currFailPt ge lenFailPtStack then
   [
   Ws("FailPtStack overflow -- Inform Swat service man.*n")
   return
   ]
failAC2 = CallersFrame()
failPtStack!currFailPt = failAC2
failPtStack!(currFailPt+1) = label
]

//----------------------------------------------------------------------------
and UnSetFailPt() be
//----------------------------------------------------------------------------
[
if currFailPt ls 0 then 
   [
   Ws("FailPtStack underflow -- Inform Swat service man.*n")
   currFailPt = 2
   ]
currFailPt = currFailPt -2
failAC2 = failPtStack!currFailPt
]

//----------------------------------------------------------------------------
and Fail() be
//----------------------------------------------------------------------------
[
// May come here with interrupts off. So turn them back on.
StartIO(3)  //smash off the ethernet
Enable()
if currFailPt ls 0 then
   [
   Ws("Fail called but FailPtStack empty -- Inform Swat service man*n")
   return
   ]
ReadFromKeys()
UnSetFailPt()
GotoLabel(failPtStack!(currFailPt+2), failPtStack!(currFailPt+3))
]

//----------------------------------------------------------------------------
and ReportFail(str) be [ PutTemplate(dsp, "$S*N", str); Fail() ]
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and ReportBug(str) be
//----------------------------------------------------------------------------
   [ PutTemplate(dsp, "$S -- Inform Swat service man*n", str); Fail() ]

//----------------------------------------------------------------------------
and InitInternalTraps() be
//----------------------------------------------------------------------------
// This code ambushes all the ways Swat could escape to itself or the O.S.
// It must be called before entering SwatMain, but after installing Swat.
[
@lvAbortFlag = @lvAbortFlag +1
@lvSysErr = SysErr
OsFinish = FinishTrap
shouldBeActive = @activeInterrupts
test debugFlag
   ifso
      [
      let topStatics = @176777b
      topStatics!35b = TeleOutLd
      topStatics!36b = TeleInLd
      ]
   ifnot
      [
      interruptVector!swatInterruptLevel = SwatInterrupt  //keyboard
      // When you say to the Exec "Resume Swat", it reaches into swat, picks
      // up what would be in trapVector!swatTrapNo, and assumes that that
      // points to the swat communication table, where it proceeds to refresh
      // the FPs for Swat and swatee.  Swat wants to catch traps and make
      // them go to 'SwatTrap' in SwatFailSysA, but it must not disturb the
      // trap vector pointer.  So smash the first two words of the scm
      // (which aren't vital when Swat is in memory) with code to go off
      // to SwatTrap.
      let scm = trapVector!swatTrapNo
      scm!0 = 2401B  //jmp @.+1
      scm!1 = SwatTrap
      ]
]

//----------------------------------------------------------------------------
and FinishTrap() be ReportBug("Unexpected finish")
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and TrapHandler() be
//----------------------------------------------------------------------------
// catch swat traps (jumps to low core, parity errors, etc.)
[
let tloc = @trapPC-1
test tloc!0 eq 77401B
   ifso // A parity error occured
      [
      @displayListHead = tloc!6
      let f(x) = @x
      ParityError(tloc, f)
      for i = 1 to 400 do for j = 1 to 400 loop // let him read it
      @activeInterrupts = shouldBeActive
      Enable()
      ]
   ifnot
      [
      PutTemplate(dsp, "Internal Trap at location $UO*N", tloc)
      DisplayState()
      ]
Fail()
]

//----------------------------------------------------------------------------
and SysErr(arg1, errNo, arg2, arg3, arg4, arg5; numargs na) be
//----------------------------------------------------------------------------
[
test errNo eq 1205  //not enough space for disk stream
   ifso  //Bleahhhh
      [
      AllocatorWarning()
      ReturnTo(CreateDiskStream+5)  //skip store of numargs
      ]
   ifnot
      [
      let t = arg1; arg1 = errNo; errNo = t
      argVec = lv arg1
      PrintError(dsp, "Sys.errors", SysErrFetch)
      ReportBug("Internal Swat Trap")
      ]
]

//----------------------------------------------------------------------------
and SysErrFetch(arg) = Usc(arg, 10) ls 0? argVec!arg, @arg
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and CheckInterruptSystem(resetit) be
//----------------------------------------------------------------------------
[
if @activeInterrupts eq shouldBeActive return
Ws("Swat's interrupt is system screwed up!*N")
if resetit then
   [
   Disable()
   @activeInterrupts = shouldBeActive
   Enable()
   ]
]

//----------------------------------------------------------------------------
and Enable() be
//----------------------------------------------------------------------------
[
let temp = @activeInterrupts
@activeInterrupts = 0
EnableInterrupts()
@wakeupsWaiting = 0
@activeInterrupts = temp
]

//----------------------------------------------------------------------------
and Disable() be DisableInterrupts()
//----------------------------------------------------------------------------