;<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