// GateControl.bcpl - Gateway Control Program
// Last modified July 2, 1983  10:28 PM by Boggs

get "SysDefs.d"
get "AltoDefs.d"
get "BcplFiles.d"

external
[
// outgoing procedures
AfterJunta; StatusCtx; TopLevel; SysErr

// incoming procedures
Junta; InitGateControl; AddToZone; ReturnFrom
CallContextList; Block; LeftCycle; MoveBlock; Zero
GateConVersion; GateConSummary; RouteSummary; TransitMatrix
EchoSummary; TimeSummary; NameSummary; BootSummary
Ws; Wss; Puts; Resets; GetString
ResetCmdMenu; CreateCmdBox; BoxProc; Free; Dequeue
Gateway; Route; Echo; Name; Boot; Time; Level0Stats
Eftp; Debugger; HaltGateway; RestartGateway
CreateRouteCtx; CreateEchoCtx; CreateGateConCtx
CreateBootCtx; CreateNameCtx; CreateTimeCtx
SetTimer; TimerHasExpired
LoadRam; InitBcplRuntime; BFSClose
EtherBoot; DisableInterrupts; StartIO

// outgoing statics
wheel; versionText

// incoming statics
lvUserFinishProc; lvIdle
sysZone; sysDisk; ctxQ; oldStatsQ
RamImage; gcNet; gcHost
]

static [ savedUFP; savedIdle; wheel; endCode; versionText ]

structure String [ length byte; char↑1,1 byte ]

//----------------------------------------------------------------------------
let GateControl(blv, upe, cfa) be
//----------------------------------------------------------------------------
[
versionText = "GateControl of 2 July 83"
let ramOk = LoadRam(RamImage) eq 0
if ramOk then InitBcplRuntime()
savedUFP = @lvUserFinishProc; @lvUserFinishProc = GCFinishProc
endCode = blv>>BLV.endCode
Junta((ramOk? levBasic, levBcpl), AfterJunta)
]

//----------------------------------------------------------------------------
and AfterJunta() be
//----------------------------------------------------------------------------
[
InitGateControl()
AddToZone(sysZone, InitGateControl, endCode-InitGateControl)
savedIdle = @lvIdle; @lvIdle = Block
//This stuff below should be in GateControlInit.
//The problem is that I run out of free storage during initialization,
// so this suff is deferred until after the initialization code has
// been reclaimed.  These procedures aren't very big and they aren't
// broken out into separate initialization modules.
CreateRouteCtx()
CreateEchoCtx()
CreateGateConCtx()
CreateBootCtx()
CreateNameCtx()
CreateTimeCtx()
TopLevel()
CallContextList(ctxQ!0) repeat
]

//----------------------------------------------------------------------------
and GCFinishProc() be
//----------------------------------------------------------------------------
[
@displayListHead = 0; for i = 0 to 32000 loop
@lvIdle = savedIdle
if sysDisk ne 0 then BFSClose(sysDisk)
manifest kbInterruptBit = 1 lshift 12
@activeInterrupts = @activeInterrupts & not kbInterruptBit
@displayInterrupt = @displayInterrupt & not kbInterruptBit
@lvUserFinishProc = savedUFP
]

//----------------------------------------------------------------------------
and SysErr(p1, ec, p2, p3, p4, p5) be
//----------------------------------------------------------------------------
[
let temp = p1; p1 = ec; ec = temp
(table [ 77403b; 1401b ])("Sys.errors", lv p1)
]

//----------------------------------------------------------------------------
and StatusCtx(ctx) be	// a context
//----------------------------------------------------------------------------
// ctx!3 is a box stream for the status window.
[
let lastNet, lastHost = -1, -1

   [ // repeat
   let sts = ctx!3
   let timer = nil; SetTimer(lv timer, 250)
      [
      while oldStatsQ!0 ne 0 do
         Free(sysZone, Dequeue(oldStatsQ))
      Block()
      ] repeatuntil TimerHasExpired(lv timer)
   
   Resets(sts, gcNet eq lastNet & gcHost eq lastHost)  // dontClear
   lastNet = gcNet; lastHost = gcHost
   GateConVersion(sts)
   Wss(sts, "*N*N")
   EchoSummary(sts)
   RouteSummary(sts)
   TimeSummary(sts)
   NameSummary(sts)
   BootSummary(sts)
   Puts(sts, $*N)
   GateConSummary(sts)
   Wss(sts, "*N*N")
   TransitMatrix(sts)
   
   ] repeat
]

//----------------------------------------------------------------------------
and TopLevel() be
//----------------------------------------------------------------------------
[
ResetCmdMenu()
CreateCmdBox(Quit, "Quit")
CreateCmdBox(Gateway, "Gateway")
CreateCmdBox(Route, "Route")
CreateCmdBox(Echo, "Echo")
CreateCmdBox(Name, "Name")
CreateCmdBox(Boot, "Boot")
CreateCmdBox(Time, "Time")
if gcHost ne 0 then CreateCmdBox(Level0Stats, "Level0Stats")
test wheel
   ifnot CreateCmdBox(Enable, "Enable")
   ifso
      [
      CreateCmdBox(Disable, "Disable")
      if gcHost ne 0 then
         [
         if sysDisk ne 0 then CreateCmdBox(Eftp, "EFTP")
         CreateCmdBox(Debugger, "Debugger")
         CreateCmdBox(HaltGateway, "Halt")
         CreateCmdBox(RestartGateway, "Restart")
         ]
      ]
// ResetCmdMenu destroyed the BoxQ which BoxProc is following.
// If we just return now, BoxProc will get horribly confused.
// So don't let it continue: force a return from BoxProc.
ReturnFrom(BoxProc)
]

//----------------------------------------------------------------------------
and Enable() be
//----------------------------------------------------------------------------
[
let psw = vec 128
if GetString("*NPassword: ", psw, false) then
   [
   Ws("(pst)")
   let encpw = 0
   for i = 1 to psw>>String.length do
      encpw = LeftCycle(encpw+(psw>>String.char↑i & #137) * 25035, 1)
   test encpw eq 24141b
      ifso
         [
         wheel = true
         TopLevel()
         ]
      ifnot Ws(" - incorrect password")
   ]
]

//----------------------------------------------------------------------------
and Disable() be
//----------------------------------------------------------------------------
[
wheel = false
TopLevel()
]

//----------------------------------------------------------------------------
and Quit() be
//----------------------------------------------------------------------------
[
ResetCmdMenu()
CreateCmdBox(TopLevel, "TopLevel")
CreateCmdBox(DMT, "DMT")
CreateCmdBox(NetExec, "NetExec")
if (@diskStatus & 40b) eq 0 then CreateCmdBox(DiskBoot, "DiskExec")
ReturnFrom(BoxProc)
]

//----------------------------------------------------------------------------
and DMT() be EtherBoot(0)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and NetExec() be EtherBoot(10b)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and DiskBoot() be
//----------------------------------------------------------------------------
[
structure KCB:
   [
   link word
   status word
   command word
   headerAddress word
   labelAddress word
   dataAddress word
   normalWakeups word
   errorWakeups word
   header word
   diskAddress word
   ]
manifest lenKCB = size KCB/16

DisableInterrupts()
StartIO(3)

let kcb, data, label = vec lenKCB, vec 256, vec 8
   [
   Zero(kcb, lenKCB)
   kcb>>KCB.command = 44100b  // check header, read label, read data
   kcb>>KCB.headerAddress = lv kcb>>KCB.header
   kcb>>KCB.labelAddress = label
   kcb>>KCB.dataAddress = data
   kcb>>KCB.diskAddress = kbdAd!0 xor -1
   until @diskCommand eq 0 loop
   @diskCommand = kcb
   while (kcb>>KCB.status & 7400b) eq 0 loop
   if (kcb>>KCB.status & 7667b) eq 7400b break
   ] repeat

MoveBlock(402b, label, 8)
MoveBlock(1, data, 256)
@2 = kcb>>KCB.status
goto 1
]