// NetExec.bcpl -- A one-day hack that worked
//  this module knows nothing about networks
// Copyright Xerox Corporation 1979, 1980, 1982, 1983
// Last modified July 1, 1983  4:23 PM by Boggs

get "AltoDefs.d"
get "CmdScan.decl"

external
[
// incoming procedures
PrintName; PrintPort; LoadMicrocode; Where; LoadKT
GetTime; GetDir; GetName; NetBoot; MyEtherBoot

MyFrame; CallSwat; SysErr; MoveBlock; Zero
Enqueue; Dequeue; DoubleDifference; Junta
InitializeZone; Allocate; Free

InitializeContext; CallContextList; Block; Dismiss

CreateDisplayStream; ShowDisplayStream; EraseBits
GetBitPos; SetBitPos; CharWidth; GetLmarg; SetFont

SetTimer; TimerHasExpired
StartIO; FalsePredicate; ReadCalendar

UNPACKDT; WEEKDAY; MONTHNAME; WRITEUDT
Puts; Resets; Closes; Putbacks; Endofs
PutTemplate; Wss; ExtractSubstring

InitCmd; GetKeyword; GetNumber; GetString; Confirm; CmdErrorCode
BeginDefaultPhrase; EndDefaultPhrase; EnableCatch; EndCatch
CreateKeywordTable; TerminatingChar

InitPupLevel1

// incoming statics
sysZone; sysFont; dsp; keys

// outgoing statics
ftpCtxQ; cmdDsp; cmdKT; ebKT; kbdCS; buf
timeRequest; dirRequest
eng; OpenFile
]

static
[
ftpCtxQ; cmdDsp; cmdKT; ebKT; kbdCS; buf
timeRequest; dirRequest

watchDog; eng; OpenFile
cursorOn; cursorTimer
]

structure KTE:	//must match definition in NetExec1.bcpl
[
bfn word	//boot file number
local word	//true => local procedure; false => boot file
port word 3	//internet address of boot server
date word 2	//used as a version number
]
manifest
[
lenKTE = size KTE/16
maxKTEs = 200

bufLen = 256 + 16384 + 4096 + 100  // header + IM + IFUM + slop
stkLim = 335b
]

//-----------------------------------------------------------------------------------------
let NetExec() be Junta(nil, AfterJunta)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and AfterJunta() be
//-----------------------------------------------------------------------------------------
[
let d = vec (lDCB+3); dsp = (d+1)&-2
let dcb = dsp+2; dsp!0, dsp!1 = dcb, dcb
Zero(dcb, lDCB); dcb>>DCB.height = 42
ShowDisplayStream(dsp, DSalone)
eng = (table [ 61014b; 1401b ])()<<VERS.eng

buf = @stkLim; @stkLim = buf + bufLen
let base = @stkLim; @stkLim = MyFrame() - 200
sysZone = InitializeZone(base, @stkLim - base, SysErr, SysErr)

let v = vec 1; ftpCtxQ = v; ftpCtxQ!0 = 0
InitPupLevel1(sysZone, ftpCtxQ, 25)
Enqueue(ftpCtxQ, InitializeContext(Allocate(sysZone, 500), 500, Title))
Enqueue(ftpCtxQ, InitializeContext(Allocate(sysZone, 500), 500, Command))
Enqueue(ftpCtxQ, InitializeContext(Allocate(sysZone, 300), 300, GetTime))
Enqueue(ftpCtxQ, InitializeContext(Allocate(sysZone, 300), 300, GetDir))
Enqueue(ftpCtxQ, InitializeContext(Allocate(sysZone, 300), 300, GetName))
Enqueue(ftpCtxQ, InitializeContext(Allocate(sysZone, 100), 100, WatchDog))

cmdKT = CreateKeywordTable(maxKTEs, lenKTE)
ebKT = CreateKeywordTable(maxKTEs, lenKTE)

CallContextList(ftpCtxQ!0) repeat
]

//-----------------------------------------------------------------------------------------
and Title() be
//-----------------------------------------------------------------------------------------
[
Block()
let lineWords = lDCB+38*2*((sysFont!-2+1) rshift 1) + 1
let top = vec 1
top!0 = CreateDisplayStream(1, Allocate(sysZone, lineWords), lineWords)
top!1 = CreateDisplayStream(1, Allocate(sysZone, lineWords), lineWords)
ShowDisplayStream(top!0, DSbelow, dsp)
let bot = vec 1
bot!0 = CreateDisplayStream(1, Allocate(sysZone, lineWords), lineWords)
bot!1 = CreateDisplayStream(1, Allocate(sysZone, lineWords), lineWords)
ShowDisplayStream(bot!0, DSbelow, top!0)
let boldFont = vec 1; boldFont = boldFont +2
boldFont!-2 = -1; boldFont!-1 = sysFont
let machineType = selecton eng into
   [
   case 0: case 1: "Alto I"
   case 2: "Alto II"
   case 3: "Alto II XM"
   case 4: "Dolphin"
   case 5: "Dorado"
   ]

let lastTime, now = vec 1, vec 1
   [
   ReadCalendar(now)
   if DoubleDifference(now, lastTime) ne 0 then
      [
      let line = top!1
      Resets(line)
      PutTemplate(line, "-- $PXEROX$P BCPL Net Executive/13",
       SetFont, boldFont, SetFont, sysFont)
      FillWithDash(line, 330)
      WriteDate(line)
      FillWithDash(line, 605)
      ExchangeLines(top)

      line = bot!1
      Resets(line)
      FillWithDash(line, 125)
      Wss(line, machineType)
      FillWithDash(line, 250)
      PrintName(line)
      if eng gr 3 then
         [
         FillWithDash(line, 450)
         PutTemplate(line, "Partition $D", (table [ 61037b; 1401b ])(0))
         ]
      FillWithDash(line, 605)
      ExchangeLines(bot)

      MoveBlock(lastTime, now, 2)
      ]
   Dismiss(20)
   ] repeat
]

//-----------------------------------------------------------------------------------------
and ExchangeLines(lineVec) be
//-----------------------------------------------------------------------------------------
[
let dcb = @displayListHead
while dcb>>DCB.next ne lineVec!0>>DS.cdcb do dcb = dcb>>DCB.next
lineVec!1>>DS.cdcb>>DCB.next = lineVec!0>>DS.cdcb>>DCB.next
dcb>>DCB.next = lineVec!1>>DS.cdcb
let temp = lineVec!1; lineVec!1 = lineVec!0; lineVec!0 = temp
]

//-----------------------------------------------------------------------------------------
and FillWithDash(stream, end) be
//-----------------------------------------------------------------------------------------
[
if (end-GetBitPos(stream)) gr CharWidth(stream, $*S) &
 GetBitPos(stream) ne GetLmarg(stream) then Puts(stream, $*S)
for i = 1 to (end-CharWidth(stream, $*S)-GetBitPos(stream))/
 CharWidth(stream, $-) do Puts(stream, $-)
SetBitPos(stream, end)
]

//-----------------------------------------------------------------------------------------
and WriteDate(stream) = valof
//-----------------------------------------------------------------------------------------
// "Weekday Month Day - hour:minute:second am/pm"
[
structure UV:
   [
   year word
   month word
   day word
   hour word
   minute word
   second word
   dst word
   ]
manifest lenUV = size UV/16
let dv = vec 1; ReadCalendar(dv)
let uv = vec lenUV; UNPACKDT(dv, uv)
if uv>>UV.year le 1982 % uv>>UV.year gr 2000 then
   [
   Wss(stream, "Date and time unknown")
   resultis false
   ]
let day = selecton WEEKDAY(dv) into
   [
   case 0: "Monday"
   case 1: "Tuesday"
   case 2: "Wednesday"
   case 3: "Thursday"
   case 4: "Friday"
   case 5: "Saturday"
   case 6: "Sunday"
   ]
let month = selecton uv>>UV.month into
   [
   case 0: "Jan"
   case 1: "Feb"
   case 2: "Mar"
   case 3: "Apr"
   case 4: "May"
   case 5: "Jun"
   case 6: "Jul"
   case 7: "Aug"
   case 8: "Sep"
   case 9: "Oct"
   case 10: "Nov"
   case 11: "Dec"
   ]
PutTemplate(stream, "$S $S $UD - ", day, month, uv>>UV.day)
let am = uv>>UV.hour le 11
if uv>>UV.hour ge 12 then uv>>UV.hour = uv>>UV.hour - 12
if uv>>UV.hour ls 1 then uv>>UV.hour = 12
PutTemplate(stream, "$UD:$U2F0D:$U2F0D $S", uv>>UV.hour,
 uv>>UV.minute, uv>>UV.second, (am? "am", "pm"))
resultis true
]

//-----------------------------------------------------------------------------------------
and Command() be  //a context
//-----------------------------------------------------------------------------------------
[
manifest numLines = 20
cmdDsp = CreateDisplayStream(numLines, buf, bufLen)
for i = 1 to numLines-1 do Puts(cmdDsp, $*N)
ShowDisplayStream(cmdDsp, DSbelow, dsp)
SetTimer(lv cursorTimer, 0)
cmdDsp>>ST.putback = cmdDsp>>ST.puts; cmdDsp>>ST.puts = PutsWithCursor
keys>>ST.par1 = keys>>ST.gets; keys>>ST.gets = GetsWithCursor
keys>>ST.par2 = keys>>ST.endof; keys>>ST.endof = EndofWithCursor
dirRequest = ExtractSubstring("0#0#")
timeRequest = true

LoadKT(cmdKT, "BootDP0", DiskBoot, 0, 0)
LoadKT(cmdKT, "EtherBoot", NetBoot, 0, 0)
LoadKT(cmdKT, "FileStat", FileStat, 0, 0)
if eng gr 3 then
   [
   LoadKT(cmdKT, "LoadMicrocode", LoadMicrocode, 0, 0)
   LoadKT(cmdKT, "Partition", Partition, 0, 0)
   LoadKT(cmdKT, "PowerOff", PowerOff, 0, 0)
   ]
LoadKT(cmdKT, "Probe", Probe, 0, 0)
LoadKT(cmdKT, "Quit", Quit, 0, 0)
LoadKT(cmdKT, "SetTime", SetTime, 0, 0)
LoadKT(cmdKT, "Where", Where, 0, 0)

   [
   kbdCS = InitCmd(256, 5, 0, 0, 0, keys, cmdDsp) repeatuntil kbdCS ne 0
   Wss(kbdCS,"*N>")
   if EnableCatch(kbdCS) then
      [
      if CmdErrorCode(kbdCS) eq ecKeyNotFound then
         dirRequest = ExtractSubstring("0#0#4")
      EndCatch(kbdCS)
      ]
   SetTimer(lv watchDog, 30000)  //5 min
   let kte = GetKeyword(kbdCS, cmdKT)
   test kte>>KTE.local
      ifso (kte>>KTE.bfn)()
      ifnot MyEtherBoot(kte>>KTE.bfn, lv kte>>KTE.port)
   Closes(kbdCS)
   ] repeat
]

//-----------------------------------------------------------------------------------------
and Quit() be MyEtherBoot(0)
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and SetTime() be timeRequest = true
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and Probe() be
//-----------------------------------------------------------------------------------------
[
test TerminatingChar(kbdCS) eq $*S
   ifnot dirRequest = ExtractSubstring("0#0#4")
   ifso
      [
      Wss(kbdCS, " (internet address) ")
      dirRequest = GetString(kbdCS)
      ]
]

//-----------------------------------------------------------------------------------------
and Partition() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, " number ")
BeginDefaultPhrase(kbdCS)
PutTemplate(kbdCS, "$D", (table [ 61037b; 1401b ])(0))
EndDefaultPhrase(kbdCS)
(table [ 61037b; 1401b ])(GetNumber(kbdCS))
]

//-----------------------------------------------------------------------------------------
and PowerOff() be if Confirm(kbdCS) then (table [ 61034b; 1401b ])()
//-----------------------------------------------------------------------------------------

//-----------------------------------------------------------------------------------------
and WatchDog() be  //a context
//-----------------------------------------------------------------------------------------
[
SetTimer(lv watchDog, 30000)  //5 minutes
Block() repeatuntil TimerHasExpired(lv watchDog)
Quit()
]

//-----------------------------------------------------------------------------------------
and DiskBoot() be
//-----------------------------------------------------------------------------------------
// D0s don't boot when SIO 100000 is executed, so this Bcpl procedure
//  does what the microcode should do.
[
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

@displayListHead = 0  //turn off display
(table [ 61000b; 1401b ])()  //disable interrupts
StartIO(3)  //reset Ethernet

let kcb, data, label = vec lenKCB, vec 256, vec 8
for tries = 1 to 10 do
   [
   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
   @diskCommand = kcb  //spin the disk
   while (kcb>>KCB.status & 7400b) eq 0 loop  //wait for it to stop
   if (kcb>>KCB.status & 7667b) eq 7400b break  //good status
   if tries eq 10 then CallSwat("10 consecutive errors reading vda 0")
   ]

MoveBlock(402b, label, 8)  //402-411 ← label
MoveBlock(1, data, 256)  // 1-400 ← data
@2 = kcb>>KCB.status  //2 ← status
goto 1  //jump to bootloader start address
]

//-----------------------------------------------------------------------------------------
and FileStat() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, " for boot file ")
let kte = GetKeyword(kbdCS, cmdKT, true)
if kte eq 0 then [ Resets(kbdCS); kte = GetKeyword(kbdCS, ebKT) ]
if kte>>KTE.local then [ Wss(kbdCS, "*NNetExec command - not a boot file"); return ]
PutTemplate(kbdCS, "*NBoot file number $UOb", kte>>KTE.bfn)
PutTemplate(kbdCS, ", from [$P]", PrintPort, lv kte>>KTE.port)
let utv = vec 7; UNPACKDT(lv kte>>KTE.date, utv)
PutTemplate(kbdCS, ", created $P", WRITEUDT, utv)
let altoI = eng le 1
Wss(kbdCS, "*NBoot keys <BS>")
for i = 0 to 15 do if ((kte>>KTE.bfn) & (1b15 rshift i)) ne 0 then
   Wss(kbdCS, selecton i into
      [
      case 0: " 3"
      case 1: " 2"
      case 2: " W"
      case 3: " Q"
      case 4: " S"
      case 5: " A"
      case 6: " 9"
      case 7: " I"
      case 8: " X"
      case 9: " O"
      case 10: " L"
      case 11: " <comma>"
      case 12: " <quote>"
      case 13: " ]"
      case 14: altoI? " <blank-middle>", " <FR4>"
      case 15: altoI? " <blank-top>", " <BW>"
      ])
]

//-----------------------------------------------------------------------------------------
and GetsWithCursor(st) = valof
//-----------------------------------------------------------------------------------------
[
Block() repeatwhile Endofs(st)
EraseCursor()
resultis st>>ST.par1(st)
]

//-----------------------------------------------------------------------------------------
and PutsWithCursor(st, char) be
//-----------------------------------------------------------------------------------------
[
EraseCursor()
Putbacks(st, char)
]

//-----------------------------------------------------------------------------------------
and EndofWithCursor(st) = valof
//-----------------------------------------------------------------------------------------
[
if TimerHasExpired(lv cursorTimer) then
   [
   SetTimer(lv cursorTimer, 50)
   test cursorOn
      ifso EraseCursor()
      ifnot [ Puts(cmdDsp, $|); cursorOn = true ]
   ]
resultis st>>ST.par2(st)
]

//-----------------------------------------------------------------------------------------
and EraseCursor() be if cursorOn then
//-----------------------------------------------------------------------------------------
[
EraseBits(cmdDsp, -CharWidth(cmdDsp,$|))
cursorOn = false
]