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