; UPD ID= 2196, SNARK:<6.1.MONITOR>TCPJFN.MAC.10, 5-Jun-85 11:21:04 by MCCOLLUM ;TCO 6.1.1406 - Update copyright notice. ; UPD ID= 1705, SNARK:<6.1.MONITOR>TCPJFN.MAC.9, 31-Mar-85 13:16:59 by PAETZOLD ;TCO 6.1.1301 - Fix ;local-host and ;foreign-host by fixing HSTHST. ; UPD ID= 1420, SNARK:<6.1.MONITOR>TCPJFN.MAC.8, 29-Jan-85 11:37:57 by PAETZOLD ;TCO 6.1.1161 - Do not leave JFN locked in a few places. ; UPD ID= 1254, SNARK:<6.1.MONITOR>TCPJFN.MAC.7, 1-Jan-85 16:48:51 by PAETZOLD ;Fix major case of EBD where not using index register when playing with TCDPU ;and TCDUR in some cases. ; UPD ID= 1085, SNARK:<6.1.MONITOR>TCPJFN.MAC.6, 16-Nov-84 16:27:01 by PAETZOLD ;More TCO 6.1041 - Make the GTOKM conditional ; UPD ID= 1042, SNARK:<6.1.MONITOR>TCPJFN.MAC.5, 12-Nov-84 15:26:48 by PAETZOLD ;TCO 6.1041 - Move ARPANET to XCDSEC ; UPD ID= 290, SNARK:TCPJFN.MAC.10, 24-Sep-84 13:55:47 by PURRETTA ;Update copyright notice. ; UPD ID= 275, SNARK:TCPJFN.MAC.9, 7-Sep-84 17:34:25 by PAETZOLD ;Zero FILTCB after ABORT%s. ;Make TCPNAM and TCPEXT use one error return. ;Fix range check for type of service atttribute value. ; UPD ID= 270, SNARK:TCPJFN.MAC.8, 5-Sep-84 16:14:37 by PAETZOLD ;Use correct index register in dispatch in IPOPAP. ; UPD ID= 235, SNARK:TCPJFN.MAC.7, 16-Aug-84 11:09:52 by PAETZOLD ;Use RETBAD instead of RETERR for TCPX35 in TCPOPN. ;Be NOINT during IPOPR% functions. ; UPD ID= 228, SNARK:TCPJFN.MAC.6, 7-Aug-84 22:28:05 by PAETZOLD ;TCO 6.2164 - Use an index register when setting timeouts in ATTTIM ; UPD ID= 187, SNARK:TCPJFN.MAC.5, 16-Jun-84 15:40:10 by PAETZOLD ;Conditional for non release 6 based monitors. ;Easier to put an EA.ENT in TCPOTS than to fix all ENTSKDers for section one ; UPD ID= 179, SNARK:TCPJFN.MAC.4, 10-Jun-84 15:28:02 by PAETZOLD ;Make NI IPOPRs give TCPX44 error if no NI code. ; UPD ID= 108, SNARK:TCPJFN.MAC.3, 12-May-84 18:11:06 by PAETZOLD ;fix typo ; UPD ID= 106, SNARK:TCPJFN.MAC.2, 12-May-84 17:46:56 by PAETZOLD ;Add code for NI IPOPRs. ; UPD ID= 3940, SNARK:<6.MONITOR>TCPJFN.MAC.13, 18-Mar-84 13:09:49 by PAETZOLD ;More TCO 6.1733 - Fix bugs dealing with FX and TCPOTS and FKSTA2. ; UPD ID= 3934, SNARK:<6.MONITOR>TCPJFN.MAC.12, 17-Mar-84 13:01:21 by PAETZOLD ;More TCO 6.1733 - ;Add IPOPR functions for internet bypass manipulation. Fix a bug in ATTRLH. ;Change DISTST to setup FX. Make TCPSIO use TCPOTS instead of INTOOT. Add code ;for .TCSFN function of TCOPR%. Add NTNCTS routine. ; UPD ID= 3915, SNARK:<6.MONITOR>TCPJFN.MAC.11, 13-Mar-84 08:06:11 by PAETZOLD ;More TCO 6.1733 - OKINT in TCPGT2 if ASGRES failed. ; UPD ID= 3903, SNARK:<6.MONITOR>TCPJFN.MAC.10, 12-Mar-84 10:28:49 by PAETZOLD ;More TCO 6.1733 - Use RETBAD and not RETERR in ACJ error return in TCPOP1 ; UPD ID= 3892, SNARK:<6.MONITOR>TCPJFN.MAC.9, 11-Mar-84 10:35:54 by PAETZOLD ;More TCO 6.1733 - ;Remove bad clearing of FILBNI. Maintain FILLEN. Prevent problems induced by ;bad host numbers. Improved default local port stuff. Set ERRF flag so LSTERR ;gets set correctly. Clear TCDCW in TCPABT. Rearrange port privilege check to ;OPENF from GTJFN. Implement TCPOTS scheduler test. Fix CZ%ABT hanging CLOSF%. ;Do SETZM of .TCPBI word as well as .TCPBO word. Clear DEC buffers during ;OPENF%. Fix bad setting of IP parameters. Add TVTJFN routine to allow ATNVTs ;for JFNs. Zero DEC TCB cells in TCPBFD so later users aren't confused. .GOANA ;now function sends foreign host and port info to ACJ. disallow wildcards in ;GTJFN. ; UPD ID= 3821, SNARK:<6.MONITOR>TCPJFN.MAC.8, 29-Feb-84 18:12:47 by PAETZOLD ; More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug Fixes. Cleanup. ;TCPJFN.MAC.20, 7-Dec-83 00:31:32, Edit by PAETZOLD ;TCO 6.1836 - Add code to support .IPGWY function of IPOPR ;Handle different returns for release 6 DTB calls. bug fixes ;TCPJFN.MAC.202, 5-Jul-83 22:31:07, Edit by PAETZOLD ;End of Revision History ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED ;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ; ;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985. ;ALL RIGHTS RESERVED. SEARCH ANAUNV,PROLOG TTITLE (TCPJFN,TCPJFN,< - DEC JSYS Interface for BBN TCP>) Comment \ This module implements the "DEC" JFN JSYS interface to the TOPS-20AN TCP code developed by Bolt, Beranek, and Newman. N.B. The AC Defs in this module are different than the rest of the TCP/IP modules so watch out. \ IFNDEF REL6, IFNDEF NOTYET, STS=P1 JFN=P2 PTR=P3 DEV=P4 F1=P5 TCB=Q1 ;not the same as TCB in other modules FX=Q3 DEFINE SAVEAT, TCPBSZ==100 ;buffer size SUBTTL TCP Device DTB SWAPCD TCPDTB:: ; DTB for TCP: device IFN REL6, ; length of DTB DTBDSP TCPSET ;*Directory setup routine DTBDSP TCPNAM ;*Name lookup DTBDSP TCPEXT ;*Extension lookup DTBDSP TCPVER ;*Version lookup DTBBAD (DESX9) ; Protection insertion DTBBAD (DESX9) ; Account insertion DTBBAD (DESX9) ; Status insertion (temporary permanent etc) DTBDSP TCPOPN ;*Open file DTBDSP TCPQI ;*Byte input DTBDSP TCPQO ;*Byte output DTBDSP TCPCLZ ;*Close file DTBBAD (DESX9) ; Rename DTBBAD (DESX9) ; Delete file DTBBAD (DESX9) ; Dump mode input DTBBAD (DESX9) ; Dump mode output DTBBAD (DESX9) ; Mount device DTBBAD (DESX9) ; Dismount device DTBBAD (DESX9) ; Initialize directory of device DTBBAD (DESX9) ; Do mtape operation DTBDSP TCPGTD ;*Get device status DTBBAD (DESX9) ; Set device status DTBDSP TCPQF ;*Force record out, (soutr jsys) DTBDSP RFTADN ; Read file time and date DTBDSP SFTADN ; Set file time and date DTBDSP TCPFI ;*Set jfn for input DTBDSP TCPFO ;*Set jfn for output DTBDSP TCPATR ;*Check attribute DTBDSP TCPRJF ;*Release jfn TCPDND==. SUBTTL GTJFN Setup Handling ;Format of a TCP: GTJFN string is as follows: ;TCP:[lcl-host-][lcl-port].[f4n-host-][f4n-port][;A1...][;A2...][;A3...] ;Square brackets denote fields which may or may not be present. Not ;all fields may be omitted for any given GTJFN string. IFN REL6, IFE REL6, IFN REL6, ;directory setup SKIPE DECOK ;DEC TCP calls allowed? CALL SKTCPU ;TCP up? RETBAD (TCPX16) ;no TQNE ;any wildcards? RETBAD(GJFX17) ;yes...error NOINT ;stop psi's SKIPE FILTCB(JFN) ;do we have a prototype tcb yet? JRST TCP2RT ;yes so success return MOVX T1,TCBSIZ ;get the size of the tcb CALL GETBLK ;get storage for the prototype tcb SKIPN T1 ;did we get the storage? RETBAD (TCPXX1,) ;no so return with an error MOVEM T1,FILTCB(JFN) ;save the DCB address MOVE TCB,FILTCB(JFN) ;get the TCB AC set up for later use MOVX T2,TCBSIZ ;get the size again CALL CLRBLK ;clear out the TCB STOR JFN,TJFN,(TCB) ;tell the TCB which JFN it belongs too JRST TCP2RT ;tell upper level stuff we suceeded SUBTTL GTJFN File Name, and File Generation Handling IFE REL6, IFN REL6, ;decode gtjfn name string SKIPN TCB,FILTCB(JFN) ;get the TCB address JRST TCPNM3 ;error if does not exist TMNE TCDGN,(TCB) ;have we allready done this? JRST TCP2RT ;yes so do not do it again SETZ T2, ;local host rules CALL HSTPRT ;decode host name and port number from string JRST TCPNM3 ;if error then badness STOR T2,TLH,(TCB) ;save the local host number STOR T2,TOPLH,(TCB) STOR T3,TLP,(TCB) ;save the local port number JE TLH,(TCB),OKRET ;default local host? LOAD T1,TLH,(TCB) ;get the local host CALL NTNCTS ;get out address on that net RETBAD (TCPXX2) LOAD T2,TLH,(TCB) ;get the local host address CAME T2,T1 ;legit address? JRST TCPNM3 ;no OKRET: ;here on success return SETONE TCDGN,(TCB) ;flag that we do not have to do this again TQNE ;do we need to unlock? JRST TCP2RT ;no OKINT ;yes so allow interrupts JRST TCP2RT ;skip 2 return TCPNM3: ;here on error from HSTPRT MOVEI T1,TCPXX2 ;get error code NOKRET: ;here on error return OKINT ;allow interrupts RET ;and return IFE REL6, IFN REL6, ;decode GTJFN version spec SKIPN T1 ;any version stuff? JRST OKRET ;no so return MOVEI T1,TCPXX4 ;get error code JRST NOKRET ;return with error SUBTTL GTJFN File Name Extension Handling IFE REL6, IFN REL6, ;decode GTJFN extension string SKIPN TCB,FILTCB(JFN) ;get the TCB address JRST TCPEX2 ;error if does not exists TMNE TCDGE,(TCB) ;have we allready done this once? JRST OKRET ;yes so do not do it again SETO T2, ;4n host rules CALL HSTPRT ;decode host name and port number from string JRST TCPEX2 ;handle error return STOR T2,TFH,(TCB) ;save the foreign host number STOR T2,TOPFH,(TCB) STOR T3,TFP,(TCB) ;save the foreign port number STOR T3,TOPFP,(TCB) JN TLH,(TCB),OKRET ;non default local host? LOAD T1,TFH,(TCB) ;get the foreign host address CALL NTNCTS ;get our address on the net JRST TCPEX1 ;we do not have one STOR T1,TLH,(TCB) ;save the new local host number STOR T1,TOPLH,(TCB) SETONE TCDGE,(TCB) ;flag so we do not do this again JRST OKRET ;everything is fine TCPEX1: ;here when we have no adr on that net MOVE T1,DEFADR ;get out default address STOR T1,TLH,(TCB) ;this is now our local address STOR T1,TOPLH,(TCB) SETONE TCDGE,(TCB) ;flag so we do not do this again JRST OKRET ;and return to caller TCPEX2: ;here on error from hstprt MOVEI T1,TCPXX3 ;get the error code JRST NOKRET ;error return SUBTTL GTJFN File Name Attribute Handling IFE REL6, IFN REL6, ;here to check attributes from gtjfn TRVAR ;temporary storage SKIPE T1 ;pointer exist? HRLI T1,010700 ;yes...make it a seven bit pointer MOVEM T1,TCPATP ;save the data pointer SKIPN TCB,FILTCB(JFN) ;get the TCB address RETERR(TCPXX5) ;error if no TCB MOVSI T1,-ATRLEN ;build aobjn pointer TCPALP: ;attribute checking loop HLRZ T3,ATRTBL(T1) ;get a code from the table CAME T3,T2 ;is this our attribute? JRST TCPAL2 ;no HRRZ T3,ATRTBL(T1) ;get the dispatch address JRST (T3) ;dispatch to the handling routine TCPAL2: ;here when entry was a match AOBJN T1,TCPALP ;check others if there are more RETBAD (TCPXX5) ;no such attribute ATRTBL: ;table of attribute codes .PFTCN,,ATTRCN ;connection .PFTPR,,ATTPST ;persist .PFTTM,,ATTTIM ;timeout .PFTTS,,ATTTOS ;type-of-service .PFTSC,,ATTSCR ;security .PFTCM,,ATTCMP ;compartment .PFTHR,,ATTHND ;handling-restrictions .PFTTC,,ATTTRC ;transmission control .PFTLH,,ATTRLH ;local-host .PFTFH,,ATTRFH ;foreign host ATRLEN==.-ATRTBL ;number of attributes SUBTTL GTJFN Attribute Argument Support Routines ATTR16: ;routine to read a legal sixteen bit number MOVEI T3,10 ;octal NIN% ;get the parameter RET SKIPL T2 ;positive? CAILE T2,177777 ;legit value? RET ;non-legit value RETSKP ;legit value ATTR18: ;routine to read a legal eighteen bit number MOVEI T3,12 ;decimal NIN% ;get the parameter RET SKIPL T2 ;positive? CAILE T2,777777 ;legit value? RET ;non-legit value RETSKP ;legit value SUBTTL GTJFN Connection Attribute ATTRCN: ;connection attribute MOVE T1,TCPATP ;get the pointer ILDB T1,T1 ;get the first byte CAIE T1,"A" ;is it "ACTIVE" CAIN T1,"A"+40 ;is it "ACTIVE" JRST ATTRC1 ;yes SETZRO TCDFS,(TCB) ;no clear the force sync bit RETSKP ATTRC1: ;it is active SETONE TCDFS,(TCB) ;set the force sync bit RETSKP SUBTTL Foreign-Host and Local-Host, Persist Attributes ATTRFH: ;foreign-host attribute MOVE T1,TCPATP ;get the pointer CALL HSTHST ;decode the host number RETBAD (TCPXX7) ;failure so get error code STOR T2,TFH,(TCB) ;save the foreign host number STOR T2,TOPFH,(TCB) RETSKP ;return success ATTRLH: ;local-host attribute MOVE T1,TCPATP ;get the pointer CALL HSTHST ;decode the host number RETBAD (TCPXX8) ;failure so get error code STOR T2,TLH,(TCB) ;save the local host number STOR T2,TOPLH,(TCB) MOVE T1,T2 ;get host number into correct place CALL NTNCTS ;get our NCT on that net RETBAD (TCPXX8) ;no address LOAD T2,TLH,(TCB) ;get the address user wants CAME T1,T2 ;same? RETBAD (TCPXX8) ;no RETSKP ;return success ATTPST: ;persist attribute MOVE T1,TCPATP ;get the pointer CALL ATTR18 ;get a legal 18 bit number RETBAD (TCPXX9) ;handle errors STOR T2,TPRS1,(TCB) ;save the first parameter SETZRO TPRS2,(TCB) ;zero the other parameter ILDB T2,T1 ;get the next byte CAIE T2,"," ;is it a comma JRST ATTPS2 ;no CALL ATTR18 ;get a legal 18 bit value RETBAD (TCPXX9) STOR T2,TPRS2,(TCB) ;save the second parameter ATTPS2: ;here when we like the parameters SETONE TCDPS,(TCB) ;turn on the persist flag RETSKP ;return success SUBTTL Timeout, Type-of-Service, and Security Attributes ATTTIM: ;timeout time attribute MOVE T1,TCPATP ;get the attribute pointer CALL ATTR18 ;get a legal 18 bit number RETBAD (TCPX10) ;very illegal CAMLE T2,TCPPTM ;is timeout parameter legitimate? MOVE T2,TCPPTM ;no so make it legitimate IMULI T2,^D1000 ;convert to msecs STOR T2,TSTO,(TCB) ;save the timeout parameter RETSKP ;return success ATTTOS: ;type of service attribute ;TCPTCP does not know how to do this yet MOVE T1,TCPATP ;get the attribute pointer MOVEI T3,10 ;octal NIN% ;get the type of service RETBAD (TCPX11) SKIPL T2 ;positive? CAILE T2,377 ;legit value? RETBAD (TCPX11) ;give error STOR T2,TTOS,(TCB) ;store the type of service RETSKP ;return success ATTSCR: ;security attribute MOVE T1,TCPATP ;get the attribute pointer CALL ATTR16 ;get a legal sixteen bit number RETBAD (TCPX12) ;give error STOR T2,TSLVN,(TCB) ;save the security level RETSKP ;return success SUBTTL Compartments, Handling-Restrictions, and Transmission Control Attributes ATTCMP: ;compartments attribute ;TCPTCP does not know how to do this yet MOVE T1,TCPATP ;get the attribute pointer CALL ATTR16 ;get a legal sixteen bit number RETBAD (TCPX13) ;give error RETSKP ;return success ATTHND: ;handling-restrictions attribute ;TCPTCP does not know how to do this yet MOVE T1,TCPATP ;get the attribute pointer CALL ATTR16 ;get a legal sixteen bit number RETBAD (TCPX14) RETSKP ;return success ATTTRC: ;transmission-control attribute ;TCPTCP does not know how to do this yet MOVE T1,TCPATP ;get the attribute pointer CALL ATTR16 ;get a legal sixteen bit number RETBAD (TCPX15) ;give error RETSKP ;return success SUBTTL CLOSF and ABORT Handling IFE REL6, IFN REL6, ;here on a closf SAVEAT ;save most acs STKVAR SKIPN TCB,FILTCB(JFN) ;get the TCB address RETSKP ;if no TCB then success LOAD T1,TJCN,(TCB) ;get the JCN for this connection TXO T1,TCP%JS ;this is a JCN JE TSUOP,(TCB),TCPABT ;if never opened then abort JE TSOPN,(TCB),TCPABT ;if never got opened then abort UMOVE T2,1 ;get users AC 1 TXNE T2,CZ%ABT ;abort? JRST TCPABT ;yes JN TCDCW,(TCB),TCPCLW ;if in close wait get to it CLOSE% ;close down the connection ERJMP TCPCLX ;handle error TCPCLW: ;here also when we were in close wait SETZRO ;no longer blocking LOAD T1,TOPNF,(TCB) ;Get ID of Open Flag for this TCB LOAD T2,TERRF,(TCB) ;Error Flag index MKWAIT INTZOT ;Make scheduler test CALL DISTST ;will we dismiss? JRST TCPCWC ;no so go finish up now SETONE ;tell lower levels we want to block SETONE TCDCW,(TCB) ;set close wait wait flag RET ;return to caller (which will block) TCPCWC: ;here when the close has completed SETZRO TCDCW,(TCB) ;no more CLOSF block LOAD T1,TERR,(TCB) ;Get the error code JUMPN T1,TCPCLX ;Jump if error code non-null LOAD T1,TJCN,(TCB) ;get the JCN TXO T1,TCP%JS ;this is a JCN ABORT% ;abort this JCN ERJMP .+1 ;ignore errors SETZM FILTCB(JFN) ;no more TCB RETSKP ;and return success SUBTTL CLOSF and ABORT Handling TCPABT: ;here on an ABORT close (CZ%ABT on) SETZRO TCDCW,(TCB) ;no more CLOSF block ABORT% ;abort the JCN ERJMP TCPAB2 ;handle errors SETZM FILTCB(JFN) ;no more TCB RETSKP ;success return TCPAB2: ;here on error from ABORT% CALL ERTRAN ;translate the error SETZM FILTCB(JFN) ;no more TCB SETONE ;Flag an error RETBAD ;error return TCPCLX: ;here on an error from the CLOSE% MOVEM T1,TCPCER ;save the error code LOAD T1,TJCN,(TCB) ;get the JCN for this connection TXO T1,TCP%JS ;this is a JCN ABORT% ;abort the JCN ERJMP .+1 SETZM FILTCB(JFN) ;no more TCB MOVE T1,TCPCER ;get back the error code CALL ERTRAN ;translate the error code SETONE ;Flag an error RET ;return with error SUBTTL RELJFN Handling IFE REL6, IFN REL6, ;here on a release jfn SAVEAT SKIPN T1,FILTCB(JFN) ;TCB Exist? RETSKP ;no SETZM FILTCB(JFN) ;no more TCB TMNE TDEC,(T1) ;DEC bit on? JRST TCPRJ2 ;yes CALL RETBLK ;no so just release the space RETSKP ;and success return TCPRJ2: ;here when we have a real DEC TCB LOAD T1,TJCN,(T1) ;get the JCN for this connection TXO T1,TCP%JS ;this is a JCN ABORT% ;abort the JCN ERJMP .+1 ;no errors SETZM FILTCB(JFN) ;no more TCB RETSKP ;return success SUBTTL OPENF Handling IFE REL6, IFN REL6, ;perform openf SAVEAT STKVAR <,OPNJCN,TCPOER> SKIPN TCB,FILTCB(JFN) ;get the TCB address RETBAD(TCPX35) ;can not reopen a TCP JFN JN TCDOW,(TCB),TCPOP3 ;if in open wait mode get to it CALL SKTCPU ;TCP up and running? RETBAD (TCPX16) ;no so return with an error ;here to check user arguments TQNE ;check illegal access modes RETBAD (TCPX17) ;if any of these on then badness TQNN ;must be readable RETBAD (TCPX17) ;if not readable then error TQNN ;must be writable RETBAD (TCPX17) ;if not writeable then error LDB T1,[POINT 6,FILBYT(JFN),11] ;get byte size user wants CAIE T1,^D32 ;is it 32 bit bytes? CAIN T1,^D8 ;or 8 bit bytes? SKIPA ;one or the other so ok RETBAD (TCPX18) ;bad byte size error CAIE T1,^D8 ;8 bit bytes? JRST TCPOP1 ;no SETONE TCDB8,(TCB) ;yes so set the flag TCPOP1: LOAD T1,TLP,(TCB) ;get the local port number SKIPN T1 ;Wild local port? JRST TCPOP3 ;yes so illegal connection LOAD T1,IOMODE ;get the mode user asked for CAILE T1,.TCMMX ;legit value? RETBAD (TCPX30) ;no so error CALL @TCOMDP(T1) ;dispatch on the mode to set flags ;here to ask the almighty ACJ if this is OK LOAD T1,TFH,(TCB) ;get the foreign host number LOAD T2,TFP,(TCB) ;get the foreign port number IFN REL6,,[RETBAD()])>> ; ask acj for its blessing IFE REL6,,[RETBAD()])> ; ask acj for its blessing ;Everything is OK. Fall through. SUBTTL OPENF% Continued.... ;Falls through from above LOAD T1,TLP,(TCB) ;Get the local port MOVEM T1,.TCPLP+TCPBCB ;save the local port TMNN TCDFS,(TCB) ;is Active flag set? CAILE T1,377 ;Not active - special low port? IFSKP. MOVX T1, TDNN T1,CAPENB ;Required privs? RETBAD(NTWZX1) ;Indicate must be network wizard ENDIF. LOAD T1,TLH,(TCB) ;get the local host number MOVEM T1,.TCPLH+TCPBCB ;save the local host number LOAD T1,TFP,(TCB) ;get the 4N port MOVEM T1,.TCPFP+TCPBCB ;save the 4n port LOAD T1,TFH,(TCB) ;Get the Foreign host number MOVEM T1,.TCPFH+TCPBCB ;save the 4n host IFN. T1 ;don't do this if no specific host CALL HSTHSH ;find hash index for host ANSKP. MOVX T1,HS%VAL!HS%UP ;have an index, clear valid and up until ANDCAM T1,HSTSTS(T2) ; network indicates something better ENDIF. SETZM .TCPIP+TCPBCB ;no IP parameters, please SETZM .TCPOP+TCPBCB ;clear the reserved word out MOVEI T1,TCPBCB ;get the connection block address SETZB T2,T3 ;clear other acs TMNE TCDFS,(TCB) ;Active flag? TXO T1,TCP%FS ;yes so force sync TMNE TCDPS,(TCB) ;persist? TXO T1,TCP%PS ;yes so set persist flag TMNE TCDPS,(TCB) ;persist? LOAD T2,TPRS1,(TCB) ;yes so get the timeout time OPEN% ;open up the connection ERJMP TCPOP5 ;handle errors HRRZM T1,OPNJCN ;zero the left half of the JCN MOVE T1,TCB ;get the prototype tcb address MOVE TCB,OPNJCN ;get the JCN MOVE TCB,JCNTCB(TCB) ;get the real TCB address SETSEC TCB,INTSEC ;TCB is in INTSEC MOVEM TCB,FILTCB(JFN) ;save the real TCB address MOVE T2,T1 ;get prototype TCB address MOVE T3,TCB ;get real TCB address TCPOP2: ;prototype to real TCB copying routine SKIPN (T3) ;is real TCB word not set? SKIPN T4,(T2) ;yes and prototype TCB word set? SKIPA ;real set or prototype not set MOVEM T4,(T3) ;set it in the real TCB if non zero AOJ T2, ;bump offset MOVE T4,T2 ;get TCB offset SUB T4,T1 ;subtract TCB base address CAIGE T4,TCBSIZ ;are we done yet? AOJA T3,TCPOP2 ;no so bump offset and continue CALL RETBLK ;release the prototype TCB SETONE TDEC,(TCB) ;set the DEC bit in the TCB SETZM TJOBA(TCB) ;no active output buffer SETZM TJOBF(TCB) ;no fill output buffer SETZM TJIBA(TCB) ;no active input buffer SETZM TJIBE(TCB) ;no empty input buffer SETZM FILLEN(JFN) ;initially zero length SETZM FILBNI(JFN) ;zero input byte number SETZM FILBNO(JFN) ;zero output byte number SETZM FILBCI(JFN) ;zero input bytes remaining count SETZM FILBCO(JFN) ;zero output bytes remaining count JE TCDWT,(TCB),RSKP ;if not in wait mode then we are done SUBTTL OPENF wait mode code TCPOP3: ;here for open wait stuff LOAD T1,TOPNF,(TCB) ;get the open wait bit LOAD T2,TERRF,(TCB) ;get the error wait bit MKWAIT TCPOTS ;make the MDISMS word MOVE FX,FORKX ;get our fork number. LOAD T3,TFH,(TCB) ;get the foreign host number MOVEM T3,FKSTA2(FX) ;save host address fork is blocked on CALL DISTST ;should we dismiss? JRST TCPOP4 ;no TCB is open or errored SETONE ;yes so set the block flag SETONE TCDOW,(TCB) ;set the open wait flag RET ;return to lower level (which will block) TCPOP4: ;here when wait condition satisfied SETZRO ;no longer blocking LOAD T1,TERR,(TCB) ;get error code IFE. T1 ;if error code zero LOAD T1,TOPNF,(TCB) ;get the open wait bit JUMPE T1,RSKP ;beware bit 0 IDIVI T1,^D36 ;separate into word and bit number MOVE T2,BITS(T2) ;get the bit TDNN T2,INTWTB(T1) ;connection open? RETBAD(OPNX20) ;no, return "host is not up" LOAD T1,TFH,(TCB) ;get the Foreign host number IFN. T1 ;don't do this if no specific host CALL HSTHSH ;find hash index for host ANSKP. MOVE T1,HSTSTS(T2) ;found it, get its current status ANDXE. T1,HS%VAL ;have valid status? MOVX T1,HS%VAL!HS%UP ;no, set valid and up since we appear to IORM T1,HSTSTS(T2) ; have made a connection with the host ENDIF. RETSKP ;yes, return success ENDIF. MOVEM T1,TCPOER ;not zero so save the error code LOAD T1,TJCN,(TCB) ;get the JCN for this TCB TXO T1,TCP%JS ;flag that this is a JCN ABORT% ;abort the TCB ERJMP .+1 SETZM FILTCB(JFN) ;no more TCB MOVE T1,TCPOER ;get back the error code CALL ERTRAN ;translate error SETONE ;Flag an error RETBAD ;and error return TCPOP5: ;here on error return from the OPEN% SETZRO ;not blocking now SETZM FILTCB(JFN) ;no tcb anymore CALL ERTRAN ;get the real error code SETONE ;Flag an error RETBAD ;and return with error SUBTTL OPENF Scheduler Test ;TCPOTS - Scheduler test for open waits ;T1/ B26+B35 ;FX/ our fork handle ;JSP T4,TCPOTS ;Returns: +1: connection not open and no error ;Returns: +2: otherwise RESCD TCPOTS: PUSH P,T4 ;save return PC on stack (RET(SKP) will fix it) IFE REL6, ;force us into section one if needed JSP T4,INTOOT ;check TOPNF/TERRF first CAIA ;neither are set RETSKP ;one or the other is set, unblock caller SKIPE T1,FKSTA2(FX) ;get host address fork is blocked on IFE REL6, ;find hash index IFN REL6, ;find hash index RET ;no host, new, or no room MOVE T1,HSTSTS(T2) ;get status of this host TXNE T1,HS%VAL ;have valid host status? TXNE T1,HS%UP ;yes, is host up? RET ;no valid status or host up RETSKP ;valid status and down IFE REL6, IFN REL6, SUBTTL OPENF Flag Setting Code TCOMDP: ;OPENF% Flag Setting Dispatch IFIW!TCOMWI ;(0) default value IFIW!TCOMWI ;(1) wait interactive IFIW!TCOMWH ;(2) wait high throughput IFIW!TCOMII ;(3) immediate interactive IFIW!TCOMIH ;(4) immediate high throughput .TCMMX==.-TCOMDP-1 ;Max legal value TCOMWI: ;wait interactive SETONE TCDWT,(TCB) ;set the wait flag SETZRO TCDHT,(TCB) ;reset the high throughput flag RET ;return to caller TCOMWH: ;wait high throughput SETONE TCDWT,(TCB) ;set the wait flag SETONE TCDHT,(TCB) ;set the high throughput flag RET ;return to caller TCOMII: ;immediate interactive SETZRO TCDWT,(TCB) ;reset the wait flag SETZRO TCDHT,(TCB) ;reset the high throughput flag RET ;return to caller TCOMIH: ;immediate high throughput SETZRO TCDWT,(TCB) ;reset the wait flag SETONE TCDHT,(TCB) ;set the high throughput flag RET ;return to caller SUBTTL Support Routines for Sequential IO IFE REL6, IFN REL6, ;Switch to INPUT TMNE FILINP ;allready doing input? RET ;yes so just return SETONE FILINP ;no so doing input now SETZRO FILOUP ;and not doing output now SETZRO FILNO,(JFN) ;not doing new OUTPUT now RET ;return to caller IFE REL6, IFN REL6, ;Switch to OUTPUT TMNE FILOUP ;allready doing output? RET ;yes so just return SETONE FILOUP ;now doing output SETONE FILNO,(JFN) ;doing new OUTPUT now SETZRO FILINP ;not doing input now RET ;return to caller TCPSIO: ;Sequential IO Setup SETZRO ;no longer blocking SKIPN TCB,FILTCB(JFN) ;get the TCB address if it exists RETERR(TCPX35) ;in case no TCB (which should not happen) TCPIO1: ;here to check TCB for errors LOAD T1,TERR,(TCB) ;get error cell for this TCB JUMPE T1,TCPIO2 ;has there been an error? CALL ERTRAN ;yes so translate the error SETONE ERRF ;set the error bit RET ;and return with the error TCPIO2: ;here when this TCB seems ok (error wise) JN TSOPN,(TCB),TCPIO4 ;this TCB ever opened? MOVE FX,FORKX ;get our fork number. LOAD T3,TFH,(TCB) ;get the foreign host number MOVEM T3,FKSTA2(FX) ;save host address fork is blocked on LOAD T1,TOPNF,(TCB) ;no so get the open wait bit LOAD T2,TERRF,(TCB) ;also get the error wait bit MKWAIT TCPOTS ;make the MDISMS word CALL DISTST ;should we dismiss? JRST TCPIO3 ;no. TCB is open or errored. Find out which. SETONE ;yes. set the block flag RET ;return to lower level (which will block) TCPIO3: ;here when wait condition satisfied JN TERR,(TCB),TCPIO1 ;error? TCPIO4: ;here when TCB is open and error free RETSKP ;return to caller SUBTTL Support Routines for Buffers RESCD TCPTST: ;scheduler test for buffer done MOVX T2,TCP%DN ;get the bit mask TDNN T2,.TCPBF(T1) ;buffer done? JRST 0(T4) ;no JRST 1(T4) ;yes IFE REL6, IFN REL6, TCPGTB: ;routine to get a buffer ;address of buffer returned in T1 NOINT ;go noint MOVX T1,<.RESP3,,TCPBSZ> ;get the buffer size and priority IFE REL6,< MOVX T2,B35> ;from the general pool > IFN REL6,< MOVX T2,B35> ;from the decnet pool > CALL ASGRES ;get some resident free space JRST TCPGT2 ;error OKINT ;allow interrupts RETSKP ;success return TCPGT2: ;here when we could not get the space OKINT ;allow interrupts SETONE ;set the block flag MOVEI T1,^D1000 ;wait 1 seconf CALL SETBKT ;compute wait HRRI T1,BLOCKT ;the scheduler test RET ;lower level will block TCPRLB: ;routine to release a buffer ;Address of buffer in T1 JUMPE T1,R ;helper for TCPBFD - lets EXCH work NOINT ;stop interrupts CALL RELRES ;release resident free space OKINT ;allow interrupts SETZ T1, ;help TCPBFD - lets EXCH work RET ;and return to caller TCPBFD:: ;routine to discard all buffers from ;TCB addressed by T1 SAVEAC ;do not destroy this AC MOVE TCB,T1 ;put the TCB address in the correct place SETZ T1, ;TCPRLB will help us after this SETZ EXCH T1,TJOBA(TCB) ;delete active output buffer CALL TCPRLB EXCH T1,TJOBF(TCB) ;delete output buffer CALL TCPRLB EXCH T1,TJIBA(TCB) ;delete input buffer CALL TCPRLB EXCH T1,TJIBE(TCB) ;delete empty input buffer CALLRET TCPRLB SUBTTL Sequential Input (BIN/SIN) IFE REL6, IFN REL6, ;Byte Input SAVEAT ;save most acs SETZRO ;we are no longer blocking TCSQI0: ;here to see if input is possible TQNN ;time to exit if EOF flag is now set CALL TCPSIO ;set things up (like TCB) RET ;pass down any problems or errors JE TCDIB,(TCB),TCSQI1 ;if we need an input buffer go get it ;here when high throughput and buffer exists SKIPG FILBCI(JFN) ;any bytes left in this buffer? JRST TCSQI5 ;no bytes left so go finish off this buffer ILDB T1,FILBFI(JFN) ;bytes left so get one AOS FILBNI(JFN) ;we read one byte SOSG FILBCI(JFN) ;and there is one less byte in the buffer JRST TCSQI6 ;get another buffer if we finished this one RET ;we did not finish the buffer so return TCSQI1: ;here when we do not have a buffer SKIPN T1,TJIBE(TCB) ;do we have a buffer to empty? JRST TCSQI3 ;no so go check the active buffer HRLS T1 ;yes so get the buffer address HRRI T1,TCPTST ;get the scheduler test CALL DISTST ;is the buffer done? JRST TCSQI2 ;yes so make the buffer available JE TCDHT,(TCB),TCSQI7 ;if high throughput mode we must block SETONE ;no so set the block bit RET ;and return so lower level can block TCSQI2: ;here when the buffer is done MOVE T2,TJIBE(TCB) ;get the buffer address MOVEI T1,<_2> ;get number of possible bytes SUB T1,.TCPBC(T2) ;get the number of bytes received TMNN TCDB8,(TCB) ;8 bit bytes? LSH T1,-2 ;yes so four bytes per word MOVEM T1,FILBCI(JFN) ;save the number of bytes available ADDM T1,FILLEN(JFN) ;update file length ;fall through SUBTTL Sequential Input (BIN/SIN) Continued ;falls through from above MOVE T1,TJIBE(TCB) ;get the buffer address ADDI T1,.TCPBS ;get address of first word of data TMNE TCDB8,(TCB) ;8 bit mode? HRLI T1,(POINT 8,0) ;yes so get an 8 bit pointer TMNN TCDB8,(TCB) ;32 bit mode? HRLI T1,(POINT 32,0) ;yes so get a 32 bit byte pointer MOVEM T1,FILBFI(JFN) ;save the new pointer SETONE TCDIB,(TCB) ;input buffer now exists JRST TCSQI0 ;and try to output this byte again TCSQI3: ;here when no TJIBE buffer SKIPN T1,TJIBA(TCB) ;is there an active buffer? JRST TCSQI4 ;no so go set one up SETZM TJIBA(TCB) ;no more active buffer MOVEM T1,TJIBE(TCB) ;former active buffer is no the emptying buffer CALL TCPGIB ;go get a new active buffer RET ;pass down any blocks or errors JRST TCSQI0 ;and go try to input a character again TCSQI4: ;here when no buffers at all CALL TCPGIB ;get an input buffer RET ;pass down errors and blocks CALL TCPGIB ;get an active input buffer RET ;pass down errors and blocks JRST TCSQI0 ;and go try to input this character again SUBTTL Sequential Input (BIN/SIN) Continued TCSQI5: ;here when the input buffer is done SETZRO TCDIB,(TCB) ;no more input buffer MOVE T1,TJIBE(TCB) ;get the buffer address SETZM TJIBE(TCB) ;no more emptying buffer CALL TCPRLB ;release the space the buffer used up CALL TCPGIB ;get another input buffer RET ;pass down errors and blocks JRST TCSQI0 ;go try to input this character again TCSQI6: ;here when we finished the buffer SAVEAC SETZRO TCDIB,(TCB) ;no more input buffer MOVE T1,TJIBE(TCB) ;get the buffer address SETZM TJIBE(TCB) ;no more emptying buffer CALL TCPRLB ;release the buffer space CALL TCPGIB ;get another input buffer NOP ;pass down errors and blocks RET ;and return to caller TCSQI7: ;here to hunt for buffer in interactive mode XMOVEI T1,TCBLCK(TCB) ;get the lock address CALL SETLCK ;lock the TCB MOVE T1,TJIBE(TCB) ;get the buffer address MOVE T2,.TCPBC(T1) ;get the byte count CAIN T2,<_2> ;any io to this buffer yet? JRST TCSQI8 ;no MOVE T1,TCB ;put TCB into the correct place CALL BUFHNT ;go hunt down the buffer XMOVEI T1,TCBLCK(TCB) ;get the lock address CALL UNLCK ;unlock the TCB JRST TCSQI0 ;go try to use this buffer TCSQI8: ;here when no IO has happened XMOVEI T1,TCBLCK(TCB) ;get the lock address CALL UNLCK ;unlock the TCB SKIPN T1,TJIBE(TCB) ;do we have a buffer to empty? JRST TCSQI3 ;no so go check the active buffer HRLS T1 ;yes so get the buffer address HRRI T1,TCPTST ;get the scheduler test CALL DISTST ;is the buffer done? JRST TCSQI2 ;yes so make the buffer available SETONE ;no so set the block bit RET ;and return so lower level can block SUBTTL Get Input Buffer Routine TCPGIB: ;Here to get an input buffer setup STKVAR CALL TCPIST ;setup the buffer RET ;pass down blocks and errors MOVEM T1,TCGIBB ;save the buffer address MOVE T2,T1 ;put buffer address in the correct place LOAD T1,TJCN,(TCB) ;get the JCN for this TCB TXO T1,TCP%JS ;flag that this is a JCN LOAD T3,TSTO,(TCB) ;get the timeout word SETZ T4, ;retransmission word RECV% ;queue the buffer for receving ERJMP TCGIBR ;handle errors MOVE T1,TCGIBB ;get the buffer address back SKIPE TJIBE(TCB) ;emptying buffer exist? JRST TCGIB3 ;yes SKIPN T2,TJIBA(TCB) ;active buffer exist? JRST TCGIB2 ;no active buffer SETZM TJIBA(TCB) ;yes so no more active buffer MOVEM T2,TJIBE(TCB) ;old active buffer is now the emptying buffer MOVEM T1,TJIBA(TCB) ;and new buffer is the active buffer RETSKP ;and return TCGIB2: ;here when no empty and no active buffers MOVEM T1,TJIBE(TCB) ;new buffer is the emptying buffer RETSKP ;and return TCGIB3: ;here when empty buffer exists MOVEM T1,TJIBA(TCB) ;new buffer must be the active buffer RETSKP ;and return TCGIBR: ;here on an error from the RECV% CALL ERTRAN ;translate the error MOVEM T1,LSTERR ;save that error code MOVE T1,TCGIBB ;get address of the buffer we can't use CALL TCPRLB ;release it MOVE T1,LSTERR ;get back the error code CAIE T1,TCPX33 ;connection closing? IFSKP. SKIPE TJIBE(TCB) ;yes. skip if no emptying buffer RETSKP ;must be trying to fill active buffer SKIPN T2,TJIBA(TCB) ;get pointer to active buffer TQO ;nothing there, set the EOF flag MOVEM T2,TJIBE(TCB) ;make it the emptying buffer SETZM TJIBA(TCB) ;no more active buffer RETSKP ;return success always ENDIF. SETONE ;set the error bit RET ;return to lower levels TCPIST: ;here to setup the input buffer in T1 CALL TCPGTB ;get a buffer RET ;pass down blocks and errors SETZM .TCPBF(T1) ;zero the flags word MOVEI T2,<_2> ;get number of octets possible MOVEM T2,.TCPBC(T1) ;save the count MOVEI T2,.TCPBS(T1) ;get the address of the first data word MOVEM T2,.TCPBA(T1) ;and save it in the block SETZM .TCPBO(T1) ;zero the option word SETZM .TCPBI(T1) ;zero the IP parameter word RETSKP ;return success SUBTTL Sequential Output (BOUT/SOUT) IFE REL6, IFN REL6, ;byte Output SAVEAT ;save most acs TRVAR MOVEM T1,TCPSOB ;save the byte to output SETZRO ;no longer blocking TCSQO1: ;here to try to output the byte CALL TCPSIO ;can we do output? RET ;pass down error JE TCDOB,(TCB),TCSQO3 ;try to get an output buffer if needed ;here when we have a buffer TMNE TCDPU,(TCB) ;are we here for a push? JRST TCSQO2 ;yes so send a buffer now JE TCDHT,(TCB),TCSQO4 ;handle interactive different ;here when we are high throughput mode SOSGE FILBCO(JFN) ;is the buffer full allready? JRST TCSQO2 ;yes so queue and try to get another AOS FILBNO(JFN) ;account for each byte MOVE T1,TCPSOB ;get the byte IDPB T1,FILBFO(JFN) ;deposit the byte SKIPG FILBCO(JFN) ;buffer now full? CALL TCSQOU ;yes so output it NOP ;allow blocks and errors RET ;and return TCSQO2: ;here when buffer full coming in CALL TCSQOU ;try to output the buffer RET ;allow blocks and errors JE TCDPU,(TCB),TCSQO1 ;go try to output the character again SETZRO TCDPU,(TCB) ;turn off the push flag SETZRO TCDUR,(TCB) ;turn off the urgent flag SETZM FILBNO(JFN) ;make sure next output to this jfn SETZM FILBCO(JFN) ;goes to a new buffer RET ;successfull return TCSQO3: ;here when no current buffer CALL TCPGOB ;try to get an output buffer RET ;allow block and errors JRST TCSQO1 ;go try to output the character again SUBTTL Sequential Output (BOUT/SOUT) Continued TCSQO4: ;here when we are interactive SETZM FILBCO(JFN) ;make sure we get called every time SOSGE TCPBCO(TCB) ;buffer allready full? JRST TCSQO2 ;yes so try to output it AOS FILBNO(JFN) ;account for each byte MOVE T1,TCPSOB ;get the byte IDPB T1,FILBFO(JFN) ;output the byte SKIPN T1,TJOBA(TCB) ;active buffer exist? JRST TCSQO5 ;no MOVX T2,TCP%DN ;done bit mask TDNN T2,.TCPBF(T1) ;is the active buffer done? JRST TCSQO5 ;no SETZM TJOBA(TCB) ;flag that active buffer no longer exists CALL TCPRLB ;yes so release the buffer CALL TCSQOU ;start the fill buffer going out NOP ;allow errors and blocks RET ;and return TCSQO5: ;here to start possibly full buffer SKIPGE TCPBCO(TCB) ;buffer full now? CALL TCSQOU ;yes so start outputing it NOP ;allow errors and blocks RET ;and return TCSQOU: ;here to queue an output buffer SKIPN T1,TJOBA(TCB) ;is there an active buffer? JRST TCSQU2 ;no SETONE TCDOQ,(TCB) ;yes so we will queue the fill buffer TCSQU2: ;here when no active buffer CALL TCPOUT ;send out the fill buffer RET ;pass down errors and blocks RETSKP ;success return SUBTTL Get Output Buffer Routine TCPGOB: ;here to setup TCP output buffer SKIPN T1,TJOBA(TCB) ;active buffer exist? JRST TCPGO4 ;no so go make a fill buffer MOVX T2,TCP%DN ;get the done bit TDNN T2,.TCPBF(T1) ;active buffer done? JRST TCPGO2 ;no SETZM TJOBA(TCB) ;yes so no more active bufffer CALL TCPRLB ;and release the space JRST TCPGO4 ;now go make a fill buffer TCPGO2: ;here when active buffer is busy. SKIPN TJOBF(TCB) ;is there a fill buffer? JRST TCPGO5 ;no so go make one JE TCDOQ,(TCB),TCPGO3 ;can we queue the fill buffer? HRLS T1 ;no so get active buffer address HRRI T1,TCPTST ;get the scheduler test SETONE ;set the block bit RET ;and non skip return TCPGO3: ;here when we can queue fill buffer SETONE TCDOQ,(TCB) ;yes but we can queue the fill buffer CALL TCPOUT ;queue the fill buffer RET ;allow errors and blocks RETSKP ;return success TCPGO4: ;here when there is no active buffer SKIPN T1,TJOBF(TCB) ;fill buffer exist? JRST TCPGO5 ;no so just go make one SETZM TJOBF(TCB) ;yes so no more fill buffer MOVEM T1,TJOBA(TCB) ;it is now the active buffer TCPGO5: ;here to make a fill buffer CALL TCPOST ;get a fill buffer RET ;pass down errors and blocks RETSKP SUBTTL TCP Output Fill Buffer Setup TCPOST: ;Setup Output FIll Buffer CALL TCPGTB ;no so get an output buffer RET ;pass down blocks and errors MOVEM T1,TJOBF(TCB) ;save address of filler buffer MOVEI T1, ;get number of words in buffer TMNE TCDB8,(TCB) ;8 bit mode? LSH T1,2 ;yes so 8 bit bytes SETZM FILBCO(JFN) ;in case interactive TMNE TCDHT,(TCB) ;high throughput? MOVEM T1,FILBCO(JFN) ;yes save the number of bytes available TMNN TCDHT,(TCB) ;interactive MOVEM T1,TCPBCO(TCB) ;yes save number of bytes available MOVE T1,TJOBF(TCB) ;get the address of the buffer SETZM .TCPBF(T1) ;zero flag word MOVEI T2,.TCPBS(T1) ;get address of first data word MOVEM T2,.TCPBA(T1) ;save the data word address SETZM .TCPBC(T1) ;zero the byte count SETZM .TCPBO(T1) ;zero the option word SETZM .TCPBI(T1) ;zero the IP parameter word TMNE TCDB8,(TCB) ;8 bit bytes? HRLI T1,(POINT 8,0) ;yes so get an 8 bit pointer TMNN TCDB8,(TCB) ;32 bit bytes? HRLI T1,(POINT 32,0) ;yes so get a 32 bit byte pointer ADDI T1,.TCPBS ;offset the pointer by a few words MOVEM T1,FILBFO(JFN) ;save the new pointer SETZM FILBNO(JFN) ;save new byte count SETONE TCDOB,(TCB) ;there is now a current output buffer SETZRO TCDOQ,(TCB) ;not queued RETSKP ;return to caller SUBTTL TCP Output Buffer Queueing TCPOUT: ;here to output the current buffeer SETZRO TCDOB,(TCB) ;there is no current output buffer MOVE T2,TJOBF(TCB) ;get the fill buffer address MOVE T1,FILBNO(JFN) ;get the byte added count TMNN TCDB8,(TCB) ;8 bit mode LSH T1,2 ;yes so 4 octets per byte MOVEM T1,.TCPBC(T2) ;save the number of octets SKIPE TJOBA(TCB) ;is there an active buffer? JRST TCPOU1 ;yes so just queue this one SETZM TJOBF(TCB) ;no more fill buffer MOVEM T2,TJOBA(TCB) ;old fill buffer is now the active buffer TCPOU1: ;here to queue the buffer JE TCDPU,(TCB),TCOPUS ;if not a push skip this stuff MOVX T1, ;get the push flag IORM T1,.TCPBF(T2) ;set the push flag TCOPUS: ;here also when not pushing JE TCDUR,(TCB),TCOURG ;if not urgent skip this stuff MOVX T1, ;get the urgent flag IORM T1,.TCPBF(T2) ;set the urgent flag TCOURG: ;here also when not urgent LOAD T1,TJCN,(TCB) ;get the JCN TXO T1,TCP%JS ;set the flag LOAD T3,TSTO,(TCB) ;get the timeout word SETZ T4, ;retranmission word SEND% ;send the buffer ERJMP TCPOU2 ;handle error RETSKP ;success return TCPOU2: ;here on error from send CALL ERTRAN ;translate the error SETONE ;set the error flag RET ;non success return SUBTTL SOUTR and GDSTS Handling IFE REL6, IFN REL6, ;Force record out SAVEAT ;save most acs SETZRO ;we are no longer blocking CALL TCPSIO ;can we still do constructive work? RET ;no so return with error or block SETONE TCDPU,(TCB) ;set the push flag CALL TCSQO1 ;join the normal byte output code TMNE ;want to block? RET ;yes so return TMNE ;have an error RET ;yes so return RETSKP ;otherwise skip return IFE REL6, IFN REL6, ;GDSTS Handling SAVEAT ;save most acs MOVE TCB,FILTCB(JFN) ;get the TCB address LOAD T1,TRSYN,(TCB) ;get the receive state LOAD T2,TSSYN,(TCB) ;get the send state HRL T1,T2 ;receive in the left half, send in the right LOAD T2,TFH,(TCB) ;get the 4n host number UMOVEM T2,3 ;save in users AC3 LOAD T2,TFP,(TCB) ;get the 4n port number UMOVEM T2,4 ;save in users AC4 RET ;and return to caller SUBTTL Decode Host-Port Specification ; Call: ; T1/ pointer to string ; T2/ NON-ZERO INDICATES RULES FOR FOREIGN HOSTS ; NON-SKIP RETURN INDICATES FAILURE ; Skip return indicates success ; T1/ updated string pointer ; T2/ host number ; T3/ port number HSTF%A==1B0 ;pound sign found flag HSTF%F==1B1 ;foreign host flag HSTPRT: ;routine to decode host-port spec STKVAR ;LOCAL STORAGE SETZM HSTPHN ;zero the host number SETZM HSTPDP ;zero the dash pointer flag SETZM HSTPOT ;zero the port number JUMPE T1,R ;if null user is trying wildcard - disallow HRLI T1,010700 ;make the pointer a byte pointer MOVEM T1,HSTPT1 ;save the initial byte pointer SETZ T4, ;zero the flag word SKIPE T2 ;4n host rules? TXO T4,HSTF%F ;yes so set the flag HSTLP1: ;loop looking for terminator for field MOVE T3,T1 ;save the old byte pointer ILDB T2,T1 ;get a character CAIE T2,"#" ;is it the special port delimitor? JRST HSTLP2 ;no so keep checking TXNE T4,HSTF%A ;have we allready had one? RET ;yes so this is an error TXO T4,HSTF%A ;flag that we have seen one JRST HSTLP1 ;and look for more characters HSTLP2: ;here on characters not quoted by ^v CAIL T2,"A" ;is it an alpha character? CAILE T2,"Z" SKIPA ;not a-z JRST HSTLP1 ;a-z so keep looking CAIL T2,"A"+40 ;is it little a through z CAILE T2,"Z"+40 SKIPA ;not little a-z JRST HSTLP1 ;little a-z so keep looking CAIL T2,"0" ;is it numeric? CAILE T2,"9" SKIPA JRST HSTLP1 ;numeric so keep looking CAIE T2,"-" ;is it our favorite delimitor? JRST HSTPR2 ;no MOVEM T3,HSTPDP ;save the latest dash pointer JRST HSTLP1 ;keep looking SUBTTL Decode Host-Port Specification...Continued HSTPR2: ;here when we have determined end of string MOVEM T3,HSTPT2 ;save the final pointer CAMN T1,HSTPT1 ;same as initial pointer? RET ;yes error SKIPN HSTPDP ;do we have a host name or number? JRST HSTPR4 ;no MOVE T1,HSTPT1 ;get the initial pointer MOVEI T3,10 ;octal number NIN% ;attempt to read host number ERJMP HSTPR3 ;hmmm. not number. must be a string JUMPLE T2,R ;host number must be positive MOVEM T2,HSTPHN ;save the host number JRST HSTPR4 ;go check for the port number HSTPR3: ;here when the host name is alphanumeric MOVE T1,HSTPT1 ;get the byte pointer CALL HSTNLK ;go look up the name RET ;not found MOVEM T1,HSTPHN ;save the host number HSTPR4: ;here to check for port number MOVE T1,HSTPDP ;get the dash pointer IBP T1 ;increment the pointer SKIPN HSTPDP ;was there a dash? MOVE T1,HSTPT1 ;no so get the initial pointer MOVEM T1,HSTPPP ;save the port number pointer MOVE T2,HSTPT2 ;get the final pointer CALL STRLEN ;get the length of the string? JUMPLE T3,HSTPR5 ;handle case of no port number MOVE T1,HSTPPP ;get the port number pointer MOVEI T3,12 ;we use decimal for ports NIN% ;read in the port number ERJMP HSTPR5 ;on error there is no port number MOVEM T2,HSTPOT ;save the port number CAILE T2,177777 ;legit port number? RET ;no error TXNE T4,HSTF%F ;foreign host spec? JRST HSTPR5 ;yes so no checks CAILE T2,377 ;special low port number? CAIL T2,100000 ;special high port number? IFNSK. LDB T3,T1 ;yes to either, get the next character CAIE T3,"#" ;is it the special port delimiter? RET ;no so error CAIG T2,377 ;if low port number, OPENF% will validate ANSKP. ;else must validate privileges JE ,CAPENB,R ENDIF. ;fall through SUBTTL Decode Host-Port Specification...Continued HSTPR5: ;here after we have port number AOS T2,JOBUNI ;get next unique number for this job ANDI T2,77 ;only last 6 bits please MOVE T3,JOBNO ;get my job number LSH T3,6 ;shift over IOR T2,T3 ;get the default port number ADDI T2,100000 ;add in the offset TXNN T4,HSTF%F ;4N host? SKIPE HSTPOT ;no so is it zero port number? SKIPA ;not 4N or not zero MOVEM T2,HSTPOT ;local and zero so use default port MOVE T1,HSTPT2 ;get the final pointer IBP T1 ;increment the pointer MOVE T2,HSTPHN ;set the host number MOVE T3,HSTPOT ;get the port number RETSKP ;return success SUBTTL Host Number Decode Routine ;Call: ;T1/ Pointer to string ;Non-skip return for error ;Skip return for success ;T2/ 32 bit host number right justified HSTHST: ;Host number decode routine STKVAR SKIPN T1 ;string exist? RET ;no so error return SETZM HSTHSN ;zero the host number word MOVX T2, ;get pointer for the host number word MOVEM T2,HSTHSP ;save the pointer MOVEI T4,4 ;four numeric fields HSTHSL: ;loop for reading fields MOVEI T3,12 ;fields are decimal NIN% ;read in a field ERJMP R ;trap errors IDPB T2,HSTHSP ;deposit the field CAIN T4,1 ;is this the last field? JRST HSTHSX ;yes LDB T2,T1 ;no so get the next character CAIE T2,"." ;better be a dot RET ;it is not...error return SOJA T4,HSTHSL ;get the next field HSTHSX: ;here when we have the whole host number MOVE T2,HSTHSN ;get the host number RETSKP ;and return success SUBTTL Host Name Decode Routine ;Call: ;T1/ Pointer to string ;Non-skip return for error ;Skip return for success ;T1/ 32 bit host number right justified HSTNLK: ;Host name lookup routine SAVEAC ;do not trash this AC STKVAR MOVEM T1,HNLKPT ;save the pointer HRLZ T1,MHOSTS ;get the AOBJN ac HSTNL1: ;name chasing loop MOVE T2,HNLKPT ;get the string pointer MOVEM T2,HNLKP1 ;save it where we can use it HRRZ T2,T1 ;get the index out of the AOBJN AC SETSEC T2,INTSEC ;make sure we touch the proper section LOAD T2,HSTNMP,(T2) ;get the address of a name string ADD T2,[INTSEC,,HSTNAM] ;get the entire address MOVX T3, ;make a byte pointer MOVEM T3,HNLKP2 ;save the second pointer HSTNL2: ;loop for checking out a host name ILDB T4,HNLKP2 ;get a byte of the second string JUMPE T4,HSTNL3 ;if this is a null byte we have success ILDB T3,HNLKP1 ;get a byte of the first string JUMPE T3,HSTNL3 ;if this is a null byte we have success CAIN T3,(T4) ;bytes match? JRST HSTNL2 ;yes so keep checking ;here when current host name did not match AOBJN T1,HSTNL1 ;go check out the next host RET ;we did not find a host name HSTNL3: ;here when we found the host name SETSEC T1,INTSEC ;reference proper section LOAD T1,HSTIDX,(T1) ;get the HOSTNN index SETSEC T1,INTSEC ;reference proper section MOVE T1,HOSTNN(T1) ;get the host number RETSKP ;and success return SUBTTL TCOPR JSYS SWAPCD .TCOPR:: MCENT ;jsys entry macro IFE NOTYET, IFN NOTYET,< NOINT ;stop interrupts CAIL T2,TCOPS1 ;special function? CAILE T2,TCOPSM ;special function? JRST TCOPR1 ;not special function SKIPE T1 ;t1 should be zero JRST TCOPRE ;if not zero then error XCTU [SKIPE T1] ;users t1 must be zero JRST TCOPRE ;it is not so give an error UMOVE T1,T3 ;get users argument MOVEI T2,-TCOPS1(T2) ;get the absolute offset into dispatch table CAIG T2,TCOPSN ;legit offset? SKIPGE T2 ;legit offset? JRST TCOPRE ;no return error CALL @TCOPSD(T2) ;dispatch to handling routine JRST TCOPRB ;non skip return means error OKINT ;allow interrupts JRST MRETN ;return to caller > ;end of ifn NOTYET SUBTTL TCOPR Special Function Handling IFN NOTYET,< TCOPSD: ;special function dispatch table IFIW!DTCRDL ;read default lower bound IFIW!DTCSDL ;set default lower bound IFIW!DTCRDU ;read default upper bound IFIW!DTCSDU ;set default uppser bound TCOPSN==.-TCOPSD-1 ;max offset DTCRDL: ;special read default lower retran bound DTCRDU: ;special read default upper retran bound XCTU [SETZM T3] ;zero users ac 3 RETSKP ;success return DTCSDL: ;special set default lower retransmission DTCSDU: ;special set default upper retransmission MOVX T2, ;get mask of privs needed TDNN T2,CAPENB ;does the user have correct privs RETBAD (TCPX21) ;no so give an error return RETSKP ;success return > ;end of IFN NOTYET SUBTTL TCOPR JFN Function Handling TCOPR1: ;here when the function was not special CAIG T2,TCOPDN ;less than max function? SKIPGE T2 ;and .ge. zero? JRST TCOPRE ;no so return with an error UMOVE JFN,T1 ;users t1 has the jfn CALL CHKJFN ;check out this jfn JRST TCOPRB ;pass on error JRST TCOPRE ;no tty's JRST TCOPRE ;no byte pointers CAIN P3,TCPDTB ;make sure it is the tcp device JRST TCOPR2 ;it is the tcp device CALL UNLCKF ;unlock the jfn TCOPRE: ;here on a tcopr error MOVEI T1,TCPX22 ;get the error code TCOPRB: ;here when we have an error code RETERR ;give an error TCOPR2: ;here when we have the jfn and it is tcp SKIPN TCB,FILTCB(JFN) ;get the TCB address RETERR(TCPX36,) ;can not reopen a TCP JFN UMOVE T1,T2 ;get the function code back UMOVE T2,T3 ;get the parameter from the user CALL @TCOPDD(T1) ;dispatch to the routine JRST TCOPRR ;error return..pass it along to the user CALL UNLCKF ;unlock the jfn JRST MRETN ;return to user TCOPRR: ;here when we have an error code PUSH P,T1 ;save the error code CALL UNLCKF ;unlock the file POP P,T1 ;and restore it RETERR ;and return the error SUBTTL TCOPR Function Dispatch Table TCOPDD: ;tcopr function dispatches IFIW!DTCRCS ;read connection state IFIW!DTCSUD ;send urgent data IFIW!DTCPSH ;push local data IFIW!DTCSPA ;set passive active flag IFIW!DTCSPP ;set persistance parameters IFIW!DTCSTP ;set timeout parameters IFIW!DTCSRP ;* set retransmission parameters IFIW!DTCSTS ;set type of service IFIW!DTCSSC ;set security and compartment levels IFIW!DTCSHT ;* set handling restrictions and transmission control IFIW!DTCSPC ;set psi channels IFIW!DTCRTW ;read a word from the tcb IFIW!DTCSIL ;* set the interrupt level for buffers IFIW!DTCLSR ;* set the loose route IFIW!DTCSSR ;* set the strict route IFIW!DTCRLB ;* read lower bound for retransmission IFIW!DTCSLB ;* set upper bound for retransmission IFIW!DTCRUB ;* read upper bound for retransmission IFIW!DTCSUB ;* set upper bound for retransmission IFIW!DTCSFN ;Send fin TCOPDN==.-TCOPDD-1 ;max offset for dispatch DTCRCS: ;read connection state DTCSRP: ;set retransmission parameters DTCSHT: ;set handling restrictions and transmission DTCSIL: ;set the interrupt level for buffers DTCLSR: ;set the loose route DTCSSR: ;set the strict route DTCRLB: ;read lower bound for retransmission DTCSLB: ;set upper bound for retransmission DTCRUB: ;read upper bound for retransmission DTCSUB: ;set upper bound for retransmission RETBAD (TCPX40) ;not yet implemented SUBTTL TCOPR JFN Functions... STCBNO: ;Skip if TCB Never Opened JE TSOPN,(TCB),RSKP ;no RETBAD (TCPX27) ;yes so return with error DTCSPA: ;set passive or active flag CALL STCBNO ;TCB Open? RET ;yes pass along error JUMPE T2,DCSPA2 ;passive? SETONE TCDFS,(TCB) ;set the flag RETSKP ;success DCSPA2: ;here on passive SETZRO TCDFS,(TCB) ;reset the flag RETSKP ;success DTCSPP: ;set persistance parameters CALL STCBNO ;TCB Open RET ;yes pass along error HLRZ T1,T2 ;(m) put second parameter in convienent place HRRZS T2 ;(n) only first parameter in this AC SKIPN T1 ;is M zero? SKIPE T2 ;and N zero? SKIPA ;no JRST DCSPP2 ;yes so they are ok CAMGE T1,T2 ;M .LT. N JRST DCSPP2 ;yes RETBAD (TCPX26) ;give an error DCSPP2: ;here when parameters are ok STOR T2,TPRS1,(TCB) ;store N STOR T1,TPRS2,(TCB) ;store M RETSKP ;success return DTCSTP: ;set timeout parameters SKIPGE T2 ;legal value? RETBAD (TCPX10) ;no CAMLE T2,TCPPTM ;within limits? MOVE T2,TCPPTM ;no so make it the maximum IMULI T2,^D1000 ;milliseconds STOR T2,TSTO,(TCB) ;save the timeout value RETSKP ;success DTCSTS: ;set type of service CALL STCBNO ;open? RET ;yes so return with error SKIPL T2 ;legal value? CAILE T2,777777 ;? RETBAD (TCPX11) ;no STOR T2,TTOS,(TCB) ;store the type of service RETSKP ;success DTCSSC: ;set security and compartment levels CALL STCBNO ;ever open? RET ;yes so return with error HLRZ T3,T2 ;get the security value CAILE T3,177777 ;legal value RETBAD (TCPX12) ;no STOR T2,TSLVN,(TCB) ;store the security code RETSKP DTCPSH: ;push local data SETZRO ;no longer blocking SETONE TCDPU,(TCB) ;set the push flag CALL TCSQO1 ;go do the push TMNE ;error? RETBAD ;yes so error return TMNN ;want to block? RETSKP ;no so success return ;here when we want to block PUSH P,T1 ;save this AC CALL UNLCKF ;unlock the JFN POP P,T1 ;restore this AC MDISMS ;go dismiss ;here we are back again MOVE T1,JFN ;get the jfn again IDIVI T1,MLJFN ;convert JFN to a number MOVE JFN,T1 ;and put it back CALL CHKJFN ;lock the JFN again RETBAD RETBAD RETBAD CAIN P3,TCPDTB ;TCP device? JRST DTCPSH ;yes RETBAD (TCPX22) ;no so return with error DTCSPC: ;set PSI channels UMOVE T1,3 ;get users AC3 SETCA T1,T1 ;complement the AC TXNE T1, ;any bad bits on? JRST DTSPC2 ;yes SETCA T1,T1 ;get the AC back LDB T3,[POINTR T1,TC%TPU] ;get the urgent channel STOR T3,TPICU,(TCB) ;store away the urgent channel LDB T3,[POINTR T1,TC%TER] ;get the error channel STOR T3,TPICE,(TCB) ;store away the error channel LDB T3,[POINTR T1,TC%TSC] ;get the state change channel STOR T3,TPICX,(TCB) ;store away the state change channel RETSKP ;return success DTSPC2: ;here when bad bits were on RETBAD (TCPX41) ;get an error of return it DTCRTW: ;read a word from the TCB UMOVE T1,3 ;get the offset the user wants CAIGE T1,TCBSIZ ;offset too large? SKIPGE T1 ;offset .GE. zero RETBAD(TCPX42) ;return with error ADD T1,TCB ;get word the user wants MOVE T1,(T1) ;get the word for the user UMOVEM T1,3 ;save the word where the user can find it RETSKP ;and success return DTCSUD: ;send urgent data SETZRO ;no longer blocking SETONE TCDUR,(TCB) ;set the urgent flag SETONE TCDPU,(TCB) ;set the push flag IFE REL6, ;go do the push IFN REL6, ;go do the push TMNE ;error? RETBAD ;yes so error return TMNN ;want to block? RETSKP ;no so success return ;here when we want to block PUSH P,T1 ;save this AC CALL UNLCKF ;unlock the JFN POP P,T1 ;restore this AC MDISMS ;go dismiss ;here we are back again MOVE T1,JFN ;get the jfn again IDIVI T1,MLJFN ;convert JFN to a number MOVE JFN,T1 ;and put it back CALL CHKJFN ;lock the JFN again RETBAD RETBAD RETBAD CAIN P3,TCPDTB ;TCP device? JRST DTCSUD ;yes RETBAD (TCPX22) ;no so return with error DTCSFN: ;Send FIN SKIPN TCB,FILTCB(JFN) ;get the TCB address RETSKP ;if no TCB then success LOAD T1,TJCN,(TCB) ;get the JCN for this connection TXO T1,TCP%JS ;this is a JCN JE TSUOP,(TCB),RSKP ;if never opened do not bother JE TSOPN,(TCB),RSKP ;if never got opened do not bother CLOSE% ;close down the connection ERJMP .+1 ;ignore errors SETONE TCDCW,(TCB) ;set close wait wait in case of CLOSF% RETSKP ;and return success SUBTTL IPOPR JSYS IFE REL6, IFN REL6, IFE REL6,<.IPOPR::> IFN REL6, MCENT ;jsys entry macro CAIG T1,IPOPDN ;legit function? SKIPGE T1 ;legit function? RETERR (TCPX23) ;no so give error MOVX T2, ;get mask of needed privs TDNN T2,CAPENB ;correct privs set? RETERR (TCPX24) ;no so return with error UMOVE T2,T2 ;get users ac 2 UMOVE T3,T3 ;get users ac 3 NOINT ;No PSIs during these functions CALL @IPOPDD(T1) ;dispatch on the function code RETERR (,) ;return error in ac 1 OKINT ;PSIs are ok now JRST MRETN ;success return IPOPDD: ;ipopr function code dispatch NCTDSP IPOPSN ;set network state NCTDSP IPOPRN ;read network state NCTDSP IPOPRI ;initialize host table NCTDSP IPOPGW ;initialize gateway table NCTDSP IPOPRB ;read state of internet bypass NCTDSP IPOPSB ;set state of internet bypass NCTDSP IPOPIP ;control internet portal NCTDSP IPOPAP ;control arp portal NCTDSP IPOPIG ;reinitialize GHT NCTDSP IPOPRG ;return GHT NCTDSP IPOPIC ;return internet portal counters NCTDSP IPOPAC ;return arp portal counters IPOPDN==.-IPOPDD-1 ;max function code IPOPSN: ;set network state MOVE T1,T2 ;get net number MOVE T2,T3 ;and value CALL MNTSET ;set it if possible NOP ;ignore errors RETSKP ;return success IPOPRN: ;read network state MOVE T1,T2 ;get the net number CALL MNTRED ;get the network state NOP ;ignore errors UMOVEM T2,3 ;save result in users t3 RETSKP ;success return IPOPRB: ;read state of internet bypass MOVE T1,INTBYP ;get state of the bypass UMOVEM T1,2 ;save result in users T2 RETSKP ;success return IPOPSB: ;set state of internet bypass SKIPE T2 ;non zero? SETO T2, ;yes make it all ones MOVEM T2,INTBYP ;set the new state RETSKP ;success return IPOPRI: ;initialize host table CALL HSTINI ;init the host table NOP ;ignore errors RETSKP ;return success IPOPGW: ;initialize gateway table CALL GWYINI ;reinitialize the gateway tables RETSKP ;success return IPOPIG: ;reinitialize GHT SKIPN [IPNIN] ;do we have IP on the NI code? RETBAD(TCPX44) ;no CALL NIHINI ;reload the translation table RET ;pass down any errors RETSKP ;success return IPOPIP: ;control internet portal SKIPN [IPNIN] ;do we have IP on the NI code? RETBAD(TCPX44) ;no SAVEAC ;save this AC MOVE P1,NIPNCT ;get our NCT MOVE T1,NTNET(P1) ;get our net number SKIPE T2 ;enable? SETO T2, ;yes so make sure it is -1 CALL MNTSET ;set it if possible NOP ;ignore errors RETSKP ;return success IPOPAP: ;control arp portal SKIPN [IPNIN] ;do we have IP on the NI code? RETBAD(TCPX44) ;no XMOVEI T1,ARPINI ;assume we are turning it on SKIPN T2 ;are we enabling it? XMOVEI T1,ARPKIL ;no CALL 0(T1) ;enable or disable ARP RETBAD() ;pass down the error RETSKP ;success return IPOPRG: ;return GHT SKIPN [IPNIN] ;do we have IP on the NI code? RETBAD(TCPX44) ;no RETBAD (TCPX23) ;for now return an error IPOPIC: ;return internet portal counters SKIPN [IPNIN] ;do we have IP on the NI code? RETBAD(TCPX44) ;no MOVEI T1,1 ;get a positive number MOVEM T1,NIPSRQ ;request to read IP counters AOS INTFRK ;ask for the internet fork to run MOVEI T1,NICTRS ;get the request down word adr CALL DISLE ;dismiss until .le. 0 RETSKP ;success return IPOPAC: ;return arp portal counters SKIPN [IPNIN] ;do we have IP on the NI code? RETBAD(TCPX44) ;no MOVEI T1,1 ;get a postive number MOVEM T1,ARPSRQ ;request to read ARP counters AOS INTFRK ;ask for the internet fork to run MOVEI T1,ARPTRS ;get the request done word adr CALL DISLE ;dismiss until .le. 0 RETSKP ;success return SUBTTL ATNVT% ;TVTJFN - Attach a TCP: JFN to a TVT ;Called from .ATNVT ;Returns to user +1 failure, T1/ error code ; +2 success, T1/ terminal designator ;Note that the error codes need to be updated for the TCP: device SWAPCD TVTJFN::STKVAR XCTU [HRRZ JFN,1] ;get user's JFN without flags CALL CHKJFN ;lock and verify JFN RETERR(ATNX1) ;bogus JFN RETERR(ATNX1) ;TTY RETERR(ATNX1) ;byte pointer or NUL: MOVEM JFN,ATNJFN ;save internal JFN HRRZ T1,FILDEV(JFN) ;get DTB CAIE T1,TCPDTB ;is it the TCP: device? ERUNLK(ATNX10) ;no, "Send JFN is not a NET connection" TQNN OPNF ;JFN is open? ERUNLK(ATNX9) ;"Send JFN is not open" TQNE READF ;open for read? TQNN WRTF ;and open for write? ERUNLK(OPNX15) ;"Read/write access required" SKIPN TCB,FILTCB(JFN) ;get the TCB address if it exists ERUNLK(TCPX35) ;in case no TCB (which should not happen) SKIPN TJOBA(TCB) ;have active output buffer? SKIPE TJOBF(TCB) ;or have fill output buffer? ERUNLK (ATNX11) ;yes - must be vanilla! SKIPN TJIBA(TCB) ;have active input buffer? SKIPE TJIBE(TCB) ;or have empty input buffer? ERUNLK (ATNX5) ;yes - must be vanilla! LOAD T1,TJCN,(TCB) ;get the JCN MOVEM T1,ATNJCN ;save JCN in case fails SETZRO TDEC,(TCB) ;clear the DEC bit in the TCB SETZM FILTCB(JFN) ;have JFN forget about the TCB IFE REL6, ;try to attach to a TVT IFN REL6, ;try to attach to a TVT IFNSK. MOVEM T1,ATNERR ;some error, save error code MOVE JFN,ATNJFN ;retrieve JFN (note: we do all this crud CALL UNLCKF ;unlock the JFN before we do the MDISMS below CALL RELJFN ;release the JFN so needn't worry about ints) MOVE T1,ATNJCN ;get back JCN TXO T1,TCP%JS ;set "JCN supplied" flag CLOSE% ;close the JCN ERJMP .+1 ;ignore errors LOAD T1,TOPNF,(TCB) ;get ID of Open Flag for this TCB LOAD T2,TERRF,(TCB) ;error flag index MKWAIT INTZOT ;select close done test MDISMS ;wait for close to happen MOVE T1,ATNJCN ;get back JCN TXO T1,TCP%JS ;set "JCN supplied" flag ABORT% ;close the JCN ERJMP .+1 ;ignore errors MOVE T1,ATNERR ;get back error code RETERR () ;return +1 to user ENDIF. MOVE JFN,ATNJFN ;retrieve JFN CALL UNLCKF ;unlock the JFN CALL RELJFN ;release the JFN SMRETN ;skip return to user ENDSV. SUBTTL String Length Subroutine IFE REL6, IFN REL6, STRLEN: ;Calculate length of string given two SAVEAC ;7-bit byte pointers, T1-T4 destroyed ;t1/ pointer one ;t2/ pointer two ;length returned in T3 IBP T1 ;advance both pointers IBP T2 ;to put them in a known state SETO T3, ADJBP T3,T2 ;backspace the second pointer SETO T2, ADJBP T2,T1 ;backspace the first pointer MOVE T1,T2 ;put first pointer into correct ac MOVEI T4,(T1) ;get the address SUBI T1,(T4) ;fix pointer for zero base address SUBI T3,(T4) ;and second pointer also MULI T1,5 ;five byte per word MULI T3,5 ;in this pointer also SUBI T4,-4(T3) ;get offset for second pointer SUBI T2,-4(T1) ;get offset for first pointer HRRZS T2 ;zero the left half HRRZ T3,T4 ;for this pointer also SUBI T3,(T2) ;get the length in bytes RET ;return to caller SKTCPU: ;Skip if TCP is up and initialized SKIPE TCPON ;tcp on? SKIPN TCPIFG ;and tcp initialized? RET ;no so no skip return RETSKP ;yes and yes so skip return SUBTTL Random Routines TCP2RT: ;routine to handle differences in returns ;from release 5 and release 6 IFN REL6, ;if release 6 then skip return IFE REL6, ;if release 5.1 then double skip return SAVAT: ;support routine for saveat macro ADJSP P,10 ;make room on the stack DMOVEM Q1,-7(P) ;save Q1 and Q2 MOVEM Q3,-5(P) ;save Q3 DMOVEM P2,-4(P) ;save P2 and P3 DMOVEM P4,-2(P) ;save P4 and P5 MOVEM P6,-0(P) ;save P5 PUSHJ P,0(CX) ;return to caller RSTAT: ;restoration routine SKIPA ;handle non skip return AOS -10(P) ;bump return address DMOVE P5,-1(P) ;restore P5 and P6 DMOVE P3,-3(P) ;restore P3 and P4 MOVE P2,-4(P) ;restore P2 DMOVE Q2,-6(P) ;restore Q2 and Q3 MOVE Q1,-7(P) ;restore Q1 ADJSP P,-10 ;fix up stack RET ;and return DISTST: ;check a sched test for possible dismiss ;returns opposite of real sched test SAVEAC ;save acs MOVE FX,FORKX ;get my fork handle HRRZ T2,T1 ;get the scheduler test address HLRZS T1 ;get the data for the sched test JSP T4,0(T2) ;dispatch to the sched test RETSKP ;skip rotuine RET ;non skip return ERTRAN: ;here to translate BBN errors to error codes TXZ T1,<777777,,777740> ;turn off unwanted bits CAILE T1,ERTMAX ;error code we know about? SETZ T1, ;no so fix it up MOVE T1,ERTABL(T1) ;get the new error code RET ;and return to caller ERTABL: EXP TCPX25,TCPX25,TCPX25,TCPX30,TCPX20,TCPXX3,TCPX19,TCPX31 EXP TCPX25,TCPX32,TCPX25,TCPX25,TCPX33,TCPXX8,TCPX25,TCPX25 EXP TCPXX1,TCPX34,TCPX25,TCPX25,TCPX34,TCPX34,TCPX34,TCPX25 EXP TCPX25,TCPX25,TCPX25,TCPX25,TCPX25,TCPX34,TCPX25,TCPX16 ERTMAX=.-ERTABL-1 NTNCTS: ;get out host number on a net SAVEAC ;save this ac CALL NETNCT ;lookup the host number RET ;error return MOVE T1,NTLADR(P1) ;put adr into a safe AC RETSKP ;skip return TNXEND END