// PupSubrs.bcpl.  The Interlisp-D Pup package
// Last change October 12, 1981  11:30 PM by Bill van Melle
// Last change August 3, 1981  3:54 AM by Beau Sheil
// Last change July 20, 1981  10:28 PM by Beau Sheil
// Last change July 13, 1981  12:44 AM by Beau Sheil
// Last change March 16, 1981  12:28 PM by Beau Sheil
// Last change February 13, 1981  6:24 PM by Beau Sheil

// 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 "Pup0.decl"
	get "Pup1.decl"

external [		// procedures defined
	OPENSOCKET		// Subr: () -> socket
	READPUP			// Subr: (soc, head, buf, lim) -> ?
	WRITEPUP		// Subr: (soc, head, buf)
	CLOSESOCKET		// Subr: (soc)

	OpenSoc; CloseSoc; StartPup

		// procedures used
	MkSmallPos; EqNIL; @XGetBase		// other Lisp externals
	MoveWords; SmallUnbox; EmAddr; RAIDCode 
	Enqueue; Dequeue; Block; Min	// OS procs
	InitializeZone; Allocate; Free; Zero; InitializeContext
		// statics used
	@ContextQ; maxPupDataBytes; @lvNIL; @lvKT

	OpenLevel1Socket; InitPupLevel1; CompletePup	// Pup stuff
	socketQ; GetPBI; CloseLevel1Socket; ReleasePBI
 	]

manifest [ pupHdrWords = pupOvWords-1	// Size of pup header in words
	 ]

static   [ PupZone			// zone for pup allocations
	   XtraQ			// queue of "extra" output PBIs
	   XUses = 0			// how many xtras are used
	 ]

let OPENSOCKET(hi, lo) = MkSmallPos(OpenSoc(SmallUnbox(hi), SmallUnbox(lo)))

and OpenSoc(hi, lo) = valof		// OpenSoc split out for Raid
  [ let s = Allocate(PupZone, lenPupSoc)
    let lclPort = vec lenPort
    Zero(lclPort, lenPort)
    lclPort>>Port.socket↑1=hi
    lclPort>>Port.socket↑2=lo
    OpenLevel1Socket(s, lclPort)
    resultis s
  ]

and READPUP(soc, head, buf, lim; numargs na) = valof
  [ let s = Socket(soc)
    unless s resultis lvNIL
    let pb = Dequeue(lv s>>PupSoc.iQ)
    unless pb do resultis lvNIL
    let pup = lv pb>>PBI.pup
    let n = (pup>>Pup.length+1) rshift 1
    test (na ls 3) % EqNIL(buf)
	ifso [	// contiguous pup
		MoveWords(EmAddr(pup), head, n)
	     ]
	ifnot [	// old style, two pieces
		MoveWords(EmAddr(pup), head, pupHdrWords)
		n = Min(n - pupOvWords, SmallUnbox(lim))
		MoveWords(EmAddr(lv pup>>Pup.words↑1), buf, n)
	      ]
    ReleasePBI(pb)
    resultis MkSmallPos(n)
  ]

and WRITEPUP(soc, head, buf; numargs na) = valof
  [ let s = Socket(soc)
    unless s resultis lvNIL
    let nwords = (XGetBase(head) + 1) rshift 1
				// first word of pup (head) is byte len
    if nwords gr (pupOvWords+(maxPupDataBytes rshift 1))
	then resultis RAIDCode ("Pup too long", head)
    let pb = nil		// get a PBI to transmit this
    [
    pb = GetPBI(s, true)		// return if none left
    test pb
	ifso break
	ifnot [ pb = GetExtraPBI(s)
		test pb ifso break ifnot Block() ]
    ] repeat
    let pup = lv pb>>PBI.pup
    test (na ls 3) % EqNIL(buf)
	ifso [	// contiguous pup
		MoveWords(head, EmAddr(pup), nwords)
	     ]
	ifnot [	// old style, two pieces
		MoveWords(head, EmAddr(pup), pupHdrWords)
		MoveWords(buf, EmAddr(lv pup>>Pup.words↑1), nwords-pupHdrWords)
	      ]
    test SocHeadChk(s, pb)
	ifso  [ CompletePup(pb); resultis lvKT ]
	ifnot [ ReleasePBI (pb); resultis lvNIL]
  ]

and CLOSESOCKET(soc) = valof [ CloseSoc(Socket(soc)); resultis lvNIL ]

and CloseSoc(s) be [ CloseLevel1Socket(s); Free(PupZone, s) ]

and StartPup(zone, zoneLength) be
  [ PupZone = InitializeZone(zone, zoneLength)
    InitPupLevel1(PupZone, ContextQ, 22)
    XtraQ = Allocate(PupZone, 2)
    Zero(XtraQ, 2)	// extra output pbis
    let lPBI = (pupOvBytes+maxPupDataBytes)/2 + lenPBIOverhead
    for i=1 to 3 do Enqueue(XtraQ, Allocate(PupZone, lPBI))
  ]

and Socket(soc) = valof
  [ let t = SmallUnbox(soc)
    let s = socketQ
    [ s = s>>PupSoc.link
      if s eq t then resultis t ] repeatwhile s
    RAIDCode("Not an open socket", soc)
    resultis false
  ]

and SocHeadChk(s, pb) = valof
  [ let bs  = lv s>>PupSoc.lclPort	// Socket's local port spec
    let bpb = lv pb>>PBI.pup.sPort	// local port of pup
    for i=(offset Port.socket/16) to lenPort-1	// skip over poss. 0 net addr
     do unless bs!i eq bpb!i
        do [ ReleasePBI(pb)
             resultis RAIDCode("Socket/header mismatch for socket", MkSmallPos(s))
	   ]
    resultis true
  ]

and GetExtraPBI(soc) = valof		// from a secret stash, for output
  [ let pb = Dequeue(XtraQ)
    if pb then [ Zero(pb, lenPBIOverhead+pupOvWords)	// clear header
                 pb>>PBI.socket = soc
                 pb>>PBI.queue = XtraQ			// so it comes back
                 XUses = XUses + 1			// count it
               ]
    resultis pb
  ]