// PupERPUser.bcpl -- Report events in common format to logging host.
// Copyright Xerox Corporation 1979
// Last modified November 27, 1978 3:43 PM by Boggs
// This source file is intended to be self-contained (not requiring
// any declarations files) -- hence if Pup definitions change, this
// file will need to be changed as well.
external
[
// outgoing procedures
EventReport
// incoming procedures
DefaultArgs
ReadCalendar; StartIO; MoveBlock
// incoming statics
ErrorLogAddress
]
// Standard Pup definitions:
structure Port:
[
net byte
host byte
socket word 2
]
manifest lenPort = size Port/16
structure EtherPup:
[
eDest byte
eSrc byte
eType word // 1000B => Pup
// the Pup begins here, stuff above is Ethernet encapsulation
length word // Bytes of pup contents
transport byte
type byte
id word 2
dPort: @Port
sPort: @Port
contents word 100
checksum word // position varies -- follows contents
]
manifest
[
pupOvBytes = 22 // Pup header overhead
pupOvWords = pupOvBytes rshift 1
ptEventReport = 240B // Event Report
ptEventReply = 241B // Event Report Reply
ptRouteRequest = 200B // Routing table info request
ptRouteReply = 201B
socketRouteInfo = 2 // Well known socket
RTC = 430B // Real Time Clock
// Ether definitions
etherPup = 1000B // Ethernet type = Pup
etherOvWords = 2 // Ether encapsulation overhead
ePLoc = 600B // Post location
eBLoc = 601B // Interrupts
eLLoc = 603B // Load location
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 TestEvent() be
//----------------------------------------------------------------------------
[
external Ws
let v = vec 10; v!0 = -1; v!1 = 2
Ws(EventReport(v, 2)? "succeeded", "failed")
]
//----------------------------------------------------------------------------
and EventReport(eventV, eventVLength, eventPort, retryCount,
timeOut; numargs na) = valof
//----------------------------------------------------------------------------
// eventV -- Pointer to vector of goodies describing event
// eventLength -- Length of vector in words (default 0)
// eventPort -- Port to send event to (default ErrorLogAddress)
[
DefaultArgs(lv na, -1, 0, ErrorLogAddress, 3, 3*27)
@eBLoc = 0 // No interrupts please
let t = StartIO(etherReset) // Get host addr & reset interface
if (t & 77777B) eq 77777B resultis false // No Ethernet interface!
@eHLoc = t & 377B // Our host address
if @eHLoc eq 0 resultis false // no host address (missing backplane jumpers)
let buf = vec 300 // Packets live here
let origTim = vec 2; ReadCalendar(origTim)
// Source port
let sPort = vec lenPort
sPort>>Port.net = 0
sPort>>Port.host = @eHLoc
MoveBlock(lv sPort>>Port.socket, origTim, 2)
let pdh = eventPort>>Port.host // Physical Destination Host
if pdh eq 0 resultis false // Don't broadcast!
for try = 1 to retryCount do
[
// If we don't know our network, get some routing info
if sPort>>Port.net eq 0 then
[
let routePort = table [ 0; 0; socketRouteInfo ]
unless SendPup(buf, routePort, routePort, origTim,
ptRouteRequest, 0, 0) resultis false // Transmission failed
let r = ReceivePup(buf, routePort, routePort, 0, ptRouteReply, timeOut)
while r gr 0 do // Examine the routing info reply
[
r = r-2
let p = (lv buf>>EtherPup.contents) + r
let net = buf>>EtherPup.dPort.net
sPort>>Port.net = net
let rNet = eventPort>>Port.net
if rNet ne net & ((p!0) rshift 8) eq eventPort>>Port.net then
pdh = buf>>EtherPup.eSrc
]
]
// Send the event report
MoveBlock(lv buf>>EtherPup.contents, eventV, eventVLength)
unless SendPup(buf, sPort, eventPort, origTim, ptEventReport,
eventVLength, pdh) resultis false // Transmission failed
// Wait for the acknowledgement
let r = ReceivePup(buf, eventPort, sPort, origTim, ptEventReply, timeOut)
if r ge 0 resultis true
]
resultis false
]
//----------------------------------------------------------------------------
and SendPup(buf, sPort, dPort, id, pupType, wordLength, dest) = valof
//----------------------------------------------------------------------------
// Assume data already in buf.
// Returns true if packet sent OK.
[
buf>>EtherPup.eDest = dest
buf>>EtherPup.eSrc = @eHLoc
buf>>EtherPup.eType = etherPup // I'm a Pup in an Ether packet
buf>>EtherPup.length = wordLength*2 + pupOvBytes
buf>>EtherPup.transport = 0
buf>>EtherPup.type = pupType
MoveBlock(lv buf>>EtherPup.id, id, 2)
MoveBlock(lv buf>>EtherPup.dPort, dPort, lenPort)
MoveBlock(lv buf>>EtherPup.sPort, sPort, lenPort)
buf>>EtherPup.sPort.host = @eHLoc
(lv buf>>EtherPup.contents)!wordLength = -1 // No checksum
StartIO(etherReset) // Reset interface
@eOCLoc = wordLength + pupOvWords + etherOvWords
@eOPLoc = buf
@eLLoc = 0
@ePLoc = 0
StartIO(etherOutput) // Turn on transmitter
for i = 1 to 30000 do if @ePLoc ne 0 break
resultis @ePLoc ne 0
]
//----------------------------------------------------------------------------
and ReceivePup(buf, sPort, dPort, id, pupType, timeOut) = valof
//----------------------------------------------------------------------------
// Filter by sockets, id, and type.
// Return length in words of data.
// Return -1 if no Pup received within specified time.
[
let tim = @RTC + timeOut
[
StartIO(etherReset) // Reset interface
@ePLoc = 0
@eICLoc = 299
@eIPLoc = buf
StartIO(etherInput) // Turn on receiver
while @ePLoc eq 0 & tim - @RTC gr 0 loop
let status = @ePLoc
StartIO(etherReset) // Reset interface
if status eq 0 resultis -1 // timeout
if status eq #377 & // good rcvr status
buf>>EtherPup.eType eq etherPup &
buf>>EtherPup.eDest eq @eHLoc & // Discards broadcasts
EqV(lv buf>>EtherPup.sPort.socket, lv sPort>>Port.socket, 2) &
EqV(lv buf>>EtherPup.dPort.socket, lv dPort>>Port.socket, 2) &
EqV(lv buf>>EtherPup.id, id, 2) &
buf>>EtherPup.type eq pupType then
resultis (buf>>EtherPup.length-22+1) rshift 1
] 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
]