// SwatNet.bcpl -- single user Pup package
// Copyright Xerox Corporation 1979, 1981, 1982
// Last modified March 21, 1982 11:30 PM by Boggs
get "Swat.decl"
get "AltoDefs.d"
external
[
// outgoing procedures
EventReport; CreateNVM; TeleSwatServer
// incoming procedures from Swat
VMFetch; VMStore; VMSwap
ReportFail; SetFailPt; UnSetFailPt; Fail
// incoming procedures from OS
DefaultArgs; ReadCalendar
Zero; MoveBlock; SetBlock; Usc
StartIO; Idle; Noop; DoubleAdd
Allocate; Free; Puts; PutTemplate; Ws; Wss
Enqueue; Unqueue; Dequeue; QueueLength
// incoming statics
ErrorLogAddress; sysZone; dsp; vm
]
static
[
teleSwatCursor
maxNBs = 32
lenBlock = 32
// a very degenerate routing table:
lclNet // our net number, last time we got a routing packet
lclHost // our host number, last time we reset the interface
frnNet // net number of our partner
gateHost // gateway host to get to frnNet
]
manifest numRTE = 32
//----------------------------------------------------------------------------
structure Port: // Internetwork address
//----------------------------------------------------------------------------
[
net byte
host byte
socket↑1,2 word
]
manifest lenPort = size Port/16
//----------------------------------------------------------------------------
structure PBI: // A Pup in an Ethernet packet
//----------------------------------------------------------------------------
[
eDest byte // destination on this Ethernet
eSrc byte // my address on this Ethernet
eType word // 1000B => Pup
// the Pup begins here, stuff above is Ethernet encapsulation
length word // Bytes of pup contents + header
transport byte // zero it on sending
type byte // pup type
id word 2 // generally used for duplicate detection
dPort: @Port // internet destination address of this packet
sPort: @Port // internet source address of this packet
bytes↑0,531 byte // the data
checksum word // position varies -- follows contents
]
manifest lenPBI = size PBI/16
//----------------------------------------------------------------------------
structure RTE: // Routing table entry
//----------------------------------------------------------------------------
[
dNet byte // to get to this net...
viaNet byte // if zero I'm directly connected; send them to me
viaHost byte // if non zero, I'll send them here
hops byte // your goal is this many internet hops away
]
manifest lenRTE = size RTE/16
//----------------------------------------------------------------------------
structure RTPBI: // Routing table PBI
//----------------------------------------------------------------------------
[
blank word offset PBI.bytes/16
rte↑0,0 @RTE
]
//----------------------------------------------------------------------------
structure NVM: // Net Virtual Memory
//----------------------------------------------------------------------------
[
@VM
lclPort @Port // Swat's address (net, host blank)
frnPort @Port // Swatee's address
id word 2 // used as packet sequence number
hits word // # cache hits
misses word // # cache misses
nbQ: // a queue of NBs
[
head word
tail word
]
]
manifest lenNVM = size NVM/16
//----------------------------------------------------------------------------
structure NB: // Net buffer (virtual memory - not packet)
//----------------------------------------------------------------------------
[
link word
firstAddr word // first address cached in this NB
lenBlock word // number of words cached in this NB
block word // size varies
]
manifest lenNBHeader = offset NB.block/16
//----------------------------------------------------------------------------
structure NBPBI: // Net Buffer PBI
//----------------------------------------------------------------------------
[
blank word offset PBI.bytes/16
address word // address of the word we are fetching or storing
value word // value of the word we are fetching or storing
lenBlock word // 0 or length of the following block:
block word // base address is (address & -lenBlock)
]
// Swat packet format:
// Pup header
// word 0: address
// word 1: value
// optionally followed by:
// word 2: lenBlock - must be a power of 2 and le 256
// user to server: send this many words surrounding address
// server to user: here are this many words surrounding address
// words 3-258 up to 256 words
// 'surrounding' means send lenBlock words starting at (address & -lenBlock)
manifest
[
pupOvBytes = 22 // Pup header overhead
ptEventReport = 240B // Pup Types
ptEventReply = 241B
ptRouteRequest = 200B
ptRouteReply = 201B
ptNameRequest = 220b
ptNameReply = 221b
ptNameError = 222b
ptSwatStore = 200b
ptSwatFetch = 201b
ptSwatSwap = 202b
ptSwatSwapReply = 203b
ptSwatAck = 204b
socRouteInfo = 2 // Well known sockets
socMiscServices = 4
socTeleSwat = 60b
// Ether definitions
etherPup = 1000B // Ethernet type = Pup
ePLoc = 600B // Ending status
eBLoc = 601B // Interrupt channel bits
eELoc = 602B // Ending count
eLLoc = 603B // Initial load
eICLoc = 604B // Input count
eIPLoc = 605B // Input pointer
eOCLoc = 606B // Output count
eOPLoc = 607B // Output pointer
eHLoc = 610B // Host address
etherReset = 3 // interface SIO command bits
etherInput = 2
etherOutput = 1
]
//----------------------------------------------------------------------------
let EventReport(event, length, dPort, tries, timeout; numargs na) = valof
//----------------------------------------------------------------------------
// event -- Pointer to vector of goodies describing event
// length -- Length of vector in words
// dPort -- Port to send event to (default ErrorLogAddress)
[
let p = VMFetch(VMFetch(176777b)+47b) //topStatics!47 in user space
let port = vec lenPort; for i = 0 to 2 do port!i = VMFetch(p+i)
DefaultArgs(lv na, -2, p, 5, 3*27)
if dPort>>Port.host eq 0 resultis false //logging disabled
InitNet()
let origTim = vec 2; ReadCalendar(origTim) //used as pup ID and socket
let sPort = vec lenPort; MoveBlock(lv sPort>>Port.socket, origTim, 2)
let pbi = vec lenPBI
for try = 1 to tries do
[
MoveBlock(lv pbi>>PBI.bytes, event, length)
SendPup(pbi, sPort, dPort, origTim, ptEventReport, length*2+pupOvBytes)
if ReceivePup(pbi, dPort, sPort, origTim, ptEventReply, timeout) then
resultis true
]
resultis false
]
//----------------------------------------------------------------------------
and CreateNVM(string) = valof
//----------------------------------------------------------------------------
[
InitNet()
let nvm = Allocate(sysZone, lenNVM); Zero(nvm, lenNVM)
nvm>>NVM.name = string
nvm>>NVM.type = vmTypeNet
SetFailPt(cnvm)
[
let s = vec 128
for i = 1 to string>>String.length-1 do
s>>String.char↑i = string>>String.char↑(i+1)
s>>String.length = string>>String.length -2
GetPartner(s, lv nvm>>NVM.frnPort, 0, socTeleSwat)
ReadCalendar(lv nvm>>NVM.lclPort.socket)
MoveBlock(cursorBitMap, teleSwatCursor, 16)
nvm>>NVM.fetch = NVMFetch
nvm>>NVM.store = NVMStore
nvm>>NVM.swap = NVMSwap
nvm>>NVM.cache = NVMCache
nvm>>NVM.print = NVMPrint
nvm>>NVM.destroy = NVMDestroy
UnSetFailPt()
resultis nvm
]
cnvm:
NVMDestroy(nvm)
Fail()
]
//----------------------------------------------------------------------------
and NVMDestroy(nvm) be
//----------------------------------------------------------------------------
[
NVMCache(nvm, vmFlushReset)
Free(sysZone, nvm>>NVM.name)
Free(sysZone, nvm)
]
//----------------------------------------------------------------------------
and NVMFetch(nvm, addr) = valof
//----------------------------------------------------------------------------
[
let nb = nvm>>NVM.nbQ.head; while nb ne 0 do
[
if Usc(addr-nb>>NB.firstAddr, nb>>NB.lenBlock) ls 0 then
[
Unqueue(lv nvm>>NVM.nbQ, nb)
Enqueue(lv nvm>>NVM.nbQ, nb)
nvm>>NVM.hits = nvm>>NVM.hits +1
resultis (lv nb>>NB.block)!(addr-nb>>NB.firstAddr)
]
nb = nb>>NB.link
]
let pbi = vec lenPBI
DoubleAdd(lv nvm>>NVM.id, table [ 0; 1 ])
[ // all you do is just:
pbi>>NBPBI.address = addr
pbi>>NBPBI.lenBlock = lenBlock
SendPup(pbi, lv nvm>>NVM.lclPort, lv nvm>>NVM.frnPort, lv nvm>>NVM.id,
ptSwatFetch, pupOvBytes+6)
if ReceivePup(pbi, lv nvm>>NVM.frnPort, lv nvm>>NVM.lclPort,lv nvm>>NVM.id,
ptSwatAck, 27) break
] repeat
if pbi>>PBI.length ge pupOvBytes+6 & pbi>>NBPBI.lenBlock ne 0 then
AddToNBCache(nvm, pbi, 0)
resultis pbi>>NBPBI.value
]
//----------------------------------------------------------------------------
and NVMStore(nvm, addr, val) be
//----------------------------------------------------------------------------
[
let nb = nvm>>NVM.nbQ.head; while nb ne 0 do // search the cache
[
if Usc(addr-nb>>NB.firstAddr, nb>>NB.lenBlock) ls 0 break
nb = nb>>NB.link
]
let pbi = vec lenPBI
DoubleAdd(lv nvm>>NVM.id, table [ 0; 1 ])
[
pbi>>NBPBI.address = addr
pbi>>NBPBI.value = val
pbi>>NBPBI.lenBlock = nb eq 0? lenBlock, 0
SendPup(pbi, lv nvm>>NVM.lclPort, lv nvm>>NVM.frnPort, lv nvm>>NVM.id,
ptSwatStore, pupOvBytes+6)
if ReceivePup(pbi, lv nvm>>NVM.frnPort, lv nvm>>NVM.lclPort,lv nvm>>NVM.id,
ptSwatAck, 27) break
] repeat
if nb ne 0 then //update the cache (it's write-through)
(lv nb>>NB.block)!(addr-nb>>NB.firstAddr) = val
if pbi>>PBI.length ge pupOvBytes+6 & pbi>>NBPBI.lenBlock ne 0 then
[
if nb ne 0 then Unqueue(lv nvm>>NVM.nbQ, nb)
AddToNBCache(nvm, pbi, nb)
]
]
//----------------------------------------------------------------------------
and NVMSwap(nvm) be
//----------------------------------------------------------------------------
[
NVMCache(nvm, vmFlushReset)
let pbi = vec lenPBI
DoubleAdd(lv nvm>>NVM.id, table [ 0; 1 ])
[
SendPup(pbi, lv nvm>>NVM.lclPort, lv nvm>>NVM.frnPort, lv nvm>>NVM.id,
ptSwatSwap, pupOvBytes)
if ReceivePup(pbi, lv nvm>>NVM.frnPort, lv nvm>>NVM.lclPort,lv nvm>>NVM.id,
ptSwatAck, 27) break
] repeat
DoubleAdd(lv nvm>>NVM.id, table [ 0; 1 ])
SendPup(pbi, lv nvm>>NVM.lclPort, lv nvm>>NVM.frnPort, lv nvm>>NVM.id,
ptSwatSwapReply, pupOvBytes)
]
//----------------------------------------------------------------------------
and NVMCache(nvm, action) be if (action & vmReset) ne 0 then
//----------------------------------------------------------------------------
while nvm>>NVM.nbQ.head ne 0 do Free(sysZone, Dequeue(lv nvm>>NVM.nbQ))
//----------------------------------------------------------------------------
and NVMPrint(nvm, stream) be
//----------------------------------------------------------------------------
[
PutTemplate(stream, ", hits: $UD misses: $UD*N*N",
nvm>>NVM.hits, nvm>>NVM.misses)
let nb = nvm>>NVM.nbQ.head; while nb ne 0 do
[
PutTemplate(stream, "[$UO...$UO]*N",
nb>>NB.firstAddr, nb>>NB.firstAddr+nb>>NB.lenBlock-1)
nb = nb>>NB.link
]
]
//----------------------------------------------------------------------------
and AddToNBCache(nvm, pbi, nb) be
//----------------------------------------------------------------------------
[
nvm>>NVM.misses = nvm>>NVM.misses +1
let lenBlock = pbi>>NBPBI.lenBlock
let nbQ = lv nvm>>NVM.nbQ
if nb ne 0 & nb>>NB.lenBlock ne lenBlock then
[ Free(sysZone, nb); nb = 0 ]
if nb eq 0 & QueueLength(nbQ) ls maxNBs then
nb = Allocate(sysZone, lenNBHeader+lenBlock, true)
if nb eq 0 then
[
nb = Dequeue(nbQ)
if nb>>NB.lenBlock ne lenBlock then
[ Free(sysZone, nb); nb = 0 ]
]
if nb eq 0 return
nb>>NB.firstAddr = pbi>>NBPBI.address & -lenBlock
nb>>NB.lenBlock = lenBlock
MoveBlock(lv nb>>NB.block, lv pbi>>NBPBI.block, lenBlock)
Enqueue(nbQ, nb)
]
//----------------------------------------------------------------------------
and TeleSwatServer() be
//----------------------------------------------------------------------------
[
InitNet()
MoveBlock(cursorBitMap, teleSwatCursor, 16)
let dally = 0
Ws("*N*TThis Swat is being remotely controlled*N")
Ws("*THit the <Swat> key to regain local control*N")
[ // repeat
let pbi = vec lenPBI
let length = pupOvBytes
let lclPort = table [ 0; 0; socTeleSwat ]
let inBytes = ReceivePup(pbi, 0, lclPort, 0, 0, 27)
if dally ne 0 & (dally - @realTimeClock) le 0 then
[ dally = 0; VMSwap(); loop ]
if inBytes eq 0 % pbi>>PBI.eDest eq 0 loop
unless pbi>>PBI.type eq ptSwatSwapReply do dally = 0
switchon pbi>>PBI.type into
[
case ptSwatFetch:
[
pbi>>NBPBI.value = VMFetch(pbi>>NBPBI.address)
length = length +4
endcase
]
case ptSwatStore:
[
VMStore(pbi>>NBPBI.address, pbi>>NBPBI.value)
endcase
]
case ptSwatSwap:
[
dally = @realTimeClock+5*27 // ~ 5 seconds
endcase
]
case ptSwatSwapReply:
[
if dally ne 0 then [ dally = 0; VMSwap() ]
loop
]
default: loop
]
let temp = vec lenPort
MoveBlock(temp, lv pbi>>PBI.sPort, lenPort)
MoveBlock(lv pbi>>PBI.sPort, lv pbi>>PBI.dPort, lenPort)
MoveBlock(lv pbi>>PBI.dPort, temp, lenPort)
if (pbi>>PBI.type eq ptSwatStore % pbi>>PBI.type eq ptSwatFetch) &
pbi>>PBI.length ge pupOvBytes+6 & pbi>>NBPBI.lenBlock ne 0 then
[
length = pupOvBytes + 6 + pbi>>NBPBI.lenBlock lshift 1
let vmBase = pbi>>NBPBI.address & -pbi>>NBPBI.lenBlock
let pbiBase = lv pbi>>NBPBI.block
for i = 0 to pbi>>NBPBI.lenBlock-1 do pbiBase!i = VMFetch(vmBase+i)
]
SendPup(pbi, 0, 0, 0, ptSwatAck, length)
] repeat
]
//----------------------------------------------------------------------------
and GetPartner(string, port, soc1, soc2; numargs na) be
//----------------------------------------------------------------------------
[
unless ParseAddressConst(string, port) do
[
let frnPort = table [ 0; 0; socMiscServices ]
let lclPort = vec lenPort; ReadCalendar(lv lclPort>>Port.socket)
let id = vec 1; ReadCalendar(id)
let pbi = vec lenPBI
let ok = false
for i = 1 to 5 do
[
for i = 1 to string>>String.length do
pbi>>PBI.bytes↑(i-1) = string>>String.char↑i
SendPup(pbi, lclPort, frnPort, id, ptNameRequest,
pupOvBytes+string>>String.length)
if ReceivePup(pbi, 0, lclPort, id, ptNameReply, 27) then
switchon pbi>>PBI.type into
[
case ptNameReply:
[
MoveBlock(port, lv pbi>>PBI.bytes, lenPort)
ok = true
break
]
case ptNameError:
[
for i = 0 to pbi>>PBI.length-pupOvBytes-1 do
Puts(dsp, pbi>>PBI.bytes↑i)
Fail()
]
]
]
unless ok do ReportFail("No name lookup server responded")
]
if port>>Port.socket↑1 eq 0 & port>>Port.socket↑2 eq 0 & na eq 4 then
[
port>>Port.socket↑1 = soc1
port>>Port.socket↑2 = soc2
]
]
//----------------------------------------------------------------------------
and ParseAddressConst(string, port) = valof
//----------------------------------------------------------------------------
// Parses a network address constant of the form
// net#host#soc and sets port accordingly
// Returns:
// true if string had correct syntax
// false otherwise
[
Zero(port, lenPort)
let c, len = 0, string>>String.length
[
let char = nil
[
c = c+1; if c gr len resultis true
char = string>>String.char↑c
] repeatwhile char eq $*s
while char ge $0 & char le $7 do
[
if (port>>Port.socket↑1 & #160000) ne 0 resultis false
port>>Port.socket↑1 = port>>Port.socket↑1 lshift 3 +
port>>Port.socket↑2 rshift 13
port>>Port.socket↑2 = port>>Port.socket↑2 lshift 3 + char-$0
c = c+1; if c gr len resultis true
char = string>>String.char↑c
]
while char eq $*s do
[
c = c+1; if c gr len resultis true
char = string>>String.char↑c
]
if char ne $# % port>>Port.net ne 0 % port>>Port.socket↑1 ne 0 %
(port>>Port.socket↑2 & #177400) ne 0 resultis false
port>>Port.net = port>>Port.host
port>>Port.host = port>>Port.socket↑2
port>>Port.socket↑1 = 0; port>>Port.socket↑2 = 0
] repeat
]
//----------------------------------------------------------------------------
and InitNet() = valof
//----------------------------------------------------------------------------
[
@eHLoc = StartIO(etherReset)
if @eHLoc & 77777b eq 0 then ReportFail("No Ethernet interface")
@eHLoc = @eHLoc & 377b
if @eHLoc eq 0 then ReportFail("Ethernet interface has no address")
Zero(ePLoc, 7)
if @eHLoc ne lclHost then lclNet = 0
lclHost = @eHLoc
teleSwatCursor = table [ 0; 73507b; 22104b; 23106b; 22104b; 23567b; 0; 0;
65227b; 105252b; 45252b; 25272b; 142452b; 0; 0; 0 ]
resultis true
]
//----------------------------------------------------------------------------
and SendPup(pbi, sPort, dPort, id, type, length) = valof
//----------------------------------------------------------------------------
// Assume data already in pbi.
// Returns true if packet seemed to go out OK.
[
unless InitNet() resultis false
if dPort ne 0 then MoveBlock(lv pbi>>PBI.dPort, dPort, lenPort)
if sPort ne 0 then MoveBlock(lv pbi>>PBI.sPort, sPort, lenPort)
if id ne 0 then MoveBlock(lv pbi>>PBI.id, id, 2)
for i = 0 to 15 do cursorBitMap!i = not cursorBitMap!i
let dNet = pbi>>PBI.dPort.net
test dNet eq 0 % dNet eq lclNet
ifso pbi>>PBI.eDest = pbi>>PBI.dPort.host
ifnot test dNet eq frnNet & gateHost ne 0
ifso pbi>>PBI.eDest = gateHost
ifnot
[
frnNet, gateHost = dNet, 0
let rPort = table [ 0; 0; socRouteInfo ]
SendPup(pbi, rPort, rPort, 0, ptRouteRequest, pupOvBytes)
resultis true //Liar! And you dirtied his packet too!
]
pbi>>PBI.eSrc = @eHLoc
pbi>>PBI.eType = etherPup // I'm a Pup in an Ether packet
pbi>>PBI.length = length
pbi>>PBI.transport = 0
pbi>>PBI.type = type
pbi>>PBI.sPort.net = lclNet
pbi>>PBI.sPort.host = @eHLoc
pbi!((length+3) rshift 1) = -1 // No checksum
@eOCLoc = (length+5) rshift 1 //Pup bytes + Ethernet encapsulation
@eOPLoc = pbi
@ePLoc = 0
StartIO(etherOutput) // Turn on transmitter
for i = 1 to 30000 if @ePLoc ne 0 break
let status = @ePLoc
StartIO(etherReset) // Reset interface
resultis status eq 777b // 777b is good xmtr status
]
//----------------------------------------------------------------------------
and ReceivePup(pbi, sPort, dPort, id, type, timeout) = valof
//----------------------------------------------------------------------------
// Filter by sockets, id, and type.
// Returns pup length or 0 if timeout.
[
unless InitNet() resultis false
let tim = @realTimeClock + timeout
[
@eICLoc = lenPBI
@eIPLoc = pbi
@ePLoc = 0
StartIO(etherInput) // Turn on receiver
while @ePLoc eq 0 & (tim - @realTimeClock) gr 0 do Idle()
let lastEPLoc = @ePLoc
let lastEELoc = @eELoc
StartIO(etherReset) // Reset interface
if lastEPLoc eq 0 resultis 0 // timeout
// reject obviously bad packets
if (@eICLoc-lastEELoc) ne (pbi>>PBI.length+5) rshift 1 %
lastEPLoc ne 377b % pbi>>PBI.eType ne etherPup % pbi>>PBI.eSrc eq 0 loop
if EqV(lv pbi>>PBI.dPort.socket, table [ 0; socRouteInfo ], 2) &
pbi>>PBI.type eq ptRouteReply then
[ // sort of a 'built-in' socket...
lclNet = pbi>>PBI.dPort.net
for i = 0 to (pbi>>PBI.length-pupOvBytes)/lenRTE do
if pbi>>RTPBI.rte↑i.dNet eq frnNet then
[ gateHost = pbi>>PBI.sPort.host; break ]
loop
]
if (type eq 0? true, pbi>>PBI.type eq type) &
EqV(lv pbi>>PBI.sPort.socket, lv sPort>>Port.socket, 2) &
EqV(lv pbi>>PBI.dPort.socket, lv dPort>>Port.socket, 2) &
EqV(lv pbi>>PBI.id, id, 2) resultis pbi>>PBI.length
] repeat // Until good Pup received or timeout
]
//----------------------------------------------------------------------------
and EqV(a, b, len) = valof
//----------------------------------------------------------------------------
[
if (b & 177770B) eq 0 resultis true // Don't compare
for i = 0 to len-1 do if a!i ne b!i resultis false
resultis true
]