;<PUP>PUPSEQ.MAC.50, 15-Dec-82 12:50:09, Edit by SCHOEN
; Open server socket in 8-bit mode (for MEIS people)
;<PUP>PUPSEQ.MAC.49,  2-Nov-82 20:44:38, Edit by SCHOEN
; Don't crash the server if PUPO fails at SNDPP1
;<PUP>PUPSEQ.MAC.48, 26-Oct-82 16:46:42, Edit by SCHOEN
; Zero PUPFSK(CX) if connection can't be created at RNTS4C.  Check for 
; non-zero CONTAB(CX) before declaring a connection found at RNTS4F
;<PUP>PUPSEQ.MAC.45, 19-Oct-82 09:52:36, Edit by SCHOEN
; Try to create server fork before assigning buffers
; Start server fork only after all buffers have been assigned
; Forget about LFINIT table
; Clear sequin block before making fork
; Destroy timed out connections which are not logged in
;<SCHOEN.LEAF>PUPSEQ.MAC.3, 31-Jul-82 12:06:11, Edit by SCHOEN
; Catch PMAP failure in MAKFRK
;<PUP>PUPSEQ.MAC.35, 29-Jun-82 21:17:01, Edit by SCHOEN
; Destroy timed out connections which had been dallying
;<PUP>PUPSEQ.MAC.34, 10-Jun-82 12:31:54, Edit by SCHOEN
; Let OS do unmapping of a fork's pages in KILLFK
;<PUP>PUPSEQ.MAC.33, 15-May-82 19:37:13, Edit by SCHOEN
; Zero last locker BEFORE freeing lock in UNLOCK
;<PUP>PUPSEQ.MAC.28, 27-Apr-82 22:35:26, Edit by SCHOEN
; Don't resignal server fork on receipt of duplicate packet
; Make sure LEAFFK is handled as two half-words
; One more time -- filter out non-sequins at RNTSV4
; Rework queues; dispense with PP queue
; SENSEQ sends data immediately, then queues it for retransmission on TX queue
; Clean up RELSEQ (correct some 8-bit arithmetic)
; Don't empty TX queue at BNTSV2
; Replace SNDQ with SNDPUP
; Don't gratuitously send contents of TX queue at BNTSRV
;<PUP>PUPSEQ.MAC.22, 25-Apr-82 15:00:43, Edit by SCHOEN
; Go NOINT in SNDQ
; Lock BNTLCK only while in SNDQ
; Check for non-sequin packets at beginning of HDLSEQ (not HDLSQ3)
;<PUP>PUPSEQ.MAC.21, 23-Apr-82 12:07:02, Edit by SCHOEN
; Unlock queue lock words if dismissed waiting for queue to empty
;<PUP>PUPSEQ.MAC.20, 16-Apr-82 14:02:26, Edit by SCHOEN
; Improve handling of SEQOUT
; Remove routine to wait for lower fork init (doesn't work well on Tops-20)
; Instead, call SGLEAF when dropping duplicate packets
;<PUP>PUPSEQ.MAC.18, 11-Apr-82 22:32:42, Edit by SCHOEN
; Add routine to wait for server fork to initialize
;<PUP>PUPSEQ.MAC.17, 11-Apr-82 21:42:50, Edit by SCHOEN
; Make some tables global
;<PUP>PUPSEQ.MAC.16, 11-Apr-82 21:23:16, Edit by SCHOEN
; Log non-sequin pups being discarded at HDLSQ3
;<PUP-TEMP>PUPSEQ.MAC.15, 11-Apr-82 00:34:05, Edit by SCHOEN
; Remove extraneous POP P,(P) from fail returns in SEQINI
;<PUP>PUPSEQ.MAC.14, 10-Apr-82 23:29:32, Edit by SCHOEN
; Stop treating SEQOUT as halfword -- count user's outstanding packets only
;<PUP>PUPSEQ.MAC.13, 10-Apr-82 20:51:28, Edit by SCHOEN
; PSQVAR, PSQPVR -> TOPVAR, TOPPVR so PUPUUO loads correctly
;<PUP>PUPSEQ.MAC.11,  6-Apr-82 12:39:22, Edit by SCHOEN
; Send SequinBroken on receipt of data Sequin for nonexistent connection
; Send SequinBroken when no free Sequins remain
; No longer timestamp buffers
; When freeing locks, make the last locker impossible.
;<PUP>PUPSEQ.MAC.8,  2-Apr-82 23:23:02, Edit by SCHOEN
; HDLSEQ checks that received packets are Sequins
;<PUP>PUPSEQ.MAC.3,  1-Apr-82 12:31:16, Edit by SCHOEN
; Don't search SYSDEF; LEAFSV.CCL includes SYS10X or SYST20 along
; with PUPDEF in compilation
;<PUP>PUPSEQ.MAC.2, 31-Mar-82 15:56:50, Edit by SCHOEN
; Shared variables via the GS macro defined in PUPDEF, rather than
; by local SHRVAR mechanism's TS macro
;<SCHOEN>PUPSEQ.MAC.71,  5-Mar-82 13:11:05, Edit by SCHOEN
; Log Sequin brokens (not DTYPE), zero CONTAB(CX) after connection has
; been cleaned up, not before!
;<SCHOEN>PUPSEQ.MAC.70, 26-Feb-82 08:49:38, Edit by SCHOEN
; Append log entry when killing connection due to timeout
;<SCHOEN>PUPSEQ.MAC.68,  3-Feb-82 20:31:04, Edit by SCHOEN
; Make MAPDAT map from file to core, rather than vs.
;<SCHOEN>PUPSEQ.MAC.64,  3-Feb-82 14:02:25, Edit by SCHOEN
; Clean stack correctly at SNDQ1 when there's no room to send
;<SCHOEN>PUPSEQ.MAC.63,  1-Feb-82 16:13:08, Edit by SCHOEN
; Make MAPDAT global (for PSVLEF routines), always map to <SYSTEM>
;<SCHOEN>PUPSEQ.MAC.61, 21-Jan-82 13:33:40, Edit by SCHOEN
; Keep track of number of active connections, do nothing when there
; are no active connections.
;<SCHOEN>PUPSEQ.MAC.60,  9-Jan-82 21:58:34, Edit by SCHOEN
; Make sure server is enabled when it starts
;<SCHOEN>PUPSEQ.MAC.59,  3-Jan-82 14:37:33, Edit by SCHOEN
; Do correct test in KILLFK on fork handle
;<SCHOEN>PUPSEQ.MAC.57,  3-Jan-82 13:55:48, Edit by SCHOEN
; Index off the correct AC to get fork handle in KILLFK
;<SCHOEN>PUPSEQ.MAC.55,  3-Jan-82 13:18:30, Edit by SCHOEN
; Kill dead connections from top fork only (fork handles are top fork relative)
;<SCHOEN>PUPSEQ.MAC.54,  2-Jan-82 13:36:48, Edit by SCHOEN
; [Tops-20] Don't call MAPDAT
;<SCHOEN>PUPSEQ.MAC.53, 15-Dec-81 10:48:41, Edit by SCHOEN
; Move responsibility for cleaning up a destroyed Sequin to BNTSV2 from 
; RNTSV2 (race condition)
;<SCHOEN>PUPSEQ.MAC.50, 11-Dec-81 14:59:11, Edit by SCHOEN
; Send packet if no allocation at receiver iff packet contains no data
; Change Sequin state to BROKen after sending a SequinBroken
; Map data pages to LEAFSV.PMAP;1;P770000 
;<SCHOEN>PUPSEQ.MAC.48, 11-Dec-81 11:27:38, Edit by SCHOEN
; make sure server is enabled to OPENF socket 43!A (for restarts)
;<SCHOEN>PUPSEQ.MAC.47,  8-Dec-81 14:02:59, Edit by SCHOEN
; More fixes to 8-bit arithmetic (had 0-377 working, but not 377-0)
;<SCHOEN>PUPSEQ.MAC.45,  7-Dec-81 17:11:09, Edit by SCHOEN
; Timestamp buffers when they're filled (for debugging info)
;<SCHOEN>PUPSEQ.MAC.42,  5-Dec-81 15:45:04, Edit by SYSTEM
; Fix 8-bit arithmetic simulations in sequence filter
;<SCHOEN>PUPSEQ.MAC.33,  4-Dec-81 22:53:10, Edit by SCHOEN
; Make BNTSRV lock shared, create locks for RX, TX, and PP queues
;<SCHOEN>PUPSEQ.MAC.31, 19-Nov-81 23:47:20, Edit by SCHOEN
; Log source of Sequin connections
;<SCHOEN>PUPSEQ.MAC.29,  6-Nov-81 16:53:14, Edit by SCHOEN
; LOG crashes
; Don't enable server forks, disable after opening socket 43!A.
;<SCHOEN>PUPSEQ.MAC.20, 23-Sep-81 10:16:20, Edit by SCHOEN
; Mere mortals get user relative socket 43 if they try to start the...
; ...server

	title	pupseq
	subttl	Sequin protocol implementation for Tenex
	search	pupdef,psqdef
	usevar	topvar,toppvr,pshvar,pshpvr


tenex,<	search stenex >
tops20,<search monsym>

;	Eric Schoen
;	SUMEX Computer Project
;	Stanford University Medical Center
;	Stanford, CA.
;	August, 1981

;	Work on Leaf and Sequin implementations in Tenex
;	and Tops-20 was funded by NIH Biotechnology Resouces 
;	Program under grant RR-00785

; format of a packet buffer
pblink==:0			; link word: previous,,next buffer
pbstat==:1			; auxiliary word

; byte pointers into Sequin packet, indexed by PB
pbhead==:2
pupLen::point 16,pbhead(pb),15	; Pup length, bytes
pupTCB::point 8,pbhead(pb),23	; Pup Transport Control Byte
PupTyp::point 8,pbhead(pb),31	; Pup Type

; pbhead+1 (normally the Pup ID field)
SeqAlc::point 8,pbhead+1(pb),7	; Sequin Allocation byte
SeqRec::point 8,pbhead+1(pb),15	; Sequin Receive sequence
SeqCon::point 8,pbhead+1(pb),23	; Sequin control byte
SeqSen::point 8,pbhead+1(pb),31	; Sequin Send sequence

; pbhead+2
ppupdn::point 8,pbhead+2(pb),7	; Pup Destination net
ppupdh::point 8,pbhead+2(pb),15	; Pup Destination host
ppupd0::point 16,pbhead+2(pb),31; Pup Destination socket high

; pbhead+3
ppupd1::point 16,pbhead+3(pb),15; Pup Destination socket low
ppupsn::point 8,pbhead+3(pb),23	; Pup Source net
ppupsh::point 8,pbhead+3(pb),31	; Pup Source host

; pbhead+4
ppupss::point 32,pbhead+4(pb),31; Pup Source socket

; pbhead+5
pbcont==pbhead+5

.noint::push p,a
	tlne f,(debugf)
	 jrst [move a,-1(p)
	       soj a,
	       movem a,.nocal	; save caller
	       movei a,400000
	       skipl intdef
		jrst .+1
	       skpir
		jrst [type <INTDEF = -1 but interrupts OFF!%/>
		      jrst .+1]
	       jrst .+1]
	movei a,400000
	aosg intdef
	 dir
	pop p,a
	popj p,

.okint::push p,a
	tlne f,(debugf)
	 jrst [move a,-1(p)
	       soj a,
	       movem a,.okcal	; save caller address
	       movei a,400000
	       skipge intdef
		jrst [type <Call to .OKINT with INTDEF = -1%/>
		      jrst .+1]
	       skpir
		jrst .+1
	       type <Call to .OKINT with INTDEF .ge. 0 and interrupts ON!%/>
	       jrst .+1]
	movei a,400000
	sosge intdef
	 eir	
	pop p,a
	popj p,

ls intdef,1			; interrupts on flag word
				; -1 means interrupts on
ls .nocal,1			; last caller of .NOINT
ls .okcal,1			; last caller of .OKINT
	subttl	Sequin Initialization

; Initialize Sequin connection management
; This routine should be called by the first user of the
; Sequin package.  Its job to is set up connection tables
; for the Sequin connections which follow.

; call: pushj p,seqini
;	a/ 0 to for sequin user, -1 for sequin server
; returns: +1, always

seqini::movem a,server
	setzm contab
	move a,[contab,,contab+1]
	blt a,contab+nconn-1
	setom bntlck		; make the background process lock free
	setzm bntlkr		; make the last locker be nonexistent
	movei a,pupbuf
	movem a,frepnt		; set up free space management
	movei a,freque		; assign the queues
	movei c,npupbf*3
	skipge server		; are we a server?
	 movei c,npupbf*nconn*3	; yes, assign queues for everyone
	pushj p,mqueue
	skipl server		; are we a server?
	 popj p,		; no, return here
	movei a,400000
	rpcap
	move c,b		; enable what we've got
	epcap
ifn ft10x,<
	hrroi b,[asciz/PUP:43!A./]
>
ifn ft20,<
	hrroi b,[asciz/PUP:43!A./]
>
	trnn c,1b18!1b19	; wheel or operator?
ifn ft10x,<
	 hrroi b,[asciz/PUP:43!U./] ; no, open user relative socket
>
ifn ft20,<
	 hrroi b,[asciz/PUP:43!U./]
>
	skipe soc44
	 hrroi b,[asciz/pup:44!A./]
	movsi a,1		; yes, open server socket
	gtjfn			; get a jfn
	 ercal [elog <Failed to get server socket: %1J%/>
		popj p,]
	move b,[107000,,300000]
	openf
	 ercal [elog <Failed to open server socket: %1J%/>
		popj p,]
	movem a,srvjfn		; save server jfn
	push p,a
	pushj p,psiini		; init the psi's
	pop p,a
ifn ft10x,<			; tenex, run disabled
	movei a,400000
	rpcap
	trz c,1b18!1b19		; not wheel or operator, now
	epcap
>				
	popj p,

ls srvjfn			; JFN of port in server mode
ls server			; server/user flag
ls freque,3			; free pool information block

; Initialize Sequin connection
; This routine resets the Send and Receive sequences, opens the Sequin
; connection, and creates the ring buffer of Sequin
; packets, thereby computing the receiver allocation.

; call:  a/ JFN of raw pup port opened read/write
;	sq/ Pointer to sequin data block (at least sqblen words long)
;	cx/ Connection table index, if being called as server
; returns: +1, failure (no connections open)
; 	   +2, success, cx/ Connection table index for this connection
; clobbers a,b,c

conini::skipge server		; a server?
	 jrst conin2		; yes, have cx, sq already
 	movsi cx,-nconn		; find a free connection
conin1:	skipn contab(cx)	; free connection if contab entry=0
	 jrst conin2		; found one
	aobjn cx,conin1
	popj p,			; fail if we can't find a free connection
	
; now have a connection table index.  Assign buffers for this connection
conin2:	movei cx,(cx)		; clear left half
	movem sq,contab(cx)	; assign this table
	move p1,a		; save Pup jfn
	skipge server
	 move p1,srvjfn

	movsi a,(sq)
	hrri a,1(sq)
	setzm (sq)
	blt a,sqblen-1(sq)	; clear out seqblk
	setom sendsq(sq)	; sendsq starts at -1

	pushj p,makfrk		; Make server fork
	 jrst [setzm contab(cx)	; free the connection
	       popj p,]		; return

	movei a,freque		; from the free queue...
	movei c,npupbf		; make npupbfs on each queue
	movei b,(cx)		; get table address
	imuli b,lqutab		; compute index into table for connection
	movei b,txtab(b)	; get that address
	movem b,sqtxcu(sq)	; save it
	setom qulock(b)		; init the queue lock
	pushj p,aqueue		; make the queue
	 popj p,

	movei b,(cx)
	imuli b,lqutab
	movei b,rxtab(b)
	movem b,sqrxcu(sq)
	setom qulock(b)
	pushj p,aqueue
	 popj p,

	movsi a,npupbf		; init connection allocation
	movem a,seqall(sq)
	
; now fill in sequin data block with local and foreign port info
	move a,p1		; retrieve pup jfn
	cvskt			; get local port params
	 ercal jerr
	movem b,seqlnh(sq)	; save local net,,host
	movem c,seqlsk(sq)	; save local socket
	skipge server		; server?
	 jrst [move a,pupfnh(cx); yes, get foreign stuff from cx tables
	       movem a,seqfnh(sq)
	       move a,pupfsk(cx)
	       movem a,seqfsk(sq)
	       jrst conin6]
	movei c,seqfnh(sq)	; get foreign port params
	hrli c,2
	gdsts
	 ercal jerr
	hrlm a,sqjfnx(sq)	; save jfn and connection index
conin6:	hrrm cx,sqjfnx(sq)
	movei a,leafSk		; default socket if necessary
	skipn seqfsk(sq)	; a socket specified?
	 movem a,seqfsk(sq)	; no
	hlrz a,seqlnh(sq)	; see if local net specified
	jumpn a,conin5
	hlrz c,seqfnh(sq)	; no, check foreign net
	jumpe c,conin5		; jump if not specified either
	move a,[sixbit /puprou/]  ; get routing table entry for net
	sysgt
	hrrz a,b		; table number
	hrli a,-1(c)		; entry
	getab
	 ercal jerr
	trnn a,-1		; are we directly connected?
	 ldb c,[point 8,a,9]	; no, use net of gateway
	hrlm c,seqlnh(sq)	; establish local net

	move a,[connt,,filet]	; set up timeouts
	movem a,ltime(cx)	; local timeout 

	move a,[connt,,filet_-1]; remote timeout
	movem a,ftime(cx)
	
	skipl server		; if not serving...
	 jrst conin5		; ... open the connection...
	hrrz a,leaffk(sq)
	movei b,leaf##
	pushj p,stfrk		; start server fork
	movei a,(cx)		; get real connection index
	log <Connection %1O opened from %2P>
	aos (p)			; and return if successful
	popj p,

; now open the Sequin connection
conin5:	setz a,			; send no data with this pup
	movei b,seqOpn
	pushj p,senSeq		; send a Sequin packet
	aos (p)			; increment return
	popj p,			; return

	subttl	Sequin Send

; routine to send a Sequin packet
; call: a/length*,,address of data to send in packet (0 if none)
;	b/SequinOp (-1 to default to most reasonable choice)
;      sq/pointer to Sequin data block
; return: +1 always
; * length in 16 bit words

senseq::push p,pb		; save packet buffer pointer
	push p,a		; save address
	push p,b		; save SequinOp
	move a,sqtxcu(sq)
	move b,qusize(a)	; get queue size
	camg b,qucnt(a)		; is there room?
	 jrst [push p,a		; no, wait until there is
	       movei a,^d250
	       disms
	       pop p,a
	       jrst .-2]
	movei a,qulock(a)	; there's room, lock the queue
	pushj p,lock
	move a,sqtxcu(sq)	; recover queue pointer
	hlrz pb,(a)		; get pup pointer
	hrrz b,0(pb)		; get address of next buffer
	cain b,0		; get a zero?
	 jrst [dtype <Buffer chain points to nowhere!!%/%/>
	       pushj p,jerr
	       jrst .+1]
	hrlm b,(a)		; store as next available buffer
	aos 2(a)		; increment queue count
	pop p,b			; retrieve sequinOp
	move a,(p)		; retrieve a
	jumpe a,sensq1		; minimum length if no data
	hlrz a,a		; get word length
	lsh a,1			; convert to bytes
sensq1:	addi a,mnplen		; add header length
	dpb a,puplen		; save pup length
	setz a,			; clear transport control byte
	dpb a,puptcb
	movei a,seqtyp		; type is "sequin"
	dpb a,puptyp

; we run with 0 allocation for lockstep handling, since it is very easy for
; our 2020 to be overrun with packets from an IFS, even when Sequin is the
; only active process on the machine!

	setz a,
repeat 0,<
	hlrz a,seqall(sq)	; store allocation byte
>
	dpb a,seqalc
	move a,recvsq(sq)	; store receiver sequence
	dpb a,seqrec
	move a,sendsq(sq)
	ldb c,puplen		; get length
	caie c,MNPLEN		; any contents bytes?
	 jrst [aoj a,		; yes, increment send sequence
	       andi a,377
	       movem a,sendsq(sq)
	       jrst sensq4]
	caige a,0		; is this the first packet out on connection?
	 aoj a,			; yes, go from -1 to 0 in send sequence

sensq4:	dpb a,seqsen
	skipl a,b		; get sequinOp into a
	 jrst sensq2		; caller supplied explicit op
	movei a,seqdat		; control is sequinData
	skipn 0(p)		; send a SequinNop if no data
	 movei a,seqnop
	skipn seqsta(sq)	; unless connection is not open
	 movei a,seqopn		; in which case, send a SequinOpen
sensq2:	dpb a,seqcon		; store control byte

	hlrz a,seqfnh(sq)	; store foreign net
	dpb a,ppupdn
	hrrz a,seqfnh(sq)	; store foreign host
	dpb a,ppupdh
	move a,seqfsk(sq)	; store foreign socket
 	dpb a,ppupd1		; low order
	rot a,-^d16
	dpb a,ppupd0		; high order

	hlrz a,seqlnh(sq)		; store local net
	dpb a,ppupsn
	hrrz a,seqlnh(sq)		; store local host
	dpb a,ppupsh
	move a,seqlsk(sq)		; store local socket
	dpb a,ppupss		

; move any data into Sequin packet
	pop p,a			; recover length,,address
	jumpe a,sensq5		; skip this if no data to send
	hlrz b,a		; get length
	aoj b,
	idivi b,2		; convert to PDP10 words
	hrl a,a			; set up to BLT data
	hrri a,pbcont(pb)
	addi b,pbcont-1(pb)
	blt a,(b)		; transfer data into packet buffer
sensq5:	tro f,tempf1		; Remember that we have the tx queue locked
; skip the stack manipulation following

; send packet
; also here to retransmit packets from retransmit queue
; sq/ points to Sequin data block for this connection
; pb/ points to packet buffer for the Sequin data packet
sensq3:	movei b,(pb)
	pushj p,sndpup		; Send the pup off
	trze f,tempf1
	 jrst  [move a,sqtxcu(sq) ; called from above?
		movei a,qulock(a) ; yes, unlock the queue
		pushj p,unlock		
		pop p,pb	; restore packet buffer pointer
		popj p,]	; return
	popj p,			; return

	subttl	Sequin Resend

; This routine is called to resend any packets in the retransmission
; queue which have not been acknowledged yet (i.e. on receipt of a
; SequinRestart packet).
; Only data containing packets are resent, control packets are ignored.
; sq/ pointer to sequin data block for this connection
; returns +1 always

rsnseq:	push p,pb		; save packet buffer pointer
	move a,sqtxcu(sq)	; lock the queue for consistency
	movei a,qulock(a)
	pushj p,lock
	trz f,tempf1		; make sure we don't look like SENSEQ
	tlo f,(sqrtrn)		; say we're retransmitting
	hrrz pb,@sqtxcu(sq)	; pick up retransmission pointer
	hlrz a,@sqtxcu(sq)	; get transmission pointer?
	push p,a		; save on stack
rsnsq1:	camn pb,(p)		; reached transmission pointer?
	 jrst rsnsq3		; yes, return
	ldb a,puplen
	caile a,MNPLEN		; only resend data packets
	 pushj p,sensq3		; resend this packet
rsnsq2:	hrrz pb,0(pb)		; look at next packet buffer
	jrst rsnsq1		; loop

; here when done
rsnsq3:	pop p,(p)		; remove transmission pointer entry
	pop p,pb
	tlz f,(sqrtrn)		; no longer retransmitting
	move a,sqtxcu(sq)
	movei a,qulock(a)
	pushj p,unlock		; unlock the queue
	popj p,			; return to caller

	subttl	Sequin Release packets on retransmission queue

; This routine frees packets on the retransmission queue which have
; been acknowledged by the other process
; a/ receive sequence number from the acknowledgement
; sq/ pointer to sequin data block for this connection
; Returns +1 always,
; b/ number of freed buffers
relseq:	noint
	push p,c
	push p,d
	setz d,			; d counts number of freed buffers
	push p,pb		; don't kill pb
	setz b,
	push p,b		; (p) counts number of freed packets
	move pb,sqtxcu(sq)
relsq0:	hrrz pb,(pb)		; pick up retransmit queue pointer
	move b,sqtxcu(sq)	; compare with transmit queue pointer
	hlrz b,(b)
	cain b,(pb)		; if equal, we're done, else loop
         jrst relsq1		; equal, leave
	ldb b,seqsen		; look at this packet's send sequence
; do 8-bit arithmetic
	camn a,b		; does recv'd ack = send seq of this packet?
	 jrst relsq1		; yes, we're done
	ldb b,puplen		; any data in this packet?
	caie b,mnplen	
	 aos (p)		; yes, increment released packet count
	aoja d,relsq0

relsq1:	move b,sqtxcu(sq)
	hrrm pb,(b)		; store updated dequeue pointer
	move c,2(b)		; get queue item count
	subi c,(d)		; adjust for freed items
	movem c,2(b)		; save new value
	pop p,b			; get freed buffer count
	pop p,pb		; restore pb
	pop p,d
	pop p,c
	okint
	popj p,			; return
	subttl Sequin Receive 
	
; this routine is called to receive Sequin packets

; Packets which are returned by this routine have already been
; input by an interrupt level routine.  These packets are placed
; in a ring buffer, like the retransmit buffer.  This routine returns
; these packets to the caller if and only if they contain data destined 
; for some higher level process (i.e. Leaf).

; call: a/ location to store received packet in (assumed MXPBLN-MNPBLN long)
;      sq/ pointer to sequin data block for this connection
; return: +1 failure: a/ -1 if timeout, 
;			 other error codes as defined above,
;	  +2: success, packet stored in location pointed to by A
;		      a/ number of bytes stored

; clobbers c,d

inpSeq::push p,a		; save address
	time
	addi a,sqtmin		; add timeout interval
	movem a,sqtime(sq)	; save timeout time

; loop here looking for packets
inpSq1: move a,sqrxcu(sq)	; get pointer to receive queue
	skipn 2(a)		; anything in the queue?
	 jrst inpSq0		; no, wait a bit
	pop p,b			; retrieve storage address
	tlo b,(1b0)		; flag DQUEUE to return only data portion
	pushj p,dqueue		; get from queue
	subi a,mnplen		; remove overhead from packet length
	aos (p)			; return +2
	popj p,

; here when the received packet queue is empty
; waits here for 250 ms, and then tries again (at inpSq1, above)
; if we timeout, return to caller =1 with a/ errTim (timeout)
inpSq0:	time			; get time
	camge a,sqtime(sq)	; timed out, yet?
	 jrst [movei a,^d250	; no, loop
	       disms
	       jrst inpSq1]
	pop p,a			; clean stack
	movei a,errTim
	popj p,			; return +1 with timeout


; Interrupt level code to handle received packet
; call: input PUP in tmprec
; returns: +1 always
; a contains some error code (see PSQDEF.MAC) or zero

; Here when there is a packet in the received Sequin packet queue.
; Here, we dispatch on the packet type and perform any Sequin-level
; tasks which need to be performed.  This code parallels the routine
; HandlePBI in IFSSequinSwap.bcpl (IFS Leaf/Sequin implementation).

hdlSeq:	movei pb,tmprec-2	; point to input packet
	ldb a,seqCon		; get control field
	cain a,seqOpn		; if it's a sequinOpen
	 skipa
	cain a,seqCls		; or a sequinClose
	 movei a,seqDat		; make it look like a sequinData
	movem a,contro		; save control type
	
	tlnn f,(debugf)
	 jrst hdlsq4
	move a,recvsq(sq)
	move b,sendsq(sq)
	hrroi c,temp
	write c,<HDLSEQ: My send #%2O, recv #%1O; >
	ldb a,SeqSen
	ldb b,SeqRec
	write c,<packet send #%1O, recv #%2O>
	hrroi c,temp
	log <%3S>

hdlsq4:	ldb a,SeqSen		; get incoming send sequence
	move b,recvsq(sq)	; and expected send sequence
	pushj p,comSeq		; compare sequence numbers
	 jrst sqFail		; +1: out-of-range, go die
	 jrst sqRqRe		; +2: ahead, request retransmission
	 jrst sqDupl		; +3: duplicate, drop packet
	 jrst sqChng		; +4: previous, change control to restart

; if here, either OK or Sequin control changed to SequinRestart
hdlSq1:	ldb a,SeqAlc		; get other process's allocation
	hrrm a,seqAll(sq)	; save it
	ldb a,SeqRec		; now compare incoming recv sequence...
	move b,sendsq(sq)	; ... against my send sequence
	pushj p,comSeq
	 jrst sqFail		; +1: out-of-range, go to die
	 jrst hdlSq3		; +2: ahead, fall through
	 jrst sqDupl		; +3: duplicate, drop packet 
	 jfcl			; +4: previous, fall through
	skiple seqout(sq)	; +5: equal, adjust outstanding packet count
	 sos seqout(sq)		;
	jrst hdlsq5		; go handle states
; ...
; if here, sequence compare equal, duplicate, or previous
; in any case, release packets from the retransmission queue which
; are acknowledged by this packet, and process the data in the packet,
; if there is any

hdlSq3:	move a,contro
	cain a,SeqRes		; is control a Restart?
	 jrst [skiple seqout(sq)
		sos seqout(sq)	; yes, adjust outstanding packet count
	       jrst hdlsq5]	; and fall through
	ldb a,seqRec		; get receive sequence
	pushj p,relSeq		; release those packets this one acks
	move a,seqout(sq)	; update outstanding packet count
	caile a,0		; don't if a is 0 or less
	 sub a,b
	jumpl a,[push p,a
		 movei a,(cx)
		 elog <HDLSEQ: Overdecremented SEQOUT for connection %1O>
		 pop p,a
		 setzm seqout(sq)
		 jrst .+1]
	movem a,seqout(sq)
	movei a,(cx)
;	dtype <HDLSQ3: Freed %2O packets on connection %1O%/>

; dispatch on state of connection
hdlsq5:	move a,seqSta(sq)	; get connection state
	jrst @stattb(a)		; dispatch

; now dispatch on control field
hdlsq2:	move a,control
	jrst @ctrltb(a)		; dispatch

; dispatch table to handle sequin connection state
stattb:	stCLOS 			; state is closed
	stOPEN 			; state is open
	stDLLY 			; state is dallying
	stBROK 			; state is broken
	stDSTR 			; state is destroyed
	stTIMD 			; state is timed out

; dispatch table to handle different control types in Sequin packets
ctrltb:	hdlDat			; handle Sequin data
	hdlAck			; handle Sequin ack
	hdlNop			; handle Sequin nop
	hdlRes			; handle Sequin restart
	hdlChk			; handle Sequin check
	screwup			; can't get Sequin open in control
	hdlBrk			; handle Sequin break
	screwup			; can't get Sequin close in control
	hdlCld			; handle Sequin closed
	hdlDes			; handle Sequin destroy
	hdlDal			; handle Sequin dally
	hdlQui			; handle Sequin quit
	hdlBro			; handle Sequin broken

	subttl	Sequin Receive utilities

; routine to compare sequence numbers
; call: a/first sequence number
;	b/second sequence number
; Returns +1: (a-b) is out of range
;	  +2: (a-b) is between 1 and mxAhed
;	  +3: (a-b) is between -2 and -mxAhed
;	  +4: (a-b) is -1
;	  +5: a=b
; Clobbers a,b
comSeq:	sub a,b			; compute a-b
	andi a,377
	trne a,200
	 ior a,[-1,,777400]	; simluating 8-bit arithmetic
	movm b,a		; get magnitude of difference
	caile b,mxAhed		; too big a difference?
	 popj p,		; yes, return +1
	aos (p)			; return at least +2
	caile a,0		; a positive?
	 popj p,		; yes, return +2
	aos (p)			; no, return at least +3
	camge a,[-1,,-1]	; a .ge. -1?
	 popj p,		; no, return +3
	aos (p)			; yes, return at least +4
	caie a,0		; a = 0?
	 popj p,		; no, must be -1; return +4
	aos (p)			; else return +5
	popj p,

; here when sequence numbers are out of range
sqFail:	setz a,			; send a sequinBroken Op
	movei b,seqBro		; the world ends!
	pushj p,senSeq

	movei a,(cx)
	log <SQFAIL: Sequin broken on connection %1O%/>
	movei a,DSTR
	movem a,seqSta(sq)	; change state to BROKen
	movei a,errDes		; signal sequin broken
	popj p,			; return +1

; here to request retransmission of all unacknowledged packets
; this routine sends a sequinRestart, and returns
sqRqRe:	setz a,			; send a sequinRestart
	movei b,seqRes
	pushj p,senSeq		; send it out
	movei a,(cx)
	dtype <SQRQRE: Sending sequinRestart for connection %1O%/>

; also here to return from HDLSEQ without queueing anything for Leaf
rethdl:	setz a,
	popj p,

; here when packet received is flagged as "duplicate"
; simply drop the packet
sqDupl:	movei a,(cx)
	dtype <SQDUPL: Dropping duplicate packet for connection %1O%/>
	jrst rethdl

; here when incoming packet is flagged as "previous"
; change control field to restart, and fall through
sqChng:	move a,control		; only make this a restart if control=data
	caie a,SeqDat
	 jrst rethdl
 	movei a,seqRes
	movem a,control		; store control
	movei a,(cx)
	dtype <SQCHNG: Incoming control becomes RESTART on connection %1O%/>
	jrst hdlsq1		; fall back to hdlseq


; dispatch code from control and state dispatches here

; here to handle CLOSed state
stCLOS:	ldb a,seqCon		; get original control byte
	caie a,seqDat		; was it a data byte?
	 cain a,seqOpn		; or an open request?
	  jrst stTIMD		; then fall through
	jrst stOPEN		; else make believe state is open
	   
; fall through

; here if state is timed out
stTIMD:	movei a,OPEN
	movem a,seqSta(sq)	; make state open
; fall through

; here if state is OPEN
stOPEN:	pushj p,strxtm		; set receive timer
	jrst hdlSq2		; return

; here if state is broken
stBROK:	setz a,
	movei b,seqBro
	pushj p,senSeq		; send a sequin broken
	movei a,errBro		; say Sequin is broken
	popj p,			; return bad

; here if in dallying state
stDLLY:	move a,contro		; get control
	cain a,seqQui		; was it a quit?
	 jrst stDLY1		; yes, go die
	setz a,
	movei b,seqDal		; no, send a dally in return
	pushj p,senseq
	setz a,
	popj p,			; and wait for more packets

stDLY1:	movei a,DSTR		; say Sequin is destroyed
	movem a,seqSta(sq)
	movei a,errDes
	popj p,			; received a quit, return +1

; here if in destroyed state
stDSTR:	dtype <STDSTR: Received packet while in DESTROYED state>
	movei a,errDes		; say sequin is destroyed
	popj p,			; return 


; these routine handle the various control fields in the sequin packet

; here when control field is "destroy"
hdlDes:	movei a,DLLY		; make state = dallying
	movem a,seqSta(sq)
	setz a,			; respond with a dallying packet
	movei b,seqDal
	pushj p,senSeq		; send off the packet
	setz a,
	popj p,			; wait for a reply

; here to respond to a SequinDally
hdlDal:	setz a,
	movei b,seqQui		; respond with a SequinQuit
	pushj p,senSeq
	movei a,ErrDes		; say Sequin has been destroyed
	popj p,

; here to respond to a seqChk or seqNop
hdlChk:
hdlNop:	setz a,
	movei b,seqAck		; reply with an ack
	pushj p,senSeq		; send it
	setz a,
	popj p,			; wait for more packets to come in

; here to respond to a SequinRestart
hdlRes:	pushj p,rsnseq		; resend the transmit queue
	setz a,
	popj p,			; wait for more packets

; here to respond to a sequinAck
hdlAck:	setz a,
	popj p,			; just keep waiting

; here to respond to a SequinData
hdlDat:	move a,seqSta(sq)	; get state
	caie a,OPEN		; are we open?
	 jrst sqFail		; no, respond with sequinBroken, ret +1
	movei b,seqAck		; prepare to respond with sequinAck
	ldb a,seqCon		; get real control field
	cain a,seqCls		; is it a sequinClose?
	 jrst [movei a,CLOS	; make state = CLOSed
	       movem a,seqSta(sq)
	       movei b,seqCld	; prepare to respond with sequinClosed
	       jrst .+1]
	ldb a,puplen		; get length of incoming pup
	caig a,MNPLEN		; greater than minimum?
	 jrst [setz a,		; no, send an acknowledgement
	       pushj p,senSeq	; send the reply
	       setz a,
	       popj p,]		; and wait for more input
	aos a,recvsq(sq)	; increment received sequence number
	andi a,377
	movem a,recvsq(sq)	; save masked number
	pushj p,inSequ		; move the packet to the caller's space
	setz a,
	popj p,
	
hdlBrk:
hdlBro:
hdlCld:
hdlQui:	jrst sqFail		; don't like receiving these here


; here to move data into caller's space
; pb/ pointer to packet buffer
; clobbers a,b,c
; returns +1 always
inSequ:	move a,sqrxcu(sq)
	movei b,pbhead(pb)	; yes, queue packet, else drop on floor 
	skipn 2(a)		; is the queue empty?
	 tro f,tempf1		; yes, remember
	move c,1(a)		; get buffer size
	camle c,2(a)		; is there room?
	 pushj p,nqueue		; yes, otherwise drop on floor
	trze f,tempf1		; was the queue empty?
	 pushj p,sgleaf		; yes, signal leaf to run
	popj p,			; return

; here to signal a leaf fork that a previously empty queue now has data in it
; call: pushj p,sgleaf
;	cx/ connection index for this connection
; returns: +1, always
; clobbers a,b
sgleaf:	skipl leaffk(sq)	; only interrupt if B0 of leaffk is on
	 popj p,
	move a,connfk(cx)	; get fork handle
	move b,[sigchn]
	iic
	popj p,


	subttl General utilities

; routines to manage queues
; a queue is a doubly-linked set of buffers of mamximum pup length, plus
; a couple of words of queue and buffer management overhead (see beginning
; of this file).  Associated with each queue is a queue information block
; containing:
;	enqueue,,dequeue pointers for the queue
;	size of queue
;	count of items in the queue

; routine to create a free buffer pool
; call: pushj p,mqueue
; 	a/ points to queue information word for this queue
; 	c/ number of buffers to assign
; returns: +1 always
; clobbers b,c
mqueue:	push p,p1		; save a permanent location
	move p1,a		; point queue info pointer in a safe place
	movem c,1(p1)		; get queue size
	pushj p,asgfre		; get a buffer
	hrrm a,(p1)		; save dequeue pointer
	hrlm a,(p1)		; save enqueue pointer
	push p,a		; save address of first buffer
	soje c,mquex		; leave if all buffers reserved

mque1:	move b,a		; save address of this buffer
	pushj p,asgfre		; get next buffer
	hrrm a,(b)		; link it to previous buffer
	hrlm b,(a)		; link previous buffer to it
	sojn c,mque1		; loop if more to do

mquex:	hlrz b,(p1)		; get enqueue pointer
	hrlm a,(b)		; make first buffer point back to last 
	hrrm a,quemax		; save highest queue address
	pop p,b			; retrieve first buffer address
	hrrm b,(a)		; make last buffer point forward to first
	move a,p1		; restore a
	setzm 2(a)		; make queue empty
	pop p,p1
	popj p,

ls quemax			; contains address of highest queue entry

; routine to assign buffers from free buffer pool to a process
; call: a/ address of free buffer pool information word
;	b/ address of information word for buffers being assigned
;	c/ number of buffers requested
; returns: +1, not enough available buffers
;	   +2, success, buffers assigned

aqueue:	push p,d		; save d
	push p,a		; save arguments
	push p,b
	push p,c

	hrrz a,(a)		; get address of first buffer in free pool
	movem a,(b)		; save in new info block
	hrlm a,(b)
	movem c,1(b)		; save queue size
	setzm 2(b)		; and make it initially empty

	move b,-2(p)		; get address of free pool info block
	move d,1(b)		; get free pool size
	subi d,(c)		; remove number of requested buffers
	jumpl d,aqueux		; fail if can't assigned requested number
	movem d,1(b)

	push p,a		; save address of first buffer in new queue
	caia			; enter assign loop
aqueu1:	hrrz a,(a)		; get free buffer pool header
	sojn c,aqueu1		; loop until found last desired buffer

	hrrz c,(a)		; get address of new first buffer in free pool
	move b,(p)		; get address of first buffer
	hrrm b,(a)		; place in link word
	hlrz d,(b)		; get last buffer in free pool
	hrlm a,(b)		; place addr of last buffer in first entry
	move a,-3(p)		; get address of free pool info block
	hrrm c,(a)		; store new first buffer
	hrlm d,(c)		; store last free pool buffer in new first buf

	pop p,(p)
	aos -4(p)		; return successfully
aqueux:	pop p,c			; recovers acs
	pop p,b
	pop p,a
	pop p,d
	popj p,

; routine to return a queue of buffers to the free buffer pool
; call: a/ address of free pool information block
;	b/ address of information block for buffer queue being deassigned
; returns: +1, always
rqueue:	push p,c		; save c
	push p,d		; and d
	push p,a		; also save arguments
	push p,b
	move d,1(b)		; get size of buffer queue being returned
	skipn 1(a)		; is free pool currently empty?
	 jrst [movsi c,(b)	; yes, just move queue over
	       hrri c,(a)
	       blt c,2(a)
	       setzm 1(b)
	       jrst rqueux]
	hrrz c,(a)		; get address of first buffer in free pool
	hlrz c,(c)		; get address of last buffer in pool
	hrrz b,(b)		; get address of buffer in returning queue
	hrrm b,(c)		; link it into free pool
	hrlm c,(b)		; and link free pool into it
	caia			; enter loop
rqueu1:	hrrz b,(b)		; get next buffer in queue
	sojn d,rqueu1		; loop until through all buffers

	hrrz a,(a)		; b has last buffer addr, get 1st in free pool
	hrlm b,(a)		; complete linking returned queue into free
	hrrm a,(b)

	move b,(p)
	move a,-1(p)
	exch d,1(b)		; zero queue size for returned queue
	setzm 2(b)		; make it empty, too
	addm d,1(a)		; add returned queue size to free pool size
rqueux:	pop p,b
	pop p,a
	pop p,d			; recover d and c
	pop p,c
	popj p,			; and return


; routine to place an item on queue
; call: a/address of queue information word
;	b/address of pup to place on queue
; returns: +1 always
; if queue if full, then process waits until it can place item on queue

nqueue:	push p,pb		; don't clobber pb
	push p,a
	push p,b
	movei a,qulock(a)	; lock queue
	pushj p,lock
	move a,-1(p)
	movei pb,-pbhead(b)	; set up bytepointers for this packet
	move b,1(a)		; get size of queue
	camg b,2(a)		; is size > count?
	 jrst [push p,a
	       movei a,qulock(a)
	       pushj p,unlock	; unlock while dismissed
	       movei a,^d250	; wait 250 ms
	       disms
	       move a,(p)
	       movei a,qulock(a)
	       pushj p,lock	; relock when done waiting
	       pop p,a
	       jrst .-2]	; and try again
	ldb a,puplen		; compute length of move
	idivi a,4
	caie b,0
	 aoj a,
	move b,-1(p)		; a has length in words, compute last address
	hlrz b,(b)		; set up BLT pointer
	addi b,pbhead-1(a)	; b has last address to BLT to now
	move a,-1(p)
	hlrz a,(a)		; get enqueue pointer
	addi a,pbhead		; point into data region of queue
	hrli a,pbhead(pb)
	blt a,(b)		; transfer onto queue
	hrrz b,-1(p)
	hlrz a,(b)		; update queue pointer
	hrrz a,(a)
	cain a,0		; check for foul link
	 jrst [elog <Buffer chain points nowhere!%/%/>
	       pushj p,jerr
	       jrst .+1]
	hrlm a,(b)
	pop p,b
	pop p,a
	aos 2(a)		; increment item count
	push p,a		; unlock queue
	movei a,qulock(a)
	pushj p,unlock
	pop p,a
	pop p,pb
	popj p,

; routine to dequeue item from queue
; call: a/ address of queue information word
;	b/ address to write into
;	   B0 on means return data part only
; returns: +1 always (waits if queue is empty)
dqueue:	push p,p1
	push p,pb		; save some acs
	push p,a
	push p,b
	movei a,qulock(a)	; lock the queue
	pushj p,lock
	move a,-1(p)
	hrrz pb,(a)		; get dequeue pointer
	hrrz b,2(a)		; get item count
	cain b,0		; wait if it's zero
	 jrst [push p,a
	       movei a,qulock(a)
	       pushj p,unlock	; unlock while dismissed
	       movei a,^d250	; wait 250 ms
	       disms
	       move a,(p)
	       movei a,qulock(a)
	       pushj p,lock	; relock when done waiting
	       pop p,a
	       jrst .-2]	; and try again
	ldb a,puplen		; see how many words to transfer
	skipge 0(p)
	 move p1,a		; if returning data only, save packet len
	idivi a,4
	caie b,0
	 aoj a,
	move b,(p)		; a has len in wds, make BLT pointer
	hrli b,pbhead(pb)	; read following queue link word
	addi a,-1(b)		; b is source,,dest; get addr of last word
	skipge 0(p)		; want data part only?
	 jrst [add b,[mnpbln-1,,0]; yes, adjust BLT stuff
	       subi a,mnpbln-1
	       jrst .+1]
	blt b,(a)
	pop p,b
	pop p,a
	hrrz pb,(pb)		; update queue pointer
	cain pb,0
	 jrst [elog <Buffer chain points nowhere!%/%/>
	       pushj p,jerr
	       jrst .+1]
	hrrm pb,(a)
	sos 2(a)		; decrement queue item count
	push p,a		; save address of queue block
	movei a,qulock(a)	; compute address of lock
	pushj p,unlock		; unlock
	pop p,a			; restore address
	skipge b
	 move a,p1		; return packet length if necessary
	pop p,pb	
	pop p,p1
	popj p,			; return
	

; routine to mark out a buffer (MXPBLN+PBHEAD words)
; returns: +1 always, a/ address of buffer
asgfre:	move a,frepnt
	push p,a
	addi a,mxpbln+pbhead
	movem a,frepnt
	pop p,a
	popj p,

; routines to set timeouts for various connections

; routine to set timeout to keep connection alive
; call: cx/ connection index for this connection
; returns: +1 always, transparent to acs
sttxtm:	push p,a		; get now
	push p,b
	time
	hrrz b,ftime(cx)
	imuli b,^d1000		; convert to ms
	add a,b
	movem a,txtime(cx)	; save time to transmit in table
	pop p,b
	pop p,a
	popj p,

; routine to set timeout on received packets
; call: cx/ connection index for this connection
; returns: +1 always, transparent to acs
strxtm:	push p,a		; get now
	push p,b
	time
	hrrz b,ltime(cx)
	imuli b,^d1000		; convert to ms
	add a,b
	movem a,rxtime(cx)	; save time to receive by
	pop p,b
	pop p,a
	popj p,

; routine to set local timeout params (called by Leaf server)
; call: pushj p,stlctm
;	a/ connection,,file timeout (seconds)
;	cx/ connection table index
; returns: +1, always
stlctm::movem a,ltime(cx)
	popj p,

; routine to set foreign timeout params (called by Leaf user)
; call: pushj p,stfntm
;	a/ connection,,file timeout (seconds)
;	cx/ connection table index
; returns: +1, always
; A SequinNop will be sent every time the file timeout expires.  Thus,
; it is advisable to set the file timeout to be something less than the
; server's file timeout.  The default timeout is 5 minutes, one-half the
; default timeout for the IFS.

stfntm::movem a,ftime(cx)
	popj p,

; routine to create a server fork
; call: pushj p,makfrk
;	cx/ connection index
;	sq/ address of sequin data block
; returns: +1, failure, JSYS error code in 1
;	   +2, success; leaffk(sq) containing fork handle of fork
; clobbers a,b,c,d
makfrk:	movsi a,(1b1)
	cfork			; create empty fork with superior's capenb
	 popj p,
tenex,<
	cfgrp			; in Tenex, do proxy logins for fork groups
	 popj p,
>
	hrrzm a,leaffk(sq)	; save fork index in sequin data block
	movem a,connfk(cx)	; and in table indexed by connection
	move d,[400000,,1000]	; stop PMAP loop when AC1 contains (d)
	movsi c,(1b2!1b4!1b9)	; map read, cw, execute
	hrlz b,a		; map from this fork to inferior
	movsi a,400000
makfk1:	camn a,d		; done yet?
	 jrst makfk3		; yes, leave
	push p,b		; no, check if this page exists
	rpacs
	tlnn b,(1b5)		; page exists?
	 jrst [push p,a		; make the page exist
	       movei a,(a)
	       lsh a,^d9
	       setzm (a)	; touch it
	       pop p,a
	       jrst .+1]
	pop p,b			; yes, map to inferior
	pmap
	 erjmp [movei a,400000
		geter
		movei b,(b)
		elog <MAKFRK: PMAP failed: %2J>
		hrrz a,leaffk(sq)
		kfork
		movei a,(b)	; error number to A
		popj p,]
	caia
makfk2:	pop p,b
	aoj b,			; increment page numbers
	aoja a,makfk1		; and loop

; here when done mapping pages... make certain pages read, write, exec
makfk3: hll a,b
	hrri a,ishloc/1000	; starting at ishloc
	move c,quemax
	lsh c,-^d9
	aoj c,
	subi c,-1(a)		; number of pages to change
makfk4:	rpacs
	tlne b,(1b5)		; page exists?
	 jrst [movsi b,(1b2!1b3); yes, change to read, write
	       spacs
	       jrst .+1]
	aoj a,
	sojn c,makfk4
	aos 0(p)
	popj p,			; ret +2

; routine to start a Leaf server fork
; call: pushj p,stfrk
;	a/ fork handle
;	b/ start address
; returns +1, always
stfrk:	push p,b
	setz b,			; set fork acs
	sfacs
	pop p,b
	sfork
	aos (p)
	popj p,

; here to kill a server fork
; call: pushj p,killfk
;	sq/ address of sequin data block
;	cx/ connection table index
; returns: +1, always
; clobbers a,b,c
killfk:	hrrz a,connfk(cx)	; check consistency of fork handle
	caig a,400000		; for debugging
	 jrst  [movei b,(cx)
		elog <Connection %2O claims fork handle %1O for server>
		popj p,]
	kfork
	setzm leaffk(sq)
	setzm connfk(cx)	; clear fork pointers
	popj p,			; returns

; lock and unlock utilities to insure contention-free program flow
; routine to lock a data structure
; call: pushj p,lock
;	a/address of lock block (word 0 = lock, word 1 = fx of locker)
; returns: +1, always, when locked
lock:	aose (a)		; try to lock
	 jrst .-1
	movem fx,1(a)
	popj p,

; routine to unlock
; call: pushj p,unlock
;	a/address of lock block
unlock: push p,a
	move a,(a)		; get lock word
	camn a,[-1,,-1]		; is it locked?
	 jrst [move a,(p)
	       elog <Lock at %1O is not locked>
	       jrst .+1]
	pop p,a
	came fx,1(a)		; do we own the lock?
	 jrst [elog <Attempt to unlock lock at %1O by improper process %16O>
	       pushj p,screwup]
	setzm 1(a)		; yes, make the last locker impossible
	setom (a)		; free lock
	popj p,

; routine to map data space into a thawed file so (enabled) others can look at
; what the server is doing
mapdat::movsi a,1		; get the .PMAP file
ifn ft10x,<
	hrroi b,[asciz/<SYSTEM>LEAFSV.PMAP;1;P770000/]
>
ifn ft20,<
	hrroi b,[asciz/SYSTEM:LEAFSV.PMAP.1;P770000/]
>
	gtjfn
	 jrst mapdaf
	move p1,a
	move b,[44b5+1b19+1b20+1b25]	; open read, write, thawed, 36 bits
	openf
	 jrst mapdaf
	move b,[400000,,ilsloc/1000]
	hrlz a,p1
	hrri a,ilsloc/1000
	movsi c,(1b2!1b3)	; map read/write
	move d,[400000,,600]	; stop here
mapda1: move p2,b
	move b,a
	seto a,
	pmap			; delete the file page
	move a,b		; (hope this works on Tops-20)
	move b,p2
	pmap			; map a page to core
	aoj b,			; increment core address
	came b,d		; reached end?
	 aoja a,mapda1		; nope, incr file address, loop
mapda2:	jrst (fx)


; here on failure
mapdaf:	log <Can't create .PMAP file: %1J>
	skipe a,p1		; relase JFN if we've got one
	 rljfn	
	  jfcl			; ignore it if we can't
	jrst (fx)

	subttl	interrupt driven routines and background process

; These routines maintain the state of the server.  RNTSRV is run at
; interrupt level to receive Pups.  On receipt of a PUP, RNTSRV finds
; the connection it belongs to (or creates a new one), then calls the
; sequence number filter to determine where in the packet sequence the
; received Sequin belongs.  Sequins which are indeed in sequence are
; queued in SQRXCU for the server fork (whatever it may be) below to
; handle.  

; BNTSRV is run on  a five second timer, and is responsible for garbage
; collecting dead or destroyed sequins, and also maintaining the state
; of each sequin connection.

; call: pushj p,bntsrv
;	transparent to acs

bntsrv::skipg nactcn			; are there any active connections?
	 popj p,			; no, return
	exch p,bntpdl
	movem 16,bntacs+16		; save acs 0-16
	movei 16,bntacs
	blt 16,bntacs+15
	move 16,bntacs+16		; recover fx (=AC16)

	cail fx,0			; are we the top fork here?
	 jrst [pushj p,bntsv1		; no, service this connection only
	       tlze f,(defntf)		; need to reenter?
		jrst .-2		; yes, do so
	       jrst bntsv5]		; done, leave

bntsv4:	movsi cx,-nconn			; look for active connections
bntsv0:	skipe sq,contab(cx)		; is this connection alive?
	 pushj p,bntsv1			; yes, handle it
	aobjn cx,bntsv0			; loop if more connections to scan

	tlze f,(defntf)			; want to recycle through this?
	 jrst bntsv4			; yes, go again

bntsv5:	movsi 16,bntacs			; done, recovers acs
	blt 16,16			
	exch p,bntpdl
	tlze f,(defntf)			; want BNTSRV again?
	 jrst bntsrv			; loop through again
	popj p,

gs bntlck				; Background service lock
gs bntlkr				; Last locker
	 
; this routine does all the work
bntsv1:
	move a,seqSta(sq)		; get current state
	caie a,BROK			; if broken...
	 cain a,DSTR			; ... or destroyed
	  jrst bntsv2			; clean up
	cain a,TIMD			; timed out?
	 jrst [skipn b,rxtime(cx)	; see if connection timed out
		jrst .+1
	       hrrz a,ltime(cx)		; compute time of connection timeout
	       imuli a,^d1000
	       sub b,a
	       hlrz a,ltime(cx)
	       imuli a,^d1000
	       add b,a
	       push p,b			; get now
	       time
	       pop p,b	
	       caml a,b
		jrst [movei c,(cx)
		      elog <BNTSV1: Connection %3O timed out>
		      jrst bntsv2]	; connection timed out
	       jrst .+1]

; check for time to send
	skipn txtime(cx)		; is there a send timeout?
	 pushj p,sttxtm			; no, set one
	time
	caml a,txtime(cx)		; tx timeout yet?
	 pushj p,sndnop			; yes, send a nop (if not server)

; check if receiver timed out
	skipn rxtime(cx)		; is there a received timeout?
	 pushj p,strxtm			; no, set one
	move b,seqSta(sq)		; already timed out?
	cain b,TIMD			; if so, avoid following
	 popj p,
	caml a,rxtime(cx)
	 jrst [movei a,TIMD
	       exch a,seqSta(sq)	; yes, say connection is timed out
	       cain a,DLLY		; were we dallying on this connection?
		jrst [movei a,DSTR
		      movem a,seqSta(sq); yes, destroy the connection
		      popj p,]
	       skipn usrnum##(cx)	; is the connection logged in?
		jrst [movei a,DSTR	; no, kill it
		      movem a,seqSta(sq)
		      popj p,]
	       movei a,(cx)
	       log <Short-term timeout on connection %1O>
	       popj p,]
	popj p,				; return

; here to close a BROKen, DeSTRoyed, or TIMeD out connection
; sq, cx set up
bntsv2:	cail fx,0			; Let only the top fork do this
	 popj p,			; If not, then return
	movei a,(cx)
	log <BNTSV2: Closing connection %1O>
	setzm pupfsk(cx)		; clear address for server, also
	setzm pupfnh(cx)
	setzm rxtime(cx)
	setzm txtime(cx)
	skipge server
	 jrst [pushj p,cleanf##		; clean JFNs
	       pushj p,killfk		; kill server fork
	       jrst bnts2a]		; don't close socket if server
	hlrz a,sqjfnx(sq)		; close jfn
	closf
	 elog <BNTSV2: While closing port: %1J>
bnts2a:	movei a,freque			; return queues to free pool
	hrrz b,sqtxcu(sq)
	pushj p,rqueue
	hrrz b,sqrxcu(sq)
	pushj p,rqueue
	setzm contab(cx)		; clear connect index
	sosge nactcn			; decrement count of actives conns
	 jrst  [elog <BNTS2A: NACTCN overdecremented>
		setzm nactcn
		popj p,]
	popj p,

; Routine to send a PUP, updating allocations as it goes, if necessary.
; This routine will dismiss if the allocation does not exist at the
; receiver, hence, do not lock any critical data structures or call with
; interrupts off.
; call: b/ Address of packet buffer to send
; returns: +1 always
;	    Clobbers c,d
sndpup: push p,a
	push p,b
	push p,pb			; save pb
	movei pb,(b)			; point to packet
	ldb a,puplen			; compute PDP10 word count
	addi a,3
	idivi a,4
	hrl b,a
	hrri b,pbhead(pb)		; point to start of packet data
	hlr a,sqjfnx(sq)
	skipge server			; if server
	 hrr a,srvjfn			; use the server jfn
	hrli a,(1b0+1b1)		; don't block, generate checksum
sndpp1:	hrrz c,seqall(sq)		; get allocation for receiver
	cain c,0			; is it 0?	
	 movei c,1			; then make it 1
	move d,seqout(sq)		; get outstanding packet count
	sub c,d				; get difference
	jumple c,[tlne f,(sqrtrn)	; retransmitting?
		   jrst .+1		; ignore allocation limits
		  push p,a		; no allocation, must wait
		  ldb a,puplen		; get length of pup
		  caig a,mnplen		; don't disms if no contents bytes
		    jrst [pop p,a
			  jrst .+1]
		  move a,sqtxcu(sq)
		  movei a,qulock(a)
		  push p,a		; unlock the queue while waiting
		  pushj p,unlock
		  movei a,^d100
		  disms
		  pop p,a
		  pushj p,lock		; relock the queue
		  pop p,a
		  jrst sndpp1]		; try again now
	pupo
	 elog <%1J>
	ldb a,puplen			; get length of PUP just sent
	caig a,MNPLEN			; any contents bytes?
	 jrst sndpp2			; no, don't mess with seqout	
	tlnn f,(sqrtrn)			; retransmitting?
	 aos seqout(sq)			; no, incr outstanding packet count
sndpp2:	pushj p,sttxtm			; reset the timeout timer for 5 minutes
	pop p,pb			; restore pb
	pop p,b
	pop p,a
	popj p,

; routine to place a sequinNop on the queue
sndNop:	skipge server			; only if not server
	 popj p,
	push p,a
	push p,b
	setz a,				; send no data
	movei b,seqNop			; send a Nop
	pushj p,senSeq			; queue it
	pop p,b				; restore acs
	pop p,a
	popj p,

; routine called when a pup is received
rntsrv: exch p,rntpdl
	movem 16,rntacs+16		; save acs 0-16
	movei 16,rntacs
	blt 16,rntacs+15
	skipge server
	 jrst [seto fx,			; we're the top fork
	       pushj p,rntsv1		; if server, get packet
	       jrst rntsv5]

	movsi cx,-nconn			; loop through connections
rntsv0:	skipe sq,contab(cx)		; looking for those with pups waiting
	 pushj p,rntsv1			; do the work
	aobjn cx,rntsv0

rntsv5:	movsi 16,rntacs			; done, recovers acs
	blt 16,16			
	exch p,rntpdl
	debrk				; leave interrupt routine
	 ercal jerr			; in case something fails

rntsv1:	hrrz a,srvjfn			; assume we're a server
	skipl server			; are we a server?
	 hlr a,sqjfnx(sq)		; no, get jfn from seqblk
	hrli a,(1b0+1b1)		; don't disms for I/O, gen checksum
	move b,[mxpbln,,tmprec]
	pupi				; attempt to input a pup
	 jrst rntsv3			; empty or error
	skipge server			; are we a server?
	 jrst [pushj p,rntsv4		; yes, get connection for this packet
	        jrst rntsv1		; failed, see if there's another
	       jrst .+1]		; found the connection
	movei c,tmprec
	pushj p,HdlSeq			; Handle this packet
	cain a,errDes			; was the Sequin destroyed?
	 jrst rntsv2			; yes, go wait for send queue to empty
	jrst rntsv1			; no, loop until input port is empty


; here when Sequin is classified as destroyed
; Make state=DSTR, let BNTSV2 clean up this connection
rntsv2:	movei a,DSTR
	movem a,seqsta(sq)		; make state=DeSTRoyed
	popj p,

rntsv3:	cain a,pupx3			; empty?
	 popj p,
	type <RNTSRV: PUPI failure %1J%/>
	popj p,

; routine to find connection index (or make new one) for received packet
; call: pushj p,rntsv4
;	TMPREC: containing received packet
; returns: +1, failed packet (can't open connection or not Sequin, etc)
; 	   +2, packet received ok, with cx, sq set up
rntsv4: push p,pb
	movei pb,tmprec-pbhead
	ldb a,puptyp		; is this a sequin packet?
	caie a,seqtyp
	 jrst [log <RNTSV4: Discarding non-sequin packet>
	       pop p,pb
	       popj p,]
	ldb a,ppupss			; get source socket
	movsi cx,-nconn
rnts4a:	camn a,pupfsk(cx)		; did we find it?
	 jrst rnts4d			; maybe, try net,,host
	aobjn cx,rnts4a			; loop until we find it

; here if not found; look for an empty slot to make a new connection in
rnts4g:	ldb a,seqcon			; get control byte
	caie a,seqOpn			; is it an open request?
	 jrst rnts4x			; no, send a broken in return
	movsi cx,-nconn			; yes, look for a free slot
rnts4b:	skipn contab(cx)
	 jrst rnts4c
	aobjn cx,rnts4b
	setz a,
	hrroi b,[asciz/Sorry, no Leaf server connections available; please try again later./]
	pop p,pb
	jrst errpup

; here if first Sequin received is not a SequinOpen
rnts4x:	pop p,pb
	jrst breksq			; send a sequin broken, return +1

; here when a free slot found, make new connection
rnts4c:	movei cx,(cx)
	movei sq,(cx)
	imuli sq,sqblen
	movei sq,sqbtab(sq)
	movem sq,contab(cx)
	ldb a,ppupss
	movem a,pupfsk(cx)
	ldb a,ppupsh
	ldb b,ppupsn
	hrl a,b
	movem a,pupfnh(cx)
	move a,srvjfn
	hrlm a,sqjfnx(sq)
	pushj p,conini
	 jrst [pop p,pb
	       setzm pupfsk(cx)		; make sure connection is closed
	       setz a,
	       hrroi b,[asciz/Sorry, unable to make connection; please try again later./]
	       jrst errpup]

	pop p,pb
	aos 0(p)
	dtype <LEAFSV: Sequin connection %6O opened%/>
	aos nactcn			; increment number of active conns
	popj p,

; here when socket matches; look for net,,host
rnts4d:	move c,a		; save pupfsk
	ldb a,ppupsh
	ldb b,ppupsn
	hrl a,b
rnts4e:	camn a,pupfnh(cx)
	 jrst [camn c,pupfsk(cx)
		jrst rnts4f	; got it
	       jrst .+1]
	aobjn cx,rnts4e
	jrst rnts4g	

; here when found a match
rnts4f:	skipn sq,contab(cx)
	 jrst  [setzm pupfsk(cx)	; don't be mislead by half-created
		sos -1(p)		; ... sockets.  Fail here.
		jrst .+1]
	pop p,pb			; connection is fully created
	aos (p)				; success return
	popj p,

ls rntstk,psisiz
ls bntstk,psisiz			; interrupt stacks
ls rntpdl
ls bntpdl				; interrupt stack pointers

; routine to send a SequinBroken back to sender when a Sequin cannot be
; created
; call: pushj p,breksq
;	pb/ pointer to received packet
; returns: +1, always
breksq: movei pb,tmprec-pbhead
	ldb a,ppupsn			; get source port
	ldb b,ppupsh
	ldb c,ppupss
	movei pb,brkpup-pbhead		; point to space to send break pup
	dpb a,ppupdn			; deposit dest port
	dpb b,ppupdh
	dpb c,ppupd1			; low order bits
	rot c,-^d16			; rotate around high order bits
	dpb c,ppupd0			; and deposit into Pup

	movei pb,tmprec-pbhead		; deposit source host bytes
	ldb a,ppupdn
	ldb b,ppupdh
	movei pb,brkpup-pbhead
	dpb a,ppupsn
	dpb b,ppupsh
	move a,srvjfn			; determine local net, host, socket
	cvskt			
	 ercal jerr
	dpb c,ppupss			; save socket

	movei pb,tmprec-pbhead		; set up sequin fields
	ldb a,seqrec			; receive sequence
	ldb b,seqSen			; get send sequence
	ldb c,puplen			; any data in packet?
	caile c,mnplen	
	 aoj b,				; yes, increment for return recv seq
	movei pb,brkpup-pbhead
	dpb a,seqSen
	dpb b,seqRec
	setz a,				; no Alloc
	dpb a,seqAll
	movei a,seqBro			; say sequin broken
	dpb a,seqCon

	movei a,mnplen
	dpb a,puplen
	movei a,seqtyp
	dpb a,puptyp
	hrr a,srvjfn		; use the server jfn
	hrli a,(1b0+1b1)	; don't block, generate checksum
	movei b,brkpup
	hrli b,mnpbln
	pupo
	 elog <BREKSQ: PUPO error: %1J>
	log <BREKSQ: No room or Data Sequin rcvd for nonexistent connection>
	popj p,

ls brkpup,MXPBLN		; a little longer for superstitious reasons

; routine to send an error pup to sender
; call: pushj p,errPup
;	a/ Error subcode
;	b/ Pointer to asciz string
; returns: +1, always
errPup: push p,a
	tlc b,-1
	tlcn b,-1
	 hrli b,(point 7)
	push p,b
	movei pb,tmprec-pbhead		; swap the ports
	ldb a,ppupsn			; get source port
	ldb b,ppupsh
	ldb c,ppupss
	movei pb,brkpup-pbhead		; point to space to send break pup
	dpb a,ppupdn			; deposit dest port
	dpb b,ppupdh
	dpb c,ppupd1			; low order bits
	rot c,-^d16			; rotate around high order bits
	dpb c,ppupd0			; and deposit into Pup

	movei pb,tmprec-pbhead		; deposit source host bytes
	ldb a,ppupdn
	ldb b,ppupdh
	movei pb,brkpup-pbhead
	dpb a,ppupsn
	dpb b,ppupsh
	move a,srvjfn			; determine local net, host, socket
	cvskt			
	 ercal jerr
	dpb c,ppupss			; save socket
	move a,tmprec+1
	movem a,brkpup+1		; transfer ID (sequin fields)

	move a,[tmprec,,brkpup+5]
	blt a,brkpup+^d9		; transfer original header
	pop p,b
	pop p,a				; recover string ptr and error code
	dpb a,[point 16,brkpup+^d10,15]
	setz a,
	dpb a,[point 16,brkpup+^d10,31]
	move a,[point 8,brkpup+^d11,-1]	; string pointer
	setz d,
errpu1:	ildb c,b			; copy string
	jumpe c,errpu2
	idpb c,a
	aoja d,errpu1			

errpu2:	movei pb,brkpup-pbhead
	movei a,mnplen+^d12		; min error pup len
	addi a,(d)			; add length of string
	trne a,1			; if odd, increment
	 aoj a,
	dpb a,puplen
	movei b,4
	dpb b,puptyp
	movei b,3(a)		; compute # of pdp10 words
	lsh b,-2
	hrlzs b
	hrr a,srvjfn		; use the server jfn
	hrli a,(1b0+1b1)	; don't block, generate checksum
	hrri b,brkpup
	pupo
	 elog <ERRPUP: PUPO error: %1J>
	popj p,

	subttl	PSI utilities

; routine to init psi's
; call: (p)/ jfn on port
psiini::setom intdef
	move a,[iowd psisiz,bntstk] ; do this here because BNTSRV used to...
	movem a,bntpdl		    ; ... run at interrupt level
	move a,[iowd psisiz,rntstk]
	movem a,rntpdl
	move b,[levtab,,chntab]
	movei a,400000		; init PSI's for this fork
	sir
	eir
	move b,[actchn]		; activate used channels
	aic
	move a,[^d26,,^d23]	; assign ^Z interrupt to channel 23
	ati
	move a,-1(p)		; set received pup interrupt
	movei b,24
	move c,[36b5+1b11+36b17]; chan 1 is recvd interrupt
	mtopr
	popj p,

; PSI channel definitions
define psi(ch,lev,disp),<
actchn==actchn!1b<ch>
	reloc chntab+^d<ch>
	lev,,disp
>

actchn==0
chntab::psi(1,3,rntsrv)		; receiver service
	psi(9,1,pdlovf)		; Pushdown overflow
	psi(11,1,daterr)	; Data error
	psi(15,1,illins)	; Illegal instruction
	psi(16,1,illred)	; Illegal read
	psi(17,1,illwrt)	; Illegal write
	psi(18,1,illxct)	; Illegal execute
	psi(20,1,illsiz)	; Machine size exceeded
	psi(23,1,kilsrv)	; ^Z interrupt to kill server

	reloc chntab+^d36

levtab::lev1pc
	lev2pc
	lev3pc

; Fatal errors

pdlovf::jsr crashx
	asciz /Pushdown overflow/

daterr::jsr crashx
	asciz /IO data error/

illred::jsr crashx
	asciz /Illegal read/

illwrt::jsr crashx
	asciz /Illegal write/

illxct::jsr crashx
	asciz /Illegal execute/

illsiz::jsr crashx
	asciz /Machine size exceeded/

; Common code for fatal error interrupts
crashx:	0
	push p,lev1pc		; Put trap pc on stack
	push p,b
	hrro b,crashx		; Make call pc into string ptr
	jrst screw1

jerr::	push p,b
	hrroi b,temp##
	write b,<%1J%/>
	hrroi b,temp##
	jrst screw1

screwup::
	push p,b
	hrroi b,[asciz/A fatal error has occurred/]
screw1:	push p,a		; don't clobber any acs
	hrrz a,-2(p)		; get caller
	soj a,			; decrement for true address
	log <%2S at %1O%/%/>
	time			; get now
	subm a,crstim		; compute how long ago we last crashed
	exch a,crstim
	caige a,^d<60*1000>	; longer than a minute?
	 jrst  [elog <Too-frequent crashes, aborting...>
		pushj p,dmplog##
		haltf
		jrst srvstt##]
	elog <Leaf server crashed, restarting...>
	pushj p,dmplog##
	jrst srvstt##

ls crstim

; here to handle illegal instruction
illins::push p,a		; Not sumex, try to do ERCAL
	push p,b
	hrrz a,lev1pc
	hllz b,(a)		; Get instruction after error
	camn b,[ERCAL]		; Is it an ERCAL?
	 jrst [hrrz a,lev1pc	; Yes, simulate ERCAL to error routine
	       hrrz b,(a)	; Get address of error routine
	       movem b,psiret	; store it
	       aoj a,		; Adjust return address from interrupt
	       pop p,b
	       exch a,(p)	; Store new return address
	       jrst @psiret]	; Jump into error routine
	hllz b,-1(a)		; Not ERCAL, did a JSYS get us?
	camn b,[JSYS 0]		; Was it a JSYS?
	 jrst  [movei a,400000
		geter
		movei a,(b)	; isolate error number
		hrroi b,temp
		write b,<Fatal JSYS error %1J>
		pop p,b		; mung stack
		pop p,a
		push p,lev1pc
		push p,b
		hrroi b,temp
		jrst screw1]
	pop p,b
	pop p,a			; Not JSYS, handle as with other errors
	jsr crashx		
	asciz /Illegal instruction/

ls psiret,1			; Location to hold address of error routine

; ^Z interrupt to kill server
kilsrv:	movsi cx,-nconn		; break all connections
	setz a,
	movei b,seqBro		; send sequin brokens
kilsr1:	skipe sq,contab(cx)
	 pushj p,senseq
	aobjn cx,kilsr1
	pushj p,dmplog
	move a,srvjfn		; close the socket
	closf
	 elog <KILSRV: Unable to close server socket: %1J>
	gtad
	type <%/%/Tenex Leaf Server halted at %1T>
	haltf
	jrst srvstt##
	subttl	Storage
ls soc44		; 0 = use soc 43, -1 = use soc 44 for debugging
ls bntacs,20		; storage for background process acs
ls rntacs,20		; storage for recv interrupt acs

; tables indexed by CX
gs contab,nconn		; connection table
gs rxtime,nconn		; receiver timeout
gs txtime,nconn		; transmitter timeout
gs pupfsk,nconn		; table of foreign sockets, indexed by cx
gs pupfnh,nconn		; table of foreign net,,host, index by cx
gs ltime,nconn		; local timeout (connection,,filelock)
gs ftime,nconn		; foreign timeout (connection,,filelock)
gs connfk,nconn		; fork for leaf server, indexed by cx

gs nactcn,1		; holds number of active connections
ls contro,1		; control word from received packet
ls frepnt,1		; free space pointer for ASGFRE
ls sndtmp,MXPBLN	; temporary send buffer
ls tmprec,MXPBLN	; temporary receive buffer

ls lev1pc,1
ls lev2pc,1
ls lev3pc,1

gs txtab,lqutab*nconn
gs rxtab,lqutab*nconn

gs sqbtab,sqblen*nconn

	end