// 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
]