;<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 [push p, a
movei a,↑D100
disms
pop p, a
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