Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/monitor/jsysf.mac
There are 53 other files named jsysf.mac in the archive. Click here to see a list.
; Edit= 8856 to JSYSF.MAC on 5-Jul-88 by GSCOTT
;Insure that no partial directory is built when CRDIR bombs in new directory.
; Edit= 8844 to JSYSF.MAC on 19-May-88 by GSCOTT (TCO 7.1290)
;Prevent <OPERATOR> directory from getting full of zeroes when a new structure
;is created and minimum password length is greater than 6 by not checking
;minimum password length when CRDIR called from monitor mode.
; Edit= 8831 to JSYSF.MAC on 15-Apr-88 by RASPUZZI
;Prevent bad error messages from JFNS% when COPYing from TTY:. Seems we are
;leaving the FILLCK set because UNLCKF does not undo FILLCK for TTYs. Make
;sure FILLCK is cleared before exitting JFNS%.
; Edit= 8829 to JSYSF.MAC on 14-Apr-88 by RASPUZZI
;Prevent more hung jobs by having JFNS% release the FILLCK along with the
;JFNLCK before potentially page faulting.
; Edit= 8820 to JSYSF.MAC on 7-Apr-88 by RASPUZZI
;Mr. VANISH is back! Fix yet another hung job case where JFNS% is using a copy
;on write page to barf the file name into. Release the JFNLCK before
;outputting characters.
; Edit= 8817 to JSYSF.MAC on 31-Mar-88 by RASPUZZI
;Prevent hung jobs because edit 8801 missed to exit points of JFNS% in the
;attribute handling routine.
; Edit= 8811 to JSYSF.MAC on 29-Mar-88 by RASPUZZI, for SPR #21880
;Install edit 8804 into 7.0 monitor. Note, there is no bug here, it has been
;installed to protect the monitor's innocence for later editting in case
;someone gets into edit 3062 dangerousness.
; Edit= 8801 to JSYSF.MAC on 17-Mar-88 by RASPUZZI
;Prevent ILMNRFs or RELBADs by having GNJFN% and JFNS% use the JFNLCK when
;dealing with important information in the JFN block.
; UPD ID= 8684, RIP:<7.MONITOR>JSYSF.MAC.17, 17-Mar-88 19:12:21 by RASPUZZI
;TCO 7.1257 - Make DIRINI entry point for CRDIR%.
; UPD ID= 8665, RIP:<7.MONITOR>JSYSF.MAC.16, 24-Feb-88 17:40:48 by RASPUZZI
;More of TCO 7.1231 - Move CHPLEN out of the way of the mainline of code.
; UPD ID= 8650, RIP:<7.MONITOR>JSYSF.MAC.15, 18-Feb-88 15:33:40 by RASPUZZI
;TCO 7.1231 - Make CRDIR% enforce a minimum password length if it is
; set for the system.
; UPD ID= 8535, RIP:<7.MONITOR>JSYSF.MAC.14, 9-Feb-88 16:24:27 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8420, RIP:<7.MONITOR>JSYSF.MAC.13, 4-Feb-88 12:28:58 by GSCOTT
;TCO 7.1210 - Set CRDBAK, CRDBK1, DELBDD normally not dumpable.
; UPD ID= 8360, RIP:<7.MONITOR>JSYSF.MAC.11, 21-Jan-88 14:31:29 by EVANS
;TCO 7.1192 - Increase size of JSBVAR created by edit 7461, so we
; don't overflow it and ILMNRF; also tell SOUT% how much to copy.
; UPD ID= 8342, RIP:<7.MONITOR>JSYSF.MAC.10, 15-Jan-88 10:56:51 by RASPUZZI
;TCO 7.1181 - Fix fencepost error in TCO 7.1044. Adjust count of words
; initialized by RFTAD% before doing initialization.
; UPD ID= 248, RIP:<7.MONITOR>JSYSF.MAC.9, 4-Nov-87 16:40:52 by MCCOLLUM
;TCO 7.1112 - Fix up DELDIR, RCNUM, RCUSR% and SFUS10 to use LGSIDX
; UPD ID= 150, RIP:<7.MONITOR>JSYSF.MAC.8, 29-Sep-87 18:22:46 by MCCOLLUM
;More of TCO 7.1063 - Fix up misuse of STRSTS field in CRDIR%
; UPD ID= 129, RIP:<7.MONITOR>JSYSF.MAC.7, 23-Sep-87 15:44:52 by MCCOLLUM
;TCO 7.1063 - Check for STRX10 in CHFDB%, DELNF%, GTFDB%, RCDIR%, and SIZEF%.
; UPD ID= 118, RIP:<7.MONITOR>JSYSF.MAC.6, 17-Sep-87 17:54:31 by GSCOTT
;TCO 7.1059 - Preserve byte counts of 34359738367(36) used by COBOL
; UPD ID= 109, RIP:<7.MONITOR>JSYSF.MAC.5, 15-Sep-87 16:08:15 by RASPUZZI
;TCO 7.1055 - Before we delete a directory, we must uncache all OFNs that
;were refering to it so CFS will not allow the allocation token to be
;used for 2 resources.
; UPD ID= 92, RIP:<7.MONITOR>JSYSF.MAC.4, 28-Aug-87 09:05:21 by RASPUZZI
;TCO 7.1044 - Make sure that the RFTAD% JSYS can handle 30-bit argument
;blocks passed in from the user.
; UPD ID= 38, RIP:<7.MONITOR>JSYSF.MAC.3, 14-Jul-87 14:15:56 by RASPUZZI
;TCO 7.1020 - Don't allow non-WHEELs to set the password expiration date
;or the password usage count word in CRDIR%.
; *** Edit 7475 to JSYSF.MAC by EVANS on 4-May-87
; Change sense of test so as not to skip over new code.
; *** Edit 7461 to JSYSF.MAC by EVANS on 28-Apr-87, for SPR #19914
; Do not allow removal of Subdirectory-user-group-allowed if subdirectory has
; it as a current User Group
; *** Edit 7460 to JSYSF.MAC by MCCOLLUM on 27-Apr-87, for SPR #21382
; In CLZFF6, call UNLCKF to unlock file and go OKINT instead of the
; OKINT/LUNLK0 combination. UNLCKF does the right thing for different types of
; JFNs.
; *** Edit 7453 to JSYSF.MAC by THOUMIRE on 16-Apr-87
; Replace Comment line for edit 7451
; *** Edit 7451 to JSYSF.MAC by THOUMIRE on 16-Apr-87, for SPR #21237
; Check if file is closed at UFPGS to prevent CFNLTK Bughlt
; *** Edit 7448 to JSYSF.MAC by MCCOLLUM on 14-Apr-87, for SPR #21382
; Do an OKINT in CLZFF6 to balance the NOINT done for a file lock in CHKJFD
; *** Edit 7440 to JSYSF.MAC by RASPUZZI on 7-Apr-87, for SPR #21583
; Prevent ILMNRF BUGHLTs in CRDIR% by ignoring "quota exceeded" from PAGEM when
; the allocation is equal to file pages (directory creation is supposed to be
; free).
; *** Edit 7384 to JSYSF.MAC by MCCOLLUM on 15-Oct-86, for SPR #21288
; Add ASGF2 to FILST1. This bit should ALWAYS shadow the state of ASGF in
; FILSTS
; *** Edit 7372 to JSYSF.MAC by RASPUZZI on 3-Oct-86
; TTPINI is now in GLOBS. We don't need it in EXTN.
; *** Edit 7365 to JSYSF.MAC by RASPUZZI on 16-Sep-86, for SPR #21264
; Make sure ASND% sets up XON/XOFF recognition like OPENF% does for TTY device
; designators.
; *** Edit 7355 to JSYSF.MAC by RASPUZZI on 20-Aug-86, for SPR #20454
; Make JFNS% print out 16-Nov-1858 19:00:00 correctly.
; *** Edit 7351 to JSYSF.MAC by EVANS on 12-Aug-86, for SPR #21270
; Remove edit 7117 - do not check for unmounted structure in RCDIR; RE edit 3045 to
; EXEC.
; *** Edit 7321 to JSYSF.MAC by WONG on 17-Jun-86, for SPR #20898 (TCO none)
; Rewrite .SFPTR JSYS to include LSN in its calculation of the byte count if
; bit SF%LSN is on.
; *** Edit 7304 to JSYSF.MAC by EVANS on 28-May-86, for SPR #20545
; Check for second opening bracket in wildcarded directory spec to prevent
; commands involving such a spec from appearing to hang.
; *** Edit 7276 to JSYSF.MAC by DMCDANIEL on 27-Mar-86, for SPR #20527
; Put in code to check JFNS flags to see if it needs to write a tab or not.
; *** Edit 7253 to JSYSF.MAC by LOMARTIRE on 5-Mar-86, for SPR #21029
; Make .DELNF honor the FB%NDL bit
; *** Edit 7207 to JSYSF.MAC by WAGNER on 9-Dec-85
; Fix RETRIEVAL so that multiple requests do not result in failures due to lack
; of free space. Reduce incidence of FSPOUT BUGINFs.
; *** Edit 7196 to JSYSF.MAC by WONG on 19-Nov-85, for SPR #20883
; Fix JSYS FFUFP to return the correct error when JSB is full
; Edit 7162 to JSYSF.MAC by PALMIERI on 21-Oct-85, for SPR #20445 (TCO 6.1.1539)
; Make WILD% understand OWGBPs.
; Edit 7161 to JSYSF.MAC by MAYO on 18-Oct-85 (TCO 6-1-1538)
; Allow modification of .FBBK1 by WHEEL users.
; UPD ID= 2327, SNARK:<6.1.MONITOR>JSYSF.MAC.80, 6-Sep-85 12:25:51 by LOMARTIRE
;More TCO 6.1.1535 - Do not clobber T2 in SIZEF%
; UPD ID= 2325, SNARK:<6.1.MONITOR>JSYSF.MAC.79, 5-Sep-85 10:00:23 by LOMARTIRE
;TCO 6.1.1535 - Make CHFDB% broadcast EOF and make SIZEF% inquire about EOF
; Edit 7117 to JSYSF.MAC by EVANS on 8-Aug-85 (TCO none)
; Do not display every dir name on expunge unmounted structure;
; catch the error earlier, in RCDIR. This replaces edit 3060.
; Edit 7107 to JSYSF.MAC by LOMARTIRE on 26-Jul-85 (TCO 6-2192 )
; Add all the intended functionality of TCO 6.2192
; Edit 7105 to JSYSF.MAC by MAYO on 25-Jul-85, for SPR #18595 (TCO 6-1-1499)
; Have ARCF% .ARDIS clear ALL the offline data when both tape pointers are
; cleared.
; Edit 7104 to JSYSF.MAC by MAYO on 24-Jul-85, for SPR #19052
; ARCF% .ARSST function should not check FB%NOD. Remove the test.
; Edit 7103 to JSYSF.MAC by LOMARTIRE on 24-Jul-85, for SPR #20325
; Make KILLing a new directory avoid races and directory damage
; UPD ID= 2093, SNARK:<6.1.MONITOR>JSYSF.MAC.78, 3-Jun-85 14:49:19 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1969, SNARK:<6.1.MONITOR>JSYSF.MAC.77, 13-May-85 17:10:41 by GLINDELL
;TCO 6.1.1381 - fix SWJFN% for DECNET JFN's
; UPD ID= 1947, SNARK:<6.1.MONITOR>JSYSF.MAC.76, 9-May-85 17:12:51 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1884, SNARK:<6.1.MONITOR>JSYSF.MAC.75, 4-May-85 14:21:11 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1820, SNARK:<6.1.MONITOR>JSYSF.MAC.74, 24-Apr-85 19:54:30 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1714, SNARK:<6.1.MONITOR>JSYSF.MAC.73, 5-Apr-85 14:05:27 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 1566, SNARK:<6.1.MONITOR>JSYSF.MAC.72, 25-Feb-85 13:47:40 by WAGNER
;TCO 6.1.1219 - Do not allow negative quotas in directories, QAR 706383
; UPD ID= 1401, SNARK:<6.1.MONITOR>JSYSF.MAC.71, 24-Jan-85 16:41:53 by LOMARTIRE
;TCO 6.1.1132 - Prevent LCKDIRs from edit 2612 via RCUSR%
; UPD ID= 1400, SNARK:<6.1.MONITOR>JSYSF.MAC.70, 24-Jan-85 14:58:25 by LOMARTIRE
;TCO 6.2192 - Make DELETE, KEEP work with temp files of low generation
; UPD ID= 1398, SNARK:<6.1.MONITOR>JSYSF.MAC.69, 23-Jan-85 16:34:39 by HAUDEL
;TCO 6.1.1154 - Add an ERJMPR after a RPACS%.
; UPD ID= 1366, SNARK:<6.1.MONITOR>JSYSF.MAC.68, 21-Jan-85 10:03:50 by MAYO
;tco 6.1.1147 - Have ARCF% discard function clear AR%WRN
; UPD ID= 1284, SNARK:<6.1.MONITOR>JSYSF.MAC.66, 7-Jan-85 16:23:44 by MCCOLLUM
;TCO 6.1.1118 - Don't CALL UPDDIR for ARCF% function .ARGST
; UPD ID= 4960, SNARK:<6.MONITOR>JSYSF.MAC.65, 18-Oct-84 15:46:51 by TBOYLE
;TCO 6.2244 (QAR 706222) - Make indexed byte pointers work for WILD%
; UPD ID= 4812, SNARK:<6.MONITOR>JSYSF.MAC.64, 17-Sep-84 10:02:11 by PURRETTA
;Update copyright notice
; UPD ID= 4774, SNARK:<6.MONITOR>JSYSF.MAC.63, 29-Aug-84 17:23:10 by TBOYLE
;TCO 6.2206 (QAR 706154) CHFDB WHELX1 error when needed.
; UPD ID= 4668, SNARK:<6.MONITOR>JSYSF.MAC.62, 8-Aug-84 15:29:03 by LEACHE
;TCO 6.2166 Fix problem in CRDIR PPN uniqueness check
; UPD ID= 4454, SNARK:<6.MONITOR>JSYSF.MAC.61, 12-Jul-84 10:38:23 by CDUNN
;More TCO 6.1127 Make call to SCSKIL in CLZFF% conform to new caller sequence
; UPD ID= 4294, SNARK:<6.MONITOR>JSYSF.MAC.60, 4-Jun-84 14:05:08 by TBOYLE
;TCO 6.2080 - Fix PPN setting on structure creation. At CRD3BC.
; UPD ID= 4248, SNARK:<6.MONITOR>JSYSF.MAC.59, 29-May-84 17:06:06 by TBOYLE
;TCO 6.2070 - Check NETN before calling RElIQ% in CLZFF% - QAR #706001
; UPD ID= 4049, SNARK:<6.MONITOR>JSYSF.MAC.58, 5-Apr-84 08:33:18 by PAETZOLD
;TCO 6.2022 - Remove call to MSTKOV as we now have global stack pointers.
; UPD ID= 4028, SNARK:<6.MONITOR>JSYSF.MAC.57, 31-Mar-84 20:26:46 by GRANT
;Remove definitions for FTCI, FTKLIPA, and CFSCOD
; UPD ID= 4020, SNARK:<6.MONITOR>JSYSF.MAC.56, 31-Mar-84 16:20:28 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3933, SNARK:<6.MONITOR>JSYSF.MAC.55, 15-Mar-84 17:45:50 by TGRADY
;TCO 6.2001 - Fix to last edit, don't call LCL2GL with invalid job index
; UPD ID= 3923, SNARK:<6.MONITOR>JSYSF.MAC.54, 14-Mar-84 10:50:47 by TGRADY
;TCO 6.1997 - Fix .DVCHR to return the global job number of the job that
; has the device assigned.
;
; UPD ID= 3486, SNARK:<6.MONITOR>JSYSF.MAC.53, 20-Jan-84 07:44:44 by MCINTEE
;TCO 6.1932 - JFNS%: allow password attribute to be returned when parse only.
; UPD ID= 3222, SNARK:<6.MONITOR>JSYSF.MAC.52, 28-Nov-83 11:00:49 by GLINDELL
;TCO 6.1882 - Allow MTOPR without JFN open if D1%MTO set for device
; UPD ID= 3188, SNARK:<6.MONITOR>JSYSF.MAC.51, 17-Nov-83 16:22:26 by CDUNN
;More TCO 6.1127 - Remove SCSKIL's dependancy on TRVAR in .CLZFF code.
; UPD ID= 3101, SNARK:<6.MONITOR>JSYSF.MAC.50, 4-Nov-83 17:00:54 by TSANG
;TCO 6.1807 - Update byte pointer in AC2 after .SFUST JSYS.
; UPD ID= 3087, SNARK:<6.MONITOR>JSYSF.MAC.48, 31-Oct-83 16:54:48 by CJOHNSON
;TCO 6.1845 - Add new error CFDBX5 for non disk CHFDB calls
; UPD ID= 3022, SNARK:<6.MONITOR>JSYSF.MAC.47, 10-Oct-83 17:31:46 by MOSER
;TCO 6.1747 - ALLOW WRITER TO CHFDB FB%FCF - MAKE BITS CONSISTENT FOR WHEELS
; UPD ID= 2982, SNARK:<6.MONITOR>JSYSF.MAC.46, 4-Oct-83 15:58:36 by TBOYLE
;TCO 6.1803 DELDI4 to call REMSDR for special dirs.
; UPD ID= 2954, SNARK:<6.MONITOR>JSYSF.MAC.45, 28-Sep-83 16:21:02 by MOSER
;TCO 6.1726 - MAKE CHFDB WORK FOR NEWLY CREATED FILE
; UPD ID= 2895, SNARK:<6.MONITOR>JSYSF.MAC.44, 16-Sep-83 08:44:06 by TBOYLE
;TCO 6.1799 - Don't check superior's quota if LIQ not being set by CRDIR%
; UPD ID= 2827, SNARK:<6.MONITOR>JSYSF.MAC.43, 11-Aug-83 15:34:14 by CDUNN
;More TCO 6.1127 - Add comment to CLZFF indicating SCSJSY dependancy on
;TRVAR in CLZFF
; UPD ID= 2796, SNARK:<6.MONITOR>JSYSF.MAC.42, 4-Aug-83 00:30:07 by LEACHE
;TCO 6.1641 Move swappable freespace out of section zero
; UPD ID= 2703, SNARK:<6.MONITOR>JSYSF.MAC.41, 18-Jul-83 16:13:58 by JCAMPBELL
;TCO 6.1729 - Allow CHFDB to modify FB%FOR (FORTRAN data) in .FBCTL in FDB.
; UPD ID= 2442, SNARK:<6.MONITOR>JSYSF.MAC.40, 6-May-83 13:34:51 by CHALL
;TCO 6.1644 - MORE TOPS-10 PPN STUFF - APPROVE A PPN OF 0,,0 (IE, NO PPN)
; UPD ID= 2285, SNARK:<6.MONITOR>JSYSF.MAC.39, 16-Apr-83 19:14:09 by PAETZOLD
;TCO 6.1557 - TCP Merge - Update copyright - Delete very old edit history.
; UPD ID= 2175, SNARK:<6.MONITOR>JSYSF.MAC.38, 6-Apr-83 07:16:31 by FLEMMING
; UPD ID= 2133, SNARK:<6.MONITOR>JSYSF.MAC.37, 2-Apr-83 22:50:20 by LEACHE
;TC0 6.1247 Add more password encryption
; UPD ID= 2104, SNARK:<6.MONITOR>JSYSF.MAC.36, 28-Mar-83 17:46:19 by MILLER
;TCO 6.1094. Don't need GETALF anymore
; UPD ID= 2100, SNARK:<6.MONITOR>JSYSF.MAC.35, 28-Mar-83 17:39:47 by MURPHY
;TCO 6.1472 - Minor cleanup re. LSTERR.
; UPD ID= 1924, SNARK:<6.MONITOR>JSYSF.MAC.34, 7-Mar-83 20:38:01 by CDUNN
;Make default be to get KLIPA code but not CI simulator code or CFS code
; UPD ID= 1918, SNARK:<6.MONITOR>JSYSF.MAC.33, 7-Mar-83 14:30:57 by WEETON
;TCO 6.1534 - Allow wild cards in logical names of directorys
; UPD ID= 1871, SNARK:<6.MONITOR>JSYSF.MAC.32, 23-Feb-83 15:13:22 by MAYO
;TCO 6.1524. Fix off by one at .ARCF+6 (edit 2918 to 5.1)
; UPD ID= 1806, SNARK:<6.MONITOR>JSYSF.MAC.31, 14-Feb-83 18:40:52 by MILLER
;TCO 6.1094. Improve call to GETALF
; UPD ID= 1778, SNARK:<6.MONITOR>JSYSF.MAC.30, 10-Feb-83 05:46:36 by CDUNN
;More TCO 6.1127 Add support to CLZFF% for cleaning up SCS% data
; UPD ID= 1708, SNARK:<6.MONITOR>JSYSF.MAC.29, 27-Jan-83 20:14:47 by MILLER
;TCO 6.1094. Code to do CFS directory allocation
; UPD ID= 1555, SNARK:<6.MONITOR>JSYSF.MAC.28, 21-Dec-82 11:25:19 by MAYO
;Edit 2612 - Fix RCUSR to return RC%NMD if trying to step non-wild string.
; UPD ID= 1518, SNARK:<6.MONITOR>JSYSF.MAC.27, 7-Dec-82 20:47:45 by COBB
;TCO 5.1.1112 - Check READF in SMAP%. -- on behalf of MURPHY
; UPD ID= 1508, SNARK:<6.MONITOR>JSYSF.MAC.26, 2-Dec-82 09:24:41 by MOSER
;TCO 6.1201 - RETURN CFDBX3 WHEN APPROPRIATE
; UPD ID= 1447, SNARK:<6.MONITOR>JSYSF.MAC.25, 16-Nov-82 14:00:57 by LOMARTIRE
;TCO 6.1358 - Add documentation to DELBDD BUGINF
; UPD ID= 1420, SNARK:<6.MONITOR>JSYSF.MAC.24, 5-Nov-82 15:07:43 by LEACHE
;TCO 6.1348 Fix use of password encryption version number
; UPD ID= 1252, SNARK:<6.MONITOR>JSYSF.MAC.23, 28-Sep-82 08:15:02 by MCINTEE
;The edit made on 21-Sep-82 was wiped out. Restore it !!
; UPD ID= 1244, SNARK:<6.MONITOR>JSYSF.MAC.22, 26-Sep-82 15:13:24 by LEACHE
;More 6.1247 Use T1 in call to CHKPEV
; UPD ID= 1241, SNARK:<6.MONITOR>JSYSF.MAC.21, 24-Sep-82 15:21:19 by LEACHE
;TCO 6.1247 - Add password encryption
; UPD ID= 1236, SNARK:<6.MONITOR>JSYSF.MAC.20, 24-Sep-82 12:26:12 by MILLER
;TCO 5.1.1070. Set GJ%ACC in CRDIR's GTJFN block
; UPD ID= 1207, SNARK:<6.MONITOR>JSYSF.MAC.19, 21-Sep-82 14:41:28 by MCINTEE
;TCO 6.1030 - DVCHR% correction
; UPD ID= 1108, SNARK:<6.MONITOR>JSYSF.MAC.18, 25-Aug-82 08:11:42 by MCINTEE
;TCO 6.1030 - Make CRDCMP global
; UPD ID= 1103, SNARK:<6.MONITOR>JSYSF.MAC.17, 23-Aug-82 12:59:21 by MCINTEE
;TCO 6.1230 - remote aliases support for CRDIR%
; UPD ID= 986, SNARK:<6.MONITOR>JSYSF.MAC.16, 13-Jul-82 15:49:40 by MCINTEE
;More of previous edit.
; UPD ID= 976, SNARK:<6.MONITOR>JSYSF.MAC.15, 6-Jul-82 16:12:55 by MCINTEE
;More TCO 6.1030 - Make DVCHR work for NFT device JFNs.
; UPD ID= 971, SNARK:<6.MONITOR>JSYSF.MAC.14, 30-Jun-82 11:17:00 by WALLACE
;TCO 6.1181 - Make JFNS% output all linked attributes for parse only JFN's
; UPD ID= 884, SNARK:<6.MONITOR>JSYSF.MAC.13, 9-Jun-82 16:02:02 by MCINTEE
;TCO 6.1030 - change some MDDOKs to DSKOK
; UPD ID= 846, SNARK:<6.MONITOR>JSYSF.MAC.12, 6-Jun-82 13:27:18 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 647, SNARK:<6.MONITOR>JSYSF.MAC.11, 15-Apr-82 15:55:11 by PAETZOLD
;TCO 5.1775 - Make UFPGS performance for short files improve
; UPD ID= 550, SNARK:<6.MONITOR>JSYSF.MAC.10, 24-Mar-82 10:32:53 by COBB
;TCO 5.1769 - Check for stepping directories at RCD550 to avoid LCKDIR bughalt
; UPD ID= 515, SNARK:<6.MONITOR>JSYSF.MAC.8, 16-Mar-82 20:34:16 by PAETZOLD
;TCO 5.1758 - Check SFTAD count
; UPD ID= 299, SNARK:<6.MONITOR>JSYSF.MAC.7, 14-Jan-82 08:58:32 by MCINTEE
;TCO 6.1056 - node control field in JFNS
; UPD ID= 277, SNARK:<6.MONITOR>JSYSF.MAC.6, 5-Jan-82 20:35:22 by MILLER
;TCO 6.1053. ALLOW WHOPER TO CHANGE FB%WNC
; UPD ID= 215, SNARK:<6.MONITOR>JSYSF.MAC.5, 20-Nov-81 16:46:36 by MCINTEE
;correction of TCO 6.1030; in DVCHR% change MDDOK to DSKOK
; UPD ID= 142, SNARK:<6.MONITOR>JSYSF.MAC.4, 19-Oct-81 16:06:52 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 115, SNARK:<6.MONITOR>JSYSF.MAC.3, 16-Oct-81 17:34:01 by MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
; UPD ID= 97, SNARK:<6.MONITOR>JSYSF.MAC.2, 8-Oct-81 11:55:49 by MURPHY
;TCO 6.1028 - Fix bugs in CRDIR% checking of offline expiration date.
; UPD ID= 186, SNARK:<5.MONITOR>JSYSF.MAC.25, 16-Sep-81 15:36:44 by DONAHUE
;TCO 5.1513 - Increment subdirectory count in <ROOT-DIRECTORY> on CRDIR%
; UPD ID= 164, SNARK:<5.MONITOR>JSYSF.MAC.24, 10-Sep-81 14:41:29 by PAETZOLD
;TCO 5.1481 - Check for non-seven bit OWGBP's in JSYS calls
; UPD ID= 82, SNARK:<5.MONITOR>JSYSF.MAC.22, 27-Jul-81 15:19:54 by GROUT
; UPD ID= 54, SNARK:<5.MONITOR>JSYSF.MAC.21, 21-Jul-81 11:39:40 by GROUT
;TCO 5.1425 - Fix .RCUSR/.RCDIR for wild strings and .RCUSR for access checking
; UPD ID= 37, SNARK:<5.MONITOR>JSYSF.MAC.20, 16-Jul-81 10:55:56 by DONAHUE
;TCO 5.1413 - Return byte pointer to user at JFNSZ-2
; UPD ID= 2074, SNARK:<5.MONITOR>JSYSF.MAC.19, 25-May-81 11:33:03 by ZIMA
;TCO 5.1348 - Fix SIBE for LSTERR conditions.
; UPD ID= 2058, SNARK:<5.MONITOR>JSYSF.MAC.18, 21-May-81 11:04:50 by SCHMITT
;Tco 5.1340 - Release JFN if CHKOFN fails at DELDI6: + 20L
; UPD ID= 2033, SNARK:<5.MONITOR>JSYSF.MAC.17, 19-May-81 14:09:31 by ZIMA
;Correct typo in previous edit...
; UPD ID= 2006, SNARK:<5.MONITOR>JSYSF.MAC.16, 15-May-81 00:07:40 by ZIMA
;TCO 5.1329 - Recode GTSTS to consistently return status bits.
; UPD ID= 1981, SNARK:<5.MONITOR>JSYSF.MAC.15, 12-May-81 23:25:18 by ZIMA
;TCO 5.1323 - Fix CRDIR to preserve MAIL.TXT attributes - create only on
; directory creation.
; UPD ID= 1913, SNARK:<5.MONITOR>JSYSF.MAC.13, 30-Apr-81 16:49:13 by CHALL
;Make FB%NDL require operator/wheel privs
; UPD ID= 1508, SNARK:<5.MONITOR>JSYSF.MAC.12, 30-Jan-81 16:32:48 by ZIMA
;TCO 5.1255 - rewrite SACTF JSYS to fix GNJFN side-effects and other bugs.
; UPD ID= 1488, SNARK:<5.MONITOR>JSYSF.MAC.11, 25-Jan-81 01:26:36 by ZIMA
;TCO 5.1243 - Fix CRDIR to work with -1,,ADR pointer to password again.
; UPD ID= 1446, SNARK:<5.MONITOR>JSYSF.MAC.10, 15-Jan-81 15:58:24 by FLEMMING
;add code for SMAP/RSMAP
; UPD ID= 1304, SNARK:<5.MONITOR>JSYSF.MAC.9, 21-Nov-80 10:26:16 by DONAHUE
;TCO 5.1200 - Make ARACCK check for EXE access requested
; UPD ID= 1087, SNARK:<5.MONITOR>JSYSF.MAC.8, 1-Oct-80 12:06:29 by MURPHY
;FIX ACVAR
; UPD ID= 1008, SNARK:<5.MONITOR>JSYSF.MAC.7, 11-Sep-80 18:26:54 by GRANT
;Change MONX01 to MONX02 in .FFFFP routines
; UPD ID= 964, SNARK:<5.MONITOR>JSYSF.MAC.6, 25-Aug-80 16:27:47 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 756, SNARK:<5.MONITOR>JSYSF.MAC.5, 14-Jul-80 13:15:13 by GRADY
; Corrrection for TCO 5.1081, call USTDIR when CRDI19 error given.
; UPD ID= 713, SNARK:<5.MONITOR>JSYSF.MAC.4, 30-Jun-80 13:57:18 by GRADY
; UPD ID= 697, SNARK:<5.MONITOR>JSYSF.MAC.3, 25-Jun-80 17:05:26 by GRADY
; TCO 5.1081 - Recover FDB index in CHFDB1 before trying to use it.
; UPD ID= 684, SNARK:<5.MONITOR>JSYSF.MAC.2, 21-Jun-80 11:51:44 by SCHMITT
;TCO 5.1073 - Use TPRCYC for Def file Offline Exp if set at DIRINI+60L
; UPD ID= 279, SNARK:<4.1.MONITOR>JSYSF.MAC.115, 20-Feb-80 09:13:00 by MILLER
; UPD ID= 276, SNARK:<4.1.MONITOR>JSYSF.MAC.114, 19-Feb-80 11:02:20 by MILLER
;TCO 4.1.1083. MAKE CZ%ARJ BE FORCED CLOSE IF FROM LOGOUT
; UPD ID= 121, SNARK:<4.1.MONITOR>JSYSF.MAC.113, 10-Dec-79 11:35:49 by SANICHARA
; TCO 4.1.1053 - Restore file status properly before call to UNLCKF
; UPD ID= 82, SNARK:<4.1.MONITOR>JSYSF.MAC.112, 3-Dec-79 13:22:39 by SCHMITT
;TCO 4.1.1041 - Allow SWJFN JSYS to swap entire JFN blocks
; UPD ID= 63, SNARK:<4.1.MONITOR>JSYSF.MAC.111, 30-Nov-79 09:35:36 by MILLER
;FIX BLOCKING IN CLZFF2 WHEN MAP COUNT IS NON-ZERO
; UPD ID= 23, SNARK:<4.1.MONITOR>JSYSF.MAC.110, 27-Nov-79 14:20:26 by DBELL
;TCO 4.1.1032 - FIX SFTAD TO ALLOW SETTING INTERVALS PROPERLY.
;<4.1.MONITOR>JSYSF.MAC.109, 26-Nov-79 11:04:19, EDIT BY MILLER
;TCO 4.1.1026. LOCK FILLCK IN JFNDCR AND IN CLZMRC
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG
TTITLE JSYSF
SWAPCD
;THIS FILE CONTAINS CODE WHICH IMPLEMENTS VARIOUS FILE JSYSES.
;ONLY JSYSES WHICH REQUIRE ONE OR MORE OF THE FILE-SPECIFIC AC
;DEFINITIONS (JFN, STS, ETC.) ARE HERE.
PPNLH==:4 ;SYSTEM DEFINED PPN LHS
;FIRST PORTION OF THE FILE CONTAINES MISC SUBROUTINES USED HEREIN.
;SECOND (MAJOR) PORTION CONTAINES JSYSES ORDERED ALPHABETICALLY
;SPECIAL AC DEFINITIONS USED HEREIN
DEFAC (STS,P1) ;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
DEFAC (F1,P5)
;ERROR RETURNS AND TRAPS
ERUNLD::CALL UNLCKF
RETERR()
; Set file byte number common code
; Call: A ; Byte number
; CALL SFBNR
; Return
; +1 ; Error of some sort, error number in a
; +2 ; Success
; Clobbers most temps
SFBNR:: TQNN <RNDF>
JRST [ MOVEI A,SFPTX2
RET] ; Illegal to reset pointer for this file
CAMN A,[-1]
MOVE A,FILLEN(JFN) ; Set to end of file if -1
JUMPL A,[MOVEI A,SFPTX3
RET] ; Illegal byte number
MOVEM A,FILBYN(JFN)
TQZ <EOFF>
TQNE <WRTF> ;FILE OPEN FOR WRITING?
JRST [ CAML A,FILLEN(JFN) ;YES, POINTER SET BEYOND CURRENT END?
CALL [ MOVEM A,FILLEN(JFN)
CALLRET UPDLEN] ;UPDATE END
JRST SFBNR1]
CAML A,FILLEN(JFN)
JRST [ CALL GETLEN ;GET REAL FILLEN
CAML A,FILLEN(JFN)
TQO <EOFF>
JRST SFBNR1] ;EXIT
SFBNR1: SETZM FILCNT(JFN) ;FORCE NEW WINDOW NEXT OPERATION
RETSKP
NFBSZ:: CAIE B,7 ;IF USER SWITCHES TO NON-ASCII,
TQO <PASLSN> ;THEN ASSUME IT'S NOT AN EDIT FILE
MOVEI C,^D36
IDIVM C,A ; Number of bytes per word
MOVEI C,^D36
IDIV C,B ; New number of bytes per word
PUSH P,C
IMUL C,FILBYN(JFN) ; Adjust byte number
IDIV C,A
CAIE D,0
AOS C
MOVEM C,FILBYN(JFN)
POP P,C
IMUL C,FILLEN(JFN) ; And adjust file length
IDIV C,A
CAIE D,0
AOS C
MOVEM C,FILLEN(JFN)
DPB B,PBYTSZ ; Deposit new byte size
RET
; This routine is called from write copy code in pagem to reduce the
; The map count of a page
; Call: 1 ; Ofn.pn
; CALL JFNDCR
; Returns +1 always
JFNDCR::CALL OFNJXL
RET
MOVSI B,-2
ADDB B,FILLFW(A) ;REDUCE MAP COUNT
TLNE B,777777 ;COUNT NOW ZERO AND CLOSF DONE?
JRST JFNDC0
MOVX B,FRKF ;YES, UNRESTRICT FILE SO ANY CLZFF GETS IT
ANDCAM B,FILSTS(A)
JFNDC0: CALL LUNLKF ;UNLOCK JFN AND STRUCTURE LOCK'
OKINT ;AND UNDO THE NOINT
RET
;ROUTINES TO CHECK TTY'S.
;CALL JFN ;SOME KIND OF SOURCE/DESTINATION DESIGNATOR
; CALL CHKTTR ;IS THIS A TERMINAL?
;RETURN
; +1 ;NO, ERROR CODE IN A.
; +2 ;YES
;ON SUCCESS, THE FOLLOWING ARE SET UP:
; DEV ;CORRECT STUFF FOR REFERENCED TERMINAL
; B ;LINE NUMBER
; C ;0 IF JFN NOT GIVEN, BYTE SIZE OF OPEN
; ; IF A JFN WAS GIVEN
CHKTTR::UMOVE JFN,1 ;GET DESIG
CHKTR1: CAIGE JFN,1B18+NLINES ;TTY DESIG?
CAIGE JFN,1B18
JRST CHKTTC ;NO
HRLI DEV,-1B18(JFN) ;YES, SET UP LINE #
CHKTC1: HRRI DEV,TTYDTB ;SET UP TTY DISPATCH IN DEV
MOVX STS,READF+WRTF+OPNF
HLRZ B,DEV ;RETURN LINE NUMBER IN B
SETZ C, ;NOT A JFN, NO BYTE SIZE
RETSKP
CHKTTC: HRLI DEV,(JFN) ;FIRST ASSUME TTY
CAMGE JFN,[600000+.DVTTY,,NLINES]
CAMGE JFN,[600000+.DVTTY,,0]
CAIA
JRST CHKTC1 ;WE HAVE 600000+.DVTTY,,LINE #
CALL CHKJFN
RETBAD(DESX1) ;GARBAGE
JRST CHKTT1 ;TTY
RETBAD(DESX1) ;BYTE PTR
CALL UNLCKF ;REGULAR JFN, UNLOCK IT
CHKTT1: TQNE <ASTF>
RETBAD(DESX7)
HRRZ A,DEV
HLRZ 2,DEV ;GET LINE NUMBER
CAIE 2,-1 ;DETACHED INDICATION?
CAIE A,TTYDTB
RETBAD (DESX6) ;NOT TTY
LDB C,[POINT 4,STS,35] ;GET BYTE SIZE OF OPEN
TXNE JFN,1B18 ;SPECIAL DESIGNATOR (100 OR 101)?
RETSKP ;YES. ALL DONE THEN
SKIPN C, ;IF NONE...
LDB C,PBYTSZ ; GET THE BYTE SIZE FROM FILBYT(JFN)
RETSKP
;CALL JFN ;SOME KIND OF SOURCE/DESTINATION DESIGNATOR
; CALL CHKTTR ;IS THIS AN AVAILABLE TERMINAL TO THIS JOB?
;RETURN
; +1 ;NO, ERROR CODE IN A.
; +2 ;YES
;ON SUCCESS, THE FOLLOWING ARE SET UP:
; DEV ;CORRECT STUFF FOR REFERENCED TERMINAL
; B ;LINE NUMBER
CHKTTM::SKIPA JFN,1 ;GET DESIG
CHKTTY::UMOVE JFN,1
STKVAR <LINENO> ;HOLDS TERMINAL LINE #
CALL CHKTR1 ;MAKE SURE IT'S A TERMINAL
RETBAD () ;IT'S NOT; ASSUME ERROR CODE IN T1.
MOVEM B,LINENO ;SAVE THE LINE NUMBER
MOVEI A,400000(B) ;MAKE TERMINAL DESIGNATOR
CALL CHKDEV ;IS THIS DEVICE AVAILABLE ?
RETBAD (DESX2) ;NOT AVAILABLE TO THIS JOB
MOVE B,LINENO ;RESTORE THE LINE NUMBER
RETSKP
;ROUTINE USED TO INCREMENT THE USE COUNT OF A JFN.
; T1/ THE JFN
; T2/ THE COUNT TO ADD TO CURRENT USE COUNT
;RETURNS:
; +1 JFN VANISHED
; +2 DONE
MJFCNT::SAVEP ;SAVE ALL VUNERABLE REGS
SAVEAC <F> ;THIS IS VULNERABLE TOO
LSH T2,1 ;DOUBLE THE SHARE COUNT
ASUBR <IJFN,COUNT>
MOVE JFN,T1 ;COPY JFN
CALL DSKJFN ;VERIFY AND CONVERT JFN
RET ;WENT AWAY
HRLZ T2,COUNT ;GET INCREMENT
ADDM T2,FILLFW(JFN) ;APPLY IT
CALL UNLCKF ;UNLOCK THE JFN
RETSKP ;AND DONE
REPEAT 0,< ;THIS IS INTENDED TO SUPPORT MULTIPLE
;DISK UNITS BUT IS NOT PRESENTLY USED.
;SET UP UNIT
; A/ B17 ON IF NOT DEFAULT
; B/ DEVICE DESIGNATOR
; RETURNS +1 - FAIL
; +2 - SUCCESS, U LOADED
SETUNT: EXCH A,B
MOVE U,JOBUNT
TLNN B,(1B17) ;DEFAULT TAKEN IF B17 OFF
RETSKP
CALL CHKDEV
RET
RETSKP
> ;END OF REPEAT 0
;ROUTINE TO REASSIGN OWNERSHIP OF A JFN. THIS IS USED WHENEVER
;A NEW FORK NEEDS TO ASSUME RESPONSIBILITY FOR THE JFN. EXAMPLES
;ARE: IF A FORK OTHER THAN THE CREATER ENABLES FOR PSI
;VIA THE JFN.
; JFN/ THE JFN
; IT MUST BE LOCKED
;RETURNS: +1 FAILURE. NONE DEFINED YET
; +2 DONE
REAJFN::HLRZ T1,FILVER(JFN) ;GET PRESENT OWNER
CAMN T1,FORKN ;ALREADY OWNED BY THIS GUY?
RETSKP ;DONE. NO CHANGE NEEDED
MOVE T1,FORKN ;NO. GET THIS FORK'S NUMBER
HRLM T1,FILVER(JFN) ;AND SET IT AS NEW OWNER
RETSKP ;AND DONE
; ARCF Jsys
; 1:JFN, 2: Function code, 3: Function dependent, normally 0
; Returns +1 always
.ARCF:: TRVAR <ROFLG>
MCENT
HRRZ JFN,T1 ; Copy JFN
CALL CKJFN ; Verify the JFN
MOVE P3,T1 ; Save FDB offset
XCTU [ MOVE T1,2] ; Get function code
XCTU [ MOVE Q3,3] ; Get param - if any
CAIL T1,0 ; Check function request
CAIL T1,NARFNS ; In range?
ERRJMP ARGX02,ARCFX ; Invalid function
SETZM ROFLG ;ASSUME NOT A READ ONLY FUNCTOIN
CAIN T1,.ARGST ;JUST READING?
SETOM ROFLG ;YES
CALL @ARCFF(T1) ; Do it
JRST ARCFX ; Failed for some reason
SKIPN ROFLG ;DON'T UPDATE IF READING ONLY
CALL UPDDIR ; Update directory
CALL USTDIR
CALL UNLCKF
MRETNG ; Done
ARCFX: CALL USTDIR ; Unlock things
ARCFXY: CALL UNLCKF
ITERR ()
ARCFF: IFIW!ARRAR ; 0 Request voluntary archive
IFIW!ARRIV ; 1 Request involuntary migration
IFIW!AREXM ; 2 File is exempt from migration
IFIW!ARRFR ; 3 Request file contents be restored
IFIW!ARDIS ; 4 Discard tape status
IFIW!ARSST ; 5 Set tape status for file
IFIW!ARRST ; 6 Restore contents of a file
IFIW!ARGST ; 7 Get tape status for file
IFIW!ARRFL ; 10 Restore failed, tell waiting fork
IFIW!ARNAR ; 11 Please don't migrate this file
NARFNS==.-ARCFF
; Request voluntary archive; Please don't migrate this file
ARNAR: LOAD T1,FBBBT,(P3)
TXNE T1,AR%RIV ; Requested?
RETBAD(ARCX19) ; Request pending
CALL CKAROF
RETBAD()
MOVX T2,AR%NAR
JRST ARRAR1
ARRAR: MOVX T2,AR%RAR ; Bit to set
HRRZ T1,Q3 ; Get set/clear flag
CAIN T1,.ARCLR ; Request to clear request?
JRST ARRAR1 ; Yes, can always clear it
LOAD T1,FBBBT,(P3) ; Get CTL bits
TXNE T1,AR%EXM ; File exempt ?
RETBAD(ARCX10) ; Yes, don't allow request
LOAD T1,FBFLG,(P3) ; Check some others too
TXNE T1,FB%OFF!FB%PRM!FB%DIR!FB%ARC!FB%TMP
RETBAD(ARCX10) ; Can't do it
ARRAR1: PUSH P,T2 ; Our bits will be stomped on
CALL CKWOWN ; Have write or owner access?
RETBAD(,<ADJSP P,-1>) ; No, fail
POP P,T2 ; Recover them
HRRZ T1,Q3 ; Get set/clear code
CAIN T1,.ARSET ; Set it?
IORM T2,.FBBBT(P3) ; Yes
CAIN T1,.ARCLR ; Clear the bit?
ANDCAM T2,.FBBBT(P3) ; Yes
TXNE T2,AR%NAR ; Did we say please don't?
RETSKP ; Yes, done here
CAIN T1,.ARCLR ; Have cleared the request?
JRST [ SETZRO <K0NAR,K0NDL>,(P3) ; Clear resist & don't flush
RETSKP] ; And exit
CALL CLRBOT ; Clear any previous stuff (migrated?)
SETZRO K0NAR,(P3) ; Can't still be resist now
MOVX T2,AR%NDL
TXNE Q3,AR%NDL ; Caller want don't flush set?
IORM T2,.FBBBT(P3) ; Yes, do that
RETSKP
; Involuntary migration; File exempt from migration
ARRIV: HRRZS Q3 ; No options through here
; - we may exit through ARRAR
CAIN Q3,.ARCLR ; Clear migration request?
JRST ARRIV1 ; Yes, always valid (gotta be WHOPR)
LOAD T1,FBBBT,(P3)
TXNE T1,AR%EXM!AR%RAR ; File exempt from migration?
RETBAD(ARCX15) ; Yes, fail
LOAD T1,FBFLG,(P3)
TXNE T1,FB%OFF!FB%PRM!FB%DIR!FB%ARC!FB%TMP
RETBAD(ARCX15) ; Can't if any of those
ARRIV1: CALL CKARDF ; Archive default for directory?
CAIA
JRST ARRAR ; Yes, turn migration into archive
MOVX T2,AR%RIV ; Invlountary migration
JRST AREXM1 ; Join farther down
AREXM: LOAD T1,FBFLG,(P3)
TXNE T1,FB%OFF ; Offline?
RETBAD(ARCX16) ; One of the 3 anyway
MOVX T2,AR%EXM ; Exempt
AREXM1: MOVE T1,CAPENB
TXNN T1,SC%WHL+SC%OPR ; Have necessary caps?
RETBAD(CAPX1) ; No
LOAD T1,FBFLG,(P3) ; Get ctl flags
HRRZ T1,Q3 ; Get set/clear flag
CAIN T1,.ARSET ; Set it?
IORM T2,.FBBBT(P3) ; Yes
CAIN T1,.ARCLR ; Clear it?
ANDCAM T2,.FBBBT(P3) ; Yes
TXNE T2,AR%RIV ; Migration request?
RETSKP
CAIN T1,.ARCLR ; Clearing exempt?
RETSKP ; Yes, done here
SETZRO <K0RIV,K0RAR,K0NDL>,(P3) ; Clear migration request (if any)
CALLRET CLRBOT ; and discard any tape info
; Request file be retrieved from offline storage
ARRFR: LOAD T1,FBFLG,(P3)
TXNN T1,FB%OFF ; Offline?
RETBAD(ARCFX9) ; No, fail
TXNE Q3,AR%WAT ; Caller waiting?
SKIPN NRTWTS ; Waits allowed?
CAIA ; Not waiting, or waits allowed
RETBAD(ARCX18) ; Say can't do it right now
; %%% check to see if caller has space left for this file
ARRFR3: HRRI T1,.RETM ;[7207] Send a retrieve message
HRLI T1,.RETR ; Default is normal request
TXNE Q3,AR%WAT ; User waiting?
HRLI T1,.RETRW ; Yes, relay that info
MOVE T2,P3 ; FDB offset
CALL ARCMSG ; Send the msg
JRST ARRFR2 ; [7207]Failed, IPCF message didn't happen
MOVX T1,AR%RFL
ANDCAM T1,.FBBBT(P3) ; Clear any old request failed flag
TXNN Q3,AR%WAT ; Done?
RETSKP ; Yes
ARRFR1: CALL USTDIR ; Unlock & make ourself interruptable
CALL UNLCKF
RETTST: MOVX T1,^D2*^D60*^D1000 ; Busy wait for file to appear
DISMS
XCTU [HRRZ JFN,1] ; Recover the JFN
CALL CKJFN ; Re-check things, GET T1/ FDB ADDR
LOAD T2,FBFLG,(T1) ; Get flags
TXNN T2,FB%OFF ; Still offline?
RETSKP ; Is back!
MOVX T2,AR%RFL ; Restore failed bit
TDNN T2,.FBBBT(T1) ; Did it?
JRST ARRFR1 ; No, wait some more
ANDCAM T2,.FBBBT(T1) ; Yes, clear the failure bit
CALL UPDDIR ; Get it back to disc
RETBAD(ARCX14) ; Tell 'em it failed
JRST ARRST ; [7207] restore the contents of offline file
ARRFR2: CAIE T1,IPCFX7 ; [7207] PID overquota?
CAIN T1,MONX06 ; [7207] or out of free space?
SKIPA ; [7207] yes, wait for QUASAR to read a packet
JRST ARRFR4 ; [7207] no, wait a while
CALL USTDIR ; [7207] Unlock and make us interruptable
CALL UNLCKF ; [7207]
AOS IPPKFR ; [7207] bump resource wait flag
MOVEI T1,IPPKFR ; [7207] get address of flag
CALL DISE ; [7207] wait until it gets cleared
MOVEI T1,^D10000 ; [7207] wait 10 seconds to "settle down"
DISMS ; [7207]
JRST ARRFR5 ; [7207] then will retry
ARRFR4: CALL USTDIR ; [7207] Unlock and make us interruptable
CALL UNLCKF ; [7207]
MOVX T1,^D2*^D60*^D1000 ; [7207] wait for two minutes
DISMS ; [7207]
ARRFR5: XCTU [HRRZ JFN,T1] ; [7207] get back the JFN
CALL CKJFN ; [7207] re-check, get T1/ FDB addr
MOVE P3,T1 ; [7207] save FDB offset
JRST ARRFR3 ; [7207] retry ARCMSG
; Restore contents of an offline file
ARRST: MOVE T1,CAPENB
TXNN T1,SC%OPR+SC%WHL ; Permitted?
RETBAD(CAPX1) ; No
LOAD T1,FBFLG,(P3) ; Get flags
TXNN T1,FB%OFF ; File offline?
RETBAD(ARCFX9) ; No, fail here
TQNE <OPNF> ; Cannot be open
ERRJMP OPNX1,ARCFX
SKIPE .FBADR(P3) ; File have contents?
BUG.(HLT,OFFONX,JSYSF,SOFT,<ARRST - File marked offline has index blk ptr>,,<
Cause: In restoring an offline file, it was discovered the file already
has some contents.
>)
PUSH P,STS
PUSH P,JFN ; Save stuff
PUSH P,DEV
CALL USTDIR ; Release it
UMOVE JFN,3 ; Get 2nd JFN
CALL CHKJFN ; Can't use CKJFN
JRST ARCF1X ; Fails
JFCL
ERRJMP DESX4,ARCF1X
TQNE <ASTF> ; Output *'s?
ERRJMP DESX7,ARCFXX ; Yes, bomb
BLCAL. DSKOK,<DEV> ;DISK?
ERRJMP ARCFX3,ARCFXX
CALL GETFDB
ERRJMP DESX3,ARCFXX
MOVE P3,T1 ; Copy FDB offset
TQNE <OPNF>
ERRJMP OPNX1,ARCFXX ; Can't be open
CAME DEV,0(P) ; Gotta be same device too
ERRJMP ARCFX5,ARCFXX
SKIPN Q1,.FBADR(P3) ; Get page tbl ptr from file w/ contents
ERRJMP RNAMX9,ARCFXX ; Can't do that...
CALL CKAROF ; Archived or offline?
JRST ARCFXX ; Yes, can't use that as a source
MOVE T1,Q1 ; Index block address
TLO T1,(THAWB) ; Restrict access
LOAD B,STR,(JFN) ; Get structure no. from JFN block
CALL ASFOFN
JRST [ MOVE T2,T1 ; Busy or bad PT
SETO T1,
CAIE T2,OPNX9 ; Busy?
JRST .+1 ; No, go ahead
MOVEI T1,RNMX10
JRST ARCFXX] ; Bomb
PUSH P,T1 ; Save OFN
;...
; More of ARRST
PUSH P,.FBCTL(P3) ; Save flags
PUSH P,Q1 ; Save addr
PUSH P,.FBBYV(P3) ; # of pages etc.
PUSH P,.FBSIZ(P3) ; And EOF
SETZRO FBADR,(P3) ; Clear it, avoid multiple ptrs
SETONE <FBNXF,FBDEL>,(P3) ; Delete the file
LOAD T2,FBNPG,(P3) ; Get page count of source file
MOVNS T2
MOVE T3,DIRORA ; Base of directory area
OPSTRM <ADDM T2,>,DRDCA,(T3) ; Reduce source dir pg cnt
MOVE T4,P3
CALL DELFIL ; Kill it
JFCL ; Was PRM???
CALL UPDDIR ; Update source dir
CALL USTDIR ; Done with it
MOVE T1,-4(P) ; OFN of source we've clobbered
SKIPL T1
CALL RELOFN
CALL UNLCKF
CALL RELJFN ; Release it entirely
MOVE STS,-7(P)
MOVE JFN,-6(P) ; Now turn our attention to dest
MOVE DEV,-5(P)
CALL GETFDB
BUG.(HLT,ARSTXX,JSYSF,SOFT,<ARRST - FDB disappeared for destination file>,,<
Cause: The FDB for a file being restored from offline does not exist.
>)
POP P,.FBSIZ(T1) ; Fix up # of bytes
POP P,.FBBYV(T1) ; and # of pages
POP P,.FBADR(T1) ; and file address
POP P,T2 ; Flags from source
TXZ T2,FB%TMP+FB%NEX+FB%NXF+FB%OFF ; Don't copy these over
IORM T2,.FBCTL(T1) ; Put in dest
MOVX T2,FB%INV ;GET SET
ANDCAM T2,.FBCTL(T1) ;MAKE SURE THE FILE IS VISIBLE NOW
ADJSP P,-1 ; Dump OFN
LOAD T2,FBNPG,(T1) ; Get no. pages in dest. file
MOVE T3,DIRORA
OPSTRM <ADDM T2,>,DRDCA,(T3) ; Update dir total
SETZRO FBOFF,(T1) ; Is online now...
POP P,DEV
POP P,JFN
POP P,STS
RETSKP ; Done
ARCFXX: CALL USTDIR ; Release current JFN
CALL UNLCKF
ARCF1X: POP P,DEV
POP P,JFN
POP P,STS
CALL UNLCKF
ITERR ()
; Discard tape status
ARDIS: LOAD T1,FBFLG,(P3)
TXNE T1,FB%OFF ; Offline?
RETBAD(ARCFX4) ; File not online
UMOVE Q1,3 ; Get user's options
ANDX Q1,AR%CR1+AR%CR2 ; Take those we know about
TXC Q1,AR%CR1+AR%CR2
JUMPE Q1,CLRBOT ; Do both
MOVE T1,CAPENB
TXNN T1,SC%WHL+SC%OPR ; Allowed?
RETBAD(CAPX1) ; No
TXC Q1,AR%CR1+AR%CR2 ; Restore request flags
TXNE Q1,AR%CR2
CALL CLR2ND
TXNE Q1,AR%CR1
CALL CLR1ST ; Do first set
SKIPN .FBTP1(P3) ; 1st tape say anything?
SKIPE .FBTP2(P3) ; 2nd?
RETSKP ; Yes
JRST CLRAAD ; Go clear common data since not offline
; Note that AREXM may enter at CLRBOT, also DSKOPN calls CLRBOT
CLRBOT::JE <FBARC>,.FBCTL(P3),CLRBO1 ; Archived file?
MOVE T1,[.ACLR,,.NOTM] ; Notification: archive sts cleared
MOVE T2,P3 ; FDB offset
CALL ARCMSG ; Send message to user
RETBAD(ARCX13) ; Say failed & why
CLRBO1: CALL CLR1ST
CALL CLR2ND
CLRAAD: SETZRO FBTDT,(P3) ; Clear tape-write date & time
SETZRO <K0RFL,K01ST,K0WRN,ARPSZ>,(P3) ; Clear tape-related data
SETZRO FBARC,(P3) ; Clear archive status flag
SETZRO FBFET,(P3) ; Clear meaningless expiry date
RETSKP ; Finished
CLR1ST: SETZRO TFN1,(P3) ; Clear tape file #
SETZRO TSN1,(P3) ; Clear save set #
SETZRO ARTP1,(P3) ; And tape #
RET
CLR2ND: SETZRO TFN2,(P3) ; Clear tape file #
SETZRO TSN2,(P3) ; Clear save set #
SETZRO ARTP2,(P3) ; Clear tape #
RET
; Set archive status for a file
ARSST: MOVE T1,CAPENB
TXNN T1,SC%WHL+SC%OPR
RETBAD(CAPX1) ; Not enough caps
LOAD T1,FBFLG,(P3)
TXNE T1,FB%OFF ; Off-line?
RETBAD(ARCFX4) ; Not on-line
TXNE T1,FB%DIR!FB%PRM!FB%TMP
RETBAD(ARCFX7) ; Not allowed
LOAD T1,FBBBT,(P3) ; Get archive bits
TXNE T1,AR%EXM ; Exempt from archiving?
RETBAD(ARCX10) ; Yes
UMOVE Q2,.AROFL(Q3) ; Get flags
TXNN Q2,AR%O1+AR%O2 ; Asking for 1 or both passes?
RETBAD(ARCFX7) ; Neither, garbage
ARSST1: TXCE Q2,AR%O1 ; Do run 1 stuff?
CALL SET1ST ; Yes, do that pass
TXCE Q2,AR%O2 ; 2nd run stuff?
CALL SET2ND ; Yes, do that too
XCTU [SKIPN T1,.ARODT(Q3)] ; User supply a TAD?
CALL LGTAD ; No, get now
STOR T1,FBTDT,(P3) ; Set date & time
CALL CKARDF ; Default to archive?
CAIA ; No
TXO Q2,AR%ARC ; Yes, force that option on
MOVX T1,FB%ARC
TXNE Q2,AR%ARC ; Mark as archived?
IORM T1,.FBCTL(P3) ; Yes, do that
SKIPN T1,ARRCYC ; Get archive recycle time
MOVX T1,.STDAE ; NONE SET, USE DEFAULT
TXNE Q2,AR%ARC ; Did we archive this?
MOVEM T1,.FBFET(P3) ; Yes, put in special offline time
LOAD T2,FBBBT,(P3) ; Get bits
MOVX T1,.AREXP ; Assume file expired
TXNE T2,AR%RAR
MOVX T1,.ARARR ; File archived
TXNE T2,AR%RIV
MOVX T1,.ARRIR ; File migration requested
STOR T1,K0RSN,(P3) ; Remember why we did this
MOVX T1,AR%RAR!AR%RIV ; Request bits
TXNE Q2,AR%CRQ ; Clear the requests?
ANDCAM T1,.FBBBT(P3) ; Yes, clear migration & archive rq
TXNN Q2,AR%OFL ; Want a flush?
RETSKP ; No, done here
SKIPE .FBTP1(P3) ; See if both sets of tape info set
SKIPN .FBTP2(P3)
RETSKP ; Not all tape info around
MOVE T4,P3 ;GET FDB ADDRESS IN T4 FOR FSHFIL
CALL FSHFIL ; Delete contents of the file
RETBAD() ; Failed
MOVE T4,P3 ; FDB offset
XCTU [SKIPE T1,.ARPSZ(Q3)] ; Get offline page count
STOR T1,ARPSZ,(P3) ; If not 0, restore it into FDB
RETSKP ; Done
SET1ST: XCTU [MOVE T1,.ARTP1(Q3)] ; Get tape id
LOAD T2,ARTP2,(P3) ; Get other tape ID (shouldn't be one)
CAMN T2,T3 ; A match?
RETBAD(ARCFX7) ; Yes, not allowed
STOR T1,ARTP1,(P3) ; Set tape tape id
ULOAD T1,AR%TSN,.ARSF1(Q3) ; Get saveset #
STOR T1,TSN1,(P3) ; And saveset #
ULOAD T1,AR%TFN,.ARSF1(Q3) ; Get tape file #
STOR T1,TFN1,(P3) ; And set tape file #
RET
SET2ND: XCTU [MOVE T3,.ARTP2(Q3)] ; Get tape #, run 2
LOAD T2,ARTP1,(P3) ; Get run 1 tape #
CAMN T2,T3 ; Match?
RETBAD(ARCFX7) ; Yes, not allowed
ULOAD T1,AR%TFN,.ARSF2(Q3) ; Get tape file #
STOR T1,TFN2,(P3) ; Set tape file #
ULOAD T1,AR%TSN,.ARSF2(Q3) ; Get saveset #
STOR T1,TSN2,(P3) ; Save set #
STOR T3,ARTP2,(P3) ; And tape #
RET
; Get tape info for caller
ARGST: XCTU [ SETZM .AROFL(Q3)] ; Never return this word
LOAD T1,ARTP1,(P3) ; Get tape #
XCTU [ MOVEM T1,.ARTP1(Q3)] ; 1st tape #
LOAD T1,TFN1,(P3) ; Tape file #
USTOR T1,AR%TFN,.ARSF1(Q3) ; Return tape file # 1
LOAD T1,TSN1,(P3) ; Get saveset #
USTOR T1,AR%TSN,.ARSF1(Q3) ; Return it
LOAD T1,ARTP2,(P3) ; Get 2nd tape #
XCTU [ MOVEM T1,.ARTP2(Q3)]
LOAD T1,TFN2,(P3) ; Get tape file #
USTOR T1,AR%TFN,.ARSF2(Q3) ; Return it
LOAD T1,TSN2,(P3) ; Get saveset # 2
USTOR T1,AR%TSN,.ARSF2(Q3)
LOAD T1,FBTDT,(P3) ; Get tape write
XCTU [ MOVEM T1,.ARODT(Q3)]
LOAD T1,ARPSZ,(P3) ; Get # of pages when pushed offline
XCTU [ MOVEM T1,.ARPSZ(Q3)]
RETSKP
; Flag that the restore failed (tell waiting process)
ARRFL: MOVE T1,CAPENB
TXNN T1,SC%WHL!SC%OPR ; Caller have caps necessary?
RETBAD(CAPX1) ; No, tell him
MOVX T1,AR%RFL
IORM T1,.FBBBT(P3) ; Set it
RETSKP
; Check for valid JFN etc.; also setup FDB
CKJFN: CALL CHKJFN ; Check validity
ITERR () ; Garbage
JFCL
ITERR (DESX4) ; Tty or byte ptr
TQNE <ASTF> ; Output *'s?
ERRJMP DESX7,ARCFXY ; Bomb with unlock
BLCAL. DSKOK,<P3> ;DISK?
ERRJMP ARCFX3,ARCFXY ; No FDB for non MDD devices
CALL GETFDB ; Get the FDB
ERRJMP DESX3,ARCFX ; No FDB
LOAD T2,FBLEN,(T1) ; Get length
CAIGE T2,.FBLXT ; Should be at least this big
ERRJMP ARCX17,ARCFX ; or we can't do anything with the file
RET
; Check file for write or owner access
CKWOWN: MOVE T2,CAPENB
TXNE T2,SC%WHL+SC%OPR ; Have special privs?
RETSKP ; Yes, win that way
MOVE T1,P3 ; FDB offset ptr
MOVX T2,WRTF ; Check write access first
CALL ACCCHK
CAIA ; Don't have that
RETSKP ; Ok, go with write access
MOVX T2,XCTF ; Check for owner like privs
CALL DIRCHK
RETBAD(CFDBX2) ; No access to file
RETSKP ; Ok, proceed with owner access
; Check to see if file has archive status, or is offline
CKAROF: LOAD T1,FBFLG,(P3) ; Get bits
TXNE T1,FB%ARC ; Archive status?
RETBAD(ARCFX2) ; Right
TXNE T1,FB%OFF ; Offline?
RETBAD(ARCFX4) ; Yes it is
RETSKP ; File is fine
CKNAON: LOAD T1,FBFLG,(P3)
TXNN T1,FB%ARC ; Archived?
RETBAD(ARCFX6) ; No
TXNN T1,FB%OFF ; Offline?
RETBAD(ARCFX9) ; No
RETSKP
; See if the default is to archive rather than migrate a file
CKARDF: HRRZ T1,FILDDN(JFN) ; Get directory # file is from
MOVE T3,DIRORA ; Where directories live
LOAD T2,DRNUM,(T3) ; Get mapped directory #
CAME T1,T2 ; They match?
BUG.(CHK,ARCASS,JSYSF,HARD,<ARCF - File directory and mapped directory do not match>,,<
Cause: The directory number of the currently mapped directory does not
match the directory number of file that we are attempting to set
tape information for in a ARCF% .ARRST request.
>)
LOAD T1,DRMOD,(T3) ; Get mode bits
TXNE T1,CD%DAR ; Is the default to archive ?
RETSKP ; Yes
RET ; No
;Routine to check read, write, execute, and append access restrictions imposed
;by the archive/virtual disk system.
;
;CALL: T1/FDB address
; T2/access request bits (FC%RD, FC%WR, FC%APP, FC%EX)
; CALL ARACCK
;RETURNS T1/0 if OK, -1 if OK with discard of tape pointer,
; -2 if OK with discard of tape pointer and request bits,
; error code if not allowed.
;
ARACCK::PUSH P,T3
PUSH P,T4
SETZ T3,
TXNN T2,FC%RD!FC%EX ;Read/Execute access requested?
JRST CKARST ;No, check write, append
JE FBOFF,(T1),CKARST ;Finished read/execute ck if online
MOVEI T3,OPNX31 ;Offline, fail (unless ret. wait set)
JRST CKADON
CKARST: TXNN T2,FC%WR!FC%APP ;Write or append requested?
JRST CKADON ;No, done
LOAD T4,FBLEN,(T1)
CAIGE T4,.FBLXT ;FDB has tape info?
JRST CKADON ;No
LOAD T4,FBFLG,(T1)
TXNE T4,FB%ARC ;Yes, File has archive status?
MOVEI T3,OPNX30 ;Yes, no modifications allowed
LOAD T4,FBBBT,(T1)
TXNE T4,AR%RAR ;File has archive request pending?
MOVEI T3,OPNX30 ;Yes, no modifications allowed
JUMPG T3,CKADON ;Done with archived files
SKIPN .FBTP1(T1) ;Ordinary file: tape 1 info there?
SKIPE .FBTP2(T1) ;Tape 2 info there?
CAIA ;Tape info exists, check further
JRST CKADON ;Neither tape there
TXNN T2,FC%WR ;Ordinary file: write access requested?
JRST CKARAP ;No, check append
SETO T3, ;Yes, Ok with discard of tape info
TXNN T3,FC%RD!FC%APP ;Read or append too?
MOVNI T3,2 ;No, discard migrate bit also
CKARAP: TXNN T2,FC%APP ;Append requested?
JRST CKADON ;No, done
SETO T3, ;OK so far with discard of tape ptr
JE FBOFF,(T1),CKADON ;Done if online
MOVEI T3,OPNX31 ;Offline, fail (unless ret. wait set)
CKADON: MOVE T1,T3
POP P,T4
POP P,T3
RET
; Assign device
; 1/ DEVICE DESIGNATOR
; ASND
; Return
; +1 ; Error, not assignable or bad designator etc.
; +2 ; Ok, the device specified is now assigned to this job
.ASND:: MCENT
STKVAR <ASNPAS,ASNUAR,ASNDIX>
MOVEM T1,ASNUAR ;SAVE USER ARG
SETZM ASNPAS ;FIRST PASS
ASND0: CALL LCKDVL
CALL CHKDEV ;CHECK DEVICE AND SEE IF ALREADY ASSIGNED
RETERR(,<UNLOKK DEVLKK>)
MOVEM T2,ASNDIX ;SAVE INDEX INTO DEVICE TABLES
TXNN C,DV%AS ;ASSIGNABLE DEVICE?
RETERR(ASNDX1,<UNLOKK DEVLKK>)
SKIPN ASNPAS ;FIRST PASS?
JRST [ HLRZ T4,DEVUNT(T2) ;GET OWNING JOB
CAMN T4,JOBNO ;THIS JOB?
JRST .+1 ;YES. DON'T BOTHER WITH ACJ THEN
UNLOKK DEVLKK ;YES
OKINT ;ALLOW INTS NOW
MOVE T1,ASNUAR ;GET USER'S ARG
GTOKM (.GOASD,T1,[RETERR ()]) ;DO GETOK AND RETURN IF ERROR
MOVE T1,ASNUAR ;GET BACK ARG
AOS ASNPAS ;ON SECOND PASS NOW
JRST ASND0] ;AND CONTINUE
HRRZ P3,DEV ;GET DISPATCH TABLE
CAIE P3,TTYDTB ;[7365] Is this a terminal?
IFSKP. ;[7365]
HLRZ B,DEV ;[7365] Yes, get the line number
CALL TTYASC ;[7365] (T2/T1) Assign the line
RETERR (,<UNLOKK DEVLKK>) ;[7365] Failed
MOVE B,ASNDIX ;[7365] Restore index to device tables
HLRE C,DEVUNT(B) ;[7365] Get current owner
IFL. C ;[7365] Previously not owned?
HLRZ B,DEV ;[7365] Yes, get line number again
CALL TTPINI ;[7365] (T2/) And init terminal parameters
ENDIF. ;[7365]
MOVE B,ASNDIX ;[7365] Restore index to device tables
ENDIF. ;[7365]
CALL DSMNT0 ;DISMOUNT IT IF NECESSARY
JFCL
MOVSI A,(DV%ASN)
MOVE B,ASNDIX ;RESTORE INDEX TO DEVICE TABLES
IORM A,DEVCHR(B) ; Mark this device as assigned by asnd
MOVE A,JOBNO
HRLM A,DEVUNT(B) ; Assign to this job
UNLOKK DEVLKK
SMRETN
; Backup file pointer by 1 byte
; Call: 1 JFN
; BKJFN
; Returns
; +1 ; Error, cannot backup this designator
; +2 ; Ok.
.BKJFN::MCENT
MOVE JFN,1
CALL CHKJFN
RETERR()
JRST BKJTTY
JRST BKJBYT
HRRZ A,DEV
CAIN A,TTYDTB ; Tty?
JRST BKJTT1
TQNN <OPNF>
RETERR(DESX5,<CALL UNLCKF>)
MOVE A,FILBYN(JFN)
SOJL A,[RETERR(SFPTX3,<CALL UNLCKF>)]
CALL SFBNR
RETERR(,<CALL UNLCKF>)
CALL UNLCKF
SMRETN
;DEVICE IS A TERMINAL. CALL DEVICE-SPECIFIC ROUTINE
BKJTT1: CALL UNLCKF
BKJTTY: HLRZ 2,DEV
CAIN T2,-1 ;DETACHED?
RETERR (DESX6) ;YES
CALL TTBKPT
RETERR ;ROUTINE HAS SET UP ERROR CODE
SMRETN
BKJBYT: MOVE A,JFN
CALL DBP
UMOVEM A,1
SMRETN
; Change fdb
; Call: LH(1) ; Offset
; RH(1) ; Jfn
; 2 ; Mask
; 3 ; Data
; CHFDB
.CHFDB::MCENT
CALL CHFDB0 ;DO THE WORK
ITERR () ;ERROR OCCURED
JRST MRETN ;SUCCESSFUL
CHFDB0: STKVAR <CHFDBA,CHFDBD,CHFDBT>
XCTU [HRRZ JFN,T1] ;SETUP THE JFN
ULOAD T1,CF%DSP,T1 ;GET DISPLACEMENT
MOVEM T1,CHFDBD ;SAVE IT
CAIL A,.FBLEN
RETBAD(CFDBX1) ; Offset too big
CALL CHKJFN ; Check jfn
RETBAD() ; Garbage
JFCL
RETBAD(DESX4) ; Tty or byte illegal
TQNE <ASTF>
ERRJMP DESX7,CHFDX
BLCAL. DSKOK,<P3> ;DISK?
ERRJMP CFDBX5,CHFDX ;No FDB for non-MDD devices
LOAD A,STR,(JFN) ;[7.1063]Get the JFN's structure number
CALL CKSTOF ;[7.1063](T1/T1)Is the structure offline?
JRST CHFDX ;[7.1063]Return "structure is offline"
CALL GETFDB ; Get the fdb
ERRJMP DESX3,CHFDX
MOVEM A,CHFDBA ; SAVE FDB ADDRESS
LOAD B,FBLEN,(A) ; Get the length of this FDB
CAMG B,CHFDBD ; Is it the FDB bigger than offset?
ERRJMP CFDBX1,CHFDB9 ; No, loose
MOVE D,CHFDBD ; GET OFFSET
UMOVE B,2 ; Mask
OPSTR <SKIPE>,FB%DIR,.FBCTL(A) ;A DIRECTORY FILE?
CAIE D,.FBCTL ;YES. CHANGING FLAG WORD?
SKIPA ;NO. PROCEED
JRST CHFDB6 ;YES. CAN'T DO IT
ANDCM B,WRTR(D) ; Writer bits?
JUMPN B,CHFDB1 ; No, check owner and wheel
JAND <OPNF,WRTF>,,CHFDB2 ;IF FILE IS OPEN FOR WRITE, THEN OK
MOVX B,FC%WR ; Yes check for write access
CALL ACCCHK
JRST CHFDB1 ; NO WRITER ACCESS, CHECK OWNER
JRST CHFDB2 ; Ok, go ahead
CHFDB1: UMOVE B,2 ; GET MASK AGAIN
MOVE D,CHFDBD ; [TCO 5.1081] GET BACK FDB INDEX
ANDCM B,OWNER(D)
JUMPN B,CHFDB4 ; Requires mor than owner status
MOVE A,CHFDBA ; GET THE FDB ADR AGAIN
CALL NFACHK ; SEE IF THIS IS A NEW FILE
JRST CHFDB3 ; NO, GO CHECK OWNER RIGHTS
JRST CHFDB2 ; YES, THEN GIVE OWNER RIGHTS TO CALLER
CHFDB3: MOVX B,DC%CN
CALL DIRCHK ;SEE IF USER CAN CONNECT (AND THUS BE LIKE
; AN OWNER)
JRST CHFDB5
JRST CHFDB2
CHFDB6: MOVEI A,CFDBX2
CHFDB9: CALL USTDIR ;UNLOCK DIRECTORY
CHFDX: CALL UNLCKF ;UNLOCK JFN
RETBAD ()
CHFDB4: ANDCM B,WOPR(D)
JUMPN B,CHFDB6 ; Can't be done
CHFDB5: MOVE B,CAPENB
TRNN B,SC%WHL!SC%OPR
IFNSK. ;FIGURE OUT WHICH ERROR TO GIVE
MOVE D,CHFDBD ;GET BACK FDB INDEX
MOVE B,WRTR(D) ;SEE IF WRITER
IOR B,OWNER(D) ;OR OWNER ACCESS WERE REQUIRED
XCTU [AND B,T2] ;ON USER SPECIFIED BITS
MOVEI T1,CFDBX3 ;GIVE WRITE OR OWNER ACCESS REQUIRED
SKIPN B ;UNLESS NEITHER WERE REQUIRED
MOVEI T1,WHELX1 ;IN WHICH CASE GIVE WHEEL/OPER REQUIRED
JRST CHFDB9 ;TELL USER
ENDIF.
CHFDB2: MOVE A,CHFDBA ; GET THE FDB ADDRESS BACK
ADD A,CHFDBD ; GET ADR OF DATA WORD IN FDB
UMOVE C,3 ; Data
MOVE B,(A) ; Old data
UMOVE D,2 ; Mask
AND C,D ; Retain masked bits of new data
ANDCM B,D ; Flush bits to be replaced from old
IOR B,C
MOVE C,CHFDBD ; Get word index
CAIN C,.FBCTL ; Flags word?
JRST CHFD10 ; Yes, check things carefully
CHFDB8: MOVEM B,(A)
TQNN <OPNF> ;IS THE FILE OPEN?
JRST CHFDB7 ;NO, DONT SET UP THE NEW LENGTH
HLRZ B,FILOFN(JFN) ;GET OFN
TQNE <LONGF> ;LONG FILE?
HRRZ B,FILOFN(JFN) ;YES, USE THIS ONE
MOVE A,OFNLEN(B) ;[7.1059] Get OFNLEN for this OFN
CAME A,[-1] ;[7.1059] Is it code for 34359738367(36)?
IFSKP. ;[7.1059] Yes
MOVEI A,^D36 ;[7.1059] Make 36 bit byte size
MOVX B,.INFIN ;[7.1059] Make 34359738367 byte count
ELSE. ;[7.1059]
LOAD A,OFNBSZ,(B) ;[7.1059] Get true file byte size
LOAD B,OFNBC,(B) ;[7.1059] and file byte count
ENDIF. ;[7.1059]
MOVE C,CHFDBD ;GET OFFSET
CAIE C,.FBBYV ;BYTE SIZE WORD
JRST CHFD12 ;NO TRY BYTE COUNT
TXNN D,FB%BSZ ;BYTE SIZE FIELD CHANGED?
JRST CHFDB7 ;NO DON'T UPDATE LENGTH
MOVE D,CHFDBA ;GET FDB ADDR
LOAD A,FBBSZ,(D) ;GET BYTE SIZE FROM FDB
JRST CHFD11 ;AND UPDATE LENGTH
CHFD12: CAIE C,.FBSIZ ;LENGTH CHANGE?
JRST CHFDB7 ;NO DON'T UPDATE IT
MOVE D,CHFDBA ;ADDR OF FDB
LOAD B,FBSIZ,(D) ;GET LENGTH FROM FDB
CHFD11: CALL UPDFLN ;UPDATE THE LENGTH
CHFDB7: UMOVE T2,T1 ;GET ARG
TXNE T2,CF%NUD ;Update directory now?
IFSKP. ;Yes
CALL UPDDIR ;()Update it
TQNN <OPNF> ;Is the file open?
ANSKP. ;Yes
;The directory has just been updated and the file is open.
;Since the EOF pointer could have changed, we must broadcast it
;to the other systems in the cluster.
HLRZ D,FILOFN(JFN) ;Get OFN
TQNE <LONGF> ;Long file?
HRRZ D,FILOFN(JFN) ;Yes, use this one
MOVE A,D ;Copy OFN
MOVEI B,0 ;Only need read permission
MOVEM D,CHFDBT ;Save OFN
CALL CFSAWT ;(T1,T2)Do it to get up-to-date EOF info
MOVE A,CHFDBT ;Get OFN back
CALL CFSBEF ;(T1)Broadcast the EOF we know about
ENDIF.
CALL USTDIR
CALL UNLCKF
RETSKP
CHFD10: TXNN B,FB%DEL ; Changing state of deleted?
JRST CHFDB8 ; No, proceed normally
PUSH P,A ; SAVE FDB LOC
PUSH P,B ; Save this
MOVX B,FC%WR ; Write access necessary for delete
CALL ARACCK ; Check archive/vir. disk requirements
JUMPLE A,[POP P,B ; Recover mask
POP P,A
JRST CHFDB8] ; And proceed
POP P,B ; Clean up stack
POP P,A
JRST CHFDB9 ; Fail
; Access tables for chfdb
;BITS WHICH CAN BE CHANGED IF PROGRAM HAS WRITE ACCESS TO FILE
WRTR: 0 ;FBTYP ,, FBLEN
FB%NOD+FB%FCF+FB%FOR ;FBFLG
0 ;FBEXL
0 ;FBADR
0 ;FBPRT
0 ;FBCRE
0 ;FBAUT
0 ;FBGEN
0 ;FBACT
007717000000 ;FBGNR, FBBSZ, FBMOD ,, FBNPG
777777777777 ;FBSIZ
777777,,777777 ;FBCRV
777777,,777777 ;FBWRT
777777,,777777 ;FBREF
0 ;FBNWR ,, FBNRF
0 ;FBBK0
0 ;FBBK1
0 ;FBBK2
0 ;FBBBT
0 ;FBNET
0 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ;FBTDT
0 ;FBFET
0 ;FBTP1
0 ;FBSS1
0 ;FBTP2
0 ;FBSS2
;BITS WHICH CAN BE CHANGED IF PROGRAM HAS OWNER ACCESS TO FILE
OWNER: 0 ;FBTYP ,, FBLEN
FB%PRM+FB%TMP+FB%DEL+FB%NOD+FB%INV+FB%FCF+FB%FOR ;FBFLG
0 ;FBEXL
0 ;FBADR
000000777777 ;FBPRT
0 ;FBCRE
0 ;FBAUT
0 ;FBGEN
0 ;FBACT
777717000000 ;FBGNR, FBBSZ, FBMOD ,, FBNPG
777777777777 ;FBSIZ
777777,,777777 ;FBCRV
777777,,777777 ;FBWRT
777777,,777777 ;FBREF
0 ;FBNWR ,, FBNRF
0 ;FBBK0
0 ;FBBK1
0 ;FBBK2
0 ;FBBBT
0 ;FBNET
777777777777 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ;FBTDT
0 ;FBFET
0 ;FBTP1
0 ;FBSS1
0 ;FBTP2
0 ;FBSS2
;BITS WHICH CAN BE CHANGED IF PROGRAM HAS WHEEL OR OPERATOR CAPABILITIES
WOPR: 0 ;FBTYP ,, FBLEN
FB%PRM+FB%TMP+FB%DEL+FB%NOD+FB%INV+FB%FCF+FB%NDL+FB%WNC+FB%FOR ;FBFLG
0 ;FBEXL
0 ;FBADR
000000777777 ;FBPRT
777777777777 ;FBCRE
0 ;FBAUT
0 ;FBGEN
0 ;FBACT
777777,,777777 ;FBGNR, FBBSZ, FBMOD ,, FBNPG
-1 ;FBSIZ
777777777777 ;FBCRV
777777777777 ;FBWRT
777777777777 ;FBREF
777777777777 ;FBNWR ,, FBNRF
777777777777 ;FBBK0 DUMPER INCREMENTAL SAVE DATA
-1 ;FBBK1 DUMPER LAST BACKED UP ON TAPE DATA
0 ;FBBK2
AR%1ST+AR%WRN ;FBBBT
0 ;FBNET
777777777777 ;FBUSW
0 ;FBGNL
0 ;FBNAM
0 ;FBEXT
0 ;FBLWR
0 ;FBTDT
0 ;FBFET
0 ;FBTP1
0 ;FBSS1
0 ;FBTP2
0 ;FBSS2
; Close a file
; Call: RH(1) ; Jfn
; 1(0) ; If 1 do not release jfn
; CLOSF
; Returns
; +1 ; Cannot close
; +2 ; Ok
.CLOSF::MCENT
CAMN 1,[-1] ; -1 means all
JRST CLZALL
HRRZ JFN,1
CAIE JFN,.PRIIN ;PRIMARY DESIGNATOR?
CAIN JFN,.PRIOU
SMRETN ;YES, DO NOTHING BUT RETURN GOOD
CALL CLZF
RETERR() ; Can't close, reason in a
XCTU [SKIPL 1] ; Don't release jfn
TQNE <OPNF> ; Or still open?
SMRETN ; Yes. all done.
CALL RELJFN ; No, release jfn.
SMRETN
CLZALL: MOVEI A,.FHSLF ;SAME AS CLZFF ON SELF
CLZFF
SMRETN
;CLOSF...
CLZF:: MOVEI A,CLSX2
HRRZ B,PRIMRY
HLRZ C,PRIMRY ;DONT CLOSE PRIMARY IN OR OUT
CAME JFN,C
CAMN JFN,B
RET
PUSH P,JFN ;SAVE THIS IN CASE OF BLOCK
CALL CHKJFD
JRST [ POP P,(P) ; Garbage
RET]
JFCL
JRST [ POP P,(P) ; Byte and tty always succeeds
RETSKP]
TQNN <OPNF>
JRST [ POP P,(P)
MOVEI A,CLSX1
JRST UNLCKF]
MOVSI B,1
ANDCAB B,FILLFW(JFN)
TLNN B,777777
IFSKP.
CALL CLZMRC ;TRY TO REASSIGN MAP COUNT
ANNSK.
CALL CLZMFE ;COULDN'T, MAKE FILE EXISTENT
POP P,0(P) ;CLEAR STACK
BLCAL. DSKOK,<DEV> ;DISK?
IFSKP. <CALL DEWNDW> ;YES. FREE UP WINDOW PAGE THEN
CALL UNLCKF ;UNLOCK THE JFN
RETBAD(CLSX3) ;SAY STILL MAPPED
ENDIF.
UMOVE A,A
AND A,[CZ%ABT+CZ%NUD] ;ACCEPT ONLY THESE FLAGS
MOVE B,0(P) ;PASS DOWN JFN
CALL CLZDO ;DO DEVICE CLOSE AND DEASSIGN STUFF
JRST CLZFW ;DIDNT CLOSE, SEE IF BLOCKING
CLZF2: POP P,(P) ;CLEAR OUT STACK
CALL UNLCKF
RETSKP
CLZFW: TQZN <BLKF> ;DOES SERVICE ROUTINE WANT TO BLOCK?
JRST [POP P,(P) ;NO, CLEAR OUT STACK
CALLRET UNLCKF] ;AND UNLOCK AND RETURN UNSUCCESSFULLY
MOVSI B,1 ;RESTORE MAP COUNT AGAIN SO THAT
IORM B,FILLFW(JFN) ; FILES ARE NOT INADVERTANTLY CLOSED
CALL UNLDIS ;YES, GO BLOCK
POP P,JFN ;GET BACK THE JFN AGAIN FOR CHKJFN
SE1ENT
JRST CLZF ;TRY AGAIN
;TRY TO REASSIGN MAP COUNT FROM THIS JFN TO SOME OTHER JFN
;WITH THE SAME OFN
; JFN/ THE JFN INDEX
; CALL JFNRMC
; RETURN +1: FAILED, COUNT STILL NON-0
; RETURN +2: OK, COUNT NOW 0
CLZMRC: MOVEI A,0(JFN) ;GET JFN
CALL DMOCHK ;SEE IF DISMOUNTED
RETSKP ;IT IS. SAY IT SUCCEEDED
MOVX A,OPNF ;CLEAR OPNF SO OFNJFN WILL NOT FIND
ANDCAM A,FILSTS(JFN) ;THIS JFN
MOVEI A,0 ;SAY PAGE 0
CALL JFNOF1 ;CONSTRUCT ID FOR PAGE 0 THIS FILE
JRST CLZMRX ;COULDN'T, FAIL
CALL OFNJFL ;FIND A JFN FOR THIS OFN
JRST CLZMRX ;NOT FOUND
HLLZ B,FILLFW(JFN) ;GET COUNT FROM ORIG JFN
ADDM B,FILLFW(A) ;MOVE IT TO NEW JFN
CALL LUNLKF ;UNLOCK JFN AND STRUCTURE
OKINT ;AND UNDO THE NOINT
HRRZS FILLFW(JFN) ;CLEAR IT FROM ORIG JFN
MOVX A,OPNF
IORM A,FILSTS(JFN) ;RESTORE OPNF
RETSKP
CLZMRX: MOVX A,OPNF ;RESTORE OPNF
IORM A,FILSTS(JFN)
RET
;MAKE FILE EXISTENT. DONE WHEN FILE CANNOT BE CLOSED BECAUSE OF
;NON-0 MAP COUNT, BECAUSE LATER CLOSE MIGHT BE DONE BY CLZFF WITH
;CZ%ABT WHICH WOULD VANISH NON-EXISTENT FILE
CLZMFE: CALL GETFDB ;GET THE FDB FOR THIS JFN
RET ;COULDN'T, ASSUME OK
MOVX B,FB%NXF
TDNE B,.FBCTL(A) ;DON'T CAUSE WRITE IF ALREADY CLEAR
ANDCAM B,.FBCTL(A) ;CLEAR NONX
CALLRET USTDIR ;RELEASE DIRECTORY AND RETURN
;CLOSE FILES RELATIVE TO SPECIFIED FORK
; 1/ CZ%NIF (B0) - NO INFERIOR FORK FILES
; CZ%NSF (B1) _ NOT AT SPECIFIED FORK
; CZ%NFJ (B2) - NO RELEASE JFN'S
; CZ%NCL (B3) - NO CLOSE FILES
; CZ%UNR (B4) - UNRESTRICT FILES
; CZ%ARJ (B5) - WAIT UNTIL MAP COUNT IS 0
; CZ%ABT (B6) - ABORT, I.E. FLUSH NONX FILES AND NO WAIT FOR IO
; CZ%NUD (B7) - NO UPDATE DIRECTORY
; RH: FORK HANDLE
; CLZFF
; RETURN +1: ALWAYS
; Traps if fork handle is bad
.CLZFF::MCENT
CLZFF0: HRRZS A
CALL FLOCK ;LOCK THE FORK STRUCTURE
MOVX T2,<CALL CLZFF1> ;ROUTINE TO DO
CALL MAPFKH ; Call routine to map over the fork hdl
JRST [ CALL FUNLK ;BLOCKING
CALL UNLDIS ;WAIT FOR CONDITION TO BE SATISIFED
UMOVE A,1 ;GET BACK USER'S ARGS
JRST CLZFF0] ;AND TRY AGAIN
CALL FUNLK ;UNLOCK THE FORK STRUCTURE
XCTU [HRRZ A,1] ;GET BACK USERS ARGUMENT
MOVEI T2,NETN ;IS THIS AN ARPANET MONITOR?
SKIPE T2 ;DO NOT DO FOLLOWING IF WE ARE NON ARPANET
RELIQ% ;RELEASE THE INTERNET QUEUE
ERJMP .+1 ;IGNORE ERRORS
JRST MRETN
;ROUTINE CALLED FOR EACH FORK SPECIFIED
CLZFF1: TRVAR <FRKHDL>
MOVEM T1,FRKHDL ;Save job relative fork hndl, setup by MAPFKH
PUSH P,P6 ;save this ac
CALL ABTJCS ;abort all JCNs
POP P,P6 ;restore the ac
MOVN JFN,MAXJFN
HRLZS JFN
;LOOP OVER ALL JFNS
CLZFF2: HLRZ B,PRIMRY
CAIN B,(JFN)
JRST CLZFF3 ; Don't affect primary files
HRRZ B,PRIMRY
CAIN B,(JFN)
JRST CLZFF3
PUSH P,JFN
PUSH P,1
HRRZS A,JFN
JUMPE A,CLZFF4 ;ALWAYS SKIP 0
IMULI A,MLJFN ; CONVERT TO INTERNAL INDEX
SKIPL FILLCK(A) ;FILE LOCKED NOW?
JRST CLZFF4 ;YES, DON'T TRY TO CLOSE IT
CALL CHKJFD ; See if this jfn is in use
JRST CLZFF8 ; NO NAME, CHECK FOR ASGF
JRST CLZFF4 ; Should not happen
JRST CLZFF4
MOVSI B,777777
TQNE <OPNF> ; If file is open
TDNE B,FILLFW(JFN) ; And map count is zero
SKIPA
JRST CLZFF5 ; Then it's ok to close it
UMOVE C,1 ;GET USER FLAGS
HLRZ B,FILVER(JFN)
MOVE A,(P)
CAMN B,A ; Was this jfn created by this fork
JRST [ TLNE C,(CZ%NSF) ; Are we to close files at the fork?
JRST CLZFF7 ; No, skip this jfn
JRST CLZFF5] ; Yes, do it
TXNE C,CZ%NIF ;CLOSE FILES OF INFERIOR FORKS?
JRST CLZFF7 ;NO, SKIP THIS JFN
EXCH A,B
CALL SKIIFA ; Skip if fork(a) < fork(b)
JRST CLZFF7
; ..
;CLZFF...
CLZFF5: UMOVE C,1
TLNE C,(CZ%UNR) ; Un restrict this file?
TQZ <FRKF> ; Yes
TQNE <OPNF>
TLNE C,(CZ%NCL)
JRST CLZFF6
MOVSI B,1
ANDCAB B,FILLFW(JFN)
TLNN B,777777 ;MAP COUNT NOW 0?
JRST CLZFM1 ;YES, CLOSE
CALL CLZMRC ;NO, TRY TO REASSIGN COUNT
SKIPA ;COULDN'T
JRST CLZFM1 ;COUNT NOW 0, OK TO CLOSE
UMOVE C,1 ;GET FLAGS
TXNN C,CZ%ABT ;FLUSH NONX FILES?
CALL CLZMFE ;NO, MAKE SURE THIS ONE EXISTS
UMOVE C,1
TXNN C,CZ%ARJ ;WAIT FOR 0 MAP COUNT?
JRST CLZFF7 ;NO, DON'T CLOSE
; SKIPN FORKN ;TOP FORK?
CALL CKMMOD ;YES. FROM THE MONITOR THEN?
SKIPA ;NO. WAIT THEN
JRST CLZFM1 ;YES. CLOSE IT THEN
MOVS A,TODCLK ;YES, GET TIME
TXZ A,1B0 ;ONLY USE 17 BITS
ADD A,[^D1000,,0] ;WAIT FOR A SEC
HRRI A,BLOCKW ;SHORT WAIT
JRST CLZFW0 ;AND WAIT A WHILE
CLZFM1: UMOVE A,1 ;GET FLAGS SET BY USER
HRRZ B,-1(P) ;[8811] Get JFN number only
CALL CLZDO ;DO THE WORK
JRST CLZFFW ;FAILED TO CLOSE, CHECK IF BLOCKING
CLZFF6: UMOVE C,1
SE1ENT
TQNN <OPNF>
TLNE C,(CZ%NRJ)
JRST CLZFF7
CALL UNLCKF ;[7460](JFN,STS/)FREE FILE AND STR LOCK
CLZFF9: CALL RELJFN
JRST CLZFF4
CLZFF7: CALL UNLCKF
CLZFF4: POP P,1
POP P,JFN
CLZFF3: AOBJN JFN,CLZFF2 ;LOOP OVER ALL JFNS
; After doing all JFN's see if there are any CI connections that need to be
;cleaned up.
;
MOVE T1,FRKHDL ;Get the job relative fork number again
HRRZ T1,SYSFK(T1) ;Get the fork number of the target fork
CALL SCSKIL ;Clean up after the SCS% JSYS...
RET
ENDTV.
;HERE ON +1 RETURN FROM CHKJFN, I.E. JFN DOESN'T EXIST OR IS RESTRICTED
CLZFF8: CAIE A,DESX3 ;[7384]ASSIGNED?
JRST CLZFF4 ;[7384]NO, SKIP IT
MOVE B,FILST1(JFN) ;[7384]GET SECOND WORD OF STATUS BITS
TQNE <ASGF> ;[7384]IS JFN BEING ASSIGNED?
TXNN B,ASGF2 ;[7384]MAKE SURE ASGF IS LIT, NOT BLKF
JRST CLZFF4 ;NO, SKIP IT
HLRZ B,FILVER(JFN) ;GET FORK
SKIPGE SYSFK(B) ;FORK STILL EXISTS?
JRST CLZFF9 ;NO, RELEASE JFN
CAME B,FORKN ;THIS FORK?
JRST CLZFF4 ;NO, SKIP IT
SKIPE PSIBIP ;AT INTERRUPT LEVEL?
JRST CLZFF4 ;YES, LEAVE IT ALONE
JRST CLZFF9 ;NO, RELEASE IT
;HERE IF CAN'T CLOSE BECAUSE SERVICE ROUTINE WANTS TO BLOCK
CLZFFW: TQZN <BLKF> ;SERVICE ROUTINE WANT TO BLOCK?
JRST CLZFF7 ;NO, GO UNLOCK AND EXIT
UMOVE B,1 ;GET USER FLAGS AGAIN
TXNE B,CZ%ABT ;WAS THE USER TRYING TO ABORT?
BUG.(CHK,CLZABF,JSYSF,HARD,<CLZFFW - Service routine blocked on an abort close>,,<
Cause: The device dependent service routine for a CLOSF% wants to block,
but the user has specified an abort close.
Action: The user will block anyway in an attempt to close the file.
>)
CLZFW0: ADJSP P,-2 ;CLEAN UP STACK
SE1ENT ;GET TO PROPER SECTION
RETSKP ;INDICATE WE WANT TO BLOCK
;COMMON DEVICE CLOSE FOR CLOSF AND CLZFF
;CALLED WITH CLZFF FLAGS IN A, ORIGINAL JFN I B
;RETURNS +1 NOT CLOSED OR ABOUT TO BLOCK IF BLKF IS 1
; +2 CLOSED OK
CLZDO: STKVAR <CLZDOA,CLZDOJ>
MOVEM A,CLZDOA ; SAVE FLAGS
MOVEM B,CLZDOJ ; SAVE JFN
CALL CHKENQ ; CHECK IF CLOSING IS ALLOWED BY ENQ/DEQ
RET ; FILE IS LOCKED, DONT CLOSE IT
MOVE A,CLZDOA ; GET FLAGS BACK
TQZE <BLKF> ; SEE IF FLAG IS OFF
BUG.(CHK,BLKF3,JSYSF,HARD,<CLZDO - BLKF set before call to service routine>,,<
Cause: BLKF has been set before the call to the device dependent service
routine which should be responsible for setting this bit.
Action: If this BUGCHK persists, change it to a BUGHLT and find out where
the bit is being set.
>)
XMOVEI C,CLZDOB ;BLOCK CO-ROUTINE
MOVE D,CLZDOJ ;PASS ALONG JFN
CALL @CLOSD(P3) ; Call DEVice dependent stuff
RET
TQZ <OPNF>
MOVEI A,0(JFN) ;GET JFN IN A
CALL DMOCHK ;CHECK IF DISMOUNTED
RETSKP ;IT IS .ALL DONE
CALL FNDUNT ;GET DEV INDEX
MOVX C,DV%OPN
TDNN C,DEVCHR(A) ;ASSIGNED BECAUSE OF OPEN?
RETSKP ;NO.
;OPEN BIT IS STILL SET IN DEVICE TABLES. FOR TELETYPES, THIS WILL NOT
;BE TRUE BECAUSE THE DEVICE-DEPENDENT CODE BOTH DEASSIGNS THE
;DATA BLOCK AND CLEANS UP THE DEVICE TABLES.
ANDCAB C,DEVCHR(A) ;YES, CLEAR ASSIGNMENT
MOVE B,DEVCH1(A)
TXNE B,D1%ALC ;DEVICE ALLOCATED BY ALLOC JSYS?
RETSKP ;YES. DON'T RELEASE IT
TXNE C,DV%ASN ;ASSIGNED BY ASND?
RETSKP ;YES. DON'T RELEASE IT
MOVE B,A ;NO. B/ INDEX TO DEVICE TABLES
CALL RELDEV ;GO CLEAR DEVICE TABLES
JRST CLZDO1 ;FAILED. GO WAIT OR FAIL
RETSKP
;RELDEV FAILED. THIS SHOULD NOT HAPPEN FOR NOW BECAUSE ONLY TELETYPE
;DEVICE DESIGNATOR CAN CAUSE THIS
CLZDO1: TXZN T1,1B0 ;HAVE TO WAIT?
RETBAD ;NO. RETURN FAILURE
TQO BLKF ;YES. INDICATE BLOCKING
RETBAD
;ROUTINE TO SEE IF A FILE IS LOCKED UP BY ENQ/DEQ
;ASSUMES CHKJFN WAS CALLED
; CALL CHKENQ
;RETURNS +1: FILE IS LOCKED BY ENQ/DEQ AND CANNOT BE CLOSED
; +2: FILE IS NOT LOCKED AND CAN BE CLOSED
CHKENQ: MOVE A,ENQLST+1 ;SEE IF ANY LOCKS ARE SET
JUMPE A,RSKP ;IF 0, NO ENQ REQUESTS OUTSTANDING
BLCAL. DSKOK,<<FILDEV(JFN)>> ;A DSK JFN?
RETSKP ;NOT A DISK, IGNORE THIS CLOSE
SETZ A, ;GET OFN OF PAGE 0 OF FILE
CALL JFNOF1 ;GET OFN OF FILE PAGE 0
RETSKP ;ILLEGAL FOR THIS JFN, CLOSE CAN PROCEED
; MAY FAIL BECAUSE STRUCTURE IS
; DISMOUNTED
HLRZS A ;GET THE OFN ONLY FOR ENQCLS
HRRZ B,JFN ;GET JFN BLOCK OFFSET
IDIVI B,MLJFN ;CONVERT TO JFN BEING CLOSED
CALLRET ENQCLS ;SEE IF FILE CAN BE CLOSED NOW
;ROUTINE CALLED BY SERVICE ROUTINE TO BLOCK
CLZDOB: STKVAR <SVDES>
MOVEM DEV,SVDES ;SAVE DEVICE
PUSH P,T2 ;SAVE JFN
CALL UNLDIS ;UNLOCK AND BLOCK
POP P,JFN ;RESTORE JFN
CALL CHKJFD
RETBAD ()
JFCL
RETBAD (DESX3)
CAME DEV,SVDES ;CHECK TO SEE IF DEVICE THE SAME
RETBAD (DESX4) ;YOU CAN'T CHANGE DESCRIPTOR
RETSKP ;CONTINUE
;CRDIR - CREATE FILE DIRECTORY OR MODIFY PARAMETERS.
;ACCEPTS:
; A/ POINTER TO STRUCTURE:<DIRECTORY> STRING
; B/ (FLAGS,,ADDRESS OF ARGUMENT BLOCK)
; C/ POINTER TO PASSWORD STRING
; CRDIR
; ReturnS +1: Error
; +2:Success
; A/ (STRUCTURE UNIQUE CODE,,DIRECTORY number)
; In parameter block
; .CDLEN=0 ; (FLAGS,,LENGTH OF ARGUMENT BLOCK (LENGTH NOT USED))
; .CDPSW=1 ; Pointer to password string, 0 if none
; .CDLIQ=2 ; WORKING STORAGE (LOGGED-IN) QUOTA
; .CDPRV=3 ; PRIVILEGE BITS
; .CDMOD=4 ; MODE BITS
; CD%DIR ;FILES-ONLY DIRECTORY
; CD%ANA ;ALPHANUMERIC ACCOUNTS ALLOWED
; CD%RLM ;REPEAT SYSTEM MESSAGES ON LOGIN
; .CDLOQ=5 ; PERMANENT STORAGE (LOGGED-OUT) QUOTA
; .CDNUM=6 ; DIR NUMBER
; .CDFPT=7 ; DEFAULT FILE PROTECTION
; .CDDPT=10 ; DIRECTORY PROTECTION
; .CDRET=11 ; DEFAULT # OF GENERATIONS TO KEEP
; .CDLLD=12 ; DATE OF LAST LOGIN
; .CDUGP=13 ; POINTER TO USER GROUPS
; .CDDGP=14 ; POINTER TO DIR GROUPS
; .CDSDQ=15 ; MAXIMUM NUMBER OF SUBDIRECTORIES
; .CDCUG=16 ; POINTER TO ALLOWED USER GROUPS FOR SUBDIR
; .CDDAC=17 ; Pointer to default account
; .CDDNE=20 ; Default online expiration
; .CDDFE=21 ; Default offline expiration
.CRDIR::MCENT
GTOKM (.GOCRD,) ;GETOK CREDIR
UMOVE Q3,2 ;GET FLAGS AND POINTER TO BLOCK
UMOVE A,1 ;GET STRING POINTER TO NAME
MOVEI B,2*MAXLW+2 ;39-DEV:<39-DIR> + 1 HEADER WORD
CALL CPYUSR ;Copy directory name string
ITERR CRDIX3 ;No room in jsb
NOINT ;[8856] Be NOINT the entire time
CALL CRDIR0 ;GO DO THE WORK
ITERR (,OKINT) ;[8856] An error occured
OKINT ;[8856] Housekeeping
JRST MRETN ;EXIT
;CRDIR0 - ROUTINE TO DO CRDIR JSYS
;ACCEPTS IN A/ POINTER TO NAME STRING IN JSB
; Q3/ (FLAGS,,POINTER TO PARAMETER BLOCK IN USER SPACE) - USER'S AC2
; CALL CRDIR0
;RETURNS +1: ERROR OCCURRED, ERROR CODE IN A
; +2: SUCCESSFUL
; LOCAL VARIABLE DEFINITIONS (STORED IN JSB FREE SPACE)
;CRDIRN ;HOLDS POINTER TO COPY OF USER'S STRING IN JSB
;CRDIRS ;POINTER TO GTJFN STRING OF COMPLETE DIRECTORY NAME
;CRDIRD ;DIRECTORY NUMBER
;CRDIRE ;TEMPORARILY HOLDS ERROR CODE
;CRDIRJ ;JFN OF DIRECTORY FILE
;CRDIRT ;HOLDS POINTER TO STRINGS ACROSS SUBROUTINE CALLS
;CRDIRF ;TEMPORARY ERROR FLAG
;CRDIRA ;INDEX BLOCK ADDRESS IN DIRECTORY DELETE ROUTINE
;CRDDNM ;ADR OF BLOCK HOLDING DIR NAME,,CRDSTX
;CRDSTX ;STRUCTURE NUMBER
;CRDIRB ;HOLDS EXPECTED TERMINATING BRACKET ON DIRECTORY STRING
;CRDLEN ;LENGTH OF NAME OF DIRECTORY FOR SETMSB
;CRDCPY ;-1 IF NEED TO CALL CPYBAK, 0 OTHERWISE
;CRDCAP ;CAPENB OF USER
;CRDTMP ;STARTING ADDRESS OF FDB
;CRDDEV ;DEVICE DESIGNATOR FOR CHKNUM
;CRDSTR ;STRUCTURE NUMBER IN CHKNUM
;CRDSUP ;FULLWORD DIR NUMBER OF SUPERIOR
;CRDWHL ;NONZERO IF THE USER IS LOGICALLY A WHEEL WRT THE DIR
;BEING MANIPULATED BY CRDIR - EITHER OWNER ACCESS OR A
;REAL WHOPER
;CRDDIQ ;DELTA IN SUPERIORS LIQ AS A RESULT OF THIS CRDIR
;CRDDOQ ;DELTA IN SUPERIORS LOQ AS A RESULT OF THIS CRDIR
;CRDDSQ ;DELTA IN SUPERIORS SDQ AS A RESULT OF THIS CRDIR
;CRDFLG ;FLAG WORD FOR INTERNAL USE
;CRDUFL ;WORD TO HOLD .CDLEN FROM USER ARGUMENT BLOCK
; * * * *
;THE HANDLING OF THE STRUCTURE LOCK IS INCORRECT HERE. WHENEVER THE
;CORRESPONDENCE BETWEEN A UNIQUE CODE AND A STRUCTURE NUMBER IS IN
;USE, THE STRUCTURE MUST BE LOCKED. ALL EXIT PATHS MUST CONTAIN A
;CALL TO ULKSTR IF CNVSTR HAS BEEN CALLED.
; * * * *
CRDNWH:CD%LEN!CD%PSW!CD%FPT!CD%DPT!CD%RET!CD%DGP!CD%DAC
CDNWF==1B0 ;BIT IN CRDFLG - NEW FILE BEING CREATED
CDDIR==1B1 ;BIT IN CRDFLG - SUPERIOR IS FILES-ONLY
CDREC==1B2 ;RECONSTRUCTING A DIRECTORY
CDERR==777777B35 ;[8856] Error code that bombed new dir create
CRDIR0:: EA.ENT
JSBVAR <CRDIRN,<CRDIRS,40>,CRDIRD,CRDIRE,CRDIRJ,CRDIRF,CRDIRA,CRDIRT,<CRDDNM,MAXLW+4>,CRDSTX,CRDIRB,CRDLEN,CRDCPY,CRDCAP,CRDTMP,CRDDEV,CRDSTR,CRDSUP,CRDWHL,CRDDIQ,CRDDOQ,CRDDSQ,CRDFLG,CRDUFL,CRDSFL,NAMPTR,<UGDRNM,2*MAXLW+1>>,[RETBAD (CRDIX3)] ;[7.1192]
;..
;MISCELLANEOUS SETUP FOR CRDIR
;..
SETZM CRDFLG ;INITIALIZE FLAG WORD
MOVE Q1,DIRORA ;GET BASE ADDRESS OF DIRECTORY
HRRZ Q2,Q3 ;GET ADDRESS OF USER'S BLOCK
SETZ B, ;INITIALIZE USER .CDLEN WORD
TXNE Q3,CD%LEN ;IS THE USER SPECIFIING A LENGTH
UMOVE B,.CDLEN(Q2) ;YES, GET IT
MOVE C,CAPENB ;GET ENABLED CAPABILITIES
TXNN T3,SC%WHL!SC%OPR ;IS THE USER ENABLED?
ANDX B,CD%RNA+CD%NCE+CD%NED+CD%FED+777777 ;NO, ONLY ALLOW THESE FLAGS
MOVEM B,CRDUFL ;SAVE THE FLAGS
HRLI A,(POINT 7,0,34) ;FORM BYTE POINTER TO NAME STRING
;MAKE CRDIRN POINT TO FREE SPACE HOLDING STR:<DIRECTORY> STRING
;AS INPUT BY USER
MOVEM A,CRDIRN ;SAVE NAME STRING ADDRESS
HRRZ B,A
MOVE B,1(B) ;CHECK FOR NULL NAME
TLNN B,774000
RETBAD (CRDIX5,<CALL CRDIR6>) ;Null name illegal
SETZM CRDIRD ;INITIALIZE DIR NUMBER
SETZM CRDIRF ;ASSUME DIR NUMBER NEED NOT BE CHECKED LATER
MOVE B,A ;COPY POINTER TO NAME
MOVEM B,NAMPTR ;[7461] Save pointer
HRROI A, UGDRNM ;[7461] Point to where to store string
MOVEI C,<2*MAXLC+4> ;[7461][7.1192] Copy this much
SETZM D ;[7.1192] Stop on null
SOUT% ;[7461]
ERJMP [CALL CRDIR6 ;[7461]
MOVE A,LSTERR ;[7461]
RETBAD ()] ;[7461]
MOVE B,NAMPTR ;[7461] Restore name for RCDIR%
MOVX A,RC%EMO ;STRING MUST MATCH EXACTLY
RCDIR ;PARSE DIRECTORY NAME
ERJMP [CALL CRDIR6 ;FAILED, CLEAN UP
MOVE A,LSTERR ;RETURN ERROR FROM RCDIR
RETBAD ()] ;RETURN ERROR CODE
TXNN A,RC%NOM ;MATCH?
IFSKP. ;[7103] No match!
TXNE Q3,CD%DEL ;[7103] User want to delete this new directory?
RETSKP ;[7103] Yes, nothing more to do then
ELSE. ;[7103] There was a match
MOVEM C,CRDIRD ;[7103] Store directory number
ENDIF. ;[7103]
TXNN Q3,CD%NUM ;SPECIFYING A NUMBER?
JRST CRDI0B ;NO
;USER HAS SPECIFIED A DIRECTORY NUMBER. SEE IF IT IS THE NUMBER FOR
;THE DIRECTORY SPECIFIED IN THE STR:<DIRECTORY> STRING
TXNE A,RC%NOM ;A REAL DIRECTORY ?
JRST [ SETOM CRDIRF ;NO, MARK THAT DIR # SHOULD BE CHECKED LATER
JRST CRDI0B ] ;GO SET UP GTJFN STRING FOR NEW DIRECTORY
XCTU [SKIPG B,.CDNUM(Q2)] ;GET NUMBER FROM USER
RETBAD (CRDIX8,<CALL CRDIR6>) ;ILLEGAL DIR NUMBER
CAIN B,ROOTDN ;IS THIS THE ROOT DIR?
JRST [ HLRZ A,C ;GET UNIQUE CODE
CALL CNVSTR ;GET STRUCTURE NUMBER
RETBAD (,<CALL CRDIR6>)
MOVE P3,STRTAB(A) ;GET ADDRESS OF SDB FOR THIS STRUCTURE
CALL ULKSTR ;UNLOCK THE STRUCTURE (LOCKED BY CNVSTR)
JN STCRD,(P3),CRDI0B ;DO NOT CHECK NAME IF CREATING ROOT-DIR
JRST .+1] ;CONTINUE, NOT CREATING ROOT-DIRECTORY
UMOVE B,.CDNUM(Q2) ;GET NUMBER FROM USER AGAIN
HRRZ C,CRDIRD ;GET NUMBER OF DIRECTORY
CAME B,C ;MATCH ?
RETBAD (CRDIX8,<CALL CRDIR6>) ;NO, RETURN ERROR CODE
;..
;HERE IN ALL CASES. CRDIRF IS -1 IF RCDIR FAILED ON DIRECTORY STRING.
;IF USER SPECIFIED DIRECTORY NUMBER, AND CRDIRF IS 0, NUMBER MATCHED
;THAT OF DIRECTORY IN STRING
; CRDIRD/ (STRUCTURE,,DIRECTORY) FOR DIRECTORY STRING
; CRDIRN/ POINTER TO ORIGINAL STRING
;THIS CODE BUILDS A STRING FOR THE DIRECTORY FILE CORRESPONDING TO THE
;DESIRED DIRECTORY. IT IS SET UP FOR A GTJFN.
;..
CRDI0B: MOVE B,CRDIRN ;GET POINTER TO INPUT STRING
ILDB C,B ;GET FIRST CHARACTER IN STRING
CAIE C,.CHDI1 ;DOES STRING BEGIN WITH A VALID
CAIN C,.CHDI2 ; DIRECTORY PUNCTUATION ?
SKIPA A,[POINT 7,[ASCIZ/DSK:/]] ;YES, DEFAULT THE DEVICE THEN
MOVE A,CRDIRN ;NO, GET POINTER TO SUPPLIED DEVICE
STDEV ;CONVERT LOGICAL NAMES TO PHYSICAL
RETBAD (,<PUSH P,B ;SAVE THE ERROR CODE
CALL CRDIR6 ;RELEASE THE SPACE
POP P,A>) ;GET BACK THE ERROR CODE
MOVE A,[POINT 7,CRDIRS] ;GET POINTER TO DESTINATION AREA
DEVST ;PUT THE PHYSICAL NAME THERE
RETBAD (,<PUSH P,A ;SAVE THE ERROR CODE
CALL CRDIR6 ;RELEASE ALL SPACE
POP P,A>) ;GET BACK THE ERROR CODE
MOVEI B,":" ;END THE STR NAME WITH A COLON
BOUT
MOVE B,CRDIRN ;NOW UPDATE THE BYTE POINTER
CDI0B1: ILDB C,B ;SCAN FOR :
JUMPE C,CRDI0D ;AT END OF STRING?
CAIE C,.CHDI1 ;NO, DOES STRING BEGIN WITH A VALID
CAIN C,.CHDI2 ; DIRECTORY PUNCTUATION?
JRST CRDI0D ;YES, GO PROCESS DIRECTORY STRING
CAIE C,":" ;NO, FOUND A COLON?
JRST CDI0B1 ;NO, LOOP BACK
CDI0B2: IBP B ;MOVE POINTER PAST OPENING DIRECTORY BRACKET
;..
;DIRECTORY MAY OR MAY NOT EXIST HERE. IF IT DOESN'T, AND USER GAVE
;DIRECTORY NUMBER, NUMBER IS AVAILABLE.
; B/ POINTER TO ORIGINAL STRING; POINTS JUST AFTER COLON
; A/ POINTER TO GTJFN STRING; POINTS JUST AFTER COLON
;DETERMINE TYPE OF CLOSING BRACKET EXPECTED
;..
CRDI0D: MOVEM A,CRDIRT ;SAVE DESTINATION POINTER FOR NEXT SOUT
LDB C,B ;GET OPENING BRACKET
JUMPN C,CRDI0C ;DIRECTORY NAME FOLLOWS?
SKIPN B,CRDIRD ;GET DIR NUM
RETBAD (CRDIX5,<CALL CRDIR6>) ;Null name illegal
DIRST ;GET STRING WITH DIR NAME IN IT
JRST [ PUSH P,A ;SAVE ERROR
CALL CRDIR6
POP P,A
RETBAD()]
MOVE B,CRDIRT ;NOW WE HAVE STR:<DIR>, GET TO <DIR>
CRDI1A: ILDB C,B ;GET NEXT CHAR
CAIE C,":" ;FOUND COLON YET?
JRST CRDI1A
ILDB C,B ;GET DIR STARTING CHAR
CRDI0C: MOVEI D,.CHDT1 ;ASSUME TYPE 1 PUNCTUATION (ANGLE BRACKETS)
CAIE C,.CHDI1 ;TYPE 1 PUNCTUATION ?
MOVEI D,.CHDT2 ;NO, GET TYPE 2 CLOSING BRACKET (SQUARE BRACKET)
MOVEM D,CRDIRB ;SAVE TERMINATING BRACKET
;COPY JUST THE DIRECTORY NAME INTO LOCAL STORAGE (CRDDNM) AND COMPUTE
;ITS LENGTH. MAKE IT END WITH NULL
HRROI A,CRDDNM ;SET UP POINTER TO WHERE NAME WILL GO
MOVEI C,MAXLC+1 ;GET MAX # OF CHARS ALLOWED IN DIRECTORY NAMES
MOVEI D,.CHNUL ;ALSO TERMINATE ON END OF STRING, I.E. ON NULLS
SOUT ;ISOLATE DIRECTORY NAME
MOVEI B,MAXLC ;GET MAX # OF CHARACTERS POSSIBLY MOVED
LDB D,A ;SEE IF ENDED ON A NULL
CAIE D,.CHNUL ;...
AOS B ;YES, DONT COUNT THE CLOSE BRACKET
SUB B,C ;COMPUTE # OF CHARACTERS ACTUALLY IN STRING
IDIVI B,5 ;COMPUTE # OF WORDS IN STRING + REMAINDER
SKIPN C ;DOES B HAVE EXACT # OF WORDS IN THE STRING ?
SUBI B,1 ;YES, SETMSB REQUIRES ONE LESS WORD IN COUNT
MOVEM B,CRDLEN ;SAVE # OF WORDS IN DIRECTORY NAME STRING
LDB B,A ;GET ACTUAL TERMINATING CHARACTER
CAIE B,.CHNUL ;DID STRING TERMINATE WITH A NULL ?
JRST CRDI0E ;NO, GO CHECK TERMINATING BRACKET
BKJFN ;YES, BACK UP TO TERMINATING BRACKET
JFCL
LDB B,A ;PICK UP TERMINATING BRACKET
CRDI0E: CAME B,CRDIRB ;IS IT EXPECTED TERMINATING BRACKET ?
RETBAD (CRDI11,<CALL CRDIR6>) ;NO, RETURN ERROR TO USER
MOVEI C,.CHNUL ;GET A NULL TO MAKE AN ASCIZ STRING
DPB C,A ;OVERWRITE CLOSING BRACKET WITH A NULL
SKIPN CRDIRF ;NEED TO SEE IF SPECIFIED DIR # EXISTS?
JRST CRDI0M ;NO, GO ON
;..
;RCDIR GAVE NO-MATCH AND USER SPECIFIED A DIRECTORY NUMBER. SEE IF IT
;EXISTS ON THE GIVEN STRUCTURE
;..
CALL CHKNUM ;YES, GO CHECK DIRECTORY NUMBER SUPPLIED
JRST [ CALL CRDIR6 ;BAD DIRECTORY NUMBER
MOVE A,CRDIRE ;RETURN ERROR
RETBAD ()]
;ADD THE FILENAME AND EXTENSION TO THE GTJFN STRING. IF THE DIRECTORY
;IS IN <ROOT-DIRECTORY>, COPY DIRNAME.DIRECTORY. IF THE DIRECTORY IS
;IN ANY OTHER DIRECTORY, COPY <SUPERIOR>DIRNAME.DIRECTORY.
CRDI0M: MOVEI A,CRDDNM ;CHECK IF THE NEW DIR IS A SUBDIR OF
HRLI A,(<POINT 7,.-.>) ;OTHER THAN ROOT-DIRECTORY
MOVEI P3,0 ;P3 WILL POINT TO LAST DOT
CRDI0F: ILDB B,A ;GET A CHAR
CAIN B,"." ;A SEPARATOR?
MOVE P3,A ;YES - COPY POINTER
JUMPN B,CRDI0F ;LOOP
JUMPE P3,CRDI0G ;ANY FOUND?
MOVEI A,.CHDI1 ;YES - BUILD DIR PREFIX
IDPB A,CRDIRT ; ...
MOVEI A,.CHDT1 ;CHANGE LAST SEP TO CLOSING DIR BRACKET
DPB A,P3 ; ...
CRDI0G: MOVE A,CRDIRT ;GET POINTER TO DESTINATION AGAIN
HRROI B,CRDDNM ;FORM POINTER TO DIRECTORY NAME
SOUT ;SAVE JUST THE NAME OF THE DIRECTORY
MOVEI B,"." ;REPLACE SEP IF NEEDED
SKIPE P3 ; ...
DPB B,P3 ; ...
HRROI B,[ASCIZ/.DIRECTORY;P020200/]
SOUT ;ADD ON EXTENSION
;..
;HAVE A FILESPEC OF THE FORM DEV:NAME.DIRECTORY;P000000 OR
;DEV:<SUPERIOR>DIRNAME.DIRECTORY;P020200. DO GTJFN, ALLOWING
;NON-EXISTENT FILE
;..
CALL CRDSWH ;SET WHEEL CAPABILITY
MOVEI A,CRDGJB ;GET POINTER TO GTJFN BLOCK
HRROI B,CRDIRS ;GET POINTER TO "NAME.DIRECTORY" STRING
GTJFN ;CREATE NEW NAME IF NONE OR GET OLD ONE
JRST [ MOVEM A,CRDIRE ;SAVE ERROR CODE
CALL CRDCWH ;CLEAR WHEEL
CALL CRDIR6 ;RELEASE ASSIGNED STORAGE
MOVE B,CRDIRE ;RESTORE ERROR CODE
MOVEI A,CRDIX4 ;ASSUME SUPERIOR DIRECTORY IS FULL
CAIN B,GJFX16 ;NO SUCH DEVICE ?
MOVEI A,CRDI12 ;YES. SAY STRUCTURE NOT MOUNTED
CAIN B,STRX09 ;"Prior structure mount required" error?
MOVEI A,CRDI12 ;yes, say structure not mounted
CAIN B,GJFX17 ;NO SUCH DIRECTORY?
MOVEI A,CRDI23 ;YES. SAY SUPERIOR DIRECTORY DOESN'T EXIST
RETBAD () ] ;RETURN ERROR
MOVEM A,CRDIRJ ;SAVE THE JFN OF THE DIRECTORY FILE
CALL CRDCWH ;CLEAR WHEEL
;Get superior directory number and save for later. If user can connect to
;superior directory without a password, he is a logical WHEEL for this
;directory.
MOVE A,CRDIRJ ;GET THE JFN
IMULI A,MLJFN ;CONVERT TO JFN BLOCK OFFSET
HRRZ B,FILDDN(A) ;GET HW DIR NUMBER OF SUPERIOR
LOAD A,FLUC,(A) ;GET UNIQUE CODE FOR FILE STRUCTURE
HRL B,A ;BUILD FW DIR NUMBER
MOVEM B,CRDSUP ;SAVE
CALL CNVSTR ;CONVERT UNIQUE CODE TO STRUCTURE NUMBER
JRST CRDIR4 ;FAILED, RETURN ERROR TO USER
HRRM A,CRDSTX ;SAVE STRUCTURE NUMBER
CALL ULKSTR ;UNLOCK THE STRUCTURE (LOCKED BY CNVSTR)
MOVE A,CRDSUP ;CHECK ACCESS TO SUPERIOR DIR
CALL SETDIR ;FIRST MAP DIR
JRST CRDIR4 ;FAILED
SETZM CRDWHL ;ASSUME NOT A LOGICAL WHEEL
MOVX B,DC%CN ;CHECK IF CAN CONNECT TO SUPERIOR
CALL DIRCHK ; ???
SKIPA ;NO - USER MUST PASS LATER CHECKS
SETOM CRDWHL ;YES - USER IS A LOGICAL WHEEL
MOVE B,DIRORA ;POINT TO START OF DIRECTORY
LOAD B,DRMOD,(B) ;GET MODE BITS
TXNN B,CD%DIR ;[8856] Is this a FILES-ONLY directory?
IFSKP. ;[8856] Yes
MOVX B,CDDIR ;[8856] Load the local flag
IORM B,CRDFLG ;[8856] Set it in the local flag word
ENDIF. ;[8856]
CALL USTDIR ;UNLOCK DIR
;See if directory file exists, and remember dir number if it does exist.
HRRZ A,CRDIRJ ;GET JFN OF DIRECTORY FILE
MOVE B,[1,,.FBCTL] ;NOW SEE IF THE FILE EXISTS
MOVEI C,D ;GET FLAGS INTO D
GTFDB
TXNN D,FB%DIR!FB%NXF ;IS THIS A DIR OR NON-EX FILE?
ERRJMP (CRDIX9,CRDIR4) ;[8856] Internal format of dir is incorrect
MOVE B,[1,,.FBDRN] ;GET DIR NUMBER
MOVEI C,C
GTFDB
HRRZM C,CRDIRD ;SAVE DIR NUMBER IF FILE EXISTS
SETZM CRDCPY ;ASSUME DON'T HAVE TO CALL CPYBAK
TXNN D,FB%NXF ;FILE EXIST YET?
JRST CRDIR1 ;YES, NOT CREATING A NEW DIR
;HERE WHEN CREATING A NEW DIRECTORY
; CRDSUP/DIRECTORY OF SUPERIOR
; CRDSTX/ STRUCTURE NUMBER
;..
MOVX A,CDNWF ;INDICATE NEW FILE FOR CLEANING UP
IORM A,CRDFLG
SKIPN CRDWHL ;CAN THIS USER CREATE?
JRST [ MOVEI A,CRDIX1 ;NO. RETURN ERROR
JRST CRDIR4]
HRRZ C,CRDSUP ;GET SUPERIOR
CAIN C,ROOTDN ;ROOT-DIRECTORY?
JRST [ SETOM CRDCPY ;YES - HAVE TO CALL CPYBAK
JRST CRDI0H] ;AND OMIT LIMIT CHECKS
;CHECK PRIVILEGES
MOVE A,CAPENB ;GET ENABLED CAPABILITIES
TXNN A,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
TXNN Q3,CD%PRV ;WANT TO SET PRIVILEGES?
JRST CRDI0N ;WHEEL OR OPER OR NOT SETTING PRIVILEGES
UMOVE A,.CDPRV(Q2) ;YES. GET DESIRED PRIVILEGES
ANDCM A,CAPENB ;WE HAVE TO HAVE THEM ENABLED
JUMPN A, [ MOVEI A,CRDI20
JRST CRDIR4]
;DIRECTORY IS NOT BEING CREATED IN <ROOT-DIRECTORY>. MAP ITS SUPERIOR
;TO CHECK THE SUBDIRECTORY'S PARAMETERS AGAINST THE SUPERIOR'S
CRDI0N: MOVE A,CRDSUP ;MAP SUPERIOR FOR LIMIT
CALL SETDIR ;CHECKS
JRST CRDIR4 ;FAILED
;CHECK LIST OF CREATABLE USER GROUPS
TXNE Q3,CD%CUG ;SETTING CREATABLE USER GROUPS?
JRST [ UMOVE A,.CDCUG(Q2) ;GET USER CREATABLE GROUPS LIST
LOAD B,DRCUG,(Q1) ;GET CREATABLE GROUPS LIST
CALL CDCKCU ;VALIDATE LIST
ERRJMP(CRDI16,CRDI0I) ;FAILED
JRST .+1] ;SUCCESS - GO ON
;CHECK LIST OF USER GROUPS
TXNE Q3,CD%UGP ;SETTING USER GROUPS?
JRST [ UMOVE A,.CDUGP(Q2) ;YES - GET USERS LIST
LOAD B,DRCUG,(Q1) ;GET CREATABLE USER GROUPS LIST
CALL CDCKCU ;VALIDATE LIST
ERRJMP(CRDI16,CRDI0I) ;FAILED
JRST .+1]
;..
;NEW DIRECTORY, NOT IN ROOT-DIRECTORY...
;CHECK PERMANENT (LOGGED-OUT) QUOTA
;..
MOVE A,CRDUFL ;GET FLAGS FROM USER
TXNE A,CD%NSQ ;CHANGING THE SUPERIOR'S QUOTA
JRST CRDI0L ;NO, SKIP THESE CHECKS
MOVX B,.STDMX ;GET DEFAULT PERMANENT QUOTA
TXNE Q3,CD%LOQ ;USER SETTING LOQ?
UMOVE B,.CDLOQ(Q2) ;YES - GET THAT VALUE
LOAD C,DRLOQ,(Q1) ;COMPARE AGAINST SUPERIOR
CALL CKLOQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
JRST CRDI0P ;INFINITE. DON'T CHECK
SKIPL B ; ...
CAMLE B,C ; ...
ERRJMP(CRDI14,CRDI0I) ;EXCEEDED SUPERIOR LOQ OR .LT. 0
;CHECK QUOTA OF SUBDIRECTORIES
CRDI0P: MOVX B,.STDSD ;GET DEFAULT SUBDIR QUOTA
TXNE Q3,CD%SDQ ;SETTING SUBDIR QUOTA?
UMOVE B,.CDSDQ(Q2) ;YES - GET USERS VALUE
TLNE B,-1 ;RIGHT HALF ONLY?
ERRJMP (CRDI24,CRDI0I) ;NO. WON'T FIT IN ALLOTTED SPACE
LOAD C,DRSDM,(Q1) ;COMPARE AGAINST
OPSTR <SUB C,>,DRSDC,(Q1) ;REMAINING SUBDIR QUOTA
CAML B,C ;LESS ONE FOR DIR BEING CREATED
ERRJMP(CRDI15,CRDI0I) ;EXCEEDED SUPERIOR SDQ
;CHECK WORKING (LOGGED-IN) QUOTA
HRRZ A,CRDSUP ;GET SUPERIOR DIR NUM
MOVE B,CRDSTX ;GET STRUCTURE NUMBER
CALL GETCAL
JRST [ LOAD A,DRLIQ,(Q1) ;DIRECTORY VALUES
OPSTR <SUB A,>,DRDCA,(Q1) ; ...
JRST .+1]
MOVE C,A ;COPY FREE SPACE
MOVX B,.STDMX ;GET DEFAULT LIQ
TXNE Q3,CD%LIQ ;SETTING LIQ?
UMOVE B,.CDLIQ(Q2) ;YES - GET USERS VALUE
CALL CKLIQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
JUMPGE B,CRDI0L ;YES. DON'T CHECK LIMITS
SKIPL B ;DON'T ALLOW NEGATIVE
CAMLE B,C ;WILL IT FIT?
ERRJMP(CRDI13,CRDI0I) ;NO - SUPERIOR LIQ EXCEEDED OR .LT. 0
;DON'T ALLOW CREATION OF LOGIN SUBDIRECTORY UNDER A FILES-ONLY SUPERIOR.
;NOTE THAT THIS CODE HAS BEEN SKIPPED IF SUPERIOR IS ROOT-DIRECTORY
CRDI0L: MOVX B,CDDIR ;SEE IF THE SUPERIOR IS FILES-ONLY
TDNN B,CRDFLG ;..
JRST CRDIR9 ;NO. DOESN'T MATTER WHAT THIS ONE IS TO BE
TXNN Q3,CD%MOD ;SUPERIOR IS FILES ONLY. ARE WE SETTING THE MODE?
ERRJMP(CRDI17,CRDI0I) ;NO. CAN'T TAKE THE DEFAULT
UMOVE A,.CDMOD(Q2) ;YES. GET THE MODE WORD FROM USER
TXNN A,CD%DIR ;SETTING FILES ONLY?
ERRJMP(CRDI17,CRDI0I) ;NO. ILLEGAL IN FILES-ONLY SUPERIOR
CRDIR9: CALL USTDIR ;UNLOCK THE SUPERIOR
;..
;NEW DIRECTORY...
;HERE WHEN QUOTAS AND MODE HAVE BEEN CHECKED OR ROOT-DIRECTORY IS THE
;SUPERIOR. GET USER'S CHOICE FOR DIRECTORY NUMBER OR NEXT AVAILABLE ONE
;AND SAVE IN CRDIRD
;..
CRDI0H: TXNE Q3,CD%NUM ;SETTING THE DIR NUMBER SPECIFICALLY?
JRST [ UMOVE A,.CDNUM(Q2) ;YES, GET THE DIR NUMBER
JRST CRDI0A] ;GO CHECK IF LEGAL
HRRZ A,CRDSTX ;GET STRUCTURE NUMBER
CALL GETNDN ;NO, GET NEXT AVAILABLE DIR NUMBER ON THIS STR
JRST [ MOVEI A,CRDI10 ;MAXIMUM DIR # EXCEEDED
JRST CRDIR4] ;GO CLEAN UP AND BOMB
JRST CRDI0A ;CONTINUE BELOW
;HERE WHEN A LIMIT CHECK HAS FAILED
CRDI0I: MOVEM A,CRDIRE ;SAVE ERROR
CALL USTDIR ;RELEASE SUPERIOR
MOVE A,CRDIRE ;RESTORE ERROR
JRST CRDIR4 ;AND UNDO WORK SO FAR
CRDI0A: SKIPL A ;NEGATIVE IS ILLEGAL
CAML A,MXDIRN ;IS THIS A LEGAL DIRECTORY NUMBER?
JRST [ MOVEI A,CRDIX8 ;NO, ILLEGAL DIR # SPECIFIED
JRST CRDIR4] ;GO RELEASE JFN AND BOMB
MOVEM A,CRDIRD ;SAVE DIR NUMBER
CAIN A,ROOTDN ;IS THIS THE ROOT DIR BEING CREATED
JRST [ SETZ A, ;YES, NO DISK ADDRESS
CALL CRDIDX ;HANDLE THIS SPECIALLY
BUG.(HLT,GTFDB6,JSYSF,SOFT,<CRDI0A - Cannot do GETFDB on ROOT-DIRECTORY >,,<
Cause: There was an error in creating the Root-Directory. Either the
FDB could not be mapped or the index table could not be set up.
>)
JRST CRDIR1] ;ROOT DIR NOW EXISTS, DONT REINITIALIZE
;THIS IS NOT ROOT-DIRECTORY. DO RECONSTRUCTION IF REQUESTED
CALL CHKREC ;SEE IF DOING RECONSTRUCTION
JRST CRDIAA ;NO
CALL CRDIDX ;YES, GO SET UP IDXTAB AND FBADR
JRST CRDIAA ;FAILED, CREATE NEW DIR
MOVX A,CDREC ;DONE, MARK THAT RECONSTRUCTION BEING DONE
IORM A,CRDFLG ; IN FLAG WORD
JRST CRDIAB ;SKIP THE DIRECTORY INITIALIZATION
;..
;NEW DIRECTORY...
;THIS IS NOT ROOT-DIRECTORY, AND WE AREN'T DOING RECONSTRUCTION.
;OPEN AND CLOSE DIRECTORY FILE, SET IDXTAB ENTRY AND INITIALIZE THE DIRECTORY
;..
CRDIAA: HRRZ A,CRDIRJ ;GET JFN
MOVE B,[FLD (^D36,OF%BSZ)+OF%RD+OF%WR+OF%THW]
OPENF ;OPEN THE FILE TO CREATE THE INDEX BLK
JRST CRDIR4 ;ERROR ON OPENF, GO RELEASE JFN
HRLI A,(1B0) ;NOW CLOSE THE FILE KEEPING THE JFN
CLOSF ;THE FILE EXISTS NOW
JFCL
SETZ A, ;NO ADDRESS OF INDEX BLOCK YET
CALL CRDIDX ;GO INITIALIZE THE INDEX TABLE
JRST CRDIR4 ;BOMBED!
MOVE A,CRDIRD ;GET THE DIRECTORY NUMBER
HRRZ B,CRDSTX ;GET STRUCTURE NUMBER
CALL DIRIN1 ;[7.1257] (A,B/) Initialize this directory
JRST CRDIR4 ;COULD NOT INITIALIZE DIR
;DIRECTORY HAS BEEN INITIALIZED OR RECONSTRUCTED. UNLESS SUPERIOR IS
;ROOT-DIRECTORY, GET NEW DIRECTORY'S QUOTAS
CRDIAB: HRRZ A,CRDSUP ;IS THE SUPERIOR ROOT-DIRECTORY?
CAIN A,ROOTDN ; ???
JRST CRDRD ;YES - NEVER DECREMENT QUOTAS
HLL A,CRDSUP ;GET UNIQUE CODE
HRR A,CRDIRD ;FORM NUMBER FOR DIRECTORY BEING CREATED
CALL SETDIR ;MAP DIRECTORY BEING CREATED
JRST CRDIR4 ;FAILED
LOAD A,DRLIQ,(Q1) ;GET CURRENT QUOTA VALUES
MOVEM A,CRDDIQ
LOAD A,DRLOQ,(Q1)
MOVEM A,CRDDOQ
LOAD A,DRSDM,(Q1)
MOVEM A,CRDDSQ
CALL USTDIR ;UNLOCK THE DIRECTORY
;MAP THE SUPERIOR AND ADJUST ITS QUOTAS BY THE AMOUNT GIVEN TO
;THE NEW DIRECTORY
CRDRD: MOVE A,CRDSUP ;DECREMENT QUOTAS BY DEFAULTS
CALL SETDIR ;MAP SUPERIOR
JRST CRDIR4 ;FAILED
INCR DRSDC,(Q1) ;INCREMENT SUBDIRECTORY COUNT
HRRZ A,CRDSUP ;IS SUPERIOR ROOT-DIRECTORY?
CAIN A,ROOTDN ;?
JRST CRDR1C ;YES
MOVE A,CRDUFL ;GET USER FLAGS
TXNE A,CD%NSQ ;UPDATING SUPERIOR QUOTA
JRST CRDIAC ;NO, SKIP OVER THIS CODE
CALL CKLIQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
JRST CRDIAF ;YES. DON'T ADJUST IT
LOAD A,DRLIQ,(Q1) ;DECREMENT WORKING
SUB A,CRDDIQ ;...
STOR A,DRLIQ,(Q1) ;STORE
HRRZ A,CRDSUP ;A/ NUMBER OF SUPERIOR
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
MOVN C,CRDDIQ ;C/ AMOUNT TO ADD TO SUPERIOR'S ALLOCATION
CALL ADJALC ;ADJUST SUPERIOR'S ALLOCATION BY SUBDIR'S QUOTA
CRDIAF: CALL CKLOQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
JRST CRDIAD ;YES. DON'T ADJUST
LOAD A,DRLOQ,(Q1) ;DECREMENT PERMANENT
SUB A,CRDDOQ ;...
STOR A,DRLOQ,(Q1) ;STORE
CRDIAD: LOAD A,DRSDM,(Q1) ;DECREMENT SUBDIR QUOTA
SUB A,CRDDSQ ;...
STOR A,DRSDM,(Q1) ;STORE
CRDIAC: CALL UPDDIR ;UPDATE DISK COPY
CALL USTDIR ;RELEASE SUPERIOR
;SET FLAG IN SUPERIOR'S FDB TO INDICATE IT HAS INFERIORS
HRRZ A,CRDSUP ;GET SUPERIOR DIR NUMBER
CALL GETIDX ;GET SUPERIOR'S SUPERIOR AND FDB ADDR
JRST CRDR1B ;IF NOT SETUP, GO ON
MOVEM A,CRDTMP ;SAVE FDB OF SUPERIOR
MOVE A,C ;GET SUP SUP DIR NUMBER
HLL A,CRDSUP ;GET SUC FOR FWDN
CALL SETDIR ;MAP SUPERIOR'S SUPERIOR
JRST CRDR1B ;NOT FATAL - GO ON
MOVE A,CRDTMP ;GET FDB
ADD A,DIRORA ;AS AN ABSOLUTE ADDRESS
SETONE FB%SDR,.FBCTL(A) ;SET SUBDIR FLAG IN SUPERIORS FDB
CALL UPDDIR ;UPDATE DISK COPY
CALL USTDIR ;RELEASE SUP SUP
JRST CRDR1B ;SETUP USERS VALUES
;..
;..
;NOT CREATING A NEW DIRECTORY. SEE IF PRIVILEGED TO CHANGE THINGS
CRDIR1: SKIPE CRDWHL ;LOGICAL WHEEL OR OPERATOR?
JRST CRDR1B ;YES. OK TO DO ANYTHING
MOVE A,FACTSW ;NO. DOES SYSTEM ALLOW USER TO CHANGE THINGS?
TXNN A,SF%CRD ;CAN USER CHANGE FIELDS
ERRJMP (CRDIX1,CRDIR4) ;[8856] No
HLLZ A,Q3 ;GET REQUESTED FUNCTIONS
ANDCM A,CRDNWH ;COMPARE AGAINST ALLOWED FUNCTIONS
JUMPN A,[MOVEI A,CRDIX1 ;WANT TO DO SOMETHING NOT ALLOWED
JRST CRDIR4] ;REQUIRE WHEEL OR OPERATOR
HLL A,CRDSUP ;GET UNIQUE CODE
HRR A,CRDIRD ;A/(UNIQUE CODE,,DIRECTORY NUMBER)
CALL SETDIR ;MAP THE DIRECTORY
JRST CRDIR4 ;FAILED.
MOVX B,DC%CN ;B/CHECK FOR ABILITY TO CONNECT
CALL DIRCHK ;CAN USER ACCESS THIS DIRECTORY?
ERRJMP (CRDIX1,CRDIR7) ;[8856] No, wheel or operator required
MOVE B,DIRORA ;GET ADDRESS OF MAPPED DIRECTORY
LOAD B,DRPSW,(B) ;GET OFFSET OF PASSWORD BLOCK
SKIPN B ;IF NONE, DIRECTORY HAS NO PASSWORD
ERRJMP (CRDIX1,CRDIR7) ;[8856] Wheel or operator required
ADD B,DIRORA ;GET ABSOLUTE ADDRESS OF PASSWORD BLOCK
MOVE C,1(B) ;GET FIRST WORD AFTER HEADER
TLNN C,774000 ;IF FIRST CHARACTER IS NULL, NO PASSWORD
ERRJMP (CRDIX1,CRDIR7) ;[8856] Wheel or operator required if no pswd
UMOVE B,3 ;GET POINTER TO PASSWORD AS INPUT BY USER
CALL CHKPSX ;SEE IF USER GAVE CORRECT PASSWORD
JRST [ ULKDIR ;FAILED. UNLOCK THE DIRECTORY LOCKED BY SETDIR
SKIPN A ;NEED TO SLEEP?
CALL PASPEN
OKINT ;NOW CAN GO OKINT FROM CALL TO SETDIR
MOVEI A,CNDIX1 ;ASSUME INCORRECT PASSWORD GIVEN
XCTU [ SKIPN 3] ;DID USER GIVE A PASSWORD?
MOVEI A,ACESX3 ;NO. RETURN 'PASSWORD REQUIRED'
JRST CRDIR4] ;TAKE ERROR RETURN
CRDR1C: CALL USTDIR ;PASSWORD IS OK. UNLOCK THE DIRECTORY
;LOCKED BY SETDIR
;..
;COMMON CODE FOR NEW AND OLD DIRECTORIES. IF NEW, IT HAS BEEN
;INITIALIZED. IF OLD, PRIVILEGE HAS BEEN CHECKED.
;..
CRDR1B: HRRZ A,CRDIRD ;GET DIR NUMBER
TXNE Q3,CD%NUM ;IS USER SPECIFYING A DIR NUMBER
UMOVE A,.CDNUM(Q2) ;YES, GET THE NUMBER
CAME A,CRDIRD ;IS THIS A MATCH OF WHAT IS IN DIR FILE
ERRJMP (CRDIX2,CRDIR4) ;[8856] No, dir number must match existing num
TXNE Q3,CD%DEL ;DELETE WANTED?
JRST DELDIR ;Yes
MOVE A,CRDIRJ ;GET THE JFN OF THE DIR FILE
RLJFN ;RELEASE THE JFN
JFCL
SETZM CRDIRJ ;MARK THAT THE JFN HAS BEEN RELEASED
HLL A,CRDSUP ;GET STR UNIQUE CODE
HRR A,CRDIRD ;ADD DIRECTORY NUMBER
CALL SETDIR ;MAP IN THIS DIRECTORY
JRST [ BUG.(CHK,CRDSDF,JSYSF,HARD,<CRDIR1 - SETDIR failed on new directory>,,<
Cause: SETDIR failed to map in a directory which has been newly created by
CRDIR%. The CRDIR% call will fail and the directory will not be
created.
>)
JRST CRDIR4]
;PUT THE DIRECTORY'S NAME IN A NAME BLOCK POINTED TO BY THE DIRECTORY
;HEADER, AND RELEASE THE FREE SPACE CONTAINING THE NAME STRING
MOVE A,DIRORA ;GET BASE ADR OF DIR AREA
LOAD A,DRNAM,(A) ;GET POINTER TO NAME STRING
JUMPN A,CRDR1A ;IF ALREADY SET, DONT SET IT AGAIN
HRROI A,CRDDNM ;FORM POINTER TO NAME STRING
MOVE B,CRDLEN ;GET LENGTH OF STRING
CALL SETMSB ;SET UP MASK FOR LAST WORD
CALL CPYDIR ;PUT THIS NAME IN THE DIR
ERRJMP (CRDIX4,CRDIR7) ;[8856] Failed to get room, return error
MOVEI B,.TYNAM ;MARK THIS AS A NAME STRING
STOR B,NMTYP,(A) ;...
SUB A,DIRORA ;GET RELATIVE ADDRESS OF BLOCK
STOR A,DRNAM,(Q1) ;PUT ADR IN DIR
CRDR1A: CALL CRDIR6 ;GO RELEASE JSB SPACE
;..
;..
;SET PASSWORD
CALL CHKCHG ;CHECK IF CHANGE DESIRED
JRST CRDR3A ;NO, DO NOT CHANGE EXISTING PARAMETERS
CRDR1S: TXNN Q3,CD%PSW ;WANT TO SET PASSWORD?
JRST CRDIR3 ;No password change
MOVE T1,CRDSTX ;Get structure number
MOVE T1,STRTAB(T1) ;Get address of SDB for this structure
MOVE T1,SDBSTS(T1) ;[7.1063]Get the structure flags
MOVEM T1,CRDSFL ;[7.1063]Save them in CRDSFL
UMOVE T1,.CDPSW(Q2) ;Get pointer to password
TLC T1,-1 ;Check for -1,,ADR
TLCN T1,-1 ; and if so,
HRLI T1,(<POINT 7,0>) ; make it into a real byte pointer
XCTBU [ ILDB T1,T1] ;Get first character of password
JUMPN T1,CRDR2A ;If non-null, OK
SKIPN CRDWHL ;Must be WHOPER or have connect to superior
ERRJMP (CRDIX1,CRDIR7) ;[8856] Nope, return error
GPVR1: SETZM T2 ;Null password always uses encryption version 0
STOR T2,DRPEV,(Q1) ;...
MOVE T1,DIRORA ;Null password has no block
JRST CRDRP3 ;Go store it
;Password is not null, copy to monitor space
CRDR2A: UMOVE T1,.CDPSW(Q2) ;Get pointer to password
CALL CPYFUS ;Copy to free storage
ERRJMP (CRDIX3,CRDIR7) ;[8856] JSB full
HRLI T1,-7 ;Make lookup pointer to JSB block
MOVEM T1,CRDIRN ;Save pointer
MOVE T3,CRDUFL ;Get user's flags
TXNE T3,CD%PEN ;Already encrypted?
JRST CRDRP1 ;Yes
;Check password length if CRDIR not called from monitor.
CALL CKMMOD ;[7.1290] Check if previous context monitor
CAIA ;[7.1290] Nope, check password length
JRST CRDR2B ;[7.1290] Yes, probably it is MSTR
CALL CHPLEN ;[7.1231] (/) Check password length
ERRJMP (CRDI30,CRDIR7) ;[8856] Password not long enough
;..
;Here when password is of proper length, check for encryption
CRDR2B: SETZM T1 ;[7.1290] Assume unencrypted structure
STOR T1,DRPEV,(Q1) ;Store encryption version number
MOVE T1,CRDSFL ;Get status flags for the structure
TXNN T1,MS%CRY ;Want to encrypt it?
JRST CRDRP2 ;No, just store password as is
GPVR2: MOVE T1,PSENVR ;Yes, use latest encryption
STOR T1,DRPEV,(Q1) ;Store encryption version number
CALL LGTAD ;Get system time and date
STOR T1,DRPDT,(Q1) ;Save time password created
;(If no date, store -1)
LOAD T1,DRPEV,(Q1) ;Load the encryption version to use
MOVE T2,CRDIRN ;Get JSB pointer
CALL ENCPAS ;Encrypt password
ERRJMP (CRDI28,CRDIR7) ;[8856] Bad version number probably
SKPENC: JRST CRDRP2 ;Go store the password
;Here if encrypted password with version number was supplied
CRDRP1: HRRZ T2,CRDUFL ;Get length of arguments
CAIGE T2,.CDPDT ;Are they there? (version and date)
ERRJMP (CRDI26,CRDIR7) ;[8856] Nope
UMOVE T1,.CDPEV(Q2) ;Get user-supplied encryption version
JUMPE T1,CRDP1A ;Bypass structure check if zero (unencrypted)
MOVE T3,CRDSFL ;Get status flags for the structure
TXNN T3,MS%CRY ;Is password encryption on for this structure?
ERRJMP (CRDI27,CRDIR7) ;[8856] Nope
CRDP1A: CALL CHKPEV ;Test validity of encryption version number
ERRJMP (CRDI28,CRDIR7) ;[8856] Bad version number
STOR T1,DRPEV,(Q1) ; And remember it
UMOVE T1,.CDPDT(Q2) ;Get user-supplied encryption date
STOR T1,DRPDT,(Q1) ; And remember it
;Here with properly encrypted password to set in directory.
CRDRP2: MOVE T1,CRDIRN ;Recover JSB address
CALL SETMSK ;Store in directory
CALL CPYDIR ;And copy string to directory
ERRJMP (CRDIX4,CRDIR7) ;[8856] Owie
MOVEI B,.TYNAM ;MARK AS NAME BLOCK
STOR B,NMTYP,(A) ;...
CRDRP3: LOAD B,DRPSW,(Q1) ;GET POINTER TO OLD PASSWORD STRING
SUB A,DIRORA ;GET RELATIVE ADR OF PASSWORD STRING
STOR A,DRPSW,(Q1) ;STORE NEW PASSWORD STRING POINTER
JUMPE B,CRDIR2
CALL RELDFR ;Release storage if any
CRDIR2: CALL CRDIR6 ;RELEASE JSB STORAGE
;SET DEFAULT ACCOUNT STRING
CRDIR3: TXNN Q3,CD%DAC ;WANT TO SET DEFAULT ACCOUNT?
JRST CRDR3F ;NO, PROCEED
UMOVE A,.CDDAC(Q2) ;GET POINTER TO ACCOUNT
CALL CPYFUS ;DRAG IT IN
ERRJMP (CRDIX3,CRDIR7) ;[8856] JSB free space?
CALL SETMSK ;STORE IN DIRECTORY
CALL CPYDIR ;AND COPY STRING TO DIRECTORY
ERRJMP (CRDIX4,CRDIR7) ;[8856] Can't do it
MOVEI B,.TYNAM ;MARK IT AS A NAME BLOCK
STOR B,NMTYP,(A) ;
LOAD B,DRACT,(Q1) ;GET POINTER TO OLD ACCOUNT
SUB A,DIRORA ;RELATIVE ADDRESS OF ACCOUNT
STOR A,DRACT,(Q1) ;STORE NEW ACCOUNT POINTER
JUMPE B,CRDR3E ;WAS THERE AN OLD DEFAULT DIR ACCOUNT?
CALL RELDFR ;YES, RELEASE SPACE FOR IT
CRDR3E: CALL CRDIR6 ;RELEASE JSB STORAGE
;..
;..
;SET PRIVILEGES
CRDR3F: TXNN Q3,CD%PRV ;SETTING PRIVILEGES?
JRST CRDR3G ;NO. SKIP THIS THEN
UMOVE A,.CDPRV(Q2) ;Get privilege bits
MOVE B,CAPENB ;LIMIT POSSIBLE PRIVS TO CURRENT USER
TXNE B,SC%WHL!SC%OPR ;[8856] Privs enabled right now?
IFSKP. ;[8856] Nope
MOVE B,A ;[8856] Copy requested priv word
ANDCM B,CAPENB ;[8856] Leave requested bits we don't have
IFN. B ;[8856] Are we granting a priv that we own?
MOVEI A,CRDI20 ;[8856] Wheel, oper, or requested cap required
JRST CRDIR7 ;[8856] Unlock directory and return error
ENDIF. ;[8856] Otherwise
ENDIF. ;[8856] it is OK to set the requested caps
STOR A,DRPRV,(Q1) ;[8856] Set requested capabilities
;..
;SET MODES
;..
CRDR3G: UMOVE A,.CDMOD(Q2) ;GET MODE BITS
TXNN Q3,CD%MOD ;WANT TO SET MODE?
JRST CRDI0K ;NO. SKIP
MOVX B,CDNWF ;IF THIS IS A NEW DIRECTORY
TDNE B,CRDFLG ; WE HAVE ALREADY CHECKED THE MODES
JRST CRDI0J ;IT IS, SO SKIP THESE CHECKS
MOVX B,CDDIR ;IF THE SUPERIOR IS FILES-ONLY
TDNN B,CRDFLG ; HAVE TO CHECK FOR CREATING LOGIN DIR
JRST CRDI0J ;NOT FILES-ONLY. OK TO CREATE USER IF DESIRED
HRRZ B,CRDSUP ;IF SUPERIOR IS ROOT-DIRECTORY
CAIN B,ROOTDN ; OK TO CREATE LOGIN DIRECTORY
JRST CRDI0J
TXNE A,CD%DIR ;TRYING TO MAKE THIS FILES ONLY?
JRST CRDI0J ;YES. OK
MOVEI A,CRDI17 ;NO. CAN'T MAKE THIS A USER DIRECTORY
JRST CRDIR7 ;[8856] Unlock directory, return error
CRDI0J: STOR A,DRMOD,(Q1) ;YES
;SET LOGIN DATE
CRDI0K: UMOVE A,.CDLLD(Q2) ;GET LAST LOGIN DATE
LOAD B,DRDAT,(Q1) ;GET PREVIOUS DATE
CAMG A,B ;IS THE NEW DATE BEFORE CURRENT DATE?
JRST CRDPUC ;YES, DONT LET TIME GO BACKWARDS
TXNE Q3,CD%LLD ;WANT TO SET IT?
STOR A,DRDAT,(Q1) ;YES
CRDPUC: MOVE T1,CRDUFL ;Get user's flags
TXNN T1,CD%PMU ;Setting Password use data?
JRST CRDPED ;
HRRZ T1,CRDUFL ;Get length of arguments
CAIGE T1,.CDPMU ;Is it there?
ERRJMP (CRDI26,CRDIR7) ;[8856] No
MOVE T1,CAPENB ;[7.1020] Get privs
TXNN T1,SC%WHL!SC%OPR ;[7.1020] Is user prived?
ERRJMP (CRDIX1,CRDIR7) ;[8856] No, don't let him change this
UMOVE T1,.CDPMU(Q2) ;Yes, get it
STOR T1,DRPUD,(Q1) ;Store it - zero means no use limit
CRDPED: MOVE T1,CRDUFL ;Get user's flags
TXNN T1,CD%PED ;Setting expiration date?
JRST CDDIRQ ;No
HRRZ T1,CRDUFL ;Get length of arguments
CAIGE T1,.CDPED ;Is it there?
ERRJMP (CRDI26,CRDIR7) ;[8856] No
MOVE T1,CAPENB ;[7.1020] Get privs
TXNN T1,SC%WHL!SC%OPR ;[7.1020] Is user prived?
ERRJMP (CRDIX1,CRDIR7) ;[8856] No, don't let him change this
UMOVE T1,.CDPED(Q2) ;Yes, get it
STOR T1,DRPED,(Q1) ;Store it - zero means no date
;SKIP EVERYTHING FROM CRDR1S TO HERE IF USER SET CD%NCE
CRDR3A: CALL UPDDIR ;UPDATE DISK WITH RESULTS SO FAR
;COMPUTE CHANGES IN LOGGED-IN QUOTA, LOGGED-OUT QUOTA, AND SUBDIRECTORY
;QUOTA. IF DIRECTORY IS NEW, IT CURRENTLY IS SET UP FOR THE DEFAULT
;VALUES
CDDIRQ: LOAD A,DRLIQ,(Q1) ;GET CURRENT LIQ
UMOVE B,.CDLIQ(Q2) ;GET USERS VALUE
TXNN Q3,CD%LIQ ;BEING SET?
MOVE B,A ;NO - NO CHANGE
SUB A,B ;COMPUTE DELTA
MOVEM A,CRDDIQ ;SAVE IT
MOVX A,CDNWF ;IF THIS IS A NEW FILE, DON'T
TDNE A,CRDFLG ; TO CHECK ITS ALLOCATION
JRST CRD3AC
HRRZ A,CRDIRD ;A/ THIS DIRECTORY'S NUMBER
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
CAIN A,ROOTDN ;IS THIS "ROOT-DIRECTORY"?
JRST CRD3AC ;YES. ALLOW IT THEN.
CALL GETCAL
JRST [ LOAD A,DRLIQ,(Q1) ;DIRECTORY VALUES
OPSTR <SUB A,>,DRDCA,(Q1) ; ...
JRST .+1]
SUB A,CRDDIQ ;ADJUST BY AMOUNT OF CHANGE FROM OLD VALUE
JUMPGE A,CRD3AC ;[8856] Enough quota today
MOVEI A,CRDI21 ;[8856] Not enough quota for existing files
JRST CRDIR7 ;[8856] Give error, unlock, return
CRD3AC: LOAD A,DRLOQ,(Q1) ;GET CURRENT LOQ
UMOVE B,.CDLOQ(Q2) ;GET USERS VALUE
TXNN Q3,CD%LOQ ;SETTING LOQ?
MOVE B,A ;NO - NO CHANGE
SUB A,B ;COMPUTE DELTA
MOVEM A,CRDDOQ ;SAVE IT
SETZM CRDDSQ ;ASSUME NO CHANGE IN SUBDIRECTORY QUOTA
TXNN Q3,CD%SDQ ;SETTING SDQ?
JRST CRD3AE ;NO. DON'T CHECK IT
UMOVE B,.CDSDQ(Q2) ;GET USERS VALUE
TLNE B,-1 ;RIGHT HALF ONLY?
ERRJMP (CRDI24,CRDIR7) ;[8856] No. Won't fit in allotted space
LOAD C,DRSDC,(Q1) ;GET NUMBER OF SUBDIRECTORIES EXISTING
CAMLE C,B ;IS NEW VALUE LESS THAN THIS?
ERRJMP (CRDI22,CRDIR7) ;[8856] Can't reduce quota this much
LOAD A,DRSDM,(Q1) ;GET CURRENT SUBDIR QUOTA
SUB A,B ;GET DELTA
MOVEM A,CRDDSQ ;SAVE IT
CRD3AE: CALL USTDIR ;RELEASE DIR
;..
;IF NOT ROOT-DIRECTORY, VERIFY LIST OF GROUPS FOR SUBDIRECTORIES AND
;LIST OF USER GROUPS FOR THIS DIRECTORY
;..
HRRZ A,CRDSUP ;CHECK IF SUPERIOR IS
CAIN A,ROOTDN ;ROOT-DIRECTORY
JRST CRDR3B ;IT IS - DONT DECREMENT ANYTHING
MOVE A,CRDSUP ;GET SUPERIOR DIR
CALL SETDIR ;MAP IT
RETBAD (MONX03) ;ANOTHER IMPOSSIBLE ERROR
TXNE Q3,CD%CUG ;SETTING CREATABLE USER GROUPS?
JRST [ UMOVE A,.CDCUG(Q2) ;GET USER CREATABLE GROUPS LIST
LOAD B,DRCUG,(Q1) ;GET CREATABLE GROUPS LIST
CALL CDCKCU ;VALIDATE LIST
ERRJMP (CRDI16,CRDIR7) ;[8856] Failed
JRST .+1] ;SUCCESS - GO ON
TXNE Q3,CD%UGP ;SETTING USER GROUPS?
JRST [ UMOVE A,.CDUGP(Q2) ;YES - GET USERS LIST
LOAD B,DRCUG,(Q1) ;GET CREATABLE USER GROUPS LIST
CALL CDCKCU ;VALIDATE LIST
ERRJMP (CRDI16,CRDIR7) ;[8856] Failed
JRST .+1]
MOVE A,CRDUFL ;SHOULD THE SUPERIOR BE DECREMENTED?
TXNE A,CD%NSQ ;...
JRST CRD3AA ;NO
;ADJUST SUPERIOR'S QUOTAS FOR LOGGED-IN QUOTA, LOGGED-OUT QUOTA, AND
;MAXIMUM SUBDIRECTORIES
MOVX A,CDNWF ;IF THIS IS A NEW FILE, CHECKS HAVE ALREADY
TDNE A,CRDFLG ; BEEN MADE
JRST CRD3AD
CALL CKLIQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
JRST CRD3AB ;YES. DON'T CHECK
TXNN Q3,CD%LIQ ;LIQ BEING SET?
JRST CRD3AD ;NO, DON'T DO CHECKS
HRRZ A,CRDSUP ;A/ SUPERIOR'S DIRECTORY NUMBER
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
CALL GETCAL
JRST [ LOAD A,DRLIQ,(Q1) ;DIRECTORY VALUES
OPSTR <SUB A,>,DRDCA,(Q1) ; ...
JRST .+1]
ADD A,CRDDIQ ;ADJUST BY CHANGE IN SUBDIR
JUMPGE A,CRD3AD ;[8856] Jump if it is OK
MOVEI A,CRDI13 ;[8856] Can't change superior
JRST CRDIR7 ;[8856] Give error, unlock, return
CRD3AD: LOAD A,DRLIQ,(Q1) ;GET LIQ
ADD A,CRDDIQ ;ADD DELTA
CRD3AB: LOAD B,DRLOQ,(Q1) ;GET LOQ
ADD B,CRDDOQ ;ADD DELTA
CALL CKLOQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
SKIPA ;YES. DON'T CHECK
JUMPL B,[MOVEI A,CRDI14 ;[8856] LOQ exhausted
JRST CRDIR7] ;[8856] Return error and unlock dir
LOAD C,DRSDM,(Q1) ;GET SDQ
ADD C,CRDDSQ ;ADD DELTA
MOVE D,C ;COPY IT
OPSTR <SUB D,>,DRSDC,(Q1) ;SUBTRACT NUMBER OF SUBDIRS EXISTING
JUMPL D,[MOVEI A,CRDI15 ;[8856] SDQ exhausted
JRST CRDIR7] ;[8856] Unlock and return error
CALL CKLIQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
SKIPA ;YES. DON'T ADJUST LOGGED-IN QUOTA
JRST [ STOR A,DRLIQ,(Q1) ;NO. ADJUST LOGGED-IN QUOTA
JRST .+1]
CALL CKLOQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
SKIPA ;YES. DON'T ADJUST LOGGED-OUT QUOTA
JRST [ STOR B,DRLOQ,(Q1) ;NO. ADJUST LOGGED-OUT QUOTA
JRST .+1]
STOR C,DRSDM,(Q1) ; ...
HRRZ A,CRDSUP ;A/ SUPERIOR'S DIRECTORY NUMBER
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
MOVE C,CRDDIQ ;C/ CHANGE IN QUOTA
CALL CKLIQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
SKIPA ;YES. DON'T ADJUST ALLOCATION ENTRY
CALL ADJALC ;ADJUST SUPERIOR'S ALLOCATION ENTRY
CRD3AA: CALL UPDDIR ;UPDATE DISK IMAGE
CALL USTDIR ;NEW VALUES PASS LIMIT CHECKS
;SET USER GROUPS FOR SUBDIRECTORIES AND THIS DIRECTORY'S USER GROUPS
CRDR3B: MOVE A,CRDIRD ;MAP OBJECT DIR AGAIN
HLL A,CRDSUP ; ...
CALL SETDIR ; ...
ERRJMP (MONX03,CRDIR4) ;[8856] Should be impossible
CALL CHKCHG ;SHOULD PARAMETERS BE CHANGED
JRST CRDR3D ;NO
UMOVE A,.CDCUG(Q2) ;GET CREATABLE USER GROUPS
TXNN Q3,CD%CUG ;[7475] SETTING THEM?
IFSKP.
CALL CRDCUP ;YES - COPY TO DIR
JRST CRDIR7 ;[8856] Failed, return
ENDIF.
UMOVE A,.CDUGP(Q2) ;GET USER GROUPS
TXNE Q3,CD%UGP ;WANT TO SET USER GROUPS?
CALL CRDUGP ;YES, GO SET UP USER GROUPS
;Set remote node aliases
MOVE T1,CRDUFL ;is remote node alias list
TXNE T1,CD%RNA ; to be changed ?
CALL CHKCHG ;yes. but SHOULD it be changed ?
IFSKP.
CALL CRDRNA ;yes. do it
JRST CRDIR7 ;[8856] Failed, unlock and return
ENDIF.
;..
;DO ALLOCATION, DEFAULT PROTECTION, DIRECTORY PROTECTION
UMOVE A,.CDLOQ(Q2) ;GET LOGGED OUT QUOTA
TXNE Q3,CD%LOQ ;SET IT?
STOR A,DRLOQ,(Q1) ;YES
UMOVE A,.CDLIQ(Q2) ;GET LOGGED IN QUOTA
TXNE Q3,CD%LIQ ;SET LOGGED IN QUOTA?
STOR A,DRLIQ,(Q1) ;YES
HRRZ A,CRDIRD ;A/ DIRECTORY NUMBER
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
MOVN C,CRDDIQ ;C/ AMOUNT TO ADD TO QUOTA
CAIE A,ROOTDN ;IS THIS "ROOT-DIRECTORY"?
CALL ADJALC ;NO, ADJUST ALLOCATION ENTRY FOR THIS DIRECTORY
UMOVE A,.CDSDQ(Q2) ;GET SUBDIR QUOTA
TXNE Q3,CD%SDQ ;SETTING IT?
STOR A,DRSDM,(Q1) ;YES.
UMOVE A,.CDFPT(Q2) ;Default file protection
ANDI A,777777
TLO A,500000
TXNE Q3,CD%FPT ;SET FILE PROTECTION?
STOR A,DRDPW,(Q1) ;YES
UMOVE A,.CDDPT(Q2) ;GET DIRECTORY PROTECTION
ANDI A,777777
TLO A,500000
TXNE Q3,CD%DPT ;SET IT?
STOR A,DRPRT,(Q1) ;YES
; Online & offline expiration defaults
MOVE B,CRDUFL ; Get flags
UMOVE A,.CDDNE(Q2) ; Get user's online exp choice
TXNE B,CD%NED ; Want to change that?
STOR A,DRDNE,(Q1) ; Yes, set it
TXNN B,CD%FED ; Want to do offline?
JRST CRD3BB ; No, skip over that
UMOVE A,.CDDFE(Q2) ; Get what user wants
MOVE B,CAPENB
SKIPE TPRCYC ;If user is wheel or no system limit set,
TXNE B,SC%WHL ;don't check range.
IFSKP.
TLNN A,-1 ; Is it an interval?
IFSKP.
CALL LGTAD ;NO, A DATE. GET NOW
HLRZ D,A ;COMPUTE MAX ALLOWED END DAY
ADD D,TPRCYC
UMOVE A,.CDDFE(Q2)
HLRZ B,A ;GET USER SPECIFIED END DAY
CAMLE B,D ;LEGAL?
ERRJMP (ARGX27,CRDIR7) ;[8856] Out of reasonable range
ELSE.
CAMLE A,TPRCYC ; Within range?
ERRJMP (ARGX27,CRDIR7) ;[8856] No
ENDIF.
ENDIF.
STOR A,DRDFE,(Q1) ;Store user value
;SET PPN
CRD3BB: UMOVE A,.CDPPN(Q2) ;GET PROJECT-PROGRAMMER NUMBER
TXNN Q3,CD%PPN ;WANT TO SET IT?
JRST CRD3BD ;NO
SETZ B, ;YES - GET A ZERO FOR CLEARING
JUMPE A,CRD3BC ;APPROVE PPN IF IT'S ZERO
HLRZS A ;ELSE ISOLATE PROJECT NUMBER
TRNN A,400000 ;SIGN BIT ON IS AN ILLEGAL TOPS-10 PROJECT NUMBER
CAIN A,PPNLH ;PREVENT CONFUSION BY NOT ALLOWING OLD STYLE
ERRJMP (PPNX1,CRDIR7) ;[8856] Illegal project number
UMOVE A,.CDPPN(Q2) ;GET PPN BACK AGAIN
TRNN A,-1 ;PROGRAMMER NUMBER OF ZERO IS ILLEGAL
ERRJMP (PPNX1,CRDIR7) ;[8856] So flunk that out
;HERE TO CHECK PPN FOR UNIQUENESS
LOAD C,DRPPN,(Q1) ;GET CURRENT PPN FOR THIS DIRECTORY
CAMN A,C ;SAME AS SPECIFIED PPN?
JRST CRD3BD ;YES, SO SKIP FURTHER PPN PROCESSING
CALL FNDPPN ;MUST NOT MATCH AN EXISTING PPN
CAIA ;NO FOUND SO OK
ERRJMP (PPNX1,CRDIR7) ;[8856] So flunk that out
CRD3BC: UMOVE B,.CDPPN(Q2) ;GET BACK PPN NUMBER
STOR B,DRPPN,(Q1) ;STORE IT IN THE DIRECTORY
HRRZ A,CRDIRD ;GET DIRECTORY NUMBER
CALL SETPPN ;ALSO, STORE IT IN IDXTAB EXTENSION
CRD3BD:
;DO RETENTION SPEC, DIRECTORY GROUPS
UMOVE A,.CDRET(Q2) ;GET # OF GENERATIONS TO KEEP
ANDI A,777777
TLO A,500000
TXNE Q3,CD%RET ;SET IT?
STOR A,DRDBK,(Q1) ;YES
UMOVE A,.CDDGP(Q2) ;GET DIRECTORY GROUPS
TXNE Q3,CD%DGP ;SET DIR GROUPS?
CALL CRDDGP ;YES, GO SET UP DIR GROUP LIST
CRDR3D: CALL UPDDIR ;FIX DIR ON DISK
CALL USTDIR ;[8856] (/) Unlock directory, go OKINT
;If creation of a top level directory, we need to call CPYBAK.
SKIPN CRDCPY ;WANT TO CALL CPYBAK?
JRST CRDR3C ;NO
HRRZ A,CRDSTX ;GET STRUCTURE NUMBER
CALL CPYBAK ;MAKE A COPY OF THE ROOT-DIRECTORY
JRST [ MOVEI B,ROOTDN ;FAILED, SEE IF WE ARE CREATING ROOT-DIR
CAME B,CRDIRD ;BACKUP FILE NOT CREATED YET IF ROOT
BUG.(CHK,CRDBAK,JSYSF,HARD,<CRDIR3 - Could not make backup copy of ROOT-DIRECTORY>,,<
Cause: CPYBAK failed to create a backup copy of the root directory during
a CRDIR% call. CPYBAK is called to re-create the backup copy of the
root directory if the root directory is the superior of the
directory being manipulated with CRDIR%.
Action: The backup copy of the root directory is now corrupted. It must be
fixed by hand.
>,,<DB%NND>) ;[7.1210]
JRST .+1]
;..
;MAKE THE MESSAGE FILE IF DIRECTORY IS NOT FILES-ONLY
;..
CRDR3C: MOVX T1,CDNWF ;IF THIS IS A NEW DIRECTORY
TDNN T1,CRDFLG ; THEN CONTINUE
JRST CRDIR5 ;NOT CREATING DIRECTORY - LEAVE ALONE
HLL B,CRDSUP ;GET STR UNIQUE CODE
HRR B,CRDIRD ;GET THE DIRECTORY NUMBER
HRROI A,CRDIRS ;RESTORE POINTER
DIRST
JRST [ CALL CRBUG1 ;REPORT TROUBLE
JRST CRDIR5] ;CLEAN UP AND ABORT
MOVEM A,CRDIRT ;SAVE CURRENT POINTER
SETZ A,
HRROI B,CRDIRS ;FORM POINTER TO START OF DIRECTORY SPEC
RCDIR ;GET DIRECTORY FLAGS
TXNE A,RC%DIR ;FILES ONLY DIRECTORY?
JRST CRDIR5 ;YES, DON'T MAKE MESSAGE FILE
MOVE A,CRDIRT ;GET POINTER TO LAST CHAR
HRROI B,[ASCIZ /MAIL.TXT;P770404/]
SETZ C,
SOUT
CALL CRDSWH ;SET WHEEL
HRROI B,CRDIRS ;GET START OF NAME STRING
MOVE A,[GJ%FOU!GJ%PHY!GJ%SHT+1] ;VERSION 1
GTJFN
JRST [ CALL CRBUG1 ;REPORT TROUBLE
JRST CRDR8A] ;CLEAN UP AND ABORT
MOVE D,A ;SAVE JFN
MOVE B,[070000,,OF%RD+OF%WR+OF%PDT]
OPENF ;MAKE THE FILE EXIST
MOVE A,D ;IGNOR ERROR
MOVE B,[1,,.FBCTL] ;GET THE CONTROL BITS
MOVEI C,C
GTFDB
TXNN C,FB%NXF ;SEE IF THE FILE EXISTED BEFORE
JRST CRDIR8 ;YES, DONT CHANGE ITS STATE
HRLI A,.FBCTL
MOVX B,FB%PRM+FB%DEL
MOVX C,FB%PRM+FB%DEL ;MAKE IT PERMANENT AND DELETED
CHFDB
CRDIR8: HRRZS A
CLOSF ;RELEASE THE JFN
JFCL
CRDR8A: CALL CRDCWH ;CLEAR WHEEL
;..
;HERE ON SUCCESSFUL COMPLETION. RETURN DIRECTORY NUMBER TO USER
;..
CRDIR5:
HLL A,CRDSUP ;GET STR UNIQUE CODE
HRR A,CRDIRD ;FORM 36-BIT DIRECTORY DESIGNATOR
UMOVEM A,1 ;RETURN IT IN USER AC 1
RETSKP ;GIVE SUCCESSFUL RETURN
;[7.1231]
;CHPLEN - Routine to check and see if a minimum password length
;is required. If so, then the supplied password must be long enough.
;
; Called with:
; password string in JSB free space
; CALL CHPLEN
;
; Returns:
; +1 - Password not long enough
; +2 - Password long enough or no minimum length required
;
;Preserves things
CHPLEN: SAVET ;Don't mangle
SKIPN MINPAS ;Do we want a minimum password length?
RETSKP ;No, so this is done
;Note - Because this is a lookup pointer, the string actually starts
;at the (CRDIRN)+1 and not (CRDIRN)+0
MOVE T1,CRDIRN ;Get pointer to password string block
AOS T1 ;Go past length word
HRLI T1,(POINT 7,) ;Make a nice byte pointer
SETZ T4, ;This is our counter
DO. ;Now count the number of characters
ILDB T2,T1 ;Get a character
JUMPE T2,ENDLP. ;If it is a null, then we are done
AOJA T4,TOP. ;Bump the count and get next character
OD. ;No more characters, count is in T4
CAMGE T4,MINPAS ;Is it big enough?
RET ;No, return failure
RETSKP ;Yes it is, this is a good one to use
;Error Routines
; Enter at CRDIR4 (directory not mapped)
;[8856] Enter at CRDIR7 (directory mapped by SETDIR)
; with A/ error code to return to user
CRDIR7: CALL USTDIR ;[8856] (/) Unlock directory, go OKINT
CRDIR4: MOVEM A,CRDIRE ;SAVE ERROR CODE
CALL CRDIR6 ;RELEASE JSB SPACE
HRRZ A,CRDIRJ ;GET JFN OF DIR FILE
JUMPE A,CRDR02 ;[8856] No JFN there, check if new dir failure
MOVX B,CDNWF ;IS THIS A NEW FILE?
TDNN B,CRDFLG ;??
JRST CRDR01 ;NO. DON'T EXPUNGE IT OR CLEAR IDXTAB
HRLI A,(DF%EXP) ;EXPUNGE THE FILE
DELF
JFCL ;IGNORE ERRORS
SKIPG A,CRDIRD ;GET DIR NUMBER
CALL DELIDX ;GET RID OF INDEX TABLE ENTRY
CRDR01: HRRZ A,CRDIRJ ;GET BACK THE JFN
RLJFN ;RELEASE THE JFN
JFCL
CRDR00: MOVE A,CRDIRE ;GET BACK ERROR CODE
RETBAD () ;AND EXIT
CRDR02: MOVX B,CDNWF ;[8856] Load new directory bit
TDNN B,CRDFLG ;[8856] Is this a new directory build failure?
JRST CRDR00 ;[8856] Nope, just return now
MOVEI A,CRDGJB ;[8856] Have to delete directory
HRROI B,CRDIRS ;[8856] Get pointer to "NAME.DIRECTORY" string
GTJFN ;[8856] Get JFN on the new directory
ERJMP CRDR00 ;[8856] If an error here I give up
HRRZM A,CRDIRJ ;[8856] Save JFN for DELDIR code
MOVE A,CRDIRE ;[8856] Load error code that we bombed on
HRRM A,CRDFLG ;[8856] Save it in place not known to DELDIR
CALL DELDIR ;[8856] Delete this directory
JFCL ;[8856] Error? Well I tried anyway
HRRZ A,CRDFLG ;[8856] Reload the error
RETBAD () ;[8856] Pass error back up
;Small routine to releaser any JSB free space we are currently using.
;Returns +1 always.
CRDIR6: MOVEI A,JSBFRE ;RELEASE NAME STRING SPACE
HRRZ B,CRDIRN ;B/ ADDRESS OF JSB FREE SPACE
JUMPE B,R ;DON'T RELEASE IF THERE ISN'T ANY
CALL RELFRE ;RELEASE THE BLOCK FOR LOCAL VARIABLES
SETZM CRDIRN ;INDICATE THERE IS NO SPACE ASSIGNED NOW
RET
;ROUTINE TO CHECK IF EXISTING PARAMETERS SHOULD BE CHANGED
; CALL CHKCHG
;RETURNS +1: PARAMETERS SHOULD NOT BE CHANGED
; +2: CHANGES ARE DESIRED
CHKCHG: MOVE B,CRDUFL ;GET THE USER FLAGS
MOVE A,CRDFLG ;GET LOCAL FLAGS
TXNN B,CD%NCE ;NO CHANGES IF EXIST BIT ON?
RETSKP ;NO, DO THE CHANGES ALWAYS
TXNE A,CDNWF ;YES, IS THIS A NEW DIRECTORY?
TXNE A,CDREC ;YES, IS THIS A RECONSTRUCTION?
RET ;DO NOT DO THE CHANGES
RETSKP ;NEW AND NO RECONSTRUCT, DO THE CHANGES
;ROUTINE TO CHECK IF RECONSTRUCTION IS NEEDED
; CALL CHKREC
;RETURNS +1: NO RECONSTRUCTION
; +2: RECONSTRUCTION TO BE DONE
; A/ DISK ADR OF INDEX BLOCK OF DIRECTORY FILE
CHKREC: SAVEQ ;SAVE PERMANENT ACS
MOVE A,CRDIRD ;GET DIR NUMBER
CALL GETIDX ;SEE IF THE NUMBER WAS IN USE
RET ;NO
TXNE D,IDX%IV ;IS THIS ENTRY INVALID?
JRST CHKRC2 ;YES, GO DELETE IT
MOVE Q3,B ;SAVE THE ADR OF THE INDEX BLOCK
MOVE A,CRDIRD ;GET THE DIR NUMBER AGAIN
HRRZ B,CRDSTX ;GET STRUCTURE NUMBER
MOVE B,STRTAB(B) ;GET UNIQUE CODE
LOAD B,STRUC,(B) ;...
HRL A,B ;BUILD A 36-BIT DIR NUMBER
CALL SETDIR ;MAP IN THAT DIRECTORY
JRST CHKRC2 ;DIR IS BAD, GO DELETE IT
CALL CHKNAM ;SEE IF THE NAME STRINGS MATCH
JRST CHKRC1 ;NO, NO RECONSTRUCTION
CALL USTDIR ;THE NAMES MATCH, DO RECONSTRUCTION
MOVE A,Q3 ;RETURN ADR OF INDEX BLOCK
RETSKP ;GO AND DO RECONSTRUCTION
CHKRC1: CALL USTDIR ;GO UNLOCK THE DIR
CHKRC2: MOVE A,CRDIRD ;GET DIR NUMBER
CALL DELIDX ;DELETE THE ENTRY FROM THE IDXTAB
RET ;AND GO CREATE THE DIR WITHOUT RECONSTRUCTION
;ROUTINE TO COMPARE THE NAME STRING IN A DIRECTORY WITH THE NAME
; STRING GIVEN BY THE USER
;ASSUMES THE CORRECT DIRECTORY IS MAPPED, AND THAT THE NAME STRING
; IS SET UP IN CRDDNM
;RETURNS +1: NAMES DO NOT MATCH
; +2: NAMES MATCH
CHKNAM: SAVEQ
MOVE Q1,DIRORA ;GET START OF DIR AREA
LOAD Q1,DRNAM,(Q1) ;GET POINTER TO THE DIRECTORY NAME
ADD Q1,DIRORA ;GET ABS ADR OF DIR NAME
MOVSI Q2,(POINT 7,(Q1),35)
MOVE C,[POINT 7,CRDDNM] ;GET POINTER TO THIS DIR NAME
CHKNA0: ILDB A,Q2 ;GET NEXT CHAR FROM DIRECTORY
ILDB B,C ;GET NEXT CHAR FROM CRDIR DATA BASE
CAME A,B ;MATCH?
RET ;NO
JUMPN A,CHKNA0 ;YES, CHECK THROUGH THE NULL
RETSKP ;NAMES MATCH
;ROUTINES TO SET UP A LIST OF GROUPS IN THE DIRECTORY
;ACCEPTS IN A/ 36 BIT GROUP DESIGNATOR
; CALL CRDUGP OR CALL CRDDGP
;RETURNS +1: ALWAYS
CRDUGP: PUSH P,A ;SAVE NEW VALUE
LOAD B,DRUGP,(Q1) ;GET OLD SETTING
SKIPE B
CALL RELDFR ;RELEASE DIR SPACE OF OLD GROUP LIST
POP P,A ;GET BACK NEW SETTING
CALL CRGDGB ;GET DIR GROUP BLOCK SET UP
MOVEI A,0 ;FAILED, DONT SET ANY GROUPS
STOR A,DRUGP,(Q1) ;STORE USER GROUPS
RET ;AND RETURN
CRDDGP: PUSH P,A ;SAVE NEW SETTING
LOAD B,DRDGP,(Q1) ;GET POINTER TO OLD LIST
SKIPE B ;IF THERE IS ONE
CALL RELDFR ;THEN RELEASE THE SPACE
POP P,A ;GET BACK NEW VALUE
CALL CRGDGB ;GET A NEW DIR GROUP BLOCK
MOVEI A,0 ;FAILED, DONT SET ANY
STOR A,DRDGP,(Q1) ;STOR POINTER INTO DIR
RET ;AND RETURN
;ROUTINE TO SETUP THE CREATABLE USER GROUPS LIST
;A/ USER ADDRESS OF NEW GROUP LIST
; CALL CRDCUP
;RETURNS: +1 NEW GROUP LIST SETUP
; +2 FAILS, GIVING ERROR MESSAGE
CRDCUP: STKVAR <NEWLST>
MOVEM T1,NEWLST ;[7461] Save pointer to new list
LOAD T2,DRCUG,(Q1) ;[7461] Get pointer to old list
SKIPN T2 ;[7461] Was there any?
JRST SETGPS ;[7461] No, just go set groups
LOAD T3,DRSDC,(Q1) ;[7461] Yes, see if any subdirs to check
SKIPN T3 ;[7461] Any?
JRST SETGPS ;[7461] No, just go set groups
MOVE T1,CRDIRD ;[7461] Get directory number
MOVE T2,NEWLST ;[7461] Get back pointer to new list
CALL CHKSUB ;[7461] (T1,T2/)Check subdirs
RETBAD ( ) ;[7461] Failure return
LOAD T2,DRCUG,(Q1) ;[7461] Passed checks - point to old list
CALL RELDFR ;[7461] (T2/)And release old space in dir
SETGPS: MOVE T1, NEWLST ;[7461] Get pointer to new list
CALL CRGDGB ;[7461] (T1/)And set the new list
MOVEI A,0 ;[7461] Failed, set up nil
STOR A,DRCUG,(Q1) ;[7461] ...
RETSKP ;[7461] Success return
ENDSV.
;Subroutine to check user's proposed list of USER-GROUPS-TO-ALLOW for
;subdirectories against the currently existing USER GROUP lists in the directory's
;inferiors. If the existing list is a subset of the proposed list, then it is
;all right to set the new list in the directory. If the existing list is NOT a
;subset of the proposed list, then the user is attempting to remove a group
;from the current list, and the inferior directories must be checked to make
;sure that the group in question does not already exist in a subdirectory. The
;first such ocurrence will cause failure return.
;
; CALL CHKSUB
; T1/ 36-bit directory number
; T2/ Pointer to proposed new list in user space
;
; Return +1: Failure, error code in T1
;
; Return +2: Success, superior directory (the one we are creating) mapped
;
;
CHKSUB: STKVAR <DIRNUM,NLIST>
MOVEM T1,DIRNUM ;[7461] Save directory number
MOVEM T2,NLIST ;[7461] Save pointer to user's list
CALL WLDCRD ;[7461] () Asteriskize (whew!) the dir name
CALL USTDIR ;[7461] (T1/) Unmap this dir
MOVE T2,[POINT 7,UGDRNM] ;[7461] Get pointer to complete dir name
CHKLUP: MOVX T1,<RC%STP!RC%AWL> ;[7461] Step the dirs, allow wildcards
HRR T3,DIRNUM ;[7461] Get the number of this dir
HLL T3, CRDSUP ;[7461] Make it a 36-bit dir number
RCDIR% ;[7461]
ERJMP R
TXNE T1,RC%NMD ;[7461] No more directories?
IFNSK.
CALL MAPSUP ;[7461] () Guess not - Remap superior
RETSKP ;[7461] Success return
ENDIF.
MOVEM T3,DIRNUM ;[7461] Save the dir number returned
MOVE T1,T3 ;[7461] Get dir number in AC1 for SETDIR
CALL SETDIR ;[7461] (T1/) Map the next directory
RETBAD () ;[7461] Pass the error along
MOVE T3,DIRORA ;[7461] Point to top of directory
LOAD T1,DRUGP,(T3) ;[7461] Get current list
MOVE T2,NLIST ;[7461] Get list we are requesting
CALL CUCKCD ;[7461] (T1,T2/) Validate list
IFSKP.
CALL USTDIR ;[7461] (T1/) Unmap
MOVE T2, [POINT 7,UGDRNM] ;[7461] Get pointer back
JRST CHKLUP ;[7461] Ok so far, move along the chain
ENDIF.
CALL USTDIR ;[7461](T1/) Unmap
RETBAD(CRDI29) ;[7461] Error return
ENDSV.
;Add an asterisk to the directory name so RCDIR will step through the
;subdirectories for us
;
; CALL WLDCRD
; USES T3,T4
;
WLDCRD: MOVE T3,[POINT 7,UGDRNM] ;[7461] Point to name
CRDLUP: ILDB T4,T3 ;[7461] Get a character
CAIE T4, ">" ;[7461] Closing bracket?
JRST CRDLUP ;[7461] No, keep looking
SETO T4, ;[7461] Found it
ADJBP T4,T3 ;[7461] Back up
MOVEI T3,"." ;[7461] Add a dot - we're looking for subdirectories
IDPB T3,T4 ;[7461]
MOVEI T3,"*" ;[7461] Now an asterisk
IDPB T3,T4 ;[7461]
MOVEI T3,">" ;[7461] And add
IDPB T3,T4 ;[7461] A closing bracket
MOVEI T3,0 ;[7461]
IDPB T3,T4 ;[7461] Finish off with a null
RET
;Here to re-map the superior again and leave things the way we found 'em
;
MAPSUP: HLL A,CRDSUP ;[7461] Get unique code
HRR A,CRDIRD ;[7461] Form 36-bit number
CALL SETDIR ;[7461] (T1/) Map directory
JRST CRDIR4 ;[7461] Failed
RET
;Routine to check a list in a directory against a list in user address space
;
;A/ RELATIVE DIRECTORY ADDRESS OF GROUP BLOCK
;B/ USER ADDRESS OF LIST
; CALL CUCKCD
;RETURNS+1:
; DIR LIST IS NOT A SUBSET OF USER LIST
;RETURNS+2:
; DIR LIST IS A SUBSET OF USER LIST
CUCKCD: JUMPE T1,RSKP ;[7461] No list in dir header - OK, success
JUMPE T2,R ;[7461] No user list - bad news
TRVAR <CDCKUP,CDCKUC,CDCKDP,CDCKDC> ;user ptr, user count, dir ptr
;[7461] dir count
MOVEM T1,CDCKDP ;[7461] Save dir pointer
MOVEM T2,CDCKUP ;[7461] Save user pointer
ADD T1,DIRORA ;[7461]
LOAD T4,BLKLEN,(A) ;[7461] Get block length
MOVEM T4,CDCKDC ;[7461] Save dir count
UMOVE T2,(T2) ;[7461] Get count from user's list
MOVEM T2,CDCKUC ;[7461] Save count
JUMPLE T2,R ;[7461] Check for garbage count
SOJE T2,R ;[7461] If null user list, error
SUB T1,DIRORA ;[7461] Get absolute address
HRLI T1,(POINT 18,.-.(Q1),35) ;[7461] and point to groups
CUCKD1: SOSG CDCKDC ;[7461] Decrement dir count
RETSKP ;[7461] End of list - success
ILDB T2,T1 ;[7461] Get first group
CALL CUCKD2 ;[7461] (/T2)
RET ;[7461] Failure
ILDB T2,T1 ;[7461] Next
JUMPE T2,RSKP ;[7461] Done - success
CALL CUCKD2 ;(/T2)
RET
JRST CUCKD1 ;[7461] keep going
;Here with element from user's list in AC2
CUCKD2: MOVE T3,CDCKUP ;[7461] Get pointer to user list
MOVE T4,CDCKUC ;[7461] Get list size
CUCKD3: SOJLE T4,R ;[7461] Group not found in user list - fail
AOS T3 ;[7461] Next element from dir
XCTU [CAMN T2,(T3)] ;[7461] Match?
RETSKP ;[7461] Yes, success
JRST CUCKD3 ;[7461] Keep looking
ENDTV.
;ROUTINE TO CHECK A LIST IN USER ADDRESS SPACE AGAINS A LIST IN
;A DIRECTORY
;A/ USER ADDRESS OF LIST
;B/ RELATIVE DIRECTORY ADDRESS OF GROUP BLOCK
; CALL CDCKCU
;RETURNS+1:
; USER LIST IS NOT A SUBSET OF DIR LIST
;RETURNS+2:
; USER LIST IS A SUBSET OF DIR LIST
CDCKCU: STKVAR <CDCKPT,CDCKCT,CDCKDP> ;KIUSER PTR, USER COUNT, DIR PTR
MOVEM A,CDCKPT ;SAVE USER POINTER
MOVEM B,CDCKDP ;SAVE DIR POINTER
UMOVE A,(A) ;GET COUNT FROM USERS LIST
MOVEM A,CDCKCT ;SAVE COUNT
JUMPLE A,R ;CHECK FOR GARBAGE COUNT
SOJE A,RSKP ;IF NULL LIST, ALL DONE
JUMPE B,R ;IF NON-NULL USER LIST AND NO DIR LIST, NO MATCH
CDCKU1: SOSG CDCKCT ;DECREMENT USER COUNT
RETSKP ;END OF LIST - SUCCESS
AOS A,CDCKPT ;STEP USER POINTER
MOVE C,CDCKDP ;GET DIR POINTER
ADD C,DIRORA ;AS ABSOLUTE ADDRESS
LOAD D,BLKLEN,(C) ;GET BLOCK LENGTH
SUB C,DIRORA ;AS RELATIVE ADDRESS
HRLI C,(<POINT 18,.-.(Q1),35>) ;BUILD BYTE POINTER
CDCKU2: SOJLE D,R ;EXHAUSTED DIR LIST - FAILURE
ILDB B,C ;GET NEXT GROUP FROM DIR
XCTU [CAMN B,(A)] ;COMPARE WITH USER LIST ELEMENT
JRST CDCKU1 ;EQUAL - GET NEXT USER ELEMENT
ILDB B,C ;GET NEXT GROUP FROM DIR
XCTU [CAMN B,(A)] ;COMPARE WITH USER ELEMENT
JRST CDCKU1 ;EQUAL - GET NEXT USER ELEMENT
JRST CDCKU2 ;NOT EQUAL - KEEP LOOKING
;ROUTINE TO GET SPACE IN DIR FOR GROUP LIST AND TO BUILD THE LIST
;ACCEPTS IN A/ ADDRESS OF LIST OF GROUP NUMBERS IN USER SPACE
; CALL CRGDGB
;RETURNS +1: FAILED
; +2: RELATIVE ADR OF LIST IN AC A
CRGDGB: STKVAR <CRGDGA,CRGDGC>
TLNE A,-1 ;GUARD AGAINST OLD FORMAT OF GROUPS
JRST [ BUG.(CHK,CRDOLD,JSYSF,HARD,<CRGDGB - Old format CRDIR is illegal>,,<
Cause: The old format of specifying user groups to CRDIR% has been
attempted. This format is no longer supported.
Action: Change the application to use the format specified in the current
Monitor Calls Reference Manual.
>)
RET] ;GIVE FAILURE RETURN
MOVEM A,CRGDGA ;SAVE ADDRESS OF LIST IN USER SPACE
JUMPE A,RSKP ;IF NO LIST, RETURN WITH A=0
XCTU [HRRZ B,0(A)] ;GET LENGTH OF LIST
SETZ A, ;SET UP FOR NULL LIST
CAIG B,1 ;LIST MUST HAVE MORE THAN HEADER
RETSKP ;NULL LIST, RETURN WITH 0 IN A
MOVEM B,CRGDGC ;SAVE LENGTH OF LIST
ADDI B,2 ;LEAVE ROOM FOR HEADER
LSH B,-1 ;WORDS ARE PACKED WHEN STORED IN DIR
CALL ASGDFR ;GET SPACE FOR LIST
RETBAD (CRDIX4) ;FAILED TO GET SPACE
MOVEI B,.TYGDB ;SET UP BLOCK TYPE
STOR B,BLKTYP,(A) ;...
MOVE B,CRGDGA ;GET POINTER TO USER LIST
MOVEM A,CRGDGA ;SAVE ADR OF LIST IN DIR
SOS C,CRGDGC ;GET COUNT OF ELEMENTS IN LIST
CRGDG1: UMOVE D,1(B) ;GET NEXT GROUP NUMBER FROM USER SPACE
HRLZM D,1(A) ;STORE IN DIR LIST
AOS B ;STEP TO NEXT ELEMENT IN USER LIST
SOJLE C,CRGDG2 ;COUNT DOWN NUMBER OF GROUPS
UMOVE D,1(B) ;GET NEXT GROUP FROM USER LIST
HRRM D,1(A) ;STORE IT IN DIRECTORY
AOS A ;STEP TO NEXT WORD IN DIR
AOS B ;AND STEP USER LIST
SOJG C,CRGDG1 ;LOOP BACK FOR ALL GROUPS
CRGDG2: MOVE A,CRGDGA ;GET ABS ADR OF LIST
SUB A,DIRORA ;GET RELATIVE ADR
RETSKP ;AND GIVE OK RETURN
;ROUTINE TO FIX UP ROOT DIR WHEN IT IS BEING CREATED DURING FILINI
;ACCEPTS IN A/ ADR OF FDB
; B/ STRUCTURE NUMBER
; CALL RDFIX
;RETURNS +1: ALWAYS
RDFIX: MOVE B,STRTAB(B) ;GET ADDRESS OF SDB FOR THIS STRUCTURE
LOAD B,STRRXB,(B) ;GET ADDRESS OF INDEX BLOCK FOR ROOT-DIRECTORY
STOR B,FBADR,(A) ;MAKE FILE EXIST
SETZRO FBNXF,(A) ;FILE NOW EXISTS
SETONE FB%SDR,.FBCTL(A) ;SUBDIRS PRESENT
MOVEI B,377777 ;INITIALIZE SUBDIR LIMIT TO INF
STOR B,DRSDM,(Q1) ; ...
RET ;AND RETURN
;ROUTINE TO SET UP THE INDEX TABLE OF NEW DIRECTORIES
;ACCEPTS IN A/ ADR OF INDEX BLOCK IF ANY (0 IF NONE)
; CALL CRDIDX
;RETURNS +1: ERROR
; +2: SUCCESSFUL - INDEX TABLE SET UP
CRDIDX: STKVAR <CRDIDA>
MOVEM A,CRDIDA ;SAVE DISK ADDRESS OF INDEX BLOCK
HRRZ JFN,CRDIRJ ;GET JFN OF DIR FILE
IMULI JFN,MLJFN ;GET INDEX INTO JFN TABLES
MOVE STS,FILSTS(JFN) ;SET UP FOR CALL TO GETFDB
HRRI DEV,DSKDTB
HRL DEV,CRDSTX ;GET STRUCTURE NUMBER
CALL GETFDB ;GET THE FDB MAPPED IN
RETBAD ;FAILED
MOVEM A,CRDTMP ;SAVE ADDRESS OF FDB
SETONE <FBNOD,FBDIR>,(A) ;MARK THAT THIS IS A DIR FILE
MOVE C,CRDIRD ;GET DIRECTORY NUMBER
STOR C,FBDRN,(A) ;STORE DIR # IN FDB OF DIR FILE
MOVEM A,CRDIRT ;SAVE FDB ADDRESS
LOAD B,STR,(JFN) ;GET STRUCTURE NUMBER
CAIN C,ROOTDN ;IS THIS THE ROOT DIR BEING CREATED?
CALL RDFIX ;YES, SET UP SPECIAL INFO
LOAD D,DRNUM,(Q1) ;GET DIR NUMBER OF SUPERIOR
MOVE B,CRDIRT ;GET ADR OF FDB
SUB B,DIRORA ;MAKE IT RELATIVE ADDRESS
MOVE A,CRDIRT ;GET ADR OF FDB AGAIN
SKIPN C,CRDIDA ;IF AN ADDRESS WAS SPECIFIED, USE IT
LOAD C,FBADR,(A) ;GET ADDRESS OF INDEX BLOCK OF FILE
LOAD A,FBDRN,(A) ;GET DIR NUMBER
CALL SETIDX ;SET UP THE INDEX TABLE
JRST CRDIDE ;FAILED
SKIPN B,CRDIDA ;IS THERE A DISK ADDRESS?
JRST CRDID1 ;NO
MOVE A,CRDTMP ;YES, DOING RECONSTRUCTION
STOR B,FBADR,(A) ;STORE THIS ADDRESS IN THE FDB
SETZRO FBNXF,(A) ;AND MAKE THIS FILE EXISTENT
CRDID1: ULKDIR ;UNLOCK THE DIR
MOVE A,CRDIRT ;GET BACK FDB ADDRESS
RETSKP ;AND RETURN
CRDIDE: MOVE B,CRDTMP ;GET ADDRESS OF FDB
SETZRO FBDIR,(B) ;UNDO WHAT CRDIDX HAS ALREADY DONE
SETZRO FBDRN,(B)
ULKDIR ;NOW UNLOCK THE DIR
RETBAD ()
;COMMON FAILURE CASE FOR ABOVE
CRBUG1: BUG.(CHK,CRDNOM,JSYSF,HARD,<CRDIR - Failed to make MAIL.TXT file>,,<
Cause: While creating a new directory that is not FILES-ONLY, CRDIR% could
not create the MAIL.TXT.1 file.
>)
RET
;change the remote alias list
;CALL CRDRNA
;Q1/ address of mapped directory
;Q2/ user address of CRDIR argument block
;directory mapped & locked.
;returns +1 on failure, with directory unlocked.
;returns +2 on success, with directory locked.
;uses T1-T4
;NOTE: when inserting a remote alias, the list in the directory is searched for
; occurrences of remote aliases with that node name. Any such occurences
; are deleted from the directory list.
CRDRNA: TRVAR <UBLOCK,MBLOCK,JSBTMP,UFLAGS>
SAVEAC <Q3>
; UBLOCK - previous context address of remote alias block
; MBLOCK - address of remote alias block being created
; JSBTMP - address of temporary storage in JSB
; UFLAGS - flags supplied by the user
;these TRVARs are used in CRDDUP, CRDCOP, CRDJSB
UMOVE T2,.CDDRN(Q2) ;Get address of first alias block
CAIN T2,0 ;null list ?
RETSKP ;yes. done.
MOVEM T2,UBLOCK ;save address
;loop detect on user arguments
MOVEI T1,CRDMAX ;maximum # of aliases allowed
DO.
UMOVE T2,.CDNXT(T2) ;get next block
JUMPE T2,ENDLP. ;end of list, good.
SOJGE T1,TOP. ;not end of list, continue
RETBAD (CRDI25,<ULKDIR>) ;failed.
ENDDO.
DO. ;for each block ...
MOVE T1,UBLOCK ;get &
UMOVE T2,.CDSIZ(T1) ; save
HLLZM T2,UFLAGS ; flags
TXNN T2,<CD%NEW+CD%KIL> ;creating a new or deleting an old ?
IFSKP.
TXNN T2,CD%NEW ;yes. creating a new ?
IFSKP.
MOVEI T2,RN.SIZ ;yes. allocate an
CALL ASGDFR ;(T2/T1) alias block for directory [absolute]
RETBAD (NSPX01) ;Failed
MOVEM T1,MBLOCK ;save addr of new block
ELSE.
SETZM MBLOCK ;no. deleting, so no new block.
ENDIF.
MOVE T1,UBLOCK ;get user's
UMOVE T1,.CDNOD(T1) ; node name byte pointer
CALL CRDDUP ;(T1) delete duplicates.
RETBAD () ;failed
SKIPN MBLOCK ;is there a new block to be copied ?
IFSKP.
CALL CRDCOP ;() yes, copy it into directory.
RETBAD () ;failed.
MOVE T2,MBLOCK ;get addr of new block [absolute]
LOAD T1,DRRNA,(Q1) ;get addr of current list
STOR T1,RNNXT,(T2) ;insert new block into current list
SUB T2,DIRORA ;make address relative.
STOR T2,DRRNA,(Q1) ;the new "current list"
ENDIF.
ELSE.
UMOVE T1,.CDNOD(T1) ;no. altering existing entry. find alias
CALL CRDFND ;(T1/T1,T2) block in directory with that node
RETBAD () ;allocation failure
SKIPN T2 ;does it exist ?
IFSKP.
MOVE Q3,T2 ;it exists. save addr of alias block [absolute]
MOVE T1,UFLAGS ;new
TXNN T1,CD%PAS ; password ?
IFSKP.
XMOVEI T1,RN.PAS(Q3) ;yes. address of directory password entry.
MOVE T2,UBLOCK ; byte pointer to
UMOVE T2,.CDPAS(T2) ; user password entry
CALL CRDCHG ;(T1,T2) do the work.
RETBAD () ;failed
ENDIF.
MOVE T1,UFLAGS ;new
TXNN T1,CD%ACC ; password ?
IFSKP.
XMOVEI T1,RN.ACC(Q3) ;yes. address of directory account entry.
MOVE T2,UBLOCK ; byte pointer to
UMOVE T2,.CDACC(T2) ; user account entry
CALL CRDCHG ;(T1,T2) do the work.
RETBAD () ;failed
ENDIF.
ENDIF.
ENDIF.
MOVE T1,UBLOCK ;get next user block
UMOVE T1,.CDNXT(T1)
SKIPN T1 ;was this the last one ?
RETSKP ;yes. success.
MOVEM T1,UBLOCK ;no.
LOOP. ; continue.
ENDDO.
;search through the current remote alias list for an entry with a
;particular node name, and delete that entry
;CALL CRDDUP
; T1/ user byte pointer to node name to key on.
; Q1/ address of mapped directory
;returns +1 on failure (allocation failure) with directory unlocked.
;returns +2 on success with directory locked.
;uses the TRVAR JSBTMP
CRDDUP: CALL CRDFND ;(T1/T1,T2) get address of the entry
RETBAD () ;allocation failure
JUMPE T2,RSKP ;not there.
CALL CRDDEL ;(T1) delete it
RETSKP
;find the remote alias entry with a particular node name associated with it.
;CALL CRDFND
; T1/ user byte pointer to node name
; Q1/ address of mapped directory
;returns +2 with
; T1/ address [absolute] of previous alias block or
; 0 if it is first in the list or
; -1 if not found
; T2/ address [absolute] of matched alias block
; 0 if no match
;returns +1 on failure (allocation), with directory unlocked
CRDFND: SAVEAC <Q2,Q3>
CALL CPYFU0 ;(T1/T1) copy user string to a JSB and trim.
RETBAD (CRDIX3,<ULKSTR>) ;failure
MOVEM T1,JSBTMP ;save JSB string block address.
SETZ Q3, ;initialize previous pointer
LOAD Q2,DRRNA,(Q1) ;get start of current list.
DO. ;for each entry in list...
SKIPE Q2 ;end of list ?
IFSKP.
SETO T1, ;yes. no match
SETZ T2,
RETSKP
ENDIF.
ADD Q2,DIRORA ;make it absolute.
MOVE T1,JSBTMP ;address of key string block
LOAD T2,RNNOD,(Q2) ;address of node name string block
SKIPE T2 ;null ?
ADD T2,DIRORA ;no. make it absolute.
CALL CRDCMP ;(T1,T2) compare. equal ?
IFSKP.
CALL CRDJSB ;yes. deallocate key string block
MOVE T1,Q3 ;address of previous
MOVE T2,Q2 ;address of this one
RETSKP ;success
ENDIF.
MOVE Q3,Q2 ;no. update previous.
MOVE Q2,.CDNXT(Q2) ;step to next
LOOP. ; and continue.
ENDDO.
;change an entry in an existing remote alias block
;CALL CRDCHG
; T1/ address of entry to be changed [absolute]
; T2/ user byte pointer
;returns +2 on success,
;returns +1 on failure with directory unlocked.
CRDCHG: SAVEAC <Q2,Q3>
MOVE Q2,T1 ;save address of old entry
MOVE T1,T2 ;get user byte pointer
CALL CRDENT ;(T1/T1) copy the entry into the directory
RETBAD () ;failed
MOVEM T1,Q3 ;save pointer to new entry
SKIPE T2,(Q2) ;any old entry ?
CALL RELDFR ;(T2) yes, deallocate it.
MOVEM Q3,(Q2) ;insert pointer to new entry
RETSKP
;copy a block
;MBLOCK/ address of directory remote alias block to be filled
;UBLOCK/ address of user remote alias block to be used
;CALL CRDCOP
;returns +1 on failure with new list deallocated, and directory unlocked
;returns +2 on success with directory locked
;uses JSBTMP
CRDCOP: ACVAR <W1,W2,W3> ;grab some ACs
MOVE W1,MBLOCK
MOVE W2,UBLOCK
MOVEI T1,.TYRNA ;get remote alias block type
STOR T1,RNTYP,(W1) ;store in directory block
SETZRO RNNXT,(W1) ;zero the "next" field in directory block
SETZRO RNNOD,(W1) ;zero the node field in directory block
SETZRO RNUSR,(W1) ;zero the user field in directory block
SETZRO RNPAS,(W1) ;zero the password field in directory block
SETZRO RNACC,(W1) ;zero the account field in directory block
XCTU [HRRZ W3,.CDSIZ(W2)] ;get length of user's block
ADDI W1,RN.NOD ;point to first entry in directory
ADDI W2,.CDNOD ;point to first entry in user
SUBI W3,.CDNOD ;how many entries user has
DO.
SOJL W3,RSKP ;until done,
UMOVE T1,(W2) ;get pointer to next entry
SKIPE T1 ;null ?
IFSKP.
AOS W1 ;yes. step
AOJA W2,TOP. ; to next
ENDIF.
CALL CRDENT ;(T1/T1) copy entry into directory
RETBAD () ;failed
MOVEM T1,(W1) ;place string block pointer in new entry
AOS W1 ;step
AOJA W2,TOP. ; to next
ENDDO. ;end loop
ENDAV. ;END ACVAR
;copy entry from user into directory
;CALL CRDENT
; T1/ user byte pointer
;returns +2 on success with
; T1/ address of directory string block [relative]
;returns +1 on failure
CRDENT: ACVAR <W1>
CALL CPYFUS ;(T1/T1) put it in JSB
RETBAD (CRDIX3,<ULKSTR>) ;failed
MOVEM T1,JSBTMP ;save its JSB address
CALL SETMSK ;set up mask data
CALL CPYDIR ;(/T1) and place it in dir. [absolute address]
RETBAD (NSPX01,<CALL CRDJSB
ULKSTR>) ;failed, release JSB string & unlock dir.
MOVEI T2,.TYNAM ;mark it as
STOR T2,NMTYP,(T1) ; a name block
SUB T1,DIRORA ;make it relative
MOVE W1,T1 ;save it
CALL CRDJSB ;() release JSB string
MOVE T1,W1 ;restore address
RETSKP
ENDAV. ;end ACVAR
;deallocate a JSB string pointed to by JSBTMP
;CALL CRDJSB
;returns +1 always
CRDJSB: MOVE T2,JSBTMP ;deallocate JSB string
MOVEI T1,JSBFRE ;JSB free space header addr
CALL RELFRE ;(T1,T2/) do it
RET
ENDTV. ;end TRVAR from CRDRNA
;compare two string blocks
;CALL CRDCMP
;T1/ addr of one
;T2/ addr of the other
;returns +1 if not equal
;returns +2 if equal
;uses T1-T4
;note addr = 0 means null string
CRDCMP::SKIPE T1 ;first is null ?
IFSKP.
JUMPE T2,RSKP ;yes. if second null, it is a match.
LOAD T3,NMLEN,(T2) ;get length of second.
CAIG T3,1 ;is length = 1 ?
RETSKP ;yes. second is null. match.
CAIG T3,2 ;is length more than 2 ?
RET ;yes. second isn't null. cannot match.
MOVE T3,1(T2) ;length is 2. get string.
JUMPE T3,RSKP ;if null, it is a match
RET ;not a match
ENDIF.
SKIPE T2 ;second is null ?
IFSKP.
LOAD T3,NMLEN,(T1) ;get length of second.
CAIG T3,1 ;is length = 1 ?
RETSKP ;yes. second is null. match.
CAIG T3,2 ;is length more than 2 ?
RET ;yes. second isn't null. cannot match.
MOVE T3,1(T1) ;length is 2. get string.
JUMPE T3,RSKP ;if null, it is a match
RET ;not a match
ENDIF.
LOAD T3,NMLEN,(T1) ;are the
LOAD T4,NMLEN,(T2) ; lengths
CAME T3,T4 ; equal ?
RET ;no. strings are not equal.
DO. ;yes. check further.
SOSG T3 ;finished ?
RETSKP ;yes. they are equal.
AOS T1 ;no. step to
AOS T2 ; next word.
MOVE T4,(T1) ;get word.
CAME T4,(T2) ;equal ?
RET ;no. strings not equal
LOOP. ;yes. strings might be equal. continue.
ENDDO.
;delete a remote alias entry in directory
;CALL CRDDEL
;T1/ absolute address of the previous entry (0 if the first is to be deleted)
;directory mapped and locked
;returns +1 always
CRDDEL: ACVAR <W1,W2,W3>
SKIPE T1 ;is the first entry in the list to be deleted ?
IFSKP.
MOVE T1,DIRORA ;yes. get directory base address
LOAD W1,DRRNA,(T1) ;get address of entry to be deleted
ADD W1,DIRORA ;make it absolute.
LOAD T2,RNNXT,(W1) ;get next entry.
STOR T2,DRRNA,(T1) ;unlink entry to be deleted.
ELSE.
LOAD W1,RNNXT,(T1) ;no. get address of entry to be deleted
ADD W1,DIRORA ;absolute.
LOAD T2,RNNXT,(W1) ;get next.
STOR T2,RNNXT,(T1) ;unlink old.
ENDIF.
LOAD W2,RNLEN,(W1) ;get size.
SUBI W2,RN.NOD ;get number of string blocks in this entry
MOVE W3,W1 ;addr of first string
ADDI W3,RN.NOD ; block entry in this block
DO.
SOJL W2,ENDLP. ;until done,
MOVE T2,(W3) ;get addr of string block
SKIPE T2 ;is it null ?
CALL RELDFR ;(T2) no. deallocate it. [relative]
AOJA W3,TOP. ;continue
ENDDO.
MOVE T2,W1 ;get addr of present block
SUB T2,DIRORA ;make it relative
CALL RELDFR ;(T2) deallocate it. [relative]
RET
ENDAV. ;END ACVAR
;DELDIR - DELETE THIS DIRECTORY
DELDIR: SETZM CRDIRF ;INITIALIZE ERROR FLAG
SETZM CRDIRE ;INITIALIZE ERROR CODE
CALL CRDIR6 ;RETURN ALL SPACE USED
SETZM CRDDIQ ;CLEAR DELTAS IN CASE DIR IS BAD
SETZM CRDDOQ ; ...
SETZM CRDDSQ ; ...
; TCO 5.1082 CHECK FOR OTHER JOB USING THIS DIRECTORY
HLL T1,CRDSUP ; GET THE STRUCTURE CODE
HRR T1,CRDIRD ; GET THE DIR ID.
CALL SETDIR ; MAP IN THE DIRECTORY
JRST [ SETOM CRDIRF ; ASSUME DIR IS BAD
JRST DELDI2 ] ; AND KEEP GOING
CALL GETIDX ; GO GET THE INDEX STUFF
JRST [ SETOM CRDIRF ; ASSUME BAD DIRECTORY
JRST DELDI2 ] ; AND MOVE ON
PUSH P,T1 ; SAVE THE INDEX STUFF FOR LATER
PUSH P,T2 ;
HRRZ T1,CRDIRD ; GET THE DIRECTORY NUMBER
NOINT ; WE SHOULD NOT BE INTERRUPTED
CALL INVDIR ;[7.1055](T1/) Make sure ALOC2 will not get us
IFNSK. ;[7.1055] Can't delete this directory
POP P,T2 ;[7.1055] Put the ACs back
POP P,T1 ;[7.1055]
CALL USTDIR ;[7.1055](/) Unlock the directory
OKINT ;[7.1055] Undo the NOINT
MOVEI T4,CRDIX7 ;[7.1055] Say we still have mapped files
JRST DELDI3 ;[7.1055] And get out of here
ENDIF. ;[7.1055]
CALL INVIDX ; INVALIDATE THE INDEX WHILE WE LOOK AROUND
MOVSI STS,-NJOBS ; SET UP AOBJN POINTER
HLL DEV,CRDSUP ; GET THE UNIQUE CODE
HRR DEV,CRDIRD ; UNIQUE CODE,,DIRECTORY
LOAD P3,CURSTR ; GET THE STRUCTURE NUMBER
DDLOOP: HRRZ T1,STS ; GET JOB NUMBER
CAMN T1,JOBNO ; IS IT US?
JRST DDNXT ; YES, WE CHECK THAT LATER
CALL MAPJSB ; MAP HIS JSB
JRST DDNXT ; NON-EXISTENT, GO DO NEXT
CALL GTOJCD ; GET OTHER JOB'S CONNECTED DIRECTORY
CAMN T1,DEV ; MATCH?
JRST DDBMB ; YES, GO BOMB OUT
CALL CLRJSB ; UNMAP JSB
CAME P3,LGSIDX ; [7.1112]Login Structure?
JRST DDNXT ; NO, DON'T CHECK FOR LOGGED-IN
HRRZ T1,JOBDIR(STS) ; GET LOGGED-IN DIR OF THIS JOB
HRRZ T2,CRDIRD ; AND THE DIR # OF THE ONE TO DELETE
CAMN T1,T2 ; SAME?
JRST DDBMB ; YES, RETURN THE ERROR
DDNXT: AOBJN STS,DDLOOP ; CHECK FOR MORE
POP P,T3 ; RETRIEVE THE IDXTAB STUFF
POP P,T2
CALL CRDONE ; RESET IT
;DON'T LET USER DELETE THIS DIRECTORY IF CONNECTED TO IT
CALL GTCSCD ;GET CONNECTED STRUCTURE,,DIRECTORY
HLL B,CRDSUP ;GET UNIQUE CODE
HRR B,CRDIRD ;GET (STRUCTURE,,DIRECTORY) TO DELETE
CAMN A,B ;TRYING TO DELETE CONNECTED DIRECTORY?
JRST [ CALL USTDIR ;RELEASE THE DIRECTORY LOCK
MOVEI D,CRDI19 ;YES. DON'T ALLOW IT
JRST DELDI3] ;GO CLEAN UP AND FAIL
MOVE A,B ;A/(UNIQUE CODE,,DIRECTORY) TO DELETE
;DON'T ALLOW USER TO DELETE THIS DIRECTORY IF LOGGED-IN TO IT.
MOVE A,JOBNO ;GET THIS JOB NUMBER
HRRZ A,JOBDIR(A) ;GET ITS LOGGED-IN DIRECTORY NUMBER ON PS
LOAD B,DRNUM,(Q1) ;GET NUMBER OF MAPPED DIRECTORY
CAME A,B ;DO THEY MATCH?
JRST DELDI6 ;NO. OK TO DELETE IT
LOAD B,CURSTR ;YES. GET STRUCTURE NUMBER FOR THIS DIRECTORY
CAME B,LGSIDX ;[7.1112]Is it the Login Structure?
JRST DELDI6 ;YES. OK TO DELETE IT
MOVEI D,CRDI18 ;YES. CAN'T DELETE LOGGED-IN DIRECTORY
CALL USTDIR ;UNLOCK THE DIRECTORY
JRST DELDI3 ;GO RETURN ERROR
; ROUTINE TO BOMB OUT OF SEARCH IN DDLOOP ABOVE
DDBMB: POP P,T3 ; GET BACK THE IDXTAB STUFF
POP P,T2 ;
CALL CRDONE ; GO RESET WITH SETIDX
CALL CLRJSB ; CLEAR OUT THE JSB WE MAPPED
CALL USTDIR ; UNLOCK THE DIRECTORY
OKINT ; MAKE US INTERRUPTIBLE
MOVEI T4,CRDIX6 ; SET ERROR TO "ALREADY MAPPED"
JRST DELDI3 ; AND GO TO IT
; ROUTINE TO RESET THE IDXTAB ENTRY FOR DDLOOP ABOVE
CRDONE: HRRZ T1,CRDIRD ;
LOAD T4,CURSTR ; GET THE STRUCTURE NUMBER
HLRS T4 ; SWAP IT
HRR T4,CRDSUP ; DIRECTORY NUMBER OF SUPERIOR
CALL SETIDX ; SET IT
RET ; SHOULDN'T HAPPEN
RET ; OK
;SAVE THE QUOTAS (DISK AND SUBDIRECTORY) FOR THIS DIRECTORY SO THEY
;CAN BE GIVEN BACK TO ITS SUPERIOR
DELDI6: LOAD A,DRLIQ,(Q1) ;GET LIQ
MOVEM A,CRDDIQ ;SAVE AS DELTA LIQ FOR SUPERIOR
LOAD A,DRLOQ,(Q1) ;GET LOQ
MOVEM A,CRDDOQ ;SAVE AS DELTA
LOAD A,DRSDM,(Q1) ;GET SUBDIR QUOTA
MOVEM A,CRDDSQ ;SAVE
CALL USTDIR ;RELEASE DIR
;SEE IF DIRECTORY FILE IS MAPPED. IF SO, THE DIRECTORY CAN'T BE DELETED
;IN THIS MANNER
MOVE A,CRDIRJ ;1/JFN
MOVE B,[1,,.FBADR] ;2/(COUNT,,OFFSET INTO FDB)
MOVEI C,D ;3/DESTINATION FOR RESULT
GTFDB ;GET ADDRESS OF INDEX BLOCK
ERJMP [SETOM CRDIRF ;DIRECTORY IS BAD. DON'T BOTHER TO CHECK
JRST DELDI2] ;GO DELETE THE DIRECTORY ANYWAY
MOVEM D,CRDIRA ;SAVE IT
CALL UNMAPD ;UNMAP THE DIRECTORY TO BE DELETED
MOVE A,CRDIRA ;A/ADDRESS OF INDEX BLOCK
HRRZ B,CRDSTX ;B/STRUCTURE NUMBER
CALL CHKOFN ;SEE IF THIS FILE IS OPEN (DIRECTORY IS MAPPED)
JRST [ MOVEI T4,CRDIX6 ;YES. CAN'T DELETE THE FILE, THEN
JRST DELDI3] ;RELEASE JFN AND RETURN
;DELETE AND EXPUNGE ALL THE FILES IN THIS DIRECTORY. THIS WILL FAIL IF THE
;DIRECTORY HAS SUBDIRECTORIES
HRRZ A,CRDSTX ;GET STRUCTURE NUMBER
CALL STRCNV ;GET UNIQUE CODE FOR THIS STRUCTURE
JRST [ MOVE D,A ;FAILED, GET ERROR CODE
JRST DELDI3 ] ;GO RETURN ERROR
HRL A,A ;POSITION UNIQUE CODE
HRR A,CRDIRD ;Get directory number to delete
MOVX F,1B17 ;DELETE AND EXPUNGE ALL FILES FROM DIR
CALL DELDEL
JRST [ MOVEM T1,CRDIRE ;FAILED. SAVE ERROR CODE
JRST DELDI1] ;GO SEE WHY FAILED
;FILES MAY OR MAY NOT HAVE BEEN DELETED AT THIS POINT. NOW CLEAR DIRECTORY
;AND PERMANENT BITS SO THAT DIRECTORY FILE CAN BE DELETED
DELDI2: HRRZ JFN,CRDIRJ ;GET JFN
IMULI JFN,MLJFN ;GET INTERNAL FORMAT
MOVE STS,FILSTS(JFN) ;SET UP FOR GETFDB CALL
HRRI DEV,DSKDTB ;...
HRL DEV,CRDSTX ;GET STRUCTURE NUMBER
CALL GETFDB ;MAP IN THE FDB OF THIS FILE
JRST [ MOVEI D,CRDIX9 ;FAILED. RETURN ILLEGAL FORMAT ERROR CODE
JRST DELDI3] ;CLEAN UP AND TAKE ERROR RETURN
SETZRO <FBPRM,FBDIR>,(A) ;CLEAR BITS SO DELF WILL WORK
;INCREMENT SUPERIOR'S QUOTAS BY THE AMOUNT PREVIOUSLY ASSIGNED TO THIS
;DIRECTORY
HRRZ A,CRDSUP ;GET SUPERIOR DIRNO
CAIN A,ROOTDN ;ROOT-DIR?
JRST DELDI5 ;YES - DONT INCREMENT QUOTAS
CALL CKLIQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
SKIPA ;YES. DON'T ADJUST
JRST [ LOAD A,DRLIQ,(Q1) ;NO. GET SUPERIOR LIQ
ADD A,CRDDIQ ;INCREMENT BY DELTA LIQ
STOR A,DRLIQ,(Q1); ADJUST SUPERIOR'S LOGGED-IN QUOTA
HRRZ A,CRDSUP ;A/ DIRECTORY NUMBER FOR SUPERIOR
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
MOVE C,CRDDIQ ;C/ AMOUNT TO ADD TO SUPERIOR
CALL ADJALC ;ADJUST SUPERIOR'S ALLOCATION ENTRY
JRST .+1]
CALL CKLOQ ;SEE IF SUPERIOR HAS INFINITE QUOTA
SKIPA ;YES. DON'T ADJUST
JRST [ LOAD A,DRLOQ,(Q1) ;NO. GET SUPERIOR LOQ
ADD A,CRDDOQ ;INCREMENT BY DELTA LOQ
STOR A,DRLOQ,(Q1) ;ADJUST SUPERIOR'S LOGGED-OUT QUOTA
JRST .+1]
LOAD A,DRSDM,(Q1) ;GET SUPERIOR SDQ
ADD A,CRDDSQ ;GET SUBDIR DELTA
STOR A,DRSDM,(Q1) ;STORE
DELDI5: LOAD A,DRSDC,(Q1) ;GET CURRENT SUBDIR COUNT
SUBI A,1 ;ONE FEWER SUBDIRS
STOR A,DRSDC,(Q1) ; ...
MOVEM A,CRDDSQ ;SAVE RESIDUAL COUNT
ULKDIR ;UNLOCK DIR
;REMOVE ENTRY FOR THIS DIRECTORY FROM IDXTAB
MOVE A,CRDIRD ;GET DIR NUMBER AGAIN
CALL DELIDX ;DELETE THIS ENTRY FROM INDEX TABLE
;IF DELETING THE LAST SUBDIRECTORY FROM ITS SUPERIOR, INDICATE THAT
;SUPERIOR NO LONGER HAS SUBDIRECTORIES
SKIPE CRDDSQ ;NEED TO CLEAR SUBDIR FLAG IN SUP FDB?
JRST DELDI4 ;NO.
HRRZ A,CRDSUP ;GET SUPERIOR DIR NUMER
CALL GETIDX ;GET INDEX INFORMATION
JRST DELDI4 ;CANT
MOVEM A,CRDTMP ;SAVE FDB ADDRESS
MOVE A,C ;GET SUPERIORS SUPERIOR DIR NUMBER
HLL A,CRDSUP ;INSERT SUC
CALL SETDIR ;MAP DIRECTORY
JRST DELDI4 ;OH WELL, WASN'T ALL THAT IMPORTANT
MOVE A,CRDTMP ;GET FDB OF SUPERIOR
ADD A,DIRORA ;AS AN ABSOLUTE ADDRESS
SETZRO FB%SDR,.FBCTL(A) ;CLEAR SUBDIR FLAG
CALL UPDDIR ;UPDATE DISK IMAGE
CALL USTDIR ;RELEASE
;DELETE THE DIRECTORY FILE AND EXPUNGE ITS CONTENTS
DELDI4: MOVE C,CRDIRD ;C/ DIRECTORY NUMBER
MOVE D,CRDSTX ;D/ STRUCTURE NUMBER
CALL REMSDR ;REMOVE FROM CACHE IF NECC.
CALL CRDSWH ;SET WHEEL FOR DURATION OF DELETE
MOVX A,DF%EXP ;EXPUNGE CONTENTS
HRR A,CRDIRJ ;GET JFN OF DIR FILE
DELF ;DELETE THE DIR FILE
JRST [ PUSH P,A ;SAVE ERROR CODE
CALL CRDCWH ;CLEAR WHEEL
POP P,D ;RESTORE ERROR CODE
JRST DELDI3] ;GO CLEAN UP
CALL CRDCWH ;CLEAR WHEEL
SKIPE CRDIRF ;HAS DELDEL FAILED FOR A BAD DIRECTORY?
JRST [ HRRZ A,CRDSTX ;GET STRUCTURE NUMBER
HRRZ A,STRTAB(A) ;GET LOCATION OF SDB
MOVE A,(A) ;GET SIXBIT STRUCTURE NAME
BUG.(INF,DELBDD,JSYSF,HARD,<DELDIR - Bad directory deleted>,<<A,STRNAM>>,<
Cause: After a bad directory has been deleted, the attempt to delete and
expunge it's contents has failed. The bit table is now incorrect.
Action: Use CHECKD to rebuild the structure's bit table.
Data: STRNAM - sixbit structure name
>,,<DB%NND>) ;[7.1210]
JRST .+1] ;CONTINUE
HRRZ A,CRDIRJ ;GET JFN AGAIN
RLJFN ;RELEASE THE JFN
JFCL
HRRZ A,CRDSUP ;GET SUPERIOR DIRECTORY NUMBER
CAIE A,ROOTDN ;IS IT ROOT-DIRECTORY?
RETSKP ;NO. DON'T MAKE BACKUP
HRRZ A,CRDSTX ;YES. GET STRUCTURE NUMBER
CALL CPYBAK ;UPDATE BACKUP
JRST [ BUG.(CHK,CRDBK1,JSYSF,HARD,<CRDIR4 - Could not make backup copy of ROOT-DIRECTORY>,,<
Cause: During an attempt to delete a directory directly inferior to the
root directory, CPYBAK failed to update the backup copy of the root
directory.
Action: The backup copy of the root directory is now corrupt and must be
repaired by hand.
>,,<DB%NND>) ;[7.1210]
RETSKP]
RETSKP
;A FAILURE HAS OCCURRED. IF IT IS DUE TO A BAD DIRECTORY, FORCE IT TO
;BE DELETED ANYWAY. IF NOT, ERROR IS PROBABLY OPEN FILE IN DIRECTORY, WHICH
;SHOULD FAIL
DELDI1: SKIPE CRDIRF ;DID CONSISTENCY CHECK FAIL PREVIOUSLY?
JRST [ MOVEI D,CRDIX9 ;YES. RETURN BAD FORMAT FOR DIRECTORY
JRST DELDI3] ;CLEAN UP AND TAKE ERROR RETURN
MOVE A,CRDIRD ;NO. A/DIRECTORY NUMBER
HLL A,CRDSUP ;GET STRUCTURE UNIQUE CODE IN LH
MOVX F,DD%CHK ;CHECK CONSISTENCY OF DIRECTORY
CALL DELDEL ; BUT DON'T FIX ANYTHING
JRST [ SETOM CRDIRF ;FAILED. INDICATE BAD DIRECTORY
JRST DELDI2] ;GO DELETE THE DIRECTORY FILE
SKIPN D,CRDIRE ;IF ERROR CODE SET, USE IT
MOVEI D,CRDIX7 ;IF NO CODE, ASSUME FILE IS OPEN
DELDI3: HRRZ A,CRDIRJ ;GET JFN OF DIRECTORY FILE
RLJFN ;RELEASE IT
JFCL
MOVE A,D ;RESTORE ERROR CODE
RETBAD () ;GIVE ERROR RETURN
;CHKNUM - ROUTINE TO SEE IF DIR # SPECIFIED BY USER ALREADY EXISTS
CHKNUM: SAVET ;PRESERVE TEMPORARY ACS
HRROI A,CRDIRS ;GET POINTER TO DEVICE NAME
STDEV ;GET DEVICE DESIGNATOR
JRST [ MOVEM B,CRDIRE ;RETURN ERROR NUMBER
RETBAD ()]
MOVEM B,CRDDEV ;SAVE DEVICE DESIGNATOR
HRRZ A,B ;GET STRUCTURE UNIQUE CODE
CALL CNVSTR ;CONVERT TO STR #
JRST [ MOVEM A,CRDIRE ;RETURN ERROR NUMBER
RETBAD ()]
MOVEM A,CRDSTR ;SAVE STRUCTURE #
SKIPN C,STRTAB(A) ;GET SDB FOR THIS STRUCTURE
JRST [ MOVEI A,CRDI12 ;INVALID STRUCTURE
JRST CHKNM1]
JN STCRD,(C),CHKNM2 ;RETURN SUCCESS IF CREATING ROOT-DIRECTORY
HRLZ A,CRDDEV ;GET STR UNIQUE CODE
XCTU [HRR A,.CDNUM(Q2)] ;GET DIR NUMBER SPECIFIED BY USER
CALL SETDIR ;SEE IF DIRECTORY WITH THIS NUMBER EXISTS
JRST CHKNM2 ;NO SUCH DIRECTORY, SUCCESS
CALL CHKNAM ;SEE IF THE NAME STRINGS MATCH
JRST CHKNM0 ;NO, THIS IS ILLEGAL
CALL USTDIR ;THEY MATCH, THIS MUST BE RECONSTRUCTION
JRST CHKNM2
CHKNM0: CALL USTDIR ;UNMAP THE DIRECTORY
MOVEI A,CRDIX8 ;DIRECTORY WITH SPECIFIED NUMBER ALREADY EXISTS
;CHKNUM ERROR RETURN
CHKNM1: MOVEM A,CRDIRE ;SAVE ERROR NUMBER
MOVE A,CRDSTR ;GET STR #
CALL ULKSTR ;UNLOCK IT
RETBAD ()
;CHKNUM SUCCESSFUL RETURN
CHKNM2: MOVE A,CRDSTR ;GET STR #
CALL ULKSTR ;UNLOCK IT
RETSKP
;GTJFN BLOCK FOR CRDIR
CRDGJB: GJ%DEL!GJ%PHY+1
377777,,377777
0 ;DEVICE
-1,,[ASCIZ/ROOT-DIRECTORY/]
0 ;NAME
0 ;EXT
0 ;PROTECTION
0 ;USE THE ACCOUNT OF THE CALLER
0
;ROUTINE TO SET THE PROCESS INTO WHEEL STATE
; CALL CRDSWH
;RETURNS +1: USER IS NOINT AND WHEEL
CRDSWH: NOINT
MOVE A,CAPENB ;GET USER'S CAPABILITIES
MOVEM A,CRDCAP ;SAVE THEM
MOVX A,SC%WHL ;ADD WHEEL
IORM A,CAPENB ; IN ORDER TO DO GTJFN
RET ;AND RETURN
;ROUTINE TO CLEAR WHEEL AND PUT BACK THE PREVIOUS CAPABILITIES
; CALL CRDCWH
;RETURNS +1: OLD CAPABILITIES ARE RRESTORED, AND PROCESS IS OKINT
CRDCWH: MOVE A,CRDCAP ;GET BACK ORIGINAL CAPABILITIES
MOVEM A,CAPENB ;AND RESTORE TO USER
OKINT
RET ;AND RETURN
;CKLIQ AND CKLOQ - CHECK FOR INFINITE QUOTA
;ACCEPTS:
; Q1/ CONTENTS OF DIRORA
; CALL CKLIQ/CKLOQ
;RETURNS +1: QUOTA IS INFINITE
; +2: QUOTA IS NOT INFINITE
;CLOBBERS NO AC'S
CKLIQ: SAVEAC <Q2>
LOAD Q2,DRLIQ,(Q1)
JRST CKLQ1
CKLOQ: SAVEAC <Q2>
LOAD Q2,DRLOQ,(Q1)
CKLQ1: TXNN Q2,1B0
TXNN Q2,1B1
RETSKP
RET
;ROUTINE TO INITIALIZE A DIRECTORY
;ACCEPTS IN T1/ DIRECTORY NUMBER
; T2/ STRUCTURE NUMBER
; CALL DIRINI
; or
; CALL DIRIN1 (from CRDIR%)
;RETURNS +1: ERROR, ERROR CODE IN T1
; +2: DIRECTORY IS INITIALIZED
DIRIN1: TDZA T4,T4 ;[7.1257] Make CRDIR% entry point
DIRINI::SETO T4, ;[7.1257] All other entries
EA.ENT
STKVAR <DIRINN,DIRINS,ENTPNT> ;[7.1257]
MOVEM T4,ENTPNT ;[7.1257] Save entry point
MOVEM T1,DIRINN ;SAVE DIRECTORY NUMBER
MOVEM T2,DIRINS ;SAVE STRUCTURE NUMBER
CALL MAPDIR ;MAP IN THE DIRECTORY
RETBAD (CRDIX8) ;ILLEGAL DIR NUMBER
MOVE T1,DIRINN ;GET BACK DIR NUMBER
MOVE T2,DIRINS ; AND STRUCTURE NUMBER
CALL LCKDNM ;LOCK THE DIRECTORY
HRRZ T1,DIRINS ;GET STRUCTURE NUMBER
MOVE T1,STRTAB(T1) ;GET ADDRESS OF SDB
INCR STRLK,(T1) ;LOCK THE STRUCTURE
MOVE T4,DIRORA ;SET UP POINTER TO DIRORG
SKIPN ENTPNT ;[7.1257] Only do this if CRDIR% code
CALL CRDSWH ;[7440] (/T1) Bump privs to WHEEL and go NOINT
SETZM 0(T4) ;ZERO THE FIRST WORD
ERJMP [SKIPN ENTPNT ;[7.1257] Do this if CRDIR% code
CALL CRDCWH ;[7440] (/T1) Reset privs and go OKINT
MOVE T1,DIRINN ;FAILED. GET DIR NUMBER
MOVE T2,DIRINS ; AND STRUCTURE NUMBER
CALL ULKDNM ;FREE LOCK
HRRZ T1,DIRINS ;GET STRUCTURE # AGAIN
MOVE T1,STRTAB(T1) ;GET SDB ADDRESS
DECR STRLK,(T1) ;RELEASE STRUCTURE
CALL UNMAPD ;UNMAP THE DIRECTORY
MOVE T1,LSTERR ;GET PAGE FAULT HANDLER'S COMPLAINT
RETBAD()] ;AND FAIL
SKIPN ENTPNT ;[7.1257] Do this if CRDIR% code
CALL CRDCWH ;[7440] (/T1) Reset privs and go OKINT
MOVEI T1,777 ;DO XBLT OF 1 PAGE
MOVE T2,T4 ;START OF PAGE
MOVE T3,T4 ;START OF PAGE
AOS T3 ;+1
CALL XBLTA
MOVE T1,DIRINN ;GET BACK DIR NUMBER
STOR T1,DRNUM,(T4) ;PUT DIRECTORY NUMBER INTO DIR
MOVEI T1,.TYDIR ;GET DIR BLOCK TYPE
STOR T1,DRTYP,(T4) ;STORE TYPE # FOR CONSISTENCY CHECK
SETZRO DRRPN,(T4) ;RELATIVE PAGE # IS 0
MOVEI T1,.DIHL0 ;GET LENGTH OF PAGE 0 HEADER
STOR T1,DRHLN,(T4) ;REMEMBER LENGTH IN HEADER ITSELF
SETZRO DRFFB,(T4) ;NO FREE AREA
STOR T1,DRFTP,(T4) ;STORE END POINTER INTO DIR
MOVEI T1,PGSIZ ;INITIAL DIR IS 1 PAGE LONG
STOR T1,DRSTP,(T4) ;WITH SYMBOL TABLE ENDING AT 777
MOVEI T1,PGSIZ-2 ;EMPTY SYMBOL TABLE IS 2 WORDS LONG
STOR T1,DRSBT,(T4) ; TO HOLD JUST THE BLOCK TYPE
ADD T1,DIRORA ;GET ACTUAL ADDRESS IN MON VIRT SPACE
MOVE T2,DIRINN ;GET DIRECTORY NUMBER
STOR T2,SYMDN,(T1) ;PUT IT IN SYMBOL TABLE HEADER BLOCK
MOVEI T2,.TYSYM ;GET BLOCK TYPE OF SYMBOL TABLE
STOR T2,SYMTY,(T1) ;STORE IT AT HEAD OF SYMBOL TABLE
SETONE SYMVL,(T1) ;SET SECOND WORD TO -1
MOVE T1,[5B2+.STDFP] ;GET STANDARD DEFAULT FILE PROTECTION
STOR T1,DRDPW,(T4) ;SAVE DEFAULT FILE PROT
MOVE T1,[5B2+.STDDP] ;NOW SET UP DIRECTORY PROTECTION
STOR T1,DRPRT,(T4) ;...
MOVE T1,[5B2+.STDBS] ;AND SET UP STD BACKUP SPECIFICATION
STOR T1,DRDBK,(T4) ;...
MOVEI T1,.STDMX ;INIT MAX ALLOCATION (LOGGED OUT QUOTA)
STOR T1,DRLOQ,(T4) ;...
STOR T1,DRLIQ,(T4) ; AND LOGGED IN QUOTA
MOVX T1,.STDSD ;GET DEFAULT SUBDIR QUOTA
STOR T1,DRSDM,(T4) ;STORE IN DIR
MOVX T1,.STDNE ; Default online expiration
STOR T1,DRDNE,(T4) ; Into directory
SKIPG T1,TPRCYC ; Use Tape Recyle Period if set for
MOVX T1,.STDFE ; Default offline expiration
STOR T1,DRDFE,(T4) ; Into directory
ULKDIR ;UNLOCK THE DIRECTORY
RETSKP ;EXIT
; Delete file
; Call: 1 ; Jfn
; DELF
; Return
; +1 ; Error, cannot delete
; +2 ; Success
; DF%NRJ (B0) - DON'T RELEASE JFN
; DF%EXP (B1) - EXPUNGE CONTENTS
; DF%FGT (B2) - FORGET FILE
.DELF:: MCENT ; Become slow
HRRZ JFN,1
CALL CHKJFN ; Check it out
JRST GBGJFN
JFCL
ERUNLK DESX4 ; Tty or byte illegal
TQNE <ASTF>
ERUNLK(DESX7) ; Output stars not allowed
CALL @DELD(P3) ; Call device dependent routine
ERUNLK() ; Couldn't delete
UMOVE A,1
TLNE A,(DF%NRJ) ;IF B0, DON'T RELEASE JFN
JRST DELF1
TQNN <OPNF>
JRST [ MOVEI A,0(JFN) ;GET THE JFN
CALL LUNLK0 ;FREE THE STR LOCK
CALL RELJFN ;RELEASE THE JFN
SMRETN]
DELF1: CALL UNLCKF
SMRETN
;DELETE ALL BUT N VERSIONS OF FILE
; 1/ FLAG BITS+JFN
; 2/ NUMBER OF VERSIONS TO KEEP
;
;RETURNS +1 - ERROR
; +2 - SUCCESS, NUMBER OF VERSIONS DELETED IN 2
.DELNF:: MCENT
XCTU [HRRZ JFN,1] ;Get JFN only from user's AC1
CALL CHKJFN ;CHECK THE JFN
JRST GBGJFN
JFCL
ERUNLK DESX4 ;TTY OF BYTE ILLEGAL
TQNE <ASTF> ;PARSE-ONLY?
ERUNLK(DESX7) ;YES, LOSE
BLCAL. DSKOK,<P3> ;DISK?
ERUNLK GFDBX1 ;NO, CAN'T DO
LOAD A,STR,(JFN) ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063](T1/T1)Is structure offline?
ERUNLK () ;[7.1063]Return "Structure is offline"
CALL GETFDB
ERUNLK DESX3
UMOVE Q1,2 ;NUMBER OF VERSIONS TO KEEP
DELNF2: JN <FBNXF,FBDEL,FBNDL>,(A),DELNF1 ;[7253] Skip DELETED, NON-EX or NEVER-DELETE files
UMOVE B,1 ; Get flag
TXNE B,DF%ARC ; Allowing deletes on archived ?
JRST DELNF5 ; Yes, bypass check then
PUSH P,A
MOVX B,FC%WR ; Write access necessary for delete
CALL ARACCK ; Check archive/vir. disk requirements
JUMPG A,[POP P,A ; Not allowed--skip this file
JRST DELNF1]
POP P,A
DELNF5: JN <FBTMP>,(A),DELNF3 ;TEMPORARY FILES ARE SPECIAL
DELNF4: SOJGE Q1,DELNF1 ;SKIP IT IF STILL WITHIN KEEP COUNT
PUSH P,A ;SAVE FDB ADR
MOVX B,FC%WR ;MUST HAVE WRITE ACCESS TO DELETE
CALL ACCCHK
JRST [ POP P,A ;NOT ENOUGH ACCESS RIGHTS
ULKDIR
ERUNLK (DELFX1)]
POP P,A ;GET BACK FDB ADR
SETONE FBDEL,(A) ;MARK IT AS DELETED
DELNF1: LOAD A,FBGNL,(A) ;GET ADR OF FDB OF NEXT GENERATION
JUMPE A,DELNFE ;DONE IF END OF LIST
ADD A,DIRORA
JRST DELNF2
DELNF3: LOAD Q2,FBGEN,(A) ;GET GENERATION NUMBER
SUBI Q2,^D100000 ;OFFSET FOR TEMPORARY GENS
JUMPL Q2,DELNF4 ;[7107] Not owned by a job, continue normally
MOVE B,JOBNO ;Get local job number
EXCH A,B ;Save A and position LJN correctly
CALL LCL2GL ;(A/A) Convert to global job number
JFCL ;This should not fail!
EXCH A,B ;Restore A; B now has global job number
CAMN Q2,B ;Belongs to current job?
JRST DELNF4 ;YES, DO NORMAL THING ON THIS FILE ONLY
JRST DELNF1 ;SKIP ALL TEMPORARY FILES NOT BELONGING TO THIS JOB
DELNFE: SKIPLE Q1 ;ANY FILES DELETED?
MOVEI Q1,0 ;NO, SET Q1=0
XCTU [MOVNM Q1,2] ;STORE # OF FILES DELETED
ULKDIR
CALL UNLCKF
SMRETN
; Dismount device
; Call: 1 ; Device designator
; DSMNT
; Return
; +1 ; Error
; +2 ; Ok
.DSMNT:: MCENT
UMOVE A,1
CALL CHKDEV
RETERR() ; Illegal designator or not available
HRRZ P3,DEV ; SET UP ADDRESS ONLY
CALL DSM0 ;DO THE WORK
RETERR DSMX1 ;FAILED
SMRETN
;LOCAL ROUTINE TO DO DISMOUNT
DSM0: PUSH P,B ;SAVE DEV INDEX
HRRZ P3,DEV
CALL @DSMD(P3) ;CALL DEVICE DEPENDENT PART
JRST [ POP P,B ;FAILED
RET]
MOVSI A,(DV%MNT)
POP P,B ;RECOVER DEV INDEX
ANDCAM A,DEVCHR(B) ;CLEAR MOUNTED BIT
RETSKP
;INTERNAL ROUTINE TO DISMOUNT DEVICE
; B/ DEV TABLE INDEX
DSMNT0::SAVEP
PUSH P,1
HRRZ A,DEVUNT(B) ;GET UNIT NUMBER
ANDI A,DV%UNT ;MASK TO UNIT NUMBER
CAIN A,DV%UNT ;CHECK FOR -1
MOVEI A,-1 ;YES SET -1
HRRZ DEV,DEVDSP(B) ;BE SURE DEV SETUP AS USUAL
HRLI DEV,0(A)
CALL DSM0 ;DO THE WORK
SOS -1(P) ;FAILED, PREVENT SKIP RETURN
DSMNT1: POP P,1
RETSKP
; Get device characteristics
; Call: 1 ; Device designator
; DVCHR
; Return
; +1 ; Ok
; 2 ; Device characteristics word
; LH(3) ; Job to which device is assigned
; RH(3) ; Unit number
.DVCHR::MCENT
STKVAR <DEVJOB> ;Stash for Device's owning job
HLRZ B,1
TRZ B,777
CAIL 1,.TTDES ; Is this a tty designator?
CAIL 1,.TTDES+NLINES
CAIN B,.DVDES ; Or a device designator
JRST DVCHR1 ; Yes, do directly
UMOVE JFN,1 ; No. translate first
CALL CHKJFN
ITERR()
JFCL
JRST [ CAMN JFN,[0,,.NULIO] ;IS THIS NULL
MOVE JFN,[600000+.DVNUL,,+777777] ;GIVE THE DEVICE DESIGNATOR
UMOVEM JFN,1
JRST DVCHR1]
CALL LCKDVL ;LOCK DEVICE TABLE TO AVOID 'SECNX'
CAIE P3,NFTDTB ;NFT device ?
IFSKP.
CALL UNLCKF ;yes. unlock file.
UNLOKK DEVLKK ;unlock device table
MOVE A,[POINT 7,[ASCIZ\NFT\]] ;this is the device name
STDEV% ;get device designator
ITERR () ;error
UMOVEM T2,T1 ;return it to user.
ELSE.
HLRZ A,FILDDN(JFN) ;no. Get pointer to device name block
HRLI A,(<POINT 7,0,35>)
CALL STDEVP ; Convert string to device designator
ITERR(<(A)>,<CALL UNLCKF
UNLOKK DEVLKK>)
CALL UNLCKF
UNLOKK DEVLKK ;UNLOCK THE DEVICE TABLE
UMOVEM A,1 ;return device designator to user
ENDIF.
DVCHR1: UMOVE A,1
CALL CHKDEV
JRST [ CAIE A,DEVX2 ; Was error due to unavailablity
ITERR() ;NO, ABORT
MOVE C,DEVCHR(B)
TLZ C,(DV%AV) ;SAY NOT AVAILABLE
JRST DVCHR4]
TLO C,(DV%AV)
DVCHR4: UMOVEM C,2
BLCAL. DSKOK,<DEV> ;THIS A DSK?
SKIPA A,DEVUNT(B) ;NOT A DISK
HLLO A,DEVUNT(B) ;A DISK, ALWAYS SAY -1 IN RH OF 3
MOVEM A,DEVJOB ;Save it
SKIPGE A ;Is device assigned to a job?
IFSKP. ;Skip, Job index in LH(A)
HLRZ A,A ;Get job index only
CALL LCL2GL ;Convert it into a job number
SKIPA ;Not a real job number, so don't save it
HRLM A,DEVJOB ;Stuff job number where index was
ENDIF. ;Resume main code
MOVE A,DEVJOB ;Get the Job number,,unit number
UMOVEM A,3
HLRZ A,DEVUNT(B) ;YES, GET THE ASSIGNER
TXNN C,DV%AV ;IS DEVICE UNAVAILABLE?
CAIE A,-1 ;YES, DO WE HAVE ASSIGNER?
MRETNG ;Available, or we have assigner
HRRZ A,DEV ;FIND OUT WHAT DEVICE THIS IS
CAIE A,TTYDTB ;IS THE UNAVAILABLE DEVICE A TTY?
JRST DVCHR2 ;NO
HRRZ A,DEVUNT(B) ;NO ASSIGNER SO MUST BE UNAVAILABLE
ANDI A,DV%UNT
CAIN A,DV%UNT ;CHECK FOR -1
MOVEI A,-1
CALL TTYPTY ;ASSUME IT'S A PTY. GET PTY NUMBER
HRLI A,<.DVDES+.DVPTY> ;MAKE IT A DEVICE DESIGNATOR
DVCHR3: CALL CHKDES ;UNAVAILABLE. GET INDEX FOR PTY
BUG.(CHK,DVCHRX,JSYSF,HARD,<DVCHR1 - Unexpected CHKDES failure within .DVCHR>,,<
Cause: CHKDES failed to get the device code for a TTY or PTY after using
either TTYPTY to convert a TTY number to a PTY number or PTYTTY to
convert a PTY number to a TTY.
>)
MOVX A,DV%ASN ;COPY THIS BIT TO USER
AND C,A ;ONLY THIS BIT
XCTU [ANDCAM A,2] ;CLEAR FROM USER
XCTU [IORM C,2] ;COPY
MOVE A,DEVUNT(B) ;Get assigner of PTY.
HLRZM A,DEVJOB ;Save it
SKIPGE A ;See if it's a real job index
IFSKP. ;Skipped, so there's a real job index
HLRZ A,A ;Move job index from LH to RH
CALL LCL2GL ;Convert Local job index into job number
SKIPA ;No such job, so don't save it
MOVEM A,DEVJOB ;Save the global job number
ENDIF. ;Continue
MOVE A,DEVJOB ;Get back the job number to return
XCTU [HRLM A,C] ;RETURN IT TO USER.
MRETNG
DVCHR2: CAIE A,PTYDTB ;IS UNAVAILABLE DEVICE A PTY?
JRST DVCHR5 ;NO
PUSH P,B ;YES. SAVE AC
HRRZ B,DEVUNT(B) ;GET ITS UNIT #
ANDI B,DV%UNT
CAIN B,DV%UNT ;CHECK FOR -1
MOVEI B,-1 ;SET -1
CALL PTYTTY ;CONVERT TERMINAL NUMBER
MOVEI A,.TTDES(B) ;MAKE IT 400000+LINE NUMBER
POP P,B ;RESTORE DEVICE TABLE POINTER
JRST DVCHR3 ;GET UNIT OF TTY TO RETURN TO USER
DVCHR5: CAIE A,MTADTB ;IS THIS A MAGTAPE?
MRETNG ;No
XCTU [HRRZS 3] ;YES, MAKE IT ASSIGNED TO JOB 0
MRETNG
;ROUTINE TO OUTPUT A BYTE FROM ERSTR - COMPLETES QUIETLY IF
;ANY PROBLEMS
ERST9:: SKIPE C
SOJLE C,CPOPJ
CALL SAVAC
UMOVE JFN,1
CALL ERBOUT
SOS -NSAC(P)
TLNN JFN,-1 ;BYTE POINTER?
JRST ERST91 ;NO
UMOVEM JFN,1 ;YES, RETURN UPDATED STRING POINTER
MOVEI B,0 ;AND APPEND A NULL
XCTBU [IDPB B,JFN]
ERST91: CALL RESAC
RETSKP
ERBOUT: TRVAR <SAVJFN,SAVBYT> ;RESERVE LOCS TO SAVE THINGS
ERBOU1: MOVEM JFN,SAVJFN ;SAVE ORIGINAL JFN
CALL CHKJFN
RET
JFCL
JFCL
TQNE <ENDF>
JRST UNLCKF
TQNE <OPNF>
TQNN <WRTF>
JRST UNLCKF
MOVEM B,SAVBYT ;SAVE THE BYTE
CALL BYTOUA ;SEND OUT BYTE
JRST ERBOUW ;SERVICE ROUTINE WANTS TO BLOCK
MOVE B,SAVBYT ;RESTORE BYTE
CALL UNLCKF ;UNLOCK THE FILE
RETSKP ;GIVE SUCCESSFUL RETURN
ERBOUW: TQNE <ERRF> ;WAS IT AN ERROR?
JRST [ MOVE B,SAVBYT ;YES. GET BACK BYTE
CALLRET UNLCKF] ;AND DONE
CALL UNLDIS ;UNLOCK AND BLOCK
MOVE B,SAVBYT ;GET BACK BYTE
JRST ERBOU1 ;TRY AGAIN
;FIND FIRST FREE FILE PAGE
; CALL: A/PAGE #,, JFN
; FFFFP
; Return
; +1
; A/JFN,,PAGE #
; OR
; A/-1 IF NO FREE PAGES
.FFFFP::MCENT
FFFF0: HRRZ JFN,1 ;MOVE JFN INT BASE REG
CALL CHKJFN ;GO SEE IF IT'S A DISK FILE
RETERR() ;ERROR ("A" HAS THE CODE)
JFCL
RETERR(DESX4) ;TTY AND BYTE POINTER ARE NO GOOD
TQNE <ASTF> ;PARSE ONLY?
RETERR(DESX7)
TQNN <OPNF> ;IS THE FILE OPEN?
ERUNLK(FFUFX1) ;NOT OPEN
BLCAL. DSKOK,<P3> ;DISK?
ERUNLK(FFUFX2) ;NO.
TQNE <LONGF> ;IS IT A LONG FILE?
JRST FFFFPL ;YES - SPECIAL HANDLING
XCTU [ MOVS A,1] ;PUT INTO <JFN,,PAGE NUMBER>
TRNE A,777000 ;IS THIS A "LONG FILE" PAGE NUMBER
JRST FFFFPX ;YES - THEN IT'S THE FIRST FREE PAGE
HLL A,FILOFN(JFN) ;GET THE OFN. A1 NOW HAS OFN,,PAGE #
CALL FFFFF ;FIND THE FIRST FREE PAGE
ERUNLK(MONX02) ;SYSTEM OUT OF JSB FREE SPACE
FFFFPX: CAMN A,[-1] ;FREE PAGE NOT FOUND IN FILE
HRRI A,1000 ;YES - THEN PAGE IS IN "LONG FILE"
XCTU [ HRL A,1] ;GET THE JFN INTO RIGHT HALF
FFFPX1: UMOVEM A,1 ;PUT FREE PAGE NUMBER IN USER AC
CALL UNLCKF ;UNLOCK THE STRUCTURE
JRST MRETN ;RETURN TO CALLER
;HERE TO SCAN A LONG FILE INDEX BLOCK. THE BASIC PHILOSOPHY IS TO
;LOOK THROUGH THE SUPER INDEX BLOCK FOR VALID PAGE TABLE ENTRIES. WHENEVER
;ONE IS FOUND SUBROUTINE FFFFF: IS CALLED TO FIND A FREE PAGE IN
;THE PAGE TABLE. THE SEARCH CONTINUES TO FIRST FREE PAGE OR END OF FILE.
FFFFPL: XCTU [ HLRZ Q1,1] ;GET PAGE NUMBER
FFFFP1: MOVE Q3,Q1 ; AND SAVE
LSH Q3,-9 ;GET THE PAGE TABLE NUMBER
ADD Q3,FILLFW(JFN) ;INDEX INTO SUPER INDEX BLOCK
HRRZS Q3 ;ADDRESS ONLY
MOVE A,Q1 ;PUT PAGE NUMBER IN A FOR JUMP TO FFFFPX
SKIPN (Q3) ;DOES PAGE TABLE EXIST
JRST FFFFPX ;NO - THEN THIS IS THE PAGE
CALL JFNOF3 ;YES - GET <OFN,,PAGE NUMBER> INTO "A"
ERUNLK (MONX01) ;RETURN RESOURCES EXHAUSTED ERROR
CALL FFFFF ;SCAN THE PAGE TABLE FOR A FREE ENTRY
ERUNLK (MONX02) ;NO JSB FREE SPACE
CAMN A,[-1] ;WAS THE PAGE TABLE COMPLETELY FULL
JRST FFFFP3 ;YES - TRY NEXT PAGE TABLE
ANDI Q1,777000 ;ISOLATE SUPER INDEX BLOCK PAGE NUMBER
ADD A,Q1 ;ADD PAGE NUMBER OF FREE PAGE FOUND
JRST FFFFPX ;AND REPORT TO USER
FFFFP3: ADDI Q1,1000 ;BUMP TO NEXT PAGE TABLE
ANDCMI Q1,777 ;ELIMINATE TEH REGULAR PAGE NUMBERS
TLNN Q1,777777 ;DID WE BUMP PAST END OF SUPER INDEX BLOCK
JRST FFFFP1 ;NO - KEEP LOOKING
SETO A, ;;YES - NO FREE PAGES
JRST FFFPX1 ;JOIN COMMON EXIT
;ROUTINE TO MAP AND SCAN PAGE TABLE FOR FREE PAGE ENTRY - SUBROUTINE FOR .FFFFP
;ACCEPTS: A/ <OFN,,PAGE NUMBER>
;RETURNS: +1,NO FREE STORAGE
; +2, A/ -1 - NO FREE PAGE FOUND IN THIS PAGE TABLE
; A/ <0,,PAGE NUMBER> IF FREE PAGE FOUND
;EXAMINE EACH ENTRY IN THE PAGE TABLE. IF THE ENTRY IS ZERO THEN THE PAGE IS
;FREE. OTHERWISE CHECK FOR SHARED POINTER (THEY ALWAYS POINT TO EXISTING
;PAGES). IF SHARED GO TO NEXT ENTRY. IF IT'S INDIRECT CALL MRPACS: TO CHECK
;THE ENTRY OUT. NOTE ENTRIES OF THE FORM 124001,,0 ARE ASSUMED TO POINT TO
;FREE PAGES.
FFFFF: STKVAR <TEMPA,<TEMPB,2>>
MOVEM A,TEMPA ;SAVE OFN,,PAGE NUMBER
CALL ASGPAG ;GET A PAGE TO MAP THE PAGE TABLE INTO
RET ;NO MEMORY - RETURN AN ERROR
MOVE B,A ;CREATE ENTRY FOR SETMPG
HRLI B,100000 ;WHERE WE WANT PAGE TO BE MAPPED
HLRZ A,TEMPA ;JFN WHOSE TABLE WE WANT
CALL SETMPG ;MAP THE PAGE TABLE
HRRZ A,TEMPA ;GET STARTING PAGE NUMBER
ADDI A,(B) ;LOCATION OF DISK ADDRESS
FFFFF0: SKIPN (A) ;EMPTY?
JRST FFFFF2 ;YES, FOUND IT
MOVE C,(A) ;GET THE PAGE POINTER
CAMN C,[124001,,0] ;SPECIAL CASE INVALID PAGE POINTER?
JRST FFFFF2 ;YES - FOUND FREE PAGE
LOAD C,PTRCOD,C ;GET THE POINTER TYPE CODE
CAIE C,INDCOD ;IS IT AN INDIRECT POINTER?
JRST FFFFF3 ;NO - PAGE EXISTS - TRY NEXT PAGE
DMOVEM A,TEMPB ;SAVE ACCROSS THE CALL
MOVE A,TEMPA ;GET THE <OFN,,PAGE NUMBER>
CALL MRPACS ;GET THE PAGE ACCESS BITS (LIKE RPACS JSYS)
MOVE C,A ;MOVING "A" ALLOWS REGS TO BE RESTORED
DMOVE A,TEMPB ;RESTORE THE REGS
TXNN C,PA%PEX ;DOES THE PAGE EXIST
JRST FFFFF2 ;NO - THEN TELL CALLER
FFFFF3: CAIGE A,777(B) ;WHOLE PAGE TABLE SCANNED?
AOJA A,FFFFF0 ;NO, TRY NEXT ONE.
MOVEI A,0
CALL SETMPG ;UNMAP THE PAGE TABLE
HRRZ A,B
CALL RELPAG ;RELEASE THE PAGE
SETO A, ;INDICATE NO FREE PAGE FOUND IN PAGE TABLE
RETSKP
FFFFF2: MOVEM A,TEMPA ;SAVE
MOVEI A,0
CALL SETMPG ;UNMAP THE PAGE TABLE
HRRZ A,B
CALL RELPAG ;RELEASE THE PAGE
MOVE A,TEMPA ;RESTORE A
ANDI A,777 ;KEEP ONLY THE PAGE NUMBER
RETSKP
; Find first used file page
; Call: LH(1) ; Jfn
; RH(1) ; Page number to start with
; FFUFP
; Returns
; +1 ; Error
; +2 ; Success jfn.pn of first used page in 1
.FFUFP::MCENT
FFUF0: HLRZ JFN,1
CALL CHKJFN
RETERR()
JFCL
RETERR(DESX4) ; Tty and byte no good
TQNE <ASTF>
RETERR(DESX7)
TQNN <OPNF>
ERUNLK(FFUFX1) ; Not open
BLCAL. DSKOK,<P3> ;DISK?
ERUNLK(FFUFX2) ; Not disk
TQNE <LONGF>
JRST FFUFPL
UMOVE A,1
TRNE A,777000
ERUNLK(FFUFX3) ; Page beyond 777 of short can't exist
HLL A,FILOFN(JFN)
CALL FFUFF
JRST [ CAIN A,MONX02 ;[7196] Error, JSB full?
ERUNLK(MONX02) ;[7196] Yes, return error code to caller
ERUNLK(FFUFX3)] ;[7196] No pages in use error code
FFUFPX: XCTU [HRRM A,1]
CALL UNLCKF
UMOVE A,A ;GET THE ARG BACK
RPACS ;CHECK ACTUAL ACCESS
ERJMPR [RETERR ()]
TLNE 2,(1B5) ;EXISTS?
SMRETN ;YES, RETURN SUCCESS
XCTU [AOS 1,1] ;NO, GO TO NEXT PAGE
TRNE 1,777777 ;OFF END OF WORLD?
JRST FFUF0 ;NO, TRY AGAIN
RETERR(FFUFX3)
;FFUFP... EXTRA HAIR NEEDED FOR LONG FILE
FFUFPL: UMOVE A,1
HRRZS A
FFUFP1: MOVE B,A
LSH B,-9 ; Get ptt number
ADD B,FILLFW(JFN)
HRRZS B ; ADDRESS ONLY
SKIPE (B) ; Check for pt existence
JRST FFUFP2 ; Exists, scan it
FFUFP3: ADDI A,1000
ANDCMI A,777
TLNN A,777777
JRST FFUFP1
ERUNLK(FFUFX3)
FFUFP2: PUSH P,A
CALL JFNOF1 ; Get ofn.pn for this page
JRST [ POP P,A ;CLEAN UP THE STACK
ERUNLK (MONX01)] ;RETURN RESOURCES EXHAUSTED ERROR
CALL FFUFF ; Scan the pt for stuff
JRST [ MOVE B,A ;[7196] Something went wrong, save error
POP P,A ;[7196] Fix the stack
CAIN B,MONX02 ;[7196] Was error jsb full?
ERUNLK(MONX02) ;[7196] Yes
JRST FFUFP3]
POP P,B
ANDI B,777000
ADD A,B
JRST FFUFPX ; Success
;ROUTINE TO MAP AND SCAN PT FOR NON-0 PAGE
FFUFF: PUSH P,A
CALL ASGPAG ; Get a page to map the pt
JRST [ POP P,A
RETBAD (MONX02)] ;[7196] No JSB free space
MOVE B,A
HRLI B,100000
HLRZ A,(P)
CALL SETMPG ; Map the pt
HRRZ A,(P) ; Get starting page number
ADDI A,(B) ; Location of disc address
FFUFF0: SKIPE (A) ; Empty?
JRST FFUFF1 ; No, found it
CAIGE A,777(B) ; Whole pt scanned?
AOJA A,FFUFF0 ; No, try next one.
FFUFF2: MOVEI A,0
CALL SETMPG ; Unmap the pt
HRRZ A,B
CALL RELPAG ; Release the page
POP P,A
RET
FFUFF1: ANDI A,777 ; Get pn part
MOVEM A,(P)
AOS -1(P) ; Skip return
JRST FFUFF2
; Get account of file
; Call: 1 ; Jfn
; 2 ; Core location to put string if any
; GACTF
; Return
; +1 ; Error
; +2
; +3 ; 5B2+number oR string pointer
.GACTF::MCENT
UMOVE JFN,1 ;GET JFN
CALL DSKJFN ;GRNTEE DISK JFN
RETERR ()
CALL GETFDB
ERUNLK(GACTX2)
LOAD B,FBACT,(A) ;GET THE ACCOUNT
JUMPG B,GACTF1 ;IS THIS A STRING?
UMOVEM B,2 ;NO
ULKDIR
CALL UNLCKF
AOS -1(P) ;DOUBLE SKIPPER
SMRETN ;...
GACTF1: ADD B,DIRORA ;GET ABS ADR OF STRING
LOAD A,ACTYP,(B) ;CHECK THE CONSISTENCY OF DIR
CAIE A,.TYACT ;IS THIS AN ACCOUNT STRING BLOCK
ERUNLK(GACTX3,<ULKDIR>) ;NO, BAD BLOCK TYPE IN DIR
CALL CPYXL ;COPY STRING TO USER SPACE
SMRETN ;GOOD RETURN
;COPY ACCOUNT/USER NAME BLOCK TO USER
; T2/ POINTER TO BLOCK
CPYXL: UMOVE T4,2 ;USERS POINTER IN 2
TLC T4,-1 ;CHECK FOR SPECIAL PNTR
TLCN T4,-1
HRLI T4,(<POINT 7,0>) ;FORM BYTE PNTR
MOVE T3,[POINT 7,2(2)] ;POINT TO TEXT IN BLOCK
CPYXL1: ILDB T1,T3 ;GET CHAR
JUMPE T1,CPYXL2 ;DONE IF ZERO
XCTBU [IDPB T1,T4] ;DEPOSIT IN USER SPACE
JRST CPYXL1 ;LOOP BACK FOR NEXT
CPYXL2: UMOVEM T4,2 ;UPDATE USER POINTER
XCTBU [IDPB T1,T4] ;DEPOSIT NULL
ULKDIR ;UNLOCK DIRECTORY
CALLRET UNLCKF ; AND JFN THEN RETURN
; Get device status
; Call: 1 ; Jfn
; GDSTS
; Returns
; +1 ; Error
; +2 ; Ok
.GDSTS::MCENT
GDSTS1: XCTU [HRRZ JFN,1] ;GET JFN
CALL CHKJFN
ITERR()
SKIPA ;ALLOW TTY JFNS
ITERR(DESX4)
MOVE A,STS
ANDI A,17
TQZE <BLKF> ;BLKF MUST BE ZERO BEFORE CALL
BUG.(CHK,BLKF4,JSYSF,HARD,<.GDSTS - BLKF set before call to device routine>,,<
Cause: The bit indicating that a device routine wishes to block has been
set before the call to the device routine has been made. This bit
must be set to zero before the call so we do not block needlessly
(maybe never to wake up).
Action: The bit is being cleared. If this problem persists, change the
BUGCHK to a BUGHLT and find out where BLKF is being set.
>)
TQNE <OPNF> ;DEVICE MUST BE OPENED TO GET STATUS
CALL @GDSTD(P3)
TQZE <BLKF> ;ROUTINE WANT TO BLOCK?
JRST GDSTSW ;YES, GO WAIT
UMOVEM A,2
JRST UNL
GDSTSW: CALL UNLDIS ;GO UNLOCK AND DISMIS
JRST GDSTS1 ;TRY AGAIN
; GET FILE USER STRING
;
; CALL: 1/ FUNCTION ,, JFN
; 2/ DESTINATION POINTER
; GFUST
; RETURNS: +1 ALWAYS, DESTINATION POINTER UPDATED
.GFUST::MCENT ;MONITOR CONTEXT ENTRY
STKVAR <GFUFDA,GFUBLK,GFUERR>
; CHECK FUNCTION CODE
XCTU [HLRZ T3,1] ;GET FUNCTION CODE FROM USER
CAIE T3,.GFAUT ;IS FUNCTION "GET AUTHOR" ?
CAIN T3,.GFLWR ; OR "GET LAST WRITER" ?
SKIPA ;YES, EVERYTHING KOSHER
ITERR (GFUSX1) ;NO, REFUSE TO PROVIDE FURTHER SERVICE
; GET DIRECTORY NUMBERS FROM FDB AND OBTAIN SPACE FOR STRING
XCTU [HRRZ JFN,1] ;GET JFN FROM USER
CALL DSKJFN ;GRNTEE JFN ON DISK
ITERR ()
CALL GETFDB ;GET FDB ADRS
ITERR (GFUSX3,<CALL UNLCKF>)
MOVEM T1,GFUFDA ;SAVE FOR LATER
LOAD T2,FBVER,(T1) ;GET FDB VERSION
CAIGE T2,1 ;VER #1 OR LATER?
JRST GFUS10 ;VERSION #0 SPECIAL
XCTU [HLRZ T3,1] ;GET FCN AGAIN
LOAD T2,FBAUT,(T1) ;ASSUME AUTHOR
CAIE T3,.GFAUT ;WAS IT
LOAD T2,FBLWR,(T1) ;NO - GET LAST WRITE
JUMPE T2,[MOVEI T2,[EXP 0,0,0] ;DUMMY BLOCK IF NONE
JRST GFUS05] ;RETURN USER A NULL
ADD T2,DIRORA ;RELOCATE POINTER
LOAD T1,UNTYP,(T2) ;GET TYPE FIELD
CAIE T1,.TYUNS ;USER NAME STRING?
ITERR (GFUSX4,<CALL USTDIR
CALL UNLCKF>) ;SOMETHING WRONG
GFUS05: CALL CPYXL ;COPY STRING TO USER SPACE
JRST MRETN ;RETURN
GFUS10: MOVEI T2,MAXLW+1 ;GET LENGTH OF BLOCK REQUIRED
CALL ASGJFR ;ASSIGN JSB FREE SPACE FOR STRING
ITERR (GFUSX2,<CALL UNLCKF
CALL USTDIR>) ;NO ROOM IN JSB
MOVEM T1,GFUBLK ;SAVE ADDRESS OF BLOCK ASSIGNED
; TRANSLATE REQUESTED DIRECTORY NUMBER TO STRING
HRROI T1,1(T1) ;FORM POINTER TO WHERE STRING SHOULD GO
SETZM (T1) ;FORM NULL STRING TO BE RETURNED IN THE CASE
; THE AUTHOR/LAST-WRITER DOES NOT EXIST
XCTU [HLRZ T3,1] ;GET FUNCTION CODE FROM USER AGAIN
MOVE T4,GFUFDA ;GET FDB ADDRESS
LOAD T2,FBAT0,(T4) ;ASSUME AUTHOR STRING DESIRED
CAIE T3,.GFAUT ;WAS AUTHOR REQUESTED ?
LOAD T2,FBLW0,(T4) ;NO - GET LAST-WRITER INSTEAD
ULKDIR ;UNLOCK DIRECTORY
CALL UNLCKF ;UNLOCK JFN
JUMPE T2,GFUS20 ;NO AUTHOR/LAST-WRITER EXISTS, RETURN A NULL
HRLI T2,USRLH ;ASSUME THE PUBLIC STRUCTURE
DIRST ;TRANSLATE TO STRING
JRST [ CAIE T1,STRX06 ;NO SUCH USER #
CAIN T1,DIRX1 ; OR INVALID DIRECTORY NUMBER ?
JRST GFUS20 ;YES, RETURN A NULL
MOVEM T1,GFUERR ;FAILED, SAVE ERROR CODE
MOVEI T1,JSBFRE ;GET FREE HEADER
MOVE T2,GFUBLK ;GET ADDRESS OF BLOCK
CALL RELFRE ;RELEASE SPACE FOR STRING
OKINT ;PERMIT INTERRUPTS AGAIN
MOVE T1,GFUERR ;RETRIEVE ERROR CODE
ITERR ()] ;GIVE ERROR NOTICE TO USER
GFUS20: UMOVE T1,2 ;GET DESTINATION POINTER
MOVE T2,GFUBLK ;GET ADDRESS OF BLOCK CONTAINING STRING
CALL CPYTUS ;RETURN STRING TO USER
MOVEI T1,JSBFRE ;GET FREE HEADER
MOVE T2,GFUBLK ;GET ADDRESS OF BLOCK
CALL RELFRE ;RELEASE SPACE USED TO HOLD STRING
OKINT ;PERMIT INTERRUPTS AGAIN
JRST MRETN ;GIVE USER SUCCESS RETURN
;GTFDB - RETURNS WORDS FROM A FILE'S FDB
;CALL: 1/ JFN
; 2/ LH: NUMBER OF WORDS TO READ, RH: OFFSET OF FIRST WORD
; 3/ LOCATION TO STORE WORDS
;
;RETURNS +1 IF SUCCESSFUL, ITRAPS ON ERRORS.
;IF THE FDB IS SHORTER THAN THE MAXIMUM SIZE OF AN FDB, ZERO WORDS
;ARE RETURNED FOR THE WORDS OFF THE END OF THE FDB.
.GTFDB::MCENT ;JSYS ENTRY
STKVAR <GTFADR,GTFBEG,GTFEND,GTFZER> ;ALLOCATE VARIABLES
MOVEM T3,GTFADR ;REMEMBER ADDRESS TO STORE DATA INTO
HRRZM T2,GTFBEG ;SAVE BEGINNING OFFSET INTO FDB
HLRZ T4,T2 ;GET WORD COUNT BY ITSELF
MOVE T1,GTFBEG ;GET BEGINNING OFFSET
CAIL T1,.FBLEN ;MAKE SURE IT ISN'T TOO LARGE
ITERR(GFDBX1) ;YES, ERROR
ADDI T1,-1(T4) ;COMPUTE LARGEST FDB ENTRY WANTED
SKIPE T4 ;MAKE SURE COUNT IS POSITIVE
CAIL T1,.FBLEN ;AND OFFSET NOT TOO LARGE
ITERR(GFDBX2) ;NO, ERROR
MOVEM T1,GTFEND ;SAVE ENDING OFFSET
MOVE T1,GTFADR ;GET ADDRESS OF USER'S BLOCK
XCTU [MOVES 0(T1)] ;MAKE SURE IT IS WRITABLE
ADDI T1,-1(T4) ;GET ADDRESS OF END OF BLOCK
XCTU [MOVES 0(T1)] ;MAKE SURE IT IS WRITABLE TOO
UMOVE JFN,1 ;GET JFN
CALL CHKFIL ;MAKE SURE IT IS A FILE
ITERR() ;ILLEGAL
TQNE <ASTF> ;SEE IF PARSE ONLY
ITERR(DESX7,<CALL UNLCKF>) ;YES, ERROR
BLCAL. DSKOK,<P3> ;DISK?
ITERR(GFDBX1,<CALL UNLCKF>) ;IF NOT, NOT LEGAL FOR THIS DEVICE
LOAD A,STR,(JFN) ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063](T1/T1)Is structure offline?
ITERR(,<CALL UNLCKF>) ;[7.1063]Return "Structure is offline"
CALL GETFDB ;GET POINTER TO THE FDB
ITERR(DESX3,<CALL UNLCKF>) ;FAILED
MOVE T2,T1 ;PUT FDB ADDRESS IN RIGHT AC
LOAD T1,FBLEN,(T1) ;GET FIRST ILLEGAL OFFSET FOR THIS FDB
MOVEM T1,GTFZER ;REMEMBER WHERE WE HAVE TO ZERO LATER
MOVE T1,GTFEND ;GET LAST WORD WANTED OF FDB
CAML T1,GTFZER ;WANTS DATA OFF OF THE END OF THE FDB?
SOS T1,GTFZER ;YES, LIMIT IT TO LAST LEGAL WORD
SUB T1,GTFBEG ;COMPUTE DIFFERENCE BETWEEN START AND END
AOJLE T1,GTFD2 ;CREATE NUMBER OF WORDS AND SKIP IF NONE
ADD T2,GTFBEG ;ADD OFFSET TO FDB ADDRESS
MOVE T3,GTFADR ;GET ADDRESS TO BLT TO
CALL BLTMU1 ;COPY SOME OF THE FDB TO THE USER
GTFD2: CALL USTDIR ;UNLOCK THE DIRECTORY
CALL UNLCKF ;AND THE JFN
; ..
;NOW ZERO WORDS WHICH THIS FDB WAS NOT LONG ENOUGH TO CONTAIN.
GTFDB3: AOS T1,GTFZER ;ADVANCE TO NEXT WORD
CAMLE T1,GTFEND ;WANTS ANOTHER WORD OFF END OF FDB?
MRETNG ;NO, ALL DONE
SUB T1,GTFBEG ;YES, COMPUTE OFFSET IN USERS BLOCK
JUMPL T1,GTFDB3 ;NOT UP TO BLOCK YET, GO ON
ADD T1,GTFADR ;ADD ADDRESS OF BLOCK
XCTU [SETZM 0(T1)] ;CLEAR THE WORD
JRST GTFDB3 ;CONTINUE
; Get open file status
; Call: 1 ; Jfn
; GTSTS
; Return
; +1
; 2 ; Status word as in filsts
.GTSTS:: MCENT
UMOVE JFN,1 ;FETCH THE USER'S JFN
CALL CHKJFD ;CHECK IT OUT, GET FILSTS TO STS
JRST GTSTS1 ;ILLEGAL, RETURN ZERO
JFCL ;TTY, SAME AS
SETZM STS ;BYTE POINTER, RETURN ZERO
CALL UNLCKF ;DON'T NEED THE FILE ANY MORE
TXNN STS,NAMEF ;JFN ASSIGNED?
GTSTS1: SETZM STS ; NO, BE SURE ALL OTHER BITS CLEAR TOO
ANDX STS,DOCSTS ;KEEP JUST THE DOCUMENTED BITS
UMOVEM STS,2 ;RETURN THEM TO THE USER
MRETNG ;AND DONE
; Initialize directory
; Call: 1 ; Device designator
; INIDR
; Return
; +1 ; Error
; +2 ; Ok
.INIDR::MCENT
TLO A,(1B3) ;SAY MOUNT WITHOUT READING DIRECTORY
MOUNT ;MAKE SURE FRESHLY MOUNTED
RETERR() ;COULDN'T MOUNT
UMOVE A,1 ;GET DEVICE DESIGNATOR
CALL CHKDEV
RETERR()
HRRZ P3,DEV ;SET UP ADDRESS ONLY
TLNN C,(1B8)
RETERR(DEVX3) ; Not mounted
CALL @INDD(P3)
RETERR() ;FAILED
SMRETN
; Convert jfn to string
; Call: 1 ; Jfn
; 2 ; String pointer
; 3 ; Format specification (see jsys manual)
;Nota bene - Because of a bug that existed in JFNS%, things have been
;changed so that JFNS% uses the FILLCK and JFNLCK all the way through.
;It releases these locks at various points so that inopportune page
;faults don't hang the job. I don't believe there are other places
;in the monitor that rely on both the JFNLCK and FILLCK. If there are
;then deadly embraces could occur. But hung jobs are better than
;BUGHLTs. JFNS% LOCKs the JFNLCK first, then LOCKs the FILLCK in all
;cases.
MSKSTR JS%T1,Q1,1B0 ;LOCAL FLAG - PUNCTUATE NULL EXTENSION
MSKSTR JS%T2,Q1,1B1 ;LOCAL FLAG - MULTIPLE DIR DEV
MSKSTR JS%T3,Q1,1B2 ;LOCAL FLAG - SUPPRESSING LEADING TAB
.JFNS:: MCENT
UMOVE A,3 ;GET BITS
TRNE A,1B26 ;IS AC2 JFN OR STRING POINTER?
JRST JFNX0 ;STRING
NOINT ;[8801] No interruptions while we have the JFNLCK
LOCK JFNLCK ;[8801] Get JFN lock
HRRZ JFN,2
CALL CHKJFD ;[8801] (JFN/) Check the JFN for real
ITERR ,<CALL JFSDN1> ;[8801] Release lock, OKINT
JFCL
ITERR DESX4,<CALL JFSDN1> ;[8801]
DMOVE A,FILSTS(JFN) ;[8801] Get file status words
TXNE A,ASGF ;[8801] JFN being assigned?
TXNN B,ASGF2 ;[8801] Make sure ASGF and not BLKF
SKIPA ;[8801] Must be BLKF or not assigning
ITERR DESX3,<CALL JFSDUN> ;[8801] Act like JFN not assigned
UMOVE A,1 ;Retrieve user's destination designator
TLNN A,777777 ;See if in -1,,xxx form
JRST JFNSZ ;Not byte pointer
TLC A,777777 ;It is a byte pointer,
TLCN A,777777 ;So make 7-bit byte pointer
HRLI A,440700 ;-1 in lh, fill in
SETZ B,
UMOVEM A,1 ;Return byte pointer to user
CSKED ;[8820] Be critical
UNLOCK JFNLCK ;[8820] Give up JFNLCK briefly
UNLOCK FILLCK(JFN) ;[8829] And file lock
XCTBU [IDPB B,A] ;Deposit initial null in case
ECSKED ;[8820] Not critical anymore
LOCK JFNLCK ;[8820] Hopefully get this back without changes
LOCK FILLCK(JFN) ;[8829] Get back the file lock
JFNSZ: XCTU [HLLZ F1,2]
XCTU [SKIPN Q3,3]
MOVE Q3,[6B2!2B5!1B8!1B11!2B14!JS%ATR!JS%PSD!JS%PAF]
SETZ Q1, ; Initialize tab flag
LOAD A,FLNOD,(JFN) ;SEE IF A NODE SPECIFIED IN THIS JFN
IFN. A
;DO NODE AND DEVICE FIELD WHEN NODE IS PRESENT IN FILE SPEC
LDB D,[POINT 1,Q3,0] ;YES, USE BIT FROM DEVICE FIELD CONTROL
CAIN D,0 ;print node name ?
IFSKP.
CALL TAB4 ;Yes. begin node field
UNLOCK JFNLCK ;[8820] Free JFN lock
UNLOCK FILLCK(JFN) ;[8829] And file lock
CALL JFNSS ;PRINT NODE NAME
LOCK JFNLCK ;[8820] Get the lock back
LOCK FILLCK(JFN) ;[8829] This one too
MOVEI B,PNCNOD ;PRINT NODE PUNCTUATION
CALL PUNCT
CALL PUNCT
ENDIF.
TQO <JS%T1,JS%T2> ;punc. null ext. & mult. dir device
LDB D,[POINT 2,Q3,2] ;now do the device field (2 bits)
CALL TAB4 ;BEGIN DEVICE FIELD
CAIN D,0 ;print device name ?
IFSKP.
HLRZ A,FILDDN(JFN) ;YES. GET THE DEVICE NAME STRING TO PRINT
UNLOCK JFNLCK ;[8820] Free JFN lock
UNLOCK FILLCK(JFN) ;[8829] And this too
CALL JFNSS ;Output the string in a
LOCK JFNLCK ;[8820] Get this back
LOCK FILLCK(JFN) ;[8829] And this too
MOVEI B,":"
CALL PUNCT
ENDIF.
ELSE.
;...
;DO DEVICE FIELD WHEN NO NODE IS PRESENT IN FILE SPEC
TXZ Q3,JS%NOD ; null out node bit
HLRZ A,FILDDN(JFN) ; Get pointer to device block
MOVN B,(A)
HRLI A,-2(B)
CALL DEVLUX
SETZ A,
MOVE C,DEVUNT(B) ;GET PSEUDO-DEVICE FLAG
CAME C,[-1] ;NO UNITS?
TXNN C,DV%PSD ;PSEUDO-DEVICE?
TLNE A,(DV%DIR)
TQOA JS%T1
TQZ JS%T1
TQNE <ASTF> ;PARSE-ONLY?
TQO JS%T1 ;YES, ALWAYS PUNCTUATE EXTENSION
CAME C,[-1] ;NO UNITS?
TXNN C,DV%PSD ;PSEUDO-DEVICE?
TLNE A,(DV%MDD)
TQOA JS%T2
TQZ JS%T2
CALL GTCSCD ; GET THE STRUCTURE UNIQUE CODE
HLRZ C,A ; OF THE CURRENT CONNECTED STR
LDB D,[POINT 3,Q3,2] ; Get format control byte for device
CALL TAB4
JUMPE D,JFNS0 ;GO ON IF NO PRINT WANTED
TQNE <STRSF> ;WILD DEVICE?
IFSKP.
LOAD A,FLUC,(JFN) ; GET THE UNIQUE CODE OF THE DEV
CAIN D,2 ; If it is suppress system default
CAME A,C ; AND IS THE DEVICE THE CONNECTED STR?
IFSKP. <JRST JFNS0> ;YES, DON'T PRINT
HLRZ A,FILDDN(JFN) ; GET THE DEVICE NAME STRING TO PRINT
UNLOCK JFNLCK ;[8820] Release this temporarily
UNLOCK FILLCK(JFN) ;[8829] And this
CALL JFNSS ; Output the string in a
LOCK JFNLCK ;[8820] Now get it back
LOCK FILLCK(JFN) ;[8829] Ditto
ELSE.
MOVEI B,[ASCIZ/DSK*/]-1 ;YES, POINT AT WILD STRING
CALL JFSTA1 ;OUTPUT IT
ENDIF.
MOVEI B,":"
CALL PUNCT
ENDIF.
; ..
;DO DIRECTORY FIELD
JFNS0: LOAD A,FLDNO,(JFN) ;GET DIRECTORY NUMBER
LDB D,[POINT 3,Q3,5] ; And format control
CALL TAB4 ; Tab before field if desired
TQNE <DIRSF>
JRST JFNS0A
CAIE D,2 ; If suppressing default,
IFSKP.
LOAD T1,JSCDF ;CONNECTED DIRECTORY STRING VALID FLAG
SKIPN T1 ; SKIP IF STRING EXISTS IN JSB
CALL JFNSCD ; ELSE TRY TO SET ONE UP
JE JSCDF,,JFNS0A ;IF NO VALID NAME STRING IN JSB, PRINT DIR
LOAD A,JSCDS ;GET ADR OF CONNECTED DIR STRING
HRLI A,(POINT 7,0,35)
LOAD B,FLDIR,(JFN) ;GET ADR OF DIR NAME STRING
JUMPE B,JFNS1 ;IF NO DIR NAME, DONT OUTPUT IT
HRLI B,(POINT 7,0,35)
CALL STRCMP ;COMPARE THE STRINGS
SKIPA ;THE STRINGS DONT MATCH, GO OUTPUT DIR
JRST JFNS1 ;THEY MATCH, DO NOT OUTPUT THE DIR NAME
ENDIF.
JFNS0A: LDB D,[POINT 3,Q3,5] ; GET format control
CAIN D,0 ; if no print is wanted
JRST JFNS1 ; Then don't print
LOAD B,FLDIR,(JFN) ; GET POINTER TO DIRECTORY STRING
TQNN <DIRSF> ; IF STARS, GO RETURN THE WILD STRING
JUMPE B,JFNS1 ; IF NONE, DONT TRY TO OUTPUT IT
MOVEI B,"<"
CALL PUNCT ; Print punctuation if desired
TQNN <DIRSF> ;Directory wild?
IFSKP. ;If so,
LOAD B,FLDMS,(JFN) ;Get wild mask
CALL JFSTA1 ;(B/) Go do it or a star
JRST JFNS0B
ENDIF.
LOAD A,FLDIR,(JFN) ; GET POINTER TO DIRECTORY STRING
JUMPE A,JFNS0B ; IF NONE, DONT TRY TO OUTPUT IT
UNLOCK JFNLCK ;[8820] Don't cause problems
UNLOCK FILLCK(JFN) ;[8829] Here either
CALL JFNSSD ; Copy string to output
LOCK JFNLCK ;[8820] Get the lock back
LOCK FILLCK(JFN) ;[8829] This one too
JFNS0B: MOVEI B,">"
CALL PUNCT ; And output terminating punct
;DO NAME FIELD
JFNS1: HLRZ A,FILNEN(JFN) ;Get location of file name block
LDB D,[POINT 3,Q3,8] ;And output control
JUMPE D,JFNS2 ;[7276] No print wanted
CALL TAB4 ;Tab before field if required
TQNN <NAMSF> ;Star in name field?
IFSKP. ;If so,
LOAD B,FLNMS,(JFN) ;Get name wild mask
CALL JFSTA1 ;(B/) Print it or a star
JRST JFNS2
ENDIF.
UNLOCK JFNLCK ;[8820] Release this
UNLOCK FILLCK(JFN) ;[8829] Like wise for this
CALL JFNSS ; Copy string to output
LOCK JFNLCK ;[8820] Now get it back
LOCK FILLCK(JFN) ;[8829] And this one too
; ..
;DO EXTENSION FIELD
JFNS2: HRRZ A,FILNEN(JFN) ; Get location of extension block
LDB D,[POINT 3,Q3,11] ; And output control
JUMPE D,JFNS3 ;[7276] No print wanted
CALL TAB4 ; Tab before field if required
MOVEI B,"."
MOVE C,1(A) ; SEE IF THERE IS AN EXTENSION STRING
TLNN C,774000 ; IF NON-NUL STRING, TYPE OUT PUNCT.
TQNE JS%T1
CALL PUNCT ;Output punctuation if desired
TQNN <EXTSF> ;Extension wild?
IFSKP. ;If so,
LOAD B,FLEMS,(JFN) ;Get extension wild mask
CALL JFSTA1 ;(B/) Print it or a star
JRST JFNS3
ENDIF.
UNLOCK JFNLCK ;[8820] Drop JFN lock a second
UNLOCK FILLCK(JFN) ;[8829] And file lock
CALL JFNSS ;Copy to output
LOCK JFNLCK ;[8820] Quick, get it back
LOCK FILLCK(JFN) ;[8829] Don't forget this one
;DO VERSION
JFNS3: HRRE A,FILVER(JFN) ; Get version number
LDB D,[POINT 3,Q3,14] ; And output control
JUMPE D,JFNS4 ;[7276] No print wanted
CALL TAB4 ; Tab before field if required
TQNN <ASTF> ;HAD OUTPUT STARS?
IFSKP.
JUMPN A,DOJF3 ;YES. DO NON-ZERO VERSION
TXNE F1,VERSF!RVERF!HVERF!LVERF ;ANY SPECIALS?
JRST DOJF3 ;YES. DO THEM
ENDIF. ;No. Do last test
TQNN JS%T2
JRST JFNS4
DOJF3: MOVEI B,PNCVER
CALL PUNCT
MOVE B,A
MOVEI C,12
TQNN <VERSF>
IFSKP.
CALL JFSTAR
CALL JFSDUN ;[8801] (/) Unlock and OKINT
MRETNG
ENDIF.
TQNE <RVERF>
MOVNI B,0
TQNE <HVERF>
MOVNI B,1
TQNE <LVERF>
MOVNI B,2
CALL NOUTXX
; ..
;SAVE INFORMATION FOR ;A, ;P, ;T
JFNS4: TQNE <ASTF> ;STARS?
JRST JFNS44 ;YES. SKIP ALL DIRECTORY STUFF
BLCAL. DSKOK,<P3> ;DISK?
IFNSK.
CAIE P3,MTDTB ;AN MT?
IFSKP.
LDB D,[POINT 3,Q3,17] ;GET CTL BITS FOR PROTECTION
SKIPE D ;[7276]PRINT TAB?
CALL TAB4 ;DO TAB CONTROL
CALL MTGPRO ;GET PROTECTION
ANDN. A ;IF NONE, DONE
ANDN. D ;IF NO TYPEOUT, DONE
TXO A,5B2 ;MAKE SURE IT IS A NUMBER
CALL JFNSP ;AND DO IT
ENDIF.
CALL JFNSAT ;TYPE OUT ATTRIBUTES (IF ANY)
CALL JFSDUN ;[8801] (/) And unlock, OKINT
MRETNG ;DONE
ENDIF.
CALL GETFDB ;(/B) Get a pointer to the fdb
IFNSK. ;If no FDB
CALL JFNSAT ;TYPE OUT ATTRIBUTES (IF ANY)
CALL JFSDUN ;[8801] (/) Unlock and OKINT
MRETNG ;DONE
ENDIF.
PUSH P,.FBREF(A)
PUSH P,.FBWRT(A)
PUSH P,.FBCRV(A)
LOAD B,FBNPG,(A)
PUSH P,B
PUSH P,.FBCTL(A)
MOVE B,.FBACT(A) ; Get account
SETZ C, ; 0 words of string
TLNE B,700000 ; String account?
IFSKP.
ADD B,DIRORA ;GET ABSOLUTE ADR OF STRING
EXCH A,D ;SAVE A
LOAD A,ACLEN,(B) ;GET LENGTH OF STRING BLOCK
SUBI A,.ACVAL ;SKIP HEADER AND SHARE COUNT
HRL A,A ;TO BOTH HALVES
XMOVEI C,1(P) ;WHERE TO PUT STRING ON STACK
XMOVEI B,.ACVAL(B) ;WHERE TO GET STRING FOM
ADD P,A
PUSH P,A ;SAVE TO BEYOND STRING
PUSH P,C ;SAVE STACK POINTER (POINTER TO STRING
SOS 0(P)
CALL XBLTA ;DO BLT
EXCH D,A ;RESTORE
JRST JFNS43
ENDIF.
PUSH P,C ; Save size of string
PUSH P,B ; And account or pointer
JFNS43: MOVE D,DIRORA ; GET BASE ADR OF MAPPED DIR
LOAD D,DRDPW,(D) ; GET DEFAULT PROTECTION WORD
PUSH P,D ; PUT IT ON THE STACK
PUSH P,.FBPRT(A)
CALL USTDIR ; Unlock directory (done with it)
JFNS44: LDB D,[POINT 3,Q3,17]
SKIPE D ;[7276]PRINT TAB?
CALL TAB4
TQNN <ASTF> ;PARSE ONLY?
IFSKP.
SKIPE D ;YES. WANT OUTPUT OF PROTECTION?
SKIPN FILPRT(JFN) ;YES. HAVE ONE?
JRST JFNS5 ;NO. GIVE IT UP
JRST JFNS45 ;GO DO IT
ENDIF.
MOVE B,0(P)
CAIN D,2
CAME B,-1(P)
CAIN D,0
JRST JFNS5
; ..
;DO ;P
JFNS45: MOVE A,0(P) ;GET PROTECTION
TQNE <ASTF> ;PARSE ONLY?
MOVE A,FILPRT(JFN) ;YES. GET IT FROM JFN THEN
TXNE Q3,JS%PRO ;[7276]JS%PRO SET?
CALL JFNSP ;AND DO IT
;DO ;A
JFNS5: TQNN <ASTF> ; PARSE ONLY
SUB P,[XWD 2,2] ; Flush protection and def prot
LDB D,[POINT 3,Q3,20]
JUMPE D,JFNS6 ;[7276]PRINT FIELD?
CALL TAB4
CAIN D,2 ; WANT DEFAULT?
TQNE <ASTF> ; YES, AND NOT OUTPUT STARS?
JRST JFNS5A ; NO, PRINT OUT THE ACCOUNT STRING
MOVE A,[POINT 7,ACCTSR] ; GET A POINTER TO THE CURRENT ACCOUNT
MOVE B,0(P) ; GET POINTER TO THIS ACCOUNT STRING
JUMPL B,JFNS5A ; IF OLD STYLE NUMERIC ACCOUNT, GO PRINT IT
HRLI B,(POINT 7,0,35) ; OTHERWISE SET UP A BYTE POINTER
CALL STRCMP ; SEE IF THE STRINGS ARE EQUAL
SKIPA ; NO, GO OUTPUT IT
JRST JFNS6 ; THE ACCOUNT IS THE DEFAULT, DONT OUTPUT
JFNS5A: MOVEI B,PNCATT
CALL PUNCT
MOVEI B,"A"
CALL PUNCT
TQNE <ASTF> ; PARSE ONLY?
SKIPA A,FILACT(JFN) ; YES. GET IT FROM JFN THEN
MOVE A,(P) ; Get account or pointer
MOVEI C,^D10
SKIPE A ;IF ZERO, FORGET IT .
CALL JFNSN
;DO ;T
JFNS6: TQNN <ASTF> ;PARSE ONLY?
IFSKP. ;If JFN is parse only then
CALL JFNSAT ; output any linked attributes
CALL JFSDUN ;[8801] (/) Unlock JFNLCK and OKINT
MRETNG ; and exit since finished
ENDIF.
ADJSP P,-1 ; Flush account or pointer
POP P,C ; Get size of saved string
SUB P,C ; Flush string from stack
LDB D,[POINT 1,Q3,21]
POP P,B
TXNE B,FB%TMP
CAIN D,0
JRST JFNS6A
MOVEI B,PNCATT
CALL PUNCT
MOVEI B,"T"
CALL BOUTA
JFNS6A: LDB D,[POINT 1,Q3,29] ; Offline output bit
TXNE B,FB%OFF ; File offline?
CAIN D,0 ; And ;OFFLINE output requested?
JRST JFNS7 ; No
MOVEI B,PNCATT ; Yes
CALL PUNCT
MOVEI A,[ASCIZ /OFFLINE/]-1 ; String for output by JFNSS
UNLOCK JFNLCK ;[8820] Release this
UNLOCK FILLCK(JFN) ;[8829] And this
CALL JFNSS
LOCK JFNLCK ;[8820] Lock 'er up again
LOCK FILLCK(JFN) ;[8829] This one too
; ..
;DO SIZE IN PAGES
JFNS7: CALL JFNSAT ;OUTPUT THE ATTRIBUTES
LDB D,[POINT 1,Q3,22]
JUMPE D,JFNS8 ;[7276]PRINT FIELD?
CALL JFNCOM
CALL TAB4
MOVE B,0(P) ;GET SIZE
MOVEI C,^D10
CALL NOUTXX
;DO DATES
JFNS8: ADJSP P,-1
CALL TAB4 ;[7276]TAB OVER TO NEXT STOP
POP P,B ;GET .FBCRV
TRNE Q3,JS%CDR ;[7276]PRINT CREATION DATE?
CALL JFNDAT
TXNE Q3,JS%CDR ;[7276]PRINT TAB FOR NEXT FIELD?
CALL TAB4
POP P,B ;GET .FBWRT
TRNE Q3,JS%LWR ;[7276]PRINT LAST-WRITE DATE?
CALL JFNDAT
TXNE Q3,JS%LWR ;[7276]PRINT TAB FOR NEXT FIELD?
CALL TAB4
POP P,B ;GET .FBREF
TRNE Q3,JS%LRD ;[7276]PRINT LAST-READ DATE?
CALL JFNDAT
JFCL
CALL JFSDUN ;[8801] (/) Now really done!
MRETNG ;End of JFNS%
;LOCAL ROUTINE TO OUTPUT PROTECTION
; A/ PROTECTION
JFNSP: PUSH P,A ;SAVE PROTECTION
MOVEI B,PNCATT
CALL PUNCT ;DO PUNCT CHAR
MOVEI B,"P" ;GET PREFIX
CALL PUNCT ;DO IT AS WELL
POP P,A ;GET BACK PROTECTION WORD
MOVEI C,10 ;IN OCTAL
CALLRET JFNSN ;AND DO IT
;DO ATTRIBUTES
JFNSAT: STKVAR <JFNSAC,JFNSAA,JFNSAV>
TXNE Q3,JS%ATR ;WANT ALL ATTRIBUTES?
JRST JFNAT1 ;YES
TXNN Q3,JS%AT1 ;WANT ONE ATTRIBUTE?
RET ;NO, DO NOTHING
UMOVE A,4 ;YES, GET THE POINTER TO PREFIX
CALL CPYFUS ;(T1-T3/T1-T3) Copy string to monitor space
ITERR ,<CALL JFSDUN> ;[8817] (/) Failed, release things we own
MOVEM A,JFNSAA ;SAVE ADR OF STRING BLOCK
HRLI A,(POINT 7,0,35) ;SET UP A BYTE POINTER TO STRING
MOVEI B,PRFXTB ;SET UP TO LOOK FOR PREFIX
EXCH A,B
TBLUK% ;Look up prefix
ERJMP JFN1AE ;FAILED
TXNN B,TL%ABR!TL%EXM ;FOUND A MATCH?
JRST JFN1AE ;NO, ERROR
HRRZ B,0(A) ;GET THE PREFIX VALUE
ANDI B,PFXMSK ;GET JUST THE VALUE
LOAD A,FLATL,(JFN) ;GET POINTER TO START OF ATTRIBUTE LIST
JFN1A1: JUMPE A,JFN1AE ;IF NONE, GIVE ERROR RETURN
LOAD C,PRFXV,(A) ;GET PREFIX VALUE OF THIS ENTRY
CAMN C,B ;FOUND A MATCH YET?
JRST JFN1A2 ;YES, GO RETURN THE VALUE
LOAD A,PRFXL,(A) ;STEP TO NEXT ENTRY ON LIST
JRST JFN1A1 ;LOOP BACK TIL DESIRED ENTRY FOUND
JFN1A2: UNLOCK JFNLCK ;[8820] Don't hold this in a sensitive spot
UNLOCK FILLCK(JFN) ;[8829] Or this
CALL JFNSS ;GO RETURN THE STRING TO THE USER
LOCK JFNLCK ;[8820] Not sensitive any more
LOCK FILLCK(JFN) ;[8829] Get this back too
HRRZ B,JFNSAA ;GET ADDRESS OF TEMP STRING
MOVEI A,JSBFRE ;RETURN TEMP STRING
CALLRET RELFRE ;AND EXIT
JFN1AE: HRRZ B,JFNSAA ;RETURN THE TEMP STRING
MOVEI A,JSBFRE ;TO THE FREE POOL
CALL RELFRE ;(T1/) Release used freespace
ITERR GJFX40,<CALL JFSDUN> ;[8817] No such attribute error
;RETURN ALL ATTRIBUTES TO THE CALLER
JFNAT1: SETZB A,JFNSAC ;INITIALIZE THE COUNT OF ATTRIBUTES
JFNAT2: CALL GTNPFX ;GET THE NEXT PREFIX
RET ;NO MORE, RETURN
MOVEM A,JFNSAA ;SAVE THE ADDRESS OF THE BLOCK
LOAD B,PRFXV,(A) ;GET THE ATTRIBUTE PREFIX
CAIN B,.PFPWD ;IS THIS THE PASSWORD ONE?
TQNE <ASTF> ;YES. IS THIS PARSE-ONLY ?
TRNA ;NOT PASSWORD OR PARSE-ONLY - PRINT IT
JRST JFNAT3 ;PASSWORD AND NOT PARSE ONLY - DO NOT PRINT IT
MOVEI B,PNCATT ;GET THE STARTING PUNCTUATION
CALL PUNCT ;PUT ";" INTO CALLER'S STRING
MOVE A,JFNSAA ;GET BACK ADDRESS OF THE ATTRIBUTE
LOAD A,PRFXV,(A) ;GET THE PREFIX VALUE FROM BLOCK
CALL GTPFXS ;GET ADDRESS OF PREFIX STRING
RET ;COULD NOT FIND IT, JUST RETURN
MOVEM B,JFNSAV ;SAVE THE VALUE
UNLOCK JFNLCK ;[8820] Drop this
UNLOCK FILLCK(JFN) ;[8829] And this
CALL JFNSS ;OUTPUT THE PREFIX STRING
LOCK JFNLCK ;[8820] Now get it back
LOCK FILLCK(JFN) ;[8829] This too
MOVE C,JFNSAV ;GET BACK THE VALUE OF THE PREFIX
TRNE C,NOATRF ;IS THIS A NO VALUE ATTRIBUTE?
JRST JFNAT3 ;YES, DO NOT ADD ON A NULL VALUE
MOVEI B,PNCPFX ;GET PUNCTUATION OF PREFIX
CALL PUNCT ;OUTPUT THE ":"
HRRZ A,JFNSAA ;GET THE ADDRESS OF THE ATTRIBUTE BLOCK
UNLOCK JFNLCK ;[8820] Let go for a second
UNLOCK FILLCK(JFN) ;[8829] This one too
CALL JFNSS ;OUTPUT THE ATTRIBUTE VALUE
LOCK JFNLCK ;[8820] Keep them out again
LOCK FILLCK(JFN) ;[8829] Here too
JFNAT3: AOS A,JFNSAC ;STEP TO THE NEXT ATTRIBUTE
JRST JFNAT2 ;LOOP BACK TILL ALL ATTRIBUTES SEEN
;ROUTINE TO GET NEXT ATTRIBUTE ON CHAIN
;ACCEPTS IN A/ COUNT OF THE DESIRED BLOCK
; CALL GTNPFX
;RETURNS +1: NO MORE
; +2: ADDRESS OF BLOCK IN AC A
GTNPFX: MOVE D,A ;SAVE THE COUNT
LOAD A,FLATL,(JFN) ;GET START OF ATTRIBUTE CHAIN
GTNPF1: JUMPE A,R ;IF NO MORE, RETURN
SOSGE D ;FOUND THE DESIRED ENTRY?
RETSKP ;YES, RETURN WITH ADRRESS IN A
LOAD A,PRFXL,(A) ;STEP TO NEXT ITEM ON THE CHAIN
JRST GTNPF1 ;LOOP BACK TILL DESIRED ENTRY IS FOUND
;ROUTINE TO GET ADDRESS OF PREFIX STRING (FOR JFNSS)
;ACCEPTS IN A/ VALUE OF THE DESIRED PREFIX
; CALL GTPFXS
;RETURNS +1: NOT FOUND
; +2: A/ ADDRESS OF STRING BLOCK -1 (FOR JFNSS)
GTPFXS: HLRZ D,PRFXTB ;GET NUMBER OF ENTRIES IN PREFIX TABLE
MOVNS D ;BUILD AOBJN POINTER
HRLZS D
HRRI D,PRFXTB+1 ;POINT TO FIRST ENTRY IN TABLE
GTPFX1: HRRZ B,0(D) ;GET THE PREFIX VALUE
ANDI B,PFXMSK ;GET JUST THE VALUE
CAMN A,B ;FOUND IT YET?
JRST GTPFX2 ;YES
AOBJN D,GTPFX1 ;NO, LOOP BACK TIL FOUND
RET ;NOT FOUND
GTPFX2: HLRZ A,0(D) ;GET ADDRESS OF STRING
HRRZ B,0(D) ;GET PREFIX VALUE AND FLAGS
SOJA A,RSKP ;RETURN ADDRESS-1 FOR JFNSS
;[8801]
;JFSDUN - Routine called before returning to user mode from JFNS%.
;Basically, called to release JFNLCK and go OKINT.
;
; Call with:
; no arguments
; CALL JFSDUN
;
; Returns:
; +1 - Always, with JFNLCK unlocked and OKINT
JFSDUN: CALL UNLCKF ;(/) Unlock the FILLCK first
SKIPL FILLCK(JFN) ;[8831] Did FILLCK get unlocked?
UNLOCK FILLCK(JFN) ;[8831] No, make sure it is unlocked
JFSDN1: UNLOCK JFNLCK ;Unlock JFN lock
OKINT ;Interruptions are OK
RET
;JFNX
;SPECIAL STRING INPUT HANDLER TO PUT CORRECT PUNCTUATION AROUND
;THE STRING. PUNCTUATION USED IS THAT FOR THE FIRST NON-ZERO FIELD
;FOUND SCANNING FROM LEFT TO RIGHT
JFNX0: MOVE JFN,2
CALL CHKJFN
ITERR()
ITERR(DESX4)
JRST JFNX0A
CALL UNLCKF
ITERR(DESX1)
JFNX0A: UMOVE A,1
TLNN A,777777
JRST JFNX1 ; Not byte pointer
TLC A,777777
TLCN A,777777
HRLI A,440700 ; -1 in lh, fill in
SETZ B,
XCTBU [IDPB B,A] ; Deposit initial null in case
JFNX1: XCTU [HLLZ F1,2]
XCTU [MOVE Q3,3]
MOVEI B,11
TRNE Q3,3B34 ;EITHER TAB REQUEST?
CALL BOUTA ;YES, OUTPUT TAB
TXNE Q3,7B2 ;DEVICE?
JRST JFNXDA ;YES
TXNE Q3,7B5 ;DIRECTORY?
JRST JFNXDB ;YES
TXNE Q3,7B8 ;NAME?
JRST JFNXN ;YES
TXNE Q3,7B11 ;EXTENSION?
JRST JFNXE ;YES
TXNE Q3,7B14 ;VERSION?
JRST JFNXV ;YES
TXNE Q3,7B17 ;PROTECTION?
JRST JFNXP ;YES
TXNE Q3,7B20 ;ACCOUNT?
JRST JFNXA ;YES
TXNE Q3,1B21 ; ";T" ?
JRST JFNXT ;YES
TXNE Q3,JS%ATR!JS%AT1 ;ATTRIBUTES?
JRST JFNXAT ;YES
TXNE Q3,17B25 ;SIZE OR ANY DATE?
JRST JFNXSD ;YES
TXNE Q3,JS%OFL ;OFFLINE?
JRST JFNXOF
;DEVICE
JFNXDA: CALL JFNXDO ;COPY USER STRING
MOVEI B,":"
JRST JFNXX1 ; STORE PUNCTUATION AND EXIT
;DIRECTORY
JFNXDB: MOVEI B,"<"
CALL PUNCT
CALL JFNXDO
MOVEI B,">"
JRST JFNXX1
;SIZE OR DATE
JFNXSD: MOVEI B,","
TRNE Q3,1B32
CALL BOUTA
;NAME
JFNXN: CALL JFNXDO
JRST JFNXX2
;EXTENSION
JFNXE: MOVEI B,"."
JFNXE1: CALL PUNCT
JRST JFNXN
;VERSION
JFNXV: MOVEI B,PNCVER
JRST JFNXE1
;ACCOUNT
JFNXA: MOVEI B,PNCATT
CALL PUNCT
MOVEI B,"A"
JRST JFNXE1
;PROTECTION
JFNXP: MOVEI B,PNCATT
CALL PUNCT
MOVEI B,"P"
JRST JFNXE1
;OFFLINE
JFNXOF: MOVEI B,PNCATT
CALL PUNCT
MOVEI A,[ASCIZ /OFFLINE/]-1
UNLOCK JFNLCK ;[8820] Release the tension
UNLOCK FILLCK(JFN) ;[8829] This spot too
CALL JFNSS
LOCK JFNLCK ;[8820] Tighten the screws again
LOCK FILLCK(JFN) ;[8829] On this too
JRST JFNXX2
;TEMPORARY
JFNXT: MOVEI B,PNCATT
CALL PUNCT
MOVEI B,"T"
;END ROUTINE
JFNXX1: CALL PUNCT
JFNXX2: JRST MRETN
JFNXDO: CAIN JFN,377777 ;NIL?
RET ;YES, DONE
JFNXD1: XCTBU [ILDB B,JFN] ;GET BYTE FROM USER
JUMPE B,R ;END ON NULL
UMOVEM JFN,2 ;UPDATE BYTE POINTER
CALL BOUTA ;OUTPUT BYTE
JRST JFNXD1
;ROUTINE TO PUNCTUATE ATTRIBUTES
JFNXAT: MOVEI B,PNCATT ;ATTRIBUTE STARTING PUNCTUATION
CALL PUNCT ;OUTPUT THE ";"
CALL JFNXDO ;FOLLOWED BY THE PREFIX STRING
TXNN Q3,JS%AT1 ;DOES THIS HAVE A VALUE
JRST JFNXX2 ;NO, ALL DONE
MOVEI B,PNCPFX ;YES, OUTPUT THE PUNCTUATION
CALL PUNCT ; BETWEEN FIELDS
UMOVE JFN,4 ;SET UP POINTER TO VALUE STRING
TLC JFN,-1 ;SEE IF -1 IN LH
TLCN JFN,-1 ;...
HRLI JFN,(POINT 7,0) ;YES, SET UP BYTE POINTER
CALL JFNXDO ;OUTPUT THE STRING
JRST JFNXX2 ;ALL DONE
;LOCAL NUMBER OUTPUT ROUTINE FOR JFNS
;NOUTXX ALWAYS PRINTS NUMBER
;JFNSN TAKES A AS STRING POINTER IF POSITIVE, NUMBER (AFTER FLUSHING
; BITS 0-2) IF NEGATIVE
JFNSN: IFG. A ;[8820] If positive,
UNLOCK JFNLCK ;[8820] Drop this
UNLOCK FILLCK(JFN) ;[8829] And this
CALL JFNSS ;[8820] Output number
LOCK JFNLCK ;[8820] And lock this up again
LOCK FILLCK(JFN) ;[8829] This too
RET ;[8820]
ENDIF. ;[8820]
MOVE B,A
TLZ B,700000
NOUTXX::PUSH P,JFN
PUSH P,DEV
PUSH P,STS
PUSH P,F1
PUSH P,Q3
PUSH P,D
PUSH P,F
PUSH P,C
PUSH P,B
CALL NOUTX
JFCL
POP P,B
POP P,C
POP P,F
POP P,D
POP P,Q3
POP P,F1
POP P,STS
POP P,DEV
POP P,JFN
RET
;LOCAL ROUTINE FOR JFNS TO TRY TO SET UP CONNECTED DIRECTORY STRING
;IN JSB WHEN ABSENT. USES ACCES JSYS TO CONNECT TO CURRENTLY CONNECTED
;DIRECTORY.... (PRESENT BECAUSE ACCES JSYS FOR ANOTHER JOB CAN'T WRITE
;THE STRING INTO ANOTHER JOB'S JSB FREE SPACE)
JFNSCD: SAVEQ ;PRESERVE Q REGS
MOVX T1,AC%CON+3 ;CONNECT FUNCTION
MOVEI T2,Q1 ;ARGS IN Q1-Q3
MOVE Q1,JSBSDN ;CURRENTLY CONNECTED DIRECTORY
SETZM Q2 ;GIVE NO PASSWORD
SETOM Q3 ;-1=THIS JOB
ACCES ;AND DO IT
ERJMP .+1 ;IGNORE ERRORS
RET ;AND DONE
;LOCAL DATE PRINTER FOR JFNS
JFNDAT: PUSH P,B
MOVEI D,1
CALL JFNCOM
POP P,B
PUSH P,A
SETZ C,
HRROI A,1(P)
ADD P,[XWD 5,5] ;[7355]
UNLOCK JFNLCK ;[8820] Drop this for a second
UNLOCK FILLCK(JFN) ;[8829] This too
ODTIM
ERJMP .+1 ;[8820] Doesn't happen
MOVEI C,-4(P) ;[7355]
HRLI C,(<POINT 7,0>)
JFNDA1: ILDB B,C
IFE. B ;[8820] If null,
SUB P,[XWD 5,5] ;[8820] Adjust "STKVAR"
POP P,A ;[8820] Get back pointer
LOCK JFNLCK ;[8820] Lock things up
LOCK FILLCK(JFN) ;[8829] This too
RET ;[8820] And return
ENDIF. ;[8820]
CALL BOUTA
JRST JFNDA1
;PRINT COMMA IF D=TRUE AND Q3/B32=1
JFNCOM: MOVEI B,","
CAIE D,0
TRNN Q3,1B32
RET
UNLOCK JFNLCK ;[8820] Give this up briefly
UNLOCK FILLCK(JFN) ;[8829] This one too
CALL BOUTA ;[8820]
LOCK JFNLCK ;[8820] Get the lock back
LOCK FILLCK(JFN) ;[8829] This lock too
RET ;[8820] And go on
;PRINT MASK ADDRESSED BY B OR A STAR IF B IS ZERO
JFSTAR: SKIPA ;ALWAYS DO A STAR IF ENTERED HERE
JFSTA1: SKIPN B ;HAVE A MASK INSTEAD?
MOVEI B,[ASCIZ /*/]-1 ;NO. USE A STAR
HRLI B,(<POINT 7,0,35>) ;MAKE A STRING POINTER
STKVAR (MSKSAV) ;SAVE STRING PTR IN TEMP STORAGE
MOVEM B,MSKSAV ;SAVE B FOR NOW
UNLOCK JFNLCK ;[8820] Give up JFN lock a second
UNLOCK FILLCK(JFN) ;[8829] Same for FILLCK
JFLOP: ILDB B,MSKSAV ;TOP OF PRINT LOOP
IFE. B ;[8820] If at end,
LOCK JFNLCK ;[8820] Lock things up
LOCK FILLCK(JFN) ;[8829] Lock this too
RET ;[8820] And return
ENDIF. ;[8820]
CALL BOUTA ;OUTPUT THE BYTE
JRST JFLOP ;DO ALL OF STRING
;PRINT PUNCTUATION IF Q3/B35=1
PUNCT: TRNE Q3,1B35
IFSKP. <RET> ;[8820] If not set, return
UNLOCK JFNLCK ;[8820] Give this up
UNLOCK FILLCK(JFN) ;[8829] And this
CALL BOUTA ;[8820] Output character
LOCK JFNLCK ;[8820] And get the lock back
LOCK FILLCK(JFN) ;[8829] Ditto
RET
;PRINT TAB PER Q3/B33-34 IF D=TRUE
TAB4: MOVEI B,11 ;TAB
TRNE Q3,JS%TBP
CAIG D,0
TRNE Q3,JS%TBR
TQON JS%T3 ;Tab usage flag in Q1
RET
UNLOCK JFNLCK ;[8820] Give it up
UNLOCK FILLCK(JFN) ;[8829] And up
CALL BOUTA ;[8820] And slam a character
LOCK JFNLCK ;[8820] Get this back
LOCK FILLCK(JFN) ;[8829] And back
RET ;[8820] And return
;JFNSS AND JFNSSD - WRITE ASCII STRING
;ACCEPTS:
; A/ ADDRESS OF ASCII STRING, WHICH STARTS IN BYTE 0 OF THE WORD
; AND ENDS WITH A NULL
; CALL JFNSS TO PRECEDE ALL SPECIAL CHARACTERS WITH CTRL/V
; OR
; CALL JFNSSD TO PRECEDE ALL SPECIAL CHARACTERS BUT PERIOD WITH CTRL/V
;RETURNS +1: ALWAYS
;CALL BOUTA, WHICH USES USER MODE AC 1 TO DETERMINE DESTINATION OF
;STRING. TERMINATES ON NULL
JFNSSD::TDZA D,D ;INDICATE DOT SHOULD NOT GET CTRL/V
JFNSS:: SETOM D ;INDICATE DOT SHOULD GET CTRL/V
ACVAR <W1>
MOVE W1,D ;SAVE THE FLAG IN CASE BOUTA CLOBBERS IT
MOVE C,A ;GET ADDRESS OF STRING
HRLI C,(<POINT 7,0,35>) ;CONSTRUCT POINTER TO SOURCE
;LOOP THROUGH THE CHARACTERS IN THE STRING, PRINTING EACH ACCORDING
;TO ITS CHARACTER CLASS. CONTINUE UNTIL NULL IS FOUND.
JFNSS1: ILDB B,C ;GET NEXT CHARACTER
JUMPE B,R ;[8820] Done when we see a null
PUSH P,C ;GET A WORK AC
PUSH P,B ;SAVE THE CHARACTER
;DETERMINE THE CHARACTER CLASS FROM CHARACTER TABLES DEFINED IN GTJFN
;IF SPECIAL, PRINT CTRL/V BEFORE PRINTING THE CHARACTER
;IDIVI B,^D36/CCSIZE
MOVEI B,^D36 ; Have to do it the hard way cause
IDIVI B,CCSIZE ; Macro can't divide externals
MOVE C,B
MOVE B,0(P) ;GET THE CHARACTER
IDIV B,C ; And finally the real divide
LDB B,CPTAB(B+1) ;GET THE CHARACTER CLASS
JUMPE B,NTSPC ;0 IS NORMAL ALPHAS (EXCLUDES SOME LETTERS)
CAIN B,30 ; Minus sign not special
JRST NTSPC
CAIL B,21 ; Digits t, p, a
CAILE B,24
JRST [ CAIN B,14 ;IS THIS A DOT?
JUMPE W1,NTSPC ;YES. IF REQUESTED, DON'T INSERT CTRL/V
MOVEI B,"V"-100 ;OUTPUT CTRL/V
CALL BOUTA ; ACCORDING TO USER'S DESIGNATOR
JRST NTSPC] ;AND THEN GO DO THE CHARACTER
NTSPC: POP P,B ;GET THE CHARACTER
POP P,C
CALL BOUTA ;OUTPUT ACCORDING TO USER'S DESIGNATOR
JRST JFNSS1 ;GO GET THE NEXT CHARACTER
ENDAV. ;END ACVAR
; Mount device
; Call: 1 ; Device designator
; MOUNT
; Return
; +1 ; Error
; +2 ; Ok
.MOUNT::MCENT
UMOVE A,1
TLZN A,(1B3) ; Directory to be read?
TDZA B,B ; Yes
SETO B, ; No
PUSH P,B
CALL CHKDEV
RETERR()
UMOVE 1,1
TLZ 1,(1B3)
TLNE C,(DV%MNT) ; Already mounted?
JRST [ DSMNT ; Attempt to dismount first
RETERR() ; Error if can't
JRST .+1]
EXCH B,(P) ; Save b, get directory read flag
HRRZ P3,DEV ; GET ADDRESS ONLY
CALL @MNTD(P3) ; Call P3ice mount routine
RETERR() ;MOUNT ERROR
POP P,B
MOVSI C,(DV%MNT)
IORM C,DEVCHR(B) ; Mark device as mounted
SMRETN ;NO, DONE NOW
; Special file operation
; Call: 1 ; Jfn
; 2 ; Operation desired
; MTOPR
.MTOPR::MCENT
MTOPR1: UMOVE JFN,1
CALL CHKJFN
ITERR()
JRST .+2
ITERR(DESX4)
TQNE <OPNF>
JRST MTOPR2 ;OPENED PATH
CALL FNDUNT ;FIND DEVICE TABLE INDEX
MOVX B,D1%MTO ;Get "MTOPR allowed although not open" bit
TDNE B,DEVCH1(A) ; and test it
JRST MTOPR2 ;Yes, bit set for this device - allow MTOPR.
HLRZ C,DEVUNT(A) ;GET JOB #
MOVX B,DV%ASN ;ASSIGNED BIT
TDNE B,DEVCHR(A) ;DEVICE ASSIGNED?
CAME C,JOBNO ;BY THIS JOB?
ITERR(CLSX1,<CALL UNLCKF>)
MTOPR2: TQZ <ERRF,EOFF> ;OK TO PROCEED
UMOVE B,2
TQZE <BLKF> ;BLKF MUST BE ZERO BEFORE CALL
BUG.(CHK,BLKF5,JSYSF,HARD,<.MTOPR - BLKF set before call to device routine>,,<
Cause: The bit indicating that a device routine wishes to block has been
set before the call to the device routine has been made. This bit
must be set to zero before the call so we do not block needlessly
(maybe never to wake up).
Action: The bit is being cleared. If this problem persists, change the
BUGCHK to a BUGHLT and find out where BLKF is being set.
>)
XMOVEI C,MTOPRB ;PASS DOWN BLOCKAGE ROUTINE
CALL @MTPD(P3)
JRST [ TQZE <BLKF> ;ROUTINE WANT TO BLOCK?
JRST MTOPRW ;YES, GO BLOCK
CALL UNLCKF
ITERR()]
CALL UNLCKF
JRST MRETN
MTOPRW: CALL UNLDIS ;UNLOCK JFN AND DISMIS
JRST MTOPR1 ;LOOP BACK AND START AGAIN
;CO-ROUTINE USED TO PERFORM LOWER LEVEL BLOCK
MTOPRB: STKVAR <DEVSAV> ;SAVE DEV OF THIS DEVICE
MOVEM DEV,DEVSAV
CALL UNLDIS ;UNLOCK JFN ETC.
UMOVE JFN,1 ;GET USER JFN AGAIN
CALL CHKJFN ;VALIDATE IT
RETBAD () ;RETURN ERRORS
JRST .+2 ;TTY OK
RETBAD (DESX4)
CAME DEV,DEVSAV ;CHECK TO SEE THAT THIS IS THE SAME DEVICE
RETBAD (DESX4) ;NO SOMEONE CHANGED THINGS
RETSKP ;GIVE GOOD RETURN
; ROUTINE TO LOAD/STORE A WORD IN MTOPR FUNCTION BLOCK
;
; CALL: A/ OFFSET INTO FUNCTION BLOCK
; B/ VALUE TO BE STORED (IF ANY)
; CALL GETWRD/PUTWRD
; RETURNS: +1 ARGUMENT BLOCK TOO SMALL
; +2 SUCCESS, ARGUMENT STORED OR RETURNED IN B
PUTWRD::TDZA D,D ;FLAG STORE INSTEAD OF LOAD
GETWRD::SETOM D ;INDICATE FETCH REQUESTED
UMOVE C,3 ;GET ADDRESS OF USER'S ARGUMENT BLOCK
UMOVE C,(C) ;GET LENGTH OF ARGUMENT BLOCK
ERJMP R ;FAILED, NON-EXISTENT
CAML A,C ;ARGUMENT BLOCK BIG ENOUGH ?
RET ;NO, FAIL RETURN
UMOVE C,3 ;GET ADDRESS OF ARGUMENT BLOCK AGAIN
ADD C,A ;COMPUTE ADDRESS OF DESIRED WORD IN BLOCK
JUMPE D,PUTWD1 ;IF STORING GO PUT VALUE IN ARGUMENT BLOCK
UMOVE B,(C) ;FETCH WORD DESIRED
ERJMP R ;FAILED, NON-EXISTENT
RETSKP ;RETURN WITH REQUESTED VALUE
PUTWD1: UMOVEM B,(C) ;STORE VALUE IN ARGUMENT BLOCK
ERJMP R ;FAILED, NON-EXISTENT
RETSKP ;RETURN
; Open a file
; Call: 1 ; Job file number
; 2(0-5) ; Byte size
; 2(6-9) ; Data mode
; RH(2) ; Access flags (see jsys manual)
; OPENF
; Return
; +1 ; Cannot open file, error code in 1
; +2 ; Successful
.OPENF::MCENT ; Become slow, save ac's
TRVAR <UNTIDX> ;SAVE UNIT INDEX HERE
OPENF0: UMOVE JFN,1 ; Get jfn
CALL CHKJFN ; What kind of designator is this?
RETERR() ; Garbage designator
JRST OPENF1 ;DON'T ALLOW 400000+TERMINAL NUMBER
JRST [ CAIE DEV,STRDTB ; IS THIS A STRING POINTER
JRST OPENFZ ; NO, NUL DEVICE IS OK
ERUNLK (OPNX26)] ; YES, STRING POINTER IS ILLEGAL
UMOVE F1,2 ; Get access bits
TXNN F1,OF%RD+OF%WR+OF%EX+OF%APP
ERUNLK OPNX13 ;RETURN ERROR IF NO ACCESS REQUESTED
TQNE <OPNF>
ERUNLK OPNX1 ; Already open
TQNE <ASTF>
ERUNLK(DESX7) ; Output stars not allowed
LDB A,[POINTR F1,OF%BSZ] ;GET BYTE SIZE
SKIPN A ; ZERO SPECIFIED?
MOVEI A,^D36 ; YES, USE FULL WORD
CAILE A,^D36
ERUNLK SFBSX2
DPB A,PBYTSZ ; Store as byte size of pointer
CALL FNDUNT ;GET DEV INDEX FOR UNIT
MOVE C,DEVCHR(A) ;GET DEVICE BITS
TXNE C,DV%AS ;ASSIGNABLE DEVICE?
JRST [ HLRZ B,DEVUNT(A) ;GET CURRENT ASSIGNMENT
CAMN B,JOBNO ;ASSIGNED BY THIS JOB?
JRST .+1 ;YES. PROCEED
HRRZM A,UNTIDX ;SAVE UNIT INDEX HERE
HRR C,DEVUNT(A) ;GET UNIT
TLZ C,777000 ;REMOVE JUNK BITS
TLO C,.DVDES ;ADD BITS FOR DESIGNATOR
GTOKM (.GOOAD,<C>,[ERUNLK ()],OPENB)
MOVE B,UNTIDX ;RECOVER UNIT INDEX
MOVE C,DEVCHR(B) ;RESTORE MODE BITS AS WELL
UMOVE F1,2 ;RECOVER ACCESS BITS AS WELL
CALL DEVAV ;DEVICE AVAILABLE?
ERUNLK(OPNX7) ;NO
JRST .+1] ;YES
LDB A,[POINTR F1,OF%MOD];GET MODE
MOVN D,A
ROT C,-1(D)
JUMPGE C,[ERUNLK(OPNX14)] ; Illegal mode
STOR (A,IOMODE) ;SAVE IO MODE
;..
;..
ANDX STS,<NAMEF+NONXF+ASTF+FRKF+.RTJST(OF%MOD,OF%MOD)> ;KEEP ONLY THESE BITS
TXNE F1,OF%HER ;MOVE CALLER BITS TO INTERNAL PLACE
TXO STS,HLTF
TXNE F1,OF%RD
TXO STS,READF
TXNE F1,OF%WR
TXO STS,WRTF
TXNE F1,OF%EX
TXO STS,XCTF
TXNE F1,OF%APP
TXO STS,RNDF
TXNN F1,OF%PLN ;USER WANT LINE NUMBERS?
TXNE F1,OF%WR!OF%EX!OF%APP;WRITING OR EXECUTING?
TQO <PASLSN> ;THEN THIS ISN'T A LINE #D FILE
LDB A,[POINTR F1,OF%BSZ]
CAIE A,7 ;IF THE FILE ISN'T ASCII,
TQO <PASLSN> ;THEN IT CAN'T HAVE LINE NUMBERS TO REMOVE
BLCAL. DSKOK,<DEV>
IFNSK.
CAIE A,MTADTB ;NO, MAGTAPE?
CAIN A,DTADTB ; AND DECTAPE
ANSKP.
TQO <PASLSN> ;ALL OTHERS DON'T NEED EXAMINING
ENDIF.
SETZM FILCNT(JFN)
XMOVEI C,OPENB ;OPEN BLOCK ROUTINE
CALL @OPEND(P3) ; Call the DEVIce dependent routine
;N.B. BITS IN F1 USED BY DSK!!!
JRST OPENR ; Cannot open
TQO <OPNF> ; Success
MOVSI B,1
HLLM B,FILLFW(JFN)
CALL FNDUNT ;GET DEV INDEX
MOVE B,DEVCHR(A) ;GET DEVICE BITS
TXNN B,DV%AS ;ASSIGNABLE DEVICE?
JRST OPENFZ ;NO
CALL CKJFTT ;IS THIS THE JFN FOR 'TTY'?
JRST OPENFZ ;YES. DON'T CHANGE DEVICE TABLES
MOVE B,JOBNO ;NO, ASSIGN IT TO THIS JOB
HRLM B,DEVUNT(A)
MOVX B,DV%OPN
IORM B,DEVCHR(A) ;NOTE ASSIGNED BECAUSE OF OPEN
MOVEI A,0(DEV) ;SEE WHAT THIS DEVICE IS
CAIN A,PTYDTB ;IS IT A PTY?
CALL PTYINI ;YES. GO INIT TTY PARAMETERS THEN
OPENFZ: CALL UNLCKF
SMRETN
;HERE IF GTOKM INDICATED BLOCK
;
OPENR: TQZE <BLKF> ;WANT TO BLOCK?
JRST OPENFW ;YES - WAIT
CAIN A,OPNX31 ; Offline?
JRST RETFIL ; Yes, handle that case
CAIE A,OPNX9 ;BUSY?
ERUNLK() ;NO, SOME OTHER ERROR
UMOVE B,2 ;GET USER'S BITS AGAIN
TRNN B,OF%NWT ;"NEVER WAIT"?
TRNN B,OF%AWT ;OR NO "ALWAYS WAIT"?
ERUNLK() ;YES, ERROR OUT
CALL UNLCKF ;"ALWAYS WAIT" AND NO "NEVER WAIT", THEREFORE WAIT
SETZM INTDF
XCT INTDFF
MOVEI A,"[" ;PRINT "[DEVICE BUSY-"
PBOUT
MOVEI A,101
UMOVE B,1
MOVEI C,0
JFNS
HRROI A,[ASCIZ / Busy-/]
PSOUT
OPENR1: MOVEI A,^D3000 ;WAIT SHORT TIME THEN TRY AGAIN
DISMS
UMOVE A,A
UMOVE 2,2
TRO B,OF%NWT
OPENF
JRST OPENR1
UMOVEM 1,1 ;SUCCESS NOW, PRINT "GO]"
HRROI 1,[ASCIZ /Go]
/]
PSOUT
SMRETN
RETFIL: UMOVE B,2 ; Get user bits again
SKIPN ARDFRT ; Job want to wait?
TXNE B,OF%RAR ; Or this call?
CAIA ; Yes, or yes
ERUNLK() ; Neither, bomb
TXNE B,OF%NWT ; Never wait?
ERUNLK() ; Right, fail now
CALL UNLCKF
SETZM INTDF
XCT INTDFF
HRROI T1,[ASCIZ/[Retrieving /]
PSOUT
MOVX A,.PRIOU
UMOVE B,1
MOVEI C,0
JFNS
HRROI A,[ASCIZ/ from tape - /]
PSOUT
UMOVE A,1 ; Recover the JFN
MOVX B,.ARRFR ; Retrieve the file pls
MOVX C,AR%WAT ; I'm waiting on you
ARCF
ERJMP RETFAI ; Couldn't????
HRROI A,[ASCIZ/Retrieved]
/]
PSOUT
UMOVE A,1 ; Get AC's again, OPENF assumes these
UMOVE B,2
JRST .OPENF ; Start over...
RETFAI: MOVX A,.PRIOU
MOVE B,LSTERR
HRLI B,.FHSLF
SETZ C,
ERSTR
JFCL
JRST RETFFA ; ??? now what...
HRROI A,[ASCIZ/]
/]
PSOUT
RETFFA: RETERR(OPNX31) ; Fail
;ROUTINE TO CHECK IF THE OPENF IS ALLOWED TO WIN IF THE DEV IS OFFLINE
;RETURNS +1: NOT ALLOWED
; +2: ALLOWED TO BE OPENED EVEN IF OFFLINE
CHKOFL::TXNN F1,OF%OFL ;CHECK THE OFF LINE BIT FROM AC2
RET ;NOT ALLOWED
RETSKP ;ALLOWED
;HERE WHEN CHKJFN RETURNED +2, INDICATING TERMINAL. IF USER SPECIFIED
;.PRIIN, .PRIOU, OR (0,,-1) RETURN SUCCESS WITHOUT ASSIGNING TERMINAL
;IN DEVICE TABLES. IF USER GAVE 400000+TERMINAL NUMBER, FAIL
OPENF1: UMOVE T1,1 ;GET USER'S INPUT AGAIN
CAIE T1,.PRIIN ;PRIMARY INPUT?
CAIN T1,.PRIOU ;NO. PRIMARY OUTPUT?
SMRETN ;ALLOW THEM TO SUCCEED
CAIE T1,-1 ;CONTROLLING TERMINAL?
RETERR (DESX1) ;NO. INVALID DESIGNATOR
SMRETN ;YES. ALLOW SUCCESS
;CKJFTT - CHECK FOR JFN FOR 'TTY'
;ACCEPTS:
; JFN/ A VALID JFN
; CALL CKJFTT
;RETURNS +1: JFN FOR 'TTY'
; +2: ANY OTHER JFN
;THIS ROUTINE IS CHECKING FOR A JFN ON THE STRING 'TTY:'. SINCE THIS
;STRING IS TAKEN TO MEAN 'JOB'S CONTROLLING TERMINAL', THE CODE THAT
;OPENS A JFN (BOTH IN OPENF AND IN TTYOPN OF FILMSC) MUST NOT ASSIGN
;THE ASSOCIATED TERMINAL IN THE DEVICE TABLES OR ACTIVATE THE LINE.
;THIS IS BECAUSE, IF THE JOB DETACHES AND ATTACHES TO ANOTHER
;TERMINAL, DOING I/O ON THIS JFN WILL GET THE NEW CONTROLLING TERMINAL.
;IF DV%OPN HAD BEEN SET ON THE ORIGINAL TERMINAL, THE DETACH WOULD
;NOT DEASSIGN IT. WHEN A DETACHED JOB DOES AN OPENF ON TTY:, THE OPENF
;WILL SUCCEED WITHOUT ACTIVATING THE LINE. WHEN THE JOB DOES I/O ON
;THE JFN, IT WILL BLOCK UNTIL THE JOB IS ATTACHED
CKJFTT::ACVAR <W1> ;GET WORK AC
HLRZ W1,FILDDN(JFN) ;GET THE ORIGINAL STRING FROM THE GTJFN
MOVE W1,1(W1) ;POINT BEYOND HEADER
TRZ W1,377 ;GET RID OF POSSIBLE GARBAGE
CAMN W1,[ASCIZ/TTY/] ;IS THIS 'TTY'?
RET ;YES. NONSKIP
RETSKP ;SKIP
ENDAV. ;END ACVAR
;NORMAL BLOCK ROUTINE
OPENFW: CALL UNLDIS ;UNLOCK AND DISMIS
JRST OPENF0 ;RETRY
;OPENF BLOCK CO-ROUTINE
OPENB: STKVAR <SAVDEV>
MOVEM DEV,SAVDEV ;SAVE DEV
CALL UNLDIS ;UNLOCK & DISMS
UMOVE JFN,1 ;FETCH JFN AGAIN
CALL CHKJFN
RETBAD () ;JUNK
JRST OPENB1 ;400000+N
JRST [ CAIE DEV,STRDTB ;STRING PNTR?
JRST .+1
RETBAD (OPNX26)]
CAME DEV,SAVDEV ;CHECK FOR SAME DEVICE
RETBAD (DESX4) ;NO YOU CHANGED IT ON ME
RETSKP ;GOOD RETURN
;HERE WHEN CHKJFN RETURNED +2, INDICATING TERMINAL. IF USER SPECIFIED
;.PRIIN, .PRIOU, OR (0,,-1) RETURN SUCCESS WITHOUT ASSIGNING TERMINAL
;IN DEVICE TABLES. IF USER GAVE 400000+TERMINAL NUMBER, FAIL
OPENB1: CAME DEV,SAVDEV ;CHECK FOR SAME DEVICE
RETBAD (DESX4) ;NO IT WAS CHANGED
UMOVE T1,1 ;GET USER'S INPUT AGAIN
CAIE T1,.PRIIN ;PRIMARY INPUT?
CAIN T1,.PRIOU ;NO. PRIMARY OUTPUT?
SMRETN ;ALLOW THEM TO SUCCEED
CAIE T1,-1 ;CONTROLLING TERMINAL?
RETERR (DESX1) ;NO. INVALID DESIGNATOR
SMRETN ;YES. ALLOW SUCCESS
;RCDIR - RECOGNIZE DIRECTORY NAME
;
; CALL: 1/ FLAGS
; 2/ POINTER TO ASCIZ DIRECTORY NAME STRING
; RCDIR
; 1/ FLAGS INDICATING RESULT:
; RC%NOM - NO MATCH FOR STRING
; RC%AMB - STRING WAS AMBIGUOUS
; 2/ UPDATED POINTER IF RECOGNITION WAS PERFORMED
;
; THE LEGAL FORMATS FOR A DIRECTORY STRING ARE:
; STR:<DIRECTORY>
; STR:[DIRECTORY]
; STR:
; <DIRECTORY>
; [DIRECTORY]
; DEFINITIONS OF PUNCTUATION CHARACTERS --
.CHDI1==:"<" ;TYPE 1 OPENING DIRECTORY BRACKET
.CHDT1==:">" ;TYPE 1 CLOSING DIRECTORY BARCKET
.CHDI2==:"[" ;TYPE 2 OPENING DIRECTORY BRACKET
.CHDT2==:"]" ;TYPE 2 CLOSING DIRECTORY BRACKET
.CHDEV==:":" ;FILE STRUCTURE DELIMITER
.CHWL1=="*" ;FIRST WILD CHARACTER
.CHWL2=="%" ;SECOND WILD CHARACTER
; ACCUMULATOR USAGE --
;
; Q1/ RESULT REGISTER: CAN RETURN NOM,AMB,WLD,NMD
; Q2/ COPY OF USER'S FLAGS
; LOCAL VARIABLE USAGE --
; RCDBLK - LOOKUP POINTER TO BLOCK CONTAINING COPY OF USER STRING
; RCDDPT - BYTE POINTER TO BEGINNING OF DIRECTORY STRING IN RCCBLK
; RCDSTR - CONTAINS THE STRUCTURE NAME IN ASCIZ
; RCDBK2 - LOOKUP POINTER TO BLOCK HOLDING COPY OF DIRECTORY STRING
; RCDIDP - TERMINATING,,INITAL DIRECTORY PUNCTUATION CHARACTERS
; RCDTPT - POINTER TO TAIL OF DIRECTORY STRING SO RECOGNITION CAN BE DONE
; RCDNUM - DIRECTORY DESIGNATOR
; RCDUC - UNIQUE CODE OF STRUCTURE SPECIFIED
; RCDLND - LOOKUP POINTER TO DIRECTORY NAME IF FOUND IN LOGICAL NAME
; RCDUPT - USER'S BYTE POINTER TO STRUCTURE/DIRECTORY STRING
; RCDBPR - UPDATED BYTE POINTER TO STRUCTURE FIELD STRING
.RCDIR::MCENT ;MONITOR CONTEXT ENTRY
CALL RCDIR0 ;CALL INNER ROUTINE
ITERR () ;ERROR RETURN
JRST MRETN ;GOOD RETURN
;THIS LEVEL OF ROUTINE IS NEEDED BECAUSE MRETN DOESN'T CLEAN UP FROM
;JSBVAR.
RCDIR0: JSBVAR <RCDBLK,RCDDPT,<RCDSTR,MAXLW+2>,RCDBK2,RCDIDP,RCDTPT,RCDNUM,RCDUC,RCDLND,RCDUPT,GETDT3>
CALL RCDIR1 ;GO DO THE WORK
JRST [ MOVEM T1,Q1 ;FAILED. SAVE ERROR CODE
CALL RCDCLN ;RELEASE FREE SPACE IF NEEDED
MOVE T1,Q1 ;RESTORE ERROR CODE
RETBAD] ;RETURN FAILURE
CALL RCDCLN ;RELEASE FREE SPACE IF NEEDED
RETSKP ;RETURN SUCCESS (Q1 MAY HAVE ERROR)
;THIS LEVEL OF CODE IS NEEDED IN ORDER TO HANDLE ERROR RETURNS
;CONSISTENTLY
RCDIR1: SETZM RCDBLK ;INITIALIZE POINTERS TO FREE SPACE
SETZM RCDBK2 ; IF THESE ARE NON-ZERO ON RETURN TO RCDIR0
SETZM RCDLND ; THEY POINT TO JSB SPACE
SETZ Q1, ;INITIALIZE TO INDICATE NO ERRORS
UMOVE Q2,1 ;GET FLAGS
LOAD T1,JSUC ;GET UNIQUE CODE OF CONNECTED STR
MOVEM T1,RCDUC ;SAVE IT IN CASE DEVICE WASN'T SPECIFIED
;..
;..
UMOVE T1,2 ;GET POINTER TO DIRECTORY STRING
; OR DIRECTORY NUMBER...
LOAD T2,NMFLG,T1 ;LOOK AT BITS 0-2
CAIN T2,NUMVAL ;IS IT A NUMBER?
JRST [ TXNE Q2,RC%STP ;YES. STEPPING?
RETBAD(DESX1) ;YES - NOT ALLOWED
CALL RCNUM ;CONVERT USER NUMBER IF NECESSARY
MOVEM T1,RCDNUM ;SAVE (UNIQUE CODE,,DIRECTORY NUMBER)
JRST RCD550] ;GO SEE IF DIRECTORY IS OK
HLRZ T2,T1 ;NO. SEE IF LEFT HALF IS 0
SKIPN T2 ;IF ZERO, THIS IS A JFN
JRST [ TXNE Q2,RC%STP ;STEPPING?
RETBAD(DESX1) ;YES - NOT ALLOWED
CALL RCJFN ;GET THE STRUCTURE,,DIRECTORY FOR THIS JFN
RETBAD ;INVALID. RETURN ERROR
MOVEM T1,RCDNUM ;SAVE (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
JRST RCD550] ;GO SEE IF DIRECTORY IS OK
;THIS IS A STRING POINTER. COPY THE STRING TO BE RECOGNIZED
MOVEM T1,RCDUPT ;SAVE FOR COPYING BACK HERE LATER
CALL PTRCHK ;CHECK THE BYTE POINTER FOR LEGALITY
RETBAD(DESX1) ;NOT LEGAL...INVALID DESIGNATOR ERROR
MOVE T1,RCDUPT ;GET THE POINTER BACK
MOVEI T2,2*MAXLW+1 ;T2/ALLOW ROOM FOR LOGICAL NAME AND DIRECTORY PLUS
; PUNCTUATION
CALL CPYUSR ;COPY STRING FROM USER SPACE
RETBAD (RCDIX1) ;FAILED, RETURN "INSUFFICIENT RESOURCES" ERROR
MOVEM T1,RCDBLK ;SAVE LOOKUP POINTER TO BLOCK CONTAINING STRING
UMOVEM T3,2 ;UPDATE THE USER'S BYTE POINTER
; DETERMINE IF A STRUCTURE NAME WAS INCLUDED IN THE STRING
LDB T2,[POINT 7,1(T1),6] ;GET FIRST CHARACTER OF STRING
HRLI T1,(POINT 7,0,35) ;FORM ILDB POINTER TO BEGINNING OF STRING
MOVEM T1,RCDDPT ;ASSUME STRING STARTS WITH DIRECTORY
CAIE T2,.CHDI1 ;DOES THE STRING BEGIN WITH VALID
CAIN T2,.CHDI2 ; DIRECTORY PUNCTUATION ?
JRST RCD050 ;YES, GO PROCESS DIRECTORY
; A DEVICE FIELD WAS SUPPLIED - COPY IT TO THE STACK
;STOP AT A NULL OR COLON OR WHEN THE MAXIMUM ALLOWED NUMBER OF
;CHARACTERS ARE DETECTED
MOVEI T1,RCDSTR ;GET ADDRESS OF BLOCK ON STACK
HRLI T1,(POINT 7,0,35) ;POINT BEYOND HEADER
MOVE T2,RCDBLK ;GET ADDRESS OF BLOCK CONTAINING STRING
HRLI T2,(POINT 7,0,35) ;FORM POINTER TO STRUCTURE NAME
MOVEI T3,MAXLC+1 ;COUNT IS MAX # OF CHARS IN NAME + ":"
RCD020: ILDB T4,T2 ;GET NEXT CHARACTER IN USER'S STRING
IDPB T4,T1 ;COPY IT TO THE STACK
CAIE T4,.CHDEV ;WAS THIS A COLON?
CAIN T4,.CHNUL ;NO. NULL?
SKIPA ;COLON OR NULL
SOJG T3,RCD020 ;NEITHER. MAXIMUM CHARACTERS READ?
;DEVICE FIELD HAS BEEN COPIED. IF A COLON WAS NOT DETECTED, IT IS
;NOT A VALID DEVICE FIELD.
CAIE T4,.CHDEV ;YES. ENDED WITH COLON?
JRST [ TXNE Q2,RC%EMO ;NO. EXACT MATCH ONLY?
RETBAD (RCDIX3) ;YES. INVALID STRUCTURE NAME
MOVX Q1,RC%AMB ;NO. INDICATE AMBIGUOUS STRUCTURE NAME
UMOVEM Q1,1 ;TELL THE USER
RETSKP] ;INDICATE SUCCESS
SETZ T4, ;FOUND COLON. MAKE IT END WITH NULL
DPB T4,T1 ; FOR CHKLND
MOVEM T2,RCDDPT ;SAVE POINTER TO BEGINNING OF DIRECTORY NAME
;..
;..
;DEVICE FIELD MAY CONTAIN LOGICAL NAME. IF SO, GET THE DEVICE AND
;DIRECTORY SPECIFIED BY THE LOGICAL NAME.
MOVEI T1,MAXLW+1 ;SET UP LENGTH OF BLOCK CONTAINING DEVICE FIELD
MOVEM T1,RCDSTR ;SAVE IT FOR CHKLND
MOVEI T1,RCDSTR ;T1/LOCATION OF BLOCK WHERE DEVICE FIELD IS
SETOM T2 ;T2/WANT DIRECTORY STRING AS WELL AS DEVICE
CALL CHKLND ;IF DEVICE FIELD IS LOGICAL NAME, CONVERT TO
; DEVICE AND DIRECTORY
MOVEM T2,RCDLND ;SAVE POINTER TO DIRECTORY NAME
;T2 POINTS TO LAST DEVICE FIELD IN CHAIN OF LOGICAL NAME DEFINITIONS
;SEE IF THIS IS REALLY A STRUCTURE AND GET ITS UNIQUE CODE
CALL STDEVP ;SEE IF DEVICE FIELD IS A KNOWN DEVICE
JRST RCSNM ;STRUCTURE NOT UP
HLRZ T2,T1 ;GET LH OF DEVICE DESIGNATOR
CAIE T2,.DVDES+.DVDSK ;IS IT A DISK?
RETBAD (STRX01) ;NO. RETURN "STRUCTURE IS NOT MOUNTED"
HRRZ T2,T1 ;GET STRUCTURE UNIQUE CODE
CAIN T2,-1 ;IS THIS "DSK"?
JRST [ LOAD T1,JSUC ;YES, GET CONNECTED STR UNIQUE CODE
JRST RCD040]
LDB T2,[POINT STRNS,T1,35] ;GET STRUCTURE INDEX
MOVE T2,STRTAB(T2) ;GET SDB ADDRESS
LOAD T2,STRJB,(T2) ;GET FORK INIT'ING STRUCTURE
SKIPE T2 ;SKIP IF NOT BEING INIT'ED
JRST [ CAMN T2,FORKX ;Are we the fork doing it?
JRST .+1 ;Yes, so that's ok
MOVEI T1,STDVX1 ;No, say "No such device",
JRST RCSNM] ;STRUCTURE NOT UP
RCD040: HRRZM T1,RCDUC ;SAVE UNIQUE CODE FOR STRUCTURE
;..
;HERE TO PROCESS DIRECTORY STRING. IF NONE WAS INPUT, AND A LOGICAL NAME
;WAS INPUT, USE THE LOGICAL NAME DEFINITION. IF NOT, ASSUME CONNECTED
;DIRECTORY.
;..
RCD050: LDB T1,[POINT 6,RCDUC,35] ;[7.1063]Get the structure number
CALL CKSTOF ;[7.1063](T1/T1)Is the structure offline?
RETBAD () ;[7.1063]Return "Structure is offline"
ILDB T1,RCDDPT ;GET FIRST CHARACTER OF DIRECTORY STRING
JUMPE T1,RCD060 ;IS THERE A STRING?
;A DIRECTORY STRING WAS INPUT BY THE USER
CALL GETDIR ;YES. CONVERT TO DIRECTORY NUMBER
RETBAD ;FAILED. ERROR CODE IS IN T1
JRST RCD500 ;GO CLEAN UP
;STRUCTURE NOT MOUNTED. SAY "NO MATCH", BUT GO ON, TO MAKE SURE
;SYNTAX OF DIRECTORY NAME IS CORRECT.
RCSNM: TXO Q1,RC%NOM ;MARK THAT THERE'S NO MATCH
JRST RCD050 ;PROCEED AND CHECK DIRECTORY NAME SYNTAX
;NO STRING WAS INPUT. SEE IF THERE IS A LOGICAL NAME DEFINITION
RCD060: SKIPN T1,RCDLND ;NO. WAS ANYTHING FOUND?
JRST RCD080 ;NO.
;A LOGICAL NAME DEFINITION WAS FOUND. CONVERT TO DIRECTORY NUMBER
TQO <NREC> ;DIRECTORY WAS FOUND IN LOGICAL NAME. INDICATE
; RECOGNITION NOT ALLOWED FOR DIRLUK
HRRZ T3,RCDLND ;get address of logical name string block
AOS T3 ;make it start at beginning of text
HRLI T3,440700 ;make it a byte pointer
HRRZ T4,RCDDPT ;get address of directory name block
HRLI T4,440700 ;make it a byte pointer
MOVEM T4,RCDDPT ;save it
MOVEI T1,.CHDI1 ;get opening bracket
IDPB T1,T4 ;write it to first byte
RCD062: ILDB T1,T3 ;get byte from logical name
JUMPE T1,RCD064 ;if end, clean up
IDPB T1,T4 ;copy it to directory name
JRST RCD062 ;go do next byte
RCD064: MOVEI T1,.CHDT1 ;end of logical name, get closing bracket
IDPB T1,T4 ;append it to end
MOVEI T1,.CHNUL ;get a nul
IDPB T1,T4 ;make sure we have an ASCIZ string
JRST RCD050 ;go try again.
;NO DIRECTORY WAS SPECIFIED. FIND OUT WHAT DIRECTORY THE USER IS
;CONNECTED TO AND USE ITS NAME
RCD080: TXO Q2,RC%EMO ;DON'T ALLOW RECOGNITION SINCE DIRST WILL CREATE
; THE STRING
CALL GTCSCD ;GET CONNECTED STRUCTURE UNIQUE CODE,,DIRECTORY
MOVE T2,T1 ;T2/(STRUCTURE UNIQUE CODE,,DIRECTORY)
HRRO T1,RCDBLK ;T1/POINTER TO WHERE STRING IS TO BE WRITTEN
AOS T1 ;POINT BEYOND HEADER
DIRST ;GET STRUCTURE AND DIRECTORY
RETBAD (RCDIX2) ;RETURN "INVALID DIRECTORY SPECIFICATION"
MOVE T2,RCDBLK ;POINT TO START OF STRING
HRLI T2,(POINT 7,0,35)
RCD051: ILDB T1,T2 ;GET THE NEXT CHARACTER
CAIE T1,.CHDEV ;IS IT A DEVICE TERMINATOR?
JRST RCD051 ;NO. KEEP LOOKING
MOVEM T2,RCDDPT ;YES. SAVE POINTER TO THIS CHARACTER
ILDB T1,RCDDPT ;GET OPENING BRACKET OF DIRECTORY STRING
CALL GETDIR ;CONVERT DIRECTORY NAME TO NUMBER
RETBAD ;FAILED. ERROR CODE IS IN AC 1
JRST RCD500 ;GO CLEAN UP
;HERE WHEN ENTIRE STRING HAS BEEN PARSED. Q1 CONTAINS FLAGS INDICATING
;RESULTS. RCDUC HAS STRUCTURE NUMBER; RCNUM HAS DIRECTORY NUMBER
RCD500:
JUMPN Q1,RCD550 ;IF NO MATCH OF AMBIGUOUS, GO RETURN VALUES
HRRZ T1,RCDUC ;GET STRUCTURE NUMBER
HRLM T1,RCDNUM ;SAVE UNIQUE PART OF DIRECTORY DESIGNATOR
; RETURN VALUES TO THE USER
RCD550: TXNE Q1,RC%NOM!RC%AMB!RC%NMD ;IF NO MATCH, AMBIG, OR NO MORE DIR
JRST RCD600 ;DONT ATTEMPT MAPPING DIR
LDB T1,[POINT 6,RCDUC,35] ;[7.1063]Get the structure number
CALL CKSTOF ;[7.1063](T1/T1)Is the structure offline?
RETBAD () ;[7.1063]Return "Structure is offline"
TXNN Q2,RC%STP ;STEPPING??
TXNE Q1,RC%WLD ;NO, WAS WILDCARD FOUND?
JRST RCD555 ;YES - DIR ALREADY MAPPED
MOVE T1,RCDNUM ;GET DIRECTORY NUMBER
CALL SETDIR ;MAP DIRECTORY
RETBAD () ;FAILED, PASS ERROR UP
RCD555: MOVE T4,DIRORA ;GET BASE ADDRESS OF DIRECTORY
LOAD T1,DRMOD,(T4) ;GET MODE BITS
TXZ T1,RC%NOM!RC%AMB!RC%NMD!RC%WLD ;DON'T SET THESE FROM T1
TXO T1,MD%SA ;ALWAYS ALLOW STRING ACCOUNTS
IOR Q1,T1 ;ADD MODE BITS TO FLAG WORD
CALL USTDIR ;UNLOCK DIRECTORY
RCD600: UMOVEM Q1,1 ;RETURN FLAGS GIVING RESULT OF LOOKUP
MOVE T1,RCDNUM ;GET DIRECTORY NUMBER
TXNN Q1,RC%NOM!RC%AMB ;NO MATCH OR AMBIGUOUS ?
UMOVEM T1,3 ;NO, SUCCESS, SO RETURN DIRECTORY NUMBER
RETSKP ;RETURN TO USER
;RCDCLN - ROUTINE TO CLEAN UP AFTER RCDIR
; CALL RCDCLN
;RETURNS +1: ALWAYS
RCDCLN: SKIPN T2,RCDBLK ;DO WE HAVE A BLOCK FOR USER'S ORIGNAL STRING?
JRST RCDCL1 ;NO. NO NEED TO RELEASE IT
MOVEI T1,JSBFRE ;YES. T1/ INDICATES JSB FREE SPACE
CALL RELFRE ;RELEASE THE BLOCK
OKINT
RCDCL1: SKIPN T2,RCDBK2 ;DO WE HAVE A BLOCK FOR DIRECTORY STRING?
JRST RCDCL2 ;NO. NO NEED TO RELEASE IT
MOVEI T1,JSBFRE ;YES. T1/ INDICATES JSB FREE SPACE
CALL RELFRE ;RELEASE THE BLOCK
OKINT
RCDCL2: SKIPN T2,RCDLND ;DID CHKLND RETURN A BLOCK FOR DIRECTORY STRING?
RET ;NO. NO NEED TO RELEASE IT
CAMN T2,[-1] ;DID CHKLND FIND A STAR?
RET ;YES. NO BLOCK TO RELEASE
MOVEI T1,JSBFRE ;YES. T1/ INDICATES JSB FREE SPACE
CALL RELFRE ;RELEASE THE BLOCK
OKINT
RET
;GETDIR - GET THE DIRECTORY NUMBER
;ACCEPTS:
; T1/FIRST CHARACTER IN DIRECTORY STRING
; Q2/USER'S FLAGS
; CALL GETDIR
;RETURNS +1: FAILURE
; 1/ERROR CODE
; +2: SUCCESS
; DIRECTORY NUMBER IN RCDNUM
; RECOGNIZED STRING COPIED BACK TO USER
GETDIR: CAIE T1,.CHDI1 ;DOES THE DIRECTORY STRING BEGIN WITH
CAIN T1,.CHDI2 ; VALID DIRECTORY PUNCTUATION ?
SKIPA ;YES, SAVE INITIAL CHARACTER
RETBAD (RCDIX2) ;NO, RETURN "INVALID DIRECTORY" SPEC"
MOVEM T1,RCDIDP ;SAVE THE INITIAL DIRECTORY PUNCTUATION
MOVEI T4,.CHDT1 ;GET TYPE 1 TERMINATOR
CAIE T1,.CHDI1 ;WAS THIS A TYPE 1 OPENER?
MOVEI T4,.CHDT2 ;NO. GET TYPE 2 TERMINATOR
HRLM T4,RCDIDP ;SAVE EXPECTED TERMINATOR
; ISOLATE THE DIRECTORY NAME STRING
MOVEI T2,MAXLW+2 ;GET NUMBER OF WORDS NEEDED FOR STRING
NOINT ;NOINT WHILE JSB SPACE IS ASSIGNED
CALL ASGJFR ;ASSIGN JSB FREE SPACE
RETBAD (RCDIX1,<OKINT>);RETURN "INSUFFICIENT RESOURCES"
MOVEM T1,RCDBK2 ;SAVE LOOKUP POINTER TO TEMPORARY BLOCK
HRLI T1,(POINT 7,0,35) ;POINT BEYOND HEADER
MOVE T2,RCDDPT ;GET POINTER TO DIRECTORY WITHIN USER STRING
MOVEI T3,MAXLC+1 ;MAX # OF CHARS IN DIRECTORY NAME + TERMINATOR
;COPY EACH CHARACTER STARTING WITH THE LEFT BRACKET UP TO INCLUDING
;EITHER A NULL OR MATCHING RIGHT BRACKET OR UNTIL THE MAXIMUM NUMBER
;OF CHARACTERS IS READ
GETD05: ILDB T4,T2 ;GET NEXT CHARACTER
MOVEM T1,RCDTPT ;SAVE POINTER TO END OF STRING FOR DIRLUK
; (LDB WOULD GET THE LAST CHARACTER COPIED)
IDPB T4,T1 ;COPY IT TO FREE SPACE
CAIE T4,.CHWL1 ;WILDCARD?
CAIN T4,.CHWL2 ; ???
TXO Q1,RC%WLD ;YES - REMEMBER ONE SEEN
MOVEM T3,GETDT3 ;SAVE T3
HRRZ T3,RCDIDP ;[7304] GET BACK OPENING BRACKET
CAMN T4,T3 ;[7304] IS THIS CHARACTER AN ADDITIONAL OPENER?
RETBAD (RCDIX2) ;[7304] YES, GIVE ERROR NOW - INVALID DIRECTORY SPEC
HLRZ T3,RCDIDP ;GET EXPECTED TERMINATING BRACKET
CAMN T4,T3 ;IS THE CURRENT CHARACTER A BRACKET?
JRST [ TXO Q2,RC%EMO ;YES. DON'T ALLOW RECOGNITION
JRST GETD07] ; AND DON'T LOOK AT MORE CHARACTERS
CAIN T4,.CHNUL ;NO. IS IT A NULL?
JRST GETD07 ;BRACKET OR NULL. STOP COPYING
MOVE T3,GETDT3 ;RESTORE COUNTER
SOJGE T3,GETD05 ;END OF SPACE?
;END OF STRING. IF LAST CHARACTER WAS BRACKET, IT MUST BE FOLLOWED
;BY NULL. IF NOT, MUST BE DOING RECOGNITION. OTHERWISE ERROR.
;NOTE THAT IF THE STRING ENDS IN NULL, AND THE LAST NON-NULL IS
;THE WRONG KIND OF BRACKET, THE ENTIRE STRING INCLUDING THE BRACKET
;WILL BE PASSED TO DIRLUK, WHICH WILL RETURN NO-MATCH
GETD07: TXNN Q1,RC%WLD ;WILDCARD FOUND?
JRST GETD09 ;NO
TXO Q2,RC%EMO ;YES - ACT LIKE EXACT MATCH ONLY
TXNN Q2,RC%AWL ;WILDCARD ALLOWED?
RETBAD (RCDIX2) ;NO - ERROR
GETD09: MOVE T3,RCDBK2 ;GET POINTER TO STRING BLOCK
SKIPN 1(T3) ;IS THE STRING NULL?
JRST [ SETO T1, ;YES, THE STRING IS AMBIGUOUS
JRST GETD21]
HLRZ T3,RCDIDP ;GET EXPECTED TERMINATING BRACKET
CAME T3,T4 ;DIRECTORY TERMINATED BY EXPECTED BRACKET ?
JRST [ TXNN Q2,RC%EMO ;NO. DOING RECOGNITION?
JRST GETD10 ;YES, CONTINUE
RETBAD (RCDIX2)] ;NO. RETURN "INVALID DIRECTORY" ERROR
ILDB T4,T2 ;YES. GET THE NEXT CHARACTER
CAIE T4,.CHNUL ;IS IT A NULL?
RETBAD (RCDIX2) ;NO. MUST BE AN ASCIZ STRING
DPB T4,T1 ;REPLACE BRACKET BY NULL SO THAT
; DIRLUK WILL SUCCEED
;..
; FORM STANDARD LOOKUP POINTER AS EXPECTED BY DIRLUK: -<NWORDS-1>,,ADR-1
;..
GETD10: TXNE Q1,RC%NOM ;HAVE WE ALREADY DECIDED THERE'S "NO MATCH"?
RETSKP ;YES, SO DON'T BOTHER LOOKING UP DIRECTORY
MOVE T2,RCDBK2 ;POINT TO BLOCK CONTAINING STRING
SUB T1,T2 ;COMPUTE NUMBER OF WORDS WRITTEN
SOS T1 ;NUMBER -1
MOVNS T1 ;-<NWORDS-1>
HRLM T1,RCDBK2 ;FINISH THE LOOKUP POINTER
; SET UP FOR RECOGNITION AND SEE IF RECOGNITION WAS REQUESTED
TQZ <NREC> ;ASSUME RECOGNITION WANTED
TXNN Q2,RC%EMO ;EXACT MATCH OLY ?
JRST GETD20 ;NO, GO DO RECOGNITION
TQO <NREC> ;YES, INDICATE NO RECOGNITION
TXNN Q2,RC%STP ;STEPPING DIRECTORY?
TXNE Q1,RC%WLD ;WILDCARD?
JRST GETD25 ;YES - GO PROCESS
; GET DIRECTORY NUMBER, RECOGNIZING IF NECESSARY
GETD20: MOVE T1,RCDBK2 ;GET ADDRESS OF BLOCK HOLDING DIRECTORY STRING
HRRZ T2,RCDUC ;GET STRUCTURE UNIQUE NUMBER
MOVE T3,RCDTPT ;GET POINTER TO TAIL OF STRING
CALL DIRLUK ;LOOKUP DIRECTORY
GETD21: JRST [ MOVX Q1,RC%NOM ;FAILED, ASSUME NO MATCH AT ALL
SKIPN T1 ;NO MATCH OR AMBIGUOUS ?
RETSKP ;NO MATCH. RETURN SUCCESS WITH Q1 SET
MOVX Q1,RC%AMB ;AMBIGUOUS
TXNN Q2,RC%PAR ;IS PARTIAL RECOGNITION ALLOWED?
RETSKP ;NO. RETURN SUCCESS (Q1 INDICATES ERROR)
JRST GETD30] ;YES. GO UPDATE USER'S STRING
MOVEM T1,RCDNUM ;SAVE DIRECTORY NUMBER
; REASSEMBLE STRING IF RECOGNITION WAS DONE
GETD30: TXNE Q2,RC%EMO ;EXACT MATCH ONLY DESIRED ?
JRST GETD40 ;YES. DON'T UPDATE THE STRING
MOVE T1,RCDDPT ;GET POINTER TO DIRECTORY IN RCDBLK
MOVE T2,RCDBK2 ;GET ADDRESS OF TEMPORARY BLOCK
HRROI T2,1(T2) ;FORM POINTER TO NAME AS FINISHED BY DIRLUK
SETZM T3 ;COPY UNTIL A NULL IS ENCOUNTERED
SOUT ;APPEND DIRECTORY BACK TO USER'S STRING
ERJMP [RETBAD (RCDIX4)] ;ERROR, RETURN "INTERNAL ERROR"
TXNN Q1,RC%AMB ;AMBIGUOUS?
JRST [ HLRZ T4,RCDIDP ;NO. GET CLOSING BRACKET FOR DIRECTORY STRING
IDPB T4,T1 ;TERMINATE DIRECTORY
JRST .+1]
MOVEI T4,.CHNUL ;GET A NULL
IDPB T4,T1 ;FORM ASCIZ STRING
JRST GETD40
;HERE IF A WILDCARD MASK WAS INPUT OR IF STEPPING
GETD25: HRLZ T1,RCDUC ;GET STRUCTURE UNIQUE CODE
TXNE Q2,RC%STP ;STEPPING?
UMOVE T1,3 ;YES - GET USERS DIR
HLRZ T2,T1 ;CHECK UNIQUE CODE
CAME T2,RCDUC ;SAME?
RETBAD (RCDIX2) ;NO. RETURN "INVALID DIRECTORY SPEC"
GETD26: MOVEI F1,0 ;CLEAR FLAGS
TQO <STEPF,DIRSF> ;SET STEP FLAGS
HRRZ T3,RCDBK2 ;GET ADR OF WILD MASK BLOCK
CALL MDDDIR ;STEP DIR
JRST GETD28 ;ERROR
MOVEM T1,RCDNUM ;SAVE DIRNUM
MOVE T4,DIRORA ;GET DIR NAME STRING
LOAD T4,DRNAM,(T4) ; ...
ADD T4,DIRORA ;AS ABSOLUTE ADDRESS
MOVSI T1,(<POINT 7,0(T4),35>) ;BUILD BYTE POINTER
HRRZ T2,RCDBK2 ;GET POINTER TO WILD MASK
CALL CHKWLD ;CHECK FOR MATCH
SKIPA ;NO MATCH
JRST GETD40 ;MATCH - RETURN THIS DIR
CALL USTDIR ;UNLOCK THIS DIR
MOVE T1,RCDNUM ;NO MATCH - STEP THIS DIR
JRST GETD26 ; ...
GETD28: CAIE T1,GJFX32 ;NO MORE DIRS?
RETBAD (RCDIX2) ;NO. RETURN "INVALID DIRECTORY SPEC"
TXNN Q2,RC%STP ;YES, ARE WE STEPPING?
TXOA Q1,RC%NOM ;NO, SET NO MATCH
TXO Q1,RC%NMD ;YES, SET NO MORE DIRECTORIES IN GROUP
SETZB T1,RCDNUM ;RETURN 0
;..
;..
; COPY COMPLETED STRING TO USER SPACE IF DOING RECOGNITION
GETD40: TXNE Q2,RC%EMO ;EXACT MATCH ONLY?
RETSKP ;YES. DON'T COPY BACK TO USER
MOVE T1,RCDUPT ;GET ORIGINAL POINTER IN USER SPACE
MOVE T2,RCDBLK ;GET LOOKUP POINTER TO BLOCK
CALL CPYTUS ;COPY STRING BACK TO USER
RETSKP
;RCNUM - GET STRUCTURE,,DIRECTORY NUMBER FROM DIRECTORY OR USER NUMBER
;ACCEPTS:
; T1/(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
; OR
; (USRLH,,DIRECTORY NUMBER)
; CALL RCNUM
;RETURNS +1: ALWAYS,
; T1/(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
;THIS ROUTINE DETECTS WHETHER THE INPUT IS A DIRECTORY NUMBER OR USER
;NUMBER. IF A DIRECTORY NUMBER, IT RETURNS IT INTACT. IF A USER NUMBER,
;IT RETURNS THE DIRECTORY NUMBER ON PS. RCDIR WILL CHECK THE VALIDITY OF THE
;DIRECTORY NUMBER LATER BY CALLING SETDIR
RCNUM:
HLRZ T2,T1 ;GET THE LEFT HALF
CAIE T2,USRLH ;IS IT A USER NUMBER?
RET ;NO. A DIRECTORY NUMBER
MOVE T2,LGSIDX ;[7.1112]Get number of Login Structure
MOVE T2,STRTAB(T2) ;POINT TO START OF SDB FOR PUBLIC STRUCTURE
LOAD T2,STRUC,(T2) ;GET UNIQUE CODE FOR PUBLIC STRUCTURE
HRL T1,T2 ;USE IT IN THE DIRECTORY NUMBER
RET
;RCJFN - GET (STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER) FROM JFN
;ACCEPTS:
; T1/JFN
; CALL RCJFN
;RETURNS +1: FAILURE
; +2: SUCCESS,
; T1/(STRUCTURE UNIQUE CODE,,DIRECTORY NUMBER)
RCJFN:
MOVE JFN,T1 ;JFN/THE JFN
CALL DSKJFN ;SEE IF VALID JFN, LOCK JFN AND STRUCTURE
RETBAD ;INVALID
LOAD T1,FLUC,(JFN) ;GET STRUCTURE UNIQUE CODE
HRLZS T1 ;PUT IN LH
HRR T1,FILDDN(JFN) ;GET DIRECTORY NUMBER
CALL UNLCKF ;UNLOCK THE JFN AND STRUCTURE
RETSKP
;RCUSR - RECOGNIZE USER NAME
;ACCEPTS:
; T1/ FLAGS
; T2/ POINTER TO USER NAME
; RCUSR
;RETURNS +1: ALWAYS
; T1/ FLAGS
; T2/ UPDATED POINTER
; T3/ USER NUMBER
;INPUT FLAGS:
; RC%PAR (1B14) - PARTIAL RECOGNITION IS ALLOWED
; RC%STP (1B15) - STEP TO THE NEXT USER NUMBER
; RC%AWL (1B16) - ALLOW WILD CARDS
; RC%EMO (1B17) - EXACT MATCH ONLY (NO RECOGNITION)
;OUTPUT FLAGS:
; RC%ANA (1B1) - ALPHANUMERIC ACCOUNTS ALLOWED
; RC%RLM (1B2) - REPEAT MESSAGE OF THE DAY
; RC%NOM (1B3) - NO MATCH
; RC%AMB (1B4) - AMBIGUOUS
; RC%NMD (1B5) - NO MORE DIRECTORIES
;CAN ITRAP ON MONITOR ERROR
.RCUSR::MCENT ;MONITOR CONTEXT ENTRY
TRVAR <RCUBLK,RCUNUM,RCUUPT,RCUTPT,RCUMOD>
CALL RCUS0 ;CALL ROUTINE TO DO THE WORK
JRST [ MOVEM T1,Q1 ;FAILED. SAVE ERROR CODE
CALL RCUCLN ;RELEASE FREE SPACE IF NECESSARY
MOVE T1,Q1 ;RESTORE ERROR CODE
ITERR]
CALL RCUCLN ;RELEASE FREE SPACE IF NECESSARY
JRST MRETN ;SUCCEEDED. TAKE NON-SKIP RETURN
;RCUS0 - ROUTINE TO DO RCUSR'S WORK. ARGUMENTS ARE THE SAME AS
;FOR RCUSR
RCUS0: UMOVE Q2,1 ;Q2/USER'S FLAGS
SETZ Q1, ;INITIALIZE RETURN FLAGS
SETZM RCUBLK ;INDICATE NO FREE SPACE YET
; COPY NAME STRING FROM USER SPACE, AND STORE IT IN JSB FREE SPACE
UMOVE T1,2 ;GET POINTER TO NAME STRING
MOVEM T1,RCUUPT ;SAVE IT FOR COPYING TO LATER
CALL CPYFUS ;GO NOINT AND COPY STRING FROM USER SPACE
RETBAD (RCUSX1) ;FAILED, INSUFFICIENT RESOURCES
UMOVEM T3,2 ;RETURN UPDATED POINTER TO USER
MOVEM T1,RCUBLK ;SAVE LOOKUP POINTER TO BLOCK
MOVEM T2,RCUTPT ;SAVE POINTER TO END OF STRING
MOVEI T2,STKCD1 ;CODE FOR STRINGS
CALL JSBSTK ;SAVE ADDRESS OF STRING ON JSB STACK
OKINT ;INTERRUPTS ALLOWED NOW
MOVE T1,RCUBLK ;RESTORE AC'S
MOVE T2,RCUTPT ;THAT WERE TRASHED
;PARSE THE STRING LOOKING FOR WILD CARD CHARACTERS
HRLI T1,(POINT 7,0,35) ;POINT BEYOND HEADER WORD
MOVEI T3,MAXLC ;MAXIMUM ALLOWED CHARACTERS
RCU030: ILDB T2,T1 ;GET NEXT CHARACTER
CAIE T2,.CHWL1 ;WILD CARD?
CAIN T2,.CHWL2
TXO Q1,RC%WLD ;YES. INDICATE WILD CARD FOUND
CAIN T2,.CHNUL ;NULL?
JRST RCU050 ;YES. END OF STRING
SOJGE T3,RCU030 ;GO GET NEXT CHARACTER UNLESS REACHED MAX
;HERE WHEN STRING HAS BEEN PARSED. Q1 HAS RC%WLD SET IF A WILD
;CARD WAS FOUND
RCU050: TXNN Q1,RC%WLD ;WILD CARD FOUND?
IFNSK. ;No
TXNN Q2,RC%STP ;Was stepping specified by user?
JRST RCU070 ;No, continue
MOVX Q1,RC%NMD ;Yes, return error
JRST RCU210
ENDIF.
TXO Q2,RC%EMO ;YES. FORCE EXACT MATCH
TXNN Q2,RC%AWL ;ARE WILD CARDS ALLOWED?
RETBAD (STRX08) ;RETURN ERROR
;USER NAME IS A DIRECTORY ON PS. GET DIRECTORY NUMBER ON THAT STRUCTURE
RCU070: MOVE T1,LGSIDX ;[7.1112]Get STRTAB offset for Login Structure
CALL STRCNV ;CONVERT TO UNIQUE CODE
RETBAD (RCDIX4) ;RETURN 'INTERNAL ERROR'
TXNN Q2,RC%EMO ;EXACT MATCH?
TQZA <NREC> ;NO. ALLOW RECOGNITION
JRST [ TXNN Q2,RC%STP ;YES. STEPPING TO NEXT USER?
TXNE Q1,RC%WLD ; OR FOUND A WILD CARD?
JRST RCU110 ;YES. GO PROCESS IT
TQO <NREC> ;NO. INDICATE NO RECOGNITION
JRST .+1]
;NO WILD CARD WAS FOUND. CALL DIRLUK TO FIND DIRECTORY CORRESPONDING
;TO GIVEN USER NAME
MOVE T2,T1 ;2/UNIQUE CODE FOR PS:
MOVE T1,RCUBLK ;1/POINTER TO USER NAME
MOVE T3,RCUTPT ;3/POINTER TO END OF STRING
CALL DIRLUK ;CONVERT DIRECTORY NAME TO NUMBER ON PS
JRST [ MOVX Q1,RC%NOM ;INITIALLY ASSUME NO MATCH
SKIPN T1 ;AMBIGUOUS?
JRST RCU210 ;NO. RETURN NO MATCH
MOVX Q1,RC%AMB ;YES. RETURN THAT BIT INSTEAD
TXNN Q2,RC%PAR ;IS USER ALLOWING PARTIAL RECOGNITION
JRST RCU210 ;NO. DON'T COPY THE STRING
JRST RCU090] ;YES. GO COPY THE STRING
HRLI T1,USRLH ;PUT THE REQUIRED CODE IN THE LH FOR A USER NAME
MOVEM T1,RCUNUM ;SAVE IT FOR LATER
;IF USER WANTED RECOGNITION, COPY COMPLETED STRING BACK TO USER
RCU090: TXNE Q2,RC%EMO ;EXACT MATCH ONLY?
JRST RCU170 ;YES. DON'T COPY THE STRING BACK TO THE USER
MOVE T1,RCUUPT ;T1/USER'S ORIGINAL BYTE POINTER
MOVE T2,RCUBLK ;T2/LOOKUP POINTER TO STRING
CALL CPYTUS ;COPY BACK THE STRING AS UPDATED BY DIRLUK
; AND UPDATE USER'S BYTE POINTER
JRST RCU170 ;GO FINISH
;A WILD CARD WAS FOUND OR STEPPING USER NAME.
;GET STARTING DIRECTORY NUMBER FROM USER.
;CALL MDDDIR TO GET NEXT DIRECTORY, CHKWLD TO SEE IF USER'S STRING
;MATCHES THE DIRECTORY. IF NOT, CALL MDDDIR AGAIN. CONTINUE UNTIL
;EITHER A MATCH OCCURS OR MDDDIR RETURNS FAILURE.
RCU110: HRLZS T1 ;IF NOT STEPPING, T1/(PS UNIQUE CODE,,0)
TXNE Q2,RC%STP ;STEPPING?
JRST [ UMOVE T1,3 ;YES. GET STARTING USER NUMBER
HLRZ T2,T1 ;GET LEFT HALF
CAIE T2,USRLH ;IS IT A VALID USER NUMBER?
RETBAD (STRX07) ;NO. RETURN ERROR
CALL CNVDIR ;CONVERT TO DIRECTORY NUMBER
JRST .+1]
;GET THE NEXT DIRECTORY AND SEE IF IT MATCHES
RCU130: MOVEI F1,0 ;INITIALIZE FLAGS FOR MDDDIR
TQO <STEPF,DIRSF> ;INDICATE STEPPING, STEPPING DIRECTORY
MOVEI T2,.RCUSR ;T2/ TELL WHERE WE'RE CALLING FROM
HRRZ T3,RCUBLK ;T3/ ADDRESS OF BLOCK CONTAINING NAME
CALL MDDDIR ;GET THE NEXT DIRECTORY
JRST RCU150
MOVEM T1,RCUNUM ;SAVE DIRECTORY NUMBER
MOVE T4,DIRORA ;SET UP BYTE POINTER TO NAME STRING
LOAD T4,DRNAM,(T4) ; IN THE DIRECTORY THAT MDDDIR RETURNED
ADD T4,DIRORA ; MAPPED
MOVSI T1,(<POINT 7,0(T4),35>) ;T1/ BYTE POINTER TO NAME STRING
HRRZ T2,RCUBLK ;T2/ ADDRESS OF USER'S STRING
CALL CHKWLD ;DOES IT MATCH?
SKIPA ;NO
JRST [ MOVE T2,DIRORA ;YES. THIS IS A USER NAME ONLY
LOAD T2,DRMOD,(T2) ; IF THE DIRECTORY IS NOT FILES-ONLY
TXNE T2,MD%FO ;IS IT?
JRST .+1 ;FILES-ONLY. GO GET ANOTHER DIRECTORY
MOVE T1,RCUNUM ;GET THE DIRECTORY NUMBER
HRLI T1,USRLH ;CONVERT IT TO A USER NUMBER
MOVEM T1,RCUNUM ; TO RETURN TO THE USER
JRST RCU170]
CALL USTDIR ;UNMAP THIS DIRECTORY
MOVE T1,RCUNUM ;RESTORE DIRECTORY NUMBER FOR MDDDIR
JRST RCU130
;HERE WHEN MDDDIR FAILS. IF NO MORE DIRECTORIES, RETURN SUCCESS
;SETTING RC%NMD. IF NOT, RETURN FAILURE.
RCU150: CAIE T1,GJFX32 ;NO MORE DIRECTORIES?
RETBAD (RCDIX2) ;NO. TAKE ITERR RETURN
TXNN Q2,RC%STP ;YES, ARE WE STEPPING?
TXOA Q1,RC%NOM ;NO, SET NO MATCH
TXO Q1,RC%NMD ;YES, SET NO MORE USERS IN GROUP
SETZM RCUNUM ;INDICATE NO DIRECTORY TO RETURN
;MAP DIRECTORY AND GET MODE BITS
RCU170: TXNE Q1,RC%NOM!RC%AMB!RC%NMD ;ANY ERRORS?
JRST RCU210 ;YES. DON'T MAP DIRECTORY
TXNE Q1,RC%WLD ;WILD CARD FOUND?
JRST RCU190 ;YES. DIRECTORY ALREADY MAPPED
MOVE T1,RCUNUM ;T1/USER NUMBER
CALL CNVDIR ;CONVERT TO DIRECTORY NUMBER ON PS
CALL SETDIR ;MAP THE USER'S DIRECTORY FROM PS AND GO NOINT
JRST RCU210 ;FAILED. DON'T LOOK AT MODE BITS
;DIRECTORY IS MAPPED. GET MODE BITS
RCU190: MOVE T4,DIRORA ;GET START OF DIRECTORY
LOAD T1,DRMOD,(T4) ;GET MODE BITS
TXZ T1,RC%NOM!RC%AMB!RC%NMD!RC%WLD ;DON'T SET THESE FROM T1
TXO T1,MD%SA ;ALWAYS ALLOW STRING ACCOUNTS
IOR Q1,T1 ;ADD IT TO BITS
TXNE T1,MD%FO ;IS IT FILES-ONLY?
MOVX Q1,RC%NOM ;YES. INDICATE NO MATCH
CALL USTDIR ;UNLOCK THE DIRECTORY AND GO OKINT
RCU210: UMOVEM Q1,1 ;RETURN FLAGS
MOVE T1,RCUNUM ;GET USER NUMBER
TXNN Q1,RC%NOM!RC%AMB!RC%NMD ;Error?
UMOVEM T1,3 ;NO. RETURN DIRECTORY NUMBER
RETSKP ;TAKE SUCCESS RETURN
;RCUCLN - CLEAN UP FROM RCUSR
; CALL RCUCLN
;RETURNS +1: ALWAYS
;RELEASES JSB FREE SPACE IF ANY IS ASSIGNED
RCUCLN: SKIPN T2,RCUBLK ;GET ADDRESS OF BLOCK OBTAINED BY CPYFUS
RET ;WASN'T ANY, DONE
SETZM RCUBLK ;CLEAR IT
MOVEI T1,JSBFRE ;SPACE WAS IN JSB FREE SPACE
NOINT ;DISALLOW INTERRUPTS
CALL RELFRS ;RETURN SPACE AND REMOVE JSB STACK ENTRY
OKINT ;INTERRUPTS ALLOWED AGAIN
RET ;DONE
; Read directory
.RDDIR::MCENT
CALL CHKDEV
RETERR()
MOVEI B,(DEV)
CAIE B,DTADTB
RETERR(RDDIX1)
HLRZ A,DEV
CALL DTAMCK ;CHECK FOR DIRECTORY IN CORE
RETERR(RDDIX1) ;FAILED, DRIVE PROBABLY OFF LINE
HLRZ A,DEV
HRRZ B,DTASTS(A) ;GET MONITOR BUFFER ADDRESS
XMOVEI B,(B) ;MAKE IT CURRENT SECTION FOR BLT
MOVEI T1,200 ;200 WORDS TO MOVE
UMOVE C,B ;GET USER ADDRESS
CALL BLTMU1 ;DO BLT
SMRETN ;RETURN
; Read file byte size
; Call: 1 ; Jfn
; RFBSZ
.RFBSZ::MCENT
MOVE JFN,1
CALL CHKJFD
RETERR()
JFCL
RETERR(DESX4)
TQNN <OPNF>
RETERR(DESX5,<CALL UNLCKF>)
LDB A,PBYTSZ
UMOVEM A,2
CALL UNLCKF
SMRETN
; Read file byte number
; Call: 1 ; Jfn
; RFPTR
; Return
; +1 ; Error
; +2 ; Success
; 2 ; File byte number
.RFPTR::MCENT
MOVE JFN,1
CALL CHKJFD
RETERR()
JFCL
RETERR(DESX4)
TQNN <OPNF>
ERUNLK(DESX5)
MOVE A,FILBYN(JFN)
UMOVEM A,2
CALL UNLCKF
SMRETN
; READ FILE TIME AND DATE
; CALL: 1 ;JFN
; 2 ;ADDR
; 3 ;COUNT
; RFTAD
; RETURNS
; +1 ; ERROR, CODE IN 1
; +2 ; SUCCESS
; WITH: 1 ; UNCHANGED
; 2 ; UNCHANGED
; ADDR +0 ;TIME AND DATE OF CREATION
; ADDR +1 ;TIME AND DATE OF LAST WRITE
; ADDR +2 ;TIME AND DATE OF LAST READ
; ADDR +3 ;MONITOR LAST WRITE TIME AND DATE (PRIVILEGED)
; FIRST "COUNT" LOCATIONS OF "ADDR" FILLED WITH DATES
; ANY WORDS OF "ADDR" FOR WHICH NO DATE EXISTS ARE FILLED WITH -1
.RFTAD::MCENT
MOVE JFN,1
CALL CHKJFN
ITERR()
JFCL
JFCL
UMOVE A,3 ;GET COUNT
JUMPE A,RFTAD1 ;RETURN NOW IF 0 COUNT
UMOVE Q3,2 ;GET ADDR
XCTU [SETOM (Q3)] ;INITIALIZE TABLE TO -1
MOVE Q1,A ;[7.1044] Put count in Q1 for CALL @RFTADD
CAIN Q1,1 ;[7.1044] Done if only 1 word buffer
IFSKP. ;[7.1044]
SOS A ;[7.1181] Make sure count of words to init is correct
MOVE B,Q3 ;[7.1044] Get source of BLT
MOVE C,B ;[7.1044] Get destination of BLT...
ADDI C,1 ;[7.1044] ...by adding 1 to source
CALL BLTUU ;[7.1044] (A,B,C/) Now set all of arg block to -1
ENDIF. ;[7.1044]
CALL @RFTADD(P3) ;CALL DEVICE DEPENDENT ROUTINE
ITERR(,<CALL UNLCKF>) ;ERROR
RFTAD1: CALL UNLCKF
MRETNG
;GLOBAL ROUTINE FOR NO DATES AVAILABLE
RFTADN::RETSKP
; Release jfn
; Call: 1 ; Jfn
; RLJFN
; Returns
; +1 ; Error
; +2 ; Success
; Cannot release jfn if being assigned unless this same process as
; Assigner, and not at interrupt level
.RLJFN::MCENT
CAMN 1,[-1] ; Release all
JRST RLALL ;YES
HRRZ JFN,1
CALL RLJF
RETERR()
SMRETN
RLALL: MOVX A,CZ%NCL!.FHSLF ;DON'T CLOSE, SELF AND INFERIORS
CLZFF
ERJMPR [RETERR()] ;GIVE USER LAST ERROR
SMRETN
RLJF: PUSH P,JFN
HRRZS JFN
CALL CHKJFD
JRST RLJF1 ; Garbage jfn
JFCL
JRST [ MOVEI A,DESX4 ; Tty or byte illegal
JRST RLJF3]
TQNE <OPNF>
JRST [ MOVEI A,OPNX1 ; File is open
JRST RLJF4]
RLJF2: MOVEI A,0(JFN) ;GET JFN
CALL LUNLK0 ;FREE THE STR LOCK
RLJF5: CALL RELJFN ; Finally we can release it
AOSA -1(P)
RLJF4: CALL UNLCKF
RLJF3: POP P,JFN
RET
RLJF1: CAMG JFN,MAXJFN ;IS IT A CURRENTLY ASSIGNED JFN?
CAIE A,DESX3 ;YES, Is no name attached to this jfn?
JRST RLJF3 ; Some other error
HLRZ B,FILVER(JFN) ; Get fork number of originator
SKIPGE SYSFK(B) ; Fork still exists?
JRST RLJF5 ; No, ok to release
CAME B,FORKN ; Is it me?
JRST RLJF3 ; No
SKIPE PSIBIP ; Test if pi in progress
JRST RLJF3 ; Yes
JRST RLJF5 ; No pi in progress, ok to release
; Rename file
; Call: 1 ; Jfn 1
; 2 ; Jfn 2
; RNAMF
; Return
; +1 ; Error
; +2 ; Ok
.RNAMF::MCENT
CAMN 1,2 ;BE SURE NOT SAME JFN
SMRETN
MOVE JFN,1
CALL CHKJFN
RETERR()
JFCL
RETERR(DESX4) ; Cannot rename tty or byte
TQNE <ASTF>
ERUNLK(DESX7)
TQNE <OPNF>
ERUNLK(OPNX1) ; File must not be open
PUSH P,JFN
PUSH P,DEV
UMOVE JFN,2
CALL CHKJFN ; Check the second jfn
ERUNLK(,<POP P,DEV
POP P,JFN
MOVE STS,FILSTS(JFN)>)
JFCL
ERUNLK(DESX4,<POP P,DEV
POP P,JFN
MOVE STS,FILSTS(JFN)>)
TQNE <ASTF>
ERUNLK(DESX7,<CALL UNLCKF
POP P,DEV
POP P,JFN
MOVE STS,FILSTS(JFN)>)
TQNE <OPNF>
ERUNLK(OPNX1,<CALL UNLCKF
POP P,DEV
POP P,JFN
MOVE STS,FILSTS(JFN)>)
POP P,A
CAME A,DEV ; Can only rename on the same device
ERUNLK(RNAMX1,<PUSH P,A
CALL UNLCKF ;FREE THIS ONE
POP P,DEV ;DEV FOR THE SOURCE
POP P,JFN
MOVE STS,FILSTS(JFN)>)
MOVE A,(P)
PUSH P,JFN
CALL @REND(P3)
ERUNLK(,<POP P,JFN
MOVE STS,FILSTS(JFN)
CALL UNLCKF
POP P,JFN
MOVE STS,FILSTS(JFN)>)
POP P,JFN
MOVE STS,FILSTS(JFN)
CALL UNLCKF
POP P,JFN
MOVE STS,FILSTS(JFN)
MOVEI A,0(JFN)
CALL LUNLK0 ;FREE UP THE STR LOCK
CALL RELJFN
SMRETN
; Set account for file
; Call: 1 ; JFN
; 2 ; String pointer or 5B2+account number
; SACTF
; Returns:
; +1 ; Error, code in 1
; +2 ; Ok
.SACTF::MCENT ;MONITOR CONTEXT ENTRY
STKVAR <SACNUM,SACPTR> ;ACCOUNT NUMBER, FREE SPACE POINTER
MOVE JFN,T1 ;FETCH THE USER'S JFN
CALL CHKFIL ;CHECK ITS VALIDITY, WE WANT A FILE
RETERR() ;INVALID
TQNE <ASTF> ;PARSE-ONLY JFN?
ERUNLK(DESX7) ;YES, PARSE-ONLY IS AN ERROR
BLCAL. DSKOK,<P3> ;A DSK?
ERUNLK(SACTX1) ;NO, ERROR
CALL GETFDB ;YES, GET A POINTER TO THE FDB
ERUNLK(SACTX4) ;FAILED
MOVX T2,DC%CN ;CODE TO CONNECT TO DIRECTORY
CALL DIRCHK ;SEE IF USER CAN DO IT
ERUNLK(SACTX4,<ULKDIR>);NOT ENOUGH PRIVS
ULKDIR ;UNLOCK THE DIRECTORY
UMOVE T1,2 ;GET USER'S POINTER OR ACCOUNT
TLC T1,-1 ;DO POINTER ADJUSTMENT
TLCN T1,-1 ;-1 ,, ADR?
HRLI T1,(<POINT 7,0>) ;YES, SET UP BYTE POINTER INSTEAD
CAMG T1,[6B2-1] ;SEE IF BYTEPOINTER OR NUMERIC ACCOUNT
CAMGE T1,[5B2] ;[1817]
JRST SACTFS ;BYTE POINTER, GO DO STRING ACCOUNT
;HERE FOR A NUMERIC ACCOUNT - CONVERT TO STRING
MOVEM T1,SACNUM ;SAVE NEW NUMERIC ACCOUNT IN SACNUM
MOVEI T2,4 ;NUMERIC ACCOUNT, CONVERT TO STRING
CALL ASGJFR ;GET A SMALL BLOCK OF JSB FREE SPACE
ERUNLK(SACTX2) ;COULDN'T DO IT
MOVEM T1,SACPTR ;SAVE LOCATION OF THE BLOCK
HRROI T1,1(T1) ;PUT -1 IN LH, AND START IN SECOND WORD
MOVE T2,SACNUM ;GET THE ACCOUNT NUMBER BACK
TLZ T2,700000 ;ISOLATE THE VALUE PORTION
MOVEI T3,^D10 ;ACCOUNT NUMBERS ARE DECIMAL
NOUT ;DO THE CONVERSION TO A STRING
ERUNLK(,<MOVE T1,T3>) ;MOVE ERROR CODE TO T1 AND ERROR OUT
IBP T1 ;STEP PAST NULL SO COUNT IS RIGHT
HRRZ T2,T1 ;LAST LOCATION USED IN BLOCK
MOVE T1,SACPTR ;ORIGIN OF THE BLOCK
MOVE T3,T2 ;COPY LAST
SUB T3,T1 ;FULL WORDS IN BLOCK - 1
MOVNS T3 ;NEGATE IT
HRLM T3,SACPTR ;FUDGED LOOKUP POINTER TO ACCOUNT
CALL TRMBLK ;TRIM THE BLOCK
MOVE T2,SACPTR ;CALL INSACT WITH LOOKUP POINTER IN T2
CALL INSACT ;INSERT NUMERIC ACCOUNT AS STRING
JRST SACTER ;INSACT FAILED, CLEANUP AND ERROR OUT
JRST SACTFE ;CLEANUP AND EXIT
;HERE FOR STRING ACCOUNT
SACTFS:
MOVE T2,T1 ;SAVE POINTER FOR A WHILE
CALL PTRCHK ;CHECK THE POINTER FOR OWGBP'S
ERUNLK(SACTX2) ;BAD POINTER SO CAN NOT COPY IT
MOVE T1,T2 ;PUT POINTER WHERE IT CAN BE FOUND
CALL CPYFUS ;COPY FROM THE USER
ERUNLK(SACTX2) ;CANNOT COPY IT
UMOVEM T3,2 ;RETURN UPDATED POINTER TO USER
MOVE T2,T1 ;STRING LOOKUP POINTER TO T2 FOR INSACT
HRRZM T1,SACPTR ;SAVE ACCOUNT STRING POINTER
CALL INSACT ;SET THE ACCOUNT IN THE DIRECTORY
JRST SACTER ;INSACT FAILED, CLEANUP AND ERROR OUT
SACTFE: MOVE T2,SACPTR ;GET OLD FILACT
MOVEI T1,JSBFRE ;JSB SPACE TO FREE
CALL RELFRE ;RELEASE FREE SPACE FOR OLD FILACT
CALL UNLCKF ;RELEASE THE SPACE
SMRETN ;AND SKIP RETURN TO USER
;HERE FOR AN ERROR FROM INSACT
SACTER: MOVEM T1,LSTERR ;FAILED, SAVE ERROR CODE
MOVEI T1,JSBFRE ;AREA IS JSB FREE SPACE
HRRZ T2,SACPTR ;GET FREE POINTER
CALL RELFRE ;RELEASE THE STRING SPACE
MOVE T1,LSTERR ;GET OLD ERROR CODE BACK
ERUNLK() ;RETURN
; Set device status
; Call: 1 ; Jfn
; SDSTS
; Returns
; +1 ; Always unless traps
.SDSTS::MCENT
SDSTS1: UMOVE JFN,1
CALL CHKJFN
ITERR()
JFCL
ITERR(DESX4)
UMOVE A,2
TQZE <BLKF> ;BLKF MUST BE ZERO BEFORE CALL
BUG.(CHK,BLKF6,JSYSF,HARD,<.SDSTS - BLKF set before call to device routine>,,<
Cause: The bit indicating that a device routine wishes to block has been
set before the call to the device routine has been made. This bit
must be set to zero before the call so we do not block needlessly
(maybe never to wake up).
Action: The bit is being cleared. If this problem persists, change the
BUGCHK to a BUGHLT and find out where BLKF is being set.
>)
TQNE <OPNF>
CALL @SDSTD(P3)
TQZN <BLKF> ;ROUTINE WANT TO WAIT?
JRST UNL ;NO, JUST EXIT
CALL UNLDIS ;YES, GO DISMIS
JRST SDSTS1 ;LOOP BACK AND TRY AGAIN
; Set file byte size jsys
; Call: 1 ; Job file number
; 2 ; Byte size (1 to 36)
; SFBSZ
; Return
; +1 ; Error number in a
; +2 ; Success
.SFBSZ::MCENT
MOVE JFN,1
CALL DSKJFN
RETERR()
TQNN <OPNF>
RETERR(CLSX1,<CALL UNLCKF>)
XCTU [SKIPLE B,2]
CAILE B,^D36
RETERR(SFBSX2,<CALL UNLCKF>) ; Illegal byte size
TQNE <SIZF>
RETERR(SFBSX1,<CALL UNLCKF>) ; Illegal to change byte size
LDB A,PBYTSZ ; Get previous byte size
CALL NFBSZ
SETZM FILCNT(JFN) ;FORCE NEW WINDOW NEXT OPERATION
CALL UNLCKF ; Unlock file
SMRETN
; Set file byte number
; Call: 1 ; LSN flag,,Job file number
; 2 ; Byte number
; SFPTR
; Return
; +1 ; Error
; +2 ; Successful
.SFPTR::MCENT ; Become slow etc.
TRVAR <SAVJFN> ;[7321]This TRVAR <SAVJFN> must be the same as
;[7321] the TRVAR in routine SIN., BYTIN, etc.
;[7321] SAVJFN must be the first argument in
;[7321] TRVAR. Before using any TRVARs within
;[7321] the flow of this routine, make sure
;[7321] that SAVJFN contains the original JFN
;[7321] when BYTINX is called in routine TSTLSN
STKVAR <LSNFLG> ;[7321]
MOVE B,1 ;[7321]Get LSN flag,,JFN
HLLM B,LSNFLG ;[7321]Save the LSN flag bit
HRRZ JFN,B ;[7321] and JFN
MOVEM JFN,SAVJFN ;[7321]Save JFN for later
CALL DSKJFN ;[7321](JFN/)Check and lock JFN
RETERR()
TQNN <OPNF> ;[7321]Is it open?
ERUNLK(CLSX1) ;[7321]No, give the error
UMOVE A,2 ;[7321]Get byte count
SKIPG A ;[7321]Possibly EOF or invalid byte count?
JRST SFPT1 ;[7321]Yes, skip LSN checking
MOVE B,LSNFLG ;[7321]Get user LSN flag
TXNN B,SF%LSN ;[7321]Include LSN in calculation?
IFSKP.
CALL TSTLSN ;[7321](A/A)Yes, go calculate byte count
ERUNLK() ;[7321]Error
ENDIF.
SFPT1: CALL SFBNR ;[7321](A/)Set the byte number
ERUNLK()
CALL UNLCKF
SMRETN
ENDSV. ;[7321]End STKVR for this region
ENDTV. ;[7321]End TRVAR for this region
;TSTLSN - accepts a byte count in AC1 and returns the correct byte count based
; on whether the file has LSNs. Called only if SF%LSN is on.
;
; Call: A ; Byte number
; TSTLSN
; Return
; +1 ;Error while read bytes
; +2 ;Byte count based on LSN in A
TSTLSN: STKVAR <BYTCNT,BYTACC> ;[7321]Byte count, byte count accumulator
MOVEM A,BYTCNT ;[7321]Save it now
SETZM BYTACC ;[7321]Clear byte accumulator
SETZM FILBYN(JFN) ;[7321]Start at beginning
TQZ <EOFF> ;[7321]Not EOF
SETZM FILCNT(JFN) ;[7321]Force new window
CALL @JFNID(P3) ;[7321]Init JFN for input
TSTL1: CALL BYTINX ;[7321](/B)Get a byte
;[7321]BYTINX expects the original JFN in
;[7321] SAVJFN (Stored in a TRVAR <SAVJFN>).
JRST TSTEND ;[7321]Error or EOF
JUMPN B,TSTL2 ;[7321]Including LSN's means including nulls
MOVE A,FILBYN(JFN) ;[7321]Are we at beginning of file?
SOJE A,TSTNLS ;[7321]Yes, file can't have line numbers
AOS BYTACC ;[7321]Add the null to the total count
JRST TSTL1 ;[7321]Get the next byte
TSTL2: LDB A,[POINT 12,FILBYT(JFN),11];[7321]Get byte position and size fields
MOVE C,FILCNT(JFN) ;[7321]Get remaining bytes in buffer
CAIE A,<POINT 7,0,6>_-^D24;[7321]First byte of a word?
IFSKP. ;[7321]
CAIL C,4 ;[7321]Yes, enuf for a line #?
IFSKP. ;[7321]
MOVE A,FILBYN(JFN) ;[7321]No, are we at beginning of file?
SOJE A,TSTNLS ;[7321]Yes, file can't have line numbers
ELSE. ;[7321]
HRRZ A,FILBYT(JFN) ;[7321]Get the word we got the character from
MOVE A,0(A) ;[7321]Do indirect
TXNE A,1B35 ;[7321]Bit 35 on? If so, call it a line #
IFSKP. ;[7321]
MOVE A,FILBYN(JFN);[7321]No, are we at beginning of file?
SOJE A,TSTNLS ;[7321]Yes, file can't have line numbers
ELSE. ;[7321]We have a line number
MOVNI A,4 ;[7321]Skip the rest of the line number quickly
ADDM A,FILCNT(JFN);[7321]Update remaining byte count in buffer
MOVEI A,4 ;[7321]Just read in four bytes
ADDM A,FILBYN(JFN);[7321]Update FILBYN
MOVX A,77B5 ;[7321]Now point to last byte in word
ANDCAM A,FILBYT(JFN);[7321]To "read" those 4
CALL BYTINX ;[7321](/B)Skip the tab after the LSN
;[7321]BYTINX expects the original JFN in
;[7321] SAVJFN, (Stored in a TRVAR <SAVJFN>.)
JRST TSTEND ;[7321]Error or EOF
MOVEI B,6 ;[7321]Just skipped 5 characters and TAB
ADDM B,BYTACC ;[7321]Add it to the new byte count
JRST TSTL1 ;[7321]And get a real one
ENDIF. ;[7321]
ENDIF.
ENDIF.
TSTL5: AOS BYTACC ;[7321]Increment new byte count
SOSE BYTCNT ;[7321]Decrement original byte count
JRST TSTL1 ;[7321]If not done get another byte
MOVE A,BYTACC ;[7321]Else store new byte count in A
RETSKP ;[7321] and return good.
TSTNLS: MOVE A,BYTCNT ;[7321]No, LSNs
RETSKP ;[7321]just return
TSTEND: CAIE A,IOX4 ;[7321]EOF?
RET ;[7321]No, error return
MOVE A,BYTACC ;[7321]Yes, return byte count as the last byte
RETSKP ;[7321]Good return
ENDSV. ;[7321]End STKVR for this region
; SET FILE TIME AND DATE
; CALL: 1 ;JFN
; 2 ;ADDR
; 3 ;COUNT
; ADDR +0 ;TIME AND DATE OF CREATION
; ADDR +1 ;TIME AND DATE OF LAST WRITE
; ADDR +2 ;TIME AND DATE OF LAST READ
; ADDR +3 ;MONITOR LAST WRITE TIME AND DATE (PRIVILEGED)
; ; TIME AND DATE = -1 FOR NO CHANGE
; SFTAD
; RETURNS
; +1 ; ERROR, CODE IN 1
; +2 ; SUCCESS
.SFTAD::MCENT
MOVE JFN,1
CALL CHKJFN
ITERR()
JFCL
JFCL
UMOVE Q1,3 ;GET COUNT FOR SUBRS
JUMPLE Q1,SFTAD1 ;JUST RETURN IF COUNT = 0
UMOVE Q3,2 ;GET ADDR
TLNE Q3,-1 ;DONT ALLOW BIG ADDRESSES
ITERR(ILLX01,<CALL UNLCKF>) ;GENERATE ERROR
MOVE T1,CAPENB ;CHECK DATES?
TRNE T1,SC%WHL!SC%OPR ;WHEEL OR OPERATOR?
JRST SFTAD2 ;CAN SET ANYTHING
CALL LGTAD ;GET TIME AND DATE IN STANDARD FORMAT
JUMPL A,[ITERR(DATEX6,<CALL UNLCKF>)] ;LOSE IF NOT SET
MOVN B,Q1 ;GET - LENGTH
HRLZ B,B
HRR B,Q3 ;AND TABLE ADDR
SFTAD3: XCTU [MOVE C,(B)] ;GET ENTRY
CAME C,[-1] ;NOT CHANGING,
CAMG C,A ;OR LEGAL TIME AND DATE?
AOBJN B,SFTAD3 ;YES, GET NEXT
JUMPGE B,SFTAD2 ; Checked all entries
HRRZ D,B ; Get offset
SUB D,Q3 ;MAKE AN INDEX
CAIE D,.RSNET ; In range where an interval is legal?
CAIN D,.RSFET
CAIA
ITERR(DATEX5,<CALL UNLCKF>) ;ILLEGAL TIME AND DATE?
AOBJN B,SFTAD3 ; Do all entries
SFTAD2: CALL @SFTADD(P3) ;CALL DEVICE DEPENDENT ROUTINE
ITERR(,<CALL UNLCKF>) ;ERROR
SFTAD1: CALL UNLCKF
MRETNG
;GLOBAL ROUTINE FOR NO DATES AVAILABLE
SFTADN::RETSKP
; SET FILE USER STRING
;
; CALL: (ARGUMENTS IN USER SPACE)
; ACCEPTS IN T1/ FUNCTION,,JFN
; T2/ POINTER TO NAME STRING
; SFUST
; RETURNS: +1 ALWAYS
.SFUST::MCENT ;MONITOR CONTEXT ENTRY
TRVAR <SFUBLK,SFUFDA,SFUDIR,SFUERR,SFSPTR> ;ALLOCATE LOCAL STORAGE
; VALIDATE THE FUNCTION REQUESTED
XCTU [ HLRZ T3,1 ] ;GET FUNCTION CODE FROM USER
CAIE T3,.SFAUT ;IS FUNCTION "SET AUTHOR STRING" ?
CAIN T3,.SFLWR ; OR "SET LAST WRITER" ?
SKIPA ;YES, PROCEED
ITERR (SFUSX1) ;NO, RETURN "INVALID FUNCTION" ERROR
; COPY NAME STRING FROM USER AND TRANSLATE TO DIRECTORY NUMBER
UMOVE T1,2 ;GET POINTER TO NAME STRING IN USER SPACE
CALL CPYFU0 ;COPY STRING FROM USER SPACE
ITERR (SFUSX2) ;FAILED, RETURN "INSUFFICIENT RESOURCES" ERROR
MOVEM T1,SFUBLK ;SAVE ADDRESS OF BLOCK ASSIGNED
MOVEM T3,SFSPTR ;SAVE THE UPDATED BYTE PTR
XCTU [HRRZ JFN,1] ;GET JFN
CALL DSKJFN ;VALIDATE FOR FILE ONLY
ITERR (,<MOVEM T1,SFUERR ;SAVE THE ERROR CODE
CALL SFUX2
MOVE T1,SFUERR>)
CALL GETFDB ;GET FDB MAPPED
ITERR (SFUSX4,<CALL SFUX1>)
MOVEM T1,SFUFDA ;SAVE FDB ADDRESS
XCTU [HLRZ T3,1] ;GET FCN CODE AGAIN
MOVE T2,CAPENB ;CHECK IF ENABLED
TXNE T2,SC%WHL!SC%OPR
JRST SFUSOK ;OK TO PROCEED
CAIN T3,.SFLWR ;WANT TO SET LAST-WRITER?
ITERR (CAPX1,<CALL SFUXIT>) ;NEED TO BE WHOPER
MOVX T2,DC%CN ;ELSE OWNER PRIVS FOR AUTHOR
CALL DIRCHK ; STRING SETTING
ITERR (SFUSX5,<CALL SFUXIT>)
SFUSOK: MOVE T1,SFUFDA ;GET FDB ADDRS AGAIN
LOAD T2,FBVER,(T1) ;LOOK AT FDB VERSION #
CAIGE T2,1 ;VERSION 1 OR LATER?
JRST SFUS10 ;OLD FDB - DIFFERENT CODE
XCTU [HLRZ T2,1] ;GET FCN AGAIN
MOVEI T3,.FBAUT ;ASSUME AUTHOR
CAIE T2,.SFAUT ;IS IT?
MOVEI T3,.FBLWR ;NO - SET LAST-WRITER
MOVE T2,SFUBLK ;POINTER TO STRING BLOCK
CALL INSUNS ;INSERT STRING INTO DIRECTORY
CALL SFUXIT ;UNLOCK THINGS
MOVE T2,SFSPTR ;RESTORE THE BYTE PTR
UMOVEM T2,2
JRST MRETN ;RETURN
;COMMON EXIT (CLEANUP) ROUTINES
SFUXIT: CALL USTDIR ;UNLOCK DIRECTORY
SFUX1: CALL UNLCKF ;UNLOCK JFN
SFUX2: MOVEI T1,JSBFRE ;FREE UP JSB FREE SPACE
MOVE T2,SFUBLK ;...
CALL RELFRE
OKINT ;ALLOW INTS AGAIN
RET ;RETURN
;HANDLE OLD STYLE FDB (CONVERT STRING TO USER # FIRST)
SFUS10: CALL USTDIR ;FIRST UNLOCK DIRECTORY
MOVE T1,LGSIDX ;[7.1112]Look on Login Structure
CALL STRCNV ;GET UNIQUE CODE
ITERR (SFUSX6,<CALL SFUX1>)
MOVE T2,T1 ;COPY FOR DIRLUK
MOVE T1,SFUBLK ;POINT TO STRING
MOVEI T3,0 ;DON'T NEED THIS IF NO RECOG.
TQO <NREC> ;SAY DON'T RECOGNIZE
CALL DIRLUK ;SEE IF VALID USER NAME ON PS
ITERR (SFUSX6,<CALL SFUX1>) ; NO SUCH USER
MOVEM T1,SFUDIR ;SAVE DIRECTORY NUMBER
CALL GETFDB ;GET FDB AGAIN
ITERR (SFUSX4,<CALL SFUX1>) ;FILE DISAPPEARED
XCTU [HLRZ T3,1] ;GET USER FCN AGAIN
HRRZ T2,SFUDIR ;GET DIRECTORY NUMBER
CAIE T3,.SFAUT ;SETTING AUTHOR?
JRST [STOR T2,FBLW0,(T1) ;NO - ASSUME LAST WRITER THEN
JRST SFUS20]
STOR T2,FBAT0,(T1) ;YES - STASH DIR #
SFUS20: CALL SFUXIT ;UNLOCK EVERYTHING
MOVE T2,SFSPTR ;RESTORE UPDATED BYTE PTR
UMOVEM T2,2
JRST MRETN ;AND RETURN
;SIBE - Skip if input buffer empty
;ACCEPTS:
; T1/ DEVICE DESIGNATOR
; SIBE
;RETURNS +1: INPUT BUFFER NOT EMPTY
; T2/ NUMBER OF BYTES IN BUFFER
; +2: INPUT BUFFER EMPTY OR ERROR
; T2/ 0 IF EMPTY OR NOT OPEN FOR READ
; OR
; ERROR CODE IF ERROR
.SIBE:: MCENT
STKVAR <SIBEBS>
CALL CHKTTR
JRST SIBE1
MOVEM C,SIBEBS ;SAVE BYTE SIZE
;DEVICE IS A TERMINAL
CALL LCKTTY ;POINT TO DYNAMIC DATA, PREVENT DEALLOCATION
JRST [ CALL ULKTTY ;NOT ACTIVE. ALLOW DEALLOCATION
MOVEI A,TTYX01 ;INDICATE LINE IS NOT ACTIVE
UMOVEM A,B ;RETURN ERROR CODE IN 2
MOVEM T1,LSTERR ; AND IN LSTERR
SMRETN] ;RETURN +2
MOVE C,SIBEBS ;GET BYTE SIZE FOR TTSIBE
CALL TTSIBE ;GO CHECK INPUT BUFFER
JRST [ UMOVEM A,B ;NOT EMPTY. RETURN COUNT
CALL ULKTTY ;ALLOW DEALLOCATION
JRST EMRET1] ;RETURN +1
CALL ULKTTY ;EMPTY. ALLOW DEALLOCATION
UMOVEM A,B ;RETURN COUNT OF 0
SMRETN ;RETURN +2
SIBE1: CAIE A,DESX6 ;LEGAL, NON-TTY DESIGNATOR?
JRST [ MOVEM T1,LSTERR ;RETURN ERROR CODE IN LSTERR
UMOVEM T1,2 ; AND USER AC2
SMRETN] ;THEN TAKE SKIP RETURN
TQNE <OPNF>
TQNN <READF>
JRST [ SETZ A,
JRST SIBE2]
CALL @JFNID(P3) ;GO INIT JFN FOR INPUT
SKIPLE A,FILCNT(JFN)
JRST [ UMOVEM A,B
JRST EMRET1]
SIBE2: UMOVEM A,B ;RETURN ERROR CODE OR 0
SMRETN ;+2 RETURN
; Get size of file
; Call: 1 ; Jfn
; SIZEF
; Return
; +1 ; Error, cannot get size of file
; +2 ; Success
; 1 ; Size in bytes
; 2 ; Size in pages
.SIZEF::MCENT
STKVAR <SIZFT,SIZFB>
MOVE JFN,1
CALL CHKJFN
JRST GBGJFN
JFCL
ERUNLK DESX4
TQNE <ASTF>
ERUNLK(DESX7)
MOVEI A,DESX8
BLCAL. DSKOK,<DEV> ;DSK?
ERUNLK()
LOAD A,STR,(JFN) ;[7.1063]Get the structure number
CALL CKSTOF ;[7.1063](T1/T1)Is the structure offline?
ERUNLK () ;[7.1063]Return "Structure is offline"
CALL GETFDB ; Get pointer to fdb
ERUNLK OPNX2
LOAD B,FBNPG,(A) ; GET NUMBER OF PAGES
TQNN <OPNF> ;FILE OPENED?
JRST [ MOVE A,.FBSIZ(A) ; NO - USE LENGTH IN FDB
JRST SIZEF1]
HLRZ D,FILOFN(JFN) ;GET OFN
TQNE <LONGF>
HRRZ D,FILOFN(JFN) ;USE THIS IF LONG FILE
MOVEM D,SIZFT ;Save the OFN
MOVEM B,SIZFB ;Save the number of pages
MOVE A,D ;Copy the OFN
MOVEI B,0 ;Only need read access in order ...
CALL CFSAWT ;(T1,T2) ... to get up-to-date EOF info
MOVE D,SIZFT ;Get OFN back
MOVE B,SIZFB ;Get the number of pages back
MOVE A,OFNLEN(D) ;[7.1059] Get OFNLEN
CAMN A,[-1] ;[7.1059] Is it code for 34359738367(36)?
SKIPA A,[.INFIN] ;[7.1059] Make 34359738367 byte count
LOAD A,OFNBC,(D) ;[7.1059] Get true file length
SIZEF1: UMOVEM A,2
UMOVEM B,3
CALL USTDIR
CALL UNLCKF
SMRETN
GBGJFN: RETERR ()
ENDSV. ;End of CHFDB STKVAR region
;FILE PORTION OF SMAP JSYS. GOTTEN HERE IF MAPPING TO A FILE.
;ACCEPTS:
; T1/ SOURCE I.D. (JFN,,SECTION NUMBER)
; Q1/ STARTING SECTION IN SOURCE
; Q2/ DESTINATION (SPT INDEX OF PSB,,SECTION NUMBER)
; Q3/ ACCESS,,COUNT
; CALL SMFILE
;RETURNS: +1 FAILURE. T1/ERROR CODE
; +2 SUCCESS
SMFILE::MOVEI T2,-1(Q3) ;GET COUNT
ADD T2,Q1 ;COMPUTE LAST SECTION IN SOURCE
CAILE T2,777 ;LEGAL SECTION?
RETBAD (ARGX23) ;NO. ILLEGAL SECTION
HLRZ JFN,T1 ;GET THE JFN
CALL DSKJFN ;VERIFY, LOCK
RETBAD () ;NOT VALID
TQNN <OPNF> ;OPENED?
RETBAD (DESX5,<CALL UNLCKF>) ;NO. ERROR THEN
TQNN <READF> ;READ OK?
RETBAD (OPNX3,<CALL UNLCKF>) ;NO - CAN'T MAP XCT-ONLY FILE.
TQNN <WRTF> ;OPEN FOR WRITE?
TXZ Q3,PM%WT ;NO. CAN'T HAVE WRITE ACCESS THEN
LSH Q1,PGSFT ;CONVERT SECTION # TO PAGE
;MAP A SECTION AT A TIME. GET THE OFN FOR EACH 1000-PAGE SECTION
;OF THE FILE AND MAP IT TO THE NEXT SECTION IN THE DESTINATION
;Q1/ PAGE NUMBER (SECTION NO. * 1000)
SMFIL1: MOVE T1,Q1 ;GET PAGE NUMBER OF SECTION
TXNN Q3,PM%WT ;WANT WRITE?
SKIPA T2,[JFNOF3]
MOVEI T2,JFNOF1
CALL 0(T2) ;GET OFN,,PN
JRST [ MOVE Q1,T1 ;SAVE ERROR
CALL UNLCKF ;UNLOCK FILE
MOVE T1,Q1 ;RESTORE ERROR
RETBAD ()] ;DONE
HLRZS T1 ;GET OFN
;SECMAP WILL DO THIS
; CALL UPSHR ;MAKE SURE IT DOESN'T DISAPPEAR
DMOVE T2,Q2 ;GET OTHER ARGS
HLLZS T3 ;ISOLATE FLAGS
CALL SECMAP ;MAP IT
RETBAD () ;LOSE, ERROR CODE IN T1
ADDI Q1,PGSIZ ;NEXT SECTION
ADDI Q2,1 ;NEXT PROCESS SECTION
SUBI Q3,1 ;ONE LESS TO DO
MOVX T1,2B17 ;INCREMENTER
ADDM T1,FILLFW(JFN) ;REMEMBER MAP
TRNE Q3,-1 ;MORE TO DO?
JRST SMFIL1 ;YES
CALL UNLCKF ;NO. UNLOCK JFN
RETSKP ;SUCCESS
; String to directory
; Call: 1 ; Positive for no recognition
; 2 ; Source designatoR
; STDIR
; Return
; +1 ; No match
; +2 ; Ambiguous
; +3 ; Unique match
.STDIR::MCENT
ITERR(STDIX1) ;STDIR WAS REPLACED BY RCUSR AND RCDIR
;JSYS TO CONVERT A STRING TO A PPN (TOPS10 STYLE)
;ACCEPTS IN T1/ 36-BIT DIRECTORY #
; JFN
; STRING-PNTR TO STR/DIRECTORY NAME
;RETURNS +1 ALWAYS T2/ PPN
.STPPN::MCENT
UMOVE T1,1 ;GET USER ARG
TLNN T1,-1 ;POSIBLE JFN?
JRST STPPJ ;YES - TRY IT
STPPNX: CALL CNVSTD ;STRING OR 36 BIT DIR # - TRY TO GET DIR #
ITERR () ;RETURN LOSAGE INFO
CALL SETDIR ;DIR # - MAP IT
ITERR () ;RETURN LOSAGE INFO
CALL USTDIR ;VALID # - UNLOCK DIR
MOVE T2,DIRORA ;DIRECTORY ORGIN
LOAD T2,DRPPN,(T2) ;GET PPN FROM DIR
SKIPE T2 ;IF PPN FROM THE DIRECTORY IS NON-ZERO
SKIPA T1,T2 ;USE PPN FROM DIRECTORY
HRLI T1,PPNLH ;ELSE, RETURN OLD STYLE
UMOVEM T1,2 ;RETURN TO USER AC2
JRST MRETN ;RETURN
STPPJ: MOVE JFN,T1 ;PUT JFN IN AC(JFN)
CALL DSKJFN ;CHECK IF A DISK
ITERR () ;NOPE - RETURN ERROR
LOAD T1,FLUC,(JFN) ;YES - GET STR #
HRLZS T1 ;TO THE LEFT HALF
HRR T1,FILDDN(JFN) ;GET DIR #
CALL UNLCKF ;UNLOCK JFN
JRST STPPNX ;COMMON EXIT
; Set status
; Call: 1 ; Jfn
; 2 ; New status
; STSTS
; Returns
; +1 ; Erro2
; +2 ; Ok (only errf, hltf, and frkf can be changed)
.STSTS::MCENT
MOVE JFN,1
CALL CHKJFN
RETERR() ; Bad jfn
JFCL
RETERR(DESX4) ; Tty and byte bad
UMOVE A,2 ; Get new status
ANDCA A,[ERRF!HLTF!FRKF]
TDZ STS,A
CALL UNLCKF
SMRETN
; Swap jfn's
; Call: 1 ; Jfn 1
; 2 ; Jfn 2
; SWJFN
.SWJFN::MCENT
MOVE JFN,1
CAMN 1,2 ;SWAPPING SAME JFN?
ITERR(SWJFX1) ;ILLEGAL, TELL USER
CALL CHKFIL
ITERR()
CALL CHKATS ;IS THIS AN ATS JFN?
JRST [ MOVE A,JFN ;YES. SET UP JFN FOR LUNLKF
CALL LUNLKF ;UNLOCK THE JFN
ITERR (SWJFX2)] ;RETURN 'ILLEGAL TO SWAP ATS JFN'
PUSH P,JFN ;NO. SAVE THE FIRST JFN
UMOVE JFN,2 ;GET THE SECOND JFN
CALL CHKFIL
ITERR(,<POP P,JFN
MOVE DEV,FILDEV(JFN)
MOVE STS,FILSTS(JFN) ;RESTORE STS CLOBBERED BY CHKJFN
CALL UNLCKF>)
CALL CHKATS ;IS THIS AN ATS JFN?
JRST [ MOVE A,JFN ;YES. SET UP FOR LUNLKF
CALL LUNLKF ;UNLOCK THE SECOND JFN
POP P,A ;SET UP THE FIRST JFN FOR LUNLKF
CALL LUNLKF ;UNLOCK THE FIRST JFN
ITERR (SWJFX2)] ;RETURN 'ILLEGAL TO SWAP ATS JFN'
POP P,A ;NO. GET THE FIRST JFN
MOVE B,[XWD -MLJFN,JFN0] ;Get AOBJN word over all JFN cells
HRLI A,B+(IFIW) ;Make first JFN an indexed local ifiw
HRLI JFN,B+(IFIW) ;Same with second
SWJFNL: ;Exchange all JFN cells between the two JFN's
MOVE C,@JFN
EXCH C,@A
MOVEM C,@JFN
AOBJN B,SWJFNL
MOVEI A,0(A) ;Get JFN only
CALL SCSWJF ;Do DECNET-dependent part of SWJFN% for 1st JFN
CALL LUNLKF ;RELEASE LOCK ON THIS JFN
MOVEI A,0(JFN) ;GET OTHER
CALL SCSWJF ;Do DECNET-dependent part of SWJFN% for 2nd JFN
CALL LUNLKF ;AND RELEASE THIS ONE ALSO
JRST MRETN
;UPDATE FILE PAGES
; A/ IDENT OF FIRST PAGE (JFN,,PN)
; B/ COUNT OF SEQUENTIAL PAGES TO UPDATE
; UFPGS
; RETURN +1: FAILURE
; RETURN +2: SUCCESS, ALL MODIFIED PAGES WRITTEN TO DSK. FDB UPDATED
; IF NECESSARY. BLOCKS UNTIL ALL WRITES COMPLETE
.UFPGS::MCENT
MOVE Q1,A ;SAVE ID
HRRZ Q2,B ;SAVE COUNT
HLRZ JFN,Q1
CALL DSKJFN ;ENSURE JFN ON DSK
RETERR()
TQNE <OPNF> ;[7451] Is file open?
TQNN <WRTF> ;OPEN FOR WRITE?
ERUNLK UFPGX1 ;NO, WRONG.
TQNE <LONGF> ;IS THE FILE LONG?
JRST UFPG1 ;YES
CAILE Q2,PGSIZ ;FILE IS SHORT...IS COUNT EXCESSIVE?
MOVEI Q2,PGSIZ ;YES...ADJUST IT
UFPG1: HRRZ A,Q1 ;GET CURRENT IDENT
CALL JFNOF3 ;GET OFN.PN
JRST [ CAIE A,LNGFX1 ;TRIED TO CREATE A PT?
JRST ERUNLD ;NO. GIVE THE ERROR THEN
HRRO A,Q1 ;GET PN IN RH AND -1 IN LH
TRZ A,777000 ;GET CURRENT PT OFFSET ONLY
JRST .+1] ;GO IN-LINE
MOVEM A,Q3
MOVEI B,PGSIZ ;COMPUTE NUMBER WORDS LEFT IN PT
SUBI B,0(A)
CAML B,Q2 ;GREATER THAN REMAINING COUNT?
HRRZ B,Q2 ;NO, USE COUNT
ADD Q1,B ;UPDATE IDENT
SUB Q2,B ;UPDATE COUNT
SKIPGE Q3 ;DOES THIS PT EXIST
JRST UFPG2 ;NO. SKIP OFN UPDATING THEN
XCTU [HLL B,2] ;COPY FLAGS
CALL UPDPGS ;DO THE WORK
HLRZ A,Q3
CALL UPDOFN ;UPDATE OFN ALSO
UFPG2: JUMPG Q2,UFPG1 ;LOOP OF COUNT NON-0
CALL GETFDB ;CHECK FDB ALSO
JRST UFPG4 ;COULDN'T, ASSUME OK (SHOULDN'T HAPPED)
MOVX B,FILNB
MOVX C,FB%NXF
TDNN B,.FBADR(A) ;NEW FILE?
TDNE C,.FBCTL(A) ;OR NONX?
JRST [ ANDCAM B,.FBADR(A) ;YES, NORMALIZE
ANDCAM C,.FBCTL(A)
CALL UPDDIR ;AND UPDATE DIRECTORY
JRST .+1] ;FILE NOW GUARANTEED ON DISK
CALL USTDIR ;RELEASE DIRECTORY
UFPG4: CALL UNLCKF ;UNLOCK JFN
SMRETN
;WILD% JSYS. USED TO COMPARE TWO STRINGS TO SEE IF THEY MATCH, OR
;TWO JFNS TO SEE IF THEY MATCH. THE FIRST STRING OR JFN CAN CONTAIN
;WILDCARD CHARACTERS.
.WILD:: MCENT ;ENTER JSYS
HLLZ F,T1 ;PUT FLAGS IN A SAFE PLACE
ANDI T1,-1 ;ISOLATE FUNCTION CODE
CAILE T1,WLDMXF ;LEGAL?
ITERR (ARGX02) ;NO
SETZ Q2, ;INITIALIZE FLAGS TO BE RETURNED
CALL @WLDDSP(T1) ;DO THE WORK
UMOVEM Q2,1 ;GIVE USER THE RESULT
MRETNG ;DONE
WLDDSP: IFIW WLDSTR ;(0) COMPARE STRINGS
IFIW WLDJFN ;(1) COMPARE JFNS
WLDMXF==.-WLDDSP-1 ;MAXIMUM LEGAL FUNCTION
;STRING COMPARE FUNCTION. AC2 CONTAINS BYTE POINTER TO WILD STRING,
;AC3 CONTAINS BYTE POINTER TO NON-WILD STRING.
WLDSTR: TLNE F,-1-<(WL%LCD)> ;SPECIFYING ILLEGAL BITS?
ITERR (ARGX22) ;YES
UMOVE T1,3 ;SET UP NON-WILD POINTER
UMOVE T2,2 ;AND WILD POINTER
TLC T1,-1 ;GET SET TO DEFAULT LEFT HALFS
TLC T2,-1
TLCN T1,-1 ;WAS LEFT HALF -1?
HRLI T1,(POINT 7,) ;YES, USE DEFAULT
TLCN T2,-1 ;HOW ABOUT OTHER POINTER?
HRLI T2,(POINT 7,) ;YES, FILL IN
; Check both pointers for reasonableness
LDB T3,[POINT 6,T1,5] ;[7162] Get postion if local or P&S if global
CAILE T3,44 ;[7162] If .le. to 44 then we have
IFSKP. ;[7162] a local byte pointer
LDB T3,[POINT 6,T1,11] ;[7162] Get the byte size
CAIGE T3,7 ;[7162] It must be at least 7
ITERR (ARGX09) ;[7162] An error if not
ELSE. ;[7162] Probably a OWGBP
CAIL T3,54 ;[7162] Is it at least 7 bits wide?
CAIL T3,77 ;[7162] A P&S of 77 is illegal
ITERR (ARGX09) ;[7162] No, then no good
ENDIF.
LDB T3,[POINT 6,T2,5] ;[7162] Get postion if local or P&S if global
CAILE T3,44 ;[7162] If .le. to 44 then we have
IFSKP. ;[7162] a local byte pointer
LDB T3,[POINT 6,T2,11] ;[7162] Get the byte size
CAIGE T3,7 ;[7162] It must be at least 7
ITERR (ARGX09) ;[7162] An error if not
ELSE. ;[7162] Probably a OWGBP
CAIL T3,54 ;[7162] Is it at least 7 bits wide?
CAIL T3,77 ;[7162] A P&S of 77 is illegal
ITERR (ARGX09) ;[7162] No, then no good
ENDIF.
MOVEI T3,[PUSHJ P,WLDCH1 ;POINT AT INSTRUCTIONS
PUSHJ P,WLDCH2] ;WHICH WILL OBTAIN USER CHARS
CALL CHKWLS ;SEE IF STRINGS MATCH
TXOA Q2,WL%NOM ;NO, SET FLAG BIT
RET ;YES, ALL DONE
SKIPE T1 ;IS IT AN ABBREVIATION?
TXO Q2,WL%ABR ;YES, SET THAT
RET ;DONE
;ROUTINES TO READ THE CHARACTERS FROM THE USER'S CORE.
;CHARACTERS HAVE TO BE RETURNED IN AC Q1 FOR CHKWLS TO USE.
WLDCH1: XCTBU [ILDB Q1,T2] ;READ CHARACTER OF WILD STRING
ERJMPR [ITERR()] ;IN CASE REFERENCE FAILS
JRST WLDCHC ;GO CHECK LOWER CASE
WLDCH2: XCTBU [ILDB Q1,T1] ;READ CHARACTER OF NON-WILD STRING
ERJMPR [ITERR()] ;IN CASE REFERENCE FAILS
WLDCHC: CAIL Q1,"A"+40 ;IS CHARACTER LOWER CASE?
CAILE Q1,"Z"+40 ;WELL?
RET ;NO
TXNN F,WL%LCD ;SHOULD WE CONVERT TO UPPER CASE?
SUBI Q1,40 ;YES, DO SO
RET ;DONE
;JFN COMPARE FUNCTION. AC2 CONTAINS A WILD JFN, AND AC3 CONTAINS
;A NON-WILD JFN.
WLDJFN: TLNE F,-1 ;SUPPLYING ANY FLAGS?
ITERR (ARGX22) ;YES, GIVE ERROR
UMOVE JFN,3 ;GET JFN OF TEST FILE
TLNE JFN,-1 ;SPECIFYING ANY WILD FLAGS?
ITERR (WILDX1) ;YES, THAT IS ILLEGAL
MOVE Q3,JFN ;SAVE FOR LATER
CALL CHKFIL ;CHECK VALIDITY OF FILE JFN
ITERR () ;ERROR IF BAD
MOVE Q1,JFN ;REMEMBER JFN OFFSET OF TEST FILE
UMOVE JFN,2 ;GET JFN OF WILD FILE
XOR Q3,JFN ;REMEMBER FLAG BITS AND COMPARE JFNS
TRNN Q3,-1 ;WERE THE WILD AND TEST JFNS THE SAME?
JRST WLJFN2 ;YES, A FILE MATCHES ITSELF!
TLZ JFN,-1 ;CLEAR FLAGS
CALL CHKFIL ;VALIDATE THIS JFN TOO
ITERR (,<CALL WLERR>) ;BAD, UNLOCK FIRST JFN AND QUIT
TXNN Q3,GJ%DEV!GJ%UNT ;DOES USER WANT WILD DEVICE OR UNIT?
JRST WLDEV ;NO, GO COMPARE EXPLICIT DEVICES
MOVE T1,FILSTS(Q1) ;GET FILE STATUS OF TEST JFN
TXNE T1,ASTF ;IS IT PARSE ONLY?
JRST WLJFD ;YES, THEN IT MATCHES
BLCAL. DSKOK,<<FILDEV(Q1)>> ;A DSK?
TXO Q2,WL%DEV ;NO, SET DEVICES DIFFER FLAG
JRST WLJFD ;GO ON TO DIRECTORIES
WLDEV: HLRZ T1,FILDDN(JFN) ;GET DEVICE STRING OF WILD FILE
HLRZ T2,FILDDN(Q1) ;AND OF TEST FILE
CALL FLDCMP ;COMPARE THEM
TXO Q2,WL%DEV ;NO MATCH, SET DEVICES DIFFER FLAG
WLJFD: LOAD T2,FLDIR,(JFN) ;GET DIRECTORY STRING OF WILD FILE
TXNN Q3,GJ%DIR ;WANT TO USE WILDCARDS INSTEAD?
JRST WLJFD1 ;NO, USE THIS STRING
LOAD T2,FLDMS,(JFN) ;GET WILD STRING
JUMPE T2,WLJFF ;IF NONE, ASSUME "*" AND MATCH
WLJFD1: LOAD T1,FLDIR,(Q1) ;GET DIRECTORY STRING OF TEST FILE
CALL FLDCMP ;DO THE COMPARISON
TXO Q2,WL%DIR ;NO MATCH, SET DIRECTORIES DIFFER FLAG
WLJFF: HLRZ T2,FILNEN(JFN) ;GET FILENAME STRING
TXNN Q3,GJ%NAM ;WILDCARDING DESIRED?
JRST WLJFF1 ;NO, SO USE THIS STRING
LOAD T2,FLNMS,(JFN) ;GET WILD STRING IF ANY
JUMPE T2,WLJFE ;IF NONE, ASSUME "*" AND MATCH
WLJFF1: HLRZ T1,FILNEN(Q1) ;GET FILENAME STRING OF TEST FILE
CALL FLDCMP ;DO THE COMPARISON
TXO Q2,WL%NAM ;NO MATCH, SET FILENAMES DIFFER FLAG
WLJFE: HRRZ T2,FILNEN(JFN) ;GET EXTENSION STRING
TXNN Q3,GJ%EXT ;SHOULD WE DO WILDCARDING?
JRST WLJFE1 ;NO, USE THIS STRING
LOAD T2,FLEMS,(JFN) ;GET WILD MASK
JUMPE T2,WLJFG ;IF NONE, MATCH THIS FIELD
WLJFE1: HRRZ T1,FILNEN(Q1) ;GET EXTENSION STRING FOR TEST FILE
CALL FLDCMP ;DO THE COMPARISON
TXO Q2,WL%EXT ;NO MATCH, SET EXTENSIONS DIFFER FLAG
WLJFG: TXNE Q3,GJ%VER ;WILD GENERATIONS DESIRED?
JRST WLJFIN ;YES, THEN THEY MATCH
HRRZ T1,FILVER(JFN) ;GET GENERATION OF WILD FILE
HRRZ T2,FILVER(Q1) ;AND GENERATION OF TEST FILE
CAME T1,T2 ;ARE THEY THE SAME?
TXO Q2,WL%GEN ;NO, SET GENERATIONS DIFFER FLAG
WLJFIN: MOVE T1,JFN ;GET JFN OF WILD FILE
CALL LUNLKF ;UNLOCK IT
WLJFN2: MOVE T1,Q1 ;GET JFN OF TEST FILE
CALLRET LUNLKF ;UNLOCK IT TOO AND RETURN
;ROUTINE TO COMPARE STRINGS POINTED TO BY POINTERS IN T1 AND T2.
;IF NO POINTER EXISTS, THE STRING WILL BE DEFAULTED TO NULL. SKIP
;RETURN IF STRINGS MATCH.
FLDCMP: SKIPN T1 ;ADDRESS OF TEST STRING MISSING?
MOVEI T1,[EXP 0,0] ;YES, POINT TO A NULL STRING
SKIPN T2 ;ADDRESS OF WILD STRING MISSING?
MOVEI T2,[EXP 0,0] ;YES, ALSO POINT TO NULL STRING
HRLI T1,(POINT 7,0,35) ;FINISH BYTE POINTER
CALLRET CHKWLD ;GO DO THE ACTUAL COMPARISON
;SUBROUTINE CALLED IF THE SECOND JFN IS BAD, TO UNLOCK THE FIRST
;JFN BEFORE GIVING THE ITRAP.
WLERR: MOVE JFN,Q1 ;GET FIRST JFN
MOVE DEV,FILDEV(JFN) ;RESTORE STATUS ACS
MOVE STS,FILSTS(JFN) ;THAT UNLCKF WANTS SET UP
CALLRET UNLCKF ;GO UNLOCK THE JFN
TNXEND
END