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