// PupBootServ.bcpl -- Boot Server
// See <Pup>AltoBoot.press for protocol specification
// Last modified March 15, 1979 11:37 PM by Boggs
get "Pup0.decl"
get "Pup1.decl"
get "Streams.d"
get "PupBootServ.decl"
get "PupServEftp.decl"
external
[
// outgoing procedures
BootServ; BootServCtx
LockBootServ; UnlockBootServ
StringCompare; DoubleUsc
// incoming procedures
InitializeContext; Dismiss; Block
MoveBlock; Zero; Enqueue; Unqueue; Dequeue
CompletePup; GetPBI; ReleasePBI
ExchangePorts; SetPupDPort; SetPupSPort; SetPupID
CallSwat; DoubleIncrement; Usc; SetTimer; TimerHasExpired
PupServSend; PupServReceive; GetTime
OpenFile; FilePos; SetFilePos; ReadBlock; Resets; Closes
Allocate; Free; DefaultArgs
// outgoing statics
@bs
// incoming statics
ndbQ; lenPup; maxPupDataBytes
bootLoaderPacket; CtxRunning; @ms
]
static @bs
// BootServCtx is the main process for this module.
// It lives forever and does the following tasks:
// Broadcasts Boot loaders.
// Probes for new versions of boot files.
// Starts a Receiver process when it finds a newer boot file version.
// Destroys transient processes when they are done.
// There are two types of transient processes:
// Receivers receive boot files from other boot servers
// Senders send boot files to:
// Other boot servers who need to update a boot file.
// Altos that are requesting a boot.
// There can be at most one receiver process.
// There can be at most two sender processes:
// At most one sending down an Ethernet (fast net).
// At most one sending down a net other than an Ethernet (slow net).
// BootServ is logically part of the miscellaneous services process,
// handling the Boot protocol packet types.
// There are two global locks which if set prevent any more
// transient processes from being created.
// Internal lock is set from within the gateway
// External lock is set by commands from GateControl
//----------------------------------------------------------------------------
let BootServCtx() be
//----------------------------------------------------------------------------
[
Dismiss(breathInterval)
// destroy any contexts which are done
compiletest nova
ifso
[
while bs>>BS.doneQ.head ne 0 do
ReleasePBI(Dequeue(lv bs>>BS.doneQ)-offset PBI.pup/16)
]
ifnot
[
while bs>>BS.doneQ.head ne 0 do
Free(ms>>MS.zone, Dequeue(lv bs>>BS.doneQ))
]
// don't do anything but kill servers if a global lock is set
if bs>>BS.globalLocks ne 0 loop
// run down the list of boot files doing house keeping:
// 1) if any need updating then try to spawn an update process
// 2) if we know the time and any files have dates later than
// now, set their dates to 0.
let now = vec 1; let knowTime = GetTime(now)
let bfe = bs>>BS.bfeQ.head; while bfe ne 0 do
[
if knowTime & DoubleUsc(now, lv bfe>>BFE.date) ls 0 then
Zero(lv bfe>>BFE.date, 2)
if bfe>>BFE.update ne 0 then
CreateBootCtx(ReceiveBootFile, bfe, rcvrLock, lv bfe>>BFE.port)
bfe = bfe>>BFE.link
]
// probe for new boot files now and then
if bs>>BS.bcstTimer gr 0 then
bs>>BS.bcstTimer = bs>>BS.bcstTimer -1
if bs>>BS.bcstTimer le 0 then SendBootDir(0, 0)
// Every five seconds, broadcast (to host 377) a Breath-of-life NON PUP on
// all directly connected Ethernets containing an Alto Ethernet boot loader.
let ndb = ndbQ!0; while ndb ne 0 do
[
if ndb>>NDB.netType eq netTypeEther then
[
structure EtherPBI:
[
blank word offset PBI.pup/16-2
dest byte
src byte
type word
]
let pbi = GetPBI(ms>>MS.soc, true); if pbi eq 0 break
pbi>>PBI.ndb = ndb
pbi>>PBI.packetLength = 256
MoveBlock(lv pbi>>EtherPBI.dest, bootLoaderPacket, 256)
pbi>>EtherPBI.dest = 377b // special for microcode
pbi>>EtherPBI.src = ndb>>NDB.localHost
pbi>>EtherPBI.type = etBreathOfLife // special for microcode
(ndb>>NDB.level0Transmit)(pbi)
]
ndb = ndb!0
]
] repeat
//----------------------------------------------------------------------------
and BootServ(pbi) be
//----------------------------------------------------------------------------
[
ExchangePorts(pbi)
switchon pbi>>PBI.pup.type into
[
case ptBootFileRequest:
[
if bs>>BS.globalLocks ne 0 endcase
let bfe = bs>>BS.bfeQ.head; while bfe ne 0 do
[
if bfe>>BFE.bfn eq pbi>>PBI.pup.id↑2 & bfe>>BFE.exists ne 0 then
[
CreateBootCtx(SendBootFile, bfe,
(pbi>>PBI.ndb>>NDB.netType eq netTypeEther? fastLock, slowLock),
lv pbi>>PBI.pup.dPort)
break
]
bfe = bfe>>BFE.link
]
endcase
]
case ptBootDirRequest:
[
if bs>>BS.globalLocks eq 0 then
SendBootDir(lv pbi>>PBI.pup.dPort, lv pbi>>PBI.pup.id)
endcase
]
case ptBootDirReply:
[
if bs>>BS.globalLocks ne 0 endcase
let now = vec 1; let knowTime = GetTime(now)
let p = 1; until p ge ((pbi>>PBI.pup.length-pupOvBytes)+1)/2 do
[
let bfd = lv pbi>>PBI.pup.words↑p
p = p + lenBFD + bfd>>BFD.name.length rshift 1 +1
if (bfd>>BFD.bfn & 1b15) ne 0 % not knowTime %
(knowTime & DoubleUsc(now, lv bfd>>BFD.date) ls 0) loop
let bfe = bs>>BS.bfeQ.head; while bfe ne 0 do
[
if bfe>>BFE.bfn eq bfd>>BFD.bfn then
[
if StringCompare(lv bfd>>BFD.name, lv bfe>>BFE.name) ne 0 break
let dateUsc = DoubleUsc(lv bfd>>BFD.date, lv bfe>>BFE.date)
if dateUsc ls 0 then bs>>BS.bcstTimer = 0
if dateUsc gr 0 then
[
MoveBlock(lv bfe>>BFE.port, lv pbi>>PBI.pup.dPort, lenPort)
bfe>>BFE.update = true
]
break
]
bfe = bfe>>BFE.link
]
]
endcase
]
case ptBootStatsRequest:
[
MoveBlock(lv pbi>>PBI.pup.words, lv bs>>BS.stats, size Stats/16)
CompletePup(pbi, ptBootStatsReply, pupOvBytes+size Stats/8)
return
]
case ptBootLockRequest:
[
if Authenticate(pbi) then
[
bs>>BS.externalLock = true
CompletePup(pbi, ptBootLockReply, pupOvBytes)
return
]
endcase
]
case ptBootUnlockRequest:
[
if Authenticate(pbi) then
[
bs>>BS.externalLock = false
bs>>BS.bcstTimer = 0
CompletePup(pbi, ptBootUnlockReply, pupOvBytes)
return
]
endcase
]
]
ReleasePBI(pbi)
]
//----------------------------------------------------------------------------
and Authenticate(pbi) = pbi>>PBI.pup.id↑1 eq 27182
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
and SendBootDir(port, id) be
//----------------------------------------------------------------------------
// Send the boot file directory to port. Set the pup IDs to id.
// If port is 0, then broadcast it on all directly connected nets.
[
let allNets = port eq 0
test port eq 0
ifso
[
port = table [ 0; 0; psMiscServ ]
id = table [ 0; 0 ]
bs>>BS.bcstTimer = bs>>BS.bcstInterval
]
ifnot DoubleIncrement(lv bs>>BS.stats.dirsSent)
let pbi, p = 0, nil // p indexes pbi: pbi>>PBI.pup.words↑p
let bfe = bs>>BS.bfeQ.head; while bfe ne 0 do
[
if bfe>>BFE.exists then
[
if pbi eq 0 then
[
pbi = GetPBI(ms>>MS.soc, true); if pbi eq 0 return
SetPupDPort(pbi, port)
SetPupID(pbi, id)
pbi>>PBI.allNets = allNets
p = 0
]
let lBFD = lenBFD + bfe>>BFE.name.length/2 +1
if (p+lBFD) gr maxPupDataBytes/2 then
[ //ran out of space in this packet
CompletePup(pbi, ptBootDirReply, pupOvBytes+p*2)
pbi = 0
loop
]
MoveBlock(lv pbi>>PBI.pup.words↑(p+1), lv bfe>>BFE.bfd, lBFD)
p = p + lBFD
]
bfe = bfe>>BFE.link
]
if pbi ne 0 then CompletePup(pbi, ptBootDirReply, pupOvBytes+p*2)
]
//----------------------------------------------------------------------------
and ReceiveBootFile(ctx) be // a BCTX
//----------------------------------------------------------------------------
[
let bfe = ctx>>BCTX.bfe
let eftp = vec lenEFTP; Zero(eftp, lenEFTP)
eftp>>EFTP.frnPort = lv ctx>>BCTX.port
eftp>>EFTP.fp = lv bfe>>BFE.fp
eftp>>EFTP.realName = lv bfe>>BFE.name
eftp>>EFTP.tempName = "TEMP.BOOT"
eftp>>EFTP.timeOut1 = 100 // 1 sec
eftp>>EFTP.timeOut2 = 2000 // 20 sec
eftp>>EFTP.proc1 = RBFStartProc
eftp>>EFTP.proc2 = RBFEndProc
if PupServReceive(eftp) then
[
DoubleIncrement(lv bs>>BS.stats.filesRcvd)
SendBootDir(0, 0)
]
//even if we fail, wait for receipt of next boot dir bcst before trying again
bfe>>BFE.update = false
DestroyBootCtx(ctx)
//returning from a context does an implicit Block()
]
//----------------------------------------------------------------------------
and RBFStartProc(soc) be
//----------------------------------------------------------------------------
[
let pbi = GetPBI(soc, true); if pbi eq 0 return
pbi>>PBI.pup.id↑2 = CtxRunning>>BCTX.bfe>>BFE.bfn
CompletePup(pbi, ptBootFileRequest, pupOvBytes)
]
//----------------------------------------------------------------------------
and RBFEndProc(stream) be
//----------------------------------------------------------------------------
[
let fPos = vec 1; FilePos(stream, fPos)
Resets(stream)
let v = vec 5; ReadBlock(stream, v, 5)
MoveBlock(lv CtxRunning>>BCTX.bfe>>BFE.date, v+3, 2)
CtxRunning>>BCTX.bfe>>BFE.exists = true
SetFilePos(stream, fPos)
]
//----------------------------------------------------------------------------
and SendBootFile(ctx) be // a BCTX
//----------------------------------------------------------------------------
[
let eftp = vec lenEFTP; Zero(eftp, lenEFTP)
eftp>>EFTP.frnPort = lv ctx>>BCTX.port
eftp>>EFTP.fp = lv ctx>>BCTX.bfe>>BFE.fp
eftp>>EFTP.realName = lv ctx>>BCTX.bfe>>BFE.name
let fast = ctx>>BCTX.lockMask eq fastLock
eftp>>EFTP.timeOut1 = fast? 50, 3000 //1/2, 30
eftp>>EFTP.timeOut2 = fast? 500, 3000 //5, 30
if PupServSend(eftp) then
DoubleIncrement(fast? lv bs>>BS.stats.fastSends, lv bs>>BS.stats.slowSends)
DestroyBootCtx(ctx)
//returning from a context does an implicit Block()
]
//----------------------------------------------------------------------------
and CreateBootCtx(proc, bfe, lockMask, port) be
//----------------------------------------------------------------------------
[
if bs>>BS.globalLocks ne 0 % (bs>>BS.localLocks & lockMask) ne 0 return
bs>>BS.localLocks = bs>>BS.localLocks % lockMask
let ctx = alto? Allocate(ms>>MS.zone, 1200, true), valof //nova case
[ //locks set above because GetPBI can call Block.
let pbi = GetPBI(ms>>MS.soc, true)
resultis pbi eq 0? 0, lv pbi>>PBI.pup
]
test ctx ne 0
ifso
[
InitializeContext(ctx, (alto? 1200, lenPup), proc, BCTXextra)
ctx>>BCTX.bfe = bfe
ctx>>BCTX.lockMask = lockMask
MoveBlock(lv ctx>>BCTX.port, port, lenPort)
Enqueue(ms>>MS.ctxQ, ctx)
]
ifnot bs>>BS.localLocks = bs>>BS.localLocks & not lockMask
]
//----------------------------------------------------------------------------
and DestroyBootCtx(ctx) be
//----------------------------------------------------------------------------
// This doesn't actually destroy it. It releases ctx's locks
// and queues it for destruction by BootCtx.
[
Unqueue(ms>>MS.ctxQ, ctx)
Enqueue(lv bs>>BS.doneQ, ctx)
bs>>BS.localLocks = bs>>BS.localLocks & not ctx>>BCTX.lockMask
]
//----------------------------------------------------------------------------
and LockBootServ() be
//----------------------------------------------------------------------------
// No further transient processes will be created.
// Returns when none are active.
[
bs>>BS.internalLock = true
Block() repeatuntil bs>>BS.localLocks eq 0
]
//----------------------------------------------------------------------------
and UnlockBootServ(name; numargs na) be
//----------------------------------------------------------------------------
[
if na gr 0 then
[
let bfe = bs>>BS.bfeQ.head; while bfe ne 0 do
[
if StringCompare(name, lv bfe>>BFE.name) eq 0 then
[
Zero(lv bfe>>BFE.fp, 5)
let stream = OpenFile(name, ksTypeReadOnly, charItem,
0, lv bfe>>BFE.fp)
if stream ne 0 then
[
let v = vec 5; ReadBlock(stream, v, 5)
MoveBlock(lv bfe>>BFE.date, v+3, 2)
Closes(stream)
bfe>>BFE.exists = true
bs>>BS.bcstTimer = 0
]
break
]
bfe = bfe>>BFE.link
]
]
bs>>BS.internalLock = false
]
//----------------------------------------------------------------------------
and StringCompare(s1, s2, first1, last1, first2, last2; numargs na) = valof
//----------------------------------------------------------------------------
//Compares the "first1" through "last1" characters of the string
//"s1" with the "first2" through "last2" characters of "s2",
//with lower-case alphabetics matching upper-case. Returns a code
//describing the result:
// -2 s1 is an initial substring of s2
// -1 s1 is "less than" s2 but not an initial substring
// 0 s1 is "equal to" s2
// 1 s1 is "greater than" s2
//The arguments beyond "s2" are optional and default to the entire
//respective string.
[
DefaultArgs(lv na, -2, 1, s1>>String.length, 1, s2>>String.length)
let firstDif = first2-first1
for i = first1 to last1 do
[
if i gr last2-firstDif resultis 1
let c1 = s1>>String.char↑i
if c1 ge $a & c1 le $z then c1 = c1-($a-$A)
let c2 = s2>>String.char↑(firstDif+i)
if c2 ge $a & c2 le $z then c2 = c2-($a-$A)
if c1 ne c2 resultis Usc(c1, c2)
]
resultis (last2-last1 eq firstDif? 0, -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)