// PupSubrs.bcpl.  The Interlisp-D Pup package
// Last change July 20, 1983  2:53 PM by Bill van Melle
// Last change June 7, 1983  12:15 PM by Bill van Melle
// Last change March 14, 1983  5:27 PM by Bill van Melle
// Last change February 11, 1983  11:39 AM by Bill van Melle
// Last change August 9, 1982  9:29 PM by Bill van Melle
// Raw packet addition May 19, 1982  2:34 PM by Bill van Melle

// This file contains Pup subrs called from Lisp. It also has the entry
// which starts up the pup package and enqueue its contexts onto ContextQ

	get "LispBcpl.decl"
	get "Pup0.decl"
	get "Pup1.decl"
	get "PupAlEth.decl"

external [		// procedures defined
	GETPACKETBUFFER
	READRAWPBI
	WRITERAWPBI
	PUPLEVEL1STATE

	XMoveWords		// dumb MoveWords
	DeImplementedSubr

	StartPup		// called from init only

				// Lisp procedures used
	EqNIL; @XGetBase; IPutBase; Serial
	EmAddr; EmUnbox; RAIDCode 
	@XSetReadBR; @XSetWriteBR; @RRead; @RWrite
				// Lisp statics used
	@ContextQ; @lvNIL; @lvKT

				// OS Procedures
	Enqueue; Dequeue; Block; Min; CallSwat; TruePredicate
	InitializeZone; Allocate; Free; Zero; InitializeContext
	DisableInterrupts; EnableInterrupts; CauseInterrupt
	TimerHasExpired; StartIO
				// pup level 1 functions
	OpenLevel1Socket; InitPupLevel1
	CloseLevel1Socket; ReleasePBI
				// pup level 0 functions
	SendEtherPacket
				// pup package statics
 	socketQ; lenPBI; lenPup; maxPupDataBytes
	pbiFreeQ; ndbQ; pbiTQ; pbiIQ
]

manifest [
	psRoutingInfo = 2
	 ]

static	[
	HaveEther = false		// true if Ethernet alive on machine
	PupZone				// zone for pup allocations
	XtraQ				// queue of "extra" output PBIs
	XUses = 0			// how many xtras have been used
	numPBIs				// how many pbi's we allocated

					// stuff for raw packet
	pupRawState = true		// true if not running pup level 1
	rawPbiIQ			// input queue of raw packets
	localNDB			// ndb for local net
	]

structure Queue:
	[
	head word
	tail word
	]

static [
	lastPBI = 0
	]

let DeImplementedSubr() = RAIDCode("Subr not implemented", lvNIL)

and StartPup(zone, zoneLength) be
  [ test Serial() ls #377
      ifso [
	PupZone = InitializeZone(zone, zoneLength, PupOutOfSpace)
	numPBIs = 20
	let maxbytes = 568
// longer for NS packets: 546 data bytes plus a header that is 6 words longer,
// plus encapsulation that is 5 words longer

	InitPupLevel1(PupZone, ContextQ, numPBIs, maxbytes)
	let s = socketQ
	[
	s = s>>PupSoc.link
	if s>>PupSoc.lclPort.socket^1 eq 0 &
	   s>>PupSoc.lclPort.socket^2 eq psRoutingInfo
	   then [	// knock router's allocation in half or so to
			// avoid getting clogged when Bcpl runs little
		let half = (s>>PupSoc.numIPBI rshift 1)+(s>>PupSoc.numIPBI rshift 2)
		s>>PupSoc.iAll = s>>PupSoc.iAll - (half lshift 8 + half)
		break
		]
	 ] repeatwhile s
	XtraQ = Allocate(PupZone, 2)
	Zero(XtraQ, 2)	// extra output pbis
	for i = 1 to 3 do Enqueue(XtraQ, Allocate(PupZone, lenPBI))
	HaveEther = true
	StartRawPup()
	]
     ifnot [		// no ether, give this to Lisp
	HaveEther = false
	IPutBase(IFPMDSZone, zone)
	IPutBase(IFPMDSZoneLength, zoneLength)
	]
  ]

and PupOutOfSpace() be
  [ RAIDCode("Pup level 1 out of space.  Probably too many sockets open", lvNIL) ] repeat

and StartRawPup()  = valof
  [
  localNDB = ndbQ>>Queue.head			// assume only one
  if ndbQ>>Queue.tail ne localNDB
     then CallSwat ("More than one NDB")
  rawPbiIQ = Allocate(PupZone, 2+lenPF)		// queue to stash input on
  Zero(rawPbiIQ, 2)				// initially empty
  let rawPF = rawPbiIQ+2
  rawPF>>PF.predicate = TruePredicate
  rawPF>>PF.queue = rawPbiIQ
  Enqueue(lv localNDB>>NDB.pfQ, rawPF)		// add a filter for non-pups
  (lv localNDB>>NDB.pupPF)>>PF.queue = rawPbiIQ
  pupRawState = true
  resultis lvNIL
  ]

and XMoveWords(src, dst, n) be
  [			// Move n words between two virtual addresses
  XSetReadBR(src)
  XSetWriteBR(dst)
  for i = 0 to n-1
    do RWrite(i, RRead(i))
  ]

and GETPACKETBUFFER() = valof
  [
  unless HaveEther do resultis lvNIL
  if lastPBI
     then [ ReleasePBI(lastPBI); lastPBI = 0 ]
  let pb = Dequeue(pbiFreeQ)
  test pb
    ifso [
	Zero(pb, lenPBIOverhead)
	pb>>PBI.queue = pbiFreeQ
	 ]
    ifnot [ pb = Dequeue(XtraQ)
	    test pb
		ifso [
		     Zero(pb, lenPBIOverhead)	// clear header
		     pb>>PBI.queue = XtraQ	// so it comes back
		     XUses = XUses + 1		// count it
		     ]
	   	ifnot [
// (2) if the interface is transmitting and has timed out, reset it
//     and fake a load overflow indication to unhang the software.
			if localNDB>>EtherNDB.eOB ne 0 &
			   TimerHasExpired(lv localNDB>>EtherNDB.tTimer)
			   then UnWedgeEther()
		     resultis lvNIL
		     ]
	 ]
  pb>>PBI.socket = 0			// charge to no socket
  lastPBI = pb
  resultis EmAddr(pb)
  ]

and UnWedgeEther() be
  [
  DisableInterrupts()
  StartIO(localNDB>>EtherNDB.resetCmd)		// causes pending interrupt
  @(localNDB>>EtherNDB.ePLoc) = 3 lshift 8	// fake a load overflow
  EnableInterrupts()
  ]

and WRITERAWPBI (pbi) = valof
  [
  unless HaveEther do resultis lvNIL
  let pb = EmUnbox(pbi)
  if lastPBI
     then [ if pb ne lastPBI
	       then ReleasePBI(lastPBI)
	  lastPBI = 0 ]
  pb>>PBI.socket = 0	// no socket associated
  pb>>PBI.ndb = localNDB
  pb>>PBI.status = 0
  SendEtherPacket (pb)
  resultis pbi
  ]

and READRAWPBI () = valof
  [
  unless HaveEther do resultis lvNIL
  if lastPBI
     then [ ReleasePBI(lastPBI); lastPBI = 0 ]
  let pbi = Dequeue (rawPbiIQ)			// get pbi from input q
  if pbi eq 0
     then [		// nothing has arrived.  Make sure interface not dead
	  if localNDB>>EtherNDB.eState eq 0 & pbiFreeQ!0 ne 0
	     then [ @(localNDB>>EtherNDB.ePLoc) = 0
		    CauseInterrupt(localNDB>>EtherNDB.mask) ]
	  resultis lvNIL
	  ]
  pbi>>PBI.queue = pbiFreeQ
  pbi>>PBI.socket = 0
  lastPBI = pbi
  resultis EmAddr(pbi)
  ]

and PUPLEVEL1STATE(flg) = valof
  [
  unless EqNIL(flg) do DeImplementedSubr()
  (lv localNDB>>NDB.pupPF)>>PF.queue = rawPbiIQ
  pupRawState = true
  resultis lvNIL
  ]