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