;<PUP>EFTP.MAC;7     2-SEP-79 15:55:42    EDIT BY TAFT
;<PUP>EFTP.MAC;6    17-JUN-78 14:07:16    EDIT BY TAFT
; Fix ESDATA to zero out the transport control byte
;<PUP>EFTP.MAC;5    28-FEB-77 18:34:57    EDIT BY TAFT
; Revise timeout mechanism to fix races
;<PUP>EFTP.MAC;4    10-JAN-77 15:53:22    EDIT BY TAFT
; Fix possibly incorrect abort procedure in timer interrupt

; Copyright 1979 by Xerox Corporation

	TITLE EFTP -- EASY FILE TRANSFER PROTOCOL
	SUBTTL E. A. Taft / October, 1976

	SEARCH STENEX


; Accumulator assignments

	A=1		; General scratch
	B=2
	C=3
	D=4

	S=6		; Pointer to EFTP socket
	PB=7		; Pointer to packet buffer

	P=17		; Stack


; Parameters and byte pointers defining the structure of a Packet Buffer (PB)

PBHEAD==0	; Start of Pup Header
 PUPLEN: POINT 16,PBHEAD(PB),15	; Pup Length
 PUPTCB: POINT 8,PBHEAD(PB),23	; Transport Control Byte
 PUPTYP: POINT 8,PBHEAD(PB),31	; Pup Type

; PBHEAD+1
 ; B0-31			; Pup ID

; PBHEAD+2
 PPUPDN: POINT 8,PBHEAD+2(PB),7	; Destination Network
 PPUPDH: POINT 8,PBHEAD+2(PB),15  ; Destination Host
 PPUPD0: POINT 16,PBHEAD+2(PB),31  ; High 16 bits of Destination Socket

; PBHEAD+3
 PPUPD1: POINT 16,PBHEAD+3(PB),15  ; Low 16 bits of Destination Socket
 PPUPSN: POINT 8,PBHEAD+3(PB),23  ; Source Network
 PPUPSH: POINT 8,PBHEAD+3(PB),31  ; Source Host

; PBHEAD+4
 PPUPSS: POINT 32,PBHEAD+4(PB),31  ; Source Socket

PBCONT==PBHEAD+5  ; Start of Pup Contents

MNPLEN==^D22	; Minimum Pup Length (bytes), incl header and checksum
MXPLEN==^D554	; Maximum Pup Length
MNPBLN==<MNPLEN+3>/4  ; Minimum size of PB, in words
MXPBLN==<MXPLEN+3>/4  ; Maximum size of PB, in words

; Structure of the local EFTP socket

SOCJFN==0	; Pup JFN opened in raw packet mode
SOCSEQ==1	; Current sequence number
SOCFRK==2	; Inferior timer fork
SOCCHN==3	; Interrupt channel number
SOCTIM==4	; Timeout interval (ms)
SOCTC==5	; Timeout countdown
SOCLTT==6	; Long-term timeout expiration time
SOCSTM==7	; Starting time for round-trip delay measurement
SOCLNH==10	; Local net/host
SOCLSK==11	; Local socket
SOCFNH==12	; Foreign net/host
SOCFSK==13	; Foreign socket


; EFTP parameters

MINTIM==^D250	; Minimum timeout interval (ms)
MAXTIM==^D5000	; Maximum timeout interval (ms)
INITIM==^D1000	; Initial timeout interval (ms)
DLYTIM==^D5000	; Dally timeout interval (ms)
LACKPB==^D25	; Space allocated for Ack PB (words)

; Pup Types

PT.DAT==30	; EFTP Data
PT.ACK==31	; EFTP Acknowledgment
PT.END==32	; EFTP End
PT.ABT==33	; EFTP Abort

; EFTP Abort codes

AC.ESA==1	; External Sender Abort
AC.ERA==2	; External Receiver Abort
AC.RBA==3	; Receiver Busy Abort
AC.OSA==4	; Out of Sync Abort

; Open EFTP socket
;	A/ Pointer to ^D20-word region for EFTP socket info block
;	B/ JFN for port opened in raw packet mode
;	C/ Interrupt channel to use for timer fork
;	   -1 => Pick any free one
; Returns +1:  Unsuccessful
;	+2:  Successful
; If it is intended to send thru this port, then the JFN
; must designate a specific foreign port.  The local net/host
; need not be specified and will be defaulted.
; It is assumed that the interrupt system is enabled and that
; levtab and chntab have been set up properly.  Level 3 is used,
; so levtab+2 must point somewhere reasonable.
; Clobbers A-D

EOPEN::	PUSH P,S
	MOVEI S,(A)
	MOVEM B,SOCJFN(S)	; Remember flags and JFN
	SETZM SOCSEQ(S)		; Initialize sequence number
	SETOM SOCTC(S)		; Reset timeout counter
	MOVEI A,INITIM		; Initialize timeout interval
	MOVEM A,SOCTIM(S)

; Create and start timer fork
	MOVE A,[1B0+1B1+1B3+1B4+XWAIT]  ; Map, caps same as mine
	SETZ B,			; Ac's same as mine
	CFORK
	 JRST ECLOS2		; Failed, return +1
	MOVEM A,SOCFRK(S)	; Ok, save fork handle

; Initialize timer interrupt
	JUMPGE C,EOPEN1		; Given specific channel?
	MOVEI A,400000		; No, find a free one
	RCM			; Read currently active channels
	SETCM B,A		; Make ones be inactive channels
	AND B,[770000007777]	; Omit system-defined channels
	JFFO B,.+2		; Find first free channel
	 JRST ECLOS1		; None available, kill fork

; Now C/ interrupt channel to use
EOPEN1:	MOVEM C,SOCCHN(S)	; Remember channel number
	MOVEI A,400000		; Get this fork's levtab,,chntab
	RIR
	ADDI B,(C)		; Make ptr to dispatch word
	MOVE D,[3,,TIMINT]	; Level 3, timer dispatch
	MOVEM D,0(B)		; Insert into chntab
	MOVN A,SOCCHN(S)	; Get -channel #
	MOVSI B,(1B0)		; Make channel mask
	LSH B,(A)
	MOVEI A,400000		; This fork
	AIC			; Activate the channel

; EOPEN (cont'd)

; Discover local and foreign port addresses
	HRRZ A,SOCJFN(S)	; Get JFN
	CVSKT			; Return local port
	 JRST ECLOS0		; Unsuccessful
	MOVEM B,SOCLNH(S)	; Store in socket info block
	MOVEM C,SOCLSK(S)
	MOVEI C,SOCFNH(S)	; Where to put foreign port
	HRLI C,2
	GDSTS			; Return foreign port
	MOVEI A,20
	SKIPN SOCFSK(S)		; Foreign socket specified?
	 MOVEM A,SOCFSK(S)	; No, use standard
	HLRZ A,SOCLNH(S)	; See if local net specified
	JUMPN A,EOPEN3
	HLRZ C,SOCFNH(S)	; No, check foreign net
	JUMPE C,EOPEN3		; 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
	 JRST ECLOS0
	TRNN A,-1		; Are we directly connected?
	 LDB C,[POINT 8,A,9]	; No, use net of gateway
	HRLM C,SOCLNH(S)	; Establish local net
EOPEN3:	POP P,S
	AOS 0(P)		; Skip return
	POPJ P,



; Close EFTP socket
;	A/ Pointer to EFTP socket info block
; Returns +1 always
; Does not close the local port whose JFN was passed to EOPEN
; Clobbers A, B

ECLOSE::PUSH P,S
	MOVEI S,(A)
ECLOS0:	MOVN A,SOCCHN(S)	; Deactivate timer interrupt
	MOVSI B,(1B0)
	LSH B,(A)
	MOVEI A,400000
	DIC
ECLOS1:	MOVE A,SOCFRK(S)	; Kill timer fork
	KFORK
ECLOS2:	POP P,S
	POPJ P,



; Reset EFTP socket in preparation for starting a new transfer.
; Equivalent to calling ECLOSE followed by EOPEN with the same
; parameters.
;	A/ Pointer to EFTP socket info block
; Returns +1

ERESET::SETZM SOCSEQ(A)		; Just zero the sequence number
	POPJ P,

; EFTP Send Data
;	A/ Pointer to EFTP socket info block
;	B/ Pointer to PB containing data to be sent
;	C/ Number of data bytes to be sent
;	D/ Timeout in ms
; Returns +1:  Unsuccessful, code in A[rh] says why:
;		-1: timed out
;		0-177777: Abort received, this is the Abort code
;		>177777: unaccountable Tenex jsys error
;		In the Abort case, the abort is copied into PB,
;		a byte pointer to the abort text is returned in B,
;		and the length of the abort text returned in C.
;	+2:  Successful
; Clobbers A-D

ESDATA::HRLI B,PT.DAT		; Remember Pup type = EFTP Data
ESDAT0:	PUSH P,S		; Enter here from End code
	PUSH P,PB
	ADD P,[LACKPB,,LACKPB]	; Reserve space for received ack
	MOVEI S,(A)
	MOVEI PB,(B)
	SETZM PBHEAD(PB)	; In particular, zero transport control
	ADDI C,MNPLEN		; Compute Pup length
	DPB C,PUPLEN		; Store in Pup
	HLRZ A,B		; Set Pup type
	DPB A,PUPTYP
	MOVE A,SOCSEQ(S)	; Set Pup ID = sequence #
	LSH A,4
	MOVEM A,PBHEAD+1(PB)
	PUSHJ P,DEFPRT		; Default ports
	TIME			; Get now
	MOVEM A,SOCSTM(S)	; Set starting time
	ADD A,D			; Set long-term timeout
	MOVEM A,SOCLTT(S)
	MOVSI PB,(PB)		; Put outgoing PB ptr in lh
	HRRI PB,-LACKPB+1(P)	; Where to put reply Pup

; Loop here to retransmit
ESDAT1:	TIME			; Get now
	CAML A,SOCLTT(S)	; Long-term timeout expired?
	 JRST [	MOVEI A,-1	; Yes, error code = -1
		JRST ESDATX]	; Fail return
	HRRZ A,SOCJFN(S)	; Get port JFN
	HRLI A,(1B1)		; Generate Pup checksum
	HLRZ B,PB		; Pointer to outgoing Pup
	HRLI B,MXPBLN
	PUPO			; Send the Pup
	 JRST ESDATX		; Failed, give fail return

; Wait for a reply
ESDAT2:	MOVEI A,2		; Reset timeout counter, get old
	EXCH A,SOCTC(S)
	JUMPGE A,ESDAT3		; Timer fork already active?
	HRRZ A,SOCFRK(S)	; No, restart it
	HFORK
	SOS SOCTC(S)
	MOVEI B,TIMFRK
	SFORK

ESDAT3:	HRRZ A,SOCJFN(S)	; Get port JFN
	HRLI A,(1B1+1B2)	; Check checksum and source address
	MOVEI B,-LACKPB+1(P)	; Where to put received packet
	HRLI B,LACKPB
	PUSHJ P,XPUPI		; Wait for reply
	 JRST [	CAIE A,PUPX3	; Failed, timed out?
		 JRST ESDAT3	; No, keep waiting
		PUSHJ P,UPDTIM	; Yes, update timeout interval
		JRST ESDAT1]	; Retransmit

; ESDATA (cont'd)

; Here when got a reply
	MOVE A,PBHEAD+1(PB)	; Get Pup ID
	LSH A,-4		; Right-justify
	CAME A,SOCSEQ(S)	; Correct sequence number?
	 JRST ESDAT3		; No, ignore
	LDB A,PUPTYP		; Yes, get type
	CAIN A,PT.ACK		; EFTP Ack?
	 JRST [	AOS -LACKPB-2(P)  ; Yes, preset skip return
		AOS SOCSEQ(S)	; Increment sequence number
		PUSHJ P,UPDTIM	; Update timeout interval
		JRST ESDATX]	; Go return
	CAIE A,PT.ABT		; EFTP Abort?
	 JRST ESDAT3		; No, ignore
	PUSHJ P,UPDTIM		; Yes, update timeout interval
	MOVSS A,PB		; Copy Abort into caller's PB
	BLT A,LACKPB-1(PB)
	LDB A,[POINT 16,PBCONT(PB),15]  ; Return Abort type
	MOVEI B,PBCONT(PB)	; Make byte ptr to abort text
	HRLI B,(POINT 8,,15)
	LDB C,PUPLEN		; Return text length
	CAILE C,4*LACKPB
	 MOVEI C,4*LACKPB
	SUBI C,MNPLEN+2

; Here to return
ESDATX:	SETZM SOCTC(S)		; Disable timeout interrupt
	SUB P,[LACKPB,,LACKPB]	; Flush junk off stack
	POP P,PB
	POP P,S
	POPJ P,



; EFTP Send End
;	A/ Pointer to EFTP socket info block
;	D/ Timeout in ms
; Returns +1:  Unsuccessful, code in A[rh] says why:
;		-1: timed out
;		0-177777: Abort received, this is the Abort code
;		>177777: unaccountable Tenex jsys error
;		In the Abort case, the abort text is lost.
;	+2:  Successful
; Clobbers A-D

ESEND::	PUSH P,S
	ADD P,[LACKPB,,LACKPB]
	MOVEI S,(A)
	MOVEI B,-LACKPB+1(P)	; Place to build EFTP End Pup
	HRLI B,PT.END		; Specify Pup type
	SETZ C,			; Zero data bytes
	PUSHJ P,ESDAT0		; Send the End, wait for Ack
	 JRST ESEND2		; Failed, give up
	MOVEI B,-LACKPB+1(P)	; Succeeded, make pointer to Pup
	MOVE A,SOCSEQ(S)	; Get updated seq no.
	LSH A,4			; Put in End Pup
	MOVEM A,PBHEAD+1(B)
	HRRZ A,SOCJFN(S)	; Prepare to send second End
	HRLI A,(1B1)		; Generate Pup checksum
	HRLI B,MXPBLN
	PUPO			; Send it to terminate dally
	 CAI			; Ignore failure
	AOS -LACKPB-1(P)	; Preset skip return
ESEND2:	SUB P,[LACKPB,,LACKPB]	; Flush junk off stack
	POP P,S
	POPJ P,

; EFTP Send Abort
;	A/ Pointer to EFTP socket info block
;	B/ Tenex string pointer to abort text
;	C/ Abort code
; If B0 of A is set, then PB points to a Pup in response to which
; an abort should be generated.  Normally the abort is sent to
; the foreign port given in the EFTP socket info block.
; Returns +1 always
; Clobbers A-D

ESABT::	PUSH P,S
	PUSH P,PB
	ADD P,[LACKPB,,LACKPB]	; Reserve space for PB
	MOVEI PB,-LACKPB+1(P)	; Make pointer to it
	SETZM PBHEAD(PB)	; In particular, zero transport control
	MOVE S,A
	DPB C,[POINT 16,PBCONT(PB),15]  ; Store Abort code
	MOVEI A,PBCONT(PB)	; Where to put Abort text
	HRLI A,(POINT 8,,15)
	MOVEI C,4*<LACKPB-MNPBLN>-2  ; Max number of bytes
	SETZ D,			; Terminate on null
	SOUT			; Copy abort string into Pup
	SKIPE C			; Was string smaller than max?
	 SUBI C,1		; Yes, don't include terminator
	MOVEI A,4*<LACKPB-MNPBLN>-2+MNPLEN  ; Compute Pup length
	SUBI A,(C)
	DPB A,PUPLEN
	MOVEI A,PT.ABT		; Pup Type = EFTP Abort
	DPB A,PUPTYP
	MOVE A,SOCSEQ(S)	; Use current sequence number
	LSH A,4
	MOVEM A,PBHEAD+1(PB)
	JUMPL S,[MOVE A,-LACKPB(P)  ; Get Pup we are responding to
		MOVSI A,PBHEAD+1(A)  ; Copy its ID and ports into
		HRRI A,PBHEAD+1(PB)  ;  the new PB
		BLT A,PBHEAD+4(PB)
		PUSHJ P,EXCHPT	; Exchange source and dest ports
		JRST .+2]
	PUSHJ P,DEFPRT		; In normal case, default ports
	HRRZ A,SOCJFN(S)	; Get port JFN
	HRLI A,(1B1)		; Generate Pup checksum
	MOVEI B,(PB)		; Pointer to outgoing Pup
	HRLI B,MXPBLN
	PUPO			; Send the Pup
	 CAI			; Ignore failure
	SUB P,[LACKPB,,LACKPB]	; Flush junk from stack
	POP P,PB
	POP P,S
	POPJ P,

; EFTP Receive Data
;	A/ Pointer to EFTP socket info block
;	B/ Pointer to PB in which to receive data
;	D/ Timeout in ms
; Returns +1:  Unsuccessful, code in A[rh] says why:
;		-4: Abort sent
;		-3: Reset received
;		-2: EFTP End received
;		-1: timeout
;		0-177777: Abort received, this is the Abort code
;		>177777: unaccountable Tenex jsys error
;		The Abort sent case occurs if we receive a Data or
;		End Pup with an improper sequence number.  In this
;		case, an "Out of Sequence" Abort has been sent.
;		In the Reset case, a Data Pup was received with
;		sequence number zero when we were expecting a
;		nonzero sequence number.  This suggests that
;		the sender aborted and restarted transmission.
;		In the Abort received case the abort is copied into PB,
;		a byte pointer to the abort text is returned in B,
;		and the length of the abort text returned in C.
;	+2:  Successful
;		The number of data bytes received is returned in C.

ERDATA::PUSH P,S
	PUSH P,PB
	MOVEI S,(A)		; Lh _ 0 (used for flags)
	MOVEI PB,(B)
	LSH D,-1		; Divide timeout by 2
	MOVEM D,SOCTIM(S)	; Store as timeout interval
	MOVEI A,3		; Reset timeout counter to use
	EXCH A,SOCTC(S)		;  between 2 and 3 of these
	JUMPGE A,ERDAT1		; Timer fork already active?
	HRRZ A,SOCFRK(S)	; No, restart it
	HFORK
	SOS SOCTC(S)
	MOVEI B,TIMFRK
	SFORK

; Wait for a packet to arrive or timeout to occur
ERDAT1:	HRRZ A,SOCJFN(S)	; Get port JFN
	HRLI A,(1B1+1B2)	; Check checksum and source address
	MOVEI B,(PB)
	HRLI B,MXPBLN
	PUSHJ P,XPUPI
	 JRST [	CAIE A,PUPX3	; Failed, timed out?
		 JRST ERDAT1	; No, keep waiting
		MOVEI A,-1	; Yes, failure code = -1
		TLNE S,(1B1)	; Were we in dally state?
		 MOVEI A,-2	; Yes, normal end code
		JRST ERDATX]	; Fail return

; See if the packet is from the correct source
	LDB B,PPUPSN		; Get source net
	LDB A,PPUPSH		; Get source host
	HRLI A,(B)		; Make net,,host
	LDB B,PPUPSS		; Get source socket
	SKIPN SOCSEQ(S)		; Have we seen any data yet?
	 JRST [	LDB C,PUPTYP	; No, is it an EFTP Data Pup?
		CAIE C,PT.DAT
		 JRST ERDAT3	; No, go send Out of Sequence abort
		MOVEM A,SOCFNH(S)  ; Yes, remember foreign port
		MOVEM B,SOCFSK(S)
		LDB A,PPUPDN	; Get net/host sender sent to
		LDB B,PPUPDH
		HRLI B,(A)
		MOVEM B,SOCLNH(S)  ; Use that for local port
		JRST ERDAT2]
	CAMN A,SOCFNH(S)	; Is it from the correct source?
	CAME B,SOCFSK(S)
	 JRST [	MOVEI A,(S)	; No, send Receiver Busy Abort
		HRLI A,(1B0)	; To source of PB
		HRROI B,[ASCIZ /EFTP Receiver busy/]
		MOVEI C,AC.RBA
		PUSHJ P,ESABT
		JRST ERDAT1]	; Keep waiting

; ERDATA (cont'd)

; Got packet from correct source.  Now see if in sequence
ERDAT2:	MOVE A,PBHEAD+1(PB)	; Get Pup ID
	LSH A,-4		; Right-justify
	MOVE B,A		; Copy it
	SUB A,SOCSEQ(S)		; Compare to expected sequence no
	JUMPE A,ERDAT4		; Jump if equal
	AOJE A,ERDAT5		; Jump if retransmission
	JUMPE B,[LDB A,PUPTYP	; Perhaps a reset, check type
		CAIE A,PT.DAT	; Is it EFTP Data?
		 JRST ERDAT1	; No, ignore
		MOVEI A,-3	; Yes, return code -3: Reset
		JRST ERDATX]
ERDAT3:	MOVEI A,(S)		; Send Out Of Sequence Abort
	HRLI A,(1B0)		; To source of PB
	HRROI B,[ASCIZ /EFTP packet out of sequence/]
	MOVEI C,AC.OSA
	PUSHJ P,ESABT
	MOVEI A,-4		; Return code -4: Abort sent
	JRST ERDATX

; Packet in sequence.  Now see what it is
ERDAT4:	TLZA S,(1B0)		; This is a new packet
ERDAT5:	 TLO S,(1B0)		; This is a retransmission
	LDB A,PUPTYP		; Get Pup type
	CAIN A,PT.ABT		; Abort?
	 JRST [	LDB A,[POINT 16,PBCONT(PB),15]  ; Yes, get type
		MOVEI B,PBCONT(PB)  ; Make byte ptr to text
		HRLI B,(POINT 8,,15)
		LDB C,PUPLEN	; Return text length
		SUBI C,MNPLEN+2
		JRST ERDATX]
	CAIN A,PT.DAT		; EFTP Data?
	 JRST ERDAT6		; Yes
	CAIE A,PT.END		; EFTP End?
	 JRST ERDAT1		; No, discard
	MOVEI A,-2		; Yes, set End code
	TLNE S,(1B1)		; Second End?
	 JUMPGE S,ERDATX	; Yes, return if not retransmission

ERDAT6:	TLNE S,(1B0)		; Retransmission?
	 SOS SOCSEQ(S)		; Yes, back up sequence number
	PUSHJ P,SNDACK		; Send acknowledgment
	 JRST ERDATX		; Failed
	AOS SOCSEQ(S)		; Advance sequence number
	JUMPL S,ERDAT1		; Await new Pup if retransmission
	LDB A,PUPTYP		; Check type
	CAIN A,PT.END		; End?
	 JRST [	TLO S,(1B1)	; Yes, remember End seen
		HRRZ A,SOCFRK(S)  ; Stop timer fork
		HFORK
		MOVEI B,DLYTIM	; Set dally timeout
		MOVEM B,SOCTIM(S)
		MOVEI B,1	; Reset timeout counter
		MOVEM B,SOCTC(S)
		MOVEI B,TIMFRK	; Restart timer fork
		SFORK
		JRST ERDAT1]	; Await second End

; Have new Data packet, return it
	LDB C,PUPLEN		; Get Pup length
	SUBI C,MNPLEN		; Compute data bytes
	AOS -2(P)		; Preset skip return

; Here to return
ERDATX:	SETZM SOCTC(S)		; Disable timeout interrupt
	POP P,PB
	POP P,S
	POPJ P,

; Send acknowledgment
;	S/ Pointer to EFTP socket info block
; Returns +1:  Unsuccessful, A/ jsys error code
;	+2:  Successful
; Clobbers A-D

SNDACK:	PUSH P,PB
	ADD P,[MNPBLN,,MNPBLN]	; Reserve space for Ack
	MOVEI PB,-MNPBLN+1(P)	; Make pointer to it
	SETZM PBHEAD(PB)	; In particular, zero transport control
	MOVEI C,MNPLEN		; Set Pup length
	DPB C,PUPLEN
	MOVEI C,PT.ACK		; Set Pup type
	DPB C,PUPTYP
	MOVE A,SOCSEQ(S)
	LSH A,4			; Set Pup ID
	MOVEM A,PBHEAD+1(PB)
	PUSHJ P,DEFPRT		; Default source and dest ports
	HRRZ A,SOCJFN(S)	; Send off the Pup
	HRLI A,(1B1)
	MOVEI B,(PB)
	HRLI B,MNPBLN
	PUPO
	 JRST .+2		; Failed
	AOS -MNPBLN-1(P)	; Succeeded, return +2
	SUB P,[MNPBLN,,MNPBLN]	; Flush stuff from stack
	POP P,PB
	POPJ P,



; Default source and destination ports in Pup
;	S/ Pointer to EFTP socket info block
;	PB/ Pointer to Pup
; Returns +1
; Clobbers A

DEFPRT:	HLRZ A,SOCFNH(S)	; Set dest net
	DPB A,PPUPDN
	HRRZ A,SOCFNH(S)	; Set dest host
	DPB A,PPUPDH
	MOVE A,SOCFSK(S)	; Set dest socket
	DPB A,PPUPD1
	LSH A,-^D16
	DPB A,PPUPD0
	HLRZ A,SOCLNH(S)	; Set source net
	DPB A,PPUPSN
	HRRZ A,SOCLNH(S)	; Set source host
	DPB A,PPUPSH
	MOVE A,SOCLSK(S)	; Set source socket
	DPB A,PPUPSS
	POPJ P,


; Exchange source and destination ports
;	PB/ Pointer to Pup
; Returns +1
; Clobbers A, B

EXCHPT:	MOVE A,PBHEAD+2(PB)	; Get dest net/host/high socket
	MOVE B,PBHEAD+3(PB)	; Get dest low socket
	LSH A,-4		; Concatenate socket
	LSHC A,-^D16		;  and right-justify dest net/host
	EXCH B,PBHEAD+4(PB)	; Exchange source and dest sockets
	LSH A,^D20		; Left-justify dest net/host
	LSH B,-4		; Right-justify source socket
	ROTC A,-^D16		; Concatenate src low skt to dest net/host
	EXCH A,PBHEAD+3(PB)	; Exchange for dst low skt, src net/host
	LSH A,-4		; Right-justify
	LSH B,^D20		; Left-justify source high socket
	LSHC A,-^D16		; Concatenate src net/host/high skt
	MOVEM B,PBHEAD+2(PB)	; Store in header
	POPJ P,

; Timer fork
; SOCTC(S) reflects the state of this fork.
; Each time it wakes up, it decrements and tests SOCTC(S).
; If it becomes exactly zero, a timeout interrupt is initiated.
; If it becomes less than zero, the fork hangs indefinitely
; until restarted.

TIMFRK:	MOVE A,SOCTIM(S)	; Get timeout
	DISMS			; Wait that amount of time
	SOSLE A,SOCTC(S)	; Test timeout counter
	 JRST TIMFRK		; No timeout, just loop
	JUMPL A,XWAIT		; Just hang if timeout not armed
	MOVN A,SOCCHN(S)	; Timed out, get -channel #
	MOVSI B,(1B0)		; Make channel mask
	LSH B,(A)
	MOVEI A,-1		; My superior fork
	IIC			; Initiate interrupt on channel
	JRST TIMFRK		; Go around once more

XWAIT:	WAIT			; Hang indefinitely


; Timer interrupt routine

TIMINT:	PUSH P,B		; Preserve ac's
	PUSH P,A
	MOVEI A,400000		; Read levtab,,chntab
	RIR
	HLRZ B,B		; Get pointer to levtab
	HRRZ B,2(B)		; Get level 3 entry
	HRRZ A,0(B)		; Get interrupt pc
	CAIL A,XPUPI		; In critical section?
	CAILE A,XPUPIE
	 JRST .+3		; No, ignore interrupt
	MOVEI A,XPUPIF		; Yes, force PUPI timeout failure
	MOVEM A,0(B)
	POP P,A
	POP P,B
	DEBRK


; The PUPI known about by the timeout mechanism
XPUPI:	SKIPG SOCTC(S)		; Already timed out?
	 JRST XPUPIF		; Yes
	PUPI			; No, do the PUPI
XPUPIE:	 POPJ P,		; Failed, return +1
	AOSA 0(P)		; Succeeded, return +2
XPUPIF:	 MOVEI A,PUPX3		; Timeout forces control to here
	POPJ P,


; Update timeout interval
;	S/ EFTP socket info block
; Returns +1
; Clobbers A, B

UPDTIM:	TIME			; Get now
	SUB A,SOCSTM(S)		; Compute delay interval
	CAIG A,MINTIM		; Limit to reasonable bounds
	 MOVEI A,MINTIM
	CAIL A,MAXTIM
	 MOVEI A,MAXTIM
	MOVE B,SOCTIM(S)	; Get old timeout interval
	LSH B,3			; Compute 7 * old interval
	SUB B,SOCTIM(S)
	ADD B,A			; + new interval
	LSH B,-3		; / 8
	MOVEM B,SOCTIM(S)	; Store new timeout interval
	POPJ P,


	END