Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/ft3/monitor/stanford/tcpbbn.mac
There are 9 other files named tcpbbn.mac in the archive. Click here to see a list.
;[MACBETH.STANFORD.EDU]SRC:<7.FT2.MONITOR.STANFORD>TCPBBN.MAC.3, 20-Jun-88 15:32:36, Edit by A.ALDERSON
; V7.0 FT Clock tape
;[MACBETH]SRC:<7.FT2.MONITOR.STANFORD>TCPBBN.MAC.2, 7-Apr-88 14:58:09, Edit by A.APPLEHACKS
; FT7.2 Merge
;[MACBETH]SRC:<7.FT1.MONITOR.STANFORD>TCPBBN.MAC.2, 26-Jan-88 00:34:03, Edit by A.APPLEHACKS
; FT7 Merge
;;PS:<6-1-MONITOR>TCPBBN.MAC.13, 9-Mar-86 17:16:16, Edit by BILLW
;; undo TSOPS bit setting.
;;PS:<6-1-MONITOR>TCPBBN.MAC.11, 24-Oct-85 03:47:00, Edit by BILLW
;; In SEND, set the "a packet has been sent" bit (TSOPS)
;;PS:<6-1-MONITOR>TCPBBN.MAC.10, 23-Oct-85 21:11:45, Edit by BILLW
;; initialize TSMRT time in ACTTCB
;;<6-1-MONITOR.FT6>TCPBBN.MAC.3, 12-Aug-85 18:01:49, Edit by WHP4
;;Stanford changes:
;; Use global job numbers in TOWNR
;
; UPD ID= 8630, RIP:<7.MONITOR>TCPBBN.MAC.3, 11-Feb-88 18:54:52 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 2194, SNARK:<6.1.MONITOR>TCPBBN.MAC.8, 5-Jun-85 11:11:23 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1747, SNARK:<6.1.MONITOR>TCPBBN.MAC.7, 10-Apr-85 10:46:46 by PAETZOLD
;Document BUGxxx's
; UPD ID= 1569, SNARK:<6.1.MONITOR>TCPBBN.MAC.6, 26-Feb-85 17:17:24 by PAETZOLD
;Document BUGxxx's
; UPD ID= 1086, SNARK:<6.1.MONITOR>TCPBBN.MAC.5, 16-Nov-84 16:27:28 by PAETZOLD
;More TCO 6.1041 - Make the GTOKM conditional
; UPD ID= 1040, SNARK:<6.1.MONITOR>TCPBBN.MAC.4, 12-Nov-84 15:26:32 by PAETZOLD
;TCO 6.1041 - Move ARPANET to XCDSEC
; UPD ID= 288, SNARK:<TCPIP.5.4.MONITOR>TCPBBN.MAC.2, 24-Sep-84 13:55:27 by PURRETTA
;Update copyright notice.
; UPD ID= 4024, SNARK:<6.MONITOR>TCPBBN.MAC.11, 31-Mar-84 16:21:36 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3916, SNARK:<6.MONITOR>TCPBBN.MAC.10, 13-Mar-84 08:06:34 by PAETZOLD
;More TCO 6.1733 - BBNCKK smashes T1. Reflect that fact in .OPEN
; UPD ID= 3893, SNARK:<6.MONITOR>TCPBBN.MAC.9, 11-Mar-84 10:36:06 by PAETZOLD
;More TCO 6.1733 - Use "JRST EMRET1" instead of RETERR at TCPERR so as
;not to set LSTERR and allow ITRAPs to work. TATTVT routine for TVTJFN
;to attach a JFN to a TVT. Require Wheel/Operator/NetWiz/AbsSockets to
;open listening on small port #. ACJ test passes host and port number
;to ACJ. If caller specifies a local address, use it in OPEN1A.
;Prevents FTP data connection opened on different host from control.
; UPD ID= 3823, SNARK:<6.MONITOR>TCPBBN.MAC.8, 29-Feb-84 18:13:12 by PAETZOLD
;More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug fixes. Cleanup.
;<TCPIP.5.3.MONITOR>TCPBBN.MAC.5, 6-Dec-83 23:58:40, Edit by PAETZOLD
;Add an ACJ call in .OPEN
;Make HISTOGRAM symbols conditional
;More TCO 6.1733 - Bug fixes.
;TCO 6.1689 - Move fork tables to extended sections. Fix FKPGS reference.
;<TCPIP.5.1.MONITOR>TCPBBN.MAC.21, 5-Jul-83 22:30:57, Edit by PAETZOLD
;JFN Interface
;BBN JSYS Stuff into this module
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH ANAUNV,PROLOG
TTITLE (TCPBBN,TCPBBN,< - BBN TCP JSYS Interface Routines>)
COMMENT !
This module implements the BBN TCP JSYS interface.
This code was originally developed at Bolt Beranek and Newman (BBN)
under contract to the Defense Advanced Research Projects Agency
(DARPA).
!
XSWAPCD
STSFLG==TCP%IX!TCP%NI!TCP%NT!TCP%SD!TCP%ST!TCP%SY!TCP%TV ; Frequent constant
Subttl Table of Contents
; Table of Contents for TCPBBN
;
; Section Page
;
;
; 1. Send JSYS - Send a Buffer . . . . . . . . . . . . . . 4
; 2. Send JSYS - Send a Buffer - Second Phase . . . . . . . 5
; 3. SETURP - Setup Urgent Pointer . . . . . . . . . . . . 7
; 4. RECV JSYS - Receive a Buffer . . . . . . . . . . . . . 8
; 5. RECV JSYS - Receive a Buffer - Second Phase . . . . . 9
; 6. OPEN JSYS - Open a Connection . . . . . . . . . . . . 10
; 7. OPEN JSYS - Open a Connection - Second Phase . . . . . 11
; 8. CLOSE JSYS - Close a Connection . . . . . . . . . . . 13
; 9. ABORT JSYS - Abandon this end of a connection . . . . 14
; 10. ABTJCS - Abort JCNs for Forks . . . . . . . . . . . . 15
; 11. ABTBUF - Abort Buffers Associated with Forks . . . . . 16
; 12. ABTJCN - Abort a JCN . . . . . . . . . . . . . . . . . 17
; 13. ABTTCB - Abort a TCB . . . . . . . . . . . . . . . . . 18
; 14. STAT JSYS - Get status of a connection or a TCB . . . 20
; 15. STAT JSYS - Get status of a connection - Second Phase 22
; 16. STATNM - Symbolic Routines . . . . . . . . . . . . . . 23
; 17. SRCH - Exact Match Binary Search Routine . . . . . . . 24
; 18. Symbolic STAT Tables . . . . . . . . . . . . . . . . . 25
; 19. CHANL - Set TCP Event Interrupt Channels . . . . . . . 26
; 20. SCSLV JSYS - Set Connection Security Level . . . . . . 27
; 21. TCP Portion of ATNVT JSYS . . . . . . . . . . . . . . 28
; 22. ACTTCB - Activate a Connection . . . . . . . . . . . . 31
; 23. CHKARG - Check BBN TCP JSYS Arguments . . . . . . . . 33
; 24. CHKJCN - See if caller has access to JCN . . . . . . . 37
; 25. GETJCN - Assign a Job Connection Number . . . . . . . 38
; 26. RETJCN - Free a Job Connection Number . . . . . . . . 39
; 27. MAKBFR - Make a Buffer Descriptor . . . . . . . . . . 40
; 28. FREBFR - Release Resources Used By a Buffer . . . . . 43
; 29. End of TCPBBN . . . . . . . . . . . . . . . . . . . . 45
SUBTTL Send JSYS - Send a Buffer
;T1/ Flags,,JCN (or Pointer to Connection Descriptor)
;T2/ Pointer to buffer header
;T3/ Timeout (in seconds) (0 is infinite)
;T4/ RX parameters
; SEND%
;Ret+1: Error, Code in T1
;Ret+2: Success
XNENT (.SEND,G)
MCENT ; Enter monitor context
TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT>&^-<TCP%JS!TCP%WT!TCP%HP>
JRST TCPILP ; Illegal control bit
XMOVEI T1,SEND1 ; Routine to call via CHKARG
CALL CHKARG ; Check arguments, set TCB, call SEND1
JUMPL T1,TCPERR ; Error.
UMOVE T1,T1 ; Get the Flags
TLNN T1,(TCP%WT) ; Supposed to wait?
JRST SKMRTN ; No. Give immediate skip return
SENDW: LOAD T1,BIDX,(BFR) ; Buffer Done Flag Index
LOAD T2,TERRF,(TCB) ; Error Flag index
ROT T2,-<WID(TERRF)> ; Put in high bits of T2
LSHC T1,^D18+<WID(TERRF)> ; Build bfr,err,,INTOOT
HRRI T1,INTOOT ; Select SEND Done Test routine
MDISMS ; Wait for either to come on
XMOVEI T1,SENDP2 ; Code to do Send checking w/ tcb locked
CALL CHKARG ; Do tcb lookup in case it's gone
JUMPL T1,TCPERR ; Jump if error
JUMPE T1,SKMRTN ; Skip return if conn open
HRLS T1 ; Conn closing, move wait bits to lh
HRRI T1,INTZOT ; Select close done test
MDISMS ;
XMOVEI T1,TCJFRE ; Code to do cleanup w/ tcb locked
CALL CHKARG ; Do tcb lookup in case it's gone
JUMPL T1,TCPERR ; Jump if error
SMRETN ; All done, skip return
SENDP2: LOAD T1,TERR,(TCB) ; Get possible error
JUMPN T1,[HRROS T1 ; If error,
RET ] ; ... return -1,,error in 1.
JE TSUOP,(TCB),SENDP3 ; Jump if conn closing already
CALL FREBFR ; Conn open, release buffer resources
SETZ T1, ; Return 0 in t1.
RET
SENDP3: ; Get wait bits for close wait test
LOAD T1,TOPNF,(TCB) ; Get ID of Open Flag for this TCB
LOAD T2,TERRF,(TCB) ; Error Flag index
ROT T2,-<WID(TERRF)> ; Put in high bits of T2
LSHC T1,<WID(TERRF)> ; Put opn,err in rh of T1.
RET ; Ret index bits to wait on
TCJFRE: CALL FREBFR ; Release resources
LOAD T1,TERR,(TCB) ; Get possible error
JUMPE T1,R ; Return 0 in T1 if no error
HRROS T1 ;
RET ; Ret with -1,,error in T1.
TCPERR: ANDI T1,-1 ; Save just the error code
TCPERO: UMOVEM T1,T1 ; Pass to user
JRST EMRET1 ; Give no-skip return. Do not update LSTERR
TCPILP: HRROI T1,ELP+^D1 ; Illegal parameter (control bit)
JRST TCPERR
SUBTTL Send JSYS - Send a Buffer - Second Phase
;T1/ JCN specified by caller
;TCB/ (Extended) Pointer to locked connection block
; NOINT
; CALL SEND1
;Ret+1: Always, T1 has 0 and BFR has the buffer, or T1 has -1,,error
SEND1: JN TTVT,(TCB),SEND8 ; Not allowed for TVTs
LOAD T3,TSSYN,(TCB)
CAIE T3,NOTSYN
CAIN T3,FINSNT ; Closed or closing?
JRST SEND6 ; Give error
SETZ T2, ; Not allow options from CDB here
CALL ACTTCB ; Try to activate the TCB (JCN in T1)
JUMPL T1,SEND6 ; Can't
XCTU [HRRZ T2,2] ; Get user buffer header address
SETZ T1,
JE TNUFM,(TCB),SEND3 ; Skip if old format
UMOVE T1,.TCPBI(T2) ; Get IP info
UMOVE T2,.TCPBO(T2) ; Get user option addresses word
TRNE T1,777 ; Specified?
STOR T1,TTOS,(TCB) ; Yes, Save type of service
HLRS T1
TRNE T1,.RTJST(-1,PITTL) ; User specify non-zero time?
STOR T1,TTTL,(TCB) ; Yes, Save Time to live
LSH T1,^D<-18+2> ; Top two bits
TRNE T1,3
STOR T1,TIFDF,(TCB) ; Don't fragment
MOVE T1,T2 ; Option addresses
SEND3:
; Should options be synchronous or asynchronous??
SKIPE T1 ; Have options?
CALL TCPUOP ; Yes
JUMPL T1,SENDX ; Error in options
CALL MAKBFR ; Make a buffer descriptor
SKIPGE BFR,T1 ; Error?
EXIT SENDX ; Yes. Code in T1.
UMOVE T3,T3 ; Get the Send Timeout from user
JUMPE T3,SEND4 ; He says infinite. Don't set it.
CAMLE T3,TCPPTM ; Be sure it is reasonable for add to TODCLK
MOVE T3,TCPPTM
IMULI T3,^D1000 ; Convert to milliseconds
STOR T3,TSTO,(TCB) ; Set new value in TCB
SEND4:
UMOVE T1,T4 ; Get Retrans. parameter word
CALL RXPARS ; Change them in TCB
MOVE T1,BFR ; What to Enqueue
XMOVEI T2,TCBSBQ(TCB) ; Queue head for send buffers
CALL NQ ; Enqueue it for Packetizer.
LOAD T1,BICNT,(BFR) ; Initial count
LOAD T2,TSBYT,(TCB) ; Currently queued for PZ
ADD T2,T1
STOR T2,TSBYT,(TCB) ; More...
MOVE T1,BFRFLG(BFR) ; Get the buffer flags
TXNN T1,TCP%UR ; URGENT send?
JRST SEND43 ; No.
CALL SETURP ; Yes. Set the send urgent pointer
SEND43:
LOAD T1,TSLFT,(TCB) ; Current Send Left
LOAD T2,TSSEQ,(TCB) ; Current Send Sequence
LOAD T3,TSWND,(TCB) ; Current Send Window
ADD T3,T1 ; Current Right
MODSEQ T3
CALL CHKWND ; See if there is space in the window
JUMPE T1,SEND5 ; Jump if not. Recv'd ACK will restart.
$SIGNL(PZ,0) ; Make Packetizer run now
SEND5:
TDZA T1,T1 ; Say OK to caller
SEND6: HRROI T1,ELP+^D12 ; "Connection Closing"
SENDX: RET
SEND8: HRROI T1,ELP+^D30 ; Only internet fork can run TVTs
RET
SUBTTL SETURP - Setup Urgent Pointer
;An URGENT send is being done and the value of the send urgent
;pointer must be computed. This is done by adding up all the queued
;data (on the send buffer queue) to get the current end of the urgent
;data, relative to the current send sequence.
;TCB/ Pointer to connection block
; NOINT
; CALL SETRUP
;Ret+1: Always. TSURP setup and TSURG turned on.
SETURP: PUSH P,BFR ; Need this global for scanning buffers
TEMP <CNT,NXT> ; Give names to T1, T2
MOVEI CNT,0 ; Assume no partial buffer
LOAD BFR,TSCB,(TCB) ; Get partial buffer if any
JUMPE BFR,SETUR1 ; Jump if none
SETSEC BFR,INTSEC ; Make extended address
LOAD CNT,BCNT,(BFR) ; Get number of unsent bytes from bfr
SETUR1:
MOVEI NXT,TCBSBQ(BFR) ; Pointer to send buffer queue head
SETUR2: MOVE BFR,NXT ; Point bfr to what we will process
CAIN BFR,TCBSBQ(BFR) ; Back to the queue head
JRST SETUR3 ; Means done. Go finish up.
SETSEC BFR,INTSEC ; Make extended address
LOAD NXT,QNEXT,+TCBSBQ(TCB) ; Get pointer to next item for next time
LOAD T3,BCNT,(BFR) ; Get count from this buffer
ADD CNT,T3 ; Add into total
JRST SETUR2 ; Loop over entire queue, incl. bfr being sent
SETUR3:
LOAD T3,TSSEQ,(TCB) ; Next send seq. num. to be used
ADD T1,T3 ; Compute 1st non-urgent seq. num.
MODSEQ T1 ; Keep within the right number of bits
STOR CNT,TSURP,(TCB) ; Set the urgent pointer into the TCB
SETONE TSURG,(TCB) ; Say we are in send urgent mode
POP P,BFR
RESTORE
RET
SUBTTL RECV JSYS - Receive a Buffer
;T1/ Flags,,JCN (or pointer to CDB)
;T2/ Pointer to buffer header
; RECV%
;Ret+1: Error. Code in T1
;Ret+2: Success
XNENT (.RECV,G)
MCENT ; Enter monitor context
TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
JRST TCPILP ; Illegal control bit
XMOVEI T1,RECV1 ; Routine to call via CHKARG
CALL CHKARG ; Check arguments, set TCB, call RECV1
JUMPL T1,TCPERR ; Error.
UMOVE T1,T1 ; Get flags
TLNN T1,(TCP%WT) ; Supposed to wait?
SMRETN ; No. Give immediate skip return
RECVW: LOAD T1,BIDX,(BFR)
LOAD T2,TERRF,(TCB) ; Error Flag index
ROT T2,-<WID(TERRF)> ; Put in high bits of T2
LSHC T1,^D18+<WID(TERRF)> ; Put indexes in LH
HRRI T1,INTOOT ; Select RECV done test routine
MDISMS
XMOVEI T1,TCJFRE ; Code to cleanup w/ tcb locked
CALL CHKARG ; Do tcb lookup in case it's gone
JUMPL T1,TCPERR ; Jump if error
SMRETN ; Return skip to user
SUBTTL RECV JSYS - Receive a Buffer - Second Phase
;T1/ JCN specified by caller
;TCB/ (Extended) Locked connection block
; NOINT
; CALL RECV1
;Ret+1: Always. T1 has 0 and BFR has the buffer, or T1 has-1,,error
RECV1: JN TTVT,(TCB),RECV8 ; Not allow for TVTs
LOAD T3,TRSYN,(TCB) ; Get receive state
CAIE T3,NOTSYN ; Not synchronized
CAIN T3,FINRCV ; or FIN received?
JRST RECV9 ; Yes. Fail. (error code into buffer?)
SETZ T2, ; Not allow options from CDB here
CALL ACTTCB ; Try to activate the TCB (JCN in T1)
JUMPL T1,RECV9 ; Could not.
CALL MAKBFR ; Make a buffer descriptor
SKIPGE BFR,T1 ; Check for error
EXIT RECVX ; There was one.
LOAD T1,TRBS,(TCB) ; Current amount of receive buffer space
LOAD T2,BICNT,(BFR) ; How much more is being made available
ADD T1,T2
STOR T1,TRBS,(TCB) ; New amount (for window setting)
MOVE T1,BFR ; Item to enqueue
XMOVEI T2,TCBRBQ(TCB) ; Receive buffer queue head
CALL NQ ; Enqueue this buffer there
CALL NUWNDO ; Setup the new window, maybe ENCPKT
JN TRPP,(TCB),RECV5 ; Jump if partially process pkt waiting
LOAD T1,QNEXT,<+TCBRPQ(TCB)> ; Ptr to 1st thing on RA queue
CAIN T1,TCBRPQ(TCB) ; Empty queue?
JRST RECV6 ; Yes. No use running RA
RECV5:
JN TRCB,(TCB),RECV6 ; No signal if RA already has a BFR
LOAD T3,QNEXT,<+TCBRBQ(TCB)> ; Get next buffer on the queue
SETSEC T3,INTSEC ; Make extended address
CAME T3,BFR ; Will this new buffer restart RA?
JRST RECV6 ; No. No need to run RA
$SIGNL(RA,0) ; Make Reassembler run now
RECV6:
TDZA T1,T1 ; Say OK to caller
RECV9: HRROI T1,ELP+^D12 ; "Connection Closing"
RECVX: RET
RECV8: HRROI T1,ELP+^D30 ; Only internet fork can run TVTs
RET
SUBTTL OPEN JSYS - Open a Connection
;T1/ Flags,,Pointer to Connection Descriptor Block (CDB)
;T2/ Persistence, seconds (max is TCPPTM)
;T3/ RX parameters
; OPEN%
;Ret+1: Error. T1 has <JCN,,code>. ELP+^D1 - bad bit (TCP%JS)
;Ret+2: Success.
XNENT (.OPEN,G)
MCENT ; Enter the monitor context
CALL BBNCKK
RETERR (TCPX28) ; not legal
;Unprivileged users must not be allowed to do a listening OPEN% on a
;small port number, e.g. [0.xxx]. This avoids a user from grabbing some
;server port, e.g. [0.23] (the TELNET port) and putting a trojan horse
;on it that gobbles down the user's password. It is really not enough
;to ask the ACJ just based upon it being some TCP open. For example, a
;site with on ARPANET and some local network may want to allow local
;net access but not ARPA access. Another example are resources such as
;printing servers which may be accessed only by certain individuals.
HOCTET==377B27 ; high order octet in a port number
UMOVE T1,1 ; get users AC1
TXNE T1,<STSFLG!TCP%JS>&^-<TCP%WT> ; JCN supplied is an error
JRST TCPILP ; Illegal control bit
MOVE T3,FORKX ; get our fork number
CAMN T3,INTFRK ; bypass check if we're the Internet fork
IFSKP.
XCTU [HRRZ T3,T1] ; must check, get connection block pointer
IFXE. T1,TCP%FS ; active connection may have any port #
UMOVE T1,.TCPLP(T3) ; get requested local port
ANDXE. T1,HOCTET ; not active, if high octet zero need privs
JE <SC%WHL,SC%OPR,SC%NAS,SC%NWZ>,CAPENB,[RETERR (NTWZX1)]
ENDIF.
UMOVE T1,.TCPFH(T3) ; get foreign host number
UMOVE T2,.TCPFP(T3) ; get foreign port number
S1XCT <GTOKM (.GOANA,<T1,T2>,[RETERR ()])> ; ask ACJ for its blessing
ENDIF.
XMOVEI T1,OPEN1 ; Routine to call via CHKARG
CALL CHKARG ; Check arguments, set TCB, call OPEN1
JUMPL T1,OPENE ; Jump if there was an error ?? JCN/TCB
UMOVE T2,T1 ; Get flags
TLNE T2,(TCP%WT) ; Supposed to wait?
JRST OPENW ; Yes.
OPENOK: TLO T1,(TCP%JS) ; Turn on JCN Supplied bit for him
UMOVEM T1,T1 ; Give JCN to user
SMRETN
OPENW: PUSH P,T1 ; Save the JCN
LOAD T1,TOPNF,(TCB) ; Get ID of Open Flag for this TCB
LOAD T2,TERRF,(TCB) ; Error Flag index
ROT T2,-<WID(TERRF)> ; Put in high bits of T2
LSHC T1,^D18+<WID(TERRF)> ; Put indexes in LH
HRRI T1,INTOOT ; Select OPEN Done Test
MDISMS
POP P,T1
LOAD T2,TERR,(TCB) ; Get error code
JUMPE T2,OPENOK ; Jump if no error
HRLZS T1 ; JCN left half
HRR T1,T2 ; Put error code in right half
SKIPA
OPENE: TLZ T1,400000 ; TURN OFF THE ERROR BIT
JRST TCPERO
SUBTTL OPEN JSYS - Open a Connection - Second Phase
;T1/ JCN resulting from CDB specified by caller
;T2/ Option addresses word, or 0 if none specified
;TCB/ (Extended) Locked connection block
; NOINT
; CALL OPEN1
;Ret+1: Always. T1 has -1,,error or the JCN
; -1,,ELP+^D6 Already open
; -1,,ELP+^D12 Closing (one side or other NOTSYN)
; -1,,ELP+^D30 TCP%VT not allowed by user jobs
OPEN1:: LOCAL <USRAC1,JCN,UOPTS>
MOVEM T1,JCN
MOVEM T2,UOPTS
UMOVE USRAC1,T1 ; get the flags
TLNN USRAC1,(TCP%VT) ; Virtual terminal?
JRST OPEN1A ; Not a virtual terminal
HRROI T1,ELP+^D30 ; "Only Internet fork can run TVTs"
MOVE T2,FORKX ; Which fork this is
CAME T2,INTFRK ; The Internet fork?
JRST OPENX ; No. Give error return
OPEN1A:
JN TSUOP,(TCB),OPEN6 ; Jump if already open
JN TLH,(TCB),OPEN1D ; If caller specified a local address use it
LOAD T1,TFH,(TCB) ; Get foreign host
JUMPE T1,OPEN1D
PUSH P,P1 ; Save AC
CALL FNDNCT ; Get the NCT for that net
JRST [ POP P,P1 ; Restore AC
MOVE T1,DEFADR ; Use default address
JRST OPEN1B] ; Join below
MOVE T1,NTLADR(P1) ; get our address on that network
POP P,P1 ; Restore AC
OPEN1B:
STOR T1,TLH,(TCB) ; And stick it in the TCB
OPEN1D:
MOVE T1,JCN
MOVE T2,UOPTS
CALL ACTTCB ; Try to activate the TCB
JUMPL T1,OPENX2 ; Cannot
SETONE TSUOP,(TCB) ; Mark the TCB as open
JE TNUFM,(TCB),OPEN5 ; Skip following if old format
HRRZ T1,USRAC1 ; Connection block address
UMOVE T1,.TCPIP(T1) ; Get IP parameter word
STOR T1,TTOS,(TCB) ; Save type of service
HLRS T1
TRNE T1,.RTJST(-1,PITTL) ; User specify non-zero time?
STOR T1,TTTL,(TCB) ; Yes, Save Time to live
LSH T1,^D<-18+2> ; Top two bits
STOR T1,TIFDF,(TCB) ; Don't fragment
OPEN5:
UMOVE T2,T2 ; no get the send timeout from user
JUMPE T2,OPEN4 ; Don't change if no specification
CAMLE T2,TCPPTM ; Be sure it is reasonable for add to TODCLK
MOVE T2,TCPPTM
IMULI T2,^D1000 ; Make into milliseconds
STOR T2,TSTO,(TCB) ; Set the new value into the TCB
OPEN4:
UMOVE T1,T3 ; get retrans. parameter word
CALL RXPARS ; Change them in TCB
TLNN USRAC1,(TCP%VT) ; Openning as a virtual terminal?
JRST OPEN3 ; No
SETONE TTVT,(TCB) ; Yes. Mark TCB as such
OPEN3:
TMNN TCDFS,(TCB) ; JFN interface want active?
TLNE USRAC1,(TCP%FS) ; Supposed to force synchronization?
CALL FRCPKT ; Yes. Packetizer will do that.
; Should TSPRS be on allready?
TLNN USRAC1,(TCP%PS) ; Supposed to be persistent?
JRST OPEN2 ; No.
SETONE TSPRS,(TCB) ; Yes, mark the TCB as such.
OPEN2:
MOVE T1,JCN ; Value to return
EXIT OPENX
;Returning an error is bad since connection is open & cannot return
;both error and JCN, either abort & return error or skip & return JCN
OPEN6: HRROI T1,ELP+^D6 ; "Connection already open"
OPENX2: ; Probably bad options
OPENX:
JUMPGE T1,OPENX3 ; JUMP IF NO ERROR
HRLI T1,(JCN) ; GET THE JCN FOR USER ABORT
TLO T1,400000 ; TURN ON THE ERROR BIT
OPENX3: ; HERE WHEN NO ERROR
RESTORE
RET
SUBTTL CLOSE JSYS - Close a Connection
;T1/ Flags,,JCN (NOTE: don't allow CDB here since it would create a TCB)
; CLOSE%
;Ret+1: Error, Code in T1
; ELP+^D1 Bad JCN, No TCB, CDB not allowed
; ELP+^D3 Was never open
;Ret+2: Success
XNENT (.CLOSE,G)
MCENT ; Enter the monitor context
TXNE T1,TCP%JS ; JCN must be supplied
TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
JRST TCPILP ; Illegal control bit
HRRZS T1 ; Save just the JCN part
XMOVEI T2,CLOSE1 ; Select CLOSE1 routine
CALL CHKJCN ; Check access, set TCB, call CLOSE1
JUMPL T1,TCPERR ; Jump if error.
UMOVE T1,T1 ; Get flags
TLNN T1,(TCP%WT) ; Supposed to wait?
JRST CLOSEX ; No. User will do ABORT to release JCN
LOAD T1,TOPNF,(TCB) ; Get ID of Open Flag for this TCB
LOAD T2,TERRF,(TCB) ; Error Flag index
ROT T2,-<WID(TERRF)> ; Put in high bits of T2
LSHC T1,^D18+<WID(TERRF)> ; Put indexes in LH
HRRI T1,INTZOT ; Select Close Done Test
MDISMS
LOAD T1,TERR,(TCB) ; Get the error code
JUMPN T1,TCPERR ; Jump if error code non-null
LOAD T1,TJCN,(TCB) ; Get the JCN for this connection
CALL RETJCN ; Release it
CLOSEX: SMRETN
CLOSE1::JE TSOPN,(TCB),CLOSE3 ; Was it ever open?
JE TSUOP,(TCB),CLOSE3 ; Still Open?
SETZRO TSUOP,(TCB) ; No longer
CALL FRCPKT ; Get a FIN sent by Packetizer
TDZA T1,T1 ; Tell caller OK
CLOSE3: HRROI T1,ELP+^D3 ; "Connection not open"
RET
SUBTTL ABORT JSYS - Abandon this end of a connection
;T1/ Flags,,JCN
; ABORT
;Ret+1: Error. T1 has code. ELP+^D1 - CDB supplied
;Ret+2: Success. Nothing more will be heard about this connection.
XNENT (.ABORT,G)
MCENT ; Enter monitor context
TXNE T1,TCP%JS ; JCN must be supplied
TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
JRST TCPILP ; Illegal control bit
HRRZS T1 ; Save just the JCN
XMOVEI T2,ABORT1 ; Select the routine to run
CALL CHKJCN ; Check arguement, set TCB, run ABORT1
JUMPL T1,TCPERR ; Jump if some sort of error
MOVEI T1,TCPABT ; Select wait routine
HRL T1,FORKX ; For this fork
MDISMS
SMRETN
;ABORT1(TCB)
;Second phase of ABORT JSYS
;T1/ JCN specified by caller (ignored here)
;TCB/ (Extended) Locked Connection Block
; NOINT
; CALL ABORT1
;Ret+1: Always. T1 has 0 for passing to caller.
ABORT1:
CALL ABTTCB ; Abort the connection and increment
; # being aborted by this forkx
LOAD T1,TJCN,(TCB) ; Get user's handle
CALL RETJCN ; Release that.
MOVX T1,OK ; Say OK to caller
RET
SUBTTL ABTJCS - Abort JCNs for Forks
;T1/ Job fork number of fork being considered
; CALL ABTJCS
;Ret+1: Always.
XNENT (ABTJCS,G)
SKIPE TCPON ; TCP enabled?
SKIPL TCPIFG ; TCP Initialized yet (JOB-0 startup)
RET ; No.
SAVET ; CLZFF code requires this
MOVE T3,T1 ; Put in place for call via LCKCAL
XMOVEI T1,TCBHLK ; Stabilize JCNTCB table in JSB
XMOVEI T2,ABTJC1 ; and call function to abort JCNs
NOINT ; Retain control during this
CALL LCKCAL
MOVEI T1,TCPABT ; Wait for all to be aborted
HRL T1,FORKX ; The ones by this fork, that is.
MDISMS
OKINT ; State is clean again
RET
;T1/ Job fork number of fork being considered
;ABTJC1
;Same as above, but called with TCBH Lock set, NOINT
;TCBHLK locked, NOINT
ABTJC1: LOCAL <JCN,JOBFRK>
PUSH P,TCB
MOVEM T1,JOBFRK
MOVSI JCN,-MAXJCN ; Set to scan table
ABTJC2: HRRZ TCB,JCNTCB(JCN) ; Get pointer to TCB
JUMPE TCB,ABTJC3 ; Avoid non-pointers
SETSEC TCB,INTSEC ; Make extended address
XMOVEI T1,TCBLCK(TCB) ; Pointer to lock on that TCB
XMOVEI T2,ABTJCN ; Function to abort a JCN
MOVE T3,JOBFRK ; Argument for ABTJCN
CALL LCKCAL ; Lock the TCB and Abort the JCN
ABTJC3: AOBJN JCN,ABTJC2 ; Loop over all
POP P,TCB
RESTORE
RET
SUBTTL ABTBUF - Abort Buffers Associated with Forks
; CALL ABTBUF
;Ret+1: Always.
XNENT (ABTBUF,G)
SAVET ; KSELF code requires this
SKIPE TCPON ; TCP enabled?
SKIPL TCPIFG ; TCP Initialized yet (JOB-0 startup)
RET ; No.
XMOVEI T1,TCBHLK ; Stabilize JCNTCB table in JSB
XMOVEI T2,ABTBF1 ; and call function to abort JCNs
CALL LCKCAL ; lock the lock and scan the TCBs
RET
;ABTBF1 worker for above, but called with TCBH Lock set
ABTBF1: LOCAL <JCN>
PUSH P,TCB
MOVSI JCN,-MAXJCN ; Set to scan table
ABTBF2: HRRZ TCB,JCNTCB(JCN) ; Get pointer to TCB
JUMPE TCB,ABTBF3 ; Avoid non-pointers
SETSEC TCB,INTSEC ; Make extended address
PUSH P,JCN
XMOVEI T1,TCBLCK(TCB) ; Lock the TCB
XMOVEI T2,ABTBF4 ; Go to worker routine for the TCB
CALL LCKCAL ; Lock the lock and call the routine
POP P,JCN
ABTBF3: AOBJN JCN,ABTBF2 ; Loop over all the JCNs
POP P,TCB ; Restore an AC
RESTORE
RET
ABTBF4: ; worker routine called with TCB locked
CALL FLSRBX ; flush any receive buffers
CALL FLSSBX ; flush any send buffers
RET ; return to caller
SUBTTL ABTJCN - Abort a JCN
;T1/ Job fork number being considered
;TCB/ (Extended) Locked connection block
;TCBH/ Locked TCB Hash table
; NOINT
; CALL ABTJCN
;Ret+1: Always.
ABTJCN: LOAD T2,TOWNR,(TCB) ; Get job number of owner
IFE STANSW,<
CAME T2,JOBNO ; Better be ours
>;IFE STANSW
IFN STANSW,<
CAME T2,GBLJNO ; Better be ours
>;IFN STANSW
BUG.(CHK,TCPJS4,TCPTCP,SOFT,<ABTJCN: TCP Conn not owned by aborting job>,,<
Cause: ABTJCN was called for a connection not owned by the calling job.
>)
LOAD T2,TOFRK,(TCB) ; Get job fork handle of owning fork
UMOVE T3,T1 ; Get CLZFF flags from caller
CAME T1,T2 ; Was JCN created by the object fork?
JRST ABTJC4 ; No.
TXNN T3,CZ%NSF ; Yes. Are we supposed to abort there?
JRST ABTJC5 ; Yes. Go do it
EXIT ABTJCX
ABTJC4: EXCH T1,T2 ; Get to right places for SKIIFA
TXNN T3,CZ%NIF ; Abort inferiors' connections?
CALLX (MSEC1,ABTJC6) ; Check owner inferior to object fork
EXIT ABTJCX ; Should not kill it
ABTJC5: ; ??Why not CALL ABORT1 for these?
CALL ABTTCB ; Get the TCP fork to do the work
LOAD T1,TJCN,(TCB) ; Get the JCN
CALL RETJCN ; Release that
ABTJCX: RET
SWAPCD ; why look at SKIIFA
ABTJC6: ; jacket routine for SKIIFA
CALL SKIIFA ; Check owner inferior to object fork
RET ; non skip return
RETSKP ; skip return
XSWAPCD
SUBTTL ABTTCB - Abort a TCB
;TCB/ Locked Connection Block
; NOINT
; CALL ABTTCB
;Ret+1: Always.
ABTTCB::
JN TSABT,(TCB),R ; Already being aborted?
SETONE TSABT,(TCB) ; No. Make it so.
SETZRO TSUOP,(TCB) ; Fake a CLOSE
MOVEI T1,ELP+^D14 ; Connection reset
CALL ABTCON ; Clean up the database for this connection
MOVE T1,FORKX ; Our fork number
STOR T1,TABTFX,(TCB) ; Indicate which is killing the TCB
NOSKED ; Make sure we get the system
ADJBP T1,FKABCP ; Pointer to base of counters
LDB T2,T1
CAIGE T2,<1_ABTCBS>-1 ; Do not allow count to wrap around
ADDI T2,1 ; Bump the number killed by this fork
DPB T2,T1
OKSKED ; Only be NOSKED for the ABORT part
$SIGNL(PZ,0) ; Run packetizer
RET
RESCD
;TCPABT(FORKX)
;Scheduler test for ABORT(s) done
;T1/ a FORKX
;T4/ Return address
; JSP T4,TCPABT
;Ret+1: One or more connections still being aborted
;Ret+2: All ABORTs completed
TCPABT::
ADJBP T1,FKABCP
LDB T2,T1
JUMPE T2,1(T4)
JRST 0(T4)
XSWAPCD
SUBTTL STAT JSYS - Get status of a connection or a TCB
;T1/ Flags,,JCN or Pointer to CDB
;T2/ -N,,Offset Number and beginning to return
;T3/ -M,,Address Size and location in user space for results
; STAT%
;Ret+1: Error. Code in T1
; ELP+^D20
; ELP+^D21
; from CHKARG
;Ret+2: Success
XNENT (.STAT,G)
MCENT ; Enter monitor context
TXNE T1,<TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT!STSFLG>
JRST TCPILP ; Illegal control bit
TXNE T1,TCP%ST ; Asking for TCP statistics?
JRST STATS ; Yes
TXNE T1,TCP%NT ; AOBJN pointer for TVTs wanted?
JRST STATNT ; Yes
TXNE T1,TCP%NI ; AOBJN pointer for connections wanted?
JRST STATNI ; Yes
XMOVEI T1,STAT1 ; Select routine to call
CALL CHKARG ; Check arguments, set TCB, call STAT1
JUMPL T1,TCPERR ; There was something wrong.
SMRETN
; Return in 2/ -#TVTs,,first TVT
STATNT: MOVE T2,TVTPTR ; Get AOBJN pointer
UMOVEM T2,2 ; to user
SMRETN ; All ok
; Return in 2/ -# connections,,1
STATNI: MOVN T2,TCBCNT ; # connections
HRLS T2 ; in LH
HRRI T2,1 ; First connection #
UMOVEM T2,2 ; to user
SMRETN ; All ok
; Just copy the statistics area to user space
STATS: SETZ TCB, ; Be safe
TXNE T1,TCP%SY ; Giving symbolic names?
JRST STATS9 ; Yes
HLRE T1,T2 ; Get count
MOVNS T1 ; As a positive number
HLRE T4,T3 ; Get size of user's area
MOVNS T4 ; As a positive number
CAMLE T1,T4 ; Take min as size of transfer
MOVE T1,T4
MOVEI T4,0(T2) ; Start point
ADD T4,T1 ; End + 1
CAILE T4,STATZZ-STAT0 ; Compare with size of statistics area
JRST STATS8 ; Tell him it is bad.
PUSH P,T1 ; Save for awhile
MOVEI T2,STAT0(T2) ; Start address within statistics area
HRRZS T3 ; Assume user section 0
CALL BLTMU ; Transfer from monitor to user
POP P,T4 ; Recover size
HRLS T4 ; Make N,,N
XCTU [ADDM T4,T2] ; Update user's pointers
XCTU [ADDM T4,T3]
SMRETN
STATS8: HRROI T1,ELP+^D21 ; Bad arg to STAT
JRST TCPERR
STATS9: CALL STATNM ; Do work
JUMPL T1,TCPERR ; Error exit
SMRETN
SUBTTL STAT JSYS - Get status of a connection - Second Phase
;T1/ JCN specified by caller (ignored here)
;TCB/ (Extended) Locked connection block
; NOINT
; CALL STAT1
;Ret+1: Always. T1 has 0 for OK, or -1,,error
; -1,,ELP+^D20
; -1,,ELP+^D21
STAT1: LOCAL <XFRCNT>
UMOVE T1,T1 ; Get flags
UMOVE T2,T2 ; Get pointer
UMOVE T3,T3 ; Get pointer to user space
TXNE T1,TCP%SY ; Giving symbolic names?
JRST STAT6 ; Yes
JUMPGE T2,STAT9 ; Strange pointer
JUMPGE T3,STAT9 ; Strange pointer
HLRE T1,T2 ; Get count
MOVNS T1 ; As a postive number
HLRE XFRCNT,T3 ; Get size of user's area
MOVNS XFRCNT ; As a postive number
CAMLE XFRCNT,T1 ; Take min as size of transfer
MOVE XFRCNT,T1
HRRZ T4,T2 ; Start offset
CAIL T4,TCBSIZ ; Must be within TCB
JRST STAT8 ; Tell him "bad arg"
ADD T4,XFRCNT ; Compute end+1
CAILE T4,TCBSIZ ; Trying to read too much?
JRST STAT8 ; Tell him arg is bad.
HRRZS T2 ; Flush the count
ADD T2,TCB ; Start address within TCB
HRRZS T3 ; Flush the count (assume user sec 0)
MOVE T1,XFRCNT ; Set up count
CALL BLTMU ; Transfer from monitor to user
HRLS XFRCNT
XCTU [ADDM XFRCNT,T2] ; Update user's pointers
XCTU [ADDM XFRCNT,T3]
MOVX T1,OK ; Tell caller all is well
EXIT STATX
STAT6: CALL STATNM ; Do the work
JRST STATX
STAT8: SKIPA T1,[-1,,ELP+^D20] ; "Funny pointer to STAT"
STAT9: HRROI T1,ELP+^D21 ; "Bad transfer size to STAT"
STATX: RESTORE
RET
SUBTTL STATNM - Symbolic Routines
; T1/ User flags
; T2/ Input count/pointer
; T3/ Output count/pointer
; CALL STATNM
;Ret+1: Always T1 has error code or 0
STATNM: LOCAL <UFL,INP,OUP>
PUSH P,TCB-1 ; Used for STAT0
XMOVEI TCB-1,STAT0 ; References
JUMPGE T2,STATNV ; IN pointer error
JUMPGE T3,STATNV ; OUT pointer error
MOVEM T1,UFL ; Save flags (TCP%SD)
MOVEM T2,INP ; Save pointers
MOVEM T3,OUP
; Know have valid input ptr & at least 1 output slot
STATN3: UMOVE T4,(INP) ; Get name
CALL SRCH ; Lookup name
JUMPE T2,STATNW ; Lose
TXNE UFL,TCP%SD ; Want pointer or value?
MOVEI T2,1 ; Pointer has only one value
TXNE UFL,TCP%SD ; Want pointer or value?
SKIPA T1,T3 ; Get pointer
LDB T1,T3 ; Get value
STATN7: UMOVEM T1,(OUP) ; For user
SOS T2 ; One less to go
AOBJP OUP,STATNU ; Leave if output full
JUMPLE T2,STATN8 ; End Multiple
ILDB T1,T3 ; Get value
JRST STATN7
STATN8: AOBJN INP,STATN3 ; More input?
SETZ T1, ; No, All done w/o error
JRST STATNX
STATNU: SKIPN T1,T2 ; Error if more to output
AOBJP INP,STATNX ; Or more input
STATNV: SKIPA T1,[-1,,ELP+^D21] ; Bad pointers
STATNW: HRROI T1,ELP+^D22 ; Invalid name
STATNX: UMOVEM INP,2 ; Return updated input
UMOVEM OUP,3 ; And output pointers
POP P,TCB-1 ; Restore register
RESTORE
RET ; Return
SUBTTL SRCH - Exact Match Binary Search Routine
; T4/ Symbol
; CALL SRCH
; T3/ Pointer
; T2/ Count
SRCH: TEMP <PRB,XXX,OFS,KEY>
SETZB PRB,T2 ; Offset into table & Assume missing
MOVX OFS,1_<^D<36-^L<STABLN>>> ; Get Initial offset (next 2**N)
SRCHF: ADD PRB,OFS ; Move forward (double)
SRCHR: LSH OFS,-1 ; Next time
SUB PRB,OFS ; Move reverse
JUMPLE OFS,SRCHX ; Stop if no move
CAIG PRB,STABLN ; Point too far? or
CAMGE KEY,STSTAB(PRB) ; Value too big?
JRST SRCHR ; Yes, move back
CAML KEY,STSTAB+1(PRB) ; As far as next?
JRST SRCHF ; Yes, move forward
SRCHX: CAME KEY,STSTAB(PRB) ; Exact match?
RET ; No, error (T2 is 0)
MOVE T3,STATPT(PRB) ; Value
MOVE T2,STATCT(PRB) ; Count
RESTORE
RET
SUBTTL Symbolic STAT Tables
DEFINE DEFSTS <
IFN IPPDSW,<XX (M,ACDLAY,HISTSZ)>
XX (M,BGRNCT)
XX (M,BGUSE)
XX (M,BYTRCT)
XX (M,BYTSCT)
XX (M,DGRNCT)
XX (M,DGUSE)
XX (M,DUPKCT)
XX (M,FINRCT)
XX (M,FINSCT)
XX (M,INTBYP)
IFN IPPDSW,<XX (M,IPDLAY,HISTSZ)>
XX (M,IPPKCT)
XX (M,IPRNCT)
XX (M,IPUSE)
XX (M,OHUSE)
IFN IPPDSW,<XX (M,OPDLAY,HISTSZ)>
XX (M,OPPKCT)
XX (M,OPRNCT)
XX (M,OPUSE)
IFN IPPDSW,<XX (M,PZDLAY,HISTSZ)>
XX (M,PZPKCT)
XX (M,PZRNCT)
XX (M,PZUSE)
IFN IPPDSW,<XX (M,RADLAY,HISTSZ)>
XX (M,RAPKCT)
XX (M,RARNCT)
XX (M,RAUSE)
XX (M,RSTRCT)
XX (M,RSTSCT)
IFN IPPDSW,<XX (M,RXDLAY,HISTSZ)>
XX (M,RXPKCT)
XX (M,RXRNCT)
XX (M,RXUSE)
XX (M,SYNRCT)
XX (M,SYNSCT)
XX (T,TABTFX)
XX (M,TASKCT)
XX (T,TCBIO,<1_<WID(PIDO)>-1-<MINIHS+3>/4>)
XX (T,TCBIR,<1_<WID(PIDO)>-1-<MINIHS+3>/4>)
XX (T,TCBIU,<1_<WID(PIDO)>-1-<MINIHS+3>/4>)
XX (T,TCBTO,<1_<WID(PTDO)>-1-<MINTHS+3>/4>)
XX (T,TCBTR,<1_<WID(PTDO)>-1-<MINTHS+3>/4>)
XX (T,TCBTU,<1_<WID(PTDO)>-1-<MINTHS+3>/4>)
XX (T,TCTBS)
XX (T,TCTSQ)
XX (T,TERBF)
XX (T,TERJN)
XX (T,TERR)
XX (T,TERRF)
XX (T,TERRT)
XX (T,TFH)
XX (T,TFP)
XX (T,TIFDF)
XX (T,TIPDO)
XX (T,TIPOR)
XX (T,TIPOU)
XX (T,TJCN)
XX (T,TLH)
XX (T,TLP)
XX (T,TMNRT)
XX (T,TMXRT)
XX (T,TOFRK)
XX (T,TOPFH)
XX (T,TOPFP)
XX (T,TOPLH)
XX (T,TOPNF)
XX (T,TOWNR)
XX (T,TPICA)
XX (T,TPICE)
XX (T,TPICR)
XX (T,TPICS)
XX (T,TPICU)
XX (T,TPICX)
XX (T,TPIFA)
XX (T,TPIFE)
XX (T,TPIFR)
XX (T,TPIFS)
XX (T,TPIFU)
XX (T,TPIFX)
XX (T,TRBS)
XX (T,TRCBY)
XX (T,TRIS)
XX (T,TRLAK)
XX (T,TRLFT)
XX (T,TRLWN)
XX (T,TRPP)
XX (T,TRSYN)
XX (T,TRURG)
XX (T,TRURP)
XX (T,TRWND)
XX (T,TRXI)
XX (T,TRXPD)
XX (T,TRXPI)
XX (T,TRXPN)
XX (T,TSABT)
XX (T,TSBYT)
XX (T,TSCB)
XX (T,TSCR)
XX (T,TSEP)
XX (T,TSFP)
XX (T,TSLFT)
XX (T,TSLVC)
XX (T,TSLVN)
XX (T,TSMRT)
XX (T,TSMXB)
XX (T,TSMXP)
XX (T,TSOPN)
XX (T,TSPRS)
XX (T,TSSEQ)
XX (T,TSSV)
XX (T,TSSYN)
XX (T,TSTO)
XX (T,TSUOP)
XX (T,TSURG)
XX (T,TSURP)
XX (T,TSWND)
XX (T,TTOS)
XX (T,TTPDO)
XX (T,TTPOR)
XX (T,TTPOU)
XX (T,TTTL)
XX (T,TTVT)
XX (T,TVTL)
XX (T,TWLDN)
XX (T,TWLDP)
XX (T,TWLDT)
> ; End of DEFINE DEFSTS
; Construct the ASCII Name Table
DEFINE XX (TYP,NAM,LEN)<
IFLE <ASCII /NAM/>-..XL,<PRINTX ? DEFSTS NAM is truncated or out of order>
..XL=ASCII /NAM/
EXP ..XL
> ; End of DEFINE XX
..XL=400000000000
STSTAB: 400000000000 ; Minimum
XLIST
DEFSTS ; Status names
LIST
377777777777 ; Maximum
STABLN=.-STSTAB-2
; Construct the Count Table
DEFINE XX (TYP,NAM,LEN)<
IFB <LEN>,<1>
IFNB <LEN>,<LEN>
> ; End of DEFINE XX
STATCT: 0 ; Minimum
XLIST
DEFSTS ; Status counts
LIST
0 ; Maximum
; Construct the LDB Pointer Table
DEFINE XLDB (L,O,M)< <^D<35-POS(M)>>B5+<WID(M)>B11+<TCB>B17+O >
DEFINE XX (TYP,NAM,LEN)<
..XL=-1
IFIDN <TYP><M>,< POINT 36,NAM-STAT0(TCB-1),35
..XL=..XL+1> ; End IFIDN M
IFIDN <TYP><T>,< IFNDEF %'NAM,< POINT 36,NAM(TCB),35>
IFDEF %'NAM,< %'NAM (XLDB,,,NAM)>
..XL=..XL+1> ; End IFIDN T
IFN ..XL,<PRINTX ? Type code for NAM must be M or T>
> ; End of DEFINE XX
STATPT: 0
XLIST
DEFSTS ; Status pointers
LIST
0
PURGE ..XL
SUBTTL CHANL - Set TCP Event Interrupt Channels
;T1/ Flags,,JCN (or pointer to CDB)
;T2/ Six 6-bit bytes (channel numbers)
; 77 - No change, or 0-5, 24-35 Channel to get intertupt
; CHANL
;Ret+1: Error, Code in T1.
; from CHKARG
; ELP+^D17 Bad arg to CHANL
;Ret+2: Success
XNENT (.CHANL,G)
MCENT ; Enter monitor context
TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
JRST TCPILP ; Illegal control bit
XMOVEI T1,CHANL1 ; Select routine to call via CHKARG
CALL CHKARG ; Check arguments, set TCB, call CHANL1
JUMPL T1,TCPERR ; Jump if something is wrong.
SMRETN
;CHANL1(TCB)
;Second phase of CHANL JSYS
;T1/ JCN specified by caller (ignored here)
;TCB/ (Extended) Locked Connection Block
; NOINT
; CALL CHANL1
;Ret+1: Always. T1 has 0 if OK, or -1,,error
; -1,,ELP+^D17 Bad arg to CHANL
CHANL1: TEMP <NEW,OLD,CNT,FORKID>
LOCAL <NEWCHS,NEWPTR,OLDPTR,FRKPTR>
UMOVE NEWCHS,T2 ; Get channel word from user
MOVE NEWPTR,[POINT 6,NEWCHS] ; Set to scan them
MOVE OLDPTR,[POINT 6,TCBPIC(TCB)]; Set to scan current ones
MOVE FRKPTR,[POINT 18,TCBPIF(TCB)]; Set to scan forks
MOVEI CNT,6 ; How many to scan
MOVE FORKID,FORKX ; Who is setting the new channels
CHANL2: ILDB NEW,NEWPTR ; Get a new setting
ILDB OLD,OLDPTR ; and what was there before
CAIE NEW,77 ; No change mark?
CAIG NEW,5 ; OK number for the channel?
JRST CHANL3 ; Take the good number
CAIL NEW,^D24 ; These are also OK
CAILE NEW,^D35
JRST CHANL9 ; Bad. Tell user.
CHANL3:
CAIE NEW,77 ; No change?
MOVE OLD,NEW ; No. New will replace old
DPB OLD,NEWPTR ; Construct the replacement set
IBP FRKPTR ; Move to current fork slot
CAIE NEW,77 ; Changing the channel
DPB FORKID,FRKPTR ; Yes. This fork gets the PSIs now.
SOJG CNT,CHANL2 ; Loop over all six bytes
MOVEM NEWCHS,TCBPIC(TCB); Stash into TCB
TDZA T1,T1 ; Tell caller all is well
CHANL9: HRROI T1,ELP+^D17 ; "Bad arg to CHANL"
RESTORE
RET
SUBTTL SCSLV JSYS - Set Connection Security Level
;T1/ Flags,,JCN or pointer to CDB
;T2/ Security Level
; SCSLV
;Ret+1: Error. Code in T1
; from CHKARG
; ELP+^D29 Security already set
;Ret+2: Success.
XNENT (.SCSLV,G)
MCENT
TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
JRST TCPILP ; Illegal control bit
XMOVEI T1,SCSLV1 ; Select routine to call via CHKARG
CALL CHKARG ; Check args, set TCB, call SCSLV1
JUMPL T1,TCPERR ; Give error return if appropriate
SMRETN ; Otherwise, it was good.
;SCSLV1(TCB)
;Second Phase of SCSLV JSYS
;T1/ JCN specified by caller (ignored here)
;TCB/ Locked connection block
; NOINT
; CALL SCSLV1
;Ret+1: Always. T1 has 0 if OK, or -1,,error
; -1,,ELP+^D29 Security already set
SCSLV1: UMOVE T2,T2 ; Get arg from caller
JN TSLVN,(TCB),SCSLVE ; Bad. No changes allowed.
STOR T2,TSLVN,(TCB) ; Set the new value
TDZA T1,T1 ; Get a 0 to indicate OK
SCSLVE: HRROI T1,ELP+^D29 ; "Can't change security levels"
RET
SUBTTL TCP Portion of ATNVT JSYS
;TATNVT
;Part of ATNVT JSYS for TVTs, Returns to USER w/ w/o skip
;TATNVT
;Attach a TVT to a User TCB; Called in non-Job-0 context
;T1/ Flags+JCN
; JRST TATNVT
;Ret+1: Failed, Error code in T1, JCN still valid
; ATNX1 -1,,ELP+^D1 Invalid JCN
; ATNX2 Receive side not SYNCED
; ATNX3 User CLOSEd/ABORTed connection
; ATNX5 Recieve side has been used (RECVs)
; ATNX6 Connection has been closed, or has errors
; ATNX8 Send side not SYNCED
; ATNX11 Send side has been used (SENDs)
; ATNX13 -1,,ELT+^D4 No TVTs or
; -1,,ELT+^D31 TCP not Initialized
;Ret+2: Success, T1 contains TTY designator for TVT
; JCN has been released
TATNVT::XCTU [HRRZ T1,1] ; Get JCN w/o flags
CALL TATTVT ; Call worker routine
JRST TCPERR ; Return error
SMRETN ; OK (skip) return
;TATTVT - Worker routine for TATNVT and TVTJFN
;Takes T1/ JCN
;Returns +1 failure, T1/ TOPS-20 error code
; +2 success, user T1 updated with TTY designator
TATTVT::TXO T1,TCP%JS ; Set JCN Supplied
UMOVEM T1,1 ; Put it back for CHKARG
XMOVEI T1,TATNV1 ; Routine to call
CALL CHKARG ; Check arg, set TCB, call TATNV1
IFL. T1
HRRZS T1 ; Drop -1,, for compares
CAIN T1,<ELP+^D1> ; Translate TCP error code into TOPS20
MOVX T1,ATNX1
CAIE T1,<ELT+^D4>
CAIN T1,<ELT+^D31>
MOVX T1,ATNX13
RET ; Return non-skip
ENDIF.
LOAD T1,TVTL,(TCB) ; Make TTY descriptor
TXO T1,.TTDES
UMOVEM T1,1 ; Return TT Descriptor
RETSKP
;TATNV1(TCB,JCN)
;Second phase of TATNVT
; T1/ JCN supplied by caller
; TCB/ Locked connection block
; NOINT
; CALL TATNV1
;Ret+1: Always. T1 has -1,,error, or TTY descriptor otherwise
TATNV1: LOCAL <JCN>
MOVEM T1,JCN
MOVX T1,<-1,,ATNX2>
LOAD T2,TRSYN,(TCB) ; Receive side SYNCED?
CAIE T2,SYNCED
JRST TATNV9 ; No, error
MOVX T1,<-1,,ATNX8>
LOAD T2,TSSYN,(TCB) ; Send side SYNCED?
CAIE T2,SYNCED
JRST TATNV9 ; No, error
MOVX T1,<-1,,ATNX5>
LOAD BFR,QNEXT,<+TCBRBQ(TCB)>
CAIE BFR,TCBRBQ(TCB) ; Without receive buffers
JRST TATNV9 ; Has buffer, error
MOVX T1,<-1,,ATNX11>
LOAD BFR,QNEXT,<+TCBSBQ(TCB)>
CAIE BFR,TCBSBQ(TCB) ; Without send buffers
JRST TATNV9 ; Has buffer, error
MOVX T1,<-1,,ATNX3>
JE TSUOP,(TCB),TATNV9 ; Not OPENed by user error
MOVX T1,<-1,,ATNX6>
JE TSOPN,(TCB),TATNV9 ; Not still OPEN error
JN TERR,(TCB),TATNV9 ; Had some error error
HRRZ T1,TCB ; ASNTVT wants TCB &
TXO T1,AN%NTP ; Say it will speak new Telnet
CALLX (MSEC1,ASNTVT) ; Assign a virtual terminal
JRST TATNV8 ; Failed (no TVT available, etc)
STOR T1,TVTL,(TCB) ; Save TTY # connection block
; Forget everything about Job which opened connection & give to Job0
MOVE T1,JCN ; Our JCN
CALL RETJCN ; Release PSIs & JCN
SETZRO TOWNR,(TCB) ; Transferred to Job0
SETONE TJCN,(TCB) ; without a JCN (hard to get to Job0 JSB)
SETONE TTVT,(TCB) ; Say its a TVT
; T2 from ASNTVT
CALL ULKTTY ; Block now stable
TDZA T1,T1 ; OK
TATNV8: MOVX T1,<-1,,ATNX13> ; Out of resources error (TVTs)
TATNV9: RESTORE
RET
SUBTTL ACTTCB - Activate a Connection
;ACTTCB tries to move a connection from the completely unsynchronized
;(closed or brand new) state into the SYNABLE state, where it is
;able to send and/or repond to SYNs. Activating a connection is the
;operation performed by user calls like OPEN, SEND and RECV, and make
;the connection be "alive". If the connection is already active, this
;results in a true value. False is return if the connection is
;partially closed -- one side or the other is NOTSYN state.
;T1/ JCN
;T2/ Option addresses word from OPEN, or 0 if otherwise
;TCB/ (Extended) Locked connection block
; NOINT
; CALL ACTTCB
;Ret+1: Always. T1 has 0 if successfully activated, error code otherwise
; **** Preserve T2 until TCPUOP
ACTTCB: LOAD T4,TSSYN,(TCB) ; Get send state
LOAD T3,TRSYN,(TCB) ; Get recv state
CAIE T4,NOTSYN ; Unsynchronized?
JRST ACTTC7 ; No.
CAIE T3,NOTSYN
JRST ACTTC8 ; Return FALSE
; NOTSYN-NOTSYN
STOR T1,TJCN,(TCB) ; Indicate this TCB is owned
MOVE T3,TCB
HRL T3,FORKX ; Form system fork,,TCB
MOVEM T3,JCNTCB(T1) ; Store in job private table
; **** T2 Preserved
SKIPE T1,T2 ; Option address word
CALL TCPUOP ; Get options from user
JUMPL T1,ACTTCX ; Return error code ** RETJCN too
IFE STANSW,<
MOVE T2,JOBNO ; Our job number
>;IFE STANSW,<
IFN STANSW,<
MOVE T2,GBLJNO ; Our global job number
>;IFN STANSW
STOR T2,TOWNR,(TCB) ; Store this as TCB Owner
MOVX T1,SYNABL ; SYN Ok state
STOR T1,TSSYN,(TCB) ; Set send side
STOR T1,TRSYN,(TCB) ; and recv side
; Clear persistent SYN flag, Clear OPEN has been done flag
; Clear "said it's open" bit, Clear ABORT requested flag
; Clear TVT flag
SETZRO <TSPRS,TSUOP,TSOPN,TSABT,TTVT>,(TCB)
SETZRO TVTL,(TCB) ; Clear TVT line number
SETZRO TSCPK,(TCB) ; No partially filled packet
MOVE T1,INTXPB ; Maximum data size for a packet
SUBI T1,MINIHS+MINTHS ; Assuming no options & largest net
STOR T1,TRWND,(TCB) ; is the default initial receive window.
SETZRO TRBS,(TCB) ; No RECV buffer space yet
HRRZ T1,FORKN ; Our Job fork number
STOR T1,TOFRK,(TCB) ; Say who owns the TCB
SETO T1,
STOR T1,TPSIC,(TCB) ; No PSI Channels named yet
STOR T1,TPIFU,(TCB) ; No INTRP fork
STOR T1,TPIFR,(TCB) ; No RECV DONE fork
STOR T1,TPIFS,(TCB) ; No SEND DONE fork
STOR T1,TPIFE,(TCB) ; No ERROR fork
STOR T1,TPIFX,(TCB) ; No STATE CHANGE fork
STOR T1,TPIFA,(TCB) ; No EOL ACK fork
STOR T1,TRLWN,(TCB) ; No last window seq #
IFE STANSW,<
MOVE T1,TCPRX0 ; Good starting point for retrans
STOR T1,TMNRT,(TCB) ; Minimum round trip time
STOR T1,TMXRT,(TCB) ; Maximum round trip time
STOR T1,TRXI,(TCB) ; Current RX interval
>;IFE STANSW
IFN STANSW,<
MOVE T1,TCPRX0 ; Good starting point for retrans
STOR T1,TMNRT,(TCB) ; Minimum round trip time
STOR T1,TMXRT,(TCB) ; Maximum round trip time
STOR T1,TRXI,(TCB) ; Current RX interval
STOR T1,TSMRT,(TCB) ; initial smoothed RTT
>;IFN STANSW
SETZRO <TRXPN,TRXPD,TRXPI>,(TCB) ; Clear RX parameters
MOVX T1,OK ; General success code
STOR T1,TERR,(TCB) ; Indicate no error on this connection
LOAD T1,TERRF,(TCB) ; Index of the error event flag
CALL CLRWTB ; Clear it
JRST ACTTC9 ; Return true to say it is now active
ACTTC7: CAIN T3,NOTSYN ; Check receive side state
ACTTC8: HRROI T1,ELP+^D12 ; "Connection closing" error
; (S=NOTSYN, R.ne.NOTSYN or
; S.ne.NOTSYN, R=NOTSYN)
ACTTC9: SETZ T1, ; Return OK (S.ne.NOTSYN & R.ne.NOTSYN)
ACTTCX: RET ; Return with TCPUOP's error code
SUBTTL CHKARG - Check BBN TCP JSYS Arguments
; call FN(JCN,user option word or 0)
;T1/ (Extended) Function address
;T2/ ARG2 for FUNC (***** obsolete *****)
; CALL CHKARG
;Ret+1: Always. T1 has value of FUNC(JCN,ARG). TCB has been setup.
; Note: TCB is locked & NOINT during call to FUNC
; CHKJCN -1,,ELP+^D1 JCN out of range, or no TCB for JCN
; GETJCN -1,,ELT+^D4 No free JCN, no space for TCB
; -1,,ELT+^D31 TCP not initialized
; CHKADD ...
; function ...
CHKARG: STACKL <<ARGBLK,CHKADW>>
CHKADL (USR) ; LOCAL
XMOVEI PARAMS,ARGBLK ; Set the pointer
MOVEM T1,FN ; Save function address
SETZM ARG1
NOINT
SKIPE TCPON ; TCP turned on?
SKIPN TCPIFG ; TCP Initialized yet?
JRST CHKARI ; No.
UMOVE T1,T1 ; Get user's AC1 flags
TXNE T1,TCP%IX ; Connection # specified?
JRST CHKAR3 ; Yes
TXNN T1,TCP%JS ; JCN Supplied in right half?
JRST CHKAR1 ; No. Go translate into one
; Given JCN
HRRZS T1 ; Save JCN part
MOVE T2,FN ; Function to call if JCN ok
MOVE T3,ARG1 ; Argument to FN
CALL CHKJCN ; Set TCB, Lock it & call FN
EXIT CHKARX ; Return whatever result
; Given Connection block or TVT number
CHKAR1: TXNE T1,TCP%TV ; TVT number specified?
JRST CHKAR2 ; Yes
; Given Connection block
CALL GETJCN ; Reserve a JCN
JUMPL T1,CHKARX ; Couldn't. Tell caller
MOVEM T1,JCN ; Save the JCN
XCTU [HRRZ USR,T1] ; Get ptr to Connection Descriptor Blk
UMOVE T1,.TCPLH(USR)
UMOVE T2,.TCPLP(USR) ; Copy the info from user area
UMOVE T3,.TCPFH(USR)
UMOVE T4,.TCPFP(USR)
UMOVE USR,.TCPOP(USR)
; **** Beginning of Compatability Kludge
PUSH P,BHC+1 ; Assume new format
JUMPE T1,KLUDG0 ; If first word 0, must be new (LP=0 illegal)
TLNE T1,-1 ; If first word is LP, then only rh 16 bits used
JRST KLUDG0 ; New format
MOVE T4,T3 ; Map old format into new
MOVE T3,T2
MOVE T2,T1
SETZB T1,USR ; New info zero if old format
SETZM (P) ; Use old format
KLUDG0:
; **** End of Compatability Kludge
ANDX T1,.RTJST(-1,PISH)
ANDX T2,.RTJST(-1,PSP)
ANDX T3,.RTJST(-1,PIDH)
ANDX T4,.RTJST(-1,PDP)
MOVEM T1,LH
MOVEM T2,LP ; Store into ARGBLK for CHKADD
MOVEM T3,FH
MOVEM T4,FP
MOVEM USR,ARG1 ; Option addresses is second arg for FN
SETZM WILDOK ; Not OK to find listening connections
MOVE T1,PARAMS ; Pointer to parameter block for CHKADD
CALL CHKADD ; Find TCB, Lock it, Call FN
; **** Beginning of Compatability Kludge
POP P,T2 ; Old (0)/New (1) flag
JUMPL T1,CHKA19 ; Jump if all went well
STOR T2,TNUFM,(TCB) ; Save format flag
JRST CHKARX
; **** End of Compatability Kludge
CHKA19: PUSH P,T1 ; Save error result
MOVE T1,JCN ; Get back the JCN
CALL RETJCN ; To return & disown TCB ("DEAD")
POP P,T1 ; Restore error code
EXIT CHKARX
; Given TVT #
CHKAR2: MOVEI T2,(T1) ; TVT line # into 2
CALLX (MSEC1,CHKTVT) ; Check if valid TVT
JRST CHKART ; Lose
CALLX (MSEC1,TVTCHK) ; Get (locked) data base
JRST CHKARU ; Not fully active
LOAD TCB,PTVT,(T2) ; Get TCB address
CALL ULKTTY ; Unlock TTY data base
JUMPE TCB,CHKART ; Illegal connection
SETSEC TCB,INTSEC ; TCBs in this section
MOVX T3,0 ;T1 ; Unused Arg for FN is line type??
XMOVEI T1,TCBLCK(TCB) ; Lock to lock
MOVE T4,ARG1 ; Second arg for FN
MOVE T2,FN ; Function to call
CALL LCKCAL
JRST CHKARX ; Leave
; Find the nth connection specified by T1
CHKAR3: HRRZS T1 ; Just the number
CAILE T1,0 ; Must be greater than 0 and
CAMLE T1,TCBCNT ; Less than current number
JRST CHKART ; Lose, invalid index
MOVEM T1,JCN ; Save index
XMOVEI T1,TCBHLK ; Lock for TCB hash table
CALL SETLCK ; Lock it
PUSH P,TCB ; Save TCB
MOVSI T2,-TCBHSZ ; Size of hash table
CHKA30: HRRZ TCB,T2 ; Current TCBH slot
ADD TCB,TCBH ; Add base of table (including section)
HRRZ T3,TCB ; Save head of list
CHKA31: LOAD TCB,QNEXT,(TCB) ; Get next on list
CAMN TCB,T3 ; Back to head?
JRST [AOBJN T2,CHKA30 ; Yes, jump back if another slot
SETZ TCB, ; No more, TCB not found
JRST CHKA32] ; Quit
SETSEC TCB,INTSEC ; TCBs in this section
SOSE JCN ; Count down index
JRST CHKA31 ; Loop if not want this one
; TCB points to TCB or is 0
CHKA32: AOS TCBHUC ; Bump hash table use count
XMOVEI T1,TCBHLK ; TCBH lock
CALL UNLCK ; Unlock it with non-zero count means reading
HRROI T1,<ELP+^D1> ; Assume error
SKIPN TCB ; Find a TCB?
JRST CHKA33 ; No
XMOVEI T1,TCBLCK(TCB) ; TCB to lock
MOVE T2,FN ; Function to call
MOVX T3,0 ;JCN ; Restore args (JCN=0 here)
MOVE T4,ARG1
CALL LCKCAL ; Call function
CHKA33: SOS TCBHUC ; Done reading TCB
POP P,TCB ; Restore register
JRST CHKARX ; Leave, error code in T1
CHKARU: CALL ULKTTY ; Maybe a non-standard block
CHKART: HRROI T1,ELP+^D1 ; Illegal connection
JRST CHKARX
CHKARI: HRROI T1,ELT+^D31 ; "TCP Not initialized yet"
CHKARX: OKINT
CHKADR
RET
SUBTTL CHKJCN - See if caller has access to JCN
;T1/ JCN in question
;T2/ (Extended) Function to call if OK
;T3/ Argument for function
; Maybe NOINT
; CALL CHKJCN
;Ret+1: Always. T1 has -1,,error or value of FN(JCN,ARG1)
; -1,,ELP+^D1 Invalid JCN, No TCB
CHKJCN: PUSH P,T1 ; Save the JCN
CAIL T1,1 ; Reasonable number?
CAIL T1,MAXJCN
JRST CHKJC9 ; No. Tell Caller
HRRZ TCB,JCNTCB(T1) ; Get the TCB
JUMPE TCB,CHKJC9 ; Non-JCN, give error
SETSEC TCB,INTSEC
CALL BBNCHK ; is this call legal for other reasons
JRST CHKJC9 ; no
LOAD T1,TOWNR,(TCB) ; check the owning job number
IFE STANSW,<
CAME T1,JOBNO ; is it the same as our job
>;IFE STANSW
IFN STANSW,<
CAME T1,GBLJNO
>;IFN STANSW
BUG.(CHK,TCPJS3,TCPTCP,SOFT,<CHKJCN: TCB ownership confused>,,<
Cause: CHKJCN was called for a connection not owned by the calling job.
>)
XMOVEI T1,TCBLCK(TCB) ; Pointer to the connection lock
MOVE T4,T3 ; Put arg in right place
MOVE T3,0(P) ; Get the JCN as first ARG to function
CALL LCKCAL ; Lock the lock and call the function
CAIA ; Use whatever value is returned
CHKJC9: HRROI T1,ELP+^D1 ; "Illegal Connection"
ADJSP P,-1 ; CLEAR STACK
RET
SUBTTL GETJCN - Assign a Job Connection Number
; NOINT
; CALL GETJCN
;Ret+1: Always. T1 has the JCN (.GT.0) or -1,,ELT+^D4
GETJCN::NOSKED ; Prevent others from interfering
MOVSI T2,-MAXJCN+1 ; Max number of JCNs per job (ignore 0)
SKIPE JCNTCB+1(T2) ; Empty slot?
AOBJN T2,.-1 ; No. Check next
HRROI T1,ELT+^D4 ; "No space for another connection"
JUMPGE T2,GETJCX ; Return that if no empty slot found
MOVE T3,FORKX ; Our identity.
HRLZM T3,JCNTCB+1(T2) ; Reserve the slot for later use
MOVEI T1,1(T2) ; The JCN as a result.
GETJCX: OKSKED
RET
SUBTTL RETJCN - Free a Job Connection Number
;T1/ JCN
; NOINT
; CALL RETJCN ; NB T2 preserved
;Ret+1: Always.
RETJCN::SAVEAC <T1,TCB>
NOSKED
CAIN T1,-1 ; Job0 w/o JCN?
JRST RETJCX ; Yes, special User TVT connection
CAIL T1,1
CAIL T1,MAXJCN ; Reasonable number
CAIA
JRST RETJC1
BUG.(INF,TCPJS1,TCPTCP,SOFT,<RETJCN: JCN out of range>,,<
Cause: RETJCN was called for a JCN that is out of range.
>)
JRST RETJCX
RETJC1: SETZ TCB,
EXCH TCB,JCNTCB(T1)
TRNN TCB,-1 ; Just a reserved slot?
JRST RETJCX ; Yes. Get out.
SETSEC TCB,INTSEC ; Make extended address
MOVNI T3,1
STOR T3,TPSIC,(TCB) ; Disable all PSIs
STOR T3,TPIFU,(TCB) ; Remove forks from TCB
STOR T3,TPIFR,(TCB)
STOR T3,TPIFS,(TCB)
STOR T3,TPIFE,(TCB)
STOR T3,TPIFX,(TCB)
STOR T3,TPIFA,(TCB)
STOR T3,TOFRK,(TCB) ; Forget owning fork
SETZRO TJCN,(TCB) ; Disown the TCB ("DEAD")
MOVE T1,TCB ; in case we call TCPBFD
TMNE TDEC,(TCB) ; a DEC TCB?
CALL TCPBFD ; yes so release all DEC buffers
RETJCX: OKSKED
RET
SUBTTL MAKBFR - Make a Buffer Descriptor
;Buffer descriptors ("Buffers") are the items which get queued for
;the Packetizer and Reassembler. There is one for each SEND or RECV
;executed by the user. Amoung other things, a buffer block contains
;an "index" which associates that buffer with a particular DONE bit
;which is stored in resident core; it is this bit that the scheduler
;tests to reactivate a process which is waiting for that particular
;buffer.
;TCB/ (ext) pointer to locked connection block
; CALL MAKBFR
;Ret+1: Always. T1 has the buffer address (.GT.0) or -1,,error
; -1,,ELP+^D15 Count < 0, Adr last word >= 1,,0
; -1,,ELT+^D16 No WAIT bits, No memory for BFR HDR
MAKBFR: STACKL <DATADR>
LOCAL <HDRADR,FLAGS,COUNT,JCNFLG>
PUSH P,BFR
UMOVE JCNFLG,T1 ; Get JCN control flags from user
UMOVE HDRADR,T2 ; Get address of header from user
SUBI HDRADR,BFRSUI ; Make it into standard header ptr.
MOVSI FLAGS,(TCP%DN!TCP%ER) ; Done and Error bits
XCTU [ANDCAB FLAGS,BFRFLG(HDRADR)] ; Clear in user space, get others
TXNE FLAGS,TCP%UR ; Urgent (send) bit on?
TXO FLAGS,TCP%PU ; Yes. That implies a PUSH.
UMOVE T3,BFRDAD(HDRADR); Address of data area
MOVEM T3,DATADR
UMOVE COUNT,BFRCNT(HDRADR); Number of words/bytes in buffer
JUMPL COUNT,MAKBF9 ; Illegal
MOVE T1,DATADR
LSH T1,-PGSFT ; First page of buffer
MOVE T2,DATADR
MOVE T3,COUNT
TLNE JCNFLG,(TCP%WM) ; Count is words?
JRST MAKBF1 ; Yes.
ADDI T3,3 ; Round up to word boundary
ASH T3,-2 ; Number of words in the buffer
MAKBF1:
ADD T2,T3
SUBI T2,1 ; Last word in buffer
LSH T2,-PGSFT ; Last page in buffer
CAIL T2,1000 ; Better fit in memory
JRST MAKBF9 ; Give error
TLNN JCNFLG,(TCP%WT) ; Will this fork wait for this buffer?
TDZA T1,T1 ; No. No wait bit index assigned
CALL ASNWTB ; Assign an index
JUMPL T1,MAKBFX ; None available right now ??? error code?
PUSH P,T1 ; Save for a while
SKIPE T1 ; No bit to clear
CALL CLRWTB ; Clr it to make us hang at SENDW (e.g.)
MOVEI T1,BFRSIZ ; Size of a buffer descriptor
CALL GETBLK ; Get a block of free storage
SKIPG BFR,T1 ; Got it? ??? error code?
JRST MAKBF8 ; No. Release index and return ELT+^D16
JN TDEC,(TCB),MAKBF6 ; do not do this for a DEC TCB
NOSKED ; Make sure we are the only one
MOVE T1,FORKX ; get my fork index
LOAD T1,FKUP%,(T1) ; get UPT SPT slot
LOAD T2,SPTSHC,(T1) ; get the share count on the spt slot
CAIL T2,MAXSHC-10 ; is it close to overflow?
JRST MAKBF7 ; yes so we can not continue
CALL UPSHR ; Increment the share count
OKSKED ; give back the system
MAKBF6:
SETZM BFRQ(BFR) ; Indicate buffer is not on a queue
POP P,T1 ; Get back the index
STOR T1,BIDX,(BFR) ; Put in wait bit index
STOR TCB,BTCB,(BFR) ; Remember which TCB owns the buffer
MOVEM FLAGS,BFRFLG(BFR) ; Store in monitor copy
SETZRO BPTR,(BFR) ; Clear Index and Indirect fields
MOVX T1,^D8 ; Assume byte-send
TLNE FLAGS,(TCP%WM) ; Word mode?
MOVX T1,^D36 ; Yes. Byte size is 36
STOR T1,BPTRS,(BFR) ; Set into size field of byte pointer
MOVE T1,TODCLK ; Now in milliseconds
STOR T1,BTS,(BFR) ; Set into buffer timestamp
STOR COUNT,BICNT,(BFR) ; Remember the initial count
STOR HDRADR,BHADR,(BFR) ; and header address in user space
MOVE T3,DATADR ; Get the user's data address
STOR T3,BDADR,(BFR) ; Remember it
UMOVE T1,BFROPT(HDRADR) ; Get option addresses word
; Beginning of Compatability Kludge
OPSTR SKIPN,TNUFM,(TCB) ; Using new formats?
SETZ T1, ; No, garbage
; End of Compatability Kludge
MOVEM T1,BFROPT(BFR) ; Save them
MOVX T1,-1 ; "Not mapped" indication
STOR T1,BMPAG,(BFR) ; In the monitor window page number
CALL RSTBFR ; Reset the buffer state
MOVE T1,FORKX ; Our own System Fork Number
STOR T1,BFRKX,(BFR) ; Remember for mapping user space
MOVE T1,BFR ; This is the value
JRST MAKBFX
MAKBF7: ; here when UPT Share count will overflow
OKSKED ; give back the machine
MOVE T1,BFR ; get the free space address
CALL RETBLK ; return the block and fall through
; here when no free space for buffer
MAKBF8: POP P,T1 ; Get back index
TLNE JCNFLG,(TCP%WT) ; Did we assign one?
CALL RELWTB ; Release it
SKIPA T1,[-1,,ELT+^D16] ; "No space right now"
MAKBF9: HRROI T1,ELP+^D15 ; "Bad buffer arg(s)"
MAKBFX: POP P,BFR
RESTORE
RET
SUBTTL FREBFR - Release Resources Used By a Buffer
;Called by a process doing a SEND, RECV which waits for completion.
;In this case USRBFE (or USRBFF) places the complete buffer on the
;TCPBDQ so it may be release by this routine in the above JSYSs or by
;ABORT.
;BFR/ (Extended) Buffer
; CALL FREBFR
;Ret+1: Always
FREBFR: NOSKED
LOAD T1,BIDX,(BFR) ; Get the wait bit index
SETZRO BIDX,(BFR) ; Indicate it has been released
SKIPE T1 ; Have a bit to release?
CALL RELWTB ; Actually release it
MOVE T1,BFR ; Item to dequeue
SKIPE (T1) ; If not queued, skip it
CALL DQ ; Remove it from the done queue
OKSKED
CALL RETBLK ; Release the storage
RET
;BBNCHK
;Check to see if a BBN TCP JSYS is legal. Always legal for the
;monitor. If from user mode not legal for a DEC TCB. If BBNOK is off
;then never legal from user mode. Skip return if legal.
BBNCHK:
XSFM T1 ; Get PC Flags
TXNN T1,PCU ; Previous Context User on?
RETSKP ; No, call is always legal for the monitor
TMNN TDEC,(TCB) ; is this a DEC TCB?
SKIPN BBNOK ; not DEC TCB. Are BBN Calls OK?
RET ; not OK aor this is a DEC TCB
RETSKP ; skip return
BBNCKK: ; Same as above but does not check the TCB
XSFM T1 ; Get PC Flags
SKIPN BBNOK ; BBN Calls OK?
TXNN T1,PCU ; No. Previous Context User on?
RETSKP ; PCU off or BBNOK on.
RET ; PCU on and BBNOK off.
SUBTTL End of TCPBBN
TNXEND
END