Trailing-Edge
-
PDP-10 Archives
-
BB-EV84A-SM_1985
-
monitor-sources/tcpjfn.mac
There are 9 other files named tcpjfn.mac in the archive. Click here to see a list.
; 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:<TCPIP.5.4.MONITOR>TCPJFN.MAC.10, 24-Sep-84 13:55:47 by PURRETTA
;Update copyright notice.
; UPD ID= 275, SNARK:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>TCPJFN.MAC.8, 5-Sep-84 16:14:37 by PAETZOLD
;Use correct index register in dispatch in IPOPAP.
; UPD ID= 235, SNARK:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>TCPJFN.MAC.3, 12-May-84 18:11:06 by PAETZOLD
;fix typo
; UPD ID= 106, SNARK:<TCPIP.5.4.MONITOR>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.
;<TCPIP.5.3.MONITOR>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
;<TCPIP.5.1.MONITOR>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,<REL6==1>
IFNDEF NOTYET,<NOTYET==0>
STS=P1
JFN=P2
PTR=P3
DEV=P4
F1=P5
TCB=Q1 ;not the same as TCB in other modules
FX=Q3
DEFINE SAVEAT,<JSP CX,SAVAT>
TCPBSZ==100 ;buffer size
SUBTTL TCP Device DTB
SWAPCD
TCPDTB:: ; DTB for TCP: device
IFN REL6,<TCPDND-TCPDTB> ; 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,<XSWAPCD>
IFE REL6,<TCPSET:>
IFN REL6,<XNENT TCPSET>
;directory setup
SKIPE DECOK ;DEC TCP calls allowed?
CALL SKTCPU ;TCP up?
RETBAD (TCPX16) ;no
TQNE <STEPF,DIRSF,NAMSF,EXTSF,VERSF> ;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,<OKINT>) ;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,<TCPNAM:>
IFN REL6,<XNENT TCPNAM>
;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 <UNLKF> ;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,<TCPVER:>
IFN REL6,<XNENT TCPVER>
;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,<TCPEXT:>
IFN REL6,<XNENT TCPEXT>
;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,<TCPATR:>
IFN REL6,<XNENT TCPATR>
;here to check attributes from gtjfn
TRVAR <TCPATP> ;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,<TCPCLZ:>
IFN REL6,<XNENT TCPCLZ>
;here on a closf
SAVEAT ;save most acs
STKVAR <TCPCER>
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 <BLKF> ;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 <BLKF> ;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 <ERRF> ;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 <ERRF> ;Flag an error
RET ;return with error
SUBTTL RELJFN Handling
IFE REL6,<TCPRJF:>
IFN REL6,<XNENT TCPRJF>
;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,<TCPOPN:>
IFN REL6,<XNENT TCPOPN>
;perform openf
SAVEAT
STKVAR <<TCPBCB,.TCPCS>,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 <XCTF,RNDF> ;check illegal access modes
RETBAD (TCPX17) ;if any of these on then badness
TQNN <READF> ;must be readable
RETBAD (TCPX17) ;if not readable then error
TQNN <WRTF> ;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,<S1XCT <GTOKM (.GOANA,<T1,T2>,[RETBAD()])>> ; ask acj for its blessing
IFE REL6,<GTOKM (.GOANA,<T1,T2>,[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,<SC%WHL!SC%OPR!SC%NWZ!SC%NAS>
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 <BLKF> ;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 <BLKF> ;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 <ERRF> ;Flag an error
RETBAD ;and error return
TCPOP5: ;here on error return from the OPEN%
SETZRO <BLKF> ;not blocking now
SETZM FILTCB(JFN) ;no tcb anymore
CALL ERTRAN ;get the real error code
SETONE <ERRF> ;Flag an error
RETBAD ;and return with error
SUBTTL OPENF Scheduler Test
;TCPOTS - Scheduler test for open waits
;T1/ <TOPNF>B26+<TERRF>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,<EA.ENT> ;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,<CALL HSTHSH> ;find hash index
IFN REL6,<CALLX (XCDSEC,HSTHSH)> ;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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<TCPFI:>
IFN REL6,<XNENT TCPFI>
;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,<TCPFO:>
IFN REL6,<XNENT TCPFO>
;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 <BLKF> ;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 <BLKF> ;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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<RS%SE0!<.RESGP>B35> ;from the general pool
>
IFN REL6,<
MOVX T2,<RS%SE0!<.RESNP>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 <BLKF> ;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 <TCB> ;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,<TCPQI:>
IFN REL6,<XNENT TCPQI>
;Byte Input
SAVEAT ;save most acs
SETZRO <BLKF> ;we are no longer blocking
TCSQI0: ;here to see if input is possible
TQNN <EOFF> ;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 <BLKF> ;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,<<TCPBSZ-.TCPBS>_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 <T1>
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,<<TCPBSZ-.TCPBS>_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 <BLKF> ;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 <TCGIBB>
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 <EOFF> ;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 <ERRF> ;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,<<TCPBSZ-.TCPBS>_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,<TCPQO:>
IFN REL6,<XNENT TCPQO>
;byte Output
SAVEAT ;save most acs
TRVAR <TCPSOB>
MOVEM T1,TCPSOB ;save the byte to output
SETZRO <BLKF> ;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 <BLKF> ;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,<TCPBSZ-.TCPBS> ;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,<TCP%PU> ;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,<TCP%UR> ;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 <ERRF> ;set the error flag
RET ;non success return
SUBTTL SOUTR and GDSTS Handling
IFE REL6,<TCPQF:>
IFN REL6,<XNENT TCPQF>
;Force record out
SAVEAT ;save most acs
SETZRO <BLKF> ;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 <BLKF> ;want to block?
RET ;yes so return
TMNE <ERRF> ;have an error
RET ;yes so return
RETSKP ;otherwise skip return
IFE REL6,<TCPGTD:>
IFN REL6,<XNENT TCPGTD>
;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 <HSTPT1,HSTPT2,HSTPHN,HSTPOT,HSTPDP,HSTPPP> ;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 <SC%WHL,SC%OPR,SC%NAS,SC%NWZ>,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 <HSTHSN,HSTHSP>
SKIPN T1 ;string exist?
RET ;no so error return
SETZM HSTHSN ;zero the host number word
MOVX T2,<POINT 8,HSTHSN,3> ;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 <T4> ;do not trash this AC
STKVAR <HNLKPT,HNLKP1,HNLKP2>
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,<POINT 7,0(T2)> ;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,<JRST TCOPR1>
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,<SC%WHL!SC%NWZ!SC%OPR> ;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,<CALL UNLCKF>) ;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 <BLKF> ;no longer blocking
SETONE TCDPU,(TCB) ;set the push flag
CALL TCSQO1 ;go do the push
TMNE <ERRF> ;error?
RETBAD ;yes so error return
TMNN <BLKF> ;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,<TC%TXX> ;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 <BLKF> ;no longer blocking
SETONE TCDUR,(TCB) ;set the urgent flag
SETONE TCDPU,(TCB) ;set the push flag
IFE REL6,<CALL TCSQO1> ;go do the push
IFN REL6,<CALLX (XCDSEC,TCSQO1)> ;go do the push
TMNE <ERRF> ;error?
RETBAD ;yes so error return
TMNN <BLKF> ;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,<SWAPCD>
IFN REL6,<XSWAPCD>
IFE REL6,<.IPOPR::>
IFN REL6,<XNENT .IPOPR,G>
MCENT ;jsys entry macro
CAIG T1,IPOPDN ;legit function?
SKIPGE T1 ;legit function?
RETERR (TCPX23) ;no so give error
MOVX T2,<SC%WHL!SC%OPR!SC%NWZ!SC%MNT> ;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 (,<OKINT>) ;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 <P1> ;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 <ATNJFN,ATNJCN,ATNERR>
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,<CALL TATTVT> ;try to attach to a TVT
IFN REL6,<CALLX (XCDSEC,TATTVT)> ;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,<SWAPCD>
IFN REL6,<XSWAPCD>
STRLEN: ;Calculate length of string given two
SAVEAC <T4> ;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,<RETSKP> ;if release 6 then skip return
IFE REL6,<JRST SK2RET> ;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 <T1,T2,T3,T4,FX> ;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 <P1> ;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