// NetExec1.bcpl -- all the network-related stuff
// Copyright Xerox Corporation 1979, 1980, 1982, 1983
// Last modified July 1, 1983 4:23 PM by Boggs
get "PupEftp.decl"
get "AltoDefs.d"
external
[
// outgoing procedures
PrintName; PrintPort; LoadMicrocode; Where; LoadKT
GetTime; GetDir; GetName; NetBoot; MyEtherBoot
// incoming procedures
UNPACKDT; WRITEUDT
DisableInterrupts; StartIO
MoveBlock; Zero; Dequeue; Allocate; Free; Block
SetTimer; TimerHasExpired; Dismiss; SetCalendar
PutTemplate; Wss; Closes; Resets
StringCompare; GetKeyword; GetString
EnumerateKeywordTable; InsertKeyword; LookupKeyword; DeleteKeyword
GetPartner; OpenLevel1Socket; CloseLevel1Socket
GetPBI; ReleasePBI; CompletePup; LocateNet
OpenEFTPSoc; ReceiveEFTPBlock; CloseEFTPSoc
// incoming statics
sysZone
kbdCS; cmdDsp; cmdKT; ebKT; buf; eng
timeRequest; dirRequest
lenPBI; ndbQ
mayDayPacket; bootLoaderPacket
]
static ourName
manifest
[
psMiscServ = 4
ptAltoTimeReq = 206b
ptAltoTimeReply = 207b
ptBootFileReq = 244b
ptBootDirReq = 257b
ptBootDirReply = 260b
ptAddressLookup = 223b
ptAddressReply = 224b
ptAddressError = 222b
]
structure KTE: //must match definition in NetExec.bcpl
[
bfn word //boot file number
local word //true => local procedure; false => boot file
port @Port //internet address of boot server
date word 2 //used as a version number
]
structure BFD: [ bfn word; date word 2; name @String ]
//-----------------------------------------------------------------------------------------
let GetTime() be //a context
//-----------------------------------------------------------------------------------------
[
Block() repeatuntil timeRequest
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptAltoTimeReq
pbi>>PBI.pup.length = pupOvBytes
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
SimplePup(pbi, 50, 1000, InstallTime)
Free(sysZone, pbi)
timeRequest = 0
] repeat
//-----------------------------------------------------------------------------------------
and InstallTime(pbi, nil) = valof
//-----------------------------------------------------------------------------------------
[
structure NTime:
[
time word 2
zone:
[
sign bit 1
hour bit 7
minute bit 8
]
beginDST word
endDST word
]
if pbi>>PBI.pup.type ne ptAltoTimeReply resultis true // keep trying
let nTime = lv pbi>>PBI.pup.words
SetCalendar(lv nTime>>NTime.time)
timeParams>>LTP.sign = nTime>>NTime.zone.sign
timeParams>>LTP.zoneH = nTime>>NTime.zone.hour
timeParams>>LTP.zoneM = nTime>>NTime.zone.minute
timeParams>>LTP.beginDST = nTime>>NTime.beginDST
timeParams>>LTP.endDST = nTime>>NTime.endDST
resultis false
]
//-----------------------------------------------------------------------------------------
and GetDir() be //a context
//-----------------------------------------------------------------------------------------
[
Block() repeatuntil dirRequest
let target = dirRequest; dirRequest = 0
if target>>String.char↑1 eq $[ then
[
for i = 2 to target>>String.length-1 do
target>>String.char↑(i-1) = target>>String.char↑i
target>>String.length = target>>String.length -2
]
let port = vec lenPort; Zero(port, lenPort)
GetPartner(target, kbdCS, port, 0, psMiscServ)
Free(sysZone, target)
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptBootDirReq
pbi>>PBI.pup.length = pupOvBytes
MoveBlock(lv pbi>>PBI.pup.dPort, port, lenPort)
SimplePup(pbi, 100, 300, InstallDir)
] repeat
//-----------------------------------------------------------------------------------------
and InstallDir(pbi, nil) = valof
//-----------------------------------------------------------------------------------------
[
if pbi>>PBI.pup.type eq ptBootDirReply then
[
let ptr, maxPtr = 1, (pbi>>PBI.pup.length-pupOvBytes)/2
while ptr ls maxPtr do
[
let bfd = lv pbi>>PBI.pup.words↑ptr
let name = lv bfd>>BFD.name
let length = name>>String.length
if StringCompare(name, ".boot", length-4) eq 0 then
LoadKT(cmdKT, name, bfd>>BFD.bfn, lv pbi>>PBI.pup.sPort, lv bfd>>BFD.date)
if StringCompare(name, ".eb", length-2) eq 0 then
LoadKT(ebKT, name, bfd>>BFD.bfn, lv pbi>>PBI.pup.sPort, lv bfd>>BFD.date)
ptr = ptr + 4 + length/2
]
]
resultis true
]
//-----------------------------------------------------------------------------------------
and LoadKT(kt, name, bfn, port, date) 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 then
[
kte = InsertKeyword(kt, name)
kte>>KTE.bfn = bfn
kte>>KTE.local = port eq 0 & date eq 0
MoveBlock(lv kte>>KTE.port, port, 3)
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 GetName() be //a context
//-----------------------------------------------------------------------------------------
[
let ndb = ndbQ!0; Block() repeatwhile ourName ne 0 % ndb>>NDB.localNet eq 0
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptAddressLookup
pbi>>PBI.pup.length = pupOvBytes+6
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
let port = lv pbi>>PBI.pup.bytes↑1
port>>Port.net = ndb>>NDB.localNet
port>>Port.host = ndb>>NDB.localHost
SimplePup(pbi, 100, 500, InstallName)
Free(sysZone, pbi)
] repeat
//-----------------------------------------------------------------------------------------
and InstallName(pbi, nil) = valof
//-----------------------------------------------------------------------------------------
[
switchon pbi>>PBI.pup.type into
[
case ptAddressReply:
[
let numChars = pbi>>PBI.pup.length - pupOvBytes
ourName = Allocate(sysZone, numChars/2+1)
for i = 1 to numChars do
ourName>>String.char↑i = pbi>>PBI.pup.bytes↑i
ourName>>String.length = numChars
resultis false
]
case ptAddressError:
[
ourName = -1
resultis false
]
default: resultis true
]
]
//-----------------------------------------------------------------------------------------
and PrintName(stream) be
//-----------------------------------------------------------------------------------------
[
test ourName eq 0 % ourName eq -1
ifso PutTemplate(stream, "[$O#$O#]", (ndbQ!0)>>NDB.localNet, (ndbQ!0)>>NDB.localHost)
ifnot PutTemplate(stream, "[$S]", ourName)
]
//-----------------------------------------------------------------------------------------
and PrintPort(stream, port) be
//-----------------------------------------------------------------------------------------
[
PutTemplate(stream, "$UO#$UO#", port>>Port.net, port>>Port.host)
if port>>Port.socket↑1 ne 0 % port>>Port.socket↑2 ne 0 then
PutTemplate(stream, "$EUO", lv port>>Port.socket)
]
//-----------------------------------------------------------------------------------------
and LoadMicrocode() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, " from file ")
let kte = GetKeyword(kbdCS, ebKT)
Closes(cmdDsp)
let soc = vec lenEFTPSoc
OpenEFTPSoc(soc, 0, lv kte>>KTE.port)
// ought to do some buffer bounds checking, and check file checksum
let bytePtr = nil
[
let pbi = GetPBI(soc)
pbi>>PBI.pup.id↑2 = kte>>KTE.bfn
CompletePup(pbi, ptBootFileReq, pupOvBytes)
bytePtr = ReceiveEFTPBlock(soc, buf, 100) // 1 sec
] repeatuntil bytePtr gr 0
let bytes = nil
[
bytes = ReceiveEFTPBlock(soc, buf+bytePtr rshift 1, 1000) // 10 sec
bytePtr = bytePtr + bytes
] repeatuntil bytes le 0
CloseEFTPSoc(soc)
let ptr = buf + 256
if eng eq 4 then
[ // magic incantation from HGM
ptr = ptr -1
ptr!0 = 0
]
(table [ 61036b; 1401b ])(ptr, true) // load ram and boot
]
//-----------------------------------------------------------------------------------------
and Where() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, " (is file) ")
let kte = GetKeyword(kbdCS, cmdKT, true)
if kte eq 0 then [ Resets(kbdCS); kte = GetKeyword(kbdCS, ebKT) ]
let pbi = Allocate(sysZone, lenPBI); Zero(pbi, lenPBI)
pbi>>PBI.pup.type = ptBootDirReq
pbi>>PBI.pup.length = pupOvBytes
pbi>>PBI.pup.dPort.socket↑2 = psMiscServ
SimplePup(pbi, 1000, 250, WhereMatch, kte!-1)
Free(sysZone, pbi)
]
//-----------------------------------------------------------------------------------------
and WhereMatch(pbi, string) = valof
//-----------------------------------------------------------------------------------------
[
if pbi>>PBI.pup.type eq ptBootDirReply then
[
let ptr, maxPtr = 1, (pbi>>PBI.pup.length-pupOvBytes)/2
while ptr ls maxPtr do
[
let bfd = lv pbi>>PBI.pup.words↑ptr
let name = lv bfd>>BFD.name
let length = name>>String.length
if StringCompare(string, name) eq 0 then
[
let utv = vec 7; UNPACKDT(lv bfd>>BFD.date, utv)
PutTemplate(cmdDsp, "*N[$P] boot file number $UO, created $P",
PrintPort, lv pbi>>PBI.pup.sPort, bfd>>BFD.bfn, WRITEUDT, utv)
]
ptr = ptr + 4 + length/2
]
]
resultis true
]
//-----------------------------------------------------------------------------------------
and SimplePup(outPbi, retransTO, totalTO, proc, arg) be
//-----------------------------------------------------------------------------------------
[
let soc = vec lenPupSoc; OpenLevel1Socket(soc)
let q = vec 1; q!0 = 0; outPbi>>PBI.queue = q
let rTimer = nil; SetTimer(lv rTimer, 0)
let tTimer = nil; SetTimer(lv tTimer, totalTO)
let continue = true
[
if TimerHasExpired(lv rTimer) then
[
outPbi>>PBI.socket = soc
CompletePup(outPbi)
SetTimer(lv rTimer, retransTO)
]
Block() repeatuntil soc>>PupSoc.iQ.head ne 0 %
TimerHasExpired(lv rTimer) % TimerHasExpired(lv tTimer)
if TimerHasExpired(lv tTimer) break
let inPbi = Dequeue(lv soc>>PupSoc.iQ); if inPbi ne 0 then
[
continue = proc(inPbi, arg)
ReleasePBI(inPbi)
]
] repeatwhile continue
CloseLevel1Socket(soc)
]
//-----------------------------------------------------------------------------------------
and NetBoot() be
//-----------------------------------------------------------------------------------------
[
Wss(kbdCS, " (file named) ")
let kte = GetKeyword(kbdCS, cmdKT)
if kte>>KTE.local then [ Wss(kbdCS, " - NetExec command; not a boot file"); return ]
Wss(kbdCS, " (from server) ")
let server = GetString(kbdCS)
if server>>String.char↑1 eq $[ then
[
for i = 2 to server>>String.length-1 do
server>>String.char↑(i-1) = server>>String.char↑i
server>>String.length = server>>String.length -2
]
let dPort = vec lenPort
if GetPartner(server, kbdCS, dPort, 0, 4) then MyEtherBoot(kte>>KTE.bfn, dPort)
Free(sysZone, server)
]
//-----------------------------------------------------------------------------------------
and MyEtherBoot(bfn, dPort; numargs na) be
//-----------------------------------------------------------------------------------------
[
let mayDayPup = mayDayPacket+2
mayDayPup>>Pup.id↑2 = bfn
if na gr 1 then
[
let rte = LocateNet(dPort>>Port.net)
if rte eq 0 then [ Dismiss(150); rte = LocateNet(dPort>>Port.net) ]
let pdh = rte eq 0? 0, (rte>>RTE.hops eq 0? dPort>>Port.host, rte>>RTE.host)
mayDayPacket!0 = pdh lshift 8
MoveBlock(lv mayDayPup>>Pup.dPort, dPort, lenPort)
mayDayPup>>Pup.sPort.net = (ndbQ!0)>>NDB.localNet
]
DisableInterrupts()
StartIO(3)
for i = 0 to 255 do 1!i = bootLoaderPacket!i //can't call a procedure!
goto 6
]