Google
 

Trailing-Edge - PDP-10 Archives - BB-M080O-SM - monitor-sources/scjsys.mac
There are 17 other files named scjsys.mac in the archive. Click here to see a list.
; *** Edit 7297 to SCJSYS.MAC by JROSSELL on 22-May-86 (TCO 6.1.1595)
; If the .MORHN function fails due to no node name found, return the node
; address. 
; *** Edit 7252 to SCJSYS.MAC by PALMIERI on 5-Mar-86, for SPR #21067 (TCO 6.1.1579)
; Only release SABs belonging to JFNs being closed at RELACT 
;------------------------- Autopatch Tape # 13 -------------------------
; *** Edit 7244 to SCJSYS.MAC by PALMIERI on 17-Feb-86 (TCO 6.1.1575)
; Preserve error code in T1 after call to SCLFNU in DNETIN 
; *** Edit 7242 to SCJSYS.MAC by PALMIERI on 17-Feb-86 (TCO 6.1.1574)
; Don't attempt to read input if JFN is opened output only. 
;------------------------- Autopatch Tape # 12 -------------------------
; *** Edit 7197 to SCJSYS.MAC by PALMIERI on 19-Nov-85 (TCO 6.1.1558)
; Check to see if SAB has been released before attempting release as a result
; of CHKJFN failure during call to SCLFNC. 
; UPD ID= 2321, SNARK:<6.1.MONITOR>SCJSYS.MAC.80,  19-Aug-85 14:35:39 by PALMIERI
;TCO 6.1.1527  Byte count for generated unique name was one too great because
;of CMPLENs strangness.
;TCO 6.1.1528  Also sense of "restricted to whopper" object type checking was
;inverted in SRVNAM
; UPD ID= 2266, SNARK:<6.1.MONITOR>SCJSYS.MAC.79,  21-Jun-85 15:08:15 by PALMIERI
;TCO 6.1.1469	Wait for DC when closing write only links.
;If can't validate JFN when returning after output to SCLINK then release
;current SAB and don't update I/O window page.
;Fix all callers of SCLFNU to notice error code in T1 if appropriate
;Limit to 12 the number of bytes written into the end user
;descriptor field in a format 2 SPN.  Add some missing comments.
; UPD ID= 2216, SNARK:<6.1.MONITOR>SCJSYS.MAC.78,  12-Jun-85 09:59:32 by PALMIERI
;TCO 6.1.1439  Correct error codes in D36ERR and return from DCNGOK
; UPD ID= 2205, SNARK:<6.1.MONITOR>SCJSYS.MAC.77,   5-Jun-85 21:16:41 by PALMIERI
;Fix problem at BLDSR2+1 so proxy access works  -  JUMPE ==> JUMPG
; UPD ID= 2181, SNARK:<6.1.MONITOR>SCJSYS.MAC.76,   5-Jun-85 11:01:59 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 2033, SNARK:<6.1.MONITOR>SCJSYS.MAC.75,  29-May-85 15:13:54 by PALMIERI
;TCO 6.1.1416  Add routine to wait for connect confirm before doing output
; when user doesn't.  Have IMPWAT revaildate JFN before returning to caller
; UPD ID= 1984, SNARK:<6.1.MONITOR>SCJSYS.MAC.74,  16-May-85 22:37:01 by GLINDELL
;More 6.1.1382 - fix oversight - T1 wasn't setup when calling DCNCEX in DCNOPN
; UPD ID= 1970, SNARK:<6.1.MONITOR>SCJSYS.MAC.73,  13-May-85 17:11:13 by GLINDELL
;TCO 6.1.1381 - fix SWJFN% for DECnet JFN's - add SCSWJF.
; UPD ID= 1968, SNARK:<6.1.MONITOR>SCJSYS.MAC.72,  13-May-85 16:17:21 by PALMIERI
;TCO 6.1.1382 - Redo most of the SRV GTJFN/OPENF parsing
;Allow object type TASK (0) if not privileged on SRV open
;Build only format 0 or 1 SPN if SRV link
; UPD ID= 1823, SNARK:<6.1.MONITOR>SCJSYS.MAC.71,  25-Apr-85 15:42:47 by PALMIERI
;TCO 6.1.1326 Connect reject gives interrupt on wrong channel.  Data => Connect
; UPD ID= 1737, SNARK:<6.1.MONITOR>SCJSYS.MAC.70,   9-Apr-85 11:18:10 by PALMIERI
;TCO 6.1.1314  Port indirect table was not being released in RELSJB because
; SKIPN should be a SKIPE
; UPD ID= 1732, SNARK:<6.1.MONITOR>SCJSYS.MAC.69,   8-Apr-85 15:42:03 by PALMIERI
;TCO 6.1.1312  Create an "active" SAB slot in the SAB indirect table for each
;PSI level and keep active SABs in their respective slots.  Also do not put
;a SAB back into the indirect table if PSBSAB is zero.
; UPD ID= 1633, SNARK:<6.1.MONITOR>SCJSYS.MAC.68,  13-Mar-85 18:02:26 by PALMIERI
;TCO 6.1.1255	Add code to allow program to do implied connect accept on
; SOUT/SOUTR following OPENF.
;TCO 6.1.1236 	Add indirect table for port blocks and return MONX07 if
;port number exceeds size of port table.
; UPD ID= 1524, SNARK:<6.1.MONITOR>SCJSYS.MAC.67,  13-Feb-85 17:36:54 by PALMIERI
;Move DNDEFS (Logical link defaults) to D36COM
;Have DCNOPN/DCNGOK supply a nodename when calling the ACJ
; UPD ID= 1427, SNARK:<6.1.MONITOR>SCJSYS.MAC.66,  29-Jan-85 18:16:37 by PALMIERI
;Guard against no SAB indirect table in NETOUP
;Save reason code around call to OUTRR in CLZRUN:
; UPD ID= 1324, SNARK:<6.1.MONITOR>SCJSYS.MAC.65,  13-Jan-85 08:40:35 by PALMIERI
;CLRPRT called RELSBX with SAB in T1 instead of AC(SAB) where it should be
; UPD ID= 1294, SNARK:<6.1.MONITOR>SCJSYS.MAC.64,   9-Jan-85 13:45:38 by PALMIERI
;Clear pointer to active SAB at CLRPRT after it is released
; UPD ID= 1271, SNARK:<6.1.MONITOR>SCJSYS.MAC.62,   4-Jan-85 15:07:52 by PALMIERI
;Move I/O window direction initialization code to routines so they can be 
;called by SCLFNU as well as NETINP and NETOUP.  Save AC STS at SCLFNU so it
;is not clobbered by CHKJFN.  This is necessary when more than one logical
;link exists for a JFN.  Release active SAB at CLRPRT.  Release active SAB when
;CALSCL returns an error.
; UPD ID= 1215, SNARK:<6.1.MONITOR>SCJSYS.MAC.61,  17-Dec-84 21:20:12 by PALMIERI
;JN at NETCLS should have been a JE - Shows how good coding by committee is
; UPD ID= 1214, SNARK:<6.1.MONITOR>SCJSYS.MAC.60,  17-Dec-84 18:20:19 by PALMIERI
;Set flag in SAAA1 only if send normal data for now.  Think about this more!!
; UPD ID= 1212, SNARK:<6.1.MONITOR>SCJSYS.MAC.59,  17-Dec-84 16:20:55 by PALMIERI
;Keep a flag (SAAA1) for NETOUP to indicate no bytes to send
;Move CALSCL up one intruction to clear block flag
;Set share count in NETCLZ so JFN is not blown away if close blocks
; UPD ID= 1201, SNARK:<6.1.MONITOR>SCJSYS.MAC.58,  12-Dec-84 18:01:31 by PALMIERI
;Don't destroy T1 at SCJRET
; UPD ID= 1190, SNARK:<6.1.MONITOR>SCJSYS.MAC.57,  11-Dec-84 21:47:19 by PALMIERI
;Set "closed by user" code at CLZRUN+1 instead of whatever random code was used
; UPD ID= 1175, SNARK:<6.1.MONITOR>SCJSYS.MAC.56,  10-Dec-84 18:42:14 by GLINDELL
;D36COM now runs in XCDSEC
; UPD ID= 1169, SNARK:<6.1.MONITOR>SCJSYS.MAC.55,   7-Dec-84 18:36:09 by PALMIERI
;Check for a SAB in the indirect block before moving one back from the active
;slot
;Release connect blocks and string pointers at SCJRET
; UPD ID= 1164, SNARK:<6.1.MONITOR>SCJSYS.MAC.54,   7-Dec-84 08:04:25 by PALMIERI
;PSI level calculation wrong at SCJLD1
; UPD ID= 1163, SNARK:<6.1.MONITOR>SCJSYS.MAC.53,   5-Dec-84 18:05:41 by PALMIERI
;Check for and handle SABs with non-empty buffers if JSYS was aborted.
;Clean up SCJLOD. Make SAB indirect table be indexed by priority level
;Move the block and wake bits from FKSWP(FX) to the PT block, so that blocking
;I/O will succeed even if the JFN has been passed to fork other than the one
;which originally opened the link. /wgn
; UPD ID= 1131, SNARK:<6.1.MONITOR>SCJSYS.MAC.52,  26-Nov-84 15:38:36 by PALMIERI
;CALL at NTMTCZ+23 should be a CALLRET
; UPD ID= 1122, SNARK:<6.1.MONITOR>SCJSYS.MAC.51,  21-Nov-84 14:02:06 by PALMIERI
;Set up channel no before calling CLZRUN (CLZMTO) from NTMTCZ
; UPD ID= 859, SNARK:<6.1.MONITOR>SCJSYS.MAC.50,  10-Oct-84 09:41:16 by PALMIERI
;Change range check at NTNTOP since there is a new function
; UPD ID= 839, SLICE:<6.1.MONITOR>SCJSYS.MAC.46,  28-Sep-84 10:02:04 by PALMIERI
;PBFRM should be PBFOR at NOOOBJ
; UPD ID= 828, SLICE:<6.1.MONITOR>SCJSYS.MAC.45,  26-Sep-84 13:25:22 by PALMIERI
;Fix bug at NOOOBJ+1 - Format type stored in wrong place
; UPD ID= 817, SLICE:<6.1.MONITOR>SCJSYS.MAC.44,  24-Sep-84 13:07:18 by PALMIERI
;More MTOPR code for proxy access
; UPD ID= 812, SLICE:<6.1.MONITOR>SCJSYS.MAC.43,  20-Sep-84 15:21:35 by GLINDELL
;Define IBBLK EXTERNal
; UPD ID= 799, SLICE:<6.1.MONITOR>SCJSYS.MAC.42,  17-Sep-84 16:25:55 by GLINDELL
;Get local node number from IBADR instead of from RTRADR
; UPD ID= 798, SLICE:<6.1.MONITOR>SCJSYS.MAC.41,  14-Sep-84 18:48:59 by PALMIERI
;Add most of code for proxy access (MTOPR not done yet)
; UPD ID= 766, SNARK:<6.1.MONITOR>SCJSYS.MAC.40,  30-Aug-84 13:38:34 by NICHOLS
;Change SCJBLK scheduler test to return by way of 0/1(T4), not RET/RETSKP,
; since the RET/RETSKP convention may disappear.
; UPD ID= 726, SNARK:<6.1.MONITOR>SCJSYS.MAC.39,   3-Aug-84 17:56:22 by NICHOLS
;Clear PTNRR after each read when mopping up all outstanding input before a
;close.  This prevents an infinite loop if we try to mop up a null record.
;Add routine DNETCL to do this.  Change OPSTR <SKIPx> to TMNx throughout.
; UPD ID= 648, SNARK:<6.1.MONITOR>SCJSYS.MAC.38, 2-Jul-84 14:42:09 by MCINTEE
;Fix bug in close code - disconnect sent state - read any data.
; UPD ID= 622, SNARK:<6.1.MONITOR>SCJSYS.MAC.37, 13-Jun-84 09:38:38 by
;GLINDELL TCO 6.1.1007 - Add X25 object names
; UPD ID= 579, SNARK:<6.1.MONITOR>SCJSYS.MAC.36, 30-May-84 09:11:21 by MCINTEE
;Bug in NTSQI1 - when we blocked and someone blew away the JFN behind our back
; UPD ID= 457, SNARK:<6.1.MONITOR>SCJSYS.MAC.35, 26-Apr-84 21:18:05 by
;GLINDELL Save node name in call to SCTN2A, since we need it to check for
;loopback node
; UPD ID= 453, SNARK:<6.1.MONITOR>SCJSYS.MAC.34, 25-Apr-84 10:59:39 by MCINTEE
;One more time on PTPSI.
; UPD ID= 451, SNARK:<6.1.MONITOR>SCJSYS.MAC.33, 25-Apr-84 09:30:08 by
;GLINDELL Connect block now contains CBNUM (node address) and CBCIR (loopback
;circuit)
; UPD ID= 429, SNARK:<6.1.MONITOR>SCJSYS.MAC.32, 5-Apr-84 13:05:07 by NICHOLS
;Undo effect of edit 402 by clearing PTPSI in DNET again.
; UPD ID= 406, SNARK:<6.1.MONITOR>SCJSYS.MAC.31, 26-Mar-84 10:58:19 by MCINTEE
;Fix MTOPR get status routine for DI receieved with data available
; UPD ID= 403, SNARK:<6.1.MONITOR>SCJSYS.MAC.30, 21-Mar-84 14:28:31 by MCINTEE
;Move the clearing of PTPSI later in NTSQI1 so that interrupts won't be lost
; UPD ID= 402, SNARK:<6.1.MONITOR>SCJSYS.MAC.29, 21-Mar-84 13:47:29 by MCINTEE
;Move the clearing of PTPSI from DNETIN to NTSQI1
; UPD ID= 388, SNARK:<6.1.MONITOR>SCJSYS.MAC.28, 15-Mar-84 12:53:01 by MCINTEE
;Bug in previous - MTOPR% close/reject broken
; UPD ID= 380, SNARK:<6.1.MONITOR>SCJSYS.MAC.27, 12-Mar-84 08:11:09 by MCINTEE
;Force out bytes in close, check for DI in input - set EOF.
; UPD ID= 285, SNARK:<6.1.MONITOR>SCJSYS.MAC.26, 5-Jan-84 14:49:42 by MCINTEE
;Bug in CLOSF logic connect received case - don't open another link.
; UPD ID= 281, SNARK:<6.1.MONITOR>SCJSYS.MAC.25, 21-Dec-83 15:50:10 by MCINTEE
;Off by one bug in reject
; UPD ID= 269, SNARK:<6.1.MONITOR>SCJSYS.MAC.24, 7-Dec-83 09:03:08 by MCINTEE
;Deallocate the window pages on open failures & clean up D36ERR.
; UPD ID= 264, SNARK:<6.1.MONITOR>SCJSYS.MAC.23, 30-Nov-83 16:04:05 by MCINTEE
;Allocate the correct amount of space for the port table.
; UPD ID= 263, SNARK:<6.1.MONITOR>SCJSYS.MAC.22, 29-Nov-83 13:39:32 by
;GLINDELL TCO 6.1.1004 - Add MTOPR to set/read link parameters and quotas
; UPD ID= 261, SNARK:<6.1.MONITOR>SCJSYS.MAC.21, 28-Nov-83 15:01:06 by MCINTEE
;Still more disconnect reason code fixes
; UPD ID= 260, SNARK:<6.1.MONITOR>SCJSYS.MAC.20, 28-Nov-83 14:43:13 by MCINTEE
;More disconnect reason code fixes
; UPD ID= 251, SNARK:<6.1.MONITOR>SCJSYS.MAC.19, 16-Nov-83 16:48:14 by MCINTEE
;Change a disconnect reason code in one case.
; UPD ID= 242, SNARK:<6.1.MONITOR>SCJSYS.MAC.18, 8-Nov-83 09:03:04 by MCINTEE
;Remove NSP% jsys - Definition of SABTSZ moved back to here
; UPD ID= 196, SNARK:<6.1.MONITOR>SCJSYS.MAC.17, 22-Aug-83 10:00:38 by MCINTEE
;UPDATE COMMENTS
; UPD ID= 164, SNARK:<6.1.MONITOR>SCJSYS.MAC.16, 19-Jul-83 08:33:00 by MCINTEE
;TCO 6.1689 - change all references to fork tables to use LOAD & STOR.
; UPD ID= 119, SNARK:<6.1.MONITOR>SCJSYS.MAC.15, 29-Apr-83 12:48:43 by MCINTEE
;Clean up & add table of contents
; UPD ID= 111, SNARK:<6.1.MONITOR>SCJSYS.MAC.14, 22-Apr-83 11:19:39 by MCINTEE
;rework SCJLOD, remove locking down of IO window pages
; UPD ID= 86, SNARK:<6.1.MONITOR>SCJSYS.MAC.13, 23-Mar-83 14:47:25 by MCINTEE
;MAKE DISCONNECT CODES BETTER
; UPD ID= 68, SNARK:<6.1.MONITOR>SCJSYS.MAC.12, 1-Mar-83 14:05:51 by MCINTEE
;MORE OF PREVIOUS
; UPD ID= 67, SNARK:<6.1.MONITOR>SCJSYS.MAC.11, 1-Mar-83 09:09:23 by MCINTEE
;MORE 36 BIT MODE
; UPD ID= 61, SNARK:<6.1.MONITOR>SCJSYS.MAC.10, 28-Feb-83 14:27:58 by MCINTEE
;36 BIT MODE FIX
; UPD ID= 56, SNARK:<6.1.MONITOR>SCJSYS.MAC.9, 23-Feb-83 10:29:17 by MCINTEE
;MORE OF PREVIOUS EDIT
; UPD ID= 41, SNARK:<6.1.MONITOR>SCJSYS.MAC.8, 16-Feb-83 09:51:26 by MCINTEE
;DISALLOW OBJECT TYPE 23 (DECIMAL) NRT IS IN TTYSRV.
; UPD ID= 40, SNARK:<6.1.MONITOR>SCJSYS.MAC.7, 16-Feb-83 09:35:24 by MCINTEE
;ERROR CONVERSION TABLE
; UPD ID= 38, SNARK:<6.1.MONITOR>SCJSYS.MAC.6, 15-Feb-83 15:15:42 by MCINTEE
;SCJLOD CHANGE
; UPD ID= 29, SNARK:<6.1.MONITOR>SCJSYS.MAC.5, 14-Feb-83 11:03:40 by MCINTEE
;SIXBIT node names
; UPD ID= 13, SNARK:<6.1.MONITOR>SCJSYS.MAC.3, 4-Feb-83 13:17:39 by CHALL MOVE
;MAXPRT TO SCPAR (WITH BEGSTR PT) TO MAKE IT ACCESSIBLE
; UPD ID= 10, SNARK:<6.1.MONITOR>SCJSYS.MAC.2, 3-Feb-83 13:03:58 by MCINTEE
;LOCAL NODE NAME BUG IN DCNOPN THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND
;MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

;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 PROLOG,D36PAR,SCPAR
	TTITLE (SCJSYS,,< - Interface to DECnet-36 Session Control     >)
	SUBTTL	Table of Contents


;		Table of Contents for SCJSYS
;
;
;			   Section			      Page
;   1. GLOBALS. . . . . . . . . . . . . . . . . . . . . . . .    3
;   2. CONSTANTS. . . . . . . . . . . . . . . . . . . . . . .    4
;   3. LOCAL STORAGE. . . . . . . . . . . . . . . . . . . . .    5
;   4. LOCAL STRUCTURES . . . . . . . . . . . . . . . . . . .    6
;   5. LOCAL MACROS . . . . . . . . . . . . . . . . . . . . .    7
;   6. REGISTER DEFINITIONS . . . . . . . . . . . . . . . . .    8
;   7. INITIALIZATION CODE  . . . . . . . . . . . . . . . . .    9
;   8. DEVICE DISPATCH VECTORS FOR SRV: DEVICE. . . . . . . .   10
;   9. DEVICE DISPATCH VECTORS FOR DCN: DEVICE. . . . . . . .   11
;  10. RELEASE JFN. . . . . . . . . . . . . . . . . . . . . .   12
;  11. EXTERNAL ENTRIES
;       11.1.   RELEASE FORK STORAGE. . . . . . . . . . . . .   13
;            11.1.1.     ACTIVE SABS. . . . . . . . . . . . .   14
;       11.2.   RELEASE JOB STORAGE . . . . . . . . . . . . .   15
;       11.3.   SWJFN% HOOK . . . . . . . . . . . . . . . . .   16
;  12. SJB & PORT ROUTINES
;       12.1.   GET SJB AND PORT TABLE  . . . . . . . . . . .   17
;       12.2.   RELEASE SJB AND PORT TABLE. . . . . . . . . .   18
;       12.3.   INITIALIZE A PORT ENTRY . . . . . . . . . . .   19
;       12.4.   CLOSE A PORT. . . . . . . . . . . . . . . . .   20
;  13. GTJFN LOOKUP ROUTINES. . . . . . . . . . . . . . . . .   21
;  14. PARSING ENTRY POINTS
;       14.1.   DCN: GTJFN. . . . . . . . . . . . . . . . . .   22
;       14.2.   SRV: GTJFN. . . . . . . . . . . . . . . . . .   23
;       14.3.   SRV: OPENF. . . . . . . . . . . . . . . . . .   24
;       14.4.   DCN: OPENF. . . . . . . . . . . . . . . . . .   25
;  15. COMMON ROUTINES FOR GTJFN & OPENF
;       15.1.   TRVARS
;            15.1.1.     BYTES IN A STRING. . . . . . . . . .   26
;            15.1.2.     SCAN FOR "-" . . . . . . . . . . . .   27
;            15.1.3.     PARSE SRV: NAME  . . . . . . . . . .   28
;            15.1.4.     PARSE SRV: EXTENSION . . . . . . . .   29
;            15.1.5.     PARSE DCN: NAME. . . . . . . . . . .   30
;            15.1.6.     PARSE DCN: EXTENSION . . . . . . . .   31
;            15.1.7.     INSERT OBJECT TYPE AND NAME. . . . .   32
;            15.1.8.     BUILD SPN. . . . . . . . . . . . . .   33
;            15.1.9.     MOVE STRING. . . . . . . . . . . . .   34
;            15.1.10.    GENERATE UNIQUE TASK NAME. . . . . .   35
;            15.1.11.    INITIALIZE TRVARS. . . . . . . . . .   36
;       15.2.   NO TRVARS
;            15.2.1.     SET UP CONNECT BLOCK DURING OPENF. .   37
;            15.2.2.     FINISH OPENF . . . . . . . . . . . .   38
;            15.2.3.     COMPUTE LENGTH OF STRING . . . . . .   39
;            15.2.4.     OBJECT TABLE INITIALIZATION. . . . .   40
;            15.2.5.     OBJECT LOOKUP. . . . . . . . . . . .   41
;  16. ATTRIBUTE ROUTINES
;       16.1.   VERIFY ATTRIBUTE. . . . . . . . . . . . . . .   42
;       16.2.   FIND AND PARSE ARBITRARY ATTRIBUTES . . . . .   43
;       16.3.   FIND AN ARBITRARY ATTRIBUTE . . . . . . . . .   44
;       16.4.   INSERT ATTRIBUTES INTO CONNECT BLOCK. . . . .   45
;       16.5.   MOVE ATTRIBUTE STRING TO CONNECT BLOCK. . . .   46
;       16.6.   PUT A BINARY ATTRIBUTE IN THE CONNECT BLOCK .   47
;  17. WINDOW ROUTINES
;       17.1.   DEALLOCATE WINDOW PAGES . . . . . . . . . . .   48
;       17.2.   ALLOCATE WINDOW PAGES . . . . . . . . . . . .   49
;       17.3.   MAKE BYTE POINTER AND COUNT . . . . . . . . .   50
;  18. CLOSF
;       18.1.   DISPATCH ON STATE OF THE LINK . . . . . . . .   51
;       18.2.   CONNECT RECEIVED STATE. . . . . . . . . . . .   52
;       18.3.   DISCONNECT SENT STATE . . . . . . . . . . . .   53
;       18.4.   RUN STATE . . . . . . . . . . . . . . . . . .   54
;       18.5.   THE REST  . . . . . . . . . . . . . . . . . .   55
;  19. WAKE UP PROCESSOR. . . . . . . . . . . . . . . . . . .   56
;       19.1.   DATA/DISCONNECT CHANNEL INTERRUPT . . . . . .   57
;       19.2.   CONNECT CHANNEL INTERRUPT . . . . . . . . . .   58
;       19.3.   JUST NOW IN RUN STATE . . . . . . . . . . . .   59
;       19.4.   EXIT ROUTINE. . . . . . . . . . . . . . . . .   60
;  20. BLOCK PROCESSOR. . . . . . . . . . . . . . . . . . . .   61
;  21. INPUT & OUTPUT
;       21.1.   ERROR EXIT  . . . . . . . . . . . . . . . . .   62
;       21.2.   SEQUENTIAL INPUT  . . . . . . . . . . . . . .   63
;       21.3.   SEQUENTIAL INPUT
;            21.3.1.     CONNECT WAIT STATE . . . . . . . . .   64
;       21.4.   CONNECT WAIT STATE. . . . . . . . . . . . . .   65
;       21.5.   CONNECT RECEIVED STATE. . . . . . . . . . . .   66
;       21.6.   WAIT FOR CONNECT. . . . . . . . . . . . . . .   67
;       21.7.   SEQUENTIAL INPUT
;            21.7.1.     DISCONNECT RECEIVED STATE. . . . . .   68
;            21.7.2.     RUN STATE AND THE REST . . . . . . .   69
;       21.8.   DNETCL - CLEAN OUT ALL REMAINING DECNET INPUT   70
;       21.9.   DNETIN - GET BYTES FROM NETWORK . . . . . . .   71
;       21.10.  FORCE RECORD OUT. . . . . . . . . . . . . . .   72
;       21.11.  SEQUENTIAL OUTPUT . . . . . . . . . . . . . .   72
;       21.12.  SEND BYTES TO NETWORK . . . . . . . . . . . .   73
;       21.13.  INITIALIZE FOR INPUT. . . . . . . . . . . . .   74
;       21.14.  INITIALIZE FOR OUTPUT . . . . . . . . . . . .   75
;  22. GET PORT STATUS. . . . . . . . . . . . . . . . . . . .   76
;  23. MTOPR FUNCTIONS
;       23.1.   ENTRY . . . . . . . . . . . . . . . . . . . .   77
;       23.2.   ASSIGN PSI CHANNELS . . . . . . . . . . . . .   78
;       23.3.   SET INTERRUPT CHANNEL IN PORT TABLE . . . . .   79
;       23.4.   RETURN STATUS OF A LOGICAL LINK . . . . . . .   81
;       23.5.   READ CONNECT INITIATE INFORMATION . . . . . .   83
;       23.6.   READ AN INTERRUPT MESSAGE . . . . . . . . . .   86
;       23.7.   SEND AN INTERRUPT MESSAGE . . . . . . . . . .   87
;       23.8.   CLOSE/REJECT A CONNECTION . . . . . . . . . .   88
;            23.8.1.     REJECT . . . . . . . . . . . . . . .   89
;       23.9.   ACCEPT AN INCOMING CONNECITON . . . . . . . .   90
;       23.10.  GET SEGMENT SIZE FOR LINK . . . . . . . . . .   91
;       23.11.  SET NETWORK HOST. . . . . . . . . . . . . . .   92
;       23.12.  SET LINK PARAMETERS . . . . . . . . . . . . .   93
;       23.13.  READ LINK PARAMETERS. . . . . . . . . . . . .   94
;       23.14.  SET LINK QUOTAS . . . . . . . . . . . . . . .   95
;       23.15.  READ LINK QUOTAS. . . . . . . . . . . . . . .   96
;       23.16.  OBSOLETE. . . . . . . . . . . . . . . . . . .   97
;  24. MTOPR UTILITY ROUTINES
;       24.1.   COPY AN ASCII STRING TO THE USER. . . . . . .   98
;       24.2.   GET STRING BLOCK STORAGE. . . . . . . . . . .   99
;       24.3.   GET OPTIONAL DATA . . . . . . . . . . . . . .  100
;  25. PRESERVE & SET UP SPECIAL ACS. . . . . . . . . . . . .  101
;  26. ROUTINE THAT CALLS SESSION CONTROL . . . . . . . . . .  103
	  SUBTTL GLOBALS

;	EXTERN SCTAND,SCTNSF,SCTN2L
;	INTERN SRVDTB,DCNDTB
;	ENTRY DOSJB,OBJINI,RELSAB,SCLGOU
	EXTERN IBBLK,DNDEFS,LASTSK
	SUBTTL CONSTANTS

TSKMAX==^D16			;MAX CHARS. IN A TASK NAME
MAXUAP==^D39			;MAX CHARS. IN USER ID, OR ACCOUNT, OR PASSWORD
MAXOPT==^D16			;MAX CHARS. IN OPTIONAL DATA
OPTSIZ==5			;# OF WORDS FOR OPTDATA BLOCK
MAXHST==6			;MAX CHARS. IN A NODE NAME
MAXBYT==4000			;MAXIMUM NUMBER OF BYTES IN A WINDOW PAGE

;ENTRY TYPES FOR SUBROUTINES

;TYPE OF LINK
.PASS==:0			;PASSIVE
.ACT==:1			;ACTIVE

;TYPE OF DATA
.USRID==:0			;USER ID
.PASSW==:1			;PASSWORD
.ACCNT==:2			;ACCOUNT
.OPTDT==:3			;OPTIONAL DATA
.HSTNM==:4			;HOST NAME
.TASKN==:5			;TASK NAME
.OBTYP==:6			;OBJECT TYPE
.FMTYP==:7			;FORMAT TYPE

;TYPE OF PSI
.CONN==:0			;CONNECT
.INT==:1			;INTERRUPT
.DATA==:2			;DATA
	SUBTTL LOCAL STORAGE

;THE SJB LOCK (SO THAT ONLY ONE IS ALLOCATED PER JOB)
NR (SJBLOK,1)			

;THE ATTRIBUTE TABLE
ATTRTB:	ATTENT (.PFUDT,0,MAXUAP,0)
	ATTENT (.PFPWD,0,MAXUAP,.PFBPW)
	ATTENT (.PFBPW,1,MAXUAP,.PFPWD)
	ATTENT (.PFACN,0,MAXUAP,0)
	ATTENT (.PFOPT,0,MAXOPT,.PFBOP)
	ATTENT (.PFBOP,1,MAXOPT,.PFOPT)
MAXNTA==.-ATTRTB


;ERROR CONVERSION TABLE
;CONVERTS DECNET-36 ERROR CODE TO TOPS20 ERROR CODE
D36ERR::MONX03			;MONITOR INTERNAL ERROR
	NSJX07			;ARGUMENT BLOCK FORMAT ERROR
	NSJX02			;ALLOCATION FAILURE
	MSTX14			;BAD CHANNEL NUMBER
	NSJX09			;BAD FORMAT TYPE IN PROCESS BLOCK
	DCNX12			;CONNECT BLOCK FORMAT ERROR
	DCNX12			;INTERRUPT DATA TOO LONG
	NSPX10			;ILLEGAL FLOW CONTROL MODE
	NSJX04			;ILLEGAL FUNCTION
	DCNX5			;JOB QUOTA EXHAUSTED
	DCNX5			;LINK QUOTA EXHAUSTED
	SCLX01			;NO CONNECT DATA TO READ
	SCLX02			;PERCENTAGE INPUT OUT OF BOUNDS
	CAPX1			;NO PRIVILEGES TO PERFORM FUNCTION
	MONX03			;OBSOLETE
	NSPX24			;UNKNOWN NODE NAME
	SCLX03			;UNEXPECTED STATE: UNSPECIFIED
	NSJX03			;WRONG NUMBER OF ARGUMENTS
	SCLX03			;FUNCTION CALLED IN WRONG STATE
	ARGX17			;CONNECT BLOCK LENGTH ERROR
	ARGX17			;PROCESS BLOCK LENGTH ERROR
	ARGX17			;STRING BLOCK LENGTH ERROR
	SCLX04			;U.E.S. DISCONNECT SENT
	SCLX05			;U.E.S. DISCONNECT CONFIRMED
	SCLX06			;U.E.S. NO CONFIDENCE
	SCLX07			;U.E.S. NO LINK
	SCLX08			;U.E.S. NO COMMUNICATION
	SCLX09			;U.E.S. NO RESOURCES
	NSPX00			;REJECTED BY OBJECT
	NSPX00			;DISCONNECTED BY OBJECT (WHEN RUNNING)
	NSPX01			;NO RESOURCES
	NSPX24			;UNRECOGNIZED NODE NAME
	NSPX03			;REMOTE NODE SHUT DOWN
	SCLX10			;UNRECOGNIZED OBJECT
	DCNX3			;INVAILD OBJECT NAME FORMAT
	SCLX11			;OBJECT TOO BUSY
	NSPX08			;ABORT BY MANAGEMENT
	NSPX09			;ABORT BY OBJECT
	COMX20			;INVALID NODE NAME FORMAT
	NSPX27			;LOCAL NODE SHUT DOWN
	NSPX13			;ACCESS CONTROL REJECTION 
	NSPX17			;NO RESPONSE FROM OBJECT
	DCNX11			;NODE UNREACHABLE
	SCLX07			;NO LINK
	SCLX12			;DISCONNECT COMPLETE
	NSPX22			;IMAGE FIELD TOO LONG
	SCLX14			;UNSPECIFIED REJECT REASON
	SCLX15			;BAD COMBINATION OF EOM & WAIT FLAGS
	SCLX16			;ADDRESS ERROR IN USER ARGUMENTS
	SCLX17			;ILLEGAL MESSAGE FORMAT DETECTED
	SCLX18			;U.E.S CONNECT WAIT
	SCLX19			;U.E.S. CONNECT RECEIVED
	SCLX20			;U.E.S. CONNECT SENT
	SCLX21			;U.E.S. REJECT
	SCLX22			;U.E.S. RUN
D36ERL==:.-D36ERR		;LENGTH OF TABLE
	SUBTTL LOCAL STRUCTURES

;FOR ATTRIBUTE PARSING

DEFSTR (NTATR,,35,9)
DEFSTR (NTATC,,17,6)
DEFSTR (NTATE,,26,9)
DEFSTR (NTATB,,0,1)
	SUBTTL LOCAL MACROS

;FOR ATTRIBUTE PARSING.
DEFINE ATTENT (VALUE,BIN,COUNT,EXCLU)<
	<BIN>B0+<COUNT>B17+EXCLU*1000+VALUE>
	SUBTTL REGISTER DEFINITIONS

FX==:7				;USED IN SCHEDULER ROUTINES - SJBGON, SCJBLK
DEFAC (T5,Q1)			;STATUS RETURNED IN SCWAKE ROUTINE
DEFAC (PRT,Q2)			;POINTS TO PORT'S DATA
DEFAC (SAB,Q3)			;POINTS TO SESSION CONTROL ARG BLOCK
DEFAC (STS,P1)			;STATUS REGISTER FOR JFN
DEFAC (JFN,P2)			;JOB FILE NUMBER
DEFAC (SJB,P3)			;SESSION CONTROL JOB BLOCK
				;CAUTION ** SJB IS KNOWN TO BE = P3 IN ROUTINES
				; SCBLOK, NTSNH, IMPWAT, AND SCLFNU
DEFAC (DEV,P4)			;POINTS TO DEVICE DISPATCH TABLE
DEFAC (F1,P5)			;THE OTHER JFN REGISTER
	SUBTTL INITIALIZATION CODE 

	SWAPCD

;CALLED FROM D36INI AT SYSTEM STARTUP
SCJINI::UNLOCK SJBLOK		;INITIALIZE SJB LOCK
	MOVE T1,TODCLK
	HRRZM T1,LASTSK		;Initialize this to a pseudo random value
	RET
	SUBTTL	DEVICE DISPATCH VECTORS FOR SRV: DEVICE

;FOR DEVICE SRV:
SRVDTB::SRVDTL
	DTBDSP (NETDIR)		;DIRECTORY SET
	DTBDSP (SRVSET)		;NAME LOOKUP
	DTBDSP (SRVEXT)		;EXTENSION LOOKUP
	DTBDSP (VERSET)		;VERSION LOOKUP
	DTBBAD (DESX9)		;NO PROTECTION
	DTBBAD (DESX9)		;NO ACCOUNT
	DTBBAD (DESX9)		;NO STATUS
	DTBDSP (SRVOPN)		;OPEN
	DTBDSP (NETSQI)		;INPUT
	DTBDSP (NETSQO)		;OUTPUT
	DTBDSP (NETCLZ)		;CLOSE
   REPEAT 7,<
	DTBBAD (DESX9)>		;ILLEGAL FUNCTIONS
	DTBDSP (NTMTOP)		;MTOPR
   REPEAT 2,<DTBBAD (DESX9)>	;ILLEGAL FUNCTIONS
	DTBDSP (NETSQR)		;SOUTR
	DTBDSP (RFTADN)		;NO TIME AND DATE
	DTBDSP (RFTADN)		;NO TIME AND DATE
	DTBDSP (NETINP)		;SET FOR INPUT
	DTBDSP (NETOUP)		;SET FOR OUTPUT
	DTBBAD (GJFX49)		;NO ATTRIBUTES
	DTBDSP (SCRELJ)		;RELEASE JFN
	SRVDTL==:.-SRVDTB	;LENGTH
	SUBTTL	DEVICE DISPATCH VECTORS FOR DCN: DEVICE

DCNDTB::DCNDTL
	DTBDSP (NETDIR)		;DIR SET
	DTBDSP (DCNSET)		;NAME LOOKUP
	DTBDSP (DCNEXT)		;EXTENSION LOOKUP
	DTBDSP (VERSET)		;VERSION LOOKUP
   REPEAT 3,<
	DTBBAD (DESX9)>		;ILLEGAL FUNCTIONS
	DTBDSP (DCNOPN)		;OPEN
	DTBDSP (NETSQI)		;INPUT
	DTBDSP (NETSQO)		;OUTPUT
	DTBDSP (NETCLZ)		;CLOSE
   REPEAT 7,<
	DTBBAD (DESX9)>	;ILLEGAL FUNCTIONS
	DTBDSP (NTMTOP)		;MTOPR
   REPEAT 2,<DTBBAD (DESX9)>	;ILLEGAL FUNCITONS
	DTBDSP (NETSQR)		;SOUTR
	DTBDSP (RFTADN)		;NO TIME AND DATE
	DTBDSP (SFTADN)		;NO TIME AND DATE
	DTBDSP (NETINP)		;SET FOR INPUT
	DTBDSP (NETOUP)		;SET FOR OUTPUT
	DTBDSP (NETATR)		;PARSE ATTRIBUTES
	DTBDSP (SCRELJ)		;RELEASE JFN
	DCNDTL==:.-DCNDTB	;LENGTH
	SUBTTL RELEASE JFN

;CALL @RLJFD(DEV)
;CALLED FROM RELJFN FOR SRV: AND DCN:
;RETURNS +1 ON FAILURE
;RETURNS +2 ON SUCCESS

SCRELJ:	LOAD T2,FLLNK,(JFN)	;GET PORT NUMBER
	JUMPE T2,RSKP		;NOTHING TO DO
	CALL SCJLOD		;SET UP SCJSYS ACS (SAB, SJB, PRT)
	 RETBAD ()		;FAILED.
	CALLRET CLRPRT		;GO CLEAN UP
	SUBTTL EXTERNAL ENTRIES -- RELEASE FORK STORAGE

;CALLED FROM KSELF AND SCLGOU
;CALL RELSAB (NO ARGUMENTS)
;CLEAN UP SAB
RELSAB::SAVEAC <T5,PRT,SAB>	;NEED SOME REGISTERS
	NOINT			;NO INTERRUPTIONS.
	SKIPN T5,PSBSAB		;GET SAB INDIRECT TABLE
	IFSKP.
	  MOVEI PRT,ST.LEN*2  	;THERE IS ONE. LOOP ON EACH ENTRY IN IT.
	  DO.
	    SKIPN SAB,(T5)	;IS THERE AN SAB HERE ?
	    IFSKP.
	      CALL RELSBX	; Clean up SAB and release it
	      SETZM (T5)	;  AND CLEAR POINTER TO IT.
	    ENDIF.
	    AOS T5
	    SOJG PRT,TOP.	;STEP TO NEXT ENTRY
	  ENDDO.
	  SETZ T1,		;DEALLOCATE INDIRECT TABLE
	  EXCH T1,PSBSAB
	  CALLX (XCDSEC,DNFWDS)
	ENDIF.
	OKINT			;ALLOW INTERRUPTIONS
	RET

;Call:
;	SAB/ SAB to deallocate

RELSBX:	OPSTR <SKIPE T1,>,SASBP,(SAB) ;YES. STRING BLOCK AROUND ?
	 CALLX (XCDSEC,DNFWDS)	; Yes, deallocate
	OPSTR <SKIPE T1,>,SACBP,(SAB) ; CONNECT BLOCK AROUND ?
	 CALLX (XCDSEC,DNFWDS)	;YES. DEALLOCATE
	MOVE T1,SAB    		;DEALLOCATE
	CALLX (XCDSEC,DNFWDS) ; SAB
	RET
	SUBTTL EXTERNAL ENTRIES -- RELEASE FORK STORAGE -- ACTIVE SABS

;Call:
;	/with nothing

;Return:
;	+1 always

;**; [7252] Replace 1 line with 2 at RELACT:	HMP	28-Feb-86

RELACT:	SAVEAC <SAB,PRT,DEV,SJB> ; [7252]
	LOAD SJB,FLLNK,(JFN)	; [7252] Get port

	MOVX PRT,ST.LEN		; Number of "active" slots
	SKIPN DEV,PSBSAB	; Get indirect table pointer
	 RET
	ADDI DEV,ST.LEN		; Offset to active portion
RELAC1:	SKIPE SAB,(DEV)		; If we have a SAB, release it
;**; [7252] Replace 2 lines with 8 at RELAC1:+1	HMP	28-Jan-86
	IFSKP.			; [7252]
	  LOAD T1,SAACH,(SAB)	; [7252] Get channel that this SAB is for
	  CAME T1,SJB		; [7252] For the channel we are clearing?
	  IFSKP.		; [7252]
	    SETZM (DEV)		; [7252] Yes, forget pointer
	    CALL RELSBX		; [7252]  and release SAB
	  ENDIF.		; [7252]
	ENDIF.			; [7252]
	AOJ DEV,		; Step to next
	SOJG PRT,RELAC1		; If more, continue
	RET
	SUBTTL EXTERNAL ENTRIES -- RELEASE JOB STORAGE
;CALLED FROM .LGOUT
;CALL SCLGOU (NO ARGUMENTS)
;CLEAN UP SJB, SAB, AND PORT TABLE

SCLGOU::CALL RELSJB		;FREE THE SJB IF IT IS AROUND
	CALL RELSAB		;FREE TOP FORK'S SAB STUFF
	RET
	SUBTTL EXTERNAL ENTRIES -- SWJFN% HOOK

;Called from .SWJFN
;
;If JFN is a DECnet JFN, then fix port block to account for the
; action of SWJFN%
;
;Call with:
;	T1/ JFN
;	CALL SCSWJF
;
;Returns:
;	+1 always, T1 intact, T2 and T3 destroyed

SCSWJF::
	LOAD T2,FLDTB,(T1)	;Get device table address
	CAIE T2,DCNDTB		;DCN
	CAIN T2,SRVDTB		; or SRV?
	SKIPA			;Yes, one or the other
	RET			;Not DECnet - return now

	OPSTR <SKIPN T2,>,FLLNK,(T1) ;Get port #
	RET			;None assigned, return now
	MOVE T3,JSBSJB		;Get job's SJB
	OPSTR <ADD T2,>,SJPRT,(T3) ;Get address of pointer to port block
	SKIPN T2,(T2)		;Get pointer to port block
	RET			;None there, return now
	STOR T1,PTJFN,(T2)	;Store our new JFN offset

	RET			;Done
	SUBTTL SJB & PORT ROUTINES -- GET SJB AND PORT TABLE 

;VERIFY THAT THE SJB EXISTS (AND THUS THE PORT TABLE)
;IF SJB DOES NOT EXIST, CREATE IT AND THE PORT TABLE.
;ALL EXITS FROM THIS ROUTINE MUST UNLOCK SJBLOK
;CALL DOSJB (NO ARGUMENTS)
;RETURNS +1 ON FAILURE, WITH ERROR IN T1
;RETURNS +2 ON SUCCESS

;DOSJB allocates the maximum number of port blocks allowed to a job, and they
;will be kept for the life of the SJB.  If we were to deallocate a port block
;when a link was closed, we could not be certain that all forks using this
;link had stopped using the PTBLK and PTWAK bits in scheduler tests until all
;the forks were stopped.  Thus we keep the PT blocks around until LOGOUT frees
;the SJB.

DOSJB::	SKIPE JSBSJB		;ALREADY HAVE AN SJB?
	RETSKP			;YES. DONE
	LOCK SJBLOK		;NO. EXCLUSIVE
	SKIPE JSBSJB		;IS THERE REALLY ONE ?
	IFSKP.
	  SAVEAC <SJB,T5>
	  MOVE T1,DNDEFS	;NO! GET DEFAULTS FOR QUOTAS
	  CALL MAKSJB		;CREATE AN SJB
       	  RETBAD (MONX07,<UNLOCK SJBLOK>) ;SAY WE FAILED.
	  MOVEM T1,JSBSJB	;SAVE ITS ADDRESS IN JSB
	  MOVE SJB,T1
	  LOAD T1,DCMAX		;Count of links allowed for non-whoppers
	  LSH T1,1		;Some extras
	  MOVE T2,CAPMSK	;No, get potential capabilities
	  TXNE T2,SC%WHL!SC%OPR	;A potential WHOPPER?
	   MOVEI T1,MAXPRT+^D10 ;Maximum number of ports plus some extrsa
	  STOR T1,SJMXP,(SJB)	;Remember number we are allowing
	  ADDI T1,1		;We don't use first slot (0)
	  CALLX (XCDSEC,DNGWDS)	;Get enough space for indirect table
	  IFSKP.
	    STOR T1,SJPRT,(SJB)	;Save address of indirect table
	  ELSE.
	    CALL RELSJB		;Failed to get block so release SJB and
	     RETBAD (MONX07,<UNLOCK SJBLOK>)	; return error
	  ENDIF.
	ENDIF.
	UNLOCK SJBLOK		;END EXCLUSIVE
	RETSKP			;SUCCESS
	SUBTTL SJB & PORT ROUTINES -- RELEASE SJB AND PORT TABLE

;CLEAN UP JOB STORAGE - SJB AND PORT TABLE
;CALL RELSJB (NO ARGUMENTS)
;RETURNS +1 ALWAYS
RELSJB:	SAVEAC <T5,PRT,F1>
	STKVAR <<SABB,SA.LEN>>	;AN SAB	FOR RESETTING
	SETZ F1,		;GET AND ZERO
	EXCH F1,JSBSJB		; PTR TO SJB
	JUMPE F1,RTN		;ALL DONE IF SJB IS ALREADY RELEASED
	XMOVEI T1,SABB		;GET A SAB
	STOR F1,SASJB,(T1)	;SET UP SJB POINTER
	MOVEI T2,.NSFRE		;FUNCTION CODE - RESET ALL LINKS FOR THIS SJB
	STOR T2,SAAFN,(T1)
	MOVEI T2,2		;NUBMER OF ARGUMENTS
	STOR T2,SANAG,(T1)
	SETZM SA.CBP(T1)	;ZERO THE THINGS THAT NEED IT.
	SETZM SA.SBP(T1)
	SETZM SA.MFG(T1)
	CALL SCTNSF		;CALL LOWER LAYER TO DO THE RESET.
	OPSTR <SKIPN PRT,>,SJPRT,(F1) ;IS THERE A PORT INDIRECT TABLE?
	IFSKP.
	  LOAD T5,SJMXP,(F1)	;Number of entries in indirect table
	  DO.
	    SKIPE T1,(PRT)	;Release any port blocks that can be found
	    CALLX (XCDSEC,DNFWDS)
	    AOJ PRT,		;Step to next slot
	    SOJG T5,TOP.
	  ENDDO.
	  OPSTR <SKIPE T1,>,SJPRT,(F1) ;Get port indirect table?
	   CALLX (XCDSEC,DNFWDS) ; and release the space
	ENDIF.
	MOVE T2,FORKX		;NOW DISMISS UNTIL THE RESET TAKES
	STOR F1,FKST2,(T2)	;SJB POINTER
	XMOVEI T1,SJBGON	;ADDRESS OF TEST ROUTINE
	MDISMS			;WAIT...
	MOVE T1,F1		;FREE
	CALLRET FRESJB		; THE SJB

	RESCD			;SCHEDULER TEST MUST BE RESIDENT

;SCHEDULER TEST TO WAIT UNTIL SLBs ASSOCIATED WITH AN SJB ARE DISPOSED OF.
SJBGON:	LOAD T1,FKST2,(FX)	;GET THE POINTER TO THE SJB
	LOAD T2,SJCHC,(T1)	;GET THE COUNT OF ENTRIES
	LOAD T1,SJCHT,(T1)	;GET POINTER TO THE SLB TABLE
	JUMPLE T2,RSKP  	;DONE IF NOTHING TO LOOK AT.
SJBGN1:	SKIPE (T1)		;SOMETHING THERE ?
	RET			;YES. WAIT SOME MORE
	SOSE T2			;NO. ANYMORE TO CHECK ?
	AOJA T1,SJBGN1		;YES. GO TO IT.
	RETSKP			;SUCCESS.

	SWAPCD
	SUBTTL SJB & PORT ROUTINES -- INITIALIZE A PORT ENTRY

;CALL CLRPRT
;RETURNS:	+2

;**; [7252] Add 1 line at CLRPRT:	HMP	28-Jan-86
CLRPRT:	CALL RELACT		; [7252] Release active SABs
	MOVE T1,PRT    		;GET THE ADDRESS OF THIS ENTRY
REPEAT PT.LEN-1,<		;CLEAR THEM OUT
	SETZM (T1)
	AOS T1 
>;END REPEAT			
	SETZM (T1)		;SINCE PT.LEN IS SMALL, THIS WAY IS BETTER.
	DECR DCCUR		;ONE LESS PORT FOR THIS FORK
;**; [7252] Delete 1 line at CLRPRT:+6	HMP	28-Jan-86
	HLRZ T1,FILWND(JFN)	;GET OUTPUT WINDOW PAGE
	SKIPE T1		;HAVE ONE?
         CALL RELPAG		;YES, RELEASE IT
	HRRZ T1,FILWND(JFN)	;GET INPUT WINDOW PAGE
	SKIPE T1		;HAVE ONE?
	 CALL RELPAG		;YES, RELEASE IT
	SETZRO FLLNK,(JFN)	;NO MORE PORT NUMBER
	RETSKP

	ENDSV.
	SUBTTL SJB & PORT ROUTINES -- CLOSE A PORT

;CALL CLZPRT
;ACCEPTS:	T1/ FLAG,,FUNCTION CODE   FLAG = -1  GET RID OF PORT
;						  0  KEEP PORT
;		T2/ PORT NUMBER
;RETURNS:	+1 FAILED  T1/ ERROR CODE
;		+2 SUCCESS

CLZPRT:	STKVAR <PORT,FLAG>
	MOVEM T2,PORT		;SAVE PORT NUMBER
	HLRZM T1,FLAG		;PRESERVE THE "KEEP" FLAG
	STOR T1,SAAFN,(SAB)	;PUT FUNCITON CODE IN SAB
	STOR T2,SAACH,(SAB)	;PUT PORT IN SAB
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 RETBAD ()		;SOMETHING WRONG
	JUMPN T1,R		;  "   "
	SKIPN FLAG		;KEEP PORT?
	 RETSKP			;YES
	MOVE T2,PORT		;NO, RETRIEVE PORT
	CALLRET CLRPRT		;RELEASE PORT'S INFO

	ENDSV.			;END STKVAR
	SUBTTL GTJFN LOOKUP ROUTINES

;NAME LOOKUP FOR SRV: AND DCN: DEVICES
DCNSET:
SRVSET:	JUMPE T1,[RETBAD (GJFX18,<OKINT>)] ;CANT'T STEP IT
OKRET:	TQNE <UNLKF>		;WANT TO UNLOCK?
	RETSKP			;NO. RETURN
	OKINT			;YES. GO OKINT THEN
	RETSKP			;AND RETURN

;VERSION LOOKUP FOR SRV: AND DCN: DEVICES
VERSET:	TQNN <STEPF>		;TRYING TO STEP?
	JRST OKRET		;NO. ALLOW IT THEN
	JUMPGE T1,OKRET		;IF NOT STEPPING, OKAY
	RETBAD (GJFX18,<OKINT>)	;ALL ELSE IS WRONG

;DIRECTORY LOOKUP FOR SRV: AND DCN: DEVICES
;CREATE SJB AND PORT TABLE.
;RETURNS +1 ON FAILURE, WITH ERROR IN T1
;RETURNS +2 AND NOINT ON SUCCESS
NETDIR:	TQNE <STEPF>		;WANT TO STEP?
	RETBAD (GJFX17)		;YES. CAN'T DO IT
	CALL DOSJB		;SET SJB AND PORT TABLE IF NEEDED
	 RETBAD ()		;FAILED
	NOINT			;SUCCESS, GO NOINT
	RETSKP			;DONE.
	SUBTTL PARSING ENTRY POINTS -- DCN: GTJFN
;THE FOLLOWING FOUR ROUTINES USE CERTAIN TRVARS FOR PARSING
;NOW, THERE ARE FOUR ENTRY POINTS. DCNEXT, SRVEXT, DCNOPN, SRVOPN
;AT THE START OF EACH ENTRY POINT ROUTINE, THERE IS A TRVAR DEFINITION.
;IF ANY OF THE TRVAR DEFINITIONS ARE CHANGED, ALL MUST BE.

;CALL @ELUKD(DEV) FOR DCN:
;DCN: EXTENSION LOOK UP DURING GTJFN
;PARSES THE NAME & EXTENSION
;T1/ EXTENSION LOOKUP POINTER

DCNEXT:	TRVAR <NTCNT,NTPNT,NTOBJ,NTNMC,NTNAM,NTDSC,NTDES,NTHST,NTHSC,NTSAV,<NTRNM,3>>
	JUMPE T1,[RETBAD (GJFX18,<OKINT>)] ;CAN'T STEP IT
	CALL SCZROT		;INIT TRVARS
	MOVEM T1,NTSAV		;SAVE EXTENSION LOOKUP POINTER
	HLRZ T1,FILNEN(JFN)	;GO PARSE
	CALL DCNNAM		; NAME
	 RETBAD()		;SOME SORT OF ERROR
	MOVE T1,NTSAV      	;GO
	CALL DCNCEX		; CHECK EXTENSION
	 RETBAD()		;SOME SORT OF ERROR
	JRST OKRET		;AND DONE
	ENDTV.			;END TRVAR, FOR IT OCCURS AGAIN
	SUBTTL PARSING ENTRY POINTS -- SRV: GTJFN

;CALL @ELUKD(DEV) FOR SRV:
;SRV: EXTENSION LOOK UP DURING GTJFN
;PARSES THE NAME & EXTENSION
;T1/ EXTENSION LOOKUP POINTER

SRVEXT:	TRVAR <NTCNT,NTPNT,NTOBJ,NTNMC,NTNAM,NTDSC,NTDES,NTHST,NTHSC,NTSAV,<NTRNM,3>>
	CALL SCZROT		;INIT TRVARS
	JUMPE T1,[RETBAD (GJFX18,<OKINT>)] ;CANT'T STEP IT
	MOVEM T1,NTSAV		;SAVE EXTENSION LOOKUP POINTER
	HLRZ T1,FILNEN(JFN)	;GO PARSE
	CALL SRVNAM		; THE NAME
	 RETBAD()		;HAD AN ERROR
	MOVE T1,NTSAV      	;GO
	CALL SRVCEX		; CHECK EXTENSION
	 RETBAD()		;SOME SORT OF ERROR
	JRST OKRET		;AND DONE
	ENDTV.			;END TRVAR, FOR IT OCCURS AGAIN
	SUBTTL PARSING ENTRY POINTS -- SRV: OPENF

;CALL @OPEND(DEV) FOR SRV:
;CALLED FROM OPENF WHEN DEVICE IS SRV:
;PARSES NAME AND EXTENSION AND OPENS A NETWORK LINK

SRVOPN:	TRVAR <NTCNT,NTPNT,NTOBJ,NTNMC,NTNAM,NTDSC,NTDES,NTHST,NTHSC,NTSAV,<NTRNM,3>>
	SETZRO FLLNK,(JFN)	;No port yet
	CALL SCJLOD		;SET UP SAB AND SJB AND PRT
	 RETBAD ()		;FAILED.
	MOVEI T1,.NSFEP		;GET OPEN SRV: FUNCTION CODE
	CALL OPNINI		;SET UP CONNECT BLOCK
	 RETBAD ()		;COULDN'T
	HLRZ T1,FILNEN(JFN)	;GET FILE NAME BLOCK ADDRESS
	CALL SRVNAM		;PARSE IT INTO A NETWORK OBJECT TYPE
	 RETBAD ()		;FAILED
	HRRZ T1,FILNEN(JFN)	;GET FILE EXTENSION BLOCK ADDRESS
	CALL SRVCEX		;PARSE IT INTO A NETWORK TASK NAME
	 RETBAD ()		;FAILED
	SKIPG NTOBJ		;Object found?
	 SKIPE NTNMC		;No, any taskname?
	 IFSKP.
	   CALL GENUNM		;No, generate a unique name
	 ENDIF.
	LOAD T1,SACBP,(SAB)	;GET CB ADDRESS
	CALL OBJNAM		;DO PROCESS DESCRIPTOR BLOCKS
	CALL ASGWDW		;GO GET WINDOW PAGES
	 RETBAD ()		;FAILED
	MOVEI T1,.NSFEP		;GET ENTER PASSIVE CODE
	STOR T1,SAAFN,(SAB)	;PUT IT IN ARG BLOCK
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 JRST DEASWD		;Failed. Deallocate windows, and return failure
	JUMPN T1,DEASWD		;  "		"
	MOVEI T1,.PASS		;GET PASSIVE INDICATOR
	CALL OPNFIN		;FILL IN JFN AND PORT TABLE
	 CALLRET OPNFAI		;Failed - Close port and return error
	RETSKP
	ENDTV.			;END TRVAR, FOR IT OCCURS AGAIN
	SUBTTL PARSING ENTRY POINTS -- DCN: OPENF

;CALL @OPEND(DEV) FOR DCN:
;CALLED FROM OPENF WHEN DEVICE IS DCN:
;PARSES NAME AND EXTENSION AND OPENS A NETWORK LINK

DCNOPN:	TRVAR <NTCNT,NTPNT,NTOBJ,NTNMC,NTNAM,NTDSC,NTDES,NTHST,NTHSC,NTSAV,<NTRNM,3>,NTNOD>
	SETZRO FLLNK,(JFN)	;No port yet
	SAVEAC <F1>
	CALL SCJLOD		;SET UP SAB AND SJB AND PRT
	 RETBAD ()		;FAILED.
	MOVEI T1,.NSFEA		;GET OPEN DCN: FUNCTION CODE
	CALL OPNINI		;SET UP CONNECT BLOCK
	 RETBAD ()  		;COULDN'T
	HLRZ T1,FILNEN(JFN)	;GET NAME FOR THE CONNECTION
	CALL DCNNAM		;GO PARSE THE NAME FIELD
	 RETBAD ()		;FAILED
	CALL DCNGOK		;Ask the ACJ if connection is allowed to this
	 RETBAD (NSPX13)	; node.  Permission denied
	HRRZ T1,FILNEN(JFN)	;Get address of extension string block
	CALL DCNCEX		;GO GET TASK NAME
	 RETBAD ()
	SKIPN NTNMC		;Did we get a name?
	 CALL GENUNM		;No, assign one
	LOAD F1,SACBP,(SAB)	;GET THE CB ADDRESS
	SETZRO CBCIR,(F1)	;Clear loopback circuit ID
	SKIPG T2,NTHSC		;HAVE A HOST NAME?
	IFSKP.			;YES
	   MOVE T1,NTHST	;GET BP TO HOST NAME STRING BLOCK
	   CALL PUTSIX		;(T1,T2/T1) CONVERT TO SIXBIT
	   MOVEM T1,NTNOD	; Save node name
	   CALL SCTN2A		; (T1/T1) and find the address
	   IFNSK.		;  -not found, maybe
	     MOVE T1,NTNOD	;    Retrieve node name
	     CALL SCTN2L	;    loopback node?
	       RETBAD (NSPX24)	;     -no, neither
	     STOR T1,CBCIR,(F1)	;    -yes, store circuit ID in connect block
	     SETZ T1,		;     and clear node number as a flag
	   ENDIF.
	ELSE.			;NO. MUST BE LOCAL NAME.
	   LOAD T1,IBADR,+IBBLK	;  Get local node number
	ENDIF.
	STOR T1,CBNUM,(F1)	;Put host number into connect block
	MOVE T1,F1		;RETRIEVE CB ADDRESS
	CALL OBJNAM		;DO PROCESS DESCRIPTOR BLOCKS
	MOVE T1,F1		;GET CB ADDRESS AGAIN
	CALL INSATR		;DO CONNECT BLOCK
	CALL ASGWDW		;NOW SET UP WINDOWS
	 RETBAD ()		;FAILED
	MOVEI T1,.NSFEA		;GET ENTER ACTIVE CODE
	STOR T1,SAAFN,(SAB)	;PUT IT IN ARG BLOCK
	MOVEI T1,5		;Argument value
	STOR T1,SANAG,(SAB)	; and put in SAB
	LOAD T1,FLSES,(JFN)	;Get segment size from JFN block
	STOR T1,SAAA2,(SAB)	; and put into SAB
	LOAD T1,FLFCO,(JFN)	;Get flow control option from JFN block
	STOR T1,SAAA3,(SAB)	; and put into SAB
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 JRST DEASWD		;Failed. Deallocate windows, and return failure
	JUMPN T1,DEASWD		;  "          "
	MOVEI T1,.ACT		;GET ACTIVE INDICATOR
	CALL OPNFIN		;FILL IN JFN AND PORT TABLE
	 CALLRET OPNFAI		;Failed - Close port and return error
	RETSKP

;END TRVAR AFTER THE FOLLOWING ROUTINES...
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- BYTES IN A STRING
;THE FOLLOWING ROUTINES USE THE TRVARs DEFINED ABOVE

;ROUTINE TO COMPUTE NUMBER OF USEFUL BYTES IN A STRING.
;CALLED FROM ROUTINES THAT PROCESS NETWORK FILE NAMES.
;CALL COMPUT
;ACCEPTS:	T1/FREE BLOCK ADDRESS
;RETURNS:	+1 ALWAYS WITH COUNT IN NTCNT AND POINTER IN NTPNT

COMPUT:	HRRZ T3,0(T1)		;GET COUNT OF WORDS IN BLOCK
	SOS T3			;DISCOUNT THE HEADER
	IMULI T3,5		;GET BYTE COUNT
	AOS T3			;ADD IN FINAL TERMINATOR
	HRLI T1,(<POINT 7,0,35>) ;GET STRING POINTER TO THE BLOCK
	MOVEM T1,NTPNT		;AND SAVE THE STARTING POINTER
	CALL CMPLEN		;GET LENGTH OF STRING
	MOVEM T3,NTCNT		;SAVE COUNT
	RET			;DONE, RETURN
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- SCAN FOR "-"

;SCAN NAME STRING FOR NETWORK PUNCTUATION CHARACTER AND UPDATE COUNTS.
;CALL NETDSH
;	NTPNT	CURRENT TEXT POINTER
;	NTCNT	CURRENT BYTE COUNT

;RETURNS:	+1
;	NTPNT	UPDATED POINTER
;	NTCNT	UPDATED COUNT
;	T1/ ORIGINAL POINTER
;	T3/ NUMBER OF CHARCTERS FOUND BEFORE PUNCTUATION

NETDSH:	MOVE T1,NTPNT		;GET BYTE POINTER
	MOVE T2,[POINT 0,0,2]	;DUMMY
	MOVE T3,NTCNT		;THE COUNT
	MOVEI T4,"-"		;STOP ON THE END OF THE HOST FIELD
	SIN%			;GET IT
	EXCH T1,NTPNT		;STORE NEW POINTER. GET OLD
	EXCH T3,NTCNT		;STORE NEW COUNT. GET OLD COUNT
	SUB T3,NTCNT		;GET BYTES TRANSPIRED
	RET			;AND DONE
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- PARSE SRV: NAME 

;ROUTINE TO PARSE THE NAME FIELD OF A SRV: SPECIFICATION.
;THE NAME FIELD CONTAINS THE OBJECT TYPE OF THE NETWORK LINK

;CALL SRVNAM
;ACCEPTS:	T1/ ADDRESS OF NAME FIELD STRING BLOCK
;RETURNS:	+1 FAILED   T1/ ERROR CODE
;		+2 SUCCESS

SRVNAM:	CALL COMPUT		;COMPUTE STRING COUNT
	MOVE T2,NTCNT		;GET CHAR. COUNT
	CAILE T2,1		;WERE THERE ANY?
	IFSKP.			;NO
	   SETZM NTOBJ		;SAY NO OBJECT
	   RETSKP		;DONE
	ENDIF.
	MOVE T1,NTPNT		;GET ADDRESS OF OBJECT STRING BLOCK
	AOS T1			;GET TO ACTUAL STRING ADDRESS
	HRLI T1,(<POINT 7,>)	;MAKE A BP TO OBJECT
	CALL OBJLOK		;GO LOOK IT UP
	 RETBAD (DCNX3)		;NO SUCH OBJECT. COMPLAIN
	SKIPE T1		;If zero, then generic task
	 CAILE T1,DECOBJ	;IS IT A DEC RESERVED OBJECT?
	  IFSKP.
	    MOVX T3,SC%WHL!SC%OPR ;YES. MUST BE PRIVILEGED THEN
	    TDNN T3,CAPENB	;IS IT ENABLED?
	     RETBAD (DCNX3)	;NO. ERROR
	  ENDIF.
	MOVEM T1,NTOBJ		;SAVE THE OBJECT
	RETSKP
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- PARSE SRV: EXTENSION

;CALL SRVCEX
;ROUTINE TO PARSE SRV: EXTENSION. 
;THIS FIELD WILL BE THE OBJECT NAME OF THE NETWORK LINK

SRVCEX:	CALL COMPUT		;FIGURE OUT COUNT
	MOVE T1,NTCNT		;GET NUMBER OF CHARS.
	SKIPG NTOBJ		;IS THERE AN OBJECT?
	IFSKP.			;YES
	   CAILE T1,1		;IS THERE A NAME?
	    RETBAD (DCNX1)	;YES, ILLEGAL FILE SPEC
	   RETSKP		;NO, GOOD
	ENDIF.
	SOS T1			;GET ACTUAL CHARACTER COUNT
	CAILE T1,TSKMAX		;WITHING RANGE
	 RETBAD (DCNX12)	;NO. TOO LONG
	MOVEM T1,NTNMC		;SAVE IT
	MOVE T1,NTPNT		;GET ADDRESS OF NAME BLOCK
	AOS T1			;OFFSET TO ACTUAL STRING
	HRLI T1,(<POINT 7,>)	;MAKE BP TO IT
	MOVEM T1,NTNAM		;SAVE IT
	RETSKP			;AND DONE
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- PARSE DCN: NAME

;PARSE NAME FOR A DCN: FILE SPEC
;THIS FIELD CONTAINS THE REMOTE NODE NAME, OBJECT TYPE, AND 
;IF THE OBJECT TYPE IS TASK, THE OBJECT NAME.

;CALL DCNNAM
;ACCEPTS:	T1/ ADDRESS OF NAME
;RETURNS:	+1 SYNTAX ERROR
;		+2 GOOD

DCNNAM:	CALL COMPUT		;FIND COUNT
       	CALL NETDSH		;GO PICK OFF HOST NAME
	SKIPN NTCNT		;MORE IN THE STRING?
	RETBAD (DCNX1)		;NO. SYNTAX ERROR THEN
	SETOM NTHSC		;ASSUME LOCAL CONNECTION
	SOSG T3			;HAVE A REAL STRING?
	JRST DCNOBJ		;NO. GO LOOK FOR OBJECT THEN
	CAILE T3,MAXHST		;WITHIN BOUNDS?
	RETBAD (COMX19)		;NO. STRING TOO LONG
	AOS T1			;OFFSET TO THE ACTUAL TEXT
	HRLI T1,(<POINT 7,>)	;MAKE A BP TO IT
	MOVEM T1,NTHST		;SAVE IT
	MOVEM T3,NTHSC		;AND SAVE COUNT
	MOVE T2,T3		;GET NODE NAME CHARACTER COUNT
	CALL PARNO1		;SEE IF VALID NODE NAME SYNTAX
	 RETBAD ()		;INVALID NODE NAME - RETURN THE ERROR
DCNOBJ:	CALL NETDSH		;GO FIND OBJECT
	CAIG T3,1		;HAVE A REAL STRING?
	RETBAD (DCNX3)		;NO. INVALID OBJECT THEN
	LDB T4,NTPNT		;GET BACK TERMINATOR
	MOVEM T4,NTOBJ		;SAVE IT
	SETZ T4,		;GET A NULL
	DPB T4,NTPNT		;TIE OFF STRING
	CALL OBJLOK		;GO LOOK UP THE OBJECT
	 RETBAD (DCNX3)		;NO SUCH
	EXCH T1,NTOBJ		;SAVE OBJECT
	DPB T1,NTPNT		;AND PUT BACK TERMINATOR
	SETZM NTDES		;ASSUME NO DESCRIPTOR
	SKIPE T3,NTCNT		;ANY BYTES LEFT IN STRING?
	 CAIG T3,1		;YES. ENOUGH TO MAKE A DESCRIPTOR?
	  RETSKP		;NO ALL DONE THEN
	SOS T3			;GET ACTUAL CHARACTER COUNT
	MOVEM T3,NTDSC		;STORE COUNT OF DESCRIPTOR
	SKIPE NTOBJ		;HAVE AN OBJECT?
	 RETBAD (DCNX1)		;YES. ILLEGAL SPECIFICATION
	CAILE T3,TSKMAX		;NO, NAME WITHIN RANGE?
	 RETBAD (DCNX12)	;NO. ILLEGAL NAME
	MOVE T1,NTPNT		;GET BP TO DESCRIPTOR
	MOVEM T1,NTDES		;SAVE IT
	RETSKP			;DONE
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- PARSE DCN: EXTENSION

;ROUTINE TO PARSE DCN: EXTENSION. THIS FIELD WILL BE THE TASKNAME

DCNCEX:	CALL COMPUT		;GET COUNT
	MOVE T1,NTCNT		;GET THE COMPUTED COUNT
	SOS T1			;GET ACTUAL CHARACTER COUNT
	CAILE T1,TSKMAX		;WITHING RANGE
	 RETBAD (DCNX12)	;NO. TOO LONG
	MOVEM T1,NTNMC		;SAVE IT
	MOVE T1,NTPNT		;GET ADDRESS OF NAME BLOCK
	AOS T1			;OFFSET TO ACTUAL STRING
	HRLI T1,(<POINT 7,>)	;MAKE BP TO IT
	MOVEM T1,NTNAM		;SAVE IT
	RETSKP			;AND DONE


;	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- DCNGOK

; Called from DCNOPN to see if user has permission (from ACJ) to open a
;  connection to the node specified.  Puts nodename in AC1,AC2

DCNGOK:	SAVEAC <T5,PRT,SAB>
	SKIPLE T2,NTHSC		; Have a host name?
	IFSKP.
	  DMOVE T1,OURNAM	; No, copy our host name from STG
	ELSE.
	  MOVE T5,NTHST		; Pointer to host name string
	  MOVE PRT,[POINT 7,T1]	; Destination is T1
	  MOVE SAB,NTHSC	; Count of bytes read from user
	  CAILE SAB,6		; If it won't fit in a word
	   MOVEI SAB,6		;  make it
	  SETZB T1,T2		; Start clean
	  DO.
	    ILDB T3,T5		; Copy from source
	    IDPB T3,PRT		;  to destination
	    SOJG SAB,TOP.	;  until done
	  ENDDO.
	ENDIF.
	GTOKM (.GODNA,<T1,T2>,[RET]) ; See if ok with the ACJ?
	RETSKP
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- INSERT OBJECT TYPE AND NAME

;PLACE OBJECT TYPE AND NAME IN PROCESS DESCRIPTOR BLOCKS
;ACCEPTS:	T1/ ADDRESS OF CONNECT BLOCK
;RETURNS:	+1

OBJNAM:	SAVEAC <F1>
	MOVE F1,T1		;PRESERVE CB ADDRESS
	MOVEI T1,PB.LEN		;GET LENGTH OF PROCESS DESCRIPTOR BLOCK
	STOR T1,PBSIZ,+CB.DST(F1)  ;PUT LENGTH IN DESTINATION BLOCK
	STOR T1,PBSIZ,+CB.SRC(F1)  ;PUT LENGTH IN SOURCE BLOCK
	SKIPG T2,NTOBJ		;GET OBJECT TYPE
	JRST NOOOBJ		;NONE GIVEN
	STOR T2,PBOBJ,+CB.DST(F1)  ;PUT NON-ZERO OBJECT DESTINATION BLOCK
	MOVEI T1,FRM.0		;FORMAT 0
	STOR T1,PBFOR,+CB.DST(F1)  ;PUT OBJECT-ONLY FORMAT TYPE IN DEST. BLOCK
	CALL BLDSRC		; Build source process name
	RET

;Not format 0 - use format 1 for destination

NOOOBJ:	MOVEI T1,FRM.1		; Use format 1
	STOR T1,PBFOR,+CB.DST(F1) ; for destination
	XMOVEI T1,CB.DST(F1)  	;GET PLACE
	ADDI T1,PB.NAM		; TO PUT NAME
	CAME DEV,[-1,,SRVDTB]	; For SRV link?
	IFSKP.
	  MOVE T2,NTNAM		; Yes, GET BP TO TASK NAME
	  HRRZ T3,NTNMC		;GET BYTE COUNT OF NAME STRING
	ELSE.
	  MOVE T2,NTDES		;No then get byte pointer to descriptor
	  MOVE T3,NTDSC		; and count of descriptor
	ENDIF.
	STOR T3,PBNCT,+CB.DST(F1)  ;PUT BYTE COUNT IN CB
	CALL MOVST1		;MOVE NAME TO DESTINATION BLOCK
	CALL BLDSRC		; Build the source ID
	RET
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- BUILD SPN

;This will build either a format 0 or 1 SPN if the GTJFN is for a passive (SRV)
;link or if a username was supplied to the GTJFN for an active (DCN) link.
;If no username was supplied for an active link a format 2 SPN will be
;constructed containing the fork number, job number, and LOGINID.  This will
;send the necessary information to allow proxy access on a VMS system.

BLDSRC:	STKVAR <SPTR,DPTR>	; Place for byte pointers
	CAMN DEV,[-1,,SRVDTB]	; Is it a passive link ?
	 JRST BLDSR1		; Yes, then no special SPN
	MOVEI T2,.PFUDT		; Username indicator
	LOAD T3,FLATL,(JFN)	; Attribute list address
	CALL GETATR		; See if a username was supplied
	 JRST BLDSR2		; None supplied, create format 2 SPN

; A name was supplied so source process name will be format 0 or 1

BLDSR1:	SKIPE T1,NTOBJ		; Object specified?
	IFSKP.
	  XMOVEI T1,CB.SRC(F1)	; No, then use format 1. Get place
	  ADDI T1,PB.NAM	;  to put name
	  MOVE T2,NTNAM		; Get BP to task name
	  HRRZ T3,NTNMC		; Get byte count of name
	  STOR T3,PBNCT,+CB.SRC(F1) ; Put byte count in
	  CALL MOVST1		; Move name to source block
	  MOVEI T1,FRM.1	; Format 1 for source process name
	ELSE.
	  STOR T1,PBOBJ,+CB.SRC(F1) ;Put non-zero object source block
	  MOVEI T1,FRM.0	; and format 0
	ENDIF.
	JRST BLDSR5

; No user name supplied, then use format 2

BLDSR2:	SKIPLE T1,NTNMC		; Did user supply a taskname?
	 JRST BLDSR1		;  Yes, use it then
	MOVE T1,JOBNO		; Get our job number	  
	STOR T1,PBUSR,+CB.SRC(F1) ; Save job number as user code
	MOVE T1,FORKX		; Get fork number
	STOR T1,PBGRP,+CB.SRC(F1) ; and send as group code
	XMOVEI T3,USRNAM+1	; Pointer to current users name
	MOVE T1,[POINT 7,(T3)]	; Source byte pointer
	MOVEM T1,SPTR
	XMOVEI T4,CB.SRC(F1)	; Get place
	ADDI T4,PB.NAM		;  to put name
	MOVE T1,[POINT 8,(T4)]	; Form 8-bit byte pointer to destination
	MOVEM T1,DPTR		; Save it
	MOVSI T2,-^D12		; Maximum length of string

BLDSR3:	ILDB T1,SPTR		; Get a byte
	JUMPE T1,BLDSR4
	IDPB T1,DPTR		; Store it
	AOBJN T2,BLDSR3		; Do all bytes
BLDSR4:	HRRZ T2,T2
	STOR T2,PBNCT,+CB.SRC(F1) ; and save count
	MOVEI T1,FRM.2
BLDSR5:	STOR T1,PBFOR,+CB.SRC(F1) ;Put format type in source block
	RET
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- MOVE STRING


;MOVE STRING TO ADDRESS
;CALL MOVST1
;ACCEPTS:	T1/ DESTINATION ADDRESS
;		T2/ BP TO SOURCE STRING
;		T3/ BYTE COUNT

MOVST1:	STKVAR <MVSPTR>		;PLACE FOR DESTINATION BP
	MOVE T4,[POINT 8,0(T1)]	;FORM 8-BIT BYTE POINTER TO DESTINATION
	MOVEM T4,MVSPTR		;SAVE IT
MOVST2:	ILDB T4,T2		;GET A BYTE
	IDPB T4,MVSPTR		;STORE IT
	SOJG T3,MOVST2		;DO ALL BYTES
	RET			;DONE

	ENDSV.			;END STKVAR
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- GENERATE UNIQUE TASK NAME

;Generate a unique task name for OPENF if one is not supplied by user
;but a taskname is needed.

GENUNM:	XMOVEI T4,NTRNM		; Place to write unique taskname
	HRLZI T1,(<POINT 7,(T4)>) ; Make a byte pointer to it
	AOS T2,LASTSK		; Use next task number
	MOVEI T3,^D10		; Decimal radix
	NOUT			; Convert to ASCII string
	 TRN
	SETZ T2,
	ILDB T2,T1		; Write a null to terminate
	MOVE T1,[POINT 7,NTRNM]	; Make a pointer to unique names
	MOVEM T1,NTNAM		;  and remember it
	MOVEI T3,^D12		; The maximum length is 12
	CALL CMPLEN		; Get the actual count
	SOS T3			; Get actual count of bytes written
	HRROM T3,NTNMC		; Save count of characters in name
	RET
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- TRVARS -- INITIALIZE TRVARS

;CALL SCZROT
;ZERO THE LOCATIONS USED FOR FILE SPEC PARSING
;RETURNS:	+1

SCZROT:	SETZM NTCNT
	SETZM NTPNT
	SETZM NTOBJ
	SETZM NTNMC
	SETZM NTNAM
	SETZM NTDSC
	SETZM NTDES
	SETZM NTHST
	SETZM NTHSC
	SETZM NTRNM
	RET

	ENDTV. 			;END TRVAR FROM DCNOPN. (& FRIENDS)
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- NO TRVARS -- SET UP CONNECT BLOCK DURING OPENF

;ACCEPTS:	T1/ DECNET36 FUNCTION CODE (ENTER ACTIVE OR ENTER PASSIVE)
;RETURNS:	+1 FAILED
;		+2 WITH CONNECT BLOCK IN SAB SET UP

OPNINI:	STKVAR <TYPE>
	MOVEM T1,TYPE		;SAVE ENTRY TYPE
	CALL SCZROT		;ZERO TEMPORARY STORAGE AREA
	MOVEI T1,CB.LEN		;GET LENGTH OF A CONNECT BLOCK
	CALLX (XCDSEC,DNGWDZ)	;GET SPACE
	 RETBAD (MONX07)	;FAILED, RETURN NO SPACE ERROR
	STOR T1,SACBP,(SAB)	;PUT ADDRESS OF CONNECT BLOCK IN ARGUMENT BLOCK
	SETONE SAKCB,(SAB)	;KEEP THE CB AROUND
	MOVE T1,TYPE		;GET FUNCTION CODE
	STOR T1,SAAFN,(SAB)	;PUT IT IN ARGUMENT BLOCK
	TQZE <RNDF>		;WANT APPEND?
	TQO <WRTF>		;YES. FORCE ON WRITE THEN
	TQNN <READF,WRTF>	;WANT SOME FORM OF ACCESS?
	RETBAD (OPNX14)		;NO. ILLEGAL OPEN
	LDB T2,PBYTSZ		;LOOK AT REQUESTED BYTE SIZE
	CAIE T2,10		;BYTES?
	CAIN T2,7		;OR ASCII?
	JRST BYTGUD		;YES. ACCEPTS IT
	CAIE T2,44		;-10 WORD MODE?
	RETBAD (SFBSX2)		;NO. ILLEGAL BYTE SIZE
BYTGUD:	LOAD T2,DCCUR		;GET # OF CURRENT LINKS
	LOAD T4,DCMAX		;GET MAX COUNT ALLOWED
	CAMGE T2,T4		;ALLOWED TO MAKE ANOTHER LINK?
	RETSKP			;YES, OK
	MOVE T3,CAPENB		;NO, GET CAPS
	CAIG T2,MAXPRT          ;Up to max ports allocated?
	TXNN T3,SC%WHL!SC%OPR	;No, A WHOPPER?
	RETBAD (DCNX5)		;NO, RETURN ERROR
	RETSKP			;YES, OK

	ENDSV.			;END STKVAR FOR OPNINI
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- NO TRVARS -- FINISH OPENF

;SAVE FORK NUMBER AND OPEN TYPE AND CLEAN UP
;ACCEPTS:	T1/ ENTRY INDICATOR
;		SAB, SJB, SET UP PER CALL SCJLOD
;		JFN SET UP PER CHKJFN
;		PRT/ Port number from SCLINK
;RETURNS:	+1 
;		PRT/ Pointer to port block

OPNFIN:	STKVAR <PRTTYP>
	MOVEM T1,PRTTYP		;Save type DCN/SRV
	LOAD PRT,SAACH,(SAB)	;GET PORT # ASSIGNED
	STOR PRT,FLLNK,(JFN)	;PUT IT IN JFN
	OPSTR <CAMLE PRT,>,SJMXP,(SJB)	;Is the port number higher than we can
	 RETBAD (MONX07)	; handle?  If yes, then error
	OPSTR <ADD PRT,>,SJPRT,(SJB)	;Get pointer port table
	SKIPE T1,(PRT)		;Do we have a port block?
	IFSKP.
	  MOVEI T1,PT.LEN	;Length of a port block
	  CALLX (XCDSEC,DNGWDS)
	   RETBAD (MONX07)
	  MOVEM T1,(PRT)	;Save address of port block
	ENDIF.
	MOVE PRT,T1		;Get port block address
	STOR DEV,PTDEV,(PRT)	;WACCPT needs this for implicit accept on SOUTR
	STOR JFN,PTJFN,(PRT)	;PUT JFN IN PORT TABLE
	MOVE T1,PRTTYP		;Get type
	STOR T1,PTTYP,(PRT)	;PUT ENTRY TYPE INTO PORT BLOCK
	MOVE T1,FORKX		;GET OUR NUMBER
	STOR T1,PTFRK,(PRT)	;PUT FORK NUMBER IN PORT TABLE
	LOAD T1,SAAST,(SAB)	;GET LINK STATUS 
	STOR T1,PTSTS,(PRT)	;PUT INTO PORT BLOCK
	INCR DCCUR		;ACCOUNT FOR THIS OPENING
	RETSKP

;	SUBTTL OPNFAI - DCN or SRV open failed after successfull call to
;			SCLINK
;Call:
;	T1/ error code
;	

OPNFAI:	STKVAR <ERRCD>
	MOVEM T1,ERRCD
	HRRZI T1,.NSFRL		;Release channel - no port to release
	CALL CLZPRT		;Close port
	 TRN
	MOVE T1,ERRCD		;Recover error code
	CALLRET DEASWD		;Now, deallocate windows, and return failure
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- NO TRVARS -- COMPUTE LENGTH OF STRING 

;CMPLEN - ROUTINE TO COMPUTE LENGTH OF STRINGS
;ACCEPTS:	T1/ POINTER TO START OF STRING
;		T3/ MAX NUMBER OF BYTES IN STRING
;RETURNS:	 +1 WITH T3/ ACTUAL NUMBER OF BYTES IN STRING

CMPLEN:	STKVAR <CPLCNT>
	MOVEM T3,CPLCNT		;STARTING COUNT
	MOVE T2,[POINT 0,0,2]	;GET DUMMY POINTER
	SETZ T4,
	SIN%			;FIND NUMBER OF USEFUL BYTES IN THE STRING
	SUB T3,CPLCNT		;COMPUTE
	MOVNS T3		; COUNT
	RET			;DONE

	ENDSV.			;END STKVAR
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- NO TRVARS -- OBJECT TABLE INITIALIZATION

;ALL OF THIS CODE IS UNSUITABLE FOR EXTENDED ADDRESSING. SINCE 
;OBJECT NAMES CAN RESIDE IN SWAPPABLE FREE SPACE, OBJTBL
;NEEDS TO HAVE 36 BIT ADDRESSES POINTING TO THE STRINGS. ALSO,
;A REPLACEMENT FOR TBLUK IS NEEDED WHICH WILL DO LOOK UP, DELETE
;AND ADD ENTRIES TO SUCH AN "EXTENDED" TABLE. FOR THE TIME BEING,
;HOWEVER, THE CODE AS WRITTEN WILL SUFFICE.

;ROUTINE TO INITIALIZE THE OBJECT TABLE FOR THE MONITOR.

	SWAPCD

OBJINI::MOVE T1,[OBJPRO,,OBJTBL]
	BLT T1,OBJTBL+OBJENT	;INIT THE TABLE
	RET			;AND DONE

;THIS TABLE SHOULD BE MOVED TO STG SOMEDAY*****************
;PROTOTYPE OBJECT TABLE

OBJPRO:	OBJENT,,OBJMAX
	[ASCIZ /ATS/],,3
	[ASCIZ /FAL/],,21
	[ASCIZ /NCU/],,23
	[ASCIZ /NRM/],,7
	[ASCIZ /TASK/],,0
	[ASCIZ /X25GAT/],,37
	[ASCIZ /X25HST/],,44
	[ASCIZ /X29SRV/],,42
OBJENT==.-OBJPRO-1		;# OF ENTRIES
	SUBTTL COMMON ROUTINES FOR GTJFN & OPENF -- NO TRVARS -- OBJECT LOOKUP

;ROUTINE TO LOOK UP AN OBJECT NAME IN THE SYSTEM OBJECT TABLES
;ACCEPTS:	T1/ POINTER TO TEST OBJECT NAME
;RETURNS:	+1 NOT FOUND. NO SUCH OBJECT
;		+2 OBJECT FOUND
;			T1/ OBJECT NUMBER

OBJLOK:	ASUBR <OBJPTR>		;SAVE POINTER
	MOVE T2,T1		;COPY POINTER
	MOVE T1,[OBJTBL]	;GET THE OBJECT TABLE
	TBLUK%			;LOOK UP THE OBJECT
	TXNN T2,TL%EXM		;FOUND IT?
	JRST OBJLO1		;NO. GO CHECK FOR NUMBER
	HRRZ T1,0(T1)		;YES. GET OBJECT NUMBER
	RETSKP			;AND RETURN WITH IT

;TBLUK DIDNT'T FIND IT. SEE IF IT IS NUMERIC

OBJLO1:	SETZ T1,		;GET AN ACCUMULATOR
OBJLO2:	ILDB T2,OBJPTR		;GET NEXT BYTE
	JUMPE T2,OBJLO3		;IF AT THE END, GOOD NUMBER
	CAIL T2,"0"		;A VALID NUMBER
	CAILE T2,"9"		;STILL?
	RET			;NO. NOT A VALID NUMBER
	IMULI T1,^D10		;YES. ADJUST ACCUMULATOR
	ADDI T1,-"0"(T2)	;AND ADD IN NEW QUANTITY
	CAILE T1,OBJMAX		;STILL VALID?
	RET			;NO. GIVE AN ERROR
	JRST OBJLO2		;GO DO ALL OF IT
OBJLO3:	CAIN T1,^D23		;IS IT NRT'S NUMBER ?
	CAME DEV,[-1,,SRVDTB]	;NO. IS IT A PASSIVE LINK ?
	RETSKP			;NO. IT IS O.K.
	RET			;YES. IT IS NRT'S NUMBER & PASSIVE. BAD.

	ENDAS.			;END ASUBR
	SUBTTL ATTRIBUTE ROUTINES -- VERIFY ATTRIBUTE

;ROUTINE CALLED FROM GTJFN TO VERIFY AN ATTRIBUTE
;CALL @ATRD(DEV)
;ACCEPTS:	T1/ BLOCK ADDRESS
;		T2/ ATTRIBUTE VALUE
;RETURNS:	+1 INVALID. ERROR CODE IN T1
;		+2 GOOD ATTRIBUTE

NETATR:	ACVAR <W1>		;GET A WORK REG
	MOVSI T3,-MAXNTA	;# OF ATTRIBUTES IN TABLE
NETAT2:	OPSTR <CAMN T2,>,NTATR,ATTRTB(T3) ;IS THIS IT?
	IFSKP.
	  AOBJN T3,NETAT2	;NO. DO ALL OF THEM
	  RETBAD (GJFX49) 	;COULDN'T FIND IT
	ENDIF.
	LOAD W1,NTATB,ATTRTB(T3) ;FOUND IT. GET BINARY BIT
	LOAD T2,NTATC,ATTRTB(T3) ;GET MAX COUNT
	SKIPE W1		;BINARY?
	IMULI T2,3		;YES. ADJUST COUNT
	HRLI T1,(<POINT 7,0,34>) ;FORM A BYTE POINTER
CNTLOP:	ILDB T4,T1		;GET NEXT BYTE
	JUMPE T4,NETAT1		;IF NULL, DONE
	SOJL T2,[RETBAD (GJFX50)] ;ATTRIBUTE TOO LONG
	JUMPE W1,CNTLOP		;IF NOT BINARY, GO GET MORE
	CAIL T4,"0"		;IS BINARY. CHECK RANGE
	CAILE T4,"7"		;""
	SKIPA
	JRST CNTLOP		;GOOD RANGE
	RETBAD (GJFX50)		;INVALID
NETAT1:	LOAD T2,NTATE,ATTRTB(T3) ;GET EXCLUSION PARTNER
	SKIPE T2		;HAVE ONE?
	CALL FNDATR		;YES. GO LOOK FOR IT
	 RETSKP			;NOT THERE. ERGO, GOOD ARG
	RETBAD (GJFX45)		;CONFLICT

	ENDAV.			;END ACVAR
	SUBTTL ATTRIBUTE ROUTINES -- FIND AND PARSE ARBITRARY ATTRIBUTES

;FIND ATTRIBUTE:
;ACCEPTS:	T2/ PREFIX VALUE
;RETURNS:	+1/ NO SUCH PREFIX
;		+2/ FOUND. T3=POINTER TO VALUE STRING

FNDATR:	LOAD T3,FLATL,(JFN)	;GET LIST OF ATTRIBUTES
	CALLRET GETATR		;GO FIND ATTRIBUTE
	SUBTTL ATTRIBUTE ROUTINES -- FIND AN ARBITRARY ATTRIBUTE

;GETATR - ROUTINE TO FIND AN ATTRIBUTE
;
;ACCEPTS IN T2/	PREFIX VALUE
;	    T3/	ADDRESS OF ATTRIBUTE LIST
;		CALL GETATR
;RETURNS: +1	 FAILED, NO SUCH PREFIX
;	  +2	SUCCESS, WITH T3/ POINTER TO VALUE STRING

GETATR:	JUMPE T3,R		;IF NO MORE, ALL DONE
	OPSTR <CAME T2,>,PRFXV,(T3) ;IS THIS THE ONE WE WANT
	JRST [	LOAD T3,PRFXL,(T3) ;NO. GET NEXT
		JRST GETATR]	;AND LOOK AT IT
	MOVEI T3,1(T3)		;GET POINTER TO BLCOK
	RETSKP			;AND SAY WE FOUND IT
	SUBTTL ATTRIBUTE ROUTINES -- INSERT ATTRIBUTES INTO CONNECT BLOCK

;CALL INSATR 
;INSERT USERID, PASSWORD, ACCOUNT, OPTIONAL DATA INTO CONNECT BLOCK
;ACCEPTS:	T1/ ADDRESS OF CONNECT BLOCK
;		JFN/ JFN
;RETURNS:	+1 

INSATR:	ACVAR <CBADR>
	STKVAR <INAATR,INACNT>
	MOVE CBADR,T1		;PRESERVE CB ADDRESS
	LOAD T2,FLATL,(JFN)	;GET ATTRIBUTE LIST ADDRESS
	MOVEM T2,INAATR		;SAVE IT
	MOVEI T2,.PFUDT		;USER I.D. INDICATOR
	MOVE T3,INAATR		;GET ATTRIBUTE LIST ADDRESS
	CALL GETATR		;IS THERE A USERID?
	IFSKP.			;YES
	  XMOVEI T1,CB.UID(CBADR)  ;GET CB ADDRESS FOR USERID
	  CALL MOVATR		;MOVE USERID TO CB
	  STOR T4,CBUCT,(CBADR) ;PUT BYTE COUNT OF USERID IN CB
	ELSE.			;NO
	  SETZRO CBUID,(CBADR) ;SAY NO USERID
	  SETZRO CBUCT,(CBADR) ; AND 0 COUNT
	ENDIF.
DOSPW1:	MOVEI T2,.PFPWD		;GET ASCII PASSWORD INDICATOR
	MOVE T3,INAATR		;GET ATTRIBUTE LIST ADDRESS
	CALL GETATR		;IS THERE AN ASCII PASSWORD?
	IFSKP.			;YES
	   XMOVEI T1,CB.PSW(CBADR)  ;GET CB LOCATION FOR PASSWORD
	   CALL MOVATR		;MOVE PASSWORD TO CB
	   STOR T4,CBPCT,(CBADR)  ;PUT BYTE COUNT OF PASSWORD IN CB
	ELSE.			;NO
	   MOVEI T2,.PFBPW	;GET BINARY PASSWORD INDICATOR
	   MOVE T3,INAATR	;GET ATTRIBUTE LIST ADDRESS
	   CALL GETATR		;IS THERE A BINARY PASSWORD?
	   IFSKP.		;YES
	      XMOVEI T1,CB.PSW(CBADR)  ;GET CB LOCATION FOR PASSWORD
	      CALL BININ	;YES. INSERT BINARY VALUE OF PASSWORD
	      STOR T4,CBPCT,(CBADR)  ;PUT BYTE COUNT OF PASSWORD IN CB
	   ELSE.		;NO
	      SETZRO CBPSW,(CBADR)  ;SAY SO
	      SETZRO CBPCT,(CBADR)  ; AND 0 COUNT
	   ENDIF.
	ENDIF.
DOACT:	MOVEI T2,.PFACN		;GET ACCOUNT INDICATOR
	MOVE T3,INAATR		;GET ATTRIBUTE LIST ADDRESS
	CALL GETATR		;IS THERE AN ACCOUNT?
	IFSKP.			;YES
	   XMOVEI T1,CB.ACC(CBADR)  ;GET CB LOCATION FOR ACCOUNT
	   CALL MOVATR		;MOVE ACCOUNT STRING TO CB
	   STOR T4,CBACT,(CBADR)  ;PUT BYTE COUNT OF ACCOUNT STRING IN CB
	ELSE.			;NO
	   SETZRO CBACC,(CBADR)	;SAY SO
	   SETZRO CBACT,(CBADR)	; AND 0 BYTE COUNT
	ENDIF.
DOOPT1:	MOVEI T2,.PFOPT		;GET ASCII OPTIONAL DATA INDICATOR
	MOVE T3,INAATR		;GET ATTRIBUTE LIST ADDRESS
	CALL GETATR		;IS THERE ASCII OPTIONAL DATA?
	IFSKP.			;YES
	   XMOVEI T1,CB.UDA(CBADR)  ;GET CB LOCATION FOR OPTIONAL DATA
	   CALL MOVATR		;MOVE ASCII OPTIONAL DATA TO CB
	   STOR T4,CBCCT,(CBADR)  ;PUT BYTE COUNT IN CB
	ELSE.			;NO
	   MOVEI T2,.PFBOP	;GET BINARY OPTIONAL DATA INDICATOR
	   MOVE T3,INAATR	;GET ATTRIBUTE LIST ADDRESS
	   CALL GETATR		;IS THERE BINARY OPTIONAL DATA?
	   IFSKP.		;YES
	      XMOVEI T1,CB.UDA(CBADR)  ;GET CB LOCATION FOR OPTIONAL DATA
	      CALL BININ	;INSERT BINARY OPTIONAL DATA
	      STOR T4,CBCCT,(CBADR)  ;PUT BYTE COUNT IN CB
	   ELSE.		;NO
	      SETZRO CBUDA,(CBADR)  ;SAY SO
	      SETZRO CBCCT,(CBADR)  ; AND 0 COUNT
	   ENDIF.
	ENDIF.
	RET

	ENDAV.			;END ACVAR
	ENDSV.			;END STKVAR
	SUBTTL ATTRIBUTE ROUTINES -- MOVE ATTRIBUTE STRING TO CONNECT BLOCK

;CALL MOVATR
;MOVE AN ATTRIBUTE STRING TO THE CB
;ACCEPTS:	T1/ DESTINATION STRING ADDRESS
;		T3/ ADDRESS OF ATTRIBUTE LIST
;RETURNS:	+1  T4/ COUNT OF BYTES

MOVATR:	ACVAR <SRC,DST>		;GET ACS TO USE
	MOVE DST,[POINT 8,(T1)]	;MAKE BP TO DESTINATION
	MOVE SRC,[POINT 7,(T3)]	;MAKE BP TO SOURCE
	SETZ T4,		;INIT BYTE COUNT
MOVAT1:	ILDB T2,SRC		;GET A BYTE
	SKIPG T2		;ARE WE DONE?
	RET			;YES
	AOS T4			;NO, ACCOUNT FOR THIS BYTE
	IDPB T2,DST		;PUT IT IN CB
	JRST MOVAT1		;GO GET ANOTHER
	ENDAV.			;END ACVAR
	SUBTTL ATTRIBUTE ROUTINES -- PUT A BINARY ATTRIBUTE IN THE CONNECT BLOCK

;CALL BININ
;ACCEPTS:	T1/ DESTINATION ADDRESS
;		T3/ CURRENT ADDRESS OF ATTRIBUTE
;RETURNS:	+1  WITH T4/ COUNT OF BYTES MOVED

BININ:	ACVAR <CNT,DTM,DST>
	SETZB T2,T4
	MOVE DST,[POINT 8,(T1)]  ;MAKE BP TO DESTINATION
	HRLI T3,(<POINT 7,>)	;FORM A BYTE POINTER TO ATTRIBUTE
BININ1:	MOVSI CNT,-3		;DO 3 BYTES
	SETZ T2,		;AN ACCUMULATOR
BININ2:	CALL BINXT		;GET NEXT BYTE
	 JRST BININ3		;DONE
	LSH T2,3		;ADJUST ACCUMULATOR
	ADDI T2,-"0"(DTM)	;PUT IN NEXT BYTE
	AOBJN CNT,BININ2	;DO AN OCTET
BININ3:	TRNN CNT,-1		;FOUND ANY?
	RET			;NO. ALL DONE
	IDPB T2,DST		;YES, PUT IT IN
	AOS T4			;ONE MORE
	JUMPGE CNT,BININ1	;IF MORE TO DO, DO THEM
	RET			;AND DONE

BINXT:	ILDB DTM,T3		;GET NEXT BYTE
	JUMPE DTM,R		;IF THE NULL, ALL DONE
	RETSKP			;A VALID BYTE
	ENDAV.			;END ACVAR
	SUBTTL WINDOW ROUTINES -- DEALLOCATE WINDOW PAGES
;Routine to deassign window pages from a JFN.
;CALL DEASWD with:
;	JFN set up
;Returns +1 always with T1 preserved.
DEASWD:	SAVEAC <T1>
	HRRZ T1,FILWND(JFN)	;Get the first window page
	SKIPE T1		;Do we have one ?
	CALL RELPAG		;Yes, deallocate it.
	HLRZ T1,FILWND(JFN)	;Get the other window page
	SKIPE T1		;Do we have it ?
	 CALLRET RELPAG		;Yes, deallocate it.
	RET
	SUBTTL WINDOW ROUTINES -- ALLOCATE WINDOW PAGES
;ROUTINE TO ASSIGN WINDOW PAGES TO A JFN.
;INITIALIZE SOME FIELDS IN THE JFN BLOCK.
;CALL ASGWDW
;ACCEPTS:	NORMAL FILE SYSTEM REGISTER (JFN,ETC...)
;RETURNS:	+1	FAILED
;		+2	SUCCESS.

ASGWDW:	SETZM FILWND(JFN)
	SETZM FILBCT(JFN)	;AND CLEAR COUNTS
	TQNN <READF>		;WANT READ ON THIS FILE?
	 JRST ASGWRT		;NO. TRY WRITE
	CALL ASGPAG		;GET A JSB PAGE
	 RETBAD (MONX02)	;COULDN'T
	HRRM T1,FILWND(JFN)	;SAVE WINDOW PAGE
	SETZM FILBNI(JFN)	;INPUT BYTE NUMBER IS ZERO
	SETZM FILBCI(JFN)	;WINDOW IS EMPTY
	SETZM FILLEN(JFN)	;NOTHING HERE
ASGWRT:	TQNN <WRTF>		;WANT WRITE
	RETSKP			;NO ALL DONE
	CALL ASGPAG		;GET A PAGE FOR OUTPUT
	IFNSK.
	  SKIPE T1,FILWND(JFN) 	;FAILED. HAVE READ WINDOW?
	  CALL RELPAG		;RELEASE THE INPUT PAGE
	  SETZM FILWND(JFN) 	;NOTE NO PAGE WAS ASSIGNED
	  SETZM FILBFI(JFN) 	;PREVENT RELEASE OF FREE SPACE BY RLJFN
	  RETBAD (MONX02)  	;AND FAIL
	ENDIF.
	HRLM T1,FILWND(JFN)	;STORE WINDOW
	LDB T3,PBYTSZ		;GET BYTE SIZE
	CALL MAKPTR		;(T1,T3/T1,T2) GET POINTER AND BUFFER SIZE
	MOVEM T1,FILBFO(JFN)	;OUTPUT POINTER
	MOVEM T2,FILBCO(JFN)	;BUFFER SIZE (IN BYTES)
	SETZM FILBNO(JFN)	;NO BYTES OUTPUT YET.
	RETSKP			;DONE.
	SUBTTL WINDOW ROUTINES -- MAKE BYTE POINTER AND COUNT

;CALL MAKPTR
;ACCEPTS:	T1/ WINDOW ADDRESS
;		T3/ BYTE SIZE
;RETURNS:	+1
;		T1/ BYTE POINTER
;		T2/ COUNT
;		T3/ BYTE SIZE
MAKPTR:	MOVE T4,T3		;SAVE IT
	IORI T3,4400		;MAKE A BYTE POINTER
	DPB T3,[POINT 12,T1,11]
	MOVEI T2,44		;BITS IN A WORD
	IDIVI T2,0(T4)		;COMPUTE BYTES IN A WORD
	LSH T2,PGSFT		;COMPUTE BYTES IN A PAGE
	MOVE T3,T4		;RESTORE IT
	RET			;AND DONE
	SUBTTL CLOSF -- DISPATCH ON STATE OF THE LINK

NETCLZ:	STKVAR <OLDLFW>
	JE FLLNK,(JFN),RSKP	;JFN STILL HAVE A PORT?
	CALL SCJLOD		;SET UP SAB AND SJB AND PRT
	 RETBAD ()		;FAILED
	CALL GETSTS		;GET PORT'S STATUS
	 RETBAD ()  		;FAILED
	HLRZ T1,FILLFW(JFN)	;Pick up flag 0,,share count
	MOVEM T1,OLDLFW
	MOVSI T1,1		;Assure a share count of 1
	IORM T1,FILLFW(JFN)
	SETZRO SASBP,(SAB)	;NO OPTIONAL DATA
	LOAD T2,FLLNK,(JFN)	;GET PORT
	LOAD T4,SAAST,(SAB)	;GET STATUS VARIABLE
	ANDI T4,NSSTA		;JUST THE STATE FIELD
	CALL @CLZSTA-1(T4)	;GO DO THE WORK
	  TRNA
	HRROM OLDLFW		;Remember non-skip return
	MOVE T1,OLDLFW
	HRLM T1,FILLFW(JFN)	;Restore share caller's count
	JUMPL T1,RSKP
	RET

CLZSTA:	IFIW!CLZREL		;CONNECT WAIT
	IFIW!CLZREJ		;CONNECT RECEIVED
	IFIW!CLZREL		;CONNECT SENT
	IFIW!CLZREL		;REJECT
	IFIW!CLZRUN		;RUN
	IFIW!CLZREL		;DISCONNECT RECEIVED
	IFIW!CLZWAT		;DISCONNECT SENT
	IFIW!CLZREL		;DISCONNECT CONFIRMED
	IFIW!CLZREL		;NO CONFIDENCE
	IFIW!CLZREL		;NO LINK
	IFIW!CLZREL		;NO COMMUNICATION
	IFIW!CLZREL		;NO RESOURCES
	SUBTTL CLOSF -- CONNECT RECEIVED STATE

;REJECT THE CONNECTION
;CALL CLZREJ
;ACCEPTS:	T2/ PORT NUMBER
;RETURNS:	+1  FAILED  T1/ ERROR
;		+2  SUCCESS

CLZREJ:	HRROI T1,.NSFRJ		;GET "REJECT" FUNCTION CODE
	CALL CLZPRT		;CLOSE AND RELEASE THE PORT
	 RETBAD ()		;FAILED
	RETSKP			;SUCCEEDED.
	SUBTTL CLOSF -- DISCONNECT SENT STATE

;WAIT FOR A BIT AND TRY AGAIN, UNLESS ABORT FLAG IS SET.
;CALL CLZWAT
;ACCEPTS:	T2/ PORT NUMBER
;RETURNS:	+1  FAILED  T1/ ERROR
;		+2  SUCCESS

CLZWAT:	UMOVE T1,1		;DID USER WANT
	TXNN T1,CZ%ABT		; ABORT ?
	IFSKP.
	  CALLRET CLZREL	;YES. GET RID OF IT.
	ENDIF.
	CALL DNETCL             ;CLEAR OUT ALL REMAINING INPUT
	LOAD T2,FLLNK,(JFN)	;GET THE PORT NUMBER
	HRROI T1,.NSFRL		;GET ABORT CODE
	CALLRET CLZPRT		;GO CLOSE THINGS
	SUBTTL CLOSF -- RUN STATE

;CLOSE A RUNNING LINK
;CALL CLZRUN
;ACCEPTS:	T2/ PORT NUMBER
;RETURNS:	+1  FAILED  T1/ ERROR
;		+2  SUCCESS

CLZRUN:	STKVAR <REASON>
	UMOVE T1,1		;GET USER'S FLAGS
	SETZRO SAAA2,(SAB)	;Set "closed by user" error code
CLZMTO:	STOR T2,SAACH,(SAB)	;Put port in SAB
	TXNN T1,CZ%ABT		;ABORT?
	IFSKP.			;YES
	   HRROI T1,.NSFAB	;GET FUNCTION CODE
	   CALLRET CLZPRT	;CLOSE AND RELEASE PORT
	ENDIF.
	LDB T3,PBYTSZ		;Compute number 
	CALL MAKPTR		; (T1,T3/T1,T2,T3) of bytes
	SUB T2,FILBCO(JFN)	; in output window.
	IFG. T2			;Are there any ?
	  LOAD T1,SAAA2,(SAB)	;Get disconnect reason
	  MOVEM T1,REASON	;Save it from destruction
  	  SETONE SAEOM,(SAB)	;Yes. Mark EOM and
	  CALL OUTRR		; send them off.
	   NOP         		;Ignore failure.
	  MOVE T1,REASON
	  STOR T1,SAAA2,(SAB)	;Restore disconnect reason
	ENDIF.
	HRRZI T1,.NSFSD		;GET SYNCHRONOUS DISCONNECT CODE
	STOR T1,SAAFN,(SAB)	;PUT FUNCTION CODE IN SAB
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 RETBAD ()		;FAILED
	JUMPN T1,R		;  "
	CALL DNETCL             ;CLEAR OUT ALL REMAINING INPUT
	LOAD T2,FLLNK,(JFN)	;GET THE PORT NUMBER
	HRROI T1,.NSFRL		;GET ABORT CODE
	CALLRET CLZPRT		;GO CLOSE THINGS

	ENDSV.
	SUBTTL CLOSF -- THE REST 

;RELEASE THE LINK.
;CALL CLZREL
;ACCEPTS:	T2/ PORT NUMBER
;RETURNS:	+1  FAILED  T1/ ERROR
;		+2  SUCCESS

CLZREL:	HRROI T1,.NSFRL		;GET "RELEASE" FUNCTION CODE
	CALLRET	CLZPRT		;CLOSE AND RELEASE THE PORT
	SUBTTL WAKE UP PROCESSOR

	RESCD			;MUST BE RESIDENT, CAN BE CALLED IN ANY CONTEXT

;ROUTINE CALLED BY SCLINK WHEN SOMETHING "INTERESTING" HAS HAPPENED
;CALL @SAWKA(SAB)
;ACCEPTS:	T1/ OLD STATUS,,PSI MASK
;		T2/ NEW STATUS,,PORT #
;		T3/ SJB
;		T4/ LINK IDENTIFIER
;		T5/ 0,,STATUS CHANGES
;RETURNS:	+1

SCWAKE:	TXNE T1,1B18		;IS THIS LINK BEING BORROWED BY NRT?
	CALLRET NRTWAK		;YES, GIVE NRT THE WAKE
	SAVEAC <SJB,F1,STS>
				;SJB - SJB ADDRESS
				;F1 - ADDRESS OF PORT'S INFO
				;STS - OLD STATUS,,NEW STATUS
	MOVE SJB,T3		;PRESERVE SJB ADDRESS
	HRRZ F1,T2		;GET PORT NUMBER
	OPSTR <CAMLE F1,>,SJMXP,(SJB) ;Outside range of our capabilities?
	 RET			; Yes, then there will be no port block
	OPSTR <ADD F1,>,SJPRT,(SJB) ;Get this port's indirect table entry
	SKIPN F1,(F1)		; and now the port block address
	 RET			; **********
	HLRZ STS,T2		;SAVE NEW STATUS IN RIGHT HALF OF STS
	STOR STS,PTSTS,(F1)	;And in port data base.
	HLL STS,T1		;SAVE OLD STATUS IN LEFT HALF OF STS
	TXNN T5,NSIDA		;INTERRUPT DATA NEWLY AVAILABLE?
	IFSKP.			;YES
	   OPSTR <SKIPG T1,>,PTINT,(F1)	;USER WANT PSI?
	   IFSKP.		;YES
	      SOS T1		;THE REAL CHANNEL
	      LOAD T2,PTFRK,(F1) ;GET FORK NUMBER
	      CALL PSIRQ	;PSI THE USER
	   ENDIF.
	ENDIF.
	TXNN T5,NSNDA		;NORMAL DATA AVAILABLE?
	IFSKP.			;YES
	   TMNE PTPSI,(F1)	;USER ALREADY NOTIFIED?
	   IFSKP.		;NO
	      CALL SCWDAT	;GIVE PSI
	      SETONE PTPSI,(F1)	;SAY WE DID IT
	   ENDIF.
	ENDIF.
	TXNN T5,NSSTA		;DID STATE CHANGE?
	JRST SCWDON		;NO, FINISH
	MOVX T1,NSSTA		;GET MASK FOR LINK STATE
	AND T1,STS		;GET NEW STATE
	CALLRET @SCWSTA-1(T1)	;YES, DO THE RIGHT THING ON STATE CHANGE

SCWSTA:	IFIW!SCWDON		;CONNECT WAIT
	IFIW!SCWCON		;CONNECT RECEIVED
	IFIW!SCWDON		;CONNECT SENT
	IFIW!SCWCON		;REJECT
	IFIW!SCWRUN		;RUN
	IFIW!SCWDAT		;DISCONNECT RECEIVED
	IFIW!SCWDON		;DISCONNECT SENT
	IFIW!SCWDON		;DISCONNECT CONFIRMED
	IFIW!SCWDAT		;NO CONFIDENCE
	IFIW!SCWDAT		;NO LINK
	IFIW!SCWDAT		;NO COMMUNICATION
	IFIW!SCWDAT		;NO RESOURCES
	SUBTTL WAKE UP PROCESSOR -- DATA/DISCONNECT CHANNEL INTERRUPT

;CALL SCWDAT
;GIVE THE USER AN INTERRUPT ON THE DATA/DISCONNECT CHANNEL, IF DESIRED
;ACCEPTS:	F1/ ADDRESS OF PORT INFO
;RETURNS:	+1

SCWDAT:	OPSTR <SKIPG T1,>,PTDAT,(F1)  ;USER WANT PSI?
	CALLRET SCWDON		;NO, FINISH
	SOS T1			;YES, THE REAL CHANNEL
	LOAD T2,PTFRK,(F1)	;GET FORK NUMBER
	CALL PSIRQ		;PSI THE USER
	CALLRET SCWDON		;FINISH
	SUBTTL WAKE UP PROCESSOR -- CONNECT CHANNEL INTERRUPT
;GIVE THE USER AN INTERRUPT ON THE CONNECT CHANNEL, IF DESIRED
;CALL SCWCON
;ACCEPTS:	F1/ ADDRESS OF PORT INFO
;RETURNS:	+1

SCWCON:	OPSTR <SKIPG T1,>,PTCON,(F1)  ;USER WANT PSI?
	CALLRET SCWDON		;NO, DONE
	SOS T1			;YES, THE REAL CHANNEL
	LOAD T2,PTFRK,(F1)	;GET FORK NUMBER
	CALL PSIRQ		;PSI THE USER
	CALLRET SCWDON		;FINISH
	SUBTTL WAKE UP PROCESSOR -- JUST NOW IN RUN STATE

;HERE WHEN NEW STATE IS "RUN"
;CALL SCWRUN
;ACCEPTS:	STS/ OLD STATUS,,NEW STATUS
;		F1/ ADDRESS OF PORT INFO
;RETURNS:	+1

SCWRUN:	SETONE PTLWC,(F1)	;SAY LINK WAS CONNECTED
	HLRZ T1,STS		;GET OLD STATE
	ANDI T1,NSSTA		;ISOLATE STATE FIELD
	CAIE T1,.NSSCS		;PREVIOUS STATE CONNECT SENT?
	CALLRET	SCWDON		;NO, FINISH
	CALLRET SCWCON		;YES, GO GIVE PSI FOR CONNECT CONFIRMED
	SUBTTL WAKE UP PROCESSOR -- EXIT ROUTINE

;EXIT ROUTINE FOR SCWAKE
;CALL SCWDON
;ACCEPTS:	F1/ ADDRESS OF PORT INFO
;RETURNS:	+1

SCWDON:	SETONE PTWAK,(F1)	;NOW WAKING
	SETZRO PTBLK,(F1)	;NO LONGER BLOCKED
	RET
	SUBTTL BLOCK PROCESSOR

;Block routine used by lower layer.
;CALL SCBLOK with
;       T1/ SJB address
;	T2/ Channel #
;	T3/ Address of SAB
;Returns +1 always
SCBLOK:	OPSTR <ADD T2,>,SJPRT,(T1)  ;Slot in port indirect table
	SKIPN T2,(T2)		;Now have port block
	 RET
	SETONE PTBLK,(T2)	;Say now blocking
	TMNE PTWAK,(T2)         ;Fork now waking?
	IFSKP.			
	   SAVEAC <JFN,DEV,STS,SJB> ;NO. SJB = P3 - All these needed by UNLDIS.
	   MOVE T1,FORKX        ;Get current fork number
	   STOR T2,FKST2,(T1)   ;Store addr of port blk for SCJBLK sched test
	   SETONE SABLK,(T3)	;Remember that we blocked
	   LOAD JFN,PTJFN,(T2)	;Get JFN for this link.
	   MOVE DEV,FILDEV(JFN)	;JFN,DEV,STS,P3(=SJB) are
	   MOVE STS,FILSTS(JFN)	; needed for the
	   HRRZ SJB,DEV		; UNLDIS call.
	   XMOVEI T1,SCJBLK	;Get the block routine
	   CALL UNLDIS		;(T1,JFN,DEV,STS,SJB) Unlock JFN and dismiss
 	   NOINT		;Need to match the OKINT in UNLDIS.
	   MOVE T2,FORKX	;Get fork number
	   LOAD T2,FKST2,(T2)   ;Recover pointer to port block
	ENDIF.
	SETZRO <PTWAK,PTBLK>,(T2) ;No longer waking or blocking
	RET

;Scheduler test for block processor.

;T1 contains relative offset in port table

SCJBLK:	LOAD T1,FKST2,(FX)      ;Get pointer to port block
	JE PTBLK,(T1),1(T4)	;Still blocked?
	JRST 0(T4)              ;Yes, non-skip return

	SWAPCD
	SUBTTL INPUT & OUTPUT -- ERROR EXIT 

;The routines following want ERRF to be set on error.
IOERR:	TQO <ERRF>		;Signal error
	RET
	SUBTTL INPUT & OUTPUT  -- SEQUENTIAL INPUT 
;CALL @BIND(DEV)
NETSQI:	TMNN FLLNK,(JFN)	;Verify that port exists
 	JRST IOERR      	;No link index !!
	CALL SCJLOD		;Set up SAB and SJB and PRT
 	 JRST IOERR		;Failed
	LOAD T1,PTSTS,(PRT)	;Get the
	ANDI T1,NSSTA		; state.
	CALL @SQISTA-1(T1)	;Do what needs to be done.
	 RET			; Bad state, leave
	JRST NTSQI1		;Attempt to read some data

;DISPATCH TABLE FOR SEQUENTIAL INPUT.
SQISTA:	IFIW!NTSWAC		;Connect wait - wait for connect, then accept
	IFIW!NTSACC		;Connect received - accept, then do input
	IFIW!RSKP		;Connect sent - lower layer will handle
	IFIW!IOERR 		;Reject 
	IFIW!RSKP		;Run
	IFIW!NTEOF		;Disconnect received - say that we're at EOF
	IFIW!RSKP		;Disconnect sent - lower layer will handle
	IFIW!IOERR 		;Disconnect confirmed - lower layer will notify
	IFIW!IOERR  		;No confidence 
	IFIW!IOERR 		;No link 
	IFIW!IOERR 		;No communication 
	IFIW!IOERR 		;No resources 
	SUBTTL INPUT & OUTPUT  -- SEQUENTIAL INPUT -- CONNECT WAIT STATE
;

NTSWAC:	CALL WACCPT		; Wait for the connect attempt
	 JRST IOERR		; Bad state - return error
	RETSKP			; Connect accepted - get some data

NTSACC:	CALL ACCPT		; We have received a connect, try to accept
	 JRST IOERR		; Link may have failed
	RETSKP			; Running! - try to read some data
	SUBTTL INPUT & OUTPUT  --  CONNECT WAIT STATE
;Wait for connect attempt, then accept it
;CALL WACCPT with
;	PRT set up.
;Returns +1 if error
;Returns +2 if success with connect confirm sent

WACCPT: LOAD T1,PTSTS,(PRT)	;Get the
	ANDI T1,NSSTA		; Present state
	CAIE T1,.NSSCW		;Is it connect wait ?
	IFSKP.
	  CALL IMPWAT		;(JFN,DEV,STS) Yes. Wait.
	   RET			;Failed to revalidate JFN after blocking
	  JRST WACCPT		;Try again.
	ENDIF.
 	CALLRET ACCPT		;Accept the connection - note that if the
				;new state is not connect received, the
				;error will be detected in the accept code.
	SUBTTL INPUT & OUTPUT  --  CONNECT CONFIRM WAIT STATE

; WCCFRM: Wait for connect we sent to be confirmed, and state to go
;   to running.
; Accepts:
;  PRT/ Pointer to current port block
; Returns:
;    +1 Next state was not RN
;    +2 Current state is running
 
WCCFRM:	LOAD T1,PTSTS,(PRT)     ; Get the status word
	ANDI T1,NSSTA           ;   and the current state
	CAIE T1,.NSSCS          ; Is it connect sent?
        IFSKP.                  ; Yes, must block
	  CALL IMPWAT           ; Go wait for a state change
	   RET                  ; JFN was invalid on return from wait
	  JRST WCCFRM           ; Check the state again
        ENDIF.
	CAIE T1,.NSSRN          ; Running?
	 JRST IOERR             ;  No, this is an error
	RETSKP                  ; Otherwise, go buffer the byte
	SUBTTL INPUT & OUTPUT  -- CONNECT RECEIVED STATE
;Accept connection - doing input implicitly accepts the connection.
;Returns +1 - on error
;Returns +2 - Connect successfully accepted

ACCPT:	MOVEI T2,.NSFAC		;Get function code for accept
	STOR T2,SAAFN,(SAB)	;Put it in SAB
	MOVEI T2,5		;Get argument count
	STOR T2,SANAG,(SAB)	; and put it in SAB
	LOAD T1,FLLNK,(JFN)	;Get port
	STOR T1,SAACH,(SAB)	;Put port in SAB
	SETZRO SASBP,(SAB)	;No optional data
	LOAD T1,FLSES,(JFN)	;Get segment size from JFN block
	STOR T1,SAAA2,(SAB)	; and put into SAB
	LOAD T1,FLFCO,(JFN)	;Get flow control option from JFN block
	STOR T1,SAAA3,(SAB)	; and put into SAB
	CALL SCLFNC		;Go do it
	 RET
	JUMPN T1,R		;Failed
	RETSKP
	SUBTTL  INPUT & OUTPUT -- WAIT FOR CONNECT

;Here when blocking is needed during an implicit connect accept
;CALL IMPWAT with 
;	PRT, JFN, DEV, STS set up.
;Returns +1 always.

IMPWAT:	SAVEAC <SJB> 		;This is P3 - needed by UNLDIS
	SETONE PTBLK,(PRT)	;Say now blocking
	TMNE PTWAK,(PRT)	;Fork now waking ?
	IFSKP.
	  MOVE T1,FORKX		;Get current fork number
	  STOR PRT,FKST2,(T1)	;Save pointer to port block for SCJBLK
	  HRRZ SJB,DEV		;No. Set up for UNLDIS
	  XMOVEI T1,SCJBLK	;Blocking routine
	  CALL UNLDIS		;(T1,JFN,DEV,STS,SJB) Go away
	  NOINT			;Needed since UNLDIS goes OKINT
	  CALL SCLFNU		;Validate JFN
	   JRST IOERR		;Couldn't.  Indicate error
	ENDIF.
	SETZRO <PTWAK,PTBLK>,(PRT) ;No longer waking or blocking
	RETSKP
	SUBTTL INPUT & OUTPUT  -- SEQUENTIAL INPUT -- DISCONNECT RECEIVED STATE
NTEOF:	TQO <EOFF>		;Say EOF
	RET			;Done.
	SUBTTL INPUT & OUTPUT  -- SEQUENTIAL INPUT -- RUN STATE AND THE REST
;RETURNS +1 ALWAYS
NTSQI1:	SOSGE FILBCI(JFN)	;Any bytes in window ?
	IFSKP.
	  ILDB T1,FILBFI(JFN)	;Yes. get one.
	  AOS FILBNI(JFN)	;Up the byte number.
	  RET			;Done
	ENDIF.
	SETO T1,		;Block for input
	CALL DNETIN		;Get bytes from network
	IFSKP.     		
	  TQNN <RECF>		;Null record received ?
	  JRST NTSQI1		;No. Got some bytes, get one the right way.
 	  SETZRO PTNRR,(PRT)	;Clear null record received flag.
	  RET 			;Done.
	ENDIF.
	CAIN T1,DESX4		;Error. JFN failed to revalidate after blocking?
	JRST IOERR		;Yes. Bomb out.
	LOAD T1,PTSTS,(PRT)	;Error. Get the
	ANDI T1,NSSTA		; state 
	CALLRET @SQISTA-1(T1)	; and redispatch.
	SUBTTL INPUT & OUTPUT  -- DNETCL - CLEAN OUT ALL REMAINING DECNET INPUT

;CALL DNETCL
;ACCEPTS:	No arguments
;RETURNS:	+1  Always

;DNETCL read all input available, blocking to wait for more, until the logical
;link goes into a state in which input is illegal.  Called from various
;closing routines.

;**; [7242] Add 2 lines at DNETCL:	HMP	17-Feb-86

DNETCL:	TQNN <READF>		;[7242] Open for read?
	 RET			;[7242] No, then don't expect any input
	SETO T1,		;Block if necessary
	CALL DNETIN		;Try to read some more input
	  RET                   ;No more input, return
 	SETZRO PTNRR,(PRT)	;Clear null record received flag, DNETIN won't
	JRST DNETCL		;Succeeded, try to get some more
	SUBTTL INPUT & OUTPUT  -- DNETIN - GET BYTES FROM NETWORK

;CALL DNETIN
;ACCEPTS:	T1/  -1 = WAIT FOR INPUT TO ARRIVE
;		      0 = DON'T WAIT
;RETURNS:	+1  FAILURE, ERROR IN T1
;		+2  SUCCESS

DNETIN:	STOR T1,SAWAI,(SAB)	;SET WAIT FLAG
 	TMNN PTNRR,(PRT) 	;HAVE A NULL RECORD THAT'S NOT YET USED ?
 	IFSKP.
 	  TQO <RECF>		;YES. MARK NULL RECORD
	  SETZRO PTPSI,(PRT)	;CLEAR PSI-PENDING FLAG
 	  RETSKP		;RETURN SUCCESS
 	ENDIF.
	HRRZ T1,FILWND(JFN)	;WINDOW ADDRESS
	LDB T3,PBYTSZ		;BYTE SIZE.
	CALL MAKPTR		;(T1,T3/T1,T2,T3) GET POINTER AND MAX COUNT.
	MOVEM T1,FILBFI(JFN)	;STORE POINTER IN JFN BLOCK.
	STOR T1,SAAA2,(SAB)	;AND TO DECNET-36
	CAIE T3,44		;WORD MODE ?
	IFSKP.
	  IMULI T2,^D9		;YES. COMPUTE # OF 8 BIT BYTES.
	  TRNE T2,1		;ODD NUMBER OF WORDS ?
	  AOS T2		;YES. ONE MORE BYTE.
	  LSH T2,-1
	ENDIF.
 	MOVEM T2,FILBCI(JFN)	;STORE MAX COUNT IN JFN BLOCK FOR NOW.
        STOR T2,SAAA1,(SAB)	;AND TO DECNET-36
	MOVEI T1,4		;NUMBER OF ADDITIONAL
	STOR T1,SANAG,(SAB)	; ARGUMENTS.
	MOVEI T1,.NSFDR		;FUNCTION
	STOR T1,SAAFN,(SAB)	; CODE.
	SETZRO SAEOM,(SAB)	;NEVER DISCARD DATA.
	LOAD T1,FLLNK,(JFN)	;PUT PORT
	STOR T1,SAACH,(SAB)	; NUMBER INTO SAB
	CALL SCLFNC		;GET SOME BYTES FROM DECNET
;[7244] Change 1 line at DNETIN:+30	hmp	17-Feb-86
	 NOP			;[7244]
	JUMPN T1,[SETZM FILBCI(JFN) ;FAILED. SAY NOTHING RECEIVED.
	          SETZRO PTPSI,(PRT) ; AND CLEAR PSI-PENDING FLAG
		  RET]
	LOAD T2,SAAA1,(SAB)	;COMPUTE NUMBER
	EXCH T2,FILBCI(JFN)	; OF BYTES
	SUBM T2,FILBCI(JFN)	;  RECEIVED
	LDB T3,PBYTSZ		;WORD
	CAIE T3,44		; MODE ?
	IFSKP.
	  MOVE T2,FILBCI(JFN) 	;YES. CONVERT TO
	  IDIVI T2,^D9		; NUMBER OF
	  LSH T2,1	 	;  WORDS
	  SKIPE T3		;REMAINDER ?
	  AOS T2		;YES. ONE MORE WORD.
	  MOVEM T2,FILBCI(JFN)	;STASH AWAY THE REAL COUNT
	ENDIF.
	TMNN SAEOM,(SAB)	;WAS END OF MESSAGE DETECTED ?
	IFSKP.
	  SETONE PTEMI,(PRT)	;YES. EOM ARRIVED
	  SKIPE T1,FILBCI(JFN)	;WERE NO BYTES TRANSFERRED ?
	  IFSKP.
	     TQO <RECF>		;YES. MUST BE NULL RECORD. MARK IT
 	     SETONE PTNRR,(PRT) ; AND IN THE PORT DB
	  ENDIF.
	  ADD T1,FILBNI(JFN)	;FILLEN WILL BE THE END OF THIS WINDOW
	ELSE.
	   SETZRO PTEMI,(PRT)	;EOM NOT HERE
	   HRLOI T1,377777      ;FILLEN(JFN) WILL BE VERY LARGE.
	ENDIF.
	MOVEM T1,FILLEN(JFN)	;SET UP FILLEN(JFN)
	SETZRO PTPSI,(PRT)	;CLEAR PSI-PENDING FLAG
	RETSKP
	SUBTTL INPUT & OUTPUT  -- FORCE RECORD OUT

;CALL @RECOUT(DEV)
;RETURNS +2 ON SUCCESS
;RETURNS +1 ON FAILURE - NO ERROR CODE IN AC1 SINCE CALLER FORCES IOX5


	SUBTTL INPUT & OUTPUT  -- SEQUENTIAL OUTPUT

;CALL @BOUT(DEV)
;T1/ BYTE
;RETURNS +1 ALWAYS WITH ERRF SET ON FAILURE.


NETSQR:	SKIPA T2,[-1]		; Indicate SOUTR => End of message
NETSQO:	 SETZ T2,		;  or SOUT => no EOM
	TRVAR <ABYTE,EOFFLG>	;SCJLOD uses the stack...
	MOVEM T2,EOFFLG		;Remember if we need EOM
	MOVEM T1,ABYTE		;Save the possible byte
	TMNN FLLNK,(JFN)	;Verify that port exists
	 JRST IOERR    		;Error.
	CALL SCJLOD		;Set up SAB and SJB and PRT 
 	 JRST IOERR		;Failed
NETSQX:	LOAD T1,PTSTS,(PRT)	;Get the
	ANDI T1,NSSTA		; state and
	CALL @SQOSTA-1(T1)	; dispatch on it
	 RET

NTSQX1:	SKIPN EOFFLG		;Did we want "end of record"?
	 JRST NTSQO1		;No
	SETONE SAEOM,(SAB)	;Yes, say EOM this message
	CALLRET OUTRR		; and send it off. 

NTSQO1:	SOSGE FILBCO(JFN)	;HAVE ANY ROOM ?
	IFSKP.
	   MOVE T1,ABYTE	;YES. GET BACK THE BYTE.
	   IDPB T1,FILBFO(JFN)	;PUT IT IN THE WINDOW.
	   AOS FILBNO(JFN)	;UP THE BYTE NUMBER.
	   RET			;DONE
	ENDIF.
	AOS FILBCO(JFN)		;NO. CORRECT THE COUNT
	SETZRO SAEOM,(SAB)	;SAY NOT EOM THIS TIME.
       	CALL OUTRR		;SEND OFF THIS WINDOW
	 JRST IOERR		;FAILED
	JRST NTSQO1		;TRY IT AGAIN
SQOSTA:	IFIW!WACCPT		; Connect wait - wait for connect, then accept
	IFIW!ACCPT		; Connect received -- accept, then do output
	IFIW!WCCFRM		; Connect sent -- Wait for confirm
	IFIW!IOERR		; Rejected
	IFIW!RSKP		; Running, send the byte
	IFIW!IOERR		; Disconnect received -- other end is gone
	IFIW!IOERR		; Disconnect sent -- bad if we've said done
	IFIW!IOERR		; Disconnect confirmed -- we're closed
	IFIW!IOERR		; No confidence -- forget this
	IFIW!IOERR		; No link
	IFIW!IOERR		; No communication
	IFIW!IOERR		; No resources
 
	SUBTTL INPUT & OUTPUT -- SEND BYTES TO NETWORK

;CALL OUTRR
;RETURNS +2 ON SUCCESS WITH FILBCO & FILBFO RESET.
;RETURNS +1 ON FAILURE

OUTRR:	STKVAR <ERROR>
	SETZM ERROR		;No errors to start with
	HLRZ T1,FILWND(JFN)	;WINDOW PAGE FOR OUTPUT
	LDB T3,PBYTSZ		;BYTE SIZE
	CALL MAKPTR		;(T1,T3/T1,T2,T3) GET POINTER & COUNT
	STOR T1,SAAA2,(SAB)     ;BYTE POINTER TO START OF WINDOW IN SAB
	STOR T1,SABPT,(SAB)
	SUB T2,FILBCO(JFN)	;COMPUTE # OF BYTES TO SEND.
	STOR T2,SABCT,(SAB)
	CAIE T3,44		;36 BIT MODE ?
	IFSKP.
	  IMULI T2,^D9		;YES. NUMBER OF 8 BIT BYTES
	  TRNE T2,1
	  AOS T2
	  LSH T2,-1
	ENDIF.
	STOR T2,SAAA1,(SAB)	; INTO SAB
	LOAD T2,SASLT,(SAB)	; Get slot address
	SETZM (T2)		; Remove SAB
	HLLZ T1,PSIBIP		; Get interrupts in progress
	TLZ T1,37777		; Keep channel in progress bits only
	JFFO T1,OUTRR1		; See which one if any
	SETZ T2,		; No interrupts are active
OUTRR1: MOVE T1,PSBSAB		; Get indirect table pointer
	ADD T1,T2		; Index to slot address
	ADDI T1,ST.LEN		; Offset to active portion
	MOVEM SAB,(T1)		;  and save SAB address in the "active" slot
	SETONE SAWAI,(SAB)	;WAIT FOR COMPLETION
	MOVEI T1,4		;We are supplying 4 arguments to SCLINK
	STOR T1,SANAG,(SAB)	;
	MOVEI T1,.NSFDS		;SET FUNCTION
	STOR T1,SAAFN,(SAB)	; CODE
	LOAD T1,FLLNK,(JFN)	;PUT PORT
	STOR T1,SAACH,(SAB)	; NUMBER INTO SAB
	CALL SCLFNC		;DO IT
	IFSKP.
	  MOVEM T1,ERROR	;Save error code
	  CALL OUTDON		;Update I/O
	  SKIPN PSBSAB		;Do we still have an indirect table?
	  IFSKP.
	    LOAD T1,SASLT,(SAB)	;Yes, get the slot entry this SAB came from
	    SKIPN (T1)		;Is there a SAB in here already?
	    IFSKP.
	      CALL RELSBX	;Yes, occupied, release SAB
	    ELSE.
	      MOVEM SAB,(T1)	;No, put this one in there
	    ENDIF.
	  ELSE.
	    CALL RELSBX		;No, release SAB
	  ENDIF.
	ELSE.
;**; 7179  Replace 1 line with 5 at OUTRR1:+28	HMP	18-Nov-85
	  LOAD T1,SASLT,(SAB)	;[7179] Get the slot entry for this SAB
	  ADDI T1,ST.LEN	;[7179] Step to active slot
	  SKIPN (T1)		;[7179] Is this SAB still in active slot?
	   RET			;[7179]  No, it must have been released
	  SETZM (T1)		;[7179] Couldn't validate JFN so clear the
	  CALLRET RELSBX	;  active slot pointer and release the SAB
	ENDIF.
	SKIPE T1,ERROR		;Did we get an error?
	 RET			;Yes
	RETSKP

	ENDSV.

OUTDON:	LOAD T1,SABPT,(SAB)	; Now fixup the I/O window
	MOVEM T1,FILBFO(JFN)	; Will also be used to fill window next time
	LOAD T1,SABCT,(SAB)	; Get count of bytes we just sent
	ADDM T1,FILBCO(JFN)	;  and compute buffer size for next time.
;	CALLRET CLRACT		; Now clear the active slot pointer

CLRACT:	HLLZ T1,PSIBIP		; Get interrupts in progress
	TLZ T1,37777		; Keep channel in progress bits only
	JFFO T1,CLRAC1		; See which one if any
	SETZ T2,		; No interrupts are active
CLRAC1:	SKIPN T1,PSBSAB		; Get pointer to SAB indirect table
	 RET
	ADD T1,T2		; Index to slot address
	ADDI T1,ST.LEN		; Offset to active portion
	SETZM (T1)		; No longer have an active SAB
	RET
	
	SUBTTL INPUT & OUTPUT -- INITIALIZE FOR INPUT
	
;CALL @JFNID(DEV)

NETINP:	TMNN FLLNK,(JFN)	;VERIFY THAT PORT EXISTS
	RETBAD (DCNX16)		;NO PORT, ILLEGAL FUNCT IN CURRENT LINK STATE
	SETZRO FILNO,(JFN)	;NOT DOING NEW OUTPUT
	TQZ FILOUP		;NOT DOING OUTPUT
	TQO FILINP		;DOING INPUT
	CALL SCJLOD		;GET SAB AND SJB AND PRT
	 RETBAD ()		;FAILED
	SKIPE FILBCI(JFN)	;ALREADY HAVE SOME BYTES?
	IFSKP.			
	  SETZ T1,		;NO. DON'T BLOCK
	  CALL DNETIN		;GET BYTES FROM NETWORK
	   NOP			;DON'T CARE ABOUT ERRORS
	ELSE.
	  CALL NETIIN		;Initialize the window for input
	ENDIF.
	RET

NETIIN:	MOVE T1,FILBCI(JFN)	;Get number of bytes so far
	ADD T1,FILBNI(JFN)	;Set FILLEN to be the end of this window,
	TMNN PTEMI,(PRT)	; unless there is no EOM. Is there ?
	 AOS T1			;There is no EOM.
	MOVEM T1,FILLEN(JFN)
	RET
	SUBTTL INPUT & OUTPUT -- INITIALIZE FOR OUTPUT

;CALL @JFNOD(DEV)

NETOUP:	SAVEAC <SAB,PRT,SJB>
	STKVAR <ERROR>
	SETZM ERROR		;Initialize to no error
	SKIPN PSBSAB		;Get pointer to SAB indirect table
	 CALLRET NETIOU		;None, nothing to check
	HLLZ T1,PSIBIP		;Get interrupts in progress
	TLZ T1,37777		;Keep channel in progress bits only
	JFFO T1,NETOU1		;See which one if any
	SETZ T2,		;No interrupts are active
NETOU1: MOVE SAB,PSBSAB		;Get indirect table pointer
	ADD SAB,T2		;Index to slot address
	ADDI SAB,ST.LEN		;Offset to active portion
	SKIPN SAB,(SAB)		;Do we have an active SAB?
	IFSKP.			;Yes
	  LOAD SJB,SASJB,(SAB)	;Get SJB address
	  LOAD PRT,FLLNK,(JFN)	;Port number
	  OPSTR <ADD PRT,>,SJPRT,(SJB) ;Slot in port indirect table
	  MOVE PRT,(PRT)	;Now have port block
	  OPSTR <SKIPGE>,SAAA1,(SAB) ; Any bytes to send?
	  IFSKP.
	    CALL CALSCL		;Yes, call session control and check for errors
	    IFNSK.
	      CALL CLRACT	; We failed to validate the JFN so clear the
	      CALL RELSBX	;  active pointer, release the SAB
	      CALLRET IOERR	;  and return an error
	    ENDIF.
	  ENDIF.
	  CALL OUTDON		;Reset I/O
	  CALL RELSBX		; and release SAB
	ENDIF.

NETOU2:	CALL NETIOU		;Initialize the window
	RET

	ENDSV.
	
;Initialize the window page for output

NETIOU:	SETONE FILNO,(JFN)	;TELL IO ABOUT NEW OUTPUT
	TQO FILOUP		;DOING OUTPUT
	TQZ FILINP		;NOT DOING INPUT
	MOVE T1,FILBCI(JFN)	;Set 
	ADD T1,FILBNI(JFN)	; up
	MOVEM T1,FILLEN(JFN)	; FILLEN to be end of this window.
	RET
	SUBTTL GET PORT STATUS
;CALL GETSTS
;RETURNS:	+1 FAILED  T1/ ERROR CODE
;			   SAB/ ARG BLOCK ADDRESS
;		+2 SUCCESS  SAB/ ARG BLOCK ADDRESS

GETSTS:	STKVAR <PORT>
	LOAD T1,FLLNK,(JFN)	;GET PORT
GETST1:	STOR T1,SAACH,(SAB)	;PUT PORT NUMBER IN SAB
	MOVEI T2,.NSFRS		;GET READ STATUS FUNCTION CODE
	STOR T2,SAAFN,(SAB)	;PUT FUNCTION CODE IN SAB
	MOVEI T2,4		;TELL SCLINK
	STOR T2,SANAG,(SAB)	; ABOUT ARGS
	SETZRO SAAA1,(SAB)	;
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 RET
	JUMPN T1,R
	RETSKP

	ENDSV.			;END STKVAR
	SUBTTL MTOPR FUNCTIONS -- ENTRY

;CALL @MTPD(DEV)

NTMTOP:	SAVEAC <F1>		;Need a preserved AC
	XCTU [HRRZ T2,2]	;Get function code
	CAIL T2,.MOACN		;Range check it
	CAILE T2,.MORFT		;  ...
	RETBAD (MTOX1)		; Out of range
	SUBI T2,.MOACN		;Make an index of the function code
	MOVE F1,NTMTTB(T2)	;Get the dispatch address and flag(s)
	TXZE F1,NTMVBO		;This function Valid Before Open?
	IFSKP.			; -no
	 TQNN <OPNF>		; Open?
	  RETBAD (CLSX1)	;  -no, that is illegal
	 TMNN FLLNK,(JFN)	; Verify that port exists
	  RETBAD (DCNX16)	;  -no, that is also illegal
	 CALL SCJLOD		; Set up SJB and SAB and PRT
	  RETBAD ()
	ENDIF.
	CALLRET 0(F1)		;Dispatch to processing routine

NTMVBO==: 400000,,0		;MTOPR function is Valid Before Open

NTMTTB:	       MTASGN		;ASSIGN PSI CHANNELS
	       NTSTS		;READ LINK STATUS
	       NTRHN		;READ FOREIGN HOST NAME
	       NTRTN		;READ LINK TASK NAME
	       NTRUS		;READ USER STRING
	       NTRPW		;READ PASSWORD
	       NTRAC		;READ ACCOUNT STRING
	       NTRDA		;READ OPTIONAL DATA
	       NTRCN		;READ CONNECT OBJECT NUMBER
	       MTRDIN		;READ INT MESSAGE
	       MTSNIN		;SEND INT MESSAGE
	       NTRCOB		;READ OBJ-DESC OF CONNECT OBJECT
	       NTMTCZ		;CLOSE/REJECT A CONNECTION
	       NTACPT		;ACCEPT A CONNECTION
	       MTGSS		;GET LINK SEGMENT SIZE
	       NTANT		;ATTACH NETWORK TERMINAL
	       NTSNH		;SET NETWORK HOST FOR TERMINAL
	NTMVBO!NTSLP		;SET LINK PARAMETERS
	NTMVBO!NTRLP		;READ LINK PARAMETERS
	       NTSLQ		;SET LINK QUOTA
	       NTRLQ		;READ LINK QUOTA
	       NTRFT		;Read source process name format type
NTMTCT==.-NTMTTB		;LENGTH OF TABLE
	SUBTTL MTOPR FUNCTIONS -- ASSIGN PSI CHANNELS

MTASGN:	SAVEAC <F1>		;NEED A PRESERVED AC
	UMOVE F1,3		;GET USER'S ARGUMENT
	LOAD T2,MO%CDN,F1	;GET CONNECT INTERRUPT CHANNEL
	MOVEI T1,.CONN		;GET CONNECT INDICATOR
	CALL MTSETI		;SET IT
	 RETBAD ()		;FAILED
	LOAD T2,MO%INA,F1	;GET INTERRUPT CHANNEL
	MOVEI T1,.INT		;GET INTERRUPT INDICATOR
	CALL MTSETI		;SET IT
	 RETBAD ()		;FAILED
	LOAD T2,MO%DAV,F1	;GET DATA/DISCONNECT CHANNEL
	MOVEI T1,.DATA		;GET DATA/DISCONNECT INDICATOR
	CALLRET MTSETI		;SET IT
	SUBTTL MTOPR FUNCTIONS -- SET INTERRUPT CHANNEL IN PORT TABLE

;ACCEPTS:	T1/ INDICATOR
;		T2/ USER'S CHANNEL NUMBER
;		SJB/ SJB ADDRESS
;RETURNS:	+1 FAILED
;		+2 SUCCESS

MTSETI:	SAVEAC <F1>
	STKVAR <INTCHN>
	MOVEM T1,F1 		;SAVE INDICATOR
	CALL CHKCHL		;VALIDATE CHANNEL NUMBER
	 RETBAD ()		;FAILED
	JUMPL T2,RSKP		;NO CHANGE NEEDED
	MOVEM T2,INTCHN		;PRESERVE INTERRUPT CHANNEL
	CAIE F1,.CONN		;CONNECT INTERRUPT?
	IFSKP.			;YES
	   STOR T2,PTCON,(PRT)	;SAVE PSI CHANNEL
	ELSE.			;NOT A CONNECT
	   CAIE F1,.INT		;INTERRUPT INTERRUPT?
	   IFSKP.		;YES
	      STOR T2,PTINT,(PRT) ;SAVE PSI CHANNEL
	   ELSE.		;NOT AN INTERRUPT
	      STOR T2,PTDAT,(PRT) ;SAVE DATA/DISCONNECT PSI CHANNEL
	   ENDIF.
	ENDIF.
	SKIPG INTCHN		;ARE WE SETTING A CHANNEL?
	RETSKP			;NO, ALL DONE
	LOAD T1,PTSTS,(PRT)	;GET STATUS VARIABLE
	CAIE F1,.CONN		;CONNECT INTERRUPT?
	IFSKP.			;YES
	   ANDI T1,NSSTA	;JUST THE STATUS FIELD
	   CAIE T1,.NSSCR	;CONNECT RECEIVED?
	   RETSKP		;NO, DONE
	ELSE.			;NOT CONNECT
	   CAIE F1,.INT		;INTERRUPT INTERRUPT?
	   IFSKP.		;YES
	      TXNN T1,NSIDA	;INTERRUPT DATA AVAILABLE?
	      RETSKP		;NO, DONE
	   ELSE.		;NOT INTERRUPT
	      TXNE T1,NSNDA	;NORMAL DATA AVAILABLE?
	      JRST MTSET1	;YES
	      ANDI T1,NSSTA	;NO, GET JUST THE STATUS FIELD
	      CAIGE T1,.NSSDR	;SOME FLAVOR
	      CAIN T1,.NSSRJ	; OF DISCONNECT?
	      JRST MTSET1	;YES
	      RETSKP		;NO, DONE
	   ENDIF.
	ENDIF.
MTSET1:	MOVE T1,INTCHN		;RETRIEVE INTERRUPT CHANNEL
	SOS T1			;GET REAL CHANNEL NUMBER
	MOVE T2,FORKX		;GET OUR FORK NUMBER
	CALL PSIRQ		;GIVE INTERRUPT TO USER
	RETSKP			;DONE

	ENDSV.			;END STKVAR
	
;VERIFY PSI CHANNEL #
;CALL CHKCHL
;WITH:
;		T2/ CHANNEL
;RETURNS:	+1 BAD CHANNEL
;		+2 VALID ARG	T2/  0 - CLEAR CURRENT SETTING
;				    -1 - NO CHANGE TO CURRENT SETTING
;				    +N - USER'S CHANNEL NUMBER +1

CHKCHL:	CAIN T2,.MOCIA		;CLEAR?
	JRST [	SETZM T2	;IF SO. UNSETTING
		RETSKP]		;SO, RETURN A ZERO
	CAIN T2,.MONCI		;NO CHANGE?
	JRST [	SETOM T2	;YES
		RETSKP]		;SO SAY SO
	CAIL T2,44		;WITHIN RANGE?
	JRST CHKILL		;NO
	CAILE T2,5		;WITHIN RANGE 0-5?
	CAIL T2,^D23		;OR WITHIN RANGE 23-35
	AOSA T2			;YES. A GOOD CHANNEL
	JRST CHKILL		;NO. ILLEGAL
	RETSKP			;RETURN GOOD VALUE
CHKILL:	RETBAD (ARGX13)		;INVALID CHANNEL
	SUBTTL MTOPR FUNCTIONS -- RETURN STATUS OF A LOGICAL LINK

NTSTS:	SKIPE FILBCI(JFN)	;ALREADY HAVE SOME BYTES?
	 JRST NTSTS1		;YES
	SETZ T1,		;NO, DON'T BLOCK
	TQNE <READF>		;OPEN FOR READ?
	 CALL DNETIN		;If so, try to get bytes from network
	  NOP 			;DON'T CARE ABOUT ERRORS.
NTSTS1:	LOAD T1,FLLNK,(JFN)	;GET PORT
	STOR T1,SAACH,(SAB)	;PUT IT IN SAB
	MOVEI T1,.NSFRD		;GET "READ DISCONNECT DATA" CODE
	STOR T1,SAAFN,(SAB)	;PUT IT IN SAB
	MOVEI T1,4		;
	STOR T1,SANAG,(SAB)	;
	SETZRO SAAA2,(SAB)	;
	CALL SCLFNC		;DO THE WORK
	 RETBAD ()              ;FAILURE.
	JUMPN T1,R		;  " "
	SETZ T3,		;INIT THE RETURN WORD
	LOAD T3,SAAA2,(SAB)	;GET DISCONNECT REASON CODE
	TMNE PTEMI,(PRT)	;EOM ARRIVED?
	TXO T3,MO%EOM		;YES
	TMNN PTTYP,(PRT)	;THIS LINK A SERVER?
	TXO T3,MO%SRV		;YES
	TMNE PTLWC,(PRT) 	;LINK EVER CONNECTED?
	TXO T3,MO%LWC		;YES
	LOAD T1,SAAST,(SAB)	;GET STATUS VARIABLE
	TXNE T1,NSIDA		;INTERRUPT DATA AVAILABLE?
	TXO T3,MO%INT		;YES
	ANDI T1,NSSTA		;GET JUST THE PORT STATE FIELD
	CALLRET @STSSTA-1(T1)	;DO THE RIGHT THING

	ENDSV.			;END STKVAR

STSSTA:	IFIW!STSWFC		;CONNECT WAIT
	IFIW!STSWCC		;CONNECT RECEIVED
	IFIW!STSWCC		;CONNECT SENT
	IFIW!STSABT		;REJECT
	IFIW!STSCON		;RUN
	IFIW!STSDIR		;DISCONNECT RECEIVED
	IFIW!STSSYN		;DISCONNECT SENT
	IFIW!STSDON		;DISCONNECT CONFIRMED
	IFIW!STSGN2		;NO CONFIDENCE
	IFIW!STSGN3		;NO LINK
	IFIW!STSGN2		;NO COMMUNICATION
	IFIW!STSGN1		;NO RESOURCES
STSWFC:	TXO T3,MO%WFC		;WAITING FOR AN INCOMING CONNECT
	CALLRET STSDON

STSWCC:	TXO T3,MO%WCC		;WAITING FOR A CONNECTION TO COMPLETE
	CALLRET STSDON

STSCON:	TXO T3,MO%CON		;RUNNING
	CALLRET STSDON

STSDIR:	LOAD T1,SAAST,(SAB)	;DI received. Get status variable
	TXNE T1,NSNDA		;Normal data available ?
	JRST STSCON		;Yes. Do as in run state
	TMNN SAAA2,(SAB)        ;No. Is there a reason?
STSSYN:	TXOA T3,MO%SYN		;No, normal close
STSABT:	TXO T3,MO%ABT		;Aborted
	CALLRET STSDON

STSDON:	UMOVEM T3,3		;RETURN INFO TO USER
	RETSKP

STSGN1:	HRRI T3,.DCX1		;NO RESOURCES - RESOURCE ALLOCATION FAILURE
	CALLRET STSABT

STSGN2:	HRRI T3,.DCX39		;NO CONFIDENCE, NO COMMUNICATION -
	CALLRET STSABT		; NO PATH TO DESTINATION NODE

STSGN3:	HRRI T3,.DCX38 		;NO LINK - PROCESS ABORTED
	CALLRET STSABT
	SUBTTL MTOPR FUNCTIONS -- READ CONNECT INITIATE INFORMATION

;READ USER ID
NTRUS:	MOVEI T1,.USRID		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;READ PASSWORD
NTRPW:	MOVEI T1,.PASSW		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;READ ACCOUNT
NTRAC:	MOVEI T1,.ACCNT		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;READ USER DATA
NTRDA:	MOVEI T1,.OPTDT		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;READ REMOTE HOST NAME
NTRHN:	MOVEI T1,.HSTNM		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;READ REMOTE TASK NAME
NTRTN:	MOVEI T1,.TASKN		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;READ OBJECT TYPE
NTRCN:	MOVEI T1,.OBTYP		;GET INDICATOR
	CALLRET NTRFNC		;GO DO THE WORK

;Read source process name format type
NTRFT:	MOVEI T1,.FMTYP		;Get indicator
	CALLRET NTRFNC		; and get the datum
;GET CONNECT INITIATE DATA FROM NETWORK
;CALL NTRFNC
;ACCEPTS:	T1/ INDICATOR
;RETURNS:	+1 FAILED  T1/ ERROR CODE
;		+2 SUCCESS

NTRFNC:	STKVAR <TYPE>		;ENTRY TYPE
	MOVEM T1,TYPE		;SAVE INDICATOR
	LOAD T4,FLLNK,(JFN)	;GET PORT
	CAIN T1,.OPTDT		;IS IT OPTIONAL DATA?
	JRST NTRFN1		;YES, MOVE ON
	TMNE PTTYP,(PRT)	;IS THIS A PASSIVE OPEN?
	RETBAD (DCNX8)		;NO, CAN'T DO THIS FUNCTION
NTRFN1:	STOR T4,SAACH,(SAB)	;PUT PORT IN SAB
	MOVEI T2,.NSFRI		;GET "READ CI DATA" CODE
	STOR T2,SAAFN,(SAB)	;PUT IT IN SAB
	CALL SCLFNC		;GO DO THE WORK
	 RETBAD ()		;SOMETHING WRONG
	JUMPN T1,R		;  "        "
	LOAD T1,SACBP,(SAB)	;GET ADDDRESS OF RETURNED INFO
	MOVE T3,TYPE		;GET FUNCTION INDICATOR
	CALLRET @NTRFNT(T3)	;DO THE RIGHT THING

	ENDSV.			;END STKVAR

NTRFNT:	IFIW!NTRUSR		;USER ID
	IFIW!NTRPAS		;PASSWORD
	IFIW!NTRACT		;ACCOUNT
	IFIW!NTROPT		;OPTIONAL DATA
	IFIW!NTRHST		;HOST NAME
	IFIW!NTRTSK		;TASK NAME
	IFIW!NTROBJ		;OBJECT TYPE
	IFIW!NTRFMT		;FORMAT TYPE
	
;RETURN CONNECT INITIATE DATA TO USER

;RETURN USER ID
NTRUSR:	XMOVEI T2,CB.UID(T1)	;GET ADDRESS OF USER ID
	LOAD T1,CBUCT,(T1)	;GET BYTE COUNT
	CALL NTACPY		;GO COPY STRING
	RETSKP			;FINISH

;RETURN PASSWORD
NTRPAS:	XMOVEI T2,CB.PSW(T1)	;GET ADDRESS OF PASSWORD
	LOAD T1,CBPCT,(T1)	;GET BYTE COUNT
	CALL NTACPY		;GO COPY STRING
	UMOVEM T2,4		;RETURN BYTE COUNT TO USER
	RETSKP			;FINISH

;RETURN ACCOUNT
NTRACT:	XMOVEI T2,CB.ACC(T1)	;GET ADDRESS OF ACCOUNT
	LOAD T1,CBACT,(T1)	;GET BYTE COUNT
	CALL NTACPY		;GO COPY STRING
	RETSKP			;FINISH

;RETURN OPTIONAL DATA
NTROPT:	XMOVEI T2,CB.UDA(T1)	;GET ADDRESS OF OPTIONAL DATA
	LOAD T1,CBCCT,(T1)	;GET BYTE COUNT
	CALL NTACPY		;GO COPY STRING
	UMOVEM T2,4		;RETURN BYTE COUNT TO USER
	RETSKP			;FINISH

;RETURN REMOTE HOST
;**; [7297] Replace 4 lines with 10 lines at NTRHST:  JCR  13-May-86
NTRHST: SAVEAC <STS>		;[7297]Save the node number here
	STKVAR <<NODNAM,2>>	;[7297]Save the node name here
	LOAD T1,CBNUM,(T1)	;[7297]Get node number
	MOVE STS,T1		;[7297]Save the node number 
	CALL SCTA2N		;[7297](T1/T1) Convert to node name
	IFNSK.			;[7297]Can't find the node name	
	  UMOVE T3,3		;[7297]Pick up address to store node number
          UMOVEM STS,0(3)	;[7297]Store the node number
	  RETBAD (NSPX24)	;[7297]No name matches number
	ENDIF.			;[7297]
	XMOVEI T2,NODNAM  	;DESTINATION B.P.
	HRLI T2,(POINT 8,0)
	CALL GETSIX		;(T1,T2/T1) CONVERT
	XMOVEI T2,NODNAM	;GET ADDRESS OF HOST NAME
	CALL NTACPY		;(T1,T2) GO COPY THE STRING
	RETSKP			;FINISH
	ENDSV.			;END STKVAR

;RETURN TASK NAME
NTRTSK:	XMOVEI T2,CB.SRC(T1)	;GET ADDRESS OF SOURCE'S PB
	ADDI T2,PB.NAM		;GET OFFSET TO TASK NAME
	LOAD T1,PBNCT,+CB.SRC(T1)  ;GET BYTE COUNT
	CALL NTACPY		;GO COPY THE STRING
	RETSKP			;FINISH

;RETURN OBJECT NUMBER
NTROBJ:	LOAD T2,PBOBJ,+CB.DST(T1)  ;GET OBJECT NUMBER
	UMOVEM T2,3		;GIVE IT TO USER
	RETSKP			;DONE.

;Return source process name format type
NTRFMT:	LOAD T2,PBFOR,+CB.SRC(T1) ;Get source name format type
	UMOVEM T2,3		; Give to user
	RETSKP
	SUBTTL MTOPR FUNCTIONS -- READ AN INTERRUPT MESSAGE

;CALL MTRDIN
;RETURNS:	+1  FAILED
;		+2  SUCCESS

MTRDIN:	LOAD T4,FLLNK,(JFN)	;GET PORT
	STOR T4,SAACH,(SAB)	;PUT IT IN ARG BLOCK
	MOVEI T1,.NSFIR		;GET FUNCTION CODE
	STOR T1,SAAFN,(SAB)	;PUT IT IN ARG BLOCK
	SETONE SAWAI,(SAB)	;SAY WE WANT TO BLOCK, IF NECESSARY
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 RETBAD () 		;FAILURE.
	JUMPN T1,R		;   "
	LOAD T2,SASBP,(SAB)	;GET SB ADDRESS
	LOAD T1,SBCNT,(T2)	;GET BYTE COUNT
	ADDI T2,SB.DAT		;OFFSET TO STRING
	CALL NTACPY		;COPY STRING TO USER
	UMOVEM T2,4		;GIVE "BYTES RETURNED" TO USER
	RETSKP			;DONE
	SUBTTL MTOPR FUNCTIONS -- SEND AN INTERRUPT MESSAGE

;CALL MTSNIN
;RETURNS:	+1  FAILED
;		+2  SUCCESS

MTSNIN:	STKVAR <COUNT,BPTR>	;COUNT:  BYTE COUNT OF MESSAGE
				;BPTR:  USER'S BYTE POINTER
	UMOVE T1,4		;GET USER'S BYTE COUNT
	CAILE T1,0		;VALID
	CAILE T1,MAXOPT		; COUNT?
	RETBAD (DCNX12)		;NO, FAIL
	MOVEM T1,COUNT		;PRESERVE BYTE COUNT
	CALL GETSB		;(T1/T1)GET A STRING BLOCK
	 RETBAD ()		;FAILED
	MOVE T4,[POINT 8,(T1)]	;MAKE A BP TO DESTINATION
	UMOVE T3,3		;GET USER'S BP
	TLC T3,-1		;FORM DEFAULT BP
	TLCN T3,-1		; IF USER
	HRLI T3,(<POINT 7,>)	;  SAID -1 IN LH
	MOVEM T3,BPTR		;SAVE IT
	MOVE T3,COUNT		;RETRIEVE BYTE COUNT
MTSNI1:	XCTBU [ILDB T2,BPTR]	;GET A BYTE
	IDPB T2,T4		;PUT IT IN MONITOR SPACE
	SOJG T3,MTSNI1		;DO THEM ALL
	LOAD T1,FLLNK,(JFN)	;GET PORT
	STOR T1,SAACH,(SAB)	;PUT PORT NUMBER IN ARG BLOCK
	MOVEI T1,.NSFIS		;GET FUNCTION CODE
	STOR T1,SAAFN,(SAB)	;PUT IT IN ARG BLOCK
	SETONE SAWAI,(SAB)	;SAY WE WANT TO BLOCK, IF NECESSARY
	CALL SCLFNC		;ASK SCLINK TO DO THE WORK
	 RET			;CAN'T USE JFN
	JUMPN T1,R		;ERROR FROM SCLINK
	RETSKP
	ENDSV.			;END STKVAR
	SUBTTL MTOPR FUNCTIONS -- CLOSE/REJECT A CONNECTION
;CALL NTMTCZ
;RETURNS:	+1  FAILED
;		+2  SUCCESS

NTMTCZ:	CALL GETOPT		;GET OPTIONAL DATA
	 RETBAD ()		;FAILED
	LOAD T2,FLLNK,(JFN)	;GET PORT
	LOAD T4,PTSTS,(PRT)	;GET THE PORT'S STATUS
	ANDI T4,NSSTA		;JUST THE STATE FIELD
	CAIE T4,.NSSRN		;RUNNING?
	CAIN T4,.NSSCR	    	; or connect received ?
	IFNSK.			;
	   MOVEI T3,4		;Yes. Four
	   STOR T3,SANAG,(SAB)	; arguments.
	   UMOVE T3,2		;GET USER'S CLOSE INFO
	   HLRZS T3		;JUST THE REASON CODE
	   STOR T3,SAAA2,(SAB)	;STASH IT IN ARG BLOCK
	   CAIN T4,.NSSCR	;Connect received ?
	    JRST NTREJ 		;Yes. Go to reject routine.
	   SETZ T1,		;Clear flags for CLZMTO
	   SKIPE T3		;Synchronous close?
	    MOVX T1,CZ%ABT	;Set the abort flag
	   CALLRET CLZMTO	; and do the close
	ENDIF.
	CALLRET @CLZSTA-1(T4)	;GO DO THE WORK
	SUBTTL MTOPR FUNCTIONS -- CLOSE/REJECT A CONNECTION -- REJECT
;Here when state is connect received. Reject current connection and reopen a 
; new listener
;CALL NTREJ with
;	T2/  port
;Returns +1 on failure, +2 on success
NTREJ:	STKVAR <CONCH,INTCH,DATCH> ;SAVE PSI CHANNEL ASSIGNMENTS
	LOAD T1,PTCON,(PRT)	;GET PSI CONNECT CHANNEL
	MOVEM T1,CONCH		;PRESERVE IT
	LOAD T1,PTINT,(PRT)	;GET PSI INTERRUPT CHANNEL
	MOVEM T1,INTCH		;PRESERVE IT
	LOAD T1,PTDAT,(PRT)	;GET PSI DATA/DISCONNECT CHANNEL
	MOVEM T1,DATCH		;PRESERVE IT
	HRROI T1,.NSFRJ		;GET "REJECT" FUNCTION CODE
	CALL CLZPRT		;(T1,T2) CLOSE AND RELEASE THE PORT
	 RETBAD ()		;FAILED
	CALL SRVOPN		;GET A NEW PORT FOR THIS JFN
	 RETBAD ()		;FAILED
	LOAD PRT,FLLNK,(JFN)	;GET NEW PORT NUMBER
	OPSTR <ADD PRT,>,SJPRT,(SJB)  ; INTO PORT INDIRECT TABLE
	MOVE PRT,(PRT)		;Now have port block
	MOVE T2,CONCH		;RETRIEVE PSI CONNECT CHANNEL
	STOR T2,PTCON,(PRT)	;PUT IT BACK IN PORT TABLE
	MOVE T2,INTCH		;RETRIEVE PSI INTERRUPT CHANNEL
	STOR T2,PTINT,(PRT)	;PIT IT BACK IN PORT TABLE
	MOVE T2,DATCH		;RETRIEVE PSI DATA/DISCONNECT CHANNEL
	STOR T2,PTDAT,(PRT)	;PUT IT BACK IN PORT TABLE
	RETSKP

	ENDSV.
	SUBTTL MTOPR FUNCTIONS -- ACCEPT AN INCOMING CONNECITON

;CALL NTACPT
;RETURNS:	+1 FAILED  T1/ ERROR CODE
;		+2 SUCCESS

NTACPT:	MOVEI T2,.NSFAC		;GET FUNCTION CODE FOR ACCEPT
	STOR T2,SAAFN,(SAB)	;PUT IT IN SAB
	MOVEI T2,5		;Get argument count
	STOR T2,SANAG,(SAB)	; and put it in SAB
	LOAD T1,FLLNK,(JFN)	;GET PORT
	STOR T1,SAACH,(SAB)	;PUT PORT IN SAB
	CALL GETOPT		;GET OPTIONAL DATA
	 RETBAD ( )		;SOMETHING WRONG
	LOAD T1,FLSES,(JFN)	;Get segment size from JFN block
	STOR T1,SAAA2,(SAB)	; and put into SAB
	LOAD T1,FLFCO,(JFN)	;Get flow control option from JFN block
	STOR T1,SAAA3,(SAB)	; and put into SAB
	CALL SCLFNC		;GO DO IT
	 RET			;Can't use JFN
	JUMPN T1,R		;Error from SCLINK
	RETSKP
	SUBTTL MTOPR FUNCTIONS -- GET SEGMENT SIZE FOR LINK

;CALL MTGSS
;RETURNS:	+1  FAILED
;		+2  SUCCESS

MTGSS:	CALL GETSTS		;GET STATUS OF PORT
	 RETBAD ()		;FAILED
	LOAD T2,SAAA1,(SAB)	;GET SEGMENT SIZE
	UMOVEM T2,3		;RETURN IT TO USER
	RETSKP			;GOOD RETURN
	SUBTTL MTOPR FUNCTIONS -- SET NETWORK HOST

;CALL NTSNH
; T1/ JFN OF LOGICAL LINK (JFN, STS, ETC SETUP AT .MTOPR ENTRY)
; T3/ PTR TO ARG BLOCK:
	.SHSIZ==0		;SIZE IN WORDS (INCLUDING THIS ONE)
	.SHTTY==1		;TERMINAL IDENT
	.SHESC==2		;FLAGS,,ESCAPE CHAR
; RETURNS +1 ON FAILURE
; RETURNS +2 WITH LINE CONNECTED TO LOGICAL LINK, JFN UNCHANGED

NTSNH:	SAVEAC <T5>
	UMOVE T5,T3		;GET ARG PTR
	UMOVE T1,.SHTTY(T5)     ;GET TTY IDENT
	CALL [	SAVEAC <JFN,STS,SJB,DEV> ;** SJB = P3** KEEP THESE FOR ORIGINAL JFN
		CALLRET CHKTTM]	;GET LINE NUMBER IN T2
	  RETBAD (ANTX01)	;NO SUCH TTY, RETURN ERROR

; T1/ Flags,,Escape Character
; T2/ TTY Line Number
; T3/ SJB Pointer for DECnet Link
; T4/ PSI MASK to restore on escape,,DECnet Channel Number

	UMOVE T1,.SHESC(T5)	;GET ESC FLAGS & ESCAPE CHAR
                                ;T2 SET UP BY CHKTTM, ABOVE
	MOVE T3,SJB             ;POINTER TO SJB
	LOAD T4,FLLNK,(JFN)	;GET DECnet CHANNEL NUMBER
	CALLRET TTSETH		;(T1,T2,T3,T4)DO HOMOGENEOUS SET HOST
	SUBTTL	MTOPR FUNCTIONS -- SET LINK PARAMETERS

;CALL NTSLP
; T1/ JFN of logical link.
; T3/ ptr to argument block:
;	0	length of argument block including this word
;	.SLPSS	The segment size
;	.SLPFC	The flow control option
;		In field MO%LFC:
;			NSF.C0	No flow control
;			NSF.CS	Segment flow control
;			NSF.CM	Message flow control
; Note: since NTSLP must be called before the link has been established,
;  NTMTOP (MTOPR dispatch) calls NTSLP without any preprocessing.
;  The .MOSLP function is only valid if the link has not been opened,
;  or if the link state is CONNECT WAIT or CONNECT RECEIVED, i.e.
;  a passive link that has not yet accepted a connect.
;
; Returns +1 on failure
;         +2 on success


NTSLP:	MOVX T1,SC%WHL!SC%OPR	;Check capabilities
	TDNN T1,CAPENB
	 RETBAD (MTOX7)		;WHEEL or OPERATOR required
; If link is not opened, then fine. If open, check if it is in CR or
;  CW state. If so, then fine, else give error.
	TQNN <OPNF>		;Opened?
	 JRST NTSLP1		; -no, thats OK
	TMNN FLLNK,(JFN)	;Port exists?
	 JRST NTSLP1		; -no, thats OK too
	CALL SCJLOD		;Link exists, set up SAB and SJB and PRT
	 RETBAD ()
; There is a link, verify state
	LOAD T1,PTSTS,(PRT)	;Get the
	ANDI T1,NSSTA		; present state
	CAIN T1,.NSSCW		;Connect Wait?
	JRST NTSLP1		; -yes, OK
	CAIN T1,.NSSCR		;Connect Received?
	JRST NTSLP1		; -yes, OK
	RETBAD (DCNX16)		;Not a valid state, return 
				; "Illegal operation for current link state"

; NTSLP1 - OK to set the parameters
;  T1/ ptr to argument block
;  T2/ length of argument block
NTSLP1:	UMOVE T1,3		;Get user argument block pointer
	UMOVE T2,0(T1)		;Get length
	CAIGE T2,2		;Check length of argument block
	IFSKP.
	 UMOVE T3,.SLPSS(T1)	;Get segment size
	 SKIPGE T3		; If necessary,
	  SETZM T3		;  apply default
	 STOR T3,FLSES,(JFN)	; and put in JFN block
	ENDIF.
	CAIGE T2,3		;Check length of argument block
	IFSKP.
	 UMOVE T3,.SLPFC(T1)	;Get flow control option
	 LDB T3,[POINTR T3,MO%LFC] ; for local end
	 CAILE T3,NSF.CM	;Range check: 0..NSF.CM is OK
	  SETZ T3,		; -not in range, assume default
	 STOR T3,FLFCO,(JFN)	;  and put in JFN block
	ENDIF.
	RETSKP
	SUBTTL	MTOPR FUNCTIONS -- READ LINK PARAMETERS

;CALL NTRLP
; T1/ JFN of logical link. Link may not be opened.
; T3/ ptr to argument block. The format of the argument block is the same
;	as for the NTSLP function.
;
; Returns +1 on failure
;         +2 on success

; NTRLP - If the link is established, do a .NSFRS call to SCLINK to get
;  the values; if not then retrieve the values from the JFN block.
; 	T1/ ptr to argument block
;	T2/ length of argument block
;	T3/ segment size
;	T4/ flow control options

NTRLP:	TQNN <OPNF>		;Open
	IFSKP.
	 TMNN FLLNK,(JFN)	; AND port exists?
	 ANSKP.			;   THEN
	   CALL SCJLOD		;	Load SAB and SJB and PRT 
	    RETBAD ()
	   CALL GETSTS		;       Get the status
	    RETBAD ()
	   LOAD T3,SAAA1,(SAB)	;	Get segment size from SAB return
	   LOAD T4,SAAA2,(SAB)	;	and flow control options
	 ELSE.			;   ELSE
	   LOAD T3,FLSES,(JFN)	;   	Get segment size
	   LOAD T4,FLFCO,(JFN)	;       and flow control options
	ENDIF.
; Return -1 if the values have not yet been decided
	SKIPG T3		;Segment size?
	 SETOM T3		; -no, return -1
	SKIPG T4		;Flow control?
	IFNSK.			; -no, return -1
	 SETO T1,
	 SETZ T4,
	 DPB T1,[POINTR T4,MO%RFC] ;Store -1 in remote flow control
	 DPB T1,[POINTR T4,MO%LFC] ;Store -1 in local flow control
	ENDIF.
; Now return the values in the argument block
	UMOVE T1,3		;Get argument block pointer
	UMOVE T2,0(T1)		;Get argument length
	CAIL T2,2		;Check length
	 UMOVEM T3,.SLPSS(T1)	;Return segment size
	CAIL T2,3		;Check length
	 UMOVEM T4,.SLPFC(T1)	;Return flow control options
	RETSKP
	SUBTTL	MTOPR FUNCTIONS -- SET LINK QUOTAS

;CALL NTSLQ
; T1/ JFN of logical link.
; T3/ ptr to argument block:
;	0	the length of the argument block with this word included
;	.SLQIP	The percent of link quota used for input
;	.SLQLQ	The link quota
;	.SLQIG	The input goal.
;
; Note that the order of the MTOPR arguments are reversed compared to the
;  order they should be set up when calling SCLINK. This is because the
;  percentage is the only non-privileged function, and it is therefore
;  attractive to let it be the first argument.
;
; Returns +1 on failure
;         +2 on success

NTSLQ:	LOAD T1,FLLNK,(JFN)	;Get port
	STOR T1,SAACH,(SAB)	; and put it in SAB block
	MOVEI T1,.NSFSQ		;Get the "set quotas and goals" function code
	STOR T1,SAAFN,(SAB)	; and put in SAB block
	MOVEI T1,5		;Get # of arguments
	STOR T1,SANAG,(SAB)	; and put in SAB block
; T1/ ptr to argument block
; T2/ length of argument block
; T3/ 0 if not enough capabilities, -1 if enough
	UMOVE T1,3		;Get ptr to argument block
	UMOVE T2,0(T1)		; and length of the block
	SETZ T3,		;Assume not enough caps
	MOVX T4,SC%WHL!SC%OPR	;Get caps to test for
	TDNE T4,CAPENB		;Has user them enabled?
	SETO T3,		; -yes, flag enough capabilities
; Get 1st argument (input %)
	SETO T4,		;Preset default
	CAIL T2,2		;Within argument block?
	UMOVE T4,.SLQIP(T1)	; -yes, get user value
	STOR T4,SAAA2,(SAB)	;Put in argument block
; Get 2nd argument (link quota)
	SETO T4,		;Preset default
	CAIL T2,3		;Contained in argument block
	SKIPN T3		; AND capabilities?
	IFSKP. < UMOVE T4,.SLQLQ(T1)	;-yes, get the user value >
	STOR T4,SAAA1,(SAB)	;Store in argument block
; Get 3rd argument (input goal)
	SETO T4,		;Preset default
	CAIL T2,4		;Within argument block?
	SKIPN T3		; AND capabilities?
	IFSKP. < UMOVE T4,.SLQIG(T1) 	;-yes, get user value >
	STOR T4,SAAA3,(SAB)	;Put in argument block
;Argument block is now prepared
	CALL SCLFNC		;Do the set quota and goals
	 RETBAD	 ()
	JUMPN T1,R		;Error from SCLINK
	RETSKP
	SUBTTL	MTOPR FUNCTIONS -- READ LINK QUOTAS

;CALL NTRLQ
; T1/ JFN of logical link
; T3/ ptr to argument block to receive the returned quotas.
;	The format of the argument block is the same as for the NTSLQ function.
;
; Returns +1 on failure
;         +2 on success

; Call SCLINK with function code .NSFRQ (read quotas and goals)
NTRLQ:	LOAD T1,FLLNK,(JFN)	;Port number
	STOR T1,SAACH,(SAB)
	MOVEI T1,.NSFRQ		;Function code
	STOR T1,SAAFN,(SAB)
	MOVEI T1,5		;Number of arguments
	STOR T1,SANAG,(SAB)
	CALL SCLFNC		;Call SCLINK
	 RETBAD ()		; Error
	JUMPN T1,R		;   "

; The data are now in words SAAA1, SAAA2 and SAAA3 in the SAB block.
;  Let T1/ ptr to user argument block
;      T2/ length of argument block
	UMOVE T1,3		;Get argument block pointer
	UMOVE T2,0(T1)		; and the argument length
	LOAD T3,SAAA2,(SAB)	;Get input percentage
	CAIL T2,2		;Fits into argument block?
	UMOVEM T3,.SLQIP(T1)	; -yes
	LOAD T3,SAAA1,(SAB)	;Get link quota
	CAIL T2,3
	UMOVEM T3,.SLQLQ(T1)
	LOAD T3,SAAA3,(SAB)	;Get input goal
	CAIL T2,4
	UMOVEM T3,.SLQIG(T1)
	RETSKP
	SUBTTL MTOPR FUNCTIONS -- OBSOLETE

;ATTACH NETWORK TERMINAL
NTANT:	RETBAD (MTOX1)		;OBSOLETE MTOPR, FUNCTION NOW HANDLED
				;ENTIRELY IN THE MONITOR (TTPHDV).
;READ OBJECT-DESCRIPTOR
NTRCOB:	RETBAD (MTOX1)		;OBSOLETE MTOPR
	SUBTTL MTOPR UTILITY ROUTINES --  COPY AN ASCII STRING TO THE USER.

;CALL NTACPY
;ACCEPTS:	T1/ BYTE COUNT
;		T2/ ADDRESS OF STRING
;RETURNS:	+1  T2/ NUMBER OF BYTES RETURNED TO USER

NTACPY:	ACVAR <SRC,CNT>
	MOVE CNT,T1		;PRESERVE BYTE COUNT
	UMOVE T3,3		;GET USER'S STRING POINTER
	TLC T3,-1
	TLCN T3,-1		;WANT DEFAULT?
	HRLI T3,(<POINT 7,>)	;USE. DO IT
	MOVE SRC,[POINT 8,0(T2)]  ;POINT TO SOURCE
NTCPY1:	ILDB T4,SRC		;GET A BYTE
	XCTBU [IDPB T4,T3]	;GIVE BYTE TO USER
	SOJG T1,NTCPY1		;DO THEM ALL
	UMOVEM T3,3		;RETURN BYTE POINTER TO USER
	SETZ T4,		;MAKE A NULL
       	XCTBU [IDPB T4,T3]	;APPEND IT
	MOVE T2,CNT		;RETURN BYTE COUNT
	RET			;AND DONE
	ENDAV.			;END ACVAR
	SUBTTL MTOPR UTILITY ROUTINES -- GET STRING BLOCK STORAGE

;GET A STRING BLOCK
;CALL GETSB
;ACCEPTS:	T1/ BYTE COUNT
;RETURNS:	+1  FAILED  T1/ ERROR CODE
;		+2  SUCCESS  T1/ ADDRESS FOR DATA

GETSB:	ASUBR <COUNT>
	MOVEI T1,SB.LEN		;GET SPACE
	CALLX (XCDSEC,DNGWDZ)	; FOR STRING BLOCK
	 RETBAD (MONX07)	;FAILED
	STOR T1,SASBP,(SAB)	;PUT IT IN SAB
	MOVE T4,COUNT		;GET BYTE COUNT
	STOR T4,SBCNT,(T1)	;PUT IT IN STRING BLOCK
	MOVEI T3,SB.LEN		;GET STRING BLOCK LENGTH
	STOR T3,SBWDS,(T1)	;PUT IT IN STRING BLOCK
	ADDI T1,SB.DAT		;OFFSET TO STRING
	RETSKP			;DONE
	ENDAS.			;END ASUBR
	SUBTTL MTOPR UTILITY ROUTINES -- GET OPTIONAL DATA

;CALL GETOPT
;ACCEPTS:	SAB/ ARG BLOCK
;RETURNS:	+1 FAILED  T1/ ERROR CODE
;		+2 SUCCESS

GETOPT:	STKVAR <COUNT>
	UMOVE T1,4		;GET BYTE COUNT OF OPTIONAL DATA FROM USER
	SKIPE T1		;IS THERE ANY?
	IFSKP.			;NO
	   SETZRO SASBP,(SAB)	;SAY SO
	   RETSKP		;DONE
	ENDIF.
	MOVEM T1,COUNT		;SAVE COUNT
	SKIPL T1		;WITHIN 
	CAILE T1,MAXOPT		; RANGE ?
	RETBAD (DCNX12)		;NO. FAIL.
	CALL GETSB		;(T1/T1) GET A STRING BLOCK
	 RETBAD ()		;FAILED
	MOVE T2,COUNT		;RETRIEVE USER BYTE COUNT
	UMOVE T4,3		;GET USER'S BYTE POINTER
	TLC T4,-1		;CHECK FOR SPECIAL POINTER
	TLCN T4,-1		;IS IT?
	HRLI T4,(<POINT 7,>)	;YES. CONVERT IT THEN
	MOVE T3,[POINT 8,(T1)]	;GET POINTER TO DESTINATION
GETOP1:	XCTBU [ILDB CX,T4]	;GET BYTE
	IDPB CX,T3		;PUT BYTE
	SOJGE T2,GETOP1		;UNTIL DONE
	RETSKP			;DONE.

	ENDSV.			;END STKVAR
	SUBTTL PRESERVE & SET UP SPECIAL ACS

;CALL SCJLOD
;RETURNS:	+1 on failure with error code in T1.
;RETURNS:	+2 on success with SAB, PRT and SJB registers set up.
;		   - SAB points to the SAB for this guise of this fork
;		   - SJB points to the SJB for this job
;		   - PRT points to the port data base for this JFN.
;Uses four words on the stack for storage - three for the registers, and
;one for the address of the slot used in the SAB table pointed to by PSBSAB.
;**MONUMENT**
;      This is a couroutine because
;      a fork may be in this module in more than one guise simultaneously,
;      since blocking and PSIs are possible. The following assures that each
;      guise receives its own SAB, and that deallocation will be correct.
;      The return restores the registers SAB, SJB, and PRT, deallocates the
;      string block and connect block in the SAB if they exist, and deallocates
;      the SAB.


SCJLOD:	NOINT			;Don't bother me.
	EXCH SJB,0(P)		;Save register, get return address
	PUSH P,SAB		;Save register
	SKIPE PSBSAB		;Have indirect table ?
	IFSKP.
	  LOCK SJBLOK		;No. exclusive
	  SKIPE PSBSAB		;Do we really have an indirect table ?
	  IFSKP.
	    MOVEI T1,ST.LEN*2  	;No. build it.
	    CALLX (XCDSEC,DNGWDZ) ;Allocate
	    IFNSK.
	      UNLOCK SJBLOK	;Failed.
	      JRST SCJERR
	    ENDIF.
	    MOVEM T1,PSBSAB	;Succeeded. save.
 	  ENDIF.
	  UNLOCK SJBLOK		;End exclusive.
	ENDIF.
	HLLZ T1,PSIBIP		;Get interrupts in progress
	TLZ T1,37777		;Keep channel in progress bits only
	JFFO T1,SCJLD1		;See which one if any
	 SETZ T2,		;No interrupts are active
SCJLD1:	MOVE SAB,PSBSAB		;Get indirect table pointer
	ADD SAB,T2		;Index to slot address
	SKIPE (SAB)		;Do we already have a SAB?
	IFSKP.
	  MOVEI T1,SA.LEN	;No, try to allocate one
	  CALLX (XCDSEC,DNGWDS)
	   JRST SCJERR		;Failed
	  MOVEM T1,(SAB)	;Succeeded. save SAB address in indirect table
	  SETZM SA.SBP(T1)	;Initialize string block
	  SETZM SA.CBP(T1)	;Initialize connect block
	  STOR SAB,SASLT,(T1)	;Keep slot address in SAB
	ENDIF.
	MOVE SAB,(SAB)		;Get SAB address
	SETZM SA.MFG(SAB)	;Initialize monitor flags
	SETONE SAEVA,(SAB)	;We always use monitior address space
	OKINT			;All is safe.
	MOVE T1,SJB		;Restore return address
	MOVE SJB,JSBSJB		;Get SJB address
	PUSH P,PRT 		;Save this register
	OPSTR <SKIPN PRT,>,FLLNK,(JFN)	;Get port number
	IFSKP.
	  OPSTR <ADD PRT,>,SJPRT,(SJB)  ;Get port indirect table
	  MOVE PRT,(PRT)		;Get port's information
	ENDIF.
	CALL 1(T1)		;Successful allocation
;Here when work is done.
;T1 with error code if any
;*****
;NOTE: It is imperative that T1 not be destroyed in SCJRET
;*****

SCJRET:	 TRNA      		;Propogate +1 return
	AOS -3(P)  		;Propogate +2 return
	MOVE PRT,T1		;Save the error code or the data
	OPSTR <SKIPN T1,>,SASBP,(SAB) ;Release string block, if any
	IFSKP.
	  CALLX (XCDSEC,DNFWDS)	;Release memory and forget about it
	  SETZRO SASBP,(SAB)
	ENDIF.
	OPSTR <SKIPN T1,>,SACBP,(SAB) ;Release connect block, if any
	IFSKP.
	  CALLX (XCDSEC,DNFWDS)
	  SETZRO SACBP,(SAB)
	ENDIF.
	MOVE T1,PRT		;Get error code/data
	POP P,PRT 		;Restore this register
	POP P,SAB		;Restore SAB
	POP P,SJB		;Restore SJB
	RET			;Done

;error occurred during allocation
SCJERR:	OKINT
	MOVEI T1,MONX07		;Set up error AC.
	MOVE CX,SJB		;Restore return address
	POP P,SAB		;Restore
	POP P,SJB		; ACs
	JRST 0(CX)		;  and propagate failure
	SUBTTL ROUTINE THAT CALLS SESSION CONTROL

;Set up standard stuff for a call to SCTNSF and do the call
;CALL SCLFNC
;SAB/ Address of SAB
;SJB/ Address of SJB
;PRT/ Address of port's info
;JFN/ Set up as per CHKJFN.
;RETURNS:	+1  T1/ ERROR
;		+2  SUCCESS

SCLFNC:	STOR SJB,SASJB,(SAB)	;Put SJB in SAB
	XMOVEI T1,SCBLOK	;Get address of block routine
	STOR T1,SAHBA,(SAB)	;Put it in SAB
	XMOVEI T1,SCWAKE	;Get address of wake routine
	STOR T1,SAWKA,(SAB)	;Put it in SAB
	SKIPE PRT		;If no port block yet don't use it
	 STOR DEV,PTDEV,(PRT)	;Save DEV for later checking
;	CALLRET CALSCL


CALSCL:	SETZRO SABLK,(SAB)	;Undo any previous block
	MOVE T1,SAB		;Position SAB address
	CALL SCTNSF		;Do the work
	LOAD T1,SAAST,(SAB)	;Get the status
	STOR T1,PTSTS,(PRT)	;Put into port data base
	LOAD T1,SAAFN,(SAB)	;Get function just completed
	CAIN T1,.NSFDS		;Was it send normal data?
	 SETONE SAAA1,(SAB)	;Indicate all bytes sent
	TMNN SABLK,(SAB)	;Did we block?
	IFSKP.
	  CALL SCLFNU		;(F1) Revalidate JFN
	   RETBAD ()		;Failure. complain.
	ENDIF.
	OPSTR <SKIPN T1,>,SAERR,(SAB) ;Error from SCTNSF ?
	IFSKP.
	  SKIPL T1		;Yes, range check it
	   CAILE T1,D36ERL
	  SETZ T1,		;Return D36ERR(0) if out of range
	  MOVE T1,D36ERR(T1)	;Convert it to TOPS20 error code.
	ENDIF.
	RETSKP     		;No, done
;Fixup and revalidation of JFN after blocking.
;CALL SCLFNU with PRT/ addr of port db
;Returns +1 on failure, with error in T1
;Returns +2 on success.
SCLFNU:	SAVEAC <SJB>		;**SJB = P3**, and is trashed by CHKJFN
	STKVAR <SAVSTS>
	MOVEM STS,SAVSTS	;CHKJFN will change this
	OKINT			;Undo last NOINT from the blocking routine.
	LOAD T3,PTJFN,(PRT)	;Get user's JFN again
	IDIVI T3,MLJFN		; and make it
	MOVE JFN,T3		;  a real JFN
	CALL CHKJFN		;Validate it. T2 is preserved !!
	 RETBAD (DESX4)		;
	 RETBAD (DESX4)		;
	 RETBAD (DESX4)		;
	MOVE STS,SAVSTS		;Get STS from this context
	OPSTR <CAME DEV,>,PTDEV,(PRT) ;DEV still good?
	RETBAD (DESX4)		;No
	TQNN FILOUP		;Doing input or output?
	IFSKP.
	  CALL NETIOU		;Output, re-intialize window for output
	ELSE.
	  SETZRO FILNO,(JFN)	;Not doing new output
	  TQO FILINP		;Doing input
	  CALL NETIIN		;Input, re-initialize window for input
	ENDIF.
	RETSKP			;Yes. all is well

	ENDSV.

	TNXEND

	END