Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
mit/monitor/jsysf.mac
There are 53 other files named jsysf.mac in the archive. Click here to see a list.
;[MIT-XX]SSY:<MONITOR.M5>JSYSF.MAC.2, 16-Apr-84 00:22:31, Edit by JTW
;3056 Prev Ctxt instruction weirdness causes problems for RFTAD% running
; with data and user PC in different sections. Install Kludge.
;[MIT-XX]SSY:<BERLIN.M5>JSYSF.MAC.7, 7-Jan-83 12:52:57, Edit by BERLIN
;3021 ADd ADDFLG to special case losing RCDIR
;<BERLIN.M5>JSYSF.MAC.6, 20-Sep-82 12:30:05, Edit by BERLIN
;1026 Oops, fix subdirectory protection bits
;1002 Fix from BBN:
; Removed call to upddir to greatly speed up dumps/restores--
; in fact, as dumper sets the tape info, it is not yet valid anyway,
; and waits more than 4 min (the max time for ddmp to update disk)
; before validation. the validation bits (AR%1ST, etc.) are
; controlled by CHFDB, which has the CF%NUD option.
; Added call back to retrieve function code, to guard offline bit
; actions which delete file contents have this call in delfil
;1001 Network fixes
; Make SIBE checks net connections correctly
; Abort TCP connections on CLOSF
;1000 V5 merge
; Move .ATNVT to this file for multinet, arpanet, chaosnet
; Allow owner to make file undeleteable (FB%NDL)
; ** Note: FB%UND was 1b35 at MIT, now using FB%NDL :== 1b18
;SRC:<SYS.MONITOR>JSYSF.MAC.2 8-Feb-81 17:00:02, Edit by CPR
;288 Protect directory creation from SWPJFN lossage
;215 Don't let non-Whoper give away owner write access to files
; or directories [.CHFDB, .CRDIR]
;143 Password hashing
;140 Cut DISMS on password failure to 1.5 secs
;130 Zero LSTDIR when unwheeling so can't cheat on directory access
;32 Allow for superior access field in directory protection for crdir
;29 Changed protection of directory file to be 020202
;14 Allow writer to change .FBUSW
;11 Add bit for No Mail File to CRDIR%
; UPD ID= 577, SNARK:<5.MONITOR>JSYSF.MAC.31, 15-Apr-82 15:51:48 by PAETZOLD
;TCO 5.1775 - Make UFPGS performance for short files improve
; UPD ID= 562, SNARK:<5.MONITOR>JSYSF.MAC.30, 24-Mar-82 10:12:42 by COBB
;TCO 5.1769 - Check for stepping directories at RCD550 to avoid LCKDIR bughalt
; UPD ID= 546, SNARK:<5.MONITOR>JSYSF.MAC.29, 16-Mar-82 20:33:32 by PAETZOLD
;TCO 5.1758 - Check SFTAD count
; UPD ID= 255, SNARK:<5.MONITOR>JSYSF.MAC.28, 12-Oct-81 16:59:09 by ELFSTROM
;CHANGE 'structure unique code' to 'structure-unique code'
; Update 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
;<4.MONITOR>JSYSF.MAC.108, 14-Nov-79 16:35:52, EDIT BY DBELL
;TCO 4.2571 - MAKE ARCHIVED FILES VISIBLE WHEN THEY ARE RESTORED IN ARRST
;<4.MONITOR>JSYSF.MAC.107, 6-Nov-79 10:42:54, EDIT BY MILLER
;PUT ERJMP AFTER SETZM IN DIRINI TO PREVENT ILMNRF BUGHLTS
; IF STRUCTURE IS FULL
;<4.MONITOR>JSYSF.MAC.106, 6-Nov-79 09:21:36, EDIT BY GRANT
;MAKE SURE JFN IS RETRIEVED AT CRDR01
;ADD COMPARISON WITH MAXJFN AT RLJF1
;<4.MONITOR>JSYSF.MAC.105, 26-Oct-79 14:31:24, EDIT BY TOMCZAK
;TCO 4.2556 - FIX DELNF TO ACCEPT FLAGS IN LEFT HALF AC1
;<4.MONITOR>JSYSF.MAC.104, 20-Oct-79 14:04:27, EDIT BY MILLER
; CHANGE CLZFF JSYS TO SPECIFY BLOCK VIA MAPFKH AND TO UNLOCK
; FORK LOCK
;<4.MONITOR>JSYSF.MAC.103, 11-Oct-79 13:36:33, EDIT BY TOMCZAK
;TCO#4.2523 - Don't allow negative LIQ/LOQ for a directory
;<4.MONITOR>JSYSF.MAC.102, 9-Oct-79 16:43:43, Edit by KONEN
;CHECK FOR "DSK" IN INIT'ING STR IN RCDIR
;<4.MONITOR>JSYSF.MAC.101, 5-Oct-79 15:19:40, Edit by KONEN
;MAKE SURE STRUCTURE HAS FINISHED INIT'ING FOR RCDIR
;<4.MONITOR>JSYSF.MAC.100, 2-Oct-79 15:34:11, EDIT BY MILLER
;FIX ASND NOT TO CALL ACJ IF DEVICE ALREADY ASSIGNED TO
; CALLING JOB
;<4.MONITOR>JSYSF.MAC.99, 1-Oct-79 15:55:38, EDIT BY MILLER
;FIX ASND JSYS TO CHECK ARGS BEFORE INVOKING ACJ. THIS IMPLIES ACJ
; WILL BE CALLED ONLY FOR ASSIGNABLE DEVICES NOT YET ASSIGNED.
;<4.MONITOR>JSYSF.MAC.98, 26-Sep-79 15:40:16, EDIT BY HALL
;GTFDB AND RDDIR - CALL BLTMU1 INSTEAD OF BLTMU FOR EXTENDED ADDRESSING
;<4.MONITOR>JSYSF.MAC.97, 26-Sep-79 13:16:50, EDIT BY MILLER
;ONE MORE FIX FOR NEW ACJ FUNCTION
;<4.MONITOR>JSYSF.MAC.95, 25-Sep-79 16:32:13, EDIT BY MILLER
;tco 4.2487. ADD .GOOAD GETOK REQUEST IN OPENF
;<4.MONITOR>JSYSF.MAC.94, 19-Sep-79 10:07:20, EDIT BY ENGEL
;PREVENT PRINTING OF ;PASSWORD IN JFNS
;<OSMAN.MON>JSYSF.MAC.1, 10-Sep-79 15:39:49, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>JSYSF.MAC.92, 30-Aug-79 08:13:49, EDIT BY MILLER
;FIX CHKTTR NOT TO TOUCH JFN BLOCK IF 100 OR 101 GIVEN AS ARGS
;<4.MONITOR>JSYSF.MAC.91, 23-Aug-79 11:35:31, EDIT BY R.ACE
;TCO 4.2416 - JFNS... IF PARSE-ONLY JFN, ALWAYS PUNCTUATE TYPE FIELD
;<4.MONITOR>JSYSF.MAC.90, 16-Aug-79 13:46:17, EDIT BY OSMAN
;CHANGE GTFDB2 TO GTFD2 TO NOT CONFLICT WITH GTFDB2 BUGHLT IN DISC
;<4.MONITOR>JSYSF.MAC.89, 13-Aug-79 15:44:52, EDIT BY GRANT
;TCO 4.2377 - RLJFN WITH T1/-1 NOW AFFECTS ONLY THE EXECUTING
;PROCESS AND ITS INFERIORS
;<4.MONITOR>JSYSF.MAC.88, 13-Aug-79 13:34:58, EDIT BY DBELL
;TCO 4.2392 - FIX FREE CORE PROBLEMS CAUSED BY -1 ARGUMENT TO RLJFN
;<4.MONITOR>JSYSF.MAC.87, 30-Jul-79 14:40:41, EDIT BY BLOUNT
;ADD CODE TO USE ARCHIVE OFFLINE DEFAULT
;<4.MONITOR>JSYSF.MAC.86, 15-Jul-79 12:02:15, EDIT BY HALL
;SMFILE - CALL UNLCKF IF FILE IS NOT OPEN
;<4.MONITOR>JSYSF.MAC.85, 25-Jun-79 16:36:10, Edit by LCAMPBELL
; Return correct error for SFUST for last writer and not WHOPER
;<4.MONITOR>JSYSF.MAC.84, 18-Jun-79 13:17:38, EDIT BY DBELL
;TCO 4.2292 - CHECK FOR PARSE-ONLY JFN IN .DELNF
;<4.MONITOR>JSYSF.MAC.83, 10-Jun-79 13:38:52, EDIT BY MILLER
;TCO 4.2281. ALLOW FLAG BITS IN LH OF AC1 FOR GDSTS
;<4.MONITOR>JSYSF.MAC.82, 20-May-79 17:41:47, EDIT BY R.ACE
;TCO 4.2254 - ADD "MOVE T4,P3" BEFORE CALL TO FSHFIL IN ARSST
;<4.MONITOR>JSYSF.MAC.81, 20-May-79 13:59:15, EDIT BY DBELL
;SMALL FIX TO GTFDB
;<4.MONITOR>JSYSF.MAC.80, 17-May-79 12:49:22, EDIT BY DBELL
;TCO 4.2248 - MAKE CHFDB AND GTFDB HANDLE VARYING SIZED FDBS.
;<4.MONITOR>JSYSF.MAC.79, 12-May-79 13:51:21, EDIT BY MILLER
;ALLOW GDSTS TO BE DONE ON TTY JFN
;<4.MONITOR>JSYSF.MAC.78, 24-Apr-79 06:13:19, EDIT BY R.ACE
;TCO 4.2241 - FIX CHFDB TO LET WHOPER SET ALL BITS OF .FBBK0
;<4.MONITOR>JSYSF.MAC.77, 19-Apr-79 13:33:46, EDIT BY R.ACE
;FIX BUGS IN ARRFR
;<4.MONITOR>JSYSF.MAC.76, 18-Apr-79 13:58:50, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.75, 5-Apr-79 11:19:53, Edit by MCLEAN
;REMOVE 1ST ARG FROM GTOKM
;<4.MONITOR>JSYSF.MAC.74, 28-Mar-79 11:44:20, Edit by LCAMPBELL
; Return proper error code if (regulated) structure not mounted
;<4.MONITOR>JSYSF.MAC.73, 21-Mar-79 14:44:33, Edit by MCLEAN
;MAKE .ASND DO RETERR NOT RETBAD
;<4.MONITOR>JSYSF.MAC.72, 16-Mar-79 11:54:30, EDIT BY R.ACE
;CHANGE FAILING CALL TO SETDIR IN RCDIR TO PASS SETDIR'S ERROR
;CODE UP TO THE USER INSTEAD OF RCDIX2
;<4.MONITOR>JSYSF.MAC.71, 15-Mar-79 21:01:33, Edit by LCAMPBELL
; If changing pswd to null, require WHOPER or connect access to superior
;<4.MONITOR>JSYSF.MAC.70, 7-Mar-79 14:01:12, Edit by KONEN
;AVOID 'SECNX' BUGHLT
;<4.MONITOR>JSYSF.MAC.69, 5-Mar-79 13:17:40, EDIT BY MILLER
;REMOVE CALL TO RELMT
;<4.MONITOR>JSYSF.MAC.68, 4-Mar-79 17:43:27, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>JSYSF.MAC.67, 2-Mar-79 15:26:27, Edit by MCLEAN
;FIX GETOKM MACROS
;<4.MONITOR>JSYSF.MAC.66, 9-Feb-79 13:12:40, EDIT BY KIRSCHEN
;DO NOT INDEX BY DEV GETTING NAME LOOKUP ROUTINE AT ARRST+23
; (DEV HAS POSITIVE LEFT HALF, CAUSES SECNX)
;<4.MONITOR>JSYSF.MAC.65, 1-Feb-79 17:41:51, EDIT BY HURLEY.CALVIN
; Don't allow temporary files to be archived or migrated
;<4.MONITOR>JSYSF.MAC.64, 31-Jan-79 18:25:13, EDIT BY MILLER
;SAVE F IN MJFCNT
;<4.MONITOR>JSYSF.MAC.63, 25-Jan-79 18:21:36, EDIT BY ZIMA
;TCO 4.2173 - Handle JFNS output case where JSCDF is zero
;<4.MONITOR>JSYSF.MAC.62, 10-Jan-79 21:26:51, EDIT BY ACARLSON
; Use the correct arguements to ARCF from OPENF (wait for file case)
;<4.MONITOR>JSYSF.MAC.61, 8-Jan-79 17:23:43, EDIT BY ZIMA
;TCO 4.2157 - PROTECT RCDIR/RCUSR CALCULATED BITS FROM DIR MODE WORD
;<4.MONITOR>JSYSF.MAC.60, 8-Jan-79 06:48:45, EDIT BY GILBERT
;TCO 4.2155 - Implement hidden symbol tables:
; Change the JSVAR macro to JSBVAR.
;<4.MONITOR>JSYSF.MAC.59, 4-Jan-79 11:32:54, EDIT BY MILLER
;<4.MONITOR>JSYSF.MAC.58, 3-Jan-79 19:41:10, EDIT BY DBELL
;TCO 4.2146 - USE JSB STACK IN RCUS0 ROUTINE TO PREVENT LONG NOINT.
;<4.MONITOR>JSYSF.MAC.57, 2-Jan-79 16:10:24, EDIT BY MILLER
;DON'T ALLOW CHFDB ON .FBCTL IF FILE IS A DIR FILE
;<4.MONITOR>JSYSF.MAC.56, 29-Dec-78 13:30:57, EDIT BY KIRSCHEN
;RESTORE MAP COUNT AT CLZFW WHEN CLOSE BLOCKS SO THAT FILES ARE
; NOT INADVERTANTLY CLOSED BY OTHER FORKS WHEN CLOSE IS ATTEMPTED AGAIN
;<4.MONITOR>JSYSF.MAC.55, 28-Dec-78 20:58:01, EDIT BY DBELL
;CALL THE RIGHT ROUTINE FOR DSK*: OUTPUT.
;<4.MONITOR>JSYSF.MAC.54, 21-Dec-78 21:25:28, EDIT BY DBELL
;TCO 4.2131 - MAKE JFNS OUTPUT DSK*: IF GIVEN A WILD DEVICE
;<4.MONITOR>JSYSF.MAC.53, 21-Dec-78 12:13:57, EDIT BY MILLER
;ADD REAJFN. REASSIGN JFN TO FORK
;<4.MONITOR>JSYSF.MAC.52, 15-Dec-78 12:43:00, EDIT BY MILLER
;ONE MORE FIX TO JFNS FOR VERSION PRINT OUT
;<4.MONITOR>JSYSF.MAC.51, 11-Dec-78 14:04:03, Edit by MCLEAN
;FIX ASND TO RETBAD ON GETOK ERROR
;<4.MONITOR>JSYSF.MAC.50, 8-Dec-78 19:44:29, EDIT BY HURLEY.CALVIN
; Correct error # in CRDIR (ARGX26 becomes ARGX27)
;<4.MONITOR>JSYSF.MAC.49, 30-Nov-78 13:11:35, EDIT BY MILLER
;FIX JFNS ONCE MORE TO MAKE MT VERSIONS PRINT OUT
;<4.MONITOR>JSYSF.MAC.48, 29-Nov-78 19:04:03, EDIT BY HURLEY.CALVIN
; Change SET1ST, SET2ND, and ARGST over to use ULOAD and USTOR
;<4.MONITOR>JSYSF.MAC.47, 28-Nov-78 16:08:29, EDIT BY MILLER
;FIX MJFCNT TO DO PROPER COUNT
;<4.MONITOR>JSYSF.MAC.46, 17-Nov-78 18:49:30, EDIT BY HURLEY.CALVIN
; Have .ARSST (ARCF) restore offline page count if setting both tape IDs
;<4.MONITOR>JSYSF.MAC.45, 13-Nov-78 13:51:36, EDIT BY LCAMPBELL
; Add CD%LEN to CRDNWH so SET DIR ONLINE <FOO> +180 will work
; On errors in CKJFN, go to ARCFXY rather than ARCFX if GETFDB not done yet
;<4.MONITOR>JSYSF.MAC.43, 6-Nov-78 19:10:25, Edit by CALVIN
; FIX ARRAR SO .ARCLR PATH WORKS; FIX AC A CLOBBERAGE AT CHFD10
;<4.MONITOR>JSYSF.MAC.42, 4-Nov-78 14:45:18, EDIT BY DBELL
;USE AC Q3 INSTEAD OF F AT WLDJFN SINCE CHKJFN TRASHES F
;<4.MONITOR>JSYSF.MAC.41, 3-Nov-78 13:07:44, EDIT BY MILLER
;FIX CKJFN TO USE P3 INSTEAD OF DEV
;<4.MONITOR>JSYSF.MAC.40, 3-Nov-78 11:25:52, EDIT BY MILLER
;ALLOW JFNS OF VERSION IF DEVICE IS DV%PSD (I.E. MT'S)
;<4.MONITOR>JSYSF.MAC.39, 31-Oct-78 16:32:12, EDIT BY DBELL
;TCO 4.2076 - DON'T ALLOW DETACHED TERMINAL IN BKJFN JSYS.
;<4.MONITOR>JSYSF.MAC.38, 29-Oct-78 14:05:31, EDIT BY DBELL
;HAVE WILD% CALL CHKFIL INSTEAD OF CHKJFN.
;<4.MONITOR>JSYSF.MAC.37, 26-Oct-78 09:51:58, EDIT BY DBELL
;TCO 4.2066 - MAKE CRDIR WORK IF SPECIFYING DIRECTORY NUMBER AND NOT
;SPECIFYING A DEVICE NAME.
;[BBN-TENEXD]<3A-EONEIL>JSYSF.MAC.22, 1-Sep-78 16:44:58, Ed: EONEIL
; Removed routine CKARDL since ARACCK now handles archive checking
;[BBN-TENEXD]<3A-EONEIL>JSYSF.MAC.18, 30-Aug-78 14:50:11, Ed: CRDAVIS
; Changed CLRBOT to call ARCMSG properly.
;<CALVIN>JSYSF.MAC.1, 24-Aug-78 07:11:15, EDIT BY CALVIN
; Replace call in ARSST to DELFL1 to call to FSHFIL (in DISC)
;<ARC-DEC>JSYSF.MAC.9, 23-Aug-78 11:23:43, EDIT BY CALVIN
; Add code to support AR%CRQ in ARSST function of ARCF & fix "bug" concerning
; AR%OFL in ARSST-check for tape info rather than both AR%O1 & AR%O2
;<ARC-DEC>JSYSF.MAC.4, 21-Aug-78 12:47:39, EDIT BY CALVIN
; Cause migration requests to become archive requests if CD%DAR is on
; in the directory mode word
;<ARC-DEC>JSYSF.MAC.3, 21-Aug-78 12:08:43, EDIT BY CALVIN
; Modifications to CRDIR for archive system
;<CALVIN>JSYSF.MAC.10, 17-Aug-78 05:33:26, EDIT BY CALVIN
; Make CHFDB check offset against actual length of FDB in question
;<CALVIN>JSYSF.MAC.3, 15-Aug-78 11:40:23, EDIT BY CALVIN
; Add new entries in CHFDB masks
;[BBN-TENEXD]<CALVIN>JSYSF.MAC.1, 15-Aug-78 08:47:48, Ed: CALVIN
; Install DEC spec'd ARCF JSYS
;[BBN-TENEXD]<3-EONEIL>JSYSF.MAC.8, 11-Aug-78 10:45:53, Ed: EONEIL
;PUT TEMP FLAG JS%TM3 IN Q1 SINCE Q3 IS FULL
;[BBN-TENEXD]<3-EONEIL>JSYSF.MAC.6, 31-Jul-78 16:25:37, Ed: EONEIL
;IN JFNS, ADDED OFFLINE ATTRIBUTE
;[BBN-TENEXD]<3-EONEIL>JSYSF.MAC.2, 1-Jun-78 11:03:22, Ed: EONEIL
; Installed archive system: ARCF JSYS, etc.
;<4.MONITOR>JSYSF.MAC.35, 18-Oct-78 12:33:10, EDIT BY MILLER
;IF RLJFN IS DONE TO AN MT JFN, CALL RELMT
;<4.MONITOR>JSYSF.MAC.34, 16-Oct-78 23:22:47, EDIT BY DBELL
;FIX SIMPLE THINGS IN WILD%
;<4.MONITOR>JSYSF.MAC.33, 15-Oct-78 16:14:18, EDIT BY DBELL
;ADD WILD% JSYS
;<4.MONITOR>JSYSF.MAC.32, 28-Sep-78 13:27:13, Edit by MCLEAN
;FIX DVCHR TO HAVE CORRECT EXPRESSION FOR NUL DEVICE
;<4.MONITOR>JSYSF.MAC.31, 26-Sep-78 18:03:06, Edit by MCLEAN
;TCO 4.2025 FIX ASND TO RETURN REAL ERROR CODE
;<4.MONITOR>JSYSF.MAC.30, 26-Sep-78 08:20:43, EDIT BY R.ACE
;TCO 4.2021 - MAKE OPENF RETURN OPNX13 IF NO ACCESS BITS SET IN AC2
;<4.MONITOR>JSYSF.MAC.29, 19-Sep-78 15:32:32, EDIT BY HALL
;TCO 1900 - DISALLOW SWJFN FOR ATS
;<4.MONITOR>JSYSF.MAC.28, 18-Sep-78 14:59:58, Edit by MCLEAN
;REMOVE EXTRANEOUS CODE AT DIRINI FOR BLT/XBLT TO CLEAR PAGE
;I BELIEVE EXADDR STUFF WAS WRONG ANYWAY
;<4.MONITOR>JSYSF.MAC.27, 16-Sep-78 15:36:53, Edit by MCLEAN
;INSERT CREDIR GETOK
;<2MCLEAN>JSYSF.MAC.24, 5-Sep-78 12:58:09, Edit by MCLEAN
;<2MCLEAN>JSYSF.MAC.23, 27-Aug-78 21:46:04, Edit by MCLEAN
;MAKE DEVUNT UNIT 15 BITS
;<4.MONITOR>JSYSF.MAC.25, 29-Aug-78 11:30:23, EDIT BY ENGEL
;IMPROVE COMMENTS FOR FFFFP
;<4.MONITOR>JSYSF.MAC.24, 28-Aug-78 21:03:15, Edit by LCAMPBELL
; Change MRETN to JRST MRETN, it works better
;<4.MONITOR>JSYSF.MAC.23, 28-Aug-78 16:10:21, EDIT BY ENGEL
;TCO #4.1994 SPEED UP FFFFP
;<4.MONITOR>JSYSF.MAC.22, 12-Aug-78 20:06:07, Edit by HELLIWELL
;TCO # 4.1983 - ALLOW LOGICAL NAMES IN CRDIR
;<4.MONITOR>JSYSF.MAC.21, 9-Aug-78 14:17:29, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.20, 9-Aug-78 00:02:44, Edit by MCLEAN
;FIX CLOSE CO-ROUTINE
;<4.MONITOR>JSYSF.MAC.19, 8-Aug-78 16:19:17, Edit by ENGEL
;FIX DVCHR FOR .NULIO
;<4.MONITOR>JSYSF.MAC.18, 1-Aug-78 15:47:09, Edit by HELLIWELL
;REMOVE NOINT/OKINT AT DSM0 (ONLY DECTAPES CARE)
;<4.MONITOR>JSYSF.MAC.17, 1-Aug-78 13:57:54, EDIT BY HALL
;ADD MJFCNT ROUTINE
;<4.MONITOR>JSYSF.MAC.16, 18-Jul-78 12:11:59, Edit by KIRSCHEN
;FIX GETWRD/PUTWRD TO NOT FAIL ON NON-EX USER ADDRESSES
;<4.MONITOR>JSYSF.MAC.15, 17-Jul-78 23:32:29, Edit by MCLEAN
;MOVE GETWRD/PUTWRD IN LINEPR TO JSYSF BECAUSE IT WAS CALLED BY CARDREADER SERVICE AND I NEED IT FOR MTA'S
;<2MCLEAN>JSYSF.MAC.14, 15-Jul-78 23:34:42, Edit by MCLEAN
;INSERT GETOK IN .ASND
;<4.MONITOR>JSYSF.MAC.13, 14-Jul-78 14:46:55, Edit by MCLEAN
;FIX OPENB TO CHECK TO SEE IF JFN IS THE SAME
;<4.MONITOR>JSYSF.MAC.12, 14-Jul-78 14:37:39, Edit by MCLEAN
;CHANGE CO-ROUTINE IN MTOPR AND OPENF TO BE IN P6
;<4.MONITOR>JSYSF.MAC.11, 14-Jul-78 13:55:12, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.10, 12-Jul-78 18:06:50, Edit by MCLEAN
;CORRECT UNNECESSARY DIRECTORY WRITES
;<2MCLEAN>JSYSF.MAC.2, 12-Jul-78 02:40:02, Edit by MCLEAN
;<4.MONITOR>JSYSF.MAC.9, 12-Jul-78 02:19:34, Edit by MCLEAN
;FIX .MTOPR CO-ROUTINE TO CHECK THAT JFN DIDN'T CHANGE DURING BLOCK
;<4.MONITOR>JSYSF.MAC.8, 10-Jul-78 11:38:32, EDIT BY MILLER
;TCO 1937. PASS UFPGS FLAGS TO PAGEM
;<3A.MONITOR>JSYSF.MAC.340, 13-Jun-78 13:30:23, Edit by PORCHER
;TCO # 1895 - FIX RCDIR AND RCUSR TO RETURN RC%NMD WHEN RC%STP SPECIFIED
; WITH NON-WILD DIRECTORY OR USER NAME
;<3A.MONITOR>JSYSF.MAC.339, 12-May-78 08:57:54, EDIT BY MILLER
;FXI GTFDB TO TOUCH ALL AFFECTED USER PAGES BEFORE LOCKING JFN
;CHECK FOR NULL DIR LIST AND NON-NULL USER LIST IN CDCKCU
;<3A.MONITOR>JSYSF.MAC.337, 27-Mar-78 12:12:29, EDIT BY MILLER
;CHECK FOR "FUNNY" JFN AT SIBE1
;<4.MONITOR>JSYSF.MAC.3, 1-Mar-78 09:36:34, EDIT BY MILLER
;MAKE SURE CRDIR CODE DOES NOT DIDDLE QUOTA OF "ROOT-DIRECTORY"
;<4.MONITOR>JSYSF.MAC.2, 16-Feb-78 17:40:08, EDIT BY MILLER
;FIX UP ERROR RETURN IN SMFILE
;<4.MONITOR>JSYSF.MAC.1, 16-Feb-78 17:28:12, EDIT BY MILLER
;ADD SUPPORT CODE FOR SMAP
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
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.
;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
;1000
; Attach connection to pty
; Call: 1 ; [Receive] jfn of opened network connection
; 2 ; Send jfn of open network connection (ARPA, PUP only)
; ATNVT
; Returns
; +1 ; Cannot attach
; +2 ; Ok. the jfn is released, ac 1 has line number of
; ; Attached pty.
.ATNVT::MCENT
IFN TCPN,< ;1001
TXNE T1,AN%TCP ; Attach TCP Virtual Terminal?
JRST TATNVT## ; Yes, go to TCP code
>;1001
XCTU [HRRZ JFN,1]
CALL CHKJFN ;CHECK JFN OF RECEIVE CONNECTION
JRST ATPER0 ;ONLY REAL JFNS ARE LEGAL
JRST ATPER0
JRST ATPER0
HRRZ T2,DEV ; Check device
CAIN T2,NETDTB ; ARPA?
JRST AATNVT##
CAIN T2,CHADTB## ; Or Chaos?
JRST CATNVT##
MOVEI T1,ATNX4 ; Neither, return error
JRST MRETNE
ATPER0: MOVEI T1,ATNX1 ;BAD RECEIVE JFN
JRST MRETNE
;1000 end addition
; ARCF Jsys
; 1:JFN, 2: Function code, 3: Function dependent, normally 0
; Returns +1 always
.ARCF:: 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
CAILE T1,NARFNS ; In range?
ERRJMP ARGX02,ARCFX ; Invalid function
CALL @ARCFF(T1) ; Do it
JRST ARCFX ; Failed for some reason
;1002 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
HRRI T1,.RETM ; 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
RETBAD(ARCX13) ; 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
; 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(OFFONX)
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
HRRZ T1,DEV ; Get device dispatch table address
HRRZ T1,NLUKD(T1)
CAIE T1,MDDNAM ; Disc?
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(ARSTXX)
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
CALL UPDDIR ;1002 Update destination directory
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
SETZRO FBARC,(P3) ; Clear archive status
SETZRO <K0NDL,K0RSN>,(P3) ; Clear don't flush request too
SETZRO FBTDT,(P3) ; Clear tape TAD
SETZRO FBFET,(P3) ; Offline expiration meaningless now
RETSKP
; 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
SETZRO FBTDT,(P3) ; Clear tape-write date & time
SETZRO <K0RFL,K01ST,ARPSZ>,(P3) ; Clear tape-related data
SETZRO FBARC,(P3) ; Clear archive status flag
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%NOD!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
HRRZ T1,NLUKD(P3)
CAIE T1,MDDNAM
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(ARCASS)
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
CAIN P3,TTYDTB ;IS THIS A TERMINAL?
JRST [ HLRZ B,DEV ;YES. GET LINE NUMBER
CALL TTYASC ;ASSIGN THE LINE
RETERR (,<UNLOKK DEVLKK>) ;FAILED
MOVE B,ASNDIX ;RESTORE INDEX TO DEVICE TABLES
JRST .+1]
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>
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
HRRZ A,NLUKD(P3)
CAIE A,MDDNAM
ERRJMP CFDBX1,CHFDX ;NO FDB FOR NON MDD DEVICES
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
JRST CHFDB6
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
;215 BEGIN ADDITION
CAIE C,.FBPRT ;SETTING PROTECTION?
JRST CHFDB8 ;NO, GO ON
MOVE C,CAPENB ;ENABLED APPROPRIATELY?
TXNN C,SC%WHL!SC%OPR
TXO B,220000 ;NO, DON'T GIVE AWAY OWNER WRITE & LIST
;215 END
CHFDB8: MOVEM B,(A)
MOVE C,CHFDBD ;GET THE OFFSET
CAIE C,.FBSIZ ;SETTING THE SIZE
CAIN C,.FBBYV ;OR BYTE SIZE
TQNN <OPNF> ;YES, IS THE FILE OPEN?
JRST CHFDB7 ;NO, DONT SET UP THE NEW LENGTH
MOVE C,CHFDBA ;GET THE ADR OF THE FDB
LOAD A,FBBSZ,(C) ;GET BYTE SIZE
LOAD B,FBSIZ,(C) ;GET LENGTH OF FILE
CALL UPDFLN ;UPDATE THE LENGTH
CHFDB7: UMOVE T2,T1 ;GET ARG
TXNN T2,CF%NUD ;UPDATE DIRECTORY NOW?
CALL UPDDIR ;YES
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 ;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
777777,,777777 ;14 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%NDL ;1000 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%FCF+FB%NDL ;FBFLG
0 ;FBEXL
0 ;FBADR
0 ;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
0 ;FBBK1
0 ;FBBK2
AR%1ST+AR%WRN ;FBBBT
0 ;FBNET
0 ;USER SETTABLE WORD
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)
TLNE B,777777
JRST [ CALL CLZMRC ;TRY TO REASSIGN MAP COUNT
SKIPA ;FAILED, PAGES STILL MAPPED
JRST .+1 ;MAP COUNT NOW 0
CALL CLZMFE ;MAKE FILE EXISTENT
POP P,0(P) ;CLEAR STACK
HRRZ A,DEV ;GET DEVICE TYPE
CAIN A,DSKDTB ;IS THIS A DISK?
CALL DEWNDW ;YES. FREE UP WINDOW PAGE THEN
CALL UNLCKF ;UNLOCK THE JFN
RETBAD(CLSX3)] ;SAY STILL MAPPED
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
NOSKED ;1000 ENSURE INTEGRITY OF JFN SHARE COUNT
HLLZ B,FILLFW(JFN) ;GET COUNT FROM ORIG JFN
ADDM B,FILLFW(A) ;MOVE IT TO NEW JFN
OKSKED ;1000
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
JRST MRETN
;ROUTINE CALLED FOR EACH FORK SPECIFIED
CLZFF1: PUSH P,P6 ;1001 MAPFKH keeps stuff in here
CALL ABTJCS ;1001 Abort all TCP connections
POP P,P6 ;1001
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
MOVE B,-1(P) ;PASS DOWN JFN
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
MOVEI A,0(JFN) ;GET JFN
CALL LUNLK0 ;FREE UP 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
RET
;HERE ON +1 RETURN FROM CHKJFN, I.E. JFN DOESN'T EXIST OR IS RESTRICTED
CLZFF8: CAIN A,DESX3 ;BEING ASSIGNED?
TQNN <ASGF>
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(CLZABF)
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(BLKF3)
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: HRRZ A,ENQLST ;SEE IF ANY LOCKS ARE SET
JUMPE A,RSKP ;IF 0, NO ENQ REQUESTS OUTSTANDING
HRRZ A,FILDEV(JFN) ;CHECK THAT THIS IS A DSK JFN
CAIE A,DSKDTB ;OTHERWISE JFNOF1 WILL BUGHLT
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
;267 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
CALL CRDIR0 ;GO DO THE WORK
ITERR () ;AN ERROR OCCURED
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!CD%NMF ;11 Add CD%NMF
CDNWF==1B0 ;BIT IN CRDFLG - NEW FILE BEING CREATED
CDDIR==1B1 ;BIT IN CRDFLG - SUPERIOR IS FILES-ONLY
CDREC==1B2 ;RECONSTRUCTING A DIRECTORY
CDLSA==1B3 ;267 superior may contain login subdirs
CDMLD==1B4 ;267 making login directory
;267 *** The ACJ depends on knowing these bits - it must be updated
;267 *** if these definitions change - BE WARNED!!!!!
CRDIR0:: SE1CAL
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>,[RETBAD (CRDIX3)]
;..
;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%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
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?
MOVEM C,CRDIRD ;YES, STORE DIR NUMBER
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;P020202/] ;29 Change default protection
SOUT ;ADD ON EXTENSION
;..
;HAVE A FILESPEC OF THE FORM DEV:NAME.DIRECTORY;P000000 OR
;DEV:<SUPERIOR>DIRNAME.DIRECTORY;P020202. DO GTJFN, ALLOWING ;29 fix comment
;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
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,FILUC,(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
TXNE B,CD%DIR ;IS THIS A FILES-ONLY DIRECTORY?
JRST [ MOVX B,CDDIR ;267 YES. INDICATE IT IN THE LOCAL FLAG WORD
IORM B,CRDFLG ;267 ..
JRST .+1]
HRRZ C,CRDSUP ;267 get sup number
CAIE C,ROOTDN ;267 root-directory ?
TXNE B,CD%LSA ;267 superior may have subdirectories?
JRST [ MOVX C,CDLSA ;267 yes, keep track of it
IORM C,CRDFLG ;267
JRST .+1] ;267
CALL USTDIR ;UNLOCK DIR
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?
JRST [ MOVEI A,CRDIX9 ;NO, ILLEGAL FORMAT DIRECTORY FILE
JRST CRDIR4] ;GO CLEAN UP AND BOMB OUT
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?
;11 JRST CRDIR1 ;YES, NOT CREATING A NEW DIR
JRST [TXO Q3,CD%NMF ;11 OLD DIRECTORY, DON'T PLAY WITH MAIL FILE
JRST CRDIR1] ;11 YES, NOT CREATING ANEW DIRECTORY
;..
;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]
CALL NEWCHK ;267 check with ACJ for new file
JRST CRDIR4 ;267 ACJ denies it
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 ;GET CURRENT DIR FREE DISK
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
JRST 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(GTFDB6)
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 DIRINI ;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: CALL OLDCHK ;267 What does the ACJ think?
JRST CRDIR4 ;267 ACJ denies access
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
JRST [ MOVEI A,CRDIX1 ;NO
JRST CRDIR4]
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?
JRST [ CALL USTDIR ;NO. UNLOCK THE DIRECTORY LOCKED BY SETDIR
MOVEI A,CRDIX1 ;WHEEL OR OPERATOR REQUIRED
JRST CRDIR4] ;TAKE ERROR RETURN
MOVE B,DIRORA ;GET ADDRESS OF MAPPED DIRECTORY
;143 LOAD B,DRPSW,(B) ;GET OFFSET OF PASSWORD BLOCK
LOAD B,DRPSH,(B) ;143 Get offset of hashed password block
SKIPN B ;IF NONE, DIRECTORY HAS NO PASSWORD
JRST [ CALL USTDIR ;UNLOCK THE DIRECTORY LOCKED BY SETDIR
MOVEI A,CRDIX1 ;WHEEL OR OPERATOR REQUIRED
JRST CRDIR4] ;TAKE ERROR RETURN
;143 begine deletion
repeat 0,<
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
JRST [ CALL USTDIR ;UNLOCK THE DIRECTORY LOCKED BY SETDIR
MOVEI A,CRDIX1 ;WHEEL OR OPERATOR REQUIRED
JRST CRDIR4] ;TAKE ERROR RETURN
>;143 end deletion
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
MOVE B,A ;SAVE FLAG FROM CHKPSX
MOVEI A,^D1500 ;140 SLEEP 3 SECONDS
SKIPN B ;NEED TO SLEEP?
DISMS
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
RETBAD (CRDIX2) ;NO, DIR NUMBER MUST MATCH EXISTING #
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(CRDSDF)
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
RETBAD(CRDIX4,<ULKDIR ;FAILED TO GET ROOM IN DIR
JRST CRDIR4>)
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
TXNN Q3,CD%PSW ;WANT TO SET PASSWORD?
JRST CRDIR3 ;No password change
;143 Begin modification
MOVE A,CRDUFL ; Setting from hash?
TXNE A,CD%HPW
JRST CRDIR2 ; Yes
UMOVE A,.CDPSW(Q2) ; No, string. Get pointer to password
CALL HASHPW ; Hash it
MOVE C,B
LOAD B,DRPSH,(Q1) ; Get old password entry
STOR C,DRPSH,(Q1) ; Store new one
JUMPE B,CRDIR3 ; If neccessary...
TLNN B,-1
CALL RELDFR ; release old password string block
JRST CRDIR3
; User is giving hash code (used by DLUSER/DUMPER, no one else)
CRDIR2: UMOVE B,.CDPSW(Q2) ; Get it
TLNN B,-1 ; Legit?
RETBAD ARGX01,<ULKDIR> ; No
STOR B,DRPSH,(Q1) ; Yes
; Fall through this mess
REPEAT 0,<
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
RETBAD (CRDIX1,<ULKDIR>) ; in order to change password to null
CRDR2A: UMOVE T1,.CDPSW(Q2) ;Get pointer to password
CALL CPYFUS ;Copy new password to free storage
RETBAD (CRDIX3,<ULKDIR>)
MOVEM A,CRDIRN ;SAVE ADDRESS OF STRING
CALL SETMSK ;Store in directory
CALL CPYDIR ;And copy string to directory
RETBAD(CRDIX4,<CALL CRDIR6
ULKDIR>)
MOVEI B,.TYNAM ;MARK AS NAME BLOCK
STOR B,NMTYP,(A) ;...
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
> ;End repeat 0
;143 End modification
;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
RETBAD (CRDIX3,<ULKDIR>)
MOVEM A,CRDIRN ;SAVE ADDRESS OF STRING
CALL SETMSK ;STORE IN DIRECTORY
CALL CPYDIR ;AND COPY STRING TO DIRECTORY
RETBAD (CRDIX4,<CALL CRDIR6
ULKDIR>)
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
TXNN B,SC%WHL!SC%OPR ;UNLESS WHOPER
JRST [ MOVE B,A
ANDCM B,CAPENB
JUMPE B,.+1
MOVEI A,CRDI20
CALL USTDIR
JRST CRDIR4]
STOR A,DRPRV,(Q1) ;YES
;..
;SET MODES
;..
CRDR3G: UMOVE A,.CDMOD(Q2) ;GET MODE BITS
TXNN Q3,CD%MOD ;WANT TO SET MODE?
JRST CRDI0K ;NO. SKIP
;267 Begin addition
CRDR31: TXNE A,CD%LSA ;Trying to set login subs allowed?
JRST [ MOVE B,CAPENB ;Yup, check it out
TXNE B,SC%LSA!SC%WHL!SC%OPR ;Allowed to do this?
JRST .+1 ;Sure
MOVEI A,CRDX02 ;Nope, lose
CALL USTDIR ;Release directory and drop into crdir4
JRST CRDIR4] ;and fail
;267 End addition
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
CALL USTDIR ;UNLOCK THE DIRECTORY
JRST CRDIR4 ;TAKE ERROR ROUTE
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 CRDR3A ;YES, DONT LET TIME GO BACKWARDS
TXNE Q3,CD%LLD ;WANT TO SET IT?
STOR A,DRDAT,(Q1) ;YES
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
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 ;GET CURRENT ALLOCATION
JRST [ LOAD A,DRLIQ,(Q1) ; NO FILES OPEN. GET LOGGED-IN QUOTA
OPSTR <SUB A,>,DRDCA,(Q1) ; LESS NUMBER OF PAGES IN USE
JRST .+1]
SUB A,CRDDIQ ;ADJUST BY AMOUNT OF CHANGE FROM OLD VALUE
JUMPL A,[ RETBAD (CRDI21,<CALL USTDIR>)] ;NOT ENOUGH QUOTA FOR EXISTING FILES
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?
RETBAD (CRDI24,<CALL USTDIR>) ;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?
RETBAD (CRDI22,<CALL USTDIR>) ;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
RETBAD(CRDI16,<CALL USTDIR>) ;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
RETBAD(CRDI16,<CALL USTDIR>) ;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
HRRZ A,CRDSUP ;A/ SUPERIOR'S DIRECTORY NUMBER
MOVE B,CRDSTX ;B/ STRUCTURE NUMBER
CALL GETCAL ;GET SUPERIOR'S AVAILABLE PAGES
JRST [ LOAD A,DRLIQ,(Q1) ;NO OPEN FILES. GET LOGGED-IN QUOTA
OPSTR <SUB A,>,DRDCA,(Q1) ; LESS PAGES ASSIGNED
JRST .+1]
ADD A,CRDDIQ ;ADJUST BY CHANGE IN SUBDIR
JUMPL A,[ RETBAD (CRDI13,<CALL USTDIR>)] ;CAN'T CHANGE SUPERIOR
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,[ RETBAD(CRDI14,<CALL USTDIR>)] ;LOQ EXHAUSTED
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,[ RETBAD(CRDI15,<CALL USTDIR>)] ;SDQ EXHAUSTED
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 ; ...
RETBAD(MONX03) ;SHOULD BE IMPOSSIBLE
CALL CHKCHG ;SHOULD PARAMETERS BE CHANGED
JRST CRDR3D ;NO
UMOVE A,.CDCUG(Q2) ;GET CREATABLE USER GROUPS
TXNE Q3,CD%CUG ;SETTING THEM?
CALL CRDCUP ;YES - COPY TO DIR
UMOVE A,.CDUGP(Q2) ;GET USER GROUPS
TXNE Q3,CD%UGP ;WANT TO SET USER GROUPS?
CALL CRDUGP ;YES, GO SET UP USER GROUPS
;..
;DO ALLOCATION, DEFAULT PROTECTION, DIRECTORY PROTECTION
; Online & offline expiration defaults
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
MOVE B,CAPENB ;215 GET CAPAS FOR FOLLOWING CHECKS
TXNN B,SC%WHL!SC%OPR ;215 SUITABLY ENABLED?
TXO A,770000 ;215 NO, DON'T GIVE AWAY OWNER ACCESS TO FILES
TXNE Q3,CD%FPT ;SET FILE PROTECTION?
STOR A,DRDPW,(Q1) ;YES
UMOVE A,.CDDPT(Q2) ;GET DIRECTORY PROTECTION
;1026 ANDI A,777777
TLZ A,777700 ;32
TLO A,500000
TXNN B,SC%WHL!SC%OPR ;215 SUITABLY ENABLED?
TXO A,77770000 ;215 NO, DON'T GIVE AWAY OWNER ACCESS TO DIR
TXNE Q3,CD%DPT ;SET IT?
STOR A,DRPRT,(Q1) ;YES
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
TLNE A,-1 ; Is it an interval?
JRST [ PUSH P,A ; No, a date, get now
PUSH P,B
CALL LGTAD
POP P,B ; LGTAD would have clobbered these
POP P,C
HRLZ D,TPRCYC ; Get max # of days
ADD A,D ; System max
CAMGE A,C ; User within that limit?
RETBAD(ARGX27,<ULKDIR>) ; Out of reasonable range
STOR A,DRDFE,(Q1) ; Store it
JRST CRD3BB]
CAMLE A,TPRCYC ; Within range?
RETBAD(ARGX27,<ULKDIR>) ; No
STOR A,DRDFE,(Q1)
CRD3BB:
;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
ULKDIR
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(CRDBAK)
JRST .+1]
;..
;MAKE THE MESSAGE FILE IF DIRECTORY IS NOT FILES-ONLY
;..
CRDR3C: MOVX T1,CDNWF ;IF THIS IS A NEW DIRECTORY
TXNN Q3,CD%NMF ;11 If flag says don't mess with mail.txt
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
; ERROR ROUTINES
CRDIR4: MOVEM A,CRDIRE ;SAVE ERROR CODE
CALL CRDIR6 ;RELEASE JSB SPACE
HRRZ A,CRDIRJ ;GET JFN OF DIR FILE
JUMPE A,CRDR00 ;DON'T RELEASE IT IF ALREADY RELEASED
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
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(ALWAYS):
; NEW GROUP LIST SETUP
CRDCUP: PUSH P,A ;SAVE POINTER TO NEW LIST
LOAD B,DRCUG,(Q1) ;GET POINTER TO OLD LIST
SKIPE B ;WAS THERE ANY?
CALL RELDFR ;YES - RELEASE IT
POP P,A ;RECOVER NEW LIST
CALL CRGDGB ;CREATE NEW LIST
MOVEI A,0 ;FAILED - SETUP NIL
STOR A,DRCUG,(Q1) ; ...
RET
;267 Begin addition
;Routine to allow/disallow creation of login directories
;returns error code in a if non-skip
;skip if creation allowed
NEWCHK: MOVX B,CDMLD ;Assume a login directory,
CALLRET DOCHK ;Call work routine
OLDCHK: MOVX B,CDNWF ;new directory,
TXNE B,CRDFLG ;This has been checked already
RETSKP ;so forget it now
TXNN Q3,CD%LIQ+CD%PRV+CD%MOD+CD%LOQ ;setting anything interesting?
RETSKP ;no, succeed
SETZ B, ;assume no change, and
;drop into DOCHK
DOCHK: TXNN Q3,CD%MOD ;want to set mode?
JRST NEW.1 ;No, so use what caller thought
MOVX B,CDMLD ;Flag as login, but...
UMOVE A,.CDMOD(Q2) ;get new modes
TXNE A,CD%DIR ;files only?
SETZ B, ; Yes, clear flag
NEW.1: IORM B,CRDFLG ;save appropriate flag
GTOKM (.GOCRD,<CRDSUP,CRDIRD,CAPMSK,CRDFLG>,[JRST MAKNOK])
RETSKP ;ACJ says OK
MAKNOK: MOVEI A,CRDX03 ;general Must Be Files Only message
RET
;267 end addition
;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(CRDOLD)
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(CRDNOM)
RET
;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 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
CAIE P3,PSNUM ; PS?
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
CAIE B,PSNUM ;IS IT THE PUBLIC 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: 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?
BUG(DELBDD)
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(CRDBK1)
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%ACC!GJ%DEL!GJ%PHY+1 ;288 Prevent clever hacker from SWPJFN'ing
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
SETZM LSTDIR ;130 Check access against real capabilities
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
;RETURNS +1: ERROR, ERROR CODE IN T1
; +2: DIRECTORY IS INITIALIZED
DIRINI::SE1CAL
STKVAR <DIRINN,DIRINS>
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
SETZM 0(T4) ;ZERO THE FIRST WORD
ERJMP [ 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
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
IFE MNET,<
;159 Begin addition
; Convert jfn to absolute network socket number
; Call: 1 ; Jfn
; CVSKT
; Returns
; +1 ; Error
; +2 ; Ok, in 2 the absolute socket number
.CVSKT::MCENT
MOVE JFN,T1
CALL CHKJFN
RETERR (CVSKX1)
RETERR (CVSKX1)
RETERR (CVSKX1)
HRRZ T2,DEV
CAIN T2,NETDTB ; ARPA?
JRST ACVSKT##
RETERR (CVSKX1,<CALL UNLCKF>) ; None of the above
>;159 End addition
; 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
HRRZ A,NLUKD(P3) ;CHECK NAME LOOKUP DISPATCH
CAIE A,MDDNAM ;IS MDDNAM?
ERUNLK GFDBX1 ;NO, CAN'T DO
CALL GETFDB
ERUNLK DESX3
UMOVE Q1,2 ;NUMBER OF VERSIONS TO KEEP
DELNF2: JN <FBNXF,FBDEL,FBNDL>,(A),DELNF1 ;5 SKIP DELETED OR NON-EX 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
CAMN Q2,JOBNO ;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
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'
HLRZ A,FILDDN(JFN) ; 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
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
HRRZ A,DEV ;SEE IF THIS IS A DSK
CAIE A,DSKDTB
SKIPA A,DEVUNT(B) ;NOT A DISK
HLLO A,DEVUNT(B) ;A DISK, ALWAYS SAY -1 IN RH OF 3
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?
JRST MRETN ;AVAILABLE, OR 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(DVCHRX)
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
HLRZ A,DEVUNT(B) ;GET ASSIGNER OF PTY.
XCTU [HRLM A,C] ;RETURN IT TO USER.
JRST MRETN
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?
JRST MRETN ;NO
XCTU [HRRZS 3] ;YES, MAKE IT ASSIGNED TO JOB 0
JRST MRETN
;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
HRRZ A,NLUKD(P3) ;GET DISPATCH ADDRESS
CAIE A,MDDNAM ;IS DEVICE 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
HRRZ A,NLUKD(P3) ; GET DISPATCH ADDRESS
CAIE A,MDDNAM
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
ERUNLK(FFUFX3) ; No pages in use
FFUFPX: XCTU [HRRM A,1]
CALL UNLCKF
UMOVE A,A ;GET THE ARG BACK
RPACS ;CHECK ACTUAL ACCESS
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 [ POP P,A ; None found
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
RET]
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(BLKF4)
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
HRRZ T1,NLUKD(P3) ;GET DISPATCH FOR NAME LOOKUP
CAIE T1,MDDNAM ;MUST BE MDDNAM
ITERR(GFDBX1,<CALL UNLCKF>) ;IF NOT, NOT LEGAL FOR THIS DEVICE
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)
JS%TM1==40 ;TEMP FLAG IN Q3 FOR PUNCTUATE NULL EXTENSION
JS%TM2==20 ;TEMP FLAG IN Q3 FOR MULTIPLE DIR DEV
JS%TM3==1 ;TEMP FLAG IN Q1 FOR SUPRESSING LEADING TAB
.JFNS:: MCENT
UMOVE A,3 ;GET BITS
TRNE A,1B26 ;IS AC2 JFN OR STRING POINTER?
JRST JFNX0 ;STRING
HRRZ JFN,2
CALL CHKJFD
ITERR()
JFCL
ITERR(DESX4)
CALL UNLCKF
UMOVE A,1
TLNN A,777777
JRST JFNSZ ; Not byte pointer
TLC A,777777
TLCN A,777777
HRLI A,440700 ; -1 in lh, fill in
SETZ B,
UMOVEM A,1 ; Return to user
XCTBU [IDPB B,A] ; Deposit initial null in case
JFNSZ: XCTU [HLLZ F1,2]
XCTU [SKIPN Q3,3]
MOVE Q3,[2B2!2B5!1B8!1B11!2B14!JS%ATR!JS%PSD!JS%PAF]
SETZ Q1, ; Initialize tab flag
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)
TROA Q3,JS%TM1
TRZ Q3,JS%TM1
TQNE <ASTF> ;PARSE-ONLY?
TRO Q3,JS%TM1 ;YES, ALWAYS PUNCTUATE EXTENSION
CAME C,[-1] ;NO UNITS?
TXNN C,DV%PSD ;PSEUDO-DEVICE?
TLNE A,(DV%MDD)
TROA Q3,JS%TM2
TRZ Q3,JS%TM2
;DO DEVICE FIELD
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?
JRST [ MOVEI B,[ASCIZ/DSK*/]-1 ;YES, POINT AT WILD STRING
CALL JFSTA1 ;OUTPUT IT
JRST JFNSDW] ;GO DO PUNCTUATION
LOAD A,FILUC,(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?
CAIN D,0 ; Or if control is "no print"
JRST JFNS0 ; Don't print
HLRZ A,FILDDN(JFN) ; GET THE DEVICE NAME STRING TO PRINT
CALL JFNSS ; Output the string in a
JFNSDW: MOVEI B,":"
CALL PUNCT
; ..
;DO DIRECTORY FIELD
JFNS0: HRRZ A,FILDDN(JFN) ; Get directory number
LDB D,[POINT 3,Q3,5] ; And format control
CALL TAB4 ; Tab before field if desired
TQNE <DIRSF>
JRST JFNS0A
CAIN D,2 ; If suppressing default,
JRST [ 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,FILDIR,(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
JRST JFNS0A ;THE STRINGS DONT MATCH, GO OUTPUT DIR
JRST JFNS1] ;THEY MATCH, DO NOT OUTPUT THE DIR NAME
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,FILDIR,(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
TQNE <DIRSF>
JRST [ LOAD B,FILDMS,(JFN) ;GET WILD MASK
CALL JFSTA1 ; GO DO IT OR A STAR
JRST JFNS0B]
LOAD A,FILDIR,(JFN) ; GET POINTER TO DIRECTORY STRING
JUMPE A,JFNS0B ; IF NONE, DONT TRY TO OUTPUT IT
CALL JFNSSD ; Copy string to output
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
CALL TAB4 ; Tab before field if required
JUMPE D,JFNS2 ; No print wanted
TQNE <NAMSF>
JRST [ LOAD B,FILNMS,(JFN) ;GET NAME WILD MASK
CALL JFSTA1 ; PRINT IT OR A STAR
JRST JFNS2]
CALL JFNSS ; Copy string to output
; ..
;DO EXTENSION FIELD
JFNS2: HRRZ A,FILNEN(JFN) ; Get location of extension block
LDB D,[POINT 3,Q3,11] ; And output control
CALL TAB4 ; Tab before field if required
JUMPE D,JFNS3 ; No print wanted
MOVEI B,"."
MOVE C,1(A) ; SEE IF THERE IS AN EXTENSION STRING
TLNN C,774000 ; IF NON-NUL STRING, TYPE OUT PUNCT.
TRNE Q3,JS%TM1
CALL PUNCT ; Output punctuation if desired
TQNE <EXTSF>
JRST [ LOAD B,FILEMS,(JFN) ;GET EXTENSION WILD MASK
CALL JFSTA1 ; PRINT IT OR A STAR
JRST JFNS3]
CALL JFNSS ; Copy to output
;DO VERSION
JFNS3: HRRE A,FILVER(JFN) ; Get version number
LDB D,[POINT 3,Q3,14] ; And output control
CALL TAB4 ; Tab before field if required
JUMPE D,JFNS4 ; No print wanted
TQNE <ASTF> ;HAD OUTPUT STARS?
JRST [ JUMPN A,DOJF3 ;YES. DO NON-ZERO VERSION
TXNE F1,VERSF!RVERF!HVERF!LVERF ;ANY SPECIALS?
JRST DOJF3 ;YES. DO THEM
JRST .+1] ;NO. DO LAST TEST
TRNN Q3,JS%TM2
JRST JFNS4
DOJF3: MOVEI B,PNCVER
CALL PUNCT
MOVE B,A
MOVEI C,12
TQNE <VERSF>
JRST [ CALL JFSTAR
JRST MRETN]
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
HRRZ A,NLUKD(P3)
CAIE A,MDDNAM
JRST [ CAIN P3,MTDTB ;AN MT?
CALL [ LDB D,[POINT 3,Q3,17] ;GET CTL BITS FOR PROTECTION
CALL TAB4 ;DO TAB CONTROL
CALL MTGPRO ;GET PROTECTION
JUMPE A,R ;IF NONE, DONE
JUMPE D,R ;OR IF NO TYPEOUT, DONE
TXO A,5B2 ;MAKE SURE IT IS A NUMBER
CALLRET JFNSP] ;AND DO IT
CALL JFNSAT ;TYPE OUT ATTRIBUTES (IF ANY)
MRETNG] ;DONE
CALL GETFDB ; Get a pointer to the fdb
JRST [ CALL JFNSAT ;TYPE OUT ATTRIBUTES (IF ANY)
MRETNG] ;DONE
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
TLNN B,700000 ; String account?
JRST [ 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)
JUMPGE P,MSTKOV ;OVERFLOW
CALL XBLTA ;DO BLT
EXCH D,A ;RESTORE
JRST JFNS43]
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]
CALL TAB4
TQNE <ASTF> ;PARSE ONLY?
JRST [ SKIPE D ;YES. WANT OUTPUT OF PROTECTION?
SKIPN FILPRT(JFN) ;YES. HAVE ONE?
JRST JFNS5 ;NO. GIVE IT UP
JRST JFNS45] ;GO DO IT
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
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]
CALL TAB4
JUMPE D,JFNS6
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: TQNE <ASTF> ;PARSE ONLY?
JRST MRETN ;YES. ALL DONE THEN
SUB P,BHC+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
CALL JFNSS
; ..
;DO SIZE IN PAGES
JFNS7: CALL JFNSAT ;OUTPUT THE ATTRIBUTES
LDB D,[POINT 1,Q3,22]
CALL JFNCOM
CALL TAB4
JUMPE D,JFNS8
MOVE B,0(P) ;GET SIZE
MOVEI C,^D10
CALL NOUTXX
;DO DATES
JFNS8: SUB P,BHC+1
POP P,B ;GET .FBCRV
TRNE Q3,1B23
CALL JFNDAT
CALL TAB4
POP P,B ;GET .FBWRT
TRNE Q3,1B24
CALL JFNDAT
CALL TAB4
POP P,B ;GET .FBREF
TRNE Q3,1B25
CALL JFNDAT
JFCL
JRST MRETN
;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 ;COPY STRING TO MONITOR SPACE
ITERR() ;FAILED
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,FILATL,(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: CALL JFNSS ;GO RETURN THE STRING TO THE USER
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
ITERR (GJFX40) ;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?
JRST JFNAT3 ;YES - THEN 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
CALL JFNSS ;OUTPUT THE PREFIX STRING
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
CALL JFNSS ;OUTPUT THE ATTRIBUTE VALUE
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,FILATL,(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
;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
CALL JFNSS
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: JUMPG A,JFNSS ; Copy to output
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
CALL TAB4
POP P,B
PUSH P,A
SETZ C,
HRROI A,1(P)
ADD P,[XWD 4,4]
ODTIM
MOVEI C,-3(P)
HRLI C,(<POINT 7,0>)
JFNDA1: ILDB B,C
JUMPE B,[SUB P,[XWD 4,4]
POP P,A
RET]
CALL BOUTA
JRST JFNDA1
;PRINT COMMA IF D=TRUE AND Q3/B32=1
JFNCOM: MOVEI B,","
CAIE D,0
TRNN Q3,1B32
RET
CALLRET BOUTA
;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
JFLOP: ILDB B,MSKSAV ; TOP OF PRINT LOOP
JUMPE B,R ; IF AT THE END, RETURN
CALL BOUTA ; OUTPUT THE BYTE
JRST JFLOP ; DO ALL OF STRING
;PRINT PUNCTUATION IF Q3/B35=1
PUNCT: TRNE Q3,1B35
CALLRET BOUTA
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
TRON Q1,JS%TM3 ; Tab usage flag in Q1
RET
CALLRET BOUTA
;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,CPOPJ ;NULL INDICATES END OF STRING
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
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(BLKF5)
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
HRRZ A,DEV ;AND FINALLY, LINE FILES COME ONLY FROM
CAIN A,DSKDTB ; DISK
JRST OPNFOK
CAIE A,MTADTB ; MAGTAPE
CAIN A,DTADTB ; AND DECTAPE
JRST OPNFOK
TQO <PASLSN> ;ALL OTHERS DON'T NEED EXAMINING
OPNFOK: 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
;3021 Addflg - 0 if ">" assumed in directory 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,addflg> ;3021 Add addflg for ">" added
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 [ JUMPE T4,[ MOVEI T1,.CHDI1 ;25 FORCE MISSING "<"
JRST RCD052 ] ;25 AND CONTINUE PARSE
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: ILDB T1,RCDDPT ;GET FIRST CHARACTER OF DIRECTORY STRING
JUMPE T1,RCD060 ;IS THERE A STRING?
;A DIRECTORY STRING WAS INPUT BY THE USER
RCD052: CALL GETDIR ;25 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: MOVE T1,RCDLND ;NO. GET DIRECTORY RESULT FROM LOGICAL NAME LOOKUP
TXNN Q2,RC%STP ;STEPPING?
CAMN T1,[-1] ;WAS A STAR FOUND?
JRST [ MOVX Q1,RC%NOM ;YES. SET 'NO MATCH'
JRST RCD500]
SKIPN T1 ;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
MOVE T2,RCDUC ;GET STRUCTURE CODE
CALL DIRLKX ;CONVERT DIRECTORY STRING TO NUMBER
JRST [ MOVX Q1,RC%NOM ;INDICATE NO MATCH
SKIPE T1 ;WAS IT AMBIGUOUS
MOVX Q1,RC%AMB ;YES. INDICATE IT
JRST RCD500]
MOVEM T1,RCDNUM ;SAVE DIRECTORY NUMBER
JRST RCD500 ;GO FINISH AND RETURN
;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
;3021 TXNN Q2,RC%STP ;STEPPING??
;3021 TXNE Q1,RC%WLD ;NO, WAS WILDCARD FOUND?
;3021 JRST RCD555 ;YES - DIR ALREADY MAPPED
TXNE Q1,RC%WLD ;3021 Wild card seen?
JRST RCD555 ;3021 Yes, dir already mapped
TXNE Q2,RC%STP ;3021 Stepping?
SKIPN addflg ;3021 Added ">"? (is 0 if ">" added)
SKIPA ;3021 Not stepping, or stepping with added ">"
JRST RCD555 ;3021 Stepping with ">" already there, dir 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
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 [ movem t4,addflg ;3021 if nul, set flag to 0
JUMPE T4,GETD10 ;25 Add ">" if needed
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
JRST GETD28
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
MOVEI T2,PSNUM ;GET NUMBER OF PUBLIC 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,FILUC,(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?
JRST RCU070 ;NO. GO LOOK UP USER NAME
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: MOVEI T1,PSNUM ;GET STRTAB OFFSET FOR PUBLIC 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
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 ;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
;3056 Begin addition
; Act differently if the user data is in a non-zero section.
TLNE Q3,-1 ;USER DATA IN SEC 0?
IFSKP. ;YES, DO IT THE OLD WAY
ADDI A,-1(Q3) ;CALC END ADDR
MOVSI B,(Q3)
HRRI B,1(Q3) ;MAKE BLT POINTER
XCTU [SETOM (Q3)] ;INITIALIZE TABLE TO -1
UMOVE Q1,3 ;GET COUNT AGAIN FOR SUBR
CAIE Q1,1 ;DONE IF ONLY 1 WORD BUFFER
XBLTUU [BLT B,(A)] ;FILL IT
ELSE. ;Handle extended addressing case
;Problems with PCXT XBLT force alternate solution.
RFTAD0: XCTU [SETOM (Q3)] ;INITIALIZE ONE WORD OF USER'S DATA BLOCK
SOSLE A ;DONE ENOUGH?
AOJA Q3,RFTAD0 ;NO, KEEP ON CHUGGING
UMOVE Q3,2 ;YES, GET ADDRESS AND ...
UMOVE Q1,3 ;...COUNT FOR DEVICE-DEPENDENT ROUTINE
ENDIF.
;3056 End addition
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
ERJMP [MOVE A,LSTERR
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
HRRZ T1,NLUKD(P3) ;IS THIS A
CAIE T1,MDDNAM ; MULTIPLE DIRECTORY DEVICE?
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(BLKF6)
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 ; Job file number
; 2 ; Byte number
; SFPTR
; Return
; +1 ; Error
; +2 ; Successful
.SFPTR::MCENT ; Become slow etc.
MOVE JFN,1
CALL DSKJFN
RETERR()
TQNN <OPNF>
ERUNLK(CLSX1)
UMOVE A,2
CALL SFBNR ; Set the byte number
ERUNLK()
CALL UNLCKF
SMRETN
; 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> ;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
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
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
MOVEI T1,PSNUM ;LOOK ON PUBLIC STR
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
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]
IFG NETN, <
SETZ A, ;1001 Ensure number is 0
HRRZ B,DEV ;1001 Is this a network connection?
CAIE B,NETDTB ;1001 ..
JRST SIBE2 ;1001
CALL NTSIBE## ;1001 Yes, check for unpacked data..
JRST [ UMOVEM A,B ;1001 there is, say not empty
JRST EMRET1] ;1001
>
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
MOVE JFN,1
CALL CHKJFN
JRST GBGJFN
JFCL
ERUNLK DESX4
TQNE <ASTF>
ERUNLK(DESX7)
HRRZ B,DEV ; Get dispatch address
MOVEI A,DESX8
CAIE B,DSKDTB
ERUNLK()
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
LOAD A,OFNBC,(D) ;GET FILE LENGTH
SIZEF1: UMOVEM A,2
UMOVEM B,3
CALL USTDIR
CALL UNLCKF
SMRETN
GBGJFN: RETERR ()
;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 <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
LOAD T2,NMFLG,T1 ;CHECK FOR 36-BIT DIR NUMB
CAIE T2,NUMVAL ;???
JRST [ MOVE T2,T1 ;SAVE POINTER FOR A WHILE
CALL PTRCHK ;CHECK THE POINTER
ITERR(DESX1) ;BAD...SO ILLEGAL DESIGNATOR
MOVE T1,T2 ;GET THE POINTER BACK
CALL CNVSTD ;STRING - TRY TO GET DIR #
ITERR ()
JRST STPPNX] ;FINISH UP
REPEAT 0,<
;THIS ISN'T REALLY NECESSARY AND ONLY BURNS CYCLES...
CALL SETDIR ;DIR # - MAP IT
ITERR () ;RETURN LOSAGE INFO
CALL USTDIR> ;VALID # - UNLOCK DIR
XCTU [HRRZ T1,1] ;GET USERS RHS
STPPNX: HRLI T1,PPNLH ;OUR OWN LHS
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
HRRZ T1,FILDDN(JFN) ;YES - 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
MOVEI B,SWJFNT
HRLI B,-SWJFNC
HRLI A,D+(IFIW)
HRLI JFN,D+(IFIW)
SWJFNL: MOVE D,(B)
MOVE C,@JFN
EXCH C,@A
MOVEM C,@JFN
AOBJN B,SWJFNL
CALL LUNLKF ;RELEASE LOCK ON THIS JFN
MOVEI A,0(JFN) ;GET OTHER
CALL LUNLKF ;AND RELEASE THIS ONE ALSO
JRST MRETN
SWJFNT: FILBYT
FILBYN
FILACT
FILLEN
FILCNT
FILLCK
FILWND
FILSTS
FILDEV
FILOFN
FILLFW
FILDDN
FILDNM
FILNEN
FILVER
FILMS1
FILMS2
FILFDB
FILCOD
SWJFNC==.-SWJFNT
;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()
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
LDB T3,[POINT 6,T1,11] ;GET BYTE SIZES
LDB T4,[POINT 6,T2,11] ;SO CAN CHECK THEM
CAIL T3,7 ;AT LEAST 7 BIT BYTES?
CAIGE T4,7
ITERR (ARGX09) ;NO, LOSE
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: XCTBMU [ILDB Q1,T2] ;READ CHARACTER OF WILD STRING
ERJMP [ITERR (,<MOVE T1,LSTERR>)] ;FAILED, PASS UPWARDS
JRST WLDCHC ;GO CHECK LOWER CASE
WLDCH2: XCTBMU [ILDB Q1,T1] ;READ CHARACTER OF NON-WILD STRING
ERJMP [ITERR (,<MOVE T1,LSTERR>)] ;FAILED, PROPAGATE ERROR
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
HRRZ T1,FILDEV(Q1) ;GET DEVICE TYPE
CAIE T1,DSKDTB ;IS IT A DISK? (ONLY WILD DEVICE IS 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,FILDIR,(JFN) ;GET DIRECTORY STRING OF WILD FILE
TXNN Q3,GJ%DIR ;WANT TO USE WILDCARDS INSTEAD?
JRST WLJFD1 ;NO, USE THIS STRING
LOAD T2,FILDMS,(JFN) ;GET WILD STRING
JUMPE T2,WLJFF ;IF NONE, ASSUME "*" AND MATCH
WLJFD1: LOAD T1,FILDIR,(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,FILNMS,(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,FILEMS,(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