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