// NetExec.bcpl -- A one-day hack that worked
// Copyright Xerox Corporation 1979, 1980, 1982, 1983
// Last modified January 11, 1983  8:22 PM by Boggs

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

external
[
// outgoing procedures
LoadKT

// incoming procedures
PrintName; LoadMicrocode; Where
GetTime; GetDir; GetName; NetBoot

MyFrame; Usc; 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

CreateKeywordTable; InsertKeyword; LookupKeyword; DeleteKeyword
InitCmd; GetKeyword; GetNumber; CmdErrorCode; EnableCatch; EndCatch
BeginDefaultPhrase; EndDefaultPhrase; Confirm

InitPupLevel1; EtherBoot

// incoming statics
sysZone; sysFont; dsp; keys
timeRequest; dirRequest

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

static
[
ftpCtxQ; cmdDsp; cmdKT; ebKT; kbdCS; buf
watchDog; numKTEs = 0; eng; OpenFile
cursorOn; cursorTimer
]

structure KTE:
[
date word 2
host word	//if host is zero then
bfn word	//bfn is really a local procedure (e.g. BfnToKeys)
]
manifest
[
lenKTE = size KTE/16
maxKTEs = 100

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, 10)
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/12",
       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

let dummyDate = vec 1; Zero(dummyDate, 2)
LoadKT(cmdKT, "BootDP0", 0, dummyDate, DiskBoot)
LoadKT(cmdKT, "EtherBoot", 0, dummyDate, NetBoot)
LoadKT(cmdKT, "FileStat", 0, dummyDate, FileStat)
if eng gr 3 then
   [
   LoadKT(cmdKT, "LoadMicrocode", 0, dummyDate, LoadMicrocode)
   LoadKT(cmdKT, "Partition", 0, dummyDate, Partition)
   LoadKT(cmdKT, "PowerOff", 0, dummyDate, PowerOff)
   ]
LoadKT(cmdKT, "Probe", 0, dummyDate, Probe)
LoadKT(cmdKT, "Quit", 0, dummyDate, Quit)
LoadKT(cmdKT, "SetTime", 0, dummyDate, SetTime)
LoadKT(cmdKT, "Where", 0, dummyDate, Where)

   [
   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 Probe()
      EndCatch(kbdCS)
      ]
   SetTimer(lv watchDog, 30000)  //5 min
   let kte = GetKeyword(kbdCS, cmdKT)
   test kte>>KTE.host ne 0
      ifso EtherBoot(kte>>KTE.bfn, false, kte>>KTE.host)
      ifnot (kte>>KTE.bfn)()
   Closes(kbdCS)
   ] repeat
]

//---------------------------------------------------------------------------
and LoadKT(kt, name, host, date, bfn) be
//---------------------------------------------------------------------------
[
let kte = LookupKeyword(kt, name)
if kte ne 0 & DoubleUsc(date, lv kte>>KTE.date) gr 0 then
   [ DeleteKeyword(kt, name); kte = 0 ]
if kte eq 0 & numKTEs ne maxKTEs then
   [
   kte = InsertKeyword(kt, name)
   kte>>KTE.host = host
   kte>>KTE.bfn = bfn
   MoveBlock(lv kte>>KTE.date, date, 2)
   ]
]

//----------------------------------------------------------------------------
and DoubleUsc(lvA, lvB) =
//----------------------------------------------------------------------------
// lvA and lvB are the addresses of two 32-bit operands Returns:
//	-1 if A < B
//	 0 if A = B
//	 1 if A > B
(table
   [
    41003b	//	sta 0 3 2	; lvA
    45002b	//	sta 1 2 2	; lvB
    23003b	//	lda 0 @3 2	; A high part
    27002b	//	lda 1 @2 2	; B high part
   106414b	//	se 0 1		; A, B
      405b	//	 jmp dusc1
    11003b	//	isz 3 2		; lvA
    11002b	//	isz 2 2		; lvB
    23003b	//	lda 0 @3 2	; A low part
    27002b	//	lda 1 @2 2	; B low part
   106433b	// dusc1: sleu 0 1	; A, B
      405b	//	 jmp gr		; A > B
   106414b	//	se 0 1		; A, B
   102001b	//	 mkminusone 0 0 skp	; A < B
   102460b	//	mkzero 0 0	; A = B
     1401b	//	jmp 1 3
   102520b	// gr:	mkone 0 0
     1401b	//	jmp 1 3
   ])(lvA, lvB)

//---------------------------------------------------------------------------
and Quit() be EtherBoot(0)
//---------------------------------------------------------------------------

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

//---------------------------------------------------------------------------
and Probe() be dirRequest = true
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
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)
if kte>>KTE.host eq 0 then
   [
   Wss(kbdCS, "*NNetExec command - not a boot file")
   return
   ]
PutTemplate(kbdCS, "*NBoot file number $UOb, from host $UO#, created ",
 kte>>KTE.bfn, kte>>KTE.host)
let utv = vec 7; UNPACKDT(lv kte>>KTE.date, utv); WRITEUDT(kbdCS, utv)
let altoI = eng le 1
Wss(kbdCS, "*Nkeys <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
]