Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/ap23-mon/gtjfn.mac
There are 52 other files named gtjfn.mac in the archive. Click here to see a list.
; Edit= 9082 to GTJFN.MAC on 22-Mar-89 by WONG, for SPR #22050 (TCO none)
;GTJFN% doesn't check for bad byte pointers in the long form extended blocks.
; Edit= 9041 to GTJFN.MAC on 13-Dec-88 by RASPUZZI
;Finish off some of the security features that were started at one time (like
;password expiration). Also, add new features to help a system manager secure
;the system.
; Edit= 8937 to GTJFN.MAC on 23-Aug-88 by LOMARTIRE
;Spell MONITR correctly in ACTION field of BUGs!
; Edit= 8916 to GTJFN.MAC on 18-Aug-88 by LOMARTIRE
;Improve BUG. documentation
; Edit= 8801 to GTJFN.MAC on 17-Mar-88 by RASPUZZI
;Prevent ILMNRFs or RELBADs by having GNJFN% and JFNS% use the JFNLCK when
;dealing with important information in the JFN block.
; UPD ID= 8524, RIP:<7.MONITOR>GTJFN.MAC.11, 9-Feb-88 15:52:44 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 8413, RIP:<7.MONITOR>GTJFN.MAC.10, 4-Feb-88 12:08:17 by GSCOTT
;TCO 7.1210 - Set NOSPLM normally not dumpable.
; UPD ID= 8332, RIP:<7.MONITOR>GTJFN.MAC.9, 31-Dec-87 08:39:23 by RASPUZZI
;More of TCO 7.1168 - Apparently, .CHWL1 is not defined in a useful place
; like MONSYM. Add it here so GTJFN will compile.
; UPD ID= 8331, RIP:<7.MONITOR>GTJFN.MAC.8, 29-Dec-87 11:14:44 by RASPUZZI
;TCO 7.1168 - Prevent ASTJFN BUGHLTs by making GTJFN understand that a
; file spec like "foo.boo;*" is illegal. It never worked and
; and it never will.
; UPD ID= 223, RIP:<7.MONITOR>GTJFN.MAC.7, 28-Oct-87 14:14:09 by MCCOLLUM
;TCO 7.1095 - Make SETDEV handle parse-only the way it always used to.
; UPD ID= 177, RIP:<7.MONITOR>GTJFN.MAC.6, 21-Oct-87 16:55:41 by MCCOLLUM
;TCO 7.1078 - Don't clear JSUC for parse-only JFNs in SETDEV
; UPD ID= 140, RIP:<7.MONITOR>GTJFN.MAC.5, 25-Sep-87 11:17:24 by GSCOTT
;TCO 7.1064 - That fine VANISH routine broke labeled tapes, it should only
; check to see if the "old" file exists if it is on disk. Clean up pagination.
; UPD ID= 127, RIP:<7.MONITOR>GTJFN.MAC.4, 23-Sep-87 15:44:16 by MCCOLLUM
;TCO 7.1063 - Make GTJFN% check for STRX10 in SETDEV
; UPD ID= 26, RIP:<7.MONITOR>GTJFN.MAC.3, 29-Jun-87 16:36:43 by RASPUZZI
;TCO 7.1014 - Implement partial file recognition.
; *** Edit 7420 to GTJFN.MAC by RASPUZZI on 6-Mar-87
; Prevent GTJFN% from ITRAPping by modifying edit 7300
; *** Edit 7415 to GTJFN.MAC by RASPUZZI on 10-Feb-87
; Teach routine GCH that "-" CRLF is a continuation of a line and not part of
; the file specification
; *** Edit 7408 to GTJFN.MAC by RASPUZZI on 31-Dec-86, for SPR #21410
; Prevent RELRNG BUGCHKs by cleaning up the RELJFN code and putting back SETZMs
; that edit 7371 moved.
; *** Edit 7401 to GTJFN.MAC by KKLEINER on 20-Nov-86
; At LCCH, don't upper-case characters if we are parsing a userid, password,
; account, or optional data file attribute.
; *** Edit 7393 to GTJFN.MAC by RASPUZZI on 18-Nov-86, for SPR #21272
; Finally, restore the use of VANISH and wit for more things to break.
; *** Edit 7386 to GTJFN.MAC by MCCOLLUM on 23-Oct-86
; At ENDALS, make sure FILPRT is > 0, but only supply RH to RELFRE
; *** Edit 7385 to GTJFN.MAC by MCCOLLUM on 22-Oct-86
; Use only left half of FILPRT when release free space in ENDALS
; *** Edit 7384 to GTJFN.MAC by MCCOLLUM on 15-Oct-86, for SPR #21288
; Add ASGF2 to FILST1. This bit should ALWAYS shadow the state of ASGF in
; FILSTS
; *** Edit 7383 to GTJFN.MAC by RASPUZZI on 15-Oct-86
; Remove call to VANISH. It still doesn't want to work with DUMPER
; *** Edit 7381 to GTJFN.MAC by RASPUZZI on 14-Oct-86
; Prevent PSINSKs and NOSKTRs by not letting VANISH leave us CSKED
; *** Edit 7380 to GTJFN.MAC by RASPUZZI on 10-Oct-86, for SPR #21272
; Save trashed AC before calling VERLUK
; *** Edit 7379 to GTJFN.MAC by RASPUZZI on 9-Oct-86, for SPR #21272
; Prevent CSKBUG BUGHLTs by not jumping to GNFAIL from IFNSK.
; *** Edit 7377 to GTJFN.MAC by RASPUZZI on 7-Oct-86, for SPR #21272
; Reinstall edit 7371 with nice things so it works.
; *** Edit 7373 to GTJFN.MAC by RASPUZZI on 3-Oct-86
; Remove edit 7371 until it works 100%.
; *** Edit 7371 to GTJFN.MAC by RASPUZZI on 30-Sep-86, for SPR #21272
; Prevent ILMNRFs by checking to see if current file exists before actually
; doing a GNJFN%.
; *** Edit 7345 to GTJFN.MAC by MCCOLLUM on 30-Jul-86, for SPR #21341
; Call ASGJFN in USRJFN if the user-supplied JFN is used and .GJALT specified
; *** Edit 7300 to GTJFN.MAC by RASPUZZI on 23-May-86, for SPR #21241
; Stop MONNEJ BUGCHKs by putting in missing ERJMPs
; *** Edit 7298 to GTJFN.MAC by RASPUZZI on 22-May-86
; Add code to make the .GJNOD function work when an extended block is passed
; *** Edit 7206 to GTJFN.MAC by WAGNER on 4-Dec-85, for SPR #20941
; Fix RELRNG bughlts caused by trying to release non-existant temp storage.
; There is no temp storage when a JFN is transitional.
; *** Edit 7194 to GTJFN.MAC by LOMARTIRE on 15-Nov-85 (TCO none)
; Remove edit 7135 because of bad side effects
; Edit 7135 to GTJFN.MAC by LOMARTIRE on 15-Aug-85, for SPR #15670 (TCO 6-1-1520)
; Allow JFNS% to return connected directory on parse-only JFNs
; UPD ID= 2263, SNARK:<6.1.MONITOR>GTJFN.MAC.59, 21-Jun-85 12:20:23 by LOMARTIRE
;More TCO 6.1.1292 - Remove code added at GNJFN1 until better solution found
; UPD ID= 2235, SNARK:<6.1.MONITOR>GTJFN.MAC.58, 18-Jun-85 16:35:03 by MOSER
;TCO 6.1.1459 - RETURN CORRECT ERRORS - LOGICAL NAME LOOP ETC FROM SETDEV
; UPD ID= 2214, SNARK:<6.1.MONITOR>GTJFN.MAC.57, 11-Jun-85 15:31:44 by MCCOLLUM
;TCO 6.1.1442 - Only save FILOPT in STRDVD if we came in through STRDEV
; UPD ID= 2207, SNARK:<6.1.MONITOR>GTJFN.MAC.56, 7-Jun-85 08:47:37 by LOMARTIRE
;TCO 6.1.1394 - Make extension recognition work again as in 5.1
; UPD ID= 2204, SNARK:<6.1.MONITOR>GTJFN.MAC.55, 5-Jun-85 21:07:23 by PALMIERI
;TCO 6.1.1433 Allow wildcards in filespec when doing parse only network JFNs
; UPD ID= 2081, SNARK:<6.1.MONITOR>GTJFN.MAC.54, 3-Jun-85 14:40:45 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1881, SNARK:<6.1.MONITOR>GTJFN.MAC.53, 4-May-85 12:55:45 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1784, SNARK:<6.1.MONITOR>APRSRV.MAC.196, 23-Apr-85 12:40:03 by MCCOLLUM
; UPD ID= 1699, SNARK:<6.1.MONITOR>GTJFN.MAC.52, 29-Mar-85 15:28:28 by MCCOLLUM
;TCO 6.1.1296 - Save FILOPT in RECNA0 before calling DEFDEV
; UPD ID= 1694, SNARK:<6.1.MONITOR>GTJFN.MAC.51, 28-Mar-85 12:42:30 by LOMARTIRE
;TCO 6.1.1292 - Make GNJFN handle deleted files better
; UPD ID= 1659, SNARK:<6.1.MONITOR>GTJFN.MAC.50, 20-Mar-85 14:52:12 by LOMARTIRE
;TCO 6.1.1279 - Prevent ILLUUO from bad byte pointer passed in to GTJFN
; UPD ID= 1654, SNARK:<6.1.MONITOR>GTJFN.MAC.49, 18-Mar-85 16:59:05 by PALMIERI
;TCO 6.1.1276 Allow wildcard for nodename for parse only JFN's
; UPD ID= 1622, SNARK:<6.1.MONITOR>GTJFN.MAC.48, 12-Mar-85 15:54:36 by LOMARTIRE
;More TCO 6.1.1222 - Make sure length of string is always counted correctly
; UPD ID= 1580, SNARK:<6.1.MONITOR>GTJFN.MAC.47, 4-Mar-85 07:42:40 by LOMARTIRE
;TCO 6.1.1222 - Make G1%NLN work correctly when recognition used
; UPD ID= 1431, SNARK:<6.1.MONITOR>GTJFN.MAC.46, 31-Jan-85 10:56:25 by LOMARTIRE
;TCO 6.1.1143 - Make system wide logicals search job then system wide tables
; UPD ID= 1402, SNARK:<6.1.MONITOR>GTJFN.MAC.45, 24-Jan-85 16:45:04 by LOMARTIRE
;TCO 6.1.1121 - Prevent ILMNRF in RECDIR with parse-only JFN no-match
;UPD ID= 1257, SNARK:<6.1.MONITOR>GTJFN.MAC.44, 2-Jan-85 11:09:20 by PAETZOLD
;More TCO 6.1.1101 - Change the way the FILOPT calculation is done.
; UPD ID= 1255, SNARK:<6.1.MONITOR>GTJFN.MAC.43, 1-Jan-85 18:39:43 by PAETZOLD
;More TCO 6.1.1101 - Put back GNJFN3 call in STRDEV.
; UPD ID= 1252, SNARK:<6.1.MONITOR>GTJFN.MAC.42, 1-Jan-85 15:24:29 by PAETZOLD
;TCO 6.1.1101 - Make STRDEV prevent device name block overtrimming.
; UPD ID= 5019, SNARK:<6.MONITOR>GTJFN.MAC.41, 26-Oct-84 13:51:40 by LOMARTIRE
;TCO 6.2261 - Return GJFX24 not STRX09 when device expansion fails for log name
; UPD ID= 4809, SNARK:<6.MONITOR>GTJFN.MAC.40, 17-Sep-84 10:01:12 by PURRETTA
;Update copyright notice
; UPD ID= 4801, SNARK:<6.MONITOR>GTJFN.MAC.39, 13-Sep-84 12:01:04 by PAETZOLD
;More TCO 6.2190 - Make DSK*: when it is the default device.
; UPD ID= 4737, SNARK:<6.MONITOR>GTJFN.MAC.38, 24-Aug-84 09:39:46 by PAETZOLD
;TCO 6.2190 - Fix DSK*: to work when PS is not named PS:.
; UPD ID= 4142, SNARK:<6.MONITOR>GTJFN.MAC.36, 25-Apr-84 16:06:34 by CJOHNSON
; Temporarily remove edit for TCO 6.1976 - it was crashing
; UPD ID= 3799, SNARK:<6.MONITOR>GTJFN.MAC.34, 29-Feb-84 01:42:58 by TGRADY
; Implement Global Job numbers
; - In DEFVER, user Global job number in GBLJNO to create Temp file version #
;
; UPD ID= 3784, SNARK:<6.MONITOR>GTJFN.MAC.33, 28-Feb-84 13:31:36 by CJOHNSON
;TCO 6.1976 - Make STRDEV determine the name of the p.s., rather than assume PS
; UPD ID= 3485, SNARK:<6.MONITOR>GTJFN.MAC.32, 20-Jan-84 07:44:26 by MCINTEE
;Still more TCO 6.1030 - allow node names for parse-only filespecs
; UPD ID= 3258, SNARK:<6.MONITOR>GTJFN.MAC.31, 6-Dec-83 09:51:58 by MOSER
;TCO 6.1833 - PREVENT CRASH WHEN PARSE ONLY AND ATTRIBUTES
; UPD ID= 2989, SNARK:<6.MONITOR>GTJFN.MAC.30, 5-Oct-83 14:48:23 by PAETZOLD
;TCO 6.1817 - Reset FILST1 as well as FILSTS in ASGJFN
; UPD ID= 2957, SNARK:<6.MONITOR>GTJFN.MAC.29, 28-Sep-83 16:51:43 by MOSER
;TCO 6.1810 - DON'T EXPAND DSK: IF G1%SLN SET
; UPD ID= 2888, SNARK:<6.MONITOR>GTJFN.MAC.26, 12-Sep-83 12:37:09 by PRATT
;TCO 6.1795 - Fix problem with GJ%MSG which causes user confusion @ENDAL2-2
; UPD ID= 2881, SNARK:<6.MONITOR>GTJFN.MAC.25, 8-Sep-83 09:59:47 by TBOYLE
;More TCO 6.1743 - fix typo, change .ENDIF to ENDIF.
; UPD ID= 2880, SNARK:<6.MONITOR>GTJFN.MAC.24, 7-Sep-83 12:59:32 by TBOYLE
;TCO 6.1743 - Make DEFEXT: return GJFX23 if it occurs.
; UPD ID= 2866, SNARK:<6.MONITOR>GTJFN.MAC.23, 24-Aug-83 08:17:22 by MCINTEE
;More TCO 6.1226 - In ASGJFN, clear the word FILST1
; UPD ID= 2772, SNARK:<6.MONITOR>GTJFN.MAC.22, 27-Jul-83 13:30:54 by MCINTEE
;More TCO 6.1030 - Better error message for node names in file specs
; UPD ID= 2295, SNARK:<6.MONITOR>GTJFN.MAC.21, 16-Apr-83 19:17:23 by PAETZOLD
;TCO 6.1557 - TCP Merge - Delete old edit history - Update copyright.
; UPD ID= 2146, SNARK:<6.MONITOR>GTJFN.MAC.20, 4-Apr-83 13:23:27 by MCINTEE
;More TCO 6.1030 - Node names in file spec not in 6.0
; UPD ID= 2106, SNARK:<6.MONITOR>GTJFN.MAC.19, 28-Mar-83 17:48:44 by MURPHY
;Minor cleanup - use ERJMPR instead of explicit load from LSTERR.
; UPD ID= 1596, SNARK:<6.MONITOR>GTJFN.MAC.16, 29-Dec-82 10:41:01 by DONAHUE
;TCO 6.1159 - Don't allocate CTRL/R buffer if string is from memory
; UPD ID= 1272, SNARK:<6.MONITOR>GTJFN.MAC.15, 4-Oct-82 12:42:21 by MCINTEE
;TCO 6.1030 - Add call to DIMLNK near end of .GTJFN
; UPD ID= 1125, SNARK:<6.MONITOR>GTJFN.MAC.14, 31-Aug-82 12:43:00 by MCINTEE
;TCO 6.1243 - Change all occurrences of ENDSTR to ENDSTX
; UPD ID= 1090, SNARK:<6.MONITOR>GTJFN.MAC.13, 18-Aug-82 08:10:38 by PAETZOLD
;More TCO 6.1219 - Use FILDEV from the JFN as COMND does not have DEV set up
; UPD ID= 1080, SNARK:<6.MONITOR>GTJFN.MAC.12, 11-Aug-82 15:59:45 by PAETZOLD
;One more time TCO 6.1219 - Do not use P3 as it is DEFAC'ed out
; UPD ID= 1079, SNARK:<6.MONITOR>GTJFN.MAC.11, 11-Aug-82 13:29:59 by PAETZOLD
;More TCO 6.1219 - Use P3 instead of DEV in RELJFN as DEV might have unit
; numbers in the left half
; UPD ID= 1078, SNARK:<6.MONITOR>GTJFN.MAC.10, 11-Aug-82 10:33:15 by PAETZOLD
;More TCO 6.1219 - Handle case where DEV not set in RLJFD call in RELJFN
; UPD ID= 1065, SNARK:<6.MONITOR>GTJFN.MAC.9, 9-Aug-82 16:19:49 by PAETZOLD
;TCO 6.1219 - Make RELJFN dispatch to RLJFD
; UPD ID= 979, SNARK:<6.MONITOR>GTJFN.MAC.8, 7-Jul-82 16:11:28 by MCINTEE
;More TCO 6.1143 - NFT: strikes again
; UPD ID= 963, SNARK:<6.MONITOR>GTJFN.MAC.7, 28-Jun-82 14:53:52 by MCINTEE
;More TCO 6.1030 - initialize FLLNK in JFN block
; UPD ID= 893, SNARK:<6.MONITOR>GTJFN.MAC.6, 9-Jun-82 22:56:45 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 882, SNARK:<6.MONITOR>GTJFN.MAC.5, 9-Jun-82 15:53:31 by MCINTEE
;TCO 6.1030 - change some MDDOKs to DSKOK.
; UPD ID= 855, SNARK:<6.MONITOR>GTJFN.MAC.4, 7-Jun-82 08:17:22 by MCINTEE
;TCO 6.1030 : node name parsing - recognition fix
; UPD ID= 780, SNARK:<6.MONITOR>GTJFN.MAC.3, 24-May-82 11:32:33 by MCINTEE
;more TCO 6.1143 & fix up disallowing of NFT: in file specs
; UPD ID= 773, SNARK:<6.MONITOR>GTJFN.MAC.2, 20-May-82 10:09:52 by MCINTEE
;TCO 6.1143 - Add in "local files specs only" to long form GTJFN - G1%LOC
; UPD ID= 300, SNARK:<6.MONITOR>GTJFN.MAC.13, 14-Jan-82 09:00:34 by MCINTEE
;TCO 6.1055 - GJ%NOD flag returned if node name in file spec
; UPD ID= 290, SNARK:<6.MONITOR>GTJFN.MAC.12, 10-Jan-82 15:36:07 by GROUT
;TCO 5.1656: If G1%SLN set, don't expand DSK:
; UPD ID= 284, SNARK:<6.MONITOR>GTJFN.MAC.11, 8-Jan-82 14:50:05 by MURPHY
;Restore COC words correctly (bug from code reorg)
; UPD ID= 268, SNARK:<6.MONITOR>GTJFN.MAC.10, 23-Dec-81 15:46:00 by MCINTEE
;Node name parsing : -1 in LH of FILDEV (No units on this "device")
; UPD ID= 262, SNARK:<6.MONITOR>GTJFN.MAC.9, 16-Dec-81 16:23:14 by MCINTEE
;Node name parsing - disallow wildcards & recognition and fix bugs
;Disallow use of NFT: in file spec
; UPD ID= 202, SNARK:<6.MONITOR>GTJFN.MAC.8, 10-Nov-81 12:20:27 by MURPHY
;TAKE OUT TCO 5.1415
; UPD ID= 181, SNARK:<6.MONITOR>GTJFN.MAC.7, 3-Nov-81 13:20:47 by MCINTEE
;Node name parsing - Call SETTMP after parsing the node part
; UPD ID= 140, SNARK:<6.MONITOR>GTJFN.MAC.6, 19-Oct-81 16:00:22 by COBB
;TCO 6.1029 - CHANGE SE1CAL TO EA.ENT
; UPD ID= 124, SNARK:<6.MONITOR>GTJFN.MAC.5, 19-Oct-81 09:51:37 by MCINTEE
;Fix error returns for node name parsing
; UPD ID= 107, SNARK:<6.MONITOR>GTJFN.MAC.4, 14-Oct-81 23:45:30 by MURPHY
;Fix bugs from node parsing
; UPD ID= 100, SNARK:<6.MONITOR>GTJFN.MAC.2, 12-Oct-81 11:58:31 by COBB
;tco 5.1562 - Insert default fields when called parse-only (GJ%OFG)
;NODE NAME PARSING
;PUT SOURCE INTO M60:
; UPD ID= 88, SNARK:<5.MONITOR>GTJFN.MAC.14, 4-Aug-81 09:33:39 by SCHMITT
;TCO 5.1441 - Check for stars allowed when defaulting .GJALL
; UPD ID= 34, SNARK:<5.MONITOR>GTJFN.MAC.13, 15-Jul-81 15:03:15 by SCHMITT
;TCO 5.1415 - Specify a JFN as parse only early so no FDB created
; UPD ID= 2210, SNARK:<5.MONITOR>GTJFN.MAC.12, 18-Jun-81 08:54:39 by SCHMITT
;A little more of TCO 5.1353
; UPD ID= 2102, SNARK:<5.MONITOR>GTJFN.MAC.10, 28-May-81 12:03:13 by SCHMITT
;Tco 5.1353 - Fix GNJFN when higher deleted version of file exists
;CLEAN UP CODE, SOME STEPS TOWARD PARSING NODE NAMES AS NODE::
; UPD ID= 1489, SNARK:<5.MONITOR>GTJFN.MAC.9, 25-Jan-81 20:33:21 by ZIMA
;TCO 5.1244 - Fix lost JFNs problem by ERJMPing TEXTI.
; UPD ID= 1486, SNARK:<5.MONITOR>GTJFN.MAC.8, 24-Jan-81 23:48:38 by ZIMA
;TCO 5.1241 - Fix ILPPT3 BUGHLTs caused by JFNRD on for short-form GTJFN.
; UPD ID= 1226, SNARK:<5.MONITOR>GTJFN.MAC.7, 3-Nov-80 16:37:00 by DONAHUE
;MORE 5.1164 - MOVE CHECK TO GTJF23+15 AND LITERAL AT ENDLZ1+3
; UPD ID= 1110, SNARK:<5.MONITOR>GTJFN.MAC.6, 2-Oct-80 14:01:00 by DONAHUE
;TCO 5.1164 - Check for logical name loop at SETDV1+2
; UPD ID= 727, SNARK:<5.MONITOR>GTJFN.MAC.5, 2-Jul-80 16:08:59 by SANICHARA
;TCO 5.1091 - Check for valid ASCII Char at REDFL1+3
; UPD ID= 718, SNARK:<5.MONITOR>GTJFN.MAC.4, 1-Jul-80 14:52:58 by LYONS
;TCO 5.1087 - make ^X echo in a GTJFN
; UPD ID= 706, SNARK:<5.MONITOR>GTJFN.MAC.3, 26-Jun-80 13:38:20 by SCHMITT
;TCO 5.1083 - BE NOINT WHILE JSSTLK IS LOCKED IN SETDEV
; UPD ID= 678, SNARK:<5.MONITOR>GTJFN.MAC.2, 19-Jun-80 15:14:03 by OSMAN
;tco 5.1070 - Prevent "Byte count too small" on DELETE of real long name
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG
TTITLE GTJFN ; & gnjfn
SWAPCD
PNCATT==:";" ;PUNCTUATION FOR ATTRIBUTES
PNCVER==:"." ;PUNCTUATION FOR VERSION
PNCPFX==:":" ;PREFIX PUNCTUATION FOR ATTRIBUTES
WLDCHR==:"%" ; WILD CHARACTER
PNCNOD==:":" ;PUNCTUATION FOR NODE (DIGRAPH)
.CHWL1==:"*" ;[7.1168] The other wildcard character
;GENERAL DEFINITIONS FOR RDTXT PROCESSING
;OFFSETS IN BLOCK FOR RDTXT
STRPNT==0 ;MAIN STRING POINTER
STRCNT==1 ;MAX CHARACTER COUNT
LDPNT==2 ;BYTE POINTER FOR ILDB'S
LDCNT==3 ;COUNT OF BYTES IN LDPNT STRING
ARGCNT==4 ;ARG COUNT FOR TEXT CALL
ARGFLG==5 ;FLAG WORD
ARGJFN==6 ;SOURCE,,DEST
CURPNT==7 ;CURRENT BUFFER POINTER
ARGDST==CURPNT ;STRING POINTER
CURCNT==10 ;CURRENT BYTE POINTER
ARGDC==CURCNT ;BYTE COUNT
ARGSTR==11 ;START OF BUFFER
ARGCR==12 ;^R BUFFER POINTER
STPCNT==13 ;LOGICAL NAME STEP COUNTER
FLAGS==14 ; LOCAL FLAG WORD
CNTWRD==15 ;MAX CHARACTER COUNT
PREFIX==16 ;VALUE OF ATTRIBUTE PREFIX
VARC==17 ;WORDS NEEDED FOR RDTXT STUFF
LOWBRK==COMMA ;LOWEST STATE FOR INTERESTING BREAK
;CHARACTERS
HGHBRK==ALTMOD ;HIGHEST STATE FOR INTERESTING BREAK
;CHARACTERS
MAXINP==<^D120-VARC>*5 ;MAX WORDS TO GET FOR TEXTI
DEFINP==MAXINP ;DEFAULT SIZE OF RDTXT BUFFER
LNHDRL==2 ;LENGTH OF LOGICAL NAME CHAIN BLOCK HDR
;SPECIAL AC DEFINITIONS USED HEREIN
DEFAC (TMP,Q1) ;Temporary AC
DEFAC (TXT,Q2) ;POINTER FOR RDTXT
DEFAC (E,Q3) ;POINTER TO USER PARAMETER BLOCK
DEFAC (STS,P1) ; LH-FILE STATUS, RH-MISC FLAGS
DEFAC (JFN,P2) ;THE CURRENT JFN
DEFAC (NUM,P3) ;USED AROUND GTJFN LOOP TO ACCUMULATE NUMBERS
DEFAC (DEV,P4) ;LH-DEVICE BITS, RH-DEVICE DISPATCH TABLE
DEFAC (F1,P5) ;MORE FLAGS FOR GTJFN AND LOOKUP ROUTINES
DEFINE TMSG(M)<
HRROI B,[ASCIZ M]
CALL TSTR1>
DEFINE CHOUT(C)<
MOVEI B,C
CALL OUTCH>
DEFINE ERRLJF(N,EXTRA)<
JRST [ EXTRA
IFDIF <N>,<>,<MOVEI A,N>
JRST ERRDO]>
; POINTERS TO THINGS IN JFN BLOCK
PBYTSZ::POINT 6,FILBYT(JFN),11 ; Points to "s" of file byte pointer
PFLMOD::POINT 4,FILSTS(JFN),35 ; MODE OF OPEN
;DEFINITIONS OF ENTITIES IN THE TXT BLOCK
DEFSTR (PFXVAL,PREFIX(TXT),35,9) ;POINTER TO THE PREFIX VALUE
MSKSTR WLDF,FLAGS(TXT),1B0 ; STRING IS A WILD MASK
MSKSTR DWLDF,FLAGS(TXT),1B1 ; DEFAULT STRING IS WILD
MSKSTR VERFF,FLAGS(TXT),1B2 ;COLLECTING A VERSION
MSKSTR SAWALT,FLAGS(TXT),1B3 ;SAW AN ALTMODE WHILE SCANNING
MSKSTR SWBRKT,FLAGS(TXT),1B4 ;SAW A SQUARE BRACKET FOR DIRECTORY
MSKSTR SAWCR,FLAGS(TXT),1B5 ;SAW A CR
MSKSTR SAWSLN,FLAGS(TXT),1B6 ;SAW A SYSTEM LOGICAL NAME
MSKSTR TMPFL,FLAGS(TXT),1B7 ;LAST ATTRIBUTE WAS ;T
MSKSTR PREFXF,FLAGS(TXT),1B8 ;GATHERING A PREFIX OF AN ATTRIBUTE
MSKSTR ARBATF,FLAGS(TXT),1B9 ;GATHERING THE DATA PART OF AN ATTRIBUTE
MSKSTR ATRF,FLAGS(TXT),1B10 ;HAVE SEEN AN ATTRIBUTE
MSKSTR RIEFLG,FLAGS(TXT),1B11 ;RETURN ON EMPTY FLAG
MSKSTR SAWF,FLAGS(TXT),1B12 ;SAW A CONTROL-F
MSKSTR NOLOGF,FLAGS(TXT),1B13 ;DON'T USE LOGICAL NAMES
MSKSTR COLNF,FLAGS(TXT),1B14 ;LAST CHAR WAS A COLON
MSKSTR CNTVF,FLAGS(TXT),1B15 ;CONTROL-V TYPED
MSKSTR SAWSEM,FLAGS(TXT),1B16 ;[7.1168] Saw a semi-colon
; Get a jfn for a file name
; Call: 1 ; E
; 2 ; String designator
; GTJFN
; Or
; LH(1) ; Flags (bit 17 = 1)
; RH(1) ; Default version
; 2 ; String designator or xwd infile,outfile
; GTJFN
; Return
; +1 error, in 1, error code
; +2 ok, in 1, the jfn for the file
; .GJGEN LH(E) ; Flags
; RH(E) ; Default version
; .GJSRC LH(E+1) ; Input jfn (377777 means none)
; RH(E+1) ; Output jfn (377777 means none)
; .GJDEV E+2 ; Default string pointer device
; .GJDIR E+3 ; Default string pointer directory
; .GJNAM E+4 ; Default string pointer name
; .GJEXT E+5 ; Default string pointer extension
; .GJPRO E+6 ; Default string pointer protection
; .GJACT E+7 ; Default string pointer account
; .GJJFN E+10 ; Desired jfn if jfnf=1 (optional)
; .GJF2 E+11 ;ALTERNATE FLAGS,,COUNT (CONTROLLED BY JFNRD)
; .GJCPP E+12 ;RETURN BUFFER ADDRESS
; .GJCPC E+13 ;RETURN BUFFER ADDRESS SIZE IN WORDS
; .GJRTY E+14 ; ^R BUFFER(CONTROLLED BY G1%RBF)
; .GJBFP E+15 ; POINTER TO DESTINATION BUFFER
; .GJATR E+16 ;POINTER TO ARBITRARY ATTRIBUTES BLOCK
; .GJNOD E+17 ; Default string pointer node name
; If a default string pointer is 0, then it is assumed unspecified
; If the lh of a default string pointer is 777777, 440700 is assumed
; Table of byte pointers for getting character class
; THIS TABLE IS ALSO USED BY LOGICAL NAME ROUTINES (LOGNAM)
CCSIZE==:5 ; Width of character class field
CCBPW==:^D36/CCSIZE
RADIX ^D10
Q==CCSIZE-1
CPTAB:: REPEAT ^D36/CCSIZE,<
POINT CCSIZE,CCTAB(B),Q
Q==Q+CCSIZE>
RADIX 8
; Character classification table
DEFINE CCN(C,N)<
REPEAT N,<CC1(C)>>
DEFINE CC1(C)<
QQ==QQ+CCSIZE
IFG QQ-^D35,<
QW
QW==0
QQ==CCSIZE-1>
QW==QW+<C>B<QQ>>
QQ==-1
QW==0
CCTAB: CC1(ILLCHR) ; Null
CC1(ILLCHR) ; Control-a
CCN ILLCHR,4 ; Control-b to e
CC1(CONTF) ; Control-f
CCN ILLCHR,2 ; Control-g & h
CC1(SPACE) ; TAB
CC1(TERMS) ; LF
CC1(ILLCHR) ; Control-k
CC1(TERMS) ;CONTROL-L (FF)
CC1(CARRET) ;CONTROL-M (CR)
CCN ILLCHR,4 ; Control-n - q
CC1(CONTR) ; Control-r
CCN ILLCHR,2 ; Control-s, t
CC1 (CONTU) ;CONT-U
CC1($QUOT) ; Control-v
CC1(CONTU) ; Control-w
CC1(ILLCHR) ; Control-x
CC1(ILLCHR) ; CONTROL-Y
CC1(TERMS) ;CONTROL-Z
CC1(ALTMOD) ; Alt-mode
CCN ILLCHR,3 ; 34-36
CC1(TERMS) ; Eol
CC1(SPACE) ; Space
CCN TERMS,3 ; ! " #
CC1(UPPER) ; $
CC1(WILDC) ; %
CC1 (ILLCHR) ; &
CCN TERMS,3 ;' ( )
CC1($STAR) ; Asterisk
CC1(TERMS) ; +
CC1(COMMA) ; Comma
CC1(MINUSC) ; -
CC1($DOT) ; Dot
CC1(TERMS) ; Slash
CCN DIGITC,12 ; Digits
;..
;..
CC1($COLON) ; Colon
CC1($SEMIC) ; Semi-colon
CC1($LANG) ; <
CC1(TERMS) ; =
CC1($RANG) ; >
CC1(QBRK) ; ?
CC1(TERMS) ; @
CC1(UPPERA) ; A
CCN UPPER,16 ; B - o
CC1(UPPERP) ; P
CCN UPPER,3 ; Q - s
CC1(UPPERT) ; T
CCN UPPER,6 ; U - z
CC1 ($LANG) ; [
CC1 (ILLCHR) ;\
CC1 ($RANG) ; ]
CC1 (ILLCHR) ; ^
CC1(UPPER) ; _
CC1(ILLCHR) ; Acute accent
CC1(LOWERA) ; Lower case a
CCN LOWER,16 ; Lower case b - o
CC1(LOWERP) ; Lower case p
CCN LOWER,3 ; Lower case q - s
CC1(LOWERT) ; Lower case t
CCN LOWER,6 ; Lower case u - z
CCN ILLCHR,4 ; Curly brackets vert bar complement
CC1(CONTU) ; Rubout
QW
; Character dispatch table
CHDTB:
PHASE 0 ; MAKE OFFSETS RELATIVE TO 0
UPPER::!CALL UCCH ; (0) upper case letter
LOWER::!CALL LCCH ; (1) lower case letter
EDTCHR::! ; EDITING CHARACTERS
CONTU::!ERRLJF GJFX4,<MOVEM A,ERRSAV> ;(2) FOR CONT-U
CONTR::!ERRLJF GJFX4,<MOVEM A,ERRSAV> ;(3) FOR CONT-R
COMMA::!JRST ENDCNF ;(4) COMMA
SPACE::!JRST ENDALL ;(5) SPACE
CONTF::!CALL RECFLF ;(6) CONT-F
TERMS::!JRST ENDCNF ; (7) cr, lf, ff, tab, eol
ALTMOD::!JRST RECALL ; (10) alt-mode
$COLON::!CALL ENDDEV ; (11) colon
$LANG::!CALL BEGDIR ; (12) <
$RANG::!CALL ENDDIR ; (13) >
$DOT::! CALL ENDNAM ; (14) .
$SEMIC::!CALL ENDEXT ; (15) ;
$QUOT::!CALL QUOTCH ; (16) control-v
ILLCHR::!ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (17) illegal character
$STAR::!CALL STAR ; (20) asterisk
DIGITC::!CALL DIGIT ; (21) digits
UPPERT::!CALL TCH ; (22) t
UPPERP::!CALL PCH ; (23) p
UPPERA::!CALL ACH ; (24) a
LOWERT::!CALL LCTCH ; (25) lower case t
LOWERP::!CALL LCPCH ; (26) lower case p
LOWERA::!CALL LCACH ; (27) lower case a
MINUSC::!CALL MINUS ; (30) minus sign
$CTRLX::!ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (31) ^X IS AN illegal character
QBRK::! CALL QUEST ;[7.1014] (32) ?
WILDC::!CALL PCENT ;[7.1014] (33) Wildcard character
CARRET::!CALL DOCR ; (34) CARRIAGE RETURN
$NODEP::!CALL ENDNOD ; (35) NODE PUNCTUATION
DEPHASE ; END OF ADDRESS RELOCATION
ECHDTB:
;THE JSYS
;START WITH A LOT OF INITIALIZATION
.GTJFN::MCENT ; Enter slow code
TRVAR <INFMOD,<INFCOC,2>,BKGCH,LDPTMP,LDCTMP,CRPTMP,CRCTMP> ;[7.1014]
;INFMOD - SAVED RFMOD OF INPUT FILE IF ANY
;INFCOC - SAVED RFCOC OF INPUT FILE IF ANY
;BKGCH - BACKED UP CHARACTER FROM GCH
;These next four locations are used to preserve the
;TEXTI% context when GTJFN% is processing a "?"
;LDPTMP - Byte pointer used by ILDB's
;LDCTMP - Count of bytes in above string
;CRPTMP - Current byte pointer
;CRCTMP - Count of bytes in above byte pointer
SETZB TXT,BKGCH ; MARK THAT TXT IS NOT SET UP YET
MOVE E,A ; Set pointer to parameter block
TLNE E,777777 ; Lh is non-zero?
HRRI E,1 ; Point to ac's
HRRZ F1,E
XCTU [HLLZ F,.GJGEN(F1)] ; Get flags from user
CAIN F1,1 ; Short form? (or doesn't matter case)
TQZ <JFNRD> ; Yes, GJ%XTN not allowed
SETZB F1,STS ; Clear f1 & sts
TQNE <NACCF>
TQO <FRKF>
TXNE E,GJ%FNS ; Is 2 a pointer
JRST GTJFZ ; No, skip the following
XCTU [HLRZ A,2] ; Get lh of byte pointer
HRLZI B,(<POINT 7,0>)
TRNN A,777777
XCTU [SETZM 2] ; Clear pointer if lh = 0
CAIN A,777777
XCTU [HLLM B,2] ; Put 7 bit byte into lh if -1
CAIE A,0 ; Does string pointer exist?
TQOA <STRF> ; Yes it does
GTJFZ: TQZ <STRF> ; No it does not
;..
;..
CALL SETINF ;SETUP FILES IF NECESSARY
TLNN E,777777 ; Can't specify jfn if short form
TQNN <JFNF> ; Is user trying to specify jfn?
IFSKP.
CALL USRJFN ;YES, SET IT UP
ELSE.
CALL ASGJFN ;GET A FREE JFN
ERRLJF(GJFX3) ; Jfn not available
ENDIF.
CALL SETSTR ;SET STAR BITS IN STS CORRECTLY
TQNN <JFNRD> ;EXTENDED BLOCK GIVEN?
JRST USDFLT ;NO. USE DEFAULT BUFFER SIZE
HRRZ D,E
MOVX A,G1%IIN
XCTU [TDNE A,.GJF2(D)] ; Want to find invisible files?
TQO <IGIVF> ; Yes, flag that fact
XCTU [HRRZ A,.GJF2(D)] ;YES. GET SIZE OF EXTENDED BLOCK
CAIGE A,.GJCPP-.GJF2 ;[9082]Do we have a count?
IFSKP. ;[9082]Yes
UMOVE B,.GJCPP(D) ;[9082]Get the byte pointer
TLC B,-1 ;[9082]
TLCN B,-1 ;[9082]-1,,addr?
IFSKP. ;[9082]No
TXNE B,1B12 ;[9082]Is bit 12 lit?
ERRLJF (DESX1) ;[9082]Yes, not a one word byte pointer
ENDIF. ;[9082]
ELSE. ;[9082]No count
JRST USDFLT ;[9082]Go around the rest
ENDIF. ;[9082]
CAIGE A,.GJCPC-.GJF2 ;IS THERE A COUNT GIVEN?
JRST USDFLT ;NO. GO AROUND THE REST
XCTU [SKIPG B,.GJCPC(D)] ;YES. IS IT NON-ZERO?
MOVEI B,DEFINP ;NO. USE THE DEFAULT
CAIGE A,.GJRTY-.GJF2 ;HAVE A ^R BUFFER?
JRST USDFL1 ;NO. GO ON THEN
XCTU [SKIPN A,.GJRTY(D)] ;[9082]IS THERE A ^R BUFFER?
JRST USDFL1 ;NO. USE VALUE WE NOW HAVE
TLC A,-1 ;[9082]
TLCN A,-1 ;[9082]-1,,addr pointer?
IFSKP. ;[9082]No,
TXNE A,1B12 ;[9082]Is bit 12 lit?
ERRLJF (DESX1) ;[9082]Yes, not a one word byte pointer
ENDIF. ;[9082]
SKIPA B,[MAXINP] ;YES. USE MAXIMUM VALUE
USDFLT: MOVEI B,DEFINP ;NO.GET DEFAULT
USDFL1: CAILE B,MAXINP ;WITHIN REASONABLE BOUNDS?
MOVEI B,MAXINP ;NO. MAKE IT SO
;INITIALIZATION CONTINUES...SETUP BLOCK TO BE USED BY RDTXT FOR INPUT
;EDITING OF TEXT BEFORE WE PARSE IT. SETUP ^R BUFFERS, ETC.
CALL SRDTXT ;SETUP RDTXT BLOCK
MOVEM B,STRCNT(TXT) ;SAVE IT
MOVEM A,ARGCR(TXT) ;^R BUFFER
TQNN <JFNRD> ;HAVE AN EXTENDED BLOCK?
JRST GJF00 ;NO
HRRZ D,E
UMOVE C,.GJF2(D) ;GET FLAG WORD
MOVX B,NOLOGF ;GET SUPPRESSION OF LOGICAL NAMES BIT
TXNE C,G1%SLN ;WANT THEM SUPPRESSED?
IORM B,FLAGS(TXT) ;YES, REMEMBER THAT
HRRZ B,C ;GET NUMBER OF EXTENDED WORDS
CAIL B,.GJRTY-.GJF2 ;INCLUDE A ^R BUFFER?
XCTU [SKIPN B,.GJRTY(D)] ;IS IT NON-ZERO?
IFSKP. <
CALL RTYSET> ;YES, SET IT UP
GJF00: MOVEM A,STRPNT(TXT) ;SAVE POINTER IN RDTXT AREA
MOVEM A,ARGSTR(TXT) ;START OF BUFFER
TQNN <JFNRD> ;HAVE EXTENDED ARGS?
JRST GTJF12 ;NO. GO ON
HRRZ D,E
XCTU [HRRZ C,.GJF2(D)] ;GET COUNT
CAIGE C,.GJRTY-.GJF2 ;HAVE A ^R POINTER?
JRST GTJF12 ;NO. GO ON THEN
XCTU [SKIPE .GJRTY(D)] ;IS ^R BUFFER NON-ZERO?
XCTU [SKIPN C,.GJCPC(D)] ;YES. IS COUNT NON-ZERO?
JRST GTJF12 ;NO. NO TRIMMING THEN
MOVEI B,5(C) ;ADD IN ONE WORD FOR GOOD MEASURE
CAML C,STRCNT(TXT) ;IS BUFFER TOO BIG?
JRST GTJF12 ;NO. GO ON
EXCH C,STRCNT(TXT) ;NEW COUNT
CAML B,C ;WORTH TRIMMING?
JRST GTJF12 ;NO. LEAVE IT ALONE
IDIVI B,5 ;YES. FOUND HOW BIG WE NEED IT IN WORDS
ADDI B,0(A) ;END OF THE BUFFER
HLRZ A,FILLNM(JFN) ;GET THE BLOCK
CALL TRMBLK ;TRIM IT TO ITS PROPER SIZE
GTJF12: CALL GTINPT ;JFNS FOR INPUT
MOVEM A,ARGJFN(TXT)
MOVEI A,6 ;NUMBER OF ARGS
MOVEM A,ARGCNT(TXT) ;TO ARG BLOCK
SETZM LDCNT(TXT) ;IN CASE WE HAVE A STRING
DMOVE A,STRPNT(TXT) ;SET UP CURRENT VALUES
DMOVEM A,CURPNT(TXT) ;"
; ..
; ****
;END OF SETUP OF RDTXT STUFF
; ****
;DO SOME REAL GTJFN WORK - I.E., GET AND PARSE CHARACTERS
GTJF0: CALL SETTMP ; Set up temporary string block
JRST ERRDO ; ERROR OCCURED DURING SETTMP
CALL INFTST ;IS THERE AN INPUT JFN?
JRST GTJF2 ;NO. GO READ STRING ONLY
GTJF22: MOVE B,STRPNT(TXT) ;THE START OF IT ALL
MOVEM B,ARGDST(TXT) ;CURRENT BUFFER
MOVE C,STRCNT(TXT) ;STARTING COUNT
MOVEM C,ARGDC(TXT) ;CURRENT COUNT
MRTEXT: TQNN <STRF> ;HAVE A STRING?
JRST MRTXT1 ;NO. GO READ FILE
CALL GCH ;YES. GET THE BYTE
JRST GTJF23 ;STRING EXHAUSTED.
MOVEI B,0(A) ;MOVE THE BYTE
JRST MRTXT2 ;GO SEE IF IT IS A BREAK
;..
;NOT A STRING. READ THE FILE
MRTXT1: HRLI C,(RD%JFN!RD%PUN!RD%BRK!RD%BEL!RD%BBG!RD%RND) ;FLAGS
HLLZM C,ARGFLG(TXT)
MOVEI A,ARGCNT(TXT) ;ARGUMENT BLOCK
TEXTI ;GO GET SOME INPUT
ERJMPR ERRDO ;ERR CODE TO A AND ERROR
HRRZ C,ARGDC(TXT)
HLL C,ARGFLG(TXT) ;GET THE FLAGS
TXNE C,RD%BTM ;FOUND A REAL BREAK CHARACTER?
IFSKP.
TRNN C,-1 ;NO, COUNT EXHAUSTED?
ERRLJF GJFX51 ;YES. BOMB HIM OUT
HLRZ A,ARGJFN(TXT)
GTSTS ; SEE IF IT WAS AN EOF
TXNE B,GS%EOF ; IS IT?
ERRLJF (IOX4) ;YES. GO TELL HIM
TQNE <JFNRD> ;NO. ALTERNATE FLAG WORD?
CALL [HRRZ D,E
UMOVE D,.GJF2(D) ;YES. GET IT
TXNE D,G1%RND ;DOES HE WANT CONTROL BACK?
ERRLJF(GJFX37) ;YES. HE WANT IT BACK
RET] ;GO BACK
BKJFN
JFCL ;TO GET THE BREAK
BIN ;GET IT
CAIN B,"R"-100 ;^R?
JRST [CALL RETYPE ;YES. DO IT
JRST GTJF22] ;AND DONE
CALL DING ;NO. DING AT HIM
JRST GTJF22 ;AND DONE
ENDIF.
LDB B,ARGDST(TXT) ;LOOK AT THE TERMINATOR
MRTXT2: IDIVI B,^D36/CCSIZE ;GET ITS CLASS
LDB B,CPTAB(C) ;""
CAIE B,ILLCHR ;ILLEGAL CHARACTER?
CAIN B,QBRK ;OR, A QUESTION MARK?
JRST GTJFST ;YES. BREAK ON THIS
CAIL B,LOWBRK ;AN ACTION BREAK CHARACTER?
CAILE B,HGHBRK ;MAYBE. HOW ABOUT THE HIGH END?
JRST MRTEXT
;..
;ENTER HERE ON A RETRY AFTER STEPPING A LOGICAL NAME
;..
GTJFST: MOVE A,STRPNT(TXT) ;YES IT IS INTERESTING
MOVEM A,LDPNT(TXT) ;WHERE TO START EXAMINING
MOVE A,STRCNT(TXT) ;THE COUNT
SUB A,CURCNT(TXT) ;CALCULATE NUMBER IN BUFFER
MOVEM A,LDCNT(TXT)
GTJF2: SKIPE A,BKGCH ;BACKED UP CHAR?
IFSKP.
CALL GCH ; NO, Get next character
JRST GTJF23 ;NO MORE
ELSE.
SETZM BKGCH ;CLEAR LOCAL CHAR BFR
ENDIF.
TMNN <SAWSEM> ;[7.1168] Did we just see a semi-colon?
IFSKP. ;[7.1168] If so,
CAIE A,.CHWL1 ;[7.1168] Is it followed with a *?
IFSKP. ;[7.1168] If so,
MOVEI A,GJFX40 ;[7.1168] Say undefined attribute
JRST ERRDO ;[7.1168] And clean up
ENDIF. ;[7.1168]
ENDIF. ;[7.1168]
TMNE <CNTVF> ; Control-v pending?
JRST [ SETZRO CNTVF
CALL UCCH ; Yes, ignore any special meanings
JRST ERRDO ;ERROR DURING HANDLING OF THIS CHAR
JRST GTJF2]
;..
;..
MOVX B,SAWSEM ;[7.1168] Check if a semi-colon was typed
CAIE A,.CHSEM ;[7.1168] Was it?
IFSKP. ;[7.1168] If so,
IORM B,FLAGS(TXT) ;[7.1168] Say we have seen a semi colon
ELSE. ;[7.1168]
ANDCAM B,FLAGS(TXT) ;[7.1168] No semi colon this time
ENDIF. ;[7.1168]
MOVX B,SAWCR ;SEE IF JUST SAW A CR
TDNN B,FLAGS(TXT) ;DID WE?
IFSKP.
ANDCAM B,FLAGS(TXT) ;YES. TURN OFF BIT
CAIE A,.CHLFD ;IS THIS A LINE FEED?
ERRLJF(GJFX4) ;NO. ILLEGAL CHARACTER THEN
ENDIF.
IFQN. COLNF ;PREV CHAR WAS COLON?
SETZRO COLNF ;YES, NOW HAVE
CAIE A,PNCNOD ; NODE PUNCTUATION?
IFSKP.
TQNN <ASTF> ;YES. PARSE ONLY ?
ERRLJF(GJFX55) ;NO. ILLEGAL.
MOVEI B,$NODEP ;YES, FAKE USUAL DISPATCH
ELSE.
MOVEM A,BKGCH ;NO, SAVE THIS CHAR
MOVEI B,$COLON ;HANDLE SINGLE COLON
ENDIF.
ELSE.
CAIE A,PNCNOD ;POSSIBLE NODE DIGRAPH?
IFSKP.
SETONE COLNF ;YES, MUST SEE WHAT FOLLOWS
JRST GTJF2
ENDIF.
MOVE B,A
IDIVI B,^D36/CCSIZE ;Prepare to get character class
LDB B,CPTAB(C) ;Get character class
CAIL B,ECHDTB-CHDTB
ERRLJF GJFX4,<MOVEM A,ERRSAV>
ENDIF.
GTJF21: XCT CHDTB(B) ; Execute the dispatch table
SKIPN A ; IF NON-ZERO, THEN ERROR
JRST GTJF2 ; SUCCESSFUL HANDLING OF CHARACTER
JUMPG A,ERRDO ; IF A>0 FATAL ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES, IGNORE STEPPED LOGICAL NAME
JRST GTJFST ; LOGICAL NAME WAS STEPPED, RETRY
;MAIN STRING EXHAUSTED
GTJF23: JUMPN A,ERRDO ; IF A NON-ZERO, ERROR
IFQN. COLNF ;COLON LAST SEEN?
SETZRO COLNF ;YES, CLEAR IT
MOVEI B,$COLON
JRST GTJF21 ;HANDLE IT
ENDIF.
MOVE A,FLAGS(TXT)
TXNE A,RIEFLG ;RETURN ON EMPTY?
ERRLJF GJFX48 ;YES, DO NOT GO READ FROM JFNS
CALL INFTST ; SEE IF MORE TO COME FROM TTY
JRST ENDALL ;NO. GO END THE INPUT SEQUENCE
CALL CLRJFN ;CLEAR THE JFN BLOCK AND THE FLAGS
CALL SETTMP ;GET ANOTHER WORK AREA
JRST ERRDO ;ERROR IN SETTMP
JRST MRTEXT ;GO CONTINUE COLLECTING TTY INPUT
;QUOTE CHARACTER
QUOTCH: SETONE CNTVF ;SET FLAG FOR NEXT CHAR
RETSKP
; Digits
DIGIT: MOVE C,FILCNT(JFN)
CAIGE C,MAXLC-5 ; STRING TO BE LONGER THAN 6 DIGITS?
JRST UCCH
TQNE <OCTF>
CAIGE A,"8"
TQNN <NUMFF> ; Or not collecting number
JRST UCCH ; Treat as letter
TQNE <STARF> ;SAW A STAR ALREADY?
RETBAD (GJFX4) ;YES. SYNTAX ERROR
MOVEI B,12
TQNE <OCTF>
MOVEI B,10
IMUL NUM,B ; Otherwise collect number
TQNN <NEGF>
ADDI NUM,-60(A)
TQNE <NEGF>
SUBI NUM,-60(A)
JRST LTR ; Also pack into string
; Simple characters
LCCH: MOVX B,ARBATF ;[7401]Are we collecting an attribute
TDNN B,FLAGS(TXT) ;[7401] argument now?
JRST LCCH1 ;[7401]No, go ahead and convert to uppercase
MOVE B,PREFIX(TXT) ;[7401]Yes, find out which attribute
CAIE B,.PFPWD ;[7401]Is it a password?
CAIN B,.PFUDT ;[7401]Or a userid?
JRST UCCH ;[7401]Yes, so don't uppercase it
CAIE B,.PFACN ;[7401]The same goes for network account
CAIN B,.PFOPT ;[7401]Or the optional data
JRST UCCH ;[7401]Yes, so don't uppercase it
LCCH1: SUBI A,40 ;[7401] Convert lower case to upper
UCCH: TQZ <NUMFF> ; Number is invalid now
TQZN <PRTFF> ;COLLECTING A PROTECTION FIELD?
JRST LTR ;NO
MOVX B,PREFXF ;YES, CHANGE IT TO AN ATTRIBUTE
IORM B,FLAGS(TXT) ;IT IS NOT A PROTECTION ANYMORE
MOVE B,FILCNT(JFN) ;WAS THIS THE FIRST CHARACTER?
CAME B,CNTWRD(TXT) ;ONLY PREFIXES WITH ALPHA AFTER P ALLOWED
RETBAD (GJFX40) ;ILLEGAL PREFIX
PUSH P,A ;PUT THE "P" INTO THE PREFIX STRING
MOVEI A,"P" ;SINCE IT WAS LEFT OFF BY PCH
CALL DPST ;PUT IT INTO THE STRING
RETBAD (,<POP P,0(P)>) ;ERROR OCCURED
POP P,A ;GET BACK CHARACTER AGAIN
LTR: TQNN <STARF> ;SAW STAR?
IFSKP.
MOVX B,WLDF ;YES, SET WILD BIT IN FLAGS
IORM B,FLAGS(TXT)
ENDIF.
MOVX B,PREFXF ;SEE IF THIS IS THE FIRST CHAR OF
MOVX C,TMPFL ; WAS ;T TYPED?
TDNN C,FLAGS(TXT) ; ...
JRST LTR1 ; NO
ANDCAM C,FLAGS(TXT) ; YES, MARK THAT NOW GETTING A PREFIX
JRST LTR2
LTR1: TQZE <KEYFF> ; A PREFIX OF AN ATTRIBUTE
LTR2: IORM B,FLAGS(TXT) ;YES, REMEMBER THAT
DPST: SOSGE FILCNT(JFN)
JRST [ MOVEI A,GJFX5 ; ASSUME BIGGER THAN MAX VALUE
MOVE B,CNTWRD(TXT) ;GET MAX SIZE OF THIS FIELD
CAIN B,MAXSHT ;DOING SHORT FILE NAME?
MOVEI A,GJFX41 ;YES
CAIN B,MAXEXT ;DOING SHORT EXTENSION?
MOVEI A,GJFX42 ;YES
RET] ;AND GIVE BAD RETURN
IDPB A,FILOPT(JFN) ; Append character to string
RETSKP
; Letter a
ACH: TQZN <KEYFF> ; Are we looking for a key letter?
JRST UCCH ; No. treat same as other letter
ACH1: TQNE <ACTF> ; Already have account?
RETBAD GJFX12 ; Yes. syntax error
TQO <ACTFF> ; We are now collecting account number
TQZ <NUMFF> ; DO NOT ALLOW A NUMBER
TSTNUL: MOVE B,FILCNT(JFN) ;GET BYTES LEFT
CAME B,CNTWRD(TXT) ; NULL STRING?
RETBAD (GJFX4) ; NO. ILLEGAL BYTE THEN
RETSKP
LCACH: TQZN <KEYFF> ; Same as for upper case a above
JRST LCCH
JRST ACH1
; Letter p
PCH: TQZN <KEYFF> ; Are we looking for key letter?
JRST UCCH ; No. treat as for letter
PCH1: TQNE <PRTF> ; Already have protection?
RETBAD GJFX13 ; Yes, illegal syntax
TQO <PRTFF,NUMFF>
TQO <OCTF>
JRST TSTNUL ; MUST BE A NULL INPUT FIELD
LCPCH: TQZN <KEYFF>
JRST LCCH
JRST PCH1
; Letter t
TCH: TQZN <KEYFF> ; Looking for key?
JRST UCCH ; No. treat as letter
TCH1: TQOE <TMPTF> ;TYPED IN A ;T ALREADY?
RETBAD (GJFX43) ;YES, MORE THAN ONCE IS NOT ALLOWED
MOVX A,TMPFL ;YES, REMEMBER THAT ;T WAS TYPED
IORM A,FLAGS(TXT)
MOVEI A,"T" ;STORE THE "T" INTO THE STRING
CALLRET DPST ;IN CASE IT IS A PREFIX
LCTCH: TQZN <KEYFF>
JRST LCCH
JRST TCH1
; Minus sign
MINUS: JUMPN NUM,UCCH ; If any number has been typed
TQOE <NEGF>
JRST UCCH ; Or 2 minus signs, treat as letter
JRST LTR
;SAW A CARRIAGE RETURN IN THE STRING
DOCR: MOVX A,SAWCR ; REMEMEBER THIS
IORM A,FLAGS(TXT) ; A PLACE TO REMEMBER THIS
RETSKP ; AND DONE
;NODE NAME TERMINATOR (::)
ENDNOD: TQNN DIRFF
TQNE <DEVF,DIRF,NAMF,EXTF> ;MUST BE THE FIRST FIELD
RETBAD GJFX54
CALL ENDSTX ;TERMINATE STRING
CALL ENDTMP ;SAVE THE STRING
STOR A,FLNOD,(JFN)
CALL ENDNDX ;LOOK UP NODE NAME & SETUP JFN BLOCK
RETBAD() ;ERROR, RETURN
CALLRET SETTMP ;RESET TEMP BLOCK & RETURN
;DEFAULT THE NODE NAME IF GIVEN
DEFNOD: CALL GLNNOD ;SEE IF DEFAULT FROM LOGICAL NAME
IFNSK.
JUMPN A,R ;NO, QUIT IF HARD ERROR
TXNN E,-1B17 ;[7298] Have JFN block?
TQNN JFNRD ;EXTENDED JFN BLOCK?
RETSKP ;NO, DEFAULT NODE NOT PROVIDED
XCTU [HRRZ A,.GJF2(E)];[7298] Get count in extended GTJFN block
CAIE A,.GJNOD-.GJF2 ;[7298] Is there a word there for .GJNOD?
RETSKP ;[7298] No, so let's return quietly
HRRZ D,E
XCTU [SKIPN A,.GJNOD(D)] ;SEE IF STRING HERE
RETSKP ;NO
CALL REDFLT ;YES, COPY IT
RETBAD
ENDIF.
NOINT
LOAD A,FLTSD,(JFN) ;GET TEMP STRING
SETZRO FLTSD,(JFN)
STOR A,FLNOD,(JFN) ;SAVE IT AS NODE
ENDNDX: TQNN <JFNRD> ;Long form GTJFN ?
IFSKP.
BLOCK. ;yes. this block exits +1 on error, +2 on
; success
SAVEAC <A,B> ;grab ACs
MOVX A,G1%LOC ;is local
HRRZ B,E ; files only
XCTU [TDNE A,.GJF2(B)] ; flag set ?
RET ;yes. exit block with error
RETSKP ;no. exit block success
ENDBK.
RETBAD (GJFX6) ;return the error that we used to.
ENDIF.
CALL NODLUK ;SEE IF A VALID NODE NAME
RETBAD () ;NOT VALID, PASS ALONG ERROR MESSAGE
OKINT ;MATCH ENDTMP
SETONE NODEF ;HAVE A NODE NOW
MOVEI B,NFTIDX ;IMPLIES DEVICE NFT
STOR B,FLDVX,(JFN) ;SAVE DEVICE INDEX
HRRZ DEV,DEVDSP(B) ;SET UP FILDEV - RH IS DEVICE DISPATCH
HRLI DEV,-1 ; LH IS -1, MEANS DEVICE HAS NO UNITS
MOVEM DEV,FILDEV(JFN)
SETONE FLLNK,(JFN) ;initialize link index
RETSKP
; Device name terminator (:)
; The string in the block addressed by tmpptr
; Is taken as a device. if the device exists, the string is saved
; As the device name for this file.
; SKIP RETURNS with tmpptr reset to a null string
ENDDEV: STKVAR <ENDDVS>
MOVX B,PREFXF ;SEE IF THIS IS THE END OF A PREFIX
TDNE B,FLAGS(TXT) ;...
JRST ENDPFX ;YES, GO PARSE THE PREFIX
TQNN <PRTFF,ACTFF> ;ALREADY GETTING ACCOUNT OR PROTECTION?
JRST ENDDV2 ;NO
MOVE B,FILCNT(JFN) ;SEE IF THIS IS FIRST CHAR OF FIELD
CAME B,CNTWRD(TXT) ;IS COUNT STILL AT STARTING VALUE?
JRST ENDDV2 ;NO, NOT FIRST CHARACTER OF FIELD
MOVEI A,.PFACT ;FIND OUT WHICH ATTRIBUTE THIS IS
TQNE <PRTFF> ;PROTECTION?
MOVEI A,.PFPRT ;YES
MOVEM A,PREFIX(TXT) ;STORE THIS PREFIX VALUE
TQZ <PRTFF,ACTFF> ;CLEAR THE OLD BITS
MOVX A,ARBATF ;GETTING AN ARBITRARY ATTRIBUTE NOW
IORM A,FLAGS(TXT)
RETSKP ;DONE WITH "-" DELIMITER
ENDDV2: TQNE <DIRFF> ;DIRECTORY ALREADY SPECIFIED?
RETBAD(GJFX6) ;YES, LOSE
TQOE <DEVF>
RETBAD (GJFX6) ; Device already specified (syntax)
TQNE NODEF ;HAVE SEEN NODE?
IFSKP.
CALL DEFNOD ;NO, TRY FOR DEFAULT
RET ;SOME KIND OF HARD FAILURE
ENDIF.
CALL ENDSTX ; Terminate string, get lookup pointer
MOVEM T1,ENDDVS ;SAVE STRING POINTER
TQZE <STARF> ; WAS A STAR OF SOME SORT TYPED?
JRST ENDSDV ; YES
TQNE NODEF ;HAVE NODE NOW?
JRST ENDDV0 ;YES
CALL CHKLNM ; GO SEE IF THIS IS A LOGICAL NAME
JRST ENDDV3 ;NO, GO LOOK UP DEVICE
TQZ <DEVF> ; TURN OFF DEVICE FLAG SET FROM ABOVE
PUSH P,B ;SAVE INDEX
CALL ENDTMP ;CLOSE OUT THIS STRING
POP P,B ;GET BACK INDEX
MOVEI C,FILLNM(JFN) ;GET ADDRESS OF CHAIN POINTER WORD
MOVE D,STPCNT(TXT) ;GET CURRENT STEP COUNTER FOR CHAIN
CALL LNKLGJ ;ADD THIS LOGICAL NAME TO CHAIN
JRST [ OKINT
RETBAD ()] ;PROBLEM OCCURED
OKINT ;UNDO WHAT ENDTMP DID
CALLRET SETTMP ;GET A NEW TEMPORARY STRING AND EXIT
ENDDV3: MOVE T1,ENDDVS ;RESTORE STRING POINTER
ENDDV0: CALL SETDEV ; SET UP DEVICE INFORMATION
JRST STEPLN ; NO SUCH DEVICE
CALL ENDTMP ; Truncate block
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ; Store as device name
OKINT
TQO <DEVTF> ; Remember that device was typed in
ENDDV1: CALLRET SETTMP ; Reset temp block and return
ENDSDV: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] No give bad return
CALL STRDEV ; SET UP FIRST STR IN LIST
RETBAD () ; ILLEGAL USE OF STAR
MOVEM T1,ENDDVS ; SAVE POSSIBLY ALTERED BLOCK POINTER
JRST ENDDV0 ; GO SET UP THIS STR
ENDPFX: ANDCAM B,FLAGS(TXT) ;CLEAR PREFIX FLAG
CALLRET GETPRE ;GO PARSE THE PREFIX
;ROUTINE TO CHECK THE SYNTAX OF STARED DEVICE FIELD
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL STRDEV OR STRDVD
;RETURNS +1: ILLEGAL USE OF STAR
; +2: OK, STRING NOW CONTAINS "PS"
STRDVD: TRVAR <DEFFLG>
SETOM DEFFLG ;FLAG THAT WE'RE DEFAULTING
MOVE B,[DWLDF] ;GET ONE TYPE OF WILD FLAG
JRST STRDE1 ;JOIN COMMON CODE
STRDEV: TRVAR <DEFFLG>
SETZM DEFFLG ;NOT DEFAULTING
MOVX B,WLDF ;OR ANOTHER TYPE
STRDE1: STKVAR <LPTR,DPTR> ;TEMPS FOR DSK*
ANDCAM B,FLAGS(TXT) ;CLEAR IT
MOVE B,1(A) ;GET THE NAME OF THE DEVICE
CAME B,[ASCIZ/DSK*/] ;IS IT THE MAGIC VALUE?
RETBAD (GJFX31) ;NO, ILLEGAL USE OF STAR
NOINT ;MAKE SURE ASGFRE DOES NOT GET UPSET
CALL GNJFN3 ;MAKE SURE WE HAVE AN UNTRIMMED BLOCK
RETBAD (,<OKINT>) ;FROM THE JSB, PASS DOWN FREE SPACE ERROR
OKINT
MOVX T2,<POINT 7,> ;GET BYTE POINTER LEFT HALF
HRRI T2,1(T1) ;GET THE ADDRESS OF THE BLOCK
MOVEM T2,DPTR ;SAVE THE TARGET POINTER
MOVX T2,<POINT 6,> ;GET SIXBIT BYTE POINTER
HRR T2,STRTAB+PSNUM ;GET ADR OF SDB FOR PS
MOVEM T2,LPTR ;SAVE THE SOURCE POINTER
MOVEI T3,6 ;SIX CHARACTERS
STRDE9: ;SIXBIT TO ASCII LOOP
ILDB T2,LPTR ;GET A BYTE
SKIPN T2 ;NULL?
JRST STRD10 ;YES
ADDI T2,40 ;CONVERT TO ASCII
IDPB T2,DPTR ;STORE THE ASCII
SOJG T3,STRDE9 ;LOOP FOR ALL SIX CHARS OR UNTIL NULL
STRD10: ;HERE WHEN ALL CHARS CONVERTED
SETZ T2, ;GET A NULL BYTE
IDPB T2,DPTR ;SAVE THE NULL BYTE
MOVEI T2,2(T1) ;DETERMINE A REASONABLE END OF THE BLOCK
SKIPN DEFFLG ;SET FILOPT IF NOT DEFAULTING
HRRM T2,FILOPT(JFN) ;MAKE SURE THIS BLOCK DOES NOT GET OVERTRIMMED
TQO <STRSF,STEPF> ;REMEMBER THAT THE DEVICE FIELD IS *
RETSKP ;AND EXIT WITH STRING POINTER IN A
; Directory name prefix (<)
; Sets dirff to remember that we are getting a directory name
BEGDIR: TQNN <DIRF> ; Already have directory?
TQOE <DIRFF> ; Or currently gettin one
RETBAD (GJFX7) ; Yes. syntax error
TQNN <NAMF> ; FOUND A NAME YET?
TQNE <EXTF> ; NO. FOUND AN EXTENSION YET?
RETBAD (GJFX7) ; YES. BAD SYNTAX THEN
MOVE B,FILCNT(JFN) ; GET BYTES LEFT IN BUFFER
CAME B,CNTWRD(TXT) ; NULL STRING?
RETBAD (GJFX4) ;NO TREAT IT AS ILLEGAL CHARACTER
MOVEI B,MAXLC ;ALLOW MAX COUNT ALWAYS
MOVEM B,FILCNT(JFN)
MOVEM B,CNTWRD(TXT) ;SAY SO
MOVX B,SWBRKT ;SAW "[" BIT
CAIE A,"<" ;ANGLE?
IORM B,FLAGS(TXT) ;NO. SET BIT
RETSKP
; Directory terminator (>)
; The string in tmpptr is taken as a directory name.
; If recognized, the corresponding directory number is saved
; As the directory number for this file.
; SKIP RETURNS with tmpptr reset to null
ENDDIR: TQZE <DIRFF> ; Were we collecting it?
TQOE <DIRF> ; And do we not yet have it?
RETBAD (GJFX8) ; No. error in syntax
TQNE <DEVF> ; Do we have a device yet?
JRST ENDDI0 ; YES, DONT GET ANOTHER
CALL DEFDEV ; No. default it first
JUMPN A,R ; IF FATAL ERROR, RETURN
ENDDI0: TQZE <STARF>
JRST STRDIR ; User typed <*>
CALL ENDSTX ; Terminate string, get lookup pointer
BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
IFSKP.
TQNE <ASTF> ;YES, DOING PARSE ONLY?
ANSKP.
LOAD B,FLUC,(JFN) ;GET STRUCTURE CODE
CALL DIRLKX ;NO, Lookup directory (no recognition)
JRST ENDDI1 ; Failed
STOR A,FLDNO,(JFN) ; Save directory number
ELSE.
SETZRO FLDNO,(JFN) ; NO DIRECTORY NUMBER
ENDIF.
CALL ENDTMP ; TIE OFF THE DIRECTORY NAME STRING
STOR A,FLDIR,(JFN) ; SAVE IT IN THE JFN BLOCK
OKINT ; UNLOCK SINCE ENDTMP LEFT THINGS LOCKED
ENDDI3: TQO <DIRTF> ; Remember that directory was typed in
TQZE <DFSTF> ;WAS THIS A DEFAULT?
RETSKP ;YES. DON'T SET UP STRING AGAIN
CALLRET SETTMP ; Reset temp block and return
STRDIR: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] No, give bad return
MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,WLDF ; IS IT?
JRST [ MOVE A,FILTMP(JFN)
HRLI A,10700 ; FORM SP
MOVEM A,FILOPT(JFN) ;MAKE THIS A NULL STRING
JRST STRDI2] ; GO PROCESS IT
WLDDIR: MOVEM A,FLAGS(TXT) ;YES. CLEAR FLAGS
CALL ENDTMP ; TIE OFF THE STRING
STOR A,FLDMS,(JFN) ; STORE MASK
OKINT ; ALLOW INTS AGAIN
STRDI2: TQO <STEPF,DIRSF> ;MAKE DIRECTORY STEP
SETZ A, ;START WITH FIRST NAME
CALL NAMLKX ;GO SET TO CORRECT FIRST DIRECTORY
RETBAD GJFX17 ;NO SUCH DIRECTORY
TQO <DIRTF> ;REMEMBER SEEN A DIRECTORY
TQZE <DFSTF> ;WAS THIS A DEFAULT?
RETSKP ;YES. JUST RETURN THEN
CALLRET SETTMP ;AND DONE
;HERE IF DIRECTORY LOOKUP FAILED
ENDDI1: TQNN <STRSF> ; Did user request DSK*: ?
JRST [ MOVE B,A ; COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ; NO SUCH DIRECTORY, GO STEP LOGICAL NM
JUMPL B,R ; AMBIGUOUS
JRST STEPLN]
CALL ENDTMP ; Yes, tie off directory name string
STOR A,FLDIR,(JFN) ; Store the pointer
OKINT ; Allow ints which were disallowed in ENDTMP
CALL DEVSTP ; Step the device
JRST STEPLN ; Failed, try stepping the logical name
JRST ENDDI3 ; And go finish up
; Name terminator (.)
; The string in tmpptr is taken as a file name.
; If found, the string is saved as the file name of this file.
; SKIP RETURNS with tmpptr reset to null
ENDNAM: TQNN <DIRFF> ;COLLECTING A DIRECTORY?
TQNE <ACTFF> ;COLLECTING AN ACCOUNT?
JRST DPST ;YES, PUT "." INTO STRING
MOVE C,FLAGS(TXT) ;COLLECTING A PREFIX OR ATTRIBUTE?
TXNE C,PREFXF!ARBATF ; IT MAY BE AN ACCOUNT STRING
JRST DPST ;YES, GO STORE THE "." IN THE STRING
TQNE <NAMF> ; Do we already have a name?
JRST [ TQNE <EXTF> ; HAVE AN EXTENSION YET?
RETBAD (GJFX9) ; YES. AN ERROR THEN
TQZ <KEYFF> ; NO. DON'T ALLOW KEY LETTERS
JRST ENDEX7] ; AND GO PARSE AN EXTENSION
TQO <EXTFF> ; SAY SAW A DOT
;ENTER HERE FROM RECALL
ENDNA3: TQO <NAMF> ; NO WE HAVE A NAME
TQNE <DIRF> ; Do we have a directory yet?
IFSKP.
CALL DEFDIR ; No. default it
JUMPN A,R ; RETURN IF FATAL ERROR
ENDIF.
TQZE <STARF>
JRST STARNM
CALL ENDSTX ; Terminate string, get lookup pointer
CALL NAMLKX ; Look up name without recognition
JRST STEPLN ; NO SUCH NAME, GO STEP LOGICAL NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp block
ENDNA1: HRLM A,FILNEN(JFN) ; Save as file name
OKINT
ENDNA2: TQO <NAMTF>
CALLRET SETTMP ; Reset temp block and return
STARNM: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] No give bad return
MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,WLDF ; IS IT?
JRST [ MOVE A,FILTMP(JFN)
HRLI A,10700 ; FORM SP
MOVEM A,FILOPT(JFN) ;MAKE A NULL STRING AGAIN
JRST STRNA2] ; GO PROCESS IT
WLDNAM: MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAG
CALL ENDTMP ; TIE OFF STRING
STOR A,FLNMS,(JFN) ; PUT IN MASK POINTER
OKINT ; ALLOW INTS AGAIN
CALL SETTMP ; GET NEW TEMP BLOCK
RETBAD() ; FAILED
STRNA2: TQO <NAMSF,STEPF>
TQNE <ASTF> ; OUTPUT STARS?
JRST ENDNA2 ; YES. ALL DONE THEN
SETZ A,
CALL NAMLKX
JRST STEPLN ;NO SUCH FILE NAME, GO STEP LN
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
STRNA1: HRRZ A,FILTMP(JFN)
TQNE <ASTF> ; DOING OUTPUT START?
SETZM 1(A) ; YES. USE A NULL NAME THEN
NOINT
HLLZS FILTMP(JFN)
JRST ENDNA1
; Semicolon
; Control comes here when a semicolon appears in the input
; Input preceding the semicolon may be:
; 1. a file name if no name has yet been input
; 2. an extension if a name has been input, but no extension
; 3. a protection if neither 1 or 2, and the field was started with p
; 4. a version number if neither 1,2, or 3 and input was numeric
; 5. an account number/string if field was preceded by an a
; SKIP RETURNS with tmpptr reset to null, and keyff=1, numff=1,
ENDEXT: TQNE <DIRFF> ;COLLECTING A DIRECTORY?
RETBAD (GJFX4) ;YES, ILLEGAL CHARACTER
CALL TSTLNG ;ALLOWING LONG NAMES?
RETBAD (GJFX4) ;NO
;ENTER HERE FROM RECALL
ENDEX8: TQO <KEYFF> ; NEXT SCAN WILL LOOK FOR KEY LETTERS
TQNE <NAMF> ; Do we have a name yet?
JRST ENDEX7 ; YES, DONT DEFAULT ONE
CALL ENDNAM ; No. take input string as name
RETBAD ; ERROR DURING ENDNAM
TQO <NREC> ; NO RECOGNITION PLEASE
CALL DEFEXT ; FORCE A DEFAULT EXTENSION SO
; NULL WILL NOT WORK
JRST [ JUMPN A,R ;IF POS OR NEG, RETURN
JRST ENDEX7] ;NO DEFAULT, GO TRY NULL EXT
JRST ENDEX9 ; GO FINISH UP
ENDEX7: TQOE <EXTF> ; Do we have an extension yet?
JRST ENDEX1 ; Yes
MOVX A,VERFF ; VERSION FLAG
TQNN <KEYFF> ; WAS PUNC A DOT?
IORM A,FLAGS(TXT) ; YES. NOW COLLECTING A VERSION
TQZE <STARF>
JRST STREXT
CALL ENDSTX ; No, terminate, get lookup pointer
CALL EXTLKX ; Lookup extension without recognition
JRST STEPLN ; NO SUCH EXT, GO STEP LOGICAL NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp block
ENDEX6: HRRM A,FILNEN(JFN) ; Store as file extension
OKINT
ENDEX9: TQO <EXTTF> ; Remember that extension was typed in
TQZ <EXTFF>
ENDEX0: TQO <NUMFF> ; Looking for key letters or numbers
TQZ <OCTF>
CALLRET SETTMP ; Reset temp block and return
ENDEX1: TQZN <PRTFF> ; Were we collecting a protection
JRST ENDEX2 ; No
ENDEXP: SKIPL NUM ; Negative numbers are illegal
TQNN <NUMFF> ; Must be number for now
RETBAD (GJFX14) ; Illegal protection
TLO NUM,500000
MOVEM NUM,FILPRT(JFN)
TQO <PRTF,PRTTF> ; Have a protection and it was typed
JRST ENDEX0
STREXT: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed
RETBAD (GJFX31) ;[7.1014] No, give bad return
MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,WLDF ; IS IT?
JRST [ MOVE A,FILTMP(JFN) ;GET TEMP POINTER
HRLI A,10700 ;MAKE IT A SP
MOVEM A,FILOPT(JFN) ;MAKE THIS GUY NULL
JRST STREX1] ; GO PROCESS IT
WLDEXT: MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAGS
CALL ENDTMP ; TIE OFF STRING
STOR A,FLEMS,(JFN) ; STORE MASK STRING
OKINT ; ALLOW INTS AGAIN
CALL SETTMP ; GET NEW TEMP POINTER
RETBAD() ; FAILED
STREX1: TQO <EXTSF,STEPF>
TQNE <ASTF> ; OUTPUT STARS?
JRST ENDEX9 ; YES. ALL DONE THEN
SETZ A,
CALL EXTLKX
JRST STEPLN ; NO SUCH EXT, STEP LOGICAL NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
HRRZ A,FILTMP(JFN)
TQNE <ASTF> ;DOING OUTPUT STARS?
SETZM 1(A) ;YES. USE NULL NAME
NOINT
HLLZS FILTMP(JFN)
JRST ENDEX6
ENDEX2: TQZN <ACTFF> ; Were we collecting an account
JRST ENDEX5 ; No
ENDEXA: CALL ENDSTX ; Account is a string
CALL ENDTMP
MOVEM A,FILACT(JFN) ; Save positive account block pointer
OKINT
TQNE <VERF> ; HAVE A VERSION YET?
IFSKP.
CALL DEFVER ; NO, GO GET ONE
RETBAD () ; FAILED
ENDIF.
CALL CHKACT ; SEE IF THE ACCOUNT STRING MATCHES
RETBAD (GJFX44) ; ACCOUNT STRING DOES NOT MATCH
TQO <ACTF,ACTTF>
JRST ENDEX0
ENDEX5: MOVX A,PREFXF ;GATHERING A PREFIX?
TDNE A,FLAGS(TXT) ;...
JRST ENDPRE ;YES
MOVX A,ARBATF ;GETTING AN ARBITRARY ATTRIBUTE?
TDNE A,FLAGS(TXT) ;...
JRST ENDARB ;YES
MOVX A,VERFF ; VERSION FLAG
MOVX B,TMPFL ; ;T FLAG
TDNN B,FLAGS(TXT) ;WAS THE LAST ATTRIBUTE TYPED A ;T?
TDNN A,FLAGS(TXT) ; NO, LOOKING FOR A VERSION?
IFNSK.
ANDCAM B,FLAGS(TXT) ;CLEAR ;T FLAG
MOVE A,CNTWRD(TXT)
SUB A,FILCNT(JFN)
JUMPE A,[CALLRET SETTMP] ;IF NULL FIELD, THEN OK
CAIE A,1 ;EXACTLY ONE CHAR ("T")?
RETBAD (GJFX40) ;NO. SYNTAX ERROR THEN
TQO <TMPFF> ;MARK THAT A TEMP FILE IS BEING MADE
CALLRET SETTMP ;SET UP FOR NEXT ATTRIBUTE
ENDIF.
TQNN <NUMFF> ; Was a number input?
RETBAD (GJFX10)
TQOE <VERF> ; And do we not yet have a version?
RETBAD (GJFX11) ; No. syntax error
TQZE <STARF>
JRST STRVER
SKIPN A,NUM
TQO <RVERF>
TLNE A,-1 ;SOMETHING IN LH OF VERSION?
TQNE <NEGF> ;YES. FOUND A NEGATIVE NUMBER?
IFSKP. < ;IS OKAY
RETBAD (GJFX20)> ;VERSION # IS TOO BIG
CAMN A,[-1]
TQO <HVERF>
CAMN A,[-2]
TQO <LVERF>
CAMN A,[-3]
JRST STRVER
STRVR1: CALL GTVER ;[7.1014] (/A) Lookup this version
JRST STEPLN ; GO TRY TO STEP LOGICAL NAME
MOVX B,VERFF ;[7.1014] No longer looking for version after
ANDCAM B,FLAGS(TXT) ;[7.1014] we have obtained one
JRST ENDEX0
STRVER: TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
RETBAD (GJFX31) ;[7.1014] Nope
TQO <VERSF,STEPF>
MOVNI A,2 ;START WITH OLDEST VERSION
TQNE <ASTF> ;OUTPUT STARS?
SETZ A, ;YES. USE ZERO INSTEAD
JRST STRVR1
;END OF A PREFIX
ENDPRE: ANDCAM A,FLAGS(TXT) ;CLEAR PREFIX FLAG
CALL GETPRE ;GO PARSE THE PREFIX
RETBAD ;UNKNOWN PREFIX
ENDARB: MOVX A,ARBATF ;CLEAR ARBITRARY ATTRIBUTE FLAG
ANDCAM A,FLAGS(TXT)
MOVE A,PREFIX(TXT) ;GET THE PREFIX VALUE
ANDI A,PFXMSK ;ISOLATE PREFIX NO.
CAIN A,.PFACT ;ACCOUNT STRING?
JRST ENDEXA ;YES, GO STORE IT
CAIN A,.PFPRT ;PROTECTION FIELD?
JRST ENDEXP ;YES
CAIN A,.PFOFL ; Offline attribute?
JRST ENDEX0 ; Yes, ignore it here
CALL ENDSTX ;TIE OFF THE STRING
HRRZS A ;GET THE ADR OF THE STRING BLOCK
LOAD B,PFXVAL ;GET THE PREFIX VALUE
HRRZ C,DEV ;GET DISPATCH ADDRESS ONLY
SKIPN C ;IS THERE A DEVICE?
RETBAD (GJFX40) ;NO. INVALID ATTRIBUTES
CALL @ATRD(C) ;CHECK ITS LEGALITY
RETBAD ;NOT A LEGAL PREFIX FOR THIS DEVICE
CALL ENDTMP ;NOW STORE THE ATTRIBUTE
CALL LNKATR ;LINK THE STRING ON THE ATTRIBUTE CHAIN
OKINT ;ALLOW INTERRUPTS AGAIN (FROM ENDTMP)
JRST ENDEX0 ;GO FINISH UP
;ROUTINE TO PARSE A PREFIX
GETPRE: MOVX A,ARBATF ;MARK THAT NOW COLLECTING ARB ATTRIBUTE
IORM A,FLAGS(TXT) ;...
CALL ENDSTX ;TIE OFF THE STRING
HRLI A,(POINT 7,0,35) ;GET POINTER TO THE PREFIX
MOVE B,A ;SET UP FOR THE TABLE LOOKUP
MOVEI A,PRFXTB ;GET ADDRESS OF THE PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMPR [RETBAD ()] ;ERROR CODE TO T1 AND RETURN FAIL
TXNN B,TL%ABR!TL%EXM ;FOUND A MATCH?
RETBAD (GJFX40) ;NO, UNKNOWN PREFIX
HRRZ A,0(A) ;GET THE PREFIX VALUE
MOVEM A,PREFIX(TXT) ;SAVE IT AWAY UNTIL DATA FIELD ENTERED
LOAD A,PFXVAL ;GET PREFIX VALUE
CALL CHKATR ;SEE IF THIS HAS ALREADY BEEN ENTERED
RETBAD (GJFX45) ;YES, ILLEGAL TO ENTER SAME PREFIX TWICE
CALLRET SETTMP ;SET UP FOR DATA FIELD AND RETURN
;PREFIX TABLE - THIS TABLE MUST BE ALPHABETICAL
PRFXTB::PRFXTL-1,,PRFXTL ;TABLE IS IN TBLUK FORMAT
[ASCIZ/A/],,.PFACT ;ACCOUNT STRING
[ASCIZ /BDATA/],,.PFBOP ;NETWORK BINARY OPTIONAL DATA
[ASCIZ/BLOCK-LENGTH/],,.PFBLK ;MAGTAPE BLOCK LENGTH
[ASCIZ /BPASSWORD/],,.PFBPW ;NETWORK BINARY PASSWORD
[ASCIZ /CHARGE/],,.PFACN ;NETWORK ACCOUNT STRING
[ASCIZ/COMPARTMENTS/],,.PFTCM ;TCP COMPARTMENT DATA
[ASCIZ/CONNECTION/],,.PFTCN ;TCP CONNECTION MODE
[ASCIZ/COPIES/],,.PFCOP ;SPOOLED FILE COPIES
[ASCIZ /DATA/],,.PFOPT ;NETWORK OPTIONAL DATA
[ASCIZ/EXPIRATION-DATE/],,.PFEXP ;MAGTAPE EXPRIATION DATE
[ASCIZ/FOREIGN-HOST/],,.PFTFH ;TCP FOREIGN HOST
[ASCIZ/FORMAT/],,.PFFMT ;MAGTAPE FORMAT
; [ASCIZ/FORMS/],,.PFFRM ;SPOOLED FILE FORMS
[ASCIZ/HANDLING-RESTRICTIONS/],,.PFTHR ;TCP HANDLING PARAMETERS
[ASCIZ/LOCAL-HOST/],,.PFTLH ;TCP LOCAL HOST NUMBER
[ASCIZ/P/],,.PFPRT ;PROTECTION
[ASCIZ /PASSWORD/],,.PFPWD ;NETWORK PASSWORD STRING
[ASCIZ/PERSIST/],,.PFTPR ;TCP PERSISTANCE PARAMETERS
[ASCIZ/POSITION/],,.PFPOS ;MAGTAPE POSITION
[ASCIZ/PREALLOCATE/],,.PFALC ;PREALLOCATE DISK SPACE
[ASCIZ/RECORD-LENGTH/],,.PFRLN ;MAGTAPE RECORD LENGTH
[ASCIZ/SECURITY/],,.PFTSC ;TCP SECURITY PARAMETERS
[ASCIZ /TAPE-ACCESS/],,.PFACC ;ACCESS CODE ON MT DEVICE
[ASCIZ/TEST/],,NOATRF ;TEST OF NOATRF FLAG
[ASCIZ/TIMEOUT/],,.PFTTM ;TCP TIMEOUT PARAMETERS
[ASCIZ/TRANSMISSION-CONTROL/],,.PFTTC ;TCP TRANSMISSION CONTROL PARAMETERS
[ASCIZ/TYPE-OF-SERVICE/],,.PFTTS ;TCP TYPE OF SERVICE PARAMETERS
[ASCIZ /USERID/],,.PFUDT ;NETWORK USER I.D. STRING
PRFXTL==.-PRFXTB ;LENGTH OF PREFIX TABLE
; Default device
; Call: CALL DEFDEV
; Return
; +1 ; A=0 IF DEFAULTED DEVICE WAS DSK, OR NO OUTPUT DONE
; +2 ; IF DEVICE NAME WAS OUTPUT TO USER DURING RECGNITION
; Gets default device string from user or "dsk"
; And stores as the device for the file given in jfn
; Clobbers a,b,c,d
DEFDEV: STKVAR <DEFDVS,DEFDVI>
TQNE NODEF ;HAVE NODE?
IFSKP.
CALL DEFNOD ;NO, TRY FOR DEFAULT
RET ;HARD ERROR
ENDIF.
CALL GLNDEV ; GET LOGICAL NAME DEFAULT
IFSKP. <
JRST DEFDV0> ; GO USE THIS ONE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,FILLNM(JFN) ;SEE IF THERE WAS A LOGICAL NAME TYPED
JUMPN A,DEFDV1 ;YES, DO NOT GET PROGRAM DEFAULT
;THIS IS A SPECIAL CASE TO MAKE
;"R SYS:LINK" WORK IF THE DEFINITION
;OF SYS: DOES NOT HAVE A STR SPECIFIED
HRRZ D,E
TLNN E,777777 ; No defaults if short form
XCTU [SKIPN A,.GJDEV(D)] ; Get user's default pointer
JRST DEFDV1 ; None specified, use dsk
CALL REDFLT ; Copy the default string
RETBAD ; ERROR OCCURED DURING REDFLT
;..
;..
DEFDV0: TQZE <DFSTF>
JRST DEFSDV ;CHECK LEGALITY OF STAR IN DEVICE FIELD
DFDV0A: MOVEM A,DEFDVS ;SAVE STRING POINTER
STOR A,FLTSD,(JFN) ;IN CASE STRDVD CHANGED IT
TQNE NODEF ;HAVE NODE NOW?
IFSKP.
CALL CHKLNM ;NO, SEE IF THIS DEFAULT IS A LOGICAL NAME
SKIPA A,DEFDVS ;NO, GET BACK STRING POINTER
JRST DFDVL0 ; YES, LOOP BACK AND TRY FOR A DEVICE
ENDIF.
CALL SETDEV ; SET UP DEVICE INFORMATION
IFNSK. ;No such device
CAIN A,STRX09 ;STRUCTURE MOUNT ERROR?
MOVEI A,GJFX24 ;YES, RETURN MORE CORRECT ERROR CODE
JRST STEPLN ;Step logical name
ENDIF.
NOINT
LOAD A,FLTSD,(JFN)
SETZRO FLTSD,(JFN)
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ;STORE STRING POINTER OF DEV
OKINT
TQO <DEVF>
CALLRET DFDVTY ;IF DOING RECOGNITION, TYPE OUT DEV NAM
DEFSDV: CALL STRDVD ;CHECK SYNTAX OF STAR IN DEVICE FIELD
RETBAD () ;ILLEGAL SYNTAX
JRST DFDV0A ;NOW HAVE THE FIRST DEVICE NAME
DEFDV1: MOVEI B,3 ; Need 3 words TO HOLD STR NAME
NOINT
CALL ASGJFR ; Of job storage
RETBAD (GJFX22,<OKINT>) ; No space available
HRLM A,FILDDN(JFN) ; The block is for the device name
OKINT
MOVE B,[ASCIZ /DSK/]
MOVEM B,1(A) ; The device is "dsk"
MOVEM A,DEFDVS ; SAVE STRING POINTER ADDRESS
CALL CHKLNM ; SEE IF THIS DEFAULT IS A LOGICAL NAME
SKIPA A,DEFDVS ;NO, GET STRING POINTER BACK AGAIN
JRST DFDVL1 ; YES, LOOP BACK AND TRY FOR A DEVICE
CALL SETDEV ; SET UP DEVICE INFORMATION
RETBAD () ; NO SUCH DEVICE
NOINT
MOVE A,DEFDVS ; GET NAME STRING POINTER
CALL CHKDSK ; SEE IF THIS IS "DSK:"
RETBAD (,<OKINT>) ; COULD NOT GET JSB SPACE FOR STRING
HRLM A,FILDDN(JFN) ; STORE NEW STRING POINTER
OKINT
TQO <DEVF>
JRST RFALSE ; RETURN WITH A=0
DFDVL0: NOINT ;PUT LOGICAL NAME STRING INTO FILLNM
LOAD A,FLTSD,(JFN) ;GET POINTER TO DEFAULT STRING
SETZRO FLTSD,(JFN) ;CLEAR POINTER TO LN STRING IN FILTMP
JRST DFDVL2 ;GO STORE LOGICAL NAME
DFDVL1: NOINT ;PUT LOGICAL NAME STRING INTO FILLNM
HLRZ A,FILDDN(JFN) ;GET POINTER TO DEFAULT STRING
HRRZS FILDDN(JFN) ;CLEAR POINTER TO LN STRING IN FILTMP
DFDVL2: MOVEM A,DEFDVS ;SAVE POINTER TO STRING
MOVEM B,DEFDVI ;SAVE INDEX
REPEAT 0,< ;NEVER WANT TO TYPE DEFAULTED DEVICE FIELD
MOVE B,1(A) ;GET FIRST WORD OF STRING
TRZ B,677 ;CLEAR OUT POSSIBLE GARBAGE BITS
CAME B,[ASCIZ/DSK/] ;IS THE NAME "DSK"?
CALL DFDVTY ;NO, THEN GO TYPE IT MAYBE
JFCL ;DFDVTY SKIPS SOMETIMES
MOVE A,DEFDVS ;GET BACK POINTER TO STRING
MOVE B,DEFDVI ;GET BACK INDEX
> ;END REPEAT 0
MOVEI C,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
MOVE D,STPCNT(TXT) ;GET CURRENT STEP COUNTER
CALL LNKLGJ ;ADD THIS LOGICAL NAME TO CHAIN
JRST [ OKINT
RETBAD ()] ;PROBLEM OCCURED
OKINT ;TURN ON INTERRUPTS AGAIN
CALL GLNDEV ;NOW GET PHYSICAL DEVICE
IFSKP. <
JRST DEFDV0> ;GO CHECK THIS ONE OUT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
JRST DEFDV1 ;GO USE DSK
DFDVTY: MOVE C,FILCNT(JFN) ;MAKE SURE USER HADNT TYPED ANYTHING
TQNN <DIRFF> ;OR WASNT ENTERING A DIRECTORY
CAMGE C,CNTWRD(TXT) ;...
JRST RFALSE ;YES, DONT TYPE OUT DEV
TQNN <DIRF,NAMF> ;IF ALREADY SEEN A DIR OR A NAME
TQNE <NREC> ; OR RECOGNITION IS NOT BEING DONE
JRST RFALSE ;DONT TYPE OUT THE LOGICAL NAME
HRRZ B,FILLNM(JFN) ;IS THERE A LOGICAL NAME IN EFFECT?
JUMPN B,RFALSE ;IF YES, DONT TYPE OUT DEFAULT DEV
HRRZ B,A ;GET THE POINTER TO THE LOGICAL NAME
TQNE <STRSF> ;IS THIS THE WILD DEVICE?
MOVEI B,[ASCIZ/DSK*/]-1 ;YES, CHANGE TO PROPER STRING
CALL TSTRB ;GO TYPE IT OUT
CHOUT <":"> ;AND FOLLOW NAME WITH A COLON
TQO <DEVTF> ;MARK THAT DEV WAS TYPED OUT FOR RETYPE
RETSKP ;AND RETURN
;ROUTINE TO SET UP DEVICE INFORMATION
;ACCEPTS IN A/ STRING POINTER TO DEVICE NAME
; CALL SETDEV
;RETURNS +1: NO SUCH DEVICE, ERROR CODE IN A
; +2: OK - FILIDX(JFN) AND FILDEV(JFN) SET UP PROPERLY
SETDEV: STKVAR <SETDVT>
TQNE NODEF ; HAVE SEEN NODE?
RETSKP ; YES, DEVICE FIELD NOT CHECKED
MOVEM A,SETDVT ; SAVE POINTER TO STRING
CALL DEVLUK ; Lookup device in device tables
JRST SETDV1 ; No such device
MOVE D,DEVCHR(B) ; GET DEVICE CHARACTERISTICS
TQNE <OLDNF> ; IS AN EXISTING FILE REQUIRED?
TXNE D,DV%IN ; YES, IS THIS DEVICE CAPABLE OF INPUT?
IFSKP.
MOVEI A,GJFX38 ; CANNOT GET OLD FILE ON OUTPUT ONLY DEV
JRST STEPLN ; GO SEE IF LOGICAL NAME CAN BE STEPPED
ENDIF.
HRRM B,FILIDX(JFN) ; STORE INDEX INTO DEVICE TABLES
MOVEM DEV,FILDEV(JFN) ; Value of lookup is initial fildev
HRRZ D,DEV ;GET DISPATCH TABLE ADDRESS
CAIN D,MTDTB ;IS THIS AN MT DEVICE?
TQNE <ASTF> ;YES. PARSE ONLY?
IFSKP.
CALL DEVAV ;YES. CHECK IF AVAILABLE
RETBAD (OPNX7) ;NOT. GIVE ERROR THEN
ENDIF.
BLCAL. DSKOK,<DEV> ;SEE IF DISK
RETSKP ;ISN'T
HLRZ B,DEV ;GET UNIT # (MAY BE STR #)
CAIN B,-1 ;YES - SPECIFIC STRUCTURE?
RETSKP ;NO, ALL DONE
STOR C,FLUC,(JFN) ;STORE UNIQUE CODE IN JFN BLOCK
;..
;..
SETZ B, ;THIS JSB IS MAPPED
MOVE A,C ;MOVE UNIQUE CODE TO T1 FOR CHKMNT
TLO A,400000 ;ALLOW MOUNT ONLY BY THIS FORK
NOINT ;BE NOINT WHILE JSSTLK IS LOCKED
LOCK JSSTLK ;LOCK JSB STRUCTURE INFO LOCK
CALL CHKMNT ;[7.1063](T1,T2/T1)Did user mount this structure
IFNSK. ;[7.1063]If not...
UNLOCK JSSTLK ;[7.1063]Unlock structure info lock in JSB
OKINT ;[7.1063]Allow interrupts now
TQNN <ASTF> ;[7.1095]Parse-only?
RETBAD () ;[7.1095]Return the error
SETZ C, ;[7.1095]Yes, structure is ok
HRRM C,FILIDX(JFN) ;[7.1095]Clear index into device tables
STOR C,FLUC,(JFN) ;[7.1095]Clear unique code
MOVEM C,FILDEV(JFN) ;[7.1095]Clear device
RETSKP ;[7.1095]Return success
ENDIF. ;[7.1063]
UNLOCK JSSTLK ;[7.1063]Unlock structure info lock in JSB
OKINT ;[7.1063]Allow interrupts now
LOAD A,STR,(JFN) ;[7.1063]Get structure number
CALL CKSTOF ;[7.1063](T1/T1)Is structure offline?
RETBAD () ;[7.1063]Return "Structure is offline"
RETSKP ;[7.1063]Return +2 to caller
;NO SUCH DEVICE
SETDV1: TQNE <ASTF> ; PARSE ONLY?
RETSKP ; YES, THEN DEVICE NAME IS OK
EXCH A,SETDVT ; SAVE ERROR CODE AND GET BACK POINTER
MOVEI B,FILLNM(JFN) ; NOW SEE IF THIS DEVICE IS ON LN CHAIN
CALL CHKCHN ; TO DETERMINE IF THIS IS A LN LOOP
SKIPA A,SETDVT ; NOT ON CHAIN, GET BACK ERROR CODE
MOVEI A,GJFX39 ; LOGICAL NAME LOOP
RETBAD ; RETURN WITH ERROR CODE IN A
;ROUTINE TO SEE IF DEVICE STRING IS "DSK:" AND TO CHANGE IT TO
; THE CONNECTED STRUCTURE IF IT IS "DSK:"
;ACCEPTS IN A/ LOOKUP POINTER TO DEVICE STRING
; MUST BE NOINT WHEN CALLED
; CALL CHKDSK
;RETURNS +1: ERROR, NO ROOM IN JSB FOR NEW STRING
; +2: NEW POINTER IN A, STRING WAS UPDATED TO STR NAME
; DEV AND FILDEV(JFN) MODIFIED APPROPRIATLY
CHKDSK: TLC DEV,-1 ;LH IS -1?
TLCE DEV,-1
RETSKP ;NO, ALREADY HAVE SPECIFIC STR
STKVAR <CHKDSN> ;SAVE NAME POINTER
MOVEM A,CHKDSN
BLCAL. DSKOK,<DEV> ;SEE IF REAL DISK
RETSKP ;ISN'T
MOVE B,FLAGS(TXT) ;GET FLAGS INTO B
TXNE B,NOLOGF ;ARE WE EXPANDING LOGICAL NAMES?
; CALL CHKLN1 ;TCO 6.1810;IF NOT, IS DSK: DEFINED?
SKIPA ;TCO 6.1810 NEVER EXPAND IF NOLOGF
JRST CHKDS1 ;NOLOGF CLEAR OR DSK: NOT DEFINED, TRANSLATE
MOVE A,CHKDSN ;DON'T TRANSLATE, RESTORE POINTER
RETSKP ;AND RETURN
CHKDS1: LOAD A,JSUC ;GET CONNECTED STR UNIQUE CODE
STOR A,FLUC,(JFN) ;PUT THIS IN THE JFN BLOCK
CALL CNVSTR ;CONVERT
RETBAD (GJFX16) ;NO SUCH DEVICE
HRL DEV,A ;UPDATE DEV WITH UNIT NUMBER
CALL ULKSTR
MOVE A,CHKDSN ;GET BACK THE NAME POINTER
MOVEM DEV,FILDEV(JFN) ;STORE IN JFN BLOCK
CALLRET CNVSIX ;CONVERT SIXBIT DEV NAME TO A STRING
;ROUTINE TO CHANGE THE DEVICE NAME TO THE CORRECT NAME FROM DEVTAB
;ACCEPTS IN A/ POINTER TO DEVICE NAME STRING
; MUST BE CALLED NOINT
; CALL CNVSIX
;RETURNS +1: NO ROOM TO EXPAND DEVICE NAME STRING
; +2: A/ POINTER TO NEW DEVICE NAME STRING
CNVSIX::HRRZ B,0(A) ;GET SIZE OF STRING
CAIL B,3 ;LARGE ENOUGH FOR STRUCTURE NAME?
IFSKP.
HRRZ B,A ;NO, RETURN THIS STRING
MOVEI A,JSBFRE
CALL RELFRE
MOVEI B,3 ;NOW GET A NEW STRING
CALL ASGJFR ;TO HOLD STR NAME
RETBAD (GJFX32)
ENDIF.
HLRZ C,FILDEV(JFN) ;GET STRUCTURE UNIT NUMBER
MOVE C,DEVNAM+DVXST0(C) ;GET SIXBIT NAME
MOVSI D,(POINT 7,0,35) ;SET UP STRING POINTER
HRR D,A ;TO NAME STRING BLOCK
CNVSX1: SETZ B, ;CLEAR OUT CHARACTER
LSHC B,6 ;GET NEXT CHARACTER
JUMPE B,CNVSX2 ;NULL MEANS DONE
ADDI B,40 ;MAKE CHARACTER ASCII
IDPB B,D ;STORE IN STRING
JRST CNVSX1 ;LOOP BACK FOR REST OF WORD
CNVSX2: IDPB B,D ;STORE NULL AT END
RETSKP ;AND EXIT WITH POINTER IN A
;ROUTINE TO CHECK IF A DEVICE NAME IS LOGICAL NAME
;ACCEPTS IN A/ POINTER TO NAME STRING TO BE CHECKED
; CALL CHKLNM
;RETURNS +1: NOT A LOGICAL NAME, OR LOGICAL NAMES NOT ALLOWED
; +2: STRING IS A LOGICAL NAME,
; B/ -1 = LOGICAL NAME AND IT IS ALREADY ON CHAIN
; 0 = JOB WID LOGICAL NAME
; +1 = SYSTEM LOGICAL NAME
CHKLNM: MOVE B,FLAGS(TXT) ;GET FLAGS
TXNE B,NOLOGF ;LOGICAL NAME EXPANSION SUPPRESSED?
RET ;YES, DO NOTHING
CHKLN1: STKVAR <CHKLNS,CHKLNB>
HRLI A,(POINT 7,0,35) ;SET UP A STRING POINTER TO NAME
MOVEM A,CHKLNS ;SAVE STRING POINTER
MOVEI B,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL CHKCHN ;CHECK IF THIS LN IS ON CHAIN
JRST CHKLN2 ;NOT ON CHAIN NOW
CAMGE C,STPCNT(TXT) ;IS THIS A NEW LOGICAL NAME
JRST CHKLN4 ;NO, GO SEE IF SHOULD BE ADDED TO CHAIN
JUMPG A,R ;IF THIS IS A SYSTEM LN, EXIT NOW
CHKLN3: MOVE A,CHKLNS ;GET BACK STRING POINTER
CALLRET LNLUKS ;CHECK FOR SYSTEM LOGICAL NAME
CHKLN2: TQNE <PHYOF> ;Is this physical only?
JRST CHKLN3 ;YES, ONLY LOOK A SYSTEM LOGICAL NAMES
MOVE A,CHKLNS ;GET STRING POINTER TO NAME
CALLRET LNLUKG ;SEE IF THIS IS EITHER FLAVOR OF LN
CHKLN4: MOVE C,STPCNT(TXT) ;GET CURRENT STEP COUNTER
STOR C,LNMSTP,(B) ;MARK THAT WE HAVE SEEN THIS LN DURING
; THIS STEP
SETO B, ;MARK THAT THIS SHOULD NOT BE PUT
RETSKP ; ON THE CHAIN AGAIN
;ROUTINE TO CHECK IF A LOGICAL NAME IS ON THE CHAIN ALREADY
;ACCEPTS IN A/ POINTER TO NAME STRING
; B/ ADDRESS OF CHAIN HEADER WORD
; CALL CHKCHN
;RETURNS +1: NOT ON CHAIN
; +2: ON CHAIN ALREADY,
; A/ INDEX OF LOGICAL NAME
; B/ ADDRESS OF CHAIN ELEMENT
; C/ STEP COUNTER OF THE LOGICAL NAME
CHKCHN::STKVAR <CHKCNP,CHKCNB>
HRLI A,(POINT 7,0,35) ;TURN ADDRESS INTO STRING POINTER
MOVEM A,CHKCNP ;SAVE POINTER TO STRING
HRRZ B,0(B) ;GET POINTER TO FIRST ELEMENT ON CHAIN
CHKCN0: JUMPE B,R ;IF NONE, RETURN
MOVEM B,CHKCNB ;SAVE POINTER TO NEXT LN BLOCK
LOAD A,LNMPNT,(B) ;GET POINTER TO NAME STRING
HRLI A,(POINT 7,0,35) ;MAKE IT INTO A STRING POINTER
MOVE B,CHKCNP ;GET POINTER TO NAME BEING CHECKED
CALL STRCMP ;COMPARE THE STRINGS
JRST CHKCN1 ;NO MATCH, CHECK DOWN CHAIN
MOVE B,CHKCNB ;GET ADDRESS OF THIS BLOCK
LOAD A,LNMIDX,(B) ;GET TYPE OF LOGICAL NAME
LOAD C,LNMSTP,(B) ;GET STEP COUNTER
RETSKP ;RETURN
CHKCN1: MOVE B,CHKCNB ;GET POINTER TO THIS BLOCK
LOAD B,LNMLNK,(B) ;STEP TO NEXT ONE
JRST CHKCN0 ;GO TRY NEXT ONE IN CHAIN
;ROUTINE TO LINK A LOGICAL NAME TO THE CHAIN
;ACCEPTS IN A/ STRING POINTER TO NAME
; B/ INDEX -1=DONT ADD TO CHAIN, 0=JOB WIDE, 1=SYSTEM
; C/ ADDRESS OF CHAIN HEADER WORD
; D/ STEP COUNTER OF THIS LOGICAL NAME
; CALL LNKLNM
;RETURNS +1: ERROR - CODE IN A
; +2: OK
;LNKLGJ - LOCAL VARIENT FOR GTJFN, SETS FLAGS
LNKLGJ: IFG. B ;SYSTEM LN?
SETONE SAWSLN ;YES, NOTE HAVE SEEN IT
ENDIF.
;.. ;FALL INTO COMMON ROUTINE
LNKLNM::STKVAR <LNKLNP,LNKLNI,LNKLNC,LNKLNS>
HRRZM C,LNKLNC ;SAVE ADDRESS OF CHAIN HEADER
JUMPL B,LNKLN1 ;IF B = -1, DONT ADD THIS TO CHAIN
MOVEM A,LNKLNP ;SAVE POINTER TO NAME
MOVEM B,LNKLNI ;SAVE INDEX
MOVEM D,LNKLNS ;SAVE STEP COUNTER
MOVEI B,LNHDRL ;GET LENGTH OF HEADER
CALL ASGJFR ;GET SPACE FOR LN BLOCK HEADER
RETBAD ;ERROR
HRRZ B,@LNKLNC ;GET START OF CHAIN
STOR B,LNMLNK,(A) ;POINT TO THIS NEXT ELEMENT
MOVE B,LNKLNP ;GET POINTER TO NAME STRING
STOR B,LNMPNT,(A) ;SAVE POINTER TO STRING
MOVE B,LNKLNI ;GET INDEX
STOR B,LNMIDX,(A) ;SAVE INDEX
MOVE B,LNKLNS ;GET STEP COUNTER
STOR B,LNMSTP,(A) ;SAVE IT IN CHAIN ELEMENT
MOVEI B,0 ;CLEAR COUNT
STOR B,LNMCNT,(A)
HRRM A,@LNKLNC ;PUT THIS BLOCK ON THE CHAIN
RETSKP ;AND RETURN
LNKLN1: HRRZ B,A ;RELEASE THE STRING
MOVEI A,JSBFRE
CALL RELFRE
RETSKP ;AND EXIT
; Default directory
; Call: JFN
; CALL DEFDIR
; Returns
; +1 ; A=0 IF DEFAULTED DIR IS SAME AS CURRENT DIR,
; AND NO OUTPUT DONE
; +2 ; IF DIR WAS OUTPUT TO USER DURING RECOGNITION
; Clobbers a,b,c,d
DEFDIR: TQNE <DEVF>
JRST DEFDI2 ;ALREADY HAVE A DEVICE
CALL DEFDEV
JUMPN A,R ;IF ERROR, RETURN
DEFDI2: CALL GLNDIR ; SEE IF A LOGICAL NAME DEFAULT EXISTS
IFSKP. <
JRST DEFDI0> ; YES, USE IT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,.GJDIR(A)] ; Get default pointer
JRST DEFDI1 ; None specified
CALL REDFLT ; Copy default string
RETBAD ; ERROR DURING REDFLT
DEFDI0: TQNE <DFSTF>
JRST DFDRST ;GO HANDLE DEFAULTED STAR
BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
JRST DEFDI3 ;NO
LOAD B,FLUC,(JFN) ;GET STRUCTURE NUMBER
CALL DIRLKX ; Look it up
JRST DEFDI7 ; Failed
HRRM A,FILDDN(JFN)
CALL GTCSCD ;GET CONNECTED STR,,DIRECTORY
LOAD B,FLUC,(JFN) ;GET THE UNIQUE CODE OF THIS STR
HRLZS B ;BUILD A STR/DIR NUMBER
HRR B,FILDDN(JFN) ;GET DEFAULT AGAIN
CAMN A,B ;IS THIS THE SAME AS THE DEFAULT?
IFSKP.
CALL DEFDIT ;NO, THEN TYPE OUT DIR NAME IF DOING RECOGNITION
IFSKP. <AOS 0(P)> ;DO SKIP RETURN
ENDIF.
DEFDI3: NOINT
LOAD B,FLTSD,(JFN)
STOR B,FLDIR,(JFN) ; SAVE THE NAME IN THE JFN BLOCK
SETZRO FLTSD,(JFN)
OKINT
TQO <DIRF>
JRST RFALSE ;RETURN WITH A=0
DEFDI1: BLCAL. DSKOK,<<FILDEV(JFN)>> ;REAL DISK?
SKIPA ;NO
TQNE <ASTF> ;IS IT REAL JFN?
JRST DEFDI4 ;NO, DONT SET DIRECTORY NUMBER AND STRING
LOAD A,JSCDS ;GET POINTER TO NAME STRING IN JSB
JN JSCDF,,DEFDI5 ;IF VAILD, GO COPY IT TO FLDIR
CALL GTCSCD ;GET CONNECTED STRUCTURE CODE,,DIRECTORY
CALL GDIRST ;GET A POINTER TO THE DIR NAME
RETBAD () ;FAILED
CALL STORDN ;STORE THE DIR NAME STRING
RETBAD (,<CALL USTDIR>) ;FAILED
LOAD A,FLUC,(JFN) ;GET UNIQUE CODE OF THIS STR
LOAD B,CURUC ;GET CURRENT MAPPED DIR
CAMN A,B ;SAME STR?
JRST [ LOAD A,JSDIR ;GET CONNECTED DIR NUMBER
HRRM A,FILDDN(JFN) ;YES, SAVE DIR NUMBER IN JFN BLOCK
CALL USTDIR ;UNLOCK DIR
JRST DEFDI4] ;DONE
CALL USTDIR
DEFDI6: CALL SDIRN ;NOW GET THE DIR NUMBER FROM STRING
RETBAD () ;FAILED TO FIND DIR ON THIS STR
DEFDI4: TQO <DIRF>
JRST RFALSE
DEFDI5: CALL STORDN ;STORE THE STRING FROM JSB TO JFN BLOCK
RETBAD ;FAILED
LOAD A,FLUC,(JFN) ;GET UNIQUE CODE OF STRUCTURE
LOAD B,JSUC ;GET CONNECTED STR #
CAME A,B ;GETTING FILE FROM CONNECTED STR/DIR?
JRST DEFDI6 ;NO, MUST GO LOOK UP THE DIR NUMBER
LOAD A,JSDIR ;YES, CAN USE THE DIR # FROM JSB
HRRM A,FILDDN(JFN) ;STORE DIR NUMBER
JRST DEFDI4 ;GO EXIT
;HERE IF DIRECTORY LOOKUP FAILED
DEFDI7: TQNE <ASTF> ;SCAN ONLY?
JRST DEFDI3 ;YES. GO HANDLE IT
TQNN <STRSF> ; Can we step the structure?
JRST [ MOVE B,A ;COPY RETURN STATUS FROM DIRLKX
MOVEI A,GJFX17 ;NO SUCH DIRECTORY
JUMPL B,R ;RETURN GJFX17 IF AMBIGUOUS RETURN FROM DIRLKX
JRST STEPLN] ;GO STEP LOGICAL NAME AND RETURN
NOINT ; Yes. Disallow ints
LOAD B,FLTSD,(JFN)
STOR B,FLDIR,(JFN) ; SAVE THE NAME IN THE JFN BLOCK
SETZRO FLTSD,(JFN)
OKINT
CALL DEVSTP ; Step the structure
JRST STEPLN ; Failed, try stepping the logical name
CALL GTCSCD ;GET CONNECTED STR,,DIRECTORY
LOAD B,FLUC,(JFN) ;GET THE UNIQUE CODE OF THIS STR
HRLZS B ;BUILD A STR/DIR NUMBER
HRR B,FILDDN(JFN) ;GET DEFAULT AGAIN
CAME A,B ;IS THIS THE SAME AS THE DEFAULT?
CALL DEFDIT ;NO, THEN TYPE OUT DIR NAME IF DOING RECOGNITION
SKIPA ; NOTHING HAS BEEN OUTPUT TO USER YET
AOS 0(P) ;SET UP FOR SKIP RETURN
TQO <DIRF>
JRST RFALSE ;RETURN WITH A=0
;ROUTINE TO PUT A DIR NAME STRING INTO THE JFN BLOCK
;ACCEPTS IN A/ POINTER TO DIRECTORY NAME BLOCK
; CALL STORDN
;RETURNS +1: FAILED TO GET SPACE FOR NAME OR NO SUCH DIR
; +2: OK, STRING POINTER PUT IN FLDIR(JFN)
STORDN::STKVAR <STODNA,STODNL>
EA.ENT
MOVEM A,STODNA ;SAVE THE POINTER
MOVE C,[POINT 7,0(A),34] ;SET UP STRING POINTER
MOVEI B,^D10 ;GET # OF WORDS NEEDED PLUS 1 FOR HEADER
STODN0: ILDB D,C ;GET NEXT CHAR
SKIPE D ;DONE?
AOJA B,STODN0 ;NO, COUNT UP CHARACTERS SEEN
IDIVI B,5 ;COUNT THE WORDS
MOVEM B,STODNL ;REMEMBER THE COUNT
LOAD C,FLDIR,(JFN) ;GET POINTER TO EXISTING NAME STRING
JUMPE C,STODN1 ;IF ANY
HRRZS D,0(C) ;GET ITS LENGTH
CAMN B,D ;IS IT LONG ENOUGH FOR THE NEW NAME?
JRST STODN2 ;YES, USE IT
MOVEI A,JSBFRE ;NO, RELEASE IT
MOVE B,C ;GET ADR OF STRING
CALL RELFRE ;RELEASE IT
STODN1: NOINT ;DO NOT PERMIT INTERRUPTS DURING THE ASSIGN
MOVE B,STODNL ;GET THE COUNT OF WORDS NEEDED
CALL ASGJFR ;GET A BLOCK FOR THE DIR NAME
RETBAD (,<OKINT>) ;COULD NOT GET ROOM
STOR A,FLDIR,(JFN) ;REMEMBER THIS STRING IN THE JFN BLOCK
OKINT ;PERMIT INTERRUPTS AGAIN
STODN2: MOVE D,STODNA ;GET BACK POINTER TO NAME STRING
MOVE B,[POINT 7,0(D),34] ;GET A BYTE POINTER TO NAME STRING
LOAD A,FLDIR,(JFN) ;SET UP BYTE POINTER TO STRING IN JSB
HRLI A,(POINT 7,0,34)
STODN3: ILDB C,B ;COPY THE STRING INTO THE JFN BLOCK
IDPB C,A
JUMPN C,STODN3 ;LOOP BACK UNTIL A NULL IS SEEN
RETSKP ;AND RETURN
;ROUTINE TO GET THE DIRECTORY # FROM STRING AND UPDATE FILDDN(JFN)
SDIRN:: BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
RETSKP ;NO, THEN RETURN OK
SAVEP
LOAD A,FLDIR,(JFN) ;GET POINTER TO THE DIRECTORY NAME
HRRZ B,0(A) ;GET LENGTH OF THE STRING
MOVNI B,-2(B) ;GET NUMBER OF FULL WORDS
HRL A,B ;SET UP LOOKUP POINTER
LOAD B,FLUC,(JFN) ;GET THE UNIQUE CODE OF STR
CALL DIRLKX ;GET THE DIRECTORY NUMBER
RETBAD (GJFX17) ;NO SUCH DIRECTORY
HRRM A,FILDDN(JFN) ;SAVE DIRECTORY NUMBER
RETSKP ;AND RETURN
DFDRST: STKVAR <DRSFIL>
MOVE A,FILOPT(JFN)
MOVEM A,DRSFIL ;SAVE POINTER
MOVE A,FLAGS(TXT) ; SEE IF WAS WILD
TXZN A,DWLDF ; WAS IT?
JRST DFDRS1 ; NO
MOVEM A,FLAGS(TXT) ;YES. CLEAR FLAG
NOINT ; NO INTS
LOAD A,FLTSD,(JFN) ; GET TEMP STRING
STOR A,FLDMS,(JFN) ; TO MASK FIELD
SETZRO FLTSD,(JFN)
OKINT ; ALLOW INTS
DFDRS1: CALL STRDI2 ;GO HANDLE WILD DIRECTORY
RETBAD() ;NO GOOD
MOVE A,DRSFIL
MOVEM A,FILOPT(JFN) ;REASTORE POINTER
TQO <DIRF> ;LITE THE DIR FIELD SEEN
MOVE C,FILCNT(JFN) ;GET RESIDUE COUNT
TQNN <NAMF,NAMTF> ;ALREADY HAVE A NAME?
CAMGE C,CNTWRD(TXT) ;OR HAVE SOME CHARACTERS
JRST RFALSE ;YES. DON'T TYPE STAR
TQNE <NREC> ;DOING RECOGNITION?
JRST RFALSE ;NO, DONT TYPE STAR
CHOUT ("<") ; PUNCTUAUTION
LOAD B,FLDMS,(JFN) ; GET DIRECTORY MASK
CALL TYSTR1 ; GO DO THIS OR A STAR
JRST DEFDT2 ; AND GO WRAP UP
DEFDIT: MOVE C,FILCNT(JFN) ;CHECK IF TYPING IS OK NOW
TQNN <NAMF,NAMTF> ;IS THERE ALREADY A NAME SEEN?
CAMGE C,CNTWRD(TXT) ;NO, ARE THERE ANY CHARACTERS TYPED IN?
RET ;YES, THEN DONT TYPE OUT THE DIRECTORY
HRRZ B,FILLNM(JFN) ;IS THERE A LOGICAL NAME YET?
JUMPN B,R ;YES, DONT TYPE ANYTHING OUT
TQNE <NREC> ;DOING RECOGNITION
RET ;NO
TQZE <DIRFF> ;WAS "<" TYPED ALREADY?
JRST DEFDT1 ;YES, DONT TYPE IT AGAIN
CHOUT ("<") ;YES, TYPE DIRECTORY NAME
DEFDT1: LOAD B,FLTSD,(JFN) ;GET STRING WITH DIR NAME IN IT
CALL TSTRB ;TYPE OUT DIR NAME
DEFDT2: CHOUT (">") ;CLOSE WITH CLOSE ANGLE BRACKET
TQO <DIRTF> ;MARK THAT DIR WAS TYPED
RETSKP
; Default name
; Call: JFN, ETC.
; CALL DEFNAM
; Return
; +1 ; A=0 MEANS No default specified
; +2 ; If successful, the name specified is set as filnam
; Clobbers a,b,c,d
DEFNAM: TQNE <DIRF>
JRST DEFNA0 ;ALREADY HAVE A DIR
CALL DEFDIR
JUMPN A,R ;IF ERROR OCCURED, RETURN
DEFNA0: CALL GLNNAM ; GO GET A LOGICAL NAME DEFAULT
IFSKP. <
JRST DEFNM1> ; FOUND ONE, GO USE IT
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default for short form
XCTU [SKIPN A,.GJNAM(A)] ; Get user's default pointer
JRST RFALSE ; None specified
CALL REDFLT ; Read default string
RETBAD
DEFNM1: TQZE <DFSTF>
JRST DFSTRN
CALL NAMLKX ; Lookup name
JRST [ TQNE <NNAMF> ; NO NAME DEVICE?
JRST RFALSE ; YES, JUST RETURN
JRST STEPLN] ; NO SUCH NAME, STEP LOGICAL NAME
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
NOINT
LOAD B,FLTSD,(JFN)
SETZRO FLTSD,(JFN)
HRLM B,FILNEN(JFN)
OKINT
TQO <NAMF,NAMTF>
TQNN <NREC>
HRLI B,(<POINT 7,0,34>) ; SET UP BYTE POINTER
CALL TSTRQC ;(B) Output the default name
RETBAD() ;Error - invalid field length
AOS (P) ;Adjust for skip return
JRST RFALSE ;Return with A set to zero
DFSTRN: MOVE A,FLAGS(TXT) ; SEE IF A WILD MASK
TXZN A,DWLDF ; IS IT?
JRST DFSTR1 ; NO
MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAG
NOINT
LOAD A,FLTSD,(JFN) ; GET DEFAULT POINTER
STOR A,FLNMS,(JFN) ; TO MASK
SETZRO FLTSD,(JFN)
OKINT
DFSTR1: TQO <NAMSF,STEPF>
SETZ A,
CALL NAMLKX ;TRY * FOR NAME
JRST [ TQNE <NNAMF> ;FAILED, NO NAME DEVICE?
JRST RFALSE ;YES, OK
JRST STEPLN] ;NO, STEP LOGICAL NAME
MOVEM A,FILFDB(JFN) ;REMEMBER THE FDB ADDRESS
CALL STRNA1 ;FINISH UP
RETBAD ()
TQZ <EXTFF>
TQO <NAMF,NAMTF>
LOAD B,FLNMS,(JFN) ; NAME MASK
TQNN <NREC>
CALL TYSTR1 ; GO DO THIS OR A STAR
RETSKP
; Default extension
; Call: JFN, ETC.
; CALL DEFEXT
; Return
; +1 ; A=0 MEANS User default does not exist
; +2 ; Hunky dory, the string specified by the user becomes
; ; The extension
DEFEXT: CALL GETDEX ; GO GET DEFAULT EXTENSION STRING
RET ; NONE THERE
TQZE <DFSTF>
JRST DFSTRE
CALL EXTLKX ; Look it up
IFNSK.
CAIE 1,GJFX23 ; DIRECTORY FULL?
JRST RFALSE ; NO, THEN SAY NO MATCH
RETBAD ; YES, THEN TELL CALLER THE REAL ERROR
ENDIF.
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
NOINT
LOAD B,FLTSD,(JFN)
SETZRO FLTSD,(JFN)
HRRM B,FILNEN(JFN)
OKINT
TQO <EXTF,EXTTF>
AOS (P)
TQNN <NREC>
TQNE <NNAMF>
JRST RFALSE
PUSH P,B
MOVEI B,"."
TQZN <EXTFF>
CALL OUTCH
POP P,B
HRLI B,(<POINT 7,0,34>) ; SET UP BYTE POINTER
SOS (P) ;Do not assume success return yet
CALL TSTRQC ;(B) Output the default extension
RETBAD() ;Error - invalid field length
AOS (P) ;Success so readjust for skip return
TQNE <NVERF>
JRST RFALSE
CALL TSTLNG ;SEE IF LONG NAMES ALLOWED
JRST DFSTRR ;NO
CHOUT <PNCVER> ;OUTPUT THE PUNCTUATION
DFSTRR: CALL ENDEX0
RETBAD
JRST RFALSE
DFSTRE: MOVEI B,"."
TQON <EXTFF>
TQNE <NREC>
JRST DFSTE1
TQNN <NNAMF>
CALL OUTCH
DFSTE1: MOVE A,FLAGS(TXT) ; SEE IF WILD MASK
TXZN A,DWLDF ; IS IT?
JRST DFSTE2 ; NO
MOVEM A,FLAGS(TXT) ; YES. CLEAR FLAG
NOINT
LOAD A,FLTSD,(JFN) ; GET DEFAULT POINTER
STOR A,FLEMS,(JFN) ; TO MASK FIELD
SETZRO FLTSD,(JFN) ; CLEAR OUT DEFAULT POINTER
OKINT
DFSTE2: CALL STREX1
RETBAD
TQO <EXTF> ;SAY SAW AN EXTENSION
LOAD B,FLEMS,(JFN) ;EXTENSION MASK
TQNN <NREC>
CALL TYSTR1 ; TYPE MASK OR STAR
TQNN <NREC>
TQNE <NVERF>
RETSKP
CALL TSTLNG ;ALLOWING LONG NAMES?
RETSKP ;NO
DFSTE3: CHOUT <PNCVER>
RETSKP
;ROUTINE TO GET THE DEFAULT EXTENSION STRING
;RETURNS +1: A=0 MEANS NO DEFAULT, A.NE.0 MEANS ERROR
; +2: STRING POINTER TO DEFAULT STRING IN A
GETDEX: CALL GLNEXT ; SEE IF A LOGICAL NAME DEFAULT EXISTS
IFSKP. <
RETSKP> ; GOT ONE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,.GJEXT(A)] ; Get user's default pointer
JRST RFALSE ; NONE THERE
CALLRET REDFLT ; Copy default string
; Default version
; Call: JFN ETC.
; CALL DEFVER
; Return
; +1 ; error
; +2 ; FOUND A VERSION
; Sets the file version number to the default specified by user
; Clobbers a,b,c,d
DEFVER: MOVEI A,0
TQNE <NVERF,NNAMF>
RETSKP
CALL GLNVER ;GET LOGICAL NAME DEFAULT IF ANY
IFNSK.
HRRZ A,E
XCTU [HRRE A,.GJGEN(A)] ;NONE, Get USER DEFINED default version
ENDIF.
TQNE <TMPFF>
SKIPE A ;TEMPORARY AND WANT "DEFAULT"?
JRST DEFVR1
MOVE A,GBLJNO ; Default becomes global job number for temp
ADDI A,^D100000
JRST DEFVR2 ;GO DO IT
DEFVR1: SKIPN A
TQNN <OUTPF>
IFSKP. <
SOS A> ; 0 default becomes -1 for output
CAMN A,[-3] ;-3 MEANS *
IFNSK. ;[7.1014]
TQNN <ASTAF,OSTRF> ;[7.1014] Stars allowed?
TQNE <ASTF> ;[7.1014] * already seen?
SKIPA ;[7.1014] Allow it
RETBAD (GJFX31) ;[7.1014] No, give an error now
JRST DFSTRV ;[7.1014] Yes, default the version to *
ENDIF. ;[7.1014]
CAMN A,[-2] ;-2 MEANS LOWEST
TQO <LVERF>
CAMN A,[-1] ;-1 MEANS NEXT HIGHER
TQO <HVERF>
SKIPN A
TQO <RVERF>
;..
;..
DEFVR2: CALL GTVER ;[7.1014] (/A) Extant?
JRST STEPLN ;[7.1014] No, step logical name
MOVE B,A
TQO <VERTF,VERF>
MOVX C,TMPFL!ATRF!ARBATF!PREFXF ;SEE IF ;T OR AN ATTRIBUTE WAS TYPED
TQNN <ACTF,PRTF> ;OR IF ;A OR ;P WERE TYPED
TDNE C,FLAGS(TXT)
RETSKP ;YES, DONT TYPE OUT RECOGNIZED VERSION #
TQNE <ACTFF,PRTFF> ;GETTING AN ACCOUNT OR PROTECTION?
RETSKP ;YES, DO NOT TYPE OUT VERSION #
TQNN <KEYFF> ;PRECEEDED BY A ";"?
TQNE <NREC>
RETSKP ;NO RECOGNITION
CALL TSTLNG ;LONG NAMES ALLOWED?
RETSKP ;NO. ALL DONE
TXNE F1,DIRSF!NAMSF!EXTSF!VERSF ;STAR TYPED?
TQNN <RVERF> ;AND MOST RECENT VERSION?
IFSKP. <
MOVEI B,0> ;YES, TYPE OUT .0 FOR VERSION #
CALL DNOUT
RETSKP
DFSTRV: CALL STRVER
RETBAD
TQO <VERTF,VERF>
TQNN <KEYFF> ;PRECEEDED BY A ;?
CALL TSTLNG ;LONG NAMES ALLOWED?
RETSKP ;NO. ALL DONE
TQNE <ACTFF,PRTFF> ;GETTING AN ACCOUNT OR PROTECTION?
RETSKP ;YES, DO NOT TYPE OUT VERSION #
TQNN <NREC>
CALL TYSTR
RETSKP
;DEFAULT THE ARBITRARY ATTRIBUTE FIELDS
;THIS ROUTINE ADDS ANY ARBITRARY ATTRIBUTES FROM THE LOGICAL
; NAME DEFINITION AND THEN ADDS ANY ATTRIBUTES FROM THE LONG
; FORM GTJFN BLOCK TO THE CHAIN OF ATTRIBUTES. IF ANY DUPLICATE
; ATTRIBUTES ARE FOUND, THEY ARE IGNORED.
;THIS ROUTINE IS CALLED AS THE LAST STEP OF THE GTJFN PROCESS
; TO GET ALL OF THE ATTRIBUTES DESTINED FOR THIS JFN
DEFATR: STKVAR <DEFATN,DEFATA>
SETZM DEFATN ;CLEAR THE ATTRIBUTE NUMBER TO 0
DEFAT1: MOVE A,DEFATN ;GET THE NUMBER OF THIS ATTRIBUTE
CALL GLNATR ;GET THE NEXT ATTRIBUTE FROM LOGICAL NAME
JRST DEFAT3 ;NONE LEFT
MOVEM A,PREFIX(TXT) ;STORE THE PREFIX VALUE
LOAD A,PFXVAL ;GET THE PREFIX VALUE
CALL CHKATR ;SEE IF THIS ONE IS ON CHAIN YET
JRST DEFAT2 ;YES, DO NOT ADD IT AGAIN
CALL ADDATR ;ADD THE ATTRIBUTE TO THE CHAIN
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
DEFAT2: AOS DEFATN ;STEP TO NEXT ATTRIBUTE
JRST DEFAT1 ;LOOP BACK FOR ALL LOGICAL NAME ATTRIBUTES
DEFAT3: TLNN E,-1 ;IS THIS A LONG FORM GTJFN
TQNN <JFNRD> ;YES, WAS LONGER FORM SPECIFIED?
RETSKP ;NO, THEN ALL DONE
XCTU [HRRZ A,11(E)] ;GET COUNT OF WORDS IN LONG BLOCK
CAIL A,.GJATR-11 ;IS THERE AN ARBITRARY ATTRIBUTE BLOCK?
XCTU [SKIPN A,.GJATR(E)] ;YES, IS IT NON-ZERO?
RETSKP ;NO, NOTHING MORE TO BE DONE
XCTU [SKIPG B,0(A)] ;SEE IF THERE ARE ANY ATTRIBUTES
RETSKP ;NO
MOVEM A,DEFATA ;SAVE ADDRESS OF ATTRIBUTE POINTERS
MOVEM B,DEFATN ;SAVE COUNT OF ATTRIBUTES
;..
;..
DEFAT4: AOS A,DEFATA ;GET ADDRESS OF NEXT ATTRIBUTE
SOSG DEFATN ;ANY MORE ATTRIBUTES?
RETSKP ;NO
UMOVE A,0(A) ;GET THE NEXT ATTRIBUTE
CALL REDPRE ;GET THE PREFIX
RETBAD ;FAILED
MOVEM B,PREFIX(TXT) ;STORE THE PREFIX VALUE
XCTBU [LDB B,A] ;GET THE TERMINATOR
IFE. B ;ENDED WITH A NUL?
SETO B, ;YES, BACK UP THE BYTE POINTER ONCE
ADJBP B,A ;SO THE DATA FIELD APPEARS TO BE NULL
MOVE A,B
ENDIF.
CALL REDFLT ;NOW GO READ IN THE DATA PORTION
RETBAD ;SOMETHING WENT WRONG
LOAD A,PFXVAL ;GET THE PREFIX VALUE
CALL CHKATR ;SEE IF THIS IS ALREADY ON CHAIN
JRST DEFAT5 ;YES, DO NOT ADD IT AGAIN
CALL ADDATR ;PUT THIS ATTRIBUTE ON THE CHAIN
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
DEFAT5: JRST DEFAT4 ;LOOP BACK FOR ALL ATTRIBUTES IN BLOCK
;ROUTINE TO CHECK IF AN ATTRIBUTE IS ON THE CHAIN ALREADY
;ACCEPTS IN A/ PREFIX VALUE TO SEARCH FOR
;RETURNS +1: PREFIX IS ON THE CHAIN ALREADY
; +2: PREFIX IS NOT ON CHAIN
CHKATR: LOAD B,FLATL,(JFN) ;GET START OF CHAIN
CHKAT1: JUMPE B,RSKP ;IF AT END OF CHAIN, RETURN OK
LOAD C,PRFXV,(B) ;GET THE VALUE OF THIS PREFIX
CAMN A,C ;IS THIS A MATCH?
RET ;YES, RETURN +1
LOAD B,PRFXL,(B) ;STEP TO THE NEXT ITEM ON CHAIN
JRST CHKAT1 ;LOOP BACK FOR REST OF CHAIN
;ROUTINE TO ADD AN ATTRIBUTE TO THE CHAIN
;ACCEPTS IN LH OF FILTMP(JFN)/ DATA PORTION OF ATTRIBUTE
; PREFIX(TXT)/ VALUE OF THE PREFIX
;RETURNS +1: ILLEGAL ATTRIBUTE FOR THIS DEVICE
; +2: ATTRIBUTE IS ON CHAIN
ADDATR: LOAD A,FLTSD,(JFN) ;FIRST CHECK LEGALITY OF ATTRIBUTE
LOAD B,PFXVAL ;GET THE PREFIX VALUE
HRRZ C,DEV ;GET DISPATCH ADDRESS ONLY
SKIPN C ;IS THERE A DEVICE?
RETBAD (GJFX40) ;NO. INVALID ATTRIBUTES
CALL @ATRD(C) ;CALL DEVICE DEPENDENT MODULE FOR OK
RETBAD () ;ILLEGAL ATTRIBUTE FOR THIS DEVICE
NOINT ;DISALLOW INTERRUPTS
LOAD A,FLTSD,(JFN) ;PICK UP THE DATA STRING
SETZRO FLTSD,(JFN) ;CLEAR POINTER TO TEMP STRING
CALL LNKATR ;LINK THIS ATTRIBUTE ONTO CHAIN
OKINT ;CAN ALLOW INTERRUPTS NOW
RETSKP ;ALL DONE
;ROUTINE TO LINK AN ATTRIBUTE ONTO THE ATTRIBUTE LIST
;ACCEPTS IN A/ ADDRESS OF STRING BLOCK OF DATA PROTION OF ATTRIBUTE
; PREFIX(TXT)/ PREFIX VALUE
;RETURNS +1: ALWAYS
LNKATR: LOAD B,FLATL,(JFN) ;GET POINTER TO FIRST ITEM ON LIST
STOR B,PRFXL,(A) ;MAKE NEW ITEM POINT DOWN THE CHAIN
MOVE B,PREFIX(TXT) ;GET PREFIX VALUE
STOR B,PRFXV,(A) ;PUT THIS VALUE IN HEADER
STOR A,FLATL,(JFN) ;PUT NEW ITEM ON CHAIN
MOVX C,ATRF ;MARK THAT AN ATTRIBUTE WAS SEEN
IORM C,FLAGS(TXT) ;THIS STOPS TYPE OUT OF THE VERSION #
RET
;ROUTINE TO READ AND PARSE A DEFAULT PREFIX STRING
;ACCEPTS IN A/ POINTER TO ATTRIBUTE STRING IN USER SPACE
;RETURNS +1: UNKNOWN PREFIX
; +2: A/ UPDATED STRING POINTER
; B/ PREFIX VALUE
REDPRE: STKVAR <REDPRB,<REDPRS,MAXLW>>
TLC A,-1 ;IS THIS ASCIZ POINTER
TLCN A,-1
HRLI A,(POINT 7,0) ;YES, SET UP BYTE POINTER
MOVEM A,REDPRB ;SAVE THE BYTE POINTER
MOVEI B,MAXLC ;GET COUNTER OF LENGTH OF MAX STRING
MOVE C,[POINT 7,REDPRS] ;GET POINTER TO TEMP STRING
REDPR1: XCTBU [ILDB A,REDPRB] ;GET NEXT CHARACTER OF PREFIX
CAIN A,PNCPFX ;IS THIS THE END OF THE PREFIX?
SETZ A, ;YES
CAIL A,"A"+40 ;LOWERCASE?
CAILE A,"Z"+40
IFSKP. <
SUBI A,40> ;YES, CONVERT IT TO UPPERCASE
IDPB A,C ;STORE THIS CHARACTER IN STRING
JUMPE A,REDPR2 ;DONE?
SOJG B,REDPR1 ;LOOP BACK FOR REST OF CHARACTERS
RETBAD (GJFX5) ;PREFIX TOO LONG
REDPR2: HRROI B,REDPRS ;GET POINTER TO START OF PREFIX STRING
MOVEI A,PRFXTB ;GET ADR OF PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMPR [RETBAD ()] ;ERR CODE TO T1 AND RETURN FAIL
TXNN B,TL%ABR!TL%EXM ;FOUND ONE?
RETBAD (GJFX40) ;NO, UNKNOWN PREFIX
HRRZ B,0(A) ;GET THE PREFIX VALUE
MOVE A,REDPRB ;GET THE BYTE POINTER
RETSKP ;AND RETURN +2
; Default account
; Call: JFN ETC.
; CALL DEFACT
; Returns
; +1 ; ERROR
; +2 ; NO ERROR
; Sets filact to that specified by program
; Clobbers a,b,c,d
DEFACT: TQNE <NVERF,NNAMF>
RETSKP
CALL GLNACT ;SEE IF A LOGICAL NAME DEFAULT EXISTS
JRST DEFAC0 ; NONE EXISTS
JUMPL T2,DEFAC4 ; WAS THIS A STRING ACCOUNT NUMBER?
JRST DEFAC1 ; NO, STORE THIS NUMBER
DEFAC0: JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,.GJACT(A)] ; Get default account
RETSKP ; NonE specified
TLC A,-1
TLCE A,-1 ;LH IS -1?
TLNN A,777777 ; Lh = 0?
HRLI A,440700 ; Yes, set up 7 bit bytes
CAMG A,[6B2-1] ; String pointer?
CAMGE A,[5B2]
JRST DEFAC2 ; Yes
DEFAC1: CALL GDFTMP ;GET A BLOCK FOR THE STRING
RETBAD () ;NONE LEFT
MOVE B,A ;GET ACCOUNT NUMBER
TLZ B,700000 ;ZERO THE 5B2
MOVE A,C ;GET STRING POINTER
MOVEI C,12 ;DECIMAL NUMBER
NOUT ;TURN NUMBER INTO A STRING
RETBAD() ;FAILED
IBP A ;NOW TIE OFF THE STRING
MOVE B,A ;GET LAST WORD USED IN B
LOAD A,FLTSD,(JFN) ;GET START OF STRING
CALL TRMBLK ;TRIM IT
JRST DEFAC4 ;GO STORE STRING IN JFN BLOCK
DEFAC2: CALL REDFLT ; Copy string to temp block
RETBAD
DEFAC4: NOINT ; PROTECT THE JSB
LOAD A,FLTSD,(JFN) ; THE STRING POINTER
SETZRO FLTSD,(JFN)
MOVEM A,FILACT(JFN)
OKINT
CALL CHKACT ; CHECK THAT THE ACCOUNT STRING MATCHES
RETBAD (GJFX44) ; IT DOESNT MATCH
TQO <ACTF>
RETSKP
; Default protection
; Call: JFN ETC.
; CALL DEFPRT
; Return
; +1 ; error
; +2 ; OK
; Sets the file protection to default specified by user or directory
; Clobbers a,b,c,d
DEFPRT: TQNE <NVERF,NNAMF>
RETSKP
CALL GLNPRT ; GET LOGICAL NAME DEFALUT PORTECTION
IFSKP. <
JRST DEFPR1> ; USE THIS VALUE
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
HRRZ A,E
TLNN E,777777 ; No default if short form
XCTU [SKIPN A,.GJPRO(A)] ; Get the default protection from user
RETSKP
DEFPR1: CAMG A,[6B2-1] ; Must be numeric
CAMGE A,[5B2]
IFSKP.
MOVEM A,FILPRT(JFN) ;NOT A STRING, SAVE IT AS IS
ELSE.
TLC A,-1
TLCE A,-1 ;LH =-1?
TLNN A,-1 ;OR LH=0
HRLI A,(POINT 7,) ;YES. USE DEFAULT
CALL REDFLT ; GET STRING
RETBAD ; ERROR
LOAD A,FLTSD,(JFN) ;GET STRING ADDRESS
TQO <OCTF> ; SAY LOOKING FOR OCTAL
CALL GETNUM ; TRY TO CONVERT TO NUMBER
RETBAD (GJFX14) ; ILLEGAL
MOVEM A,FILPRT(JFN) ;STASH IT AWAY
NOINT
LOAD B,FLTSD,(JFN) ;THE JSB SPACE
SETZRO FLTSD,(JFN)
MOVEI A,JSBFRE
CALL RELFRE ;FREE THE BLOCK
OKINT
ENDIF.
TQO <PRTF>
RETSKP
;ROUTINE TO COLLECT A NUMBER FOR DEFACT AND DEFPRT
GETNUM: SETZ B, ;THE ACCUMLATOR
MOVEI D,11 ;ASSUME DECIMAL
TQNE <OCTF> ;WANT OCTAL?
MOVEI D,7 ;YES
TQZ <OCTF> ;RESTORE THIS
HRLI A,(<POINT 7,0,35>) ;SET UP THE STRING POINTER
GETNM2: ILDB C,A ;GET NEXT
JUMPE C,GETNM1 ;DONE
CAIL C,"0" ;POSSIBLY A DIGIT?
CAILE C,"0"(D) ;""
RET ;NO
IMULI B,1(D) ;SCALE ACCUMULATOR
ADDI B,-"0"(C) ;ADD IN THE DIGIT
JRST GETNM2 ;AND GO GET THE NEXT
GETNM1: TLNE B,-1 ;WITHIN BOUNDS?
RET ;NO
MOVEI A,0(B) ;YES
TLO A,(5B2) ;MAKE IT A NUMBER
RETSKP ;RETURN WITH THE NUMBER
; Copy default string
; Call: A ; A default string pointer
; CALL REDFLT
; Returns
; +1 ; ERROR
; +2 ; In a, a lookup pointer
; Copies the default string into a block addressed by FLTSD (lh(filtmp(jfn)))
; Clobbers a,b,c,d
REDFLT: CALL GDFTMP ; GET A DEFAULT STRING POINTER IN C
RETBAD ()
MOVEI D,MAXLC
MOVEI B,0 ; Null byte if next instruction jumps
TQZ <DFSTF>
JUMPE A,REDFL2 ; No pointer
TLNE A,777777
JUMPGE A,REDFL7
CAML A,[-1B17]
HRLI A,440700
REDFL7: MOVE B,[XCTBU [ILDB B,A]] ;NEED TO GET IT MAPPED
REDFL0: SAVEAC <TMP> ;Save the temporary AC
STKVAR <BYTSAV,STTSAV>
MOVEM B,TMP ;Save instruction to get bytes
REDFL1: XCT TMP ;Get a byte
MOVEM B,BYTSAV ;SAVE THE BYTE
MOVEM C,STTSAV ;SAVE THE POINTER
CALL GTCODE ;SEE IF VALID CHAR
RET ;NO
MOVE C,B ;GET THE BYTE INTO AC3
MOVE B,BYTSAV ;GET BACK THE BYTE
CAIN C,WILDC ; WILD CHARACTER?
JRST REDQST ; YES. GO DO IT
CAIN C,$QUOT ; Character quote?
JRST REDFL3
CAIN C,$STAR ;STAR?
JRST REDFST
CAIL C,DIGITC
CAILE C,LOWERA
CAIN C,MINUSC ;LOWER CASE LETTER OR MINUS?
JRST REDFL4 ;YES
CAIN C,$DOT ; DOT?
JRST REDFL4 ; YES, DOT IS LEGAL IN DIR NAMES AND ACCOUNTS
CAILE C,LOWER ; A NON-ALPHA?
JRST [ SETZ B, ;YES, END OF STRING
AOS D ;ALLOW NULL TO BE STORED
JRST REDFL4] ; GO WRAP UP
CAIE D,MAXLC ; FIRST BYTE OF STRING?
TQNN <DFSTF> ; NO. ON A * FIELD?
JRST REDFL4 ; CANT BE WILD
MOVX C,DWLDF ; BECOMING WILD
IORM C,FLAGS(TXT) ; SAY SO
;..
;..
REDFL4: MOVE C,STTSAV ; RESTORE POINTER
CAIL B,"A"+40 ;LOWER CASE?
CAILE B,"Z"+40 ;MAYBE
IFSKP. <
TRZ B,40> ;YES. RAISE IT
REDFL2: SOSGE D ;ROOM FOR THIS ONE IN THE BUFFER?
RETBAD (GJFX5) ;NO. GIVE ERROR THEN
IDPB B,C
JUMPN B,REDFL1
REDFLE: LOAD A,FLTSD,(JFN)
MOVE B,C
CALL TRMBLK ; Trim the block and return excess
LOAD A,FLTSD,(JFN)
MOVN B,(A) ;GET NEG LENGTH OF BLOCK, I.E. -(NWDS+1)
HRLI A,2(B) ;SETUP -(NWORDS-1) IN LH
RETSKP
REDFL3: MOVE C,STTSAV ;RESTORE POINTER
XCT TMP ;Get next byte
JRST REDFL2
REDFST: MOVX C,DWLDF ; SEE IF IT IS BECOMING WILD
CAIE D,MAXLC ; IS IT?
IORM C,FLAGS(TXT) ; YES. SAY SO
STARB: TQNN <ASTAF> ; STARS ALLOWED?
TQNE <ASTF> ;* ALREADY SEEN?
IFSKP. <
RETBAD (GJFX31)> ; NO. GIVE APPROPRIATE ERROR
TQNE <OSTRF> ; OUTPUT STARS ?
TQO <ASTF> ; YES. SAY SO
TQO <DFSTF>
JRST REDFL4 ; AND GO INSERT IT
REDQST: MOVX C,DWLDF ; SAY SAW A WILD MASK
IORM C,FLAGS(TXT)
JRST STARB ; GO DO REST OF WILD LOGIC
GDFTMP: STKVAR <GDFTMT>
MOVEM A,GDFTMT ;SAVE AC A
LOAD A,FLTSD,(JFN)
IFN. A
HRRZ B,0(A) ;HAVE A STRING. SEE IF CORRECT LENGTH
CAIN B,MAXLW+1 ;HAS IT BEEN TRIMMED?
JRST GDFTM1 ;NO. USE IT THEN
MOVE B,A ;YES. MUST RELEASE IT
MOVEI A,JSBFRE ; BACK TO THE POOL
NOINT
SETZRO FLTSD,(JFN) ; NO STRING NOW
CALL RELFRE ;FREE IT UP
OKINT ;ALLOW INTS AGAIN
ENDIF.
MOVEI B,MAXLW+1
NOINT
CALL ASGJFR
RETBAD (GJFX22,<OKINT>) ; Insufficient space
STOR A,FLTSD,(JFN)
OKINT
GDFTM1: HRLI A,(<POINT 7,0>)
AOS C,A
MOVE A,GDFTMT ;GET BACK ORIGINAL A
RETSKP ;GIVE SKIP RETURN
;ROUTINE TO COPY A LOGICAL NAME DEFAULT INTO THE DEFAULT STRING
;CALL:
; MOVE T1,ADR OF STRING TO BE COPIED
; CALL LNMCPY
;RETURNS +1: ERROR
; +2: OK
LNMCPY::STKVAR <LNMCPS> ;GET A WORK CELL
MOVEM T1,LNMCPS ;SAVE POINTER TO STRING TO BE COPIED
CALL GDFTMP ;GET A DEFAULT STRING TO COPY INTO
RETBAD ()
MOVE T1,LNMCPS ;RESTORE POINTER TO DEFAULT STRING
MOVEI D,MAXLC ;COUNT OF BYTES
SETZ B, ;IN CASE
CAMN T1,[-2] ;IS THIS A NULL STRING
JRST REDFL2 ;GO HANDLE NULL STRING
HRLI T1,(POINT 7,0,35) ;SET UP A STRING POINTER TO STRING
MOVE B,[ILDB B,A] ;USE LOCAL BYTE OPERATION
JRST REDFL0 ;GO COPY IT
;ROUTINE TO CHECK THAT AN ACCOUNT STRING IS OK
CHKACT: TQNN <ASTF> ;PARSE ONLY?
TXNE F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF ;ANY STARS?
RETSKP ;YES, ACCOUNT STRING MUST BE OK
SKIPE FILACT(JFN) ;IS THERE AN ACCOUNT STRING?
TQNE <NEWF,NEWVF> ;YES, OLD FILE?
RETSKP ;NO, THEN OK
BLCAL. DSKOK,<<FILDEV(JFN)>> ;DISK?
RETSKP ;NOT A DISK, ALWAYS PROCEED
CALL GETFDB ;MAP IN THE FILE
RETBAD () ;FAILED
CALL COMACT ;SEE IF ACCOUNT STRING MATCHES
RETBAD (,<CALL USTDIR>) ;IT IS NOT A MATCH
CALL USTDIR ;MATCHED, UNLOCK THE DIR
RETSKP ;AND GIVE SUCCESSFUL RETURN
;ROUTINE TO COMPARE ACCOUNT STRINGS
;THIS ROUTINE ASSUMES DIR IS LOCKED
;ACCEPTS IN A/ ADR OF FDB OF FILE
; CALL COMACT
;RETURNS +1: NO MATCH
; +2: MATCHED, OR NO ACCOUNT STRING SPECIFIED IN JFN
COMACT: STKVAR <COMACP,<COMACS,3>>
SKIPN FILACT(JFN) ;WAS AN ACCOUNT STRING SPECIFIED?
RETSKP ;NO, THIS MATCHES ALL STRINGS
MOVE B,.FBACT(A) ;GET ACCOUNT STRING
CAMG B,[6B2-1] ;IS THIS A NUMBER?
CAMGE B,[5B2] ;...
JRST [ ADD B,DIRORA ;GET BASE ADR OF THE ACCOUNT STRING
ADDI B,.ACVAL ;POINT TO THE FIRST WORD OF THE STRING
JRST COMAC1]
TLZ B,700000 ;CLEAR THE 5B2 IN THE NUMBER
HRROI A,COMACS ;GET POINTER TO DESTINATION STRING
MOVEI C,12 ;DECIMAL
NOUT ;TRANSLATE NUMBER TO A STRING
RETBAD () ;FAILED
MOVEI B,COMACS ;GET ADR OF FIRST WORD OF STRING
COMAC1: MOVSI A,(<POINT 7,0(B)>) ;SET UP A POINTER TO THE STRING
MOVE C,FILACT(JFN) ;GET POINTER TO STRING IN JFN BLOCK
HRLI C,(POINT 7,0,34) ;..
MOVEM C,COMACP ;SAVE BYTE POINTER
COMAC2: ILDB D,A ;NOW COMPARE THE STRING
ILDB C,COMACP ;GET A CHARACTER FROM EACH STRING
CAME C,D ;MATCH?
RETBAD (GJFX44) ;NO, FAIL
SKIPN D ;END OF STRING?
JUMPE C,RSKP ;IF BOTH STRINGS ENDED, THEN MATCHED
SKIPE D ;IS D DONE AND C NOT DONE?
JUMPN C,COMAC2 ;NEITHER STRING DONE, CONTINUE LOOP
RETBAD (GJFX44) ;NO MATCH
; Recognize current field
; Called from gtjfn loop
; Decides which field was being input, and then attempts to recognize it
RECFLF: MOVX C,SAWF ;ENTRY FOR CNTRL-F TYPED
IORM C,FLAGS(TXT) ;REMEMBER WE SAW A RECOG CHARACTER
RECFLD: CALL BACKIT ;ZAP THE RECOGNITION CHARACTER
MOVE C,FILCNT(JFN) ;WAS ANYTHING TYPED?
CAMN C,CNTWRD(TXT)
JRST RECFL2 ;NO, THEN RECOGNITION CAN OCCUR
TXNE F1,DIRSF!NAMSF!EXTSF!VERSF!STARF
JRST DING ; Cannot recognize after *
RECFL2: TQNE <DIRFF> ; Find which field is being input
JRST RECDIR ; Directory name is
TQNE <EXTFF>
JRST RECEX0 ; Extension is
TQNN <NAMF>
JRST RECNA0 ; Recognize name
MOVE C,FILCNT(JFN)
CAME C,CNTWRD(TXT) ; SOMETHING TYPED, TREAT LIKE CONT-F
JRST RECFL1 ; Some thing typed, treat like cont-f
MOVE C,FLAGS(TXT) ; SEE IF GETTING AN ATTRIBUTE
TXNN C,ARBATF ; IF YES, THEN DING
TQNE <VERF>
JRST DING ; Can recognize no more
JRST DEFVER ; Default version
RECFL0: TQNE <DIRFF>
JRST RECDIR
TQNE <EXTFF>
JRST RECEXT
TQNN <NAMF>
JRST RECNA0
MOVE C,FLAGS(TXT) ;SEE IF PARSING A PREFIX
TXNE C,PREFXF ;...
JRST RECPRE ;YES, GO RECOGNIZE IT
MOVE D,FILCNT(JFN) ;SEE IF NOTHING TYPED YET
CAMN D,CNTWRD(TXT) ;...
TXNN C,ARBATF ;NOTHING TYPED YET, DOING AN ATTRIBUTE?
JRST ENDEXT ;NO, CAN GO FINISH DEFAULTING EVERYTHING
TQNN <NREC> ;RECOGNIZING?
JRST DING ;YES, CANNOT RECOGNIZE A NULL ATTRIBUTE
RETBAD (GJFX46) ;NULL ATTRIBUTE IS NOT ALLOWED
RECFL1: MOVE C,FLAGS(TXT) ;CHECK FOR AN ATTRIBUTE PREFIX
TXNE C,PREFXF ;...
JRST RECPRF ;GO RECOGNIZE PREFIX
CALLRET ENDEXT ;NO, GO FINISH THIS FIELD
; Recognize directory name
; Call: RH(FILTMP(JFN)) ; Pointer to string block to recognize
; FILOPT(JFN) ; Pointer to last character in string
; Flags norec, devf, dirf,dirff,dirtf are updated or used
; CALL RECDIR
; Return
; +1 ; A=0 MEANS Ambiguous
; +2 ; Ok
; Clobbers most everything
RECDIR: TQNE <DEVF>
JRST RECDI1 ;HAVE A DEV ALREADY
CALL DEFDEV ; Default device first
JUMPN A,R ; IF ERROR, RETURN IMMEDIATELY
RECDI1: CALL ENDSTX ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing out tail
BLCAL. MDDOK,<<FILDEV(JFN)>> ;A MULTIPLE DIR DEVICE?
JRST RECDI3 ; No. Do not update FILOPT for JFN
LOAD B,FLUC,(JFN) ; GET STRUCTURE NUMBER
MOVE C,FILOPT(JFN) ; COPY POINTER TO TAIL
CALL DIRLUK ; Lookup directory name get number
JRST [ JUMPL A,RECDI2 ; AMBIGUOUS
TQNE <ASTF> ; PARSE ONLY?
JRST RECDI3 ; Yes. Do not update FILOPT for JFN
POP P,FILOPT(JFN)
MOVEI A,GJFX17 ; NO SUCH DIRECTORY, STEP LOGICAL NAME
JRST STEPLN]
HRRM A,FILDDN(JFN) ; Store directory number
MOVEM B,FILOPT(JFN) ;SAVE UPDATED POINTER
CALL ENDTMP ;TIE OFF THE DIR NAME STRING
STOR A,FLDIR,(JFN) ;STORE IT IN THE JFN BLOCK
OKINT ;UNLOCK FROM ENDTMP
POP P,B
TQNE <NREC> ;WANT RECOGNITION?
IFSKP.
CALL TSTRQ ;YES. TYPE OUT REST OF NAME
CALL BRKOUT ;OUTPUT THE PUNCTUAUTION
ENDIF.
TQO <DIRF,DIRTF>
TQZ <DIRFF>
CALLRET SETTMP ; Reset temp block and return
; HERE ON AMBIGUOUS RETURN FROM DIRLUK
RECDI2: MOVEM B,FILOPT(JFN) ;STORE UPDATED POINTER
RECDI3: POP P,B ;Get back pointer to untyped text
TQNE <NREC> ;DOING RECOGNITION?
JRST [ MOVEI A,GJFX17 ;NO, THEN NO DIRECTORY WAS FOUND
JRST STEPLN] ;GO SEE IF WE CAN STEP
CALL TSTRQ ;OUTPUT THE RECOGNIZED PORTION
CALLRET DING ;DING THE USER
;ROUTINE TO OUTPUT TERMINATING PUNCTUATION AFTER DIRECTORY
;RECOGNITION
BRKOUT: MOVEI B,">" ;DEFAULT PUNCTUAUTION
MOVX C,SWBRKT ;SAW "[" BIT
TDNE C,FLAGS(TXT) ;NEED TO OUTPUT A "]"
MOVEI B,"]" ;YES. SO DO IT
CALL OUTCH ;GO DO IT
RET ;AND DONE
; Recognize extension
; This routine operates in the same way as recdir described above
RECEXT: CALL RECEXX
JRST [ JN AMBGF,,DING ;IF AMBIGUOUS...
JUMPN A,R ;IF ERROR, RETURN NOW
MOVEI A,GJFX19 ;IF NO ERROR, STEP LOGICAL NAME
JRST STEPLN]
RETSKP
RECEXX: CALL ENDSTX ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing out tail
CALL EXTLUK ; Lookup extension
IFNSK. ;[7.1014] Extension lookup failed
POP P,FILOPT(JFN) ;[7.1014] Get FILOPT back
IFQN. AMBGF ;[7.1014] If ambiguous, recognize what we can
MOVE B,FILOPT(JFN) ;[7.1014] Our work string
CALL TSTRQ ;[7.1014] (B/) Do the work
RET ;[7.1014] Pass error back
ENDIF. ;[7.1014]
TQNE <OLDNF> ;[7.1014] If old file desired,
JRST RFALSE ;[7.1014] Go step logical name
RET ;[7.1014] Else return
ENDIF. ;[7.1014]
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp string get pointer
HRRM A,FILNEN(JFN) ; Store as extension
OKINT
TQO <EXTF,EXTTF>
TQZ <EXTFF>
POP P,B
TQNN <NNAMF>
TQNE <NREC> ; Were we performing recognition?
JRST RECXX1 ; No. done
CALL TSTRQC ;(B) Yes, output tail
RETBAD() ;Error - invalid field length
TQNE <NVERF>
JRST RECXX1
CALL TSTLNG ;ALLOWING LONG NAMES?
JRST RECXX1 ;NO
CHOUT <PNCVER> ;AND THE PUNCTUATION
TQO <NUMFF> ; And act like the user did it
MOVX A,VERFF ; SAW VERSION . FLAG
IORM A,FLAGS(TXT) ; SAY SO
RECXX1: CALL SETTMP ; Reset temp block and return
RETBAD
RETSKP
RECEX0: MOVE C,FILCNT(JFN)
CAME C,CNTWRD(TXT)
JRST RECEX1 ;HAVE PARTIAL STRING, GO RECOGNIZE
CALL DEFEXT ;TRY FOR DEFAULT VALUE FIRST
IFSKP. <
RETSKP>
JUMPN A,R ;IF ERRORS, RETURN
CALL GETDEX ;SEE IF THERE IS A DEFAULT EXT
JRST [ JUMPN A,R ;IF ERROR, RETURN
JRST RECEX1] ;IF NO DEFAULT, GO TRY TO RECOGNIZE
MOVEI A,GJFX19 ;SEE IF LN CAN BE STEPPED
CALL STEPLN
JUMPL A,R ;IF STEPPED, RETURN
RETBAD ;COULD NOT, RETURN ERROR CODE
RECEX1: TQNE <ASTF> ;OUTPUT STARS?
JRST DING ;YES. ALWAYS AMBIGUOUS THEN
CALL RECEXX ;TRY TO RECOGNIZE
JRST [ JN AMBGF,,DING ;IF AMBIGUOUS
JUMPN A,R ;IF ERROR, RETURN NOW
MOVEI A,GJFX19 ;EXTENSION NOT FOUND
RET]
RETSKP
; Recognize name
; This routine operates in the same way as recdir and recext above
RECNA0: TQNE <DEVF> ;SEEN A DEVICE YET?
IFSKP.
CALL DEFDEV ;NO, GO GET DEFAULTED DEVICE
IFSKP. <
RETSKP> ;DEVICE NAME WAS RECOGNIZED, STOP HERE
JUMPN A,[RETBAD ()] ;IF ERROR, EXIT
ENDIF.
TQNE <DIRF> ;SEEN A DIRECTORY YET?
IFSKP.
CALL DEFDIR ;NO, GO DEFAULT ONE
IFSKP. <
RETSKP> ;DIR WAS RECOGNIZED, STOP HERE
JUMPN A,[RETBAD ()] ;OTHERWISE EXIT
ENDIF.
SETZ A, ;NO ERROR CONDITION
MOVE C,FILCNT(JFN) ;GET CHARACTERS FOUND
CAMN C,CNTWRD(TXT) ;FOUND ANY?
SKIPA ;ONLY DO DEFAULT
CALL RECNA1 ;HAVE DEV AND DIR, NOW TRY FOR NAME
IFNSK.
JUMPN A,R ;IF ERROR EXIT
MOVE C,FILCNT(JFN)
CAMN C,CNTWRD(TXT)
CALL DEFNAM
IFNSK.
JUMPE A,DING ;IF NO ERRORS, RING THE BELL
RETBAD ()
ENDIF.
ENDIF.
TQNN <NREC> ;DOING RECOGNITION?
TQNE <NNAMF>
RETSKP ;NO, DONT TYPE OUT "."
CHOUT "."
TQO <EXTFF>
RETSKP
RECNAM: CALL RECNA1
IFSKP. <
RETSKP>
JUMPE A,DING ;GO RING BELL IF NO ERROR
RETBAD ()
RECNA1: TQNE <DIRF>
JRST RECNA2 ;ALREADY HAVE A DIR
CALL DEFDIR ; Default directory
JUMPN A,R ; IF ERROR, RETURN
RECNA2: CALL ENDSTX ; Terminate string, get lookup pointer
PUSH P,FILOPT(JFN) ; Save filopt(jfn) for typing tail
CALL NAMLUK ; Lookup name in directory
IFNSK. ;[7.1014] Name lookup failed
POP P,FILOPT(JFN) ;[7.1014] Get FILOPT back
IFQN. AMBGF ;[7.1014] If ambiguous,
MOVE B,FILOPT(JFN) ;[7.1014] Get working string
CALL TSTRQ ;[7.1014] (B/) Recognize all that we can
JRST RFALSE ;[7.1014] The return ambiguous
ENDIF. ;[7.1014]
TQNN <OLDNF> ;[7.1014] New files allowed?
TQNE <NREC> ;[7.1014] And trying to recognize?
JRST STEPLN ;[7.1014] Yes, go step logical name
JRST RFALSE ;[7.1014] No, return ambiguous
ENDIF.
MOVEM A,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
CALL ENDTMP ; Truncate temp block, and get pointer
HRLM A,FILNEN(JFN) ; To put in file name
OKINT
TQO <NAMF,NAMTF>
POP P,B
TQNN <NNAMF>
TQNE <NREC>
IFSKP.
CALL TSTRQC ;(B) Type remainder
RETBAD() ;Error - invalid field length
ENDIF.
CALLRET SETTMP
;ROUTINE TO RECOGNIZE THE PREFIX PORTION OF AN ATTRIBUTE FIELD
RECPRE: CALL RECPR0 ;GO TRY TO RECOGNIZE
JRST RECPRA ;AMBIGUOUS
MOVE A,PREFIX(TXT) ;GET PREFIX VALUE
TXNE A,NOATRF ;DOES THIS HAVE AN ARGUMENT?
JRST [ CALL ENDARB ;GO CLOSE OUT THIS ATTRIBUTE
RETBAD
JRST ENDEXT] ;GO RECOGNIZE THE OTHER FIELDS
TQNN <NREC> ;RECOGNIZING?
JRST DING ;YES, CAN GO NO FURTHER
RETBAD (GJFX46) ;NO, ATTRIBUTE VALUE REQUIRED
RECPRF: CALL RECPR0 ;GO TRY TO RECOGNIZE
JRST RECPRA ;FAILED OR AMBIGUOUS
MOVE A,PREFIX(TXT) ;SEE IF THIS HAS AN ATTRIBUTE VALUE
TXNN A,NOATRF ;...
RETSKP ;IT DOES, GO WAIT FOR ONE
CALLRET ENDARB ;IT DOESNT, CLOSE THIS PREFIX OUT
RECPRA: JUMPN A,R ;IF NON-ZERO, THEN ERROR CODE
TQNN <NREC> ;RECOGNIZING?
JRST DING ;YES, GIVE AMBIGUOUS RETURN
RETBAD (GJFX40) ;NO, UNKNOWN ATTRIBUTE
RECPR0: CALL ENDSTX ;TIE OFF THE PREFIX STRING
HRLI A,(POINT 7,0,35) ;GET POINTER TO THE FIRST CHAR
MOVE B,A ;SET UP FOR LOOKUP OF PREFIX
MOVEI A,PRFXTB ;GET POINTER TO PREFIX TABLE
TBLUK ;LOOKUP THE PREFIX
ERJMPR [RETBAD ()] ;ERR CODE TO A AND RETURN FAIL
TXNN B,TL%ABR!TL%EXM ;FOUND A PREFIX?
JRST [ TXNE B,TL%AMB ;NO, AMBIGUOUS?
JRST RFALSE ;YES, GO DING
RETBAD (GJFX40)] ;NO, UNKNOWN ATTRIBUTE
HRRZ A,0(A) ;GET THE PREFIX VALUE
MOVEM A,PREFIX(TXT) ;SAVE IT AWAY
EXCH B,C ;GET POINTER TO REMAINDER OF PREFIX
TQNE <NREC> ;DOING RECOGNITION?
JRST RECPR1 ;NO, DONT OUTPUT THE REMAINDER OF STRING
TXNN C,TL%EXM ;EXACT MATCH?
CALL TSTRQ ;NO, TYPE OUT THE REMAINDER OF PREFIX
MOVEI B,PNCPFX ;FOLLOWED BY THE SEPERATOR
MOVE A,PREFIX(TXT) ;GET PREFIX VALUE
TXNN A,NOATRF ;ANY ATTRIBUTE VALUE?
CALL OUTCH ;YES, TYPE OUT THE PUNCTUATION
RECPR1: LOAD A,PFXVAL ;GET PREFIX VALUE
CALL CHKATR ;SEE IF ALREADY ON THE CHAIN
RETBAD (GJFX45) ;YES, ERROR
MOVX A,PREFXF ;CLEAR PREFIX FLAG
ANDCAM A,FLAGS(TXT)
MOVX A,ARBATF ;AND SET ATTRIBUTE FLAG
IORM A,FLAGS(TXT)
CALLRET SETTMP ;GO SET UP TO GET DATA FIELD
RETYPE: TMSG </
/>
SETZ C, ;A NULL
MOVE B,CURPNT(TXT) ; CURRENT TAIL POINTER
IDPB C,B ; TIE IT OFF
MOVE A,ARGCR(TXT) ;START OF IT ALL
PSOUT ; PRINT IT OUT
CALL SFCC0 ; BACK TO GTJFN STANDARDS
RET ;AND DONE
TYSTR1: SKIPN B ; NEED TO DO A STAR?
TYSTR: MOVEI B,[ASCIZ /*/]-1 ; YES
CALL TSTRB ; GO TYPE OUT WHAT IS IN B
RET
; Terminator seen, finish up
ENDCNF: TQOA <TCONF> ;SAW CONFIRMING TERMINATOR
ENDALL: TQZ <TCONF> ;SAW NON-CONFIRMING TERMINATOR
TQO <NREC> ; Suppress recognition
JRST ENDALZ
RECALL: CALL BACKIT ;ZAP THE RECOGNITION CHARACTER
MOVX A,SAWALT ;SAY SAW AN ALTODE
IORM A,FLAGS(TXT) ;REMEMBER THIS IN FLAG WORD
TQZ <TCONF> ;NO CONFIRMATION SO FAR
TQZ <NREC> ;INSURE WE WILL DO RECOGNITION
ENDALZ: HRRZ A,FILDEV(JFN) ;Disallow use of device NFT: -
CAIN A,NFTDTB ; using device NFT AND
TQNE NODEF ; no node in file spec ?
IFSKP.
TQNE <ASTF> ;yes. parse only ?
IFSKP.
MOVEI T1,GJFX16 ;no. force failure. (NO SUCH DEVICE)
JRST ERRDO
ENDIF.
SETZM FILDEV(JFN) ;yes. clear device field in JFN block
ENDIF.
TQNN <STARF>
IFSKP.
CALL [ TQNE <DIRFF> ;COLLECTING DIRECTORY?
IFSKP.
TQNN <NAMF>
CALLRET ENDNA3
CALLRET ENDEX8
ELSE.
CALL ENDDIR ;YES. GO FINISH IT UP
RET ;FAILED
TQNN <NREC> ;DOING RECOGNITION?
CALL BRKOUT ;YES. OUTPUT TERMINATOR
RETSKP ;DONE
ENDIF.]
JRST [ JUMPL A,GTJFST ; IF <0, LN WAS STEPPED
JRST ERRDO] ; ELSE, NO STEP
ENDIF.
;..
;..
MOVE C,FILCNT(JFN)
TQNN <DIRFF> ;COLLECTING A DIRECTORY?
CAME C,CNTWRD(TXT) ; Is input string NON-null?
IFNSK.
TQNN <NREC> ;YES. DOING RECOGNITION?
TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF ;YES. SEEN A STAR?
IFSKP.
TQNE <EXTF> ;YES, GOT EXTENTION FIELD YET?
IFSKP.
CALL DING ;NO, RETURN AMBIGUOUS
MOVEI A,0
JRST GTJF2
ENDIF.
ENDIF.
CALL RECFL0
IFNSK.
JUMPE A,GTJF2 ; AMBIGUOUS
JUMPG A,ERRDO ; ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES, CONTINUE
JRST GTJFST ; RETRY - LOGICAL NAME WAS STEPPED
ENDIF.
ENDIF.
;..
;..
MOVE C,FLAGS(TXT) ;SEE IF GETTING AN ATTRIBUTE
TXNN C,ARBATF ;...
IFSKP.
MOVEI A,GJFX46 ;YES
TQNE <NREC> ;RECOGNIZING?
JRST ERRDO ;NO, THEN GIVE AN ERROR RETURN
CALL DING ;YES, RING THE BELL
JRST GTJF2 ;AND GO BACK FOR THE ATTRIBUTE VALUE
ENDIF.
TQNE <NAMF,NNAMF> ; Do we have a name?
IFSKP.
CALL DEFNAM ; No, try the default name
IFNSK.
JUMPL A,GTJFST ; LN WAS STEPPED, GO RETRY
JUMPG A,ERRDO ; ERROR OCCURED
CALL RECNAM ; NO DEFAULT, SEE IF A NO-NAME DEVICE
IFNSK.
JUMPE A,GTJF2 ; GO GET MORE FROM USER
JUMPG A,ERRDO ; ERROR
TQNE <ASTF> ; PARSE ONLY?
JRST ENDAL4 ; YES - DON'T RETRY STEPPED LOGICAL NAME
JRST GTJFST ; RETRY - LOGICAL NAME WAS STEPPED
ENDIF.
ENDIF.
ENDIF.
TQNE <EXTF,NNAMF> ; After all that, do we have ext?
JRST ENDAL4 ; Yes
MOVE C,FILCNT(JFN) ; IS THERE A PARTIAL STRING?
TQNN <EXTFF> ; SAW A DOT YET?
CAME C,CNTWRD(TXT) ; HAVE A PARTIAL STRING?
JRST ENDAL6 ; YES, GO USE IT
CALL DEFEXT ; NO, Attempt to default extension
JRST [ JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JUMPG A,ERRDO ;AN ERROR WAS ENCOUNTERED
JRST ENDAL6] ;OTHERWISE GO DEFAULT EXT
;..
;..
ENDAL4: TQNE <NNAMF> ; NO NAME DEVICE?
JRST ENDAL7 ; YES
TQNE <VERF> ; Do we have a version?
IFSKP.
CALL DEFVER ; No, default it
IFNSK.
JUMPGE A,ERRDO ;ERROR
CALL STOALT ;LN WAS STEPPED, PUT ALTMODE BACK IF NEEDED
JRST ERRDO ;ERROR ENCOUNTERED
JRST GTJFST ;GO REPROCESS THE COMMAND
ENDIF.
ENDIF.
TQNE <NEWF,NEWVF>
IFSKP.
TQNN <ASTF> ; Parse-only?
JRST ENDAL7 ; No, continue
ENDIF.
TQNE <PRTF> ; Do we have protection?
IFSKP.
CALL DEFPRT ; No, default it
JRST ERRDO
ENDIF.
TQNE <ACTF> ; Do we have an account?
IFSKP.
CALL DEFACT ; No, default it
JRST ERRDO
ENDIF.
ENDAL7: CALL DEFATR ;GET SET UP ANY DESIRED ATTRIBUTES
JRST ERRDO ;FAILED
ENDL77: TQNN <TCONF> ;ALREADY CONFIRMED?
TQNN <PONFF> ;OR NO PRINT REQUESTED?
JRST ENDAL3 ;YES, DON'T PRINT O.F., N.F., ETC.
TQNN <ASTF> ;NOT PARSE ONLY?
TQNE <NREC> ;RECOGNITION?
JRST ENDAL3 ;NO, NO MESSAGE
HRROI B,[ASCIZ / !Old file!/]
TQNN <NVERF>
HRROI B,[ASCIZ / !Old generation!/]
TQNE <NEWVF> ; Did we generate a new version?
HRROI B,[ASCIZ / !New generation!/]
TQNE <NEWF> ; Did we generate a new file
HRROI B,[ASCIZ / !New file!/]
TQNN <NNAMF>
JRST ENDAL9
HRROI B,[ASCIZ / !OK!/]
TQNE <CFRMF>
HRROI B,[ASCIZ / !Confirm!/]
;..
;..
ENDAL9: TXNN F1,DIRSF!NAMSF!EXTSF!VERSF
CALL [ TQNN <JFNRD> ;HAVE AN EXTENDED BLOCK?
CALLRET TSTR1 ;NO. PRINT BUT DON'T PUT IN BUFFER
HRRZ A,E
UMOVE A,11(A) ;YES. GET FLAGS
TQNN <CFRMF> ;WANT CONFIRMATION?
TXNN A,G1%RCM ;NO. WANT THE MESSAGE?
CALLRET TSTR1 ;DON'T PUT IN BUFFER
CALLRET TSTR] ;PUT IT IN THE BUFFER
ENDAL3: CALL INFTST ;SEE IF WE HAVE A FILE
JRST ENDAL2 ;NO. GIVE THIS UP
TQNN <TCONF> ;CONFIRMATION ALREADY GIVEN?
TQNN <CFRMF>
JRST ENDAL2 ; Or no confirmation requested
ENDL33: BIN ; Else read confirmation character
IDIVI B,^D36/CCSIZE
LDB B,CPTAB(C) ; Get character class
CAIN B,CARRET ; IGNORE?
JRST ENDL33 ;YES. GO GET ANOTHER
CAIN B,CONTR
JRST [ CALL RETYPE ; DO LOGICAL TYPE OUT
JRST ENDL77] ; GO DO CONFIRM AGAIN
CAIE B,SPACE ;SPACE
CAIN B,ALTMOD ;OR ESC?
JRST [ CALL DING ;DON'T CONFIRM, BUT DON'T ABORT EITHER
JRST ENDAL3] ;TRY AGAIN
CAIE B,COMMA ;CONFIRMATION CHARACTER?
CAIN B,TERMS ;IN EITHER CLASS
JRST ENDAL2 ; Is ok
CAIE B,CONTU
CAIN B,EDTCHR ; CHARACTER EDITING BYTE?
IFSKP. <
ERRLJF GJFX15> ; Improper confirmation
BKJFN ; BACK UP THE INPUT
JFCL
CALL CLRJFN ;CLEAR OUT THE INPUT
CALL SETTMP ;GET SOME WORK SPACE
JRST ERRDO
TXNN F1,DIRSF!NAMSF!EXTSF!VERSF
TQNN <PONFF> ;PRINT REQUESTED?
JRST MRTEXT ;NO. GO ON
CALL RETYPE ;RETYPE EDITED FILESPEC
JRST MRTEXT ;AND GO GET SOME MORE INPUT
ENDAL2: TQNE <NEWVF,NEWF> ;NEW FILE OR NEW VERSION?
SKIPN FILFDB(JFN) ;SET ACCOUNTING, ETC. IF FDB WAS CREATED
JRST ENDALS ;NO, DON'T INSERT PROTECTION, ETC. INTO DIRECTORY
PUSH P,E ; SAVE E
HRRZ E,DEV
TQNE <PRTF> ; Do we have a protection?
CALL @PLUKD(E) ; Insert it into the directory
TQNE <ACTF> ; Do we have an account string?
IFSKP.
NOINT ;AVOID INTERRUPTS WHILE FILACT IS FUDGED
MOVEI B,ACCTSR-1 ;POINT TO ACCOUNT STRING
MOVN A,ACCTSL
HRLI B,2(A) ;LOOKUP POINTER TO ACCOUNT
CALL @ALUKD(E)
JRST [POP P,E ;ERROR
JRST ERRDO]
SETZM FILACT(JFN)
OKINT
JRST ENDALT
ENDIF.
MOVE B,FILACT(JFN)
HRRZ A,0(B) ;BLOCK LENGTH
SUBI A,2
MOVNS A
HRL B,A ;LOOKUP POINTER TO ACCOUNT
CALL @ALUKD(E) ; Yes, insert it into the directory
JRST [ POP P,E ;ERROR, RESTORE E
JRST ERRDO]
ENDALT: MOVX B,FB%TMP
TQNE <TMPTF,TMPFF> ; Is this file to be temp?
CALL @SLUKD(E)
HRRZ A,E ;SEE IF REAL DISK
POP P,E ;RESTORE E
BLCAL. DSKOK,<A> ;REAL DISK?
IFSKP. <
CALL FDBINU> ;YES - INIT NAME STRINGS IN FDB
;..
;..
ENDALS: CALL STRUSR ;RETURN FILE NAME TO THE USER
NOINT
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL RELLNS ;RELEASE LOGICAL NAME CHAIN
MOVEI A,JSBFRE
TQNE <ASTF> ; SCAN ONLY?
JRST ENDLS1 ; YES. DON'T RELEASE ACCOUNT AND PROT STRINGS
SETZM FILPRT(JFN) ; AND PROTECTION WORD
ENDLS1: HRRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE ; And temp
LOAD B,FLTSD,(JFN)
SKIPE B
CALL RELFRE
HLRZ B,FILLNM(JFN) ;RDTXT BUFFER
SKIPE B ;ONE AROUND?
CALL RELFRE ;YES. ZAP IT.
HRRZS FILLNM(JFN) ;CLEAR OUT POINTER TO RDTXT BUFFER
SETZM FILTMP(JFN)
SETZM FILOPT(JFN)
SETZM FILCNT(JFN)
AND STS,[XWD 100,0] ; Retain astf
IOR STS,FILSTS(JFN) ; Get rest of sts
TQZ <ASGF,FILINP,FILOUP>; CLEAR ASSIGN AND I/O FLAGS
TQO <NAMEF> ; Set name attached flag
TQNE <NACCF>
TQO <FRKF>
MOVEM STS,FILSTS(JFN)
SETZRO ASGF2,(JFN) ;[7384]CLEAR ASGF SHADOW BIT
OKINT
CALL ENDINF ;RESTORE INPUT FILES
MOVE A,JFN ; GET JFN
IDIVI A,MLJFN ; CONVERT BACK TO USER INDEX
MOVE JFN,A ; PUT IT BACK IN JFN
TXNN F,ASTAF+OSTRF+RLHFF ;RETURN LH FLAGS?
JRST ENDA51 ;NO
TQNE <PRTTF> ;IF ;P SPECIFIED,
TQO <FXPRT> ;SAY SO
TQNE <ACTTF>
TQO <FXACT>
TQNE <TMPTF,TMPFF>
TQO <FXTMP>
HLL JFN,F1 ;GET FLAGS TO RETURN
TXZ JFN,STEPF+STARF+DFSTF+TCONF+EXTXF+IGIVF ;CLEAR FLAGS NOT RETURNED
TQNN <IGDLF>
TXO JFN,GJ%GND ; Not seeing deleted files
TQNN <IGIVF>
TXO JFN,GJ%GIV ; Not seeing invisible files
TQNE NODEF
TXO JFN,GJ%NOD ; Saw a node name in file spec
;..
;..
ENDA51: TQNN <OSTRF> ;Real file
TQNN <NODEF> ; AND saw node name ?
IFSKP.
CALL DIMLNK ;yes. establish link to remote FAL
JRST ERRDO ;failure.
ENDIF.
UMOVEM JFN,1 ; Return jfn to user
TQNN <ASTF> ; REAL JFN?
TXNN JFN,STRSF!NAMSF!EXTSF!DIRSF!VERSF ;DOING ANY STARS?
SMRETN ; NO. RETURN NOW
HRRZS JFN ; GET ONLY JFN PART
CALL CHKJFN ; LOCK UP THE JFN
RETERR () ; SOMETHING BAD HAPPENED
SMRETN ; TTY AND STRING ALWAYS OK
SMRETN ; ""
BLCAL. DSKOK,<NUM> ;SEE IF REAL FDB PRESENT, i.e. real disk
JRST ENDL58 ;ISN'T
CALL GETFDB ; FIND FDB FOR THE FILE
JRST ENDL56 ; NOT THERE. STEP IT THEN
PUSH P,A ; SAVE THE FDB ADDRESS
MOVX B,FC%DIR ; CHECK FOR LIST ACCESS
CALL ACCCHK ; DO IT
JRST ENDL57 ; NOT ACCESSIBLE. GO STEP IT
MOVE A,0(P) ; GET BACK THE FDB ADDRESS
CALL COMACT ; COMPARE THE ACCOUNT STRING
JRST ENDL57 ; DID NOT MATCH, GO STEP TO NEXT FILE
POP P,A ; CLEAN UP STACK
CALL USTDIR ; FREE UP DIR
ENDL58: CALL UNLCKF ; AND THE FILE
SMRETN ; RETURN GOOD
ENDL57: POP P,A ; CLEAN UP THE STACK
CALL USTDIR ; FREE UP DIR
ENDL56: CALL UNLCKF ; AND THE FILE
UMOVE A,A ; GET BACK JFN AND FLAGS
GNJFN ; STEP TO FIRST GOOD ONE
RETERR (GJFX32) ; NO MATCH
SMRETN ; FOUND IT
;HERE IF HAVE NO DEFAULT EXTENSION
ENDAL6: TQNE <NREC> ; NOT DOING RECOGNITION?
TQNN <EXTFF> ; AND SPECIFIED NULL EXTENSION?
IFSKP. <
JRST ENDL6A> ; YES. LET HIM GET NULL EXTENSION THEN
MOVEI B,"."
TQNN <NNAMF>
TQNE <NREC>
JRST ENDL6B
TQON <EXTFF> ;EXTENSION STARTED YET?
CALL OUTCH ;NO, TYPE OUT A DOT
ENDL6B: CALL DEFEXT ;FIRST SEE IF DEFAULT EXISTS
IFSKP. <
JRST ENDAL4> ;YES. USE IT
JUMPN A,ERRDO ;IF BAD NEWS, BOMB OUT
CALL GETDEX ;GO SEE IF THERE IS A DEFAULT EXTENSION
JRST ENDL6C ;NONE SPECIFIED
MOVEI A,GJFX19 ;SET UP ERROR CODE
CALL STEPLN ;STEP TO NEXT LN
JUMPGE A,ERRDO ;FAILURE OR NO MORE LOGICAL NAMES
CALL STOALT ;GO PUT ALTMODE BACK IN BUFFER
JRST ERRDO ;ERROR OCCURED
JRST GTJFST ;GO START OVER AGAIN
ENDL6A: CALL RECEXX ;SEE IF AN EXT CAN BE RECOGNIZED
IFSKP. <
JRST ENDAL4>
IFQN. AMBGF ;NO, FAILURE OR AMBIGUOUS
CALL DING ;AMBIGUOUS, DING AND TRY FOR MORE
JRST GTJF2
ENDIF.
JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JUMPG A,ERRDO ;AN ERROR WAS ENCOUNTERED
MOVEI A,GJFX19 ;SET UP ERROR CODE
CALL STEPLN ;STEP THE LOGICAL NAME IF ANY
JUMPL A,GTJFST ;LOGICAL NAME WAS STEPPED
JRST ERRDO ;LOGICAL NAME NOT STEPPED, BOMB OUT
ENDL6C: JUMPN A,ERRDO ;IF ERROR, GO BOMB OUT
TXNN F1,DIRSF!NAMSF ;THIS FOLLOWING A STAR?
JRST ENDL6A ;OTHERWISE GO RECOGNIZE
TQNE <NREC> ;DOING RECOGNITION?
ERRLJF (GJFX19) ;NO. GO COMPLAIN ABOUT THIS CASE THEN
CALL DING ;YES. REFUSE TO DO ANY MORE
JRST GTJF2 ;AND PROCEED IN-LINE
; Star typed
STAR: CALL DPST ; SAVE BYTE
RETBAD() ; CANT DO IT
MOVE A,FILCNT(JFN) ;[7.1014] Allow *'s so *? can give directory listing
MOVE B,CNTWRD(TXT) ;GET MAX VALUE
CAIN A,-1(B) ; HAVE SOMETHING ALREADY?
TQNE <STARF> ; ALREADY SEENA STAR?
IFNSK.
MOVX A,WLDF ; YES. IT IS WILD THEN
IORM A,FLAGS(TXT) ;REMEMBER THIS
TQNE <NUMFF> ;COLLECTING A NUMBER?
RETBAD (GJFX4) ;YES. GIVE AN ERROR THEN
ENDIF.
STAR2: TQNE <OSTRF>
TQO <ASTF> ; Set * bit in sts
TQO <STARF>
RETSKP
PCENT: TQNE <NUMFF> ;[7.1014] FOR WILD CHARS. ON A NUMBER?
RETBAD (GJFX4) ; YES. ILLEGAL CHARACTER THEN
CALL DPST ; SAVE BYTE
RETBAD() ; NO ROOM
MOVX A,WLDF ; FOR FLAGS
IORM A,FLAGS(TXT) ;REMEMBER WILD CHAR SEEN
CALLRET STAR2 ; GO DO THE * STUFF
;[7.1014]
; The following routines handle user question mark input. This is entered
; from the input char dispatch table. If the input is NIL, this will return
; immediately. Otherwise, list the candidates for the field currently being
; entered if no previous field had a wild card. If no candidates are found,
; break with GJFX34. Scan for candidates is terminated on last one.
;
;QUEST - Routine dispatched to when "?" is seen.
;
; Called with:
; TEXTI% context setup
; CALL through dispatch table when "?" is seen
;
; Returns:
; +1 - Always
QUEST: MOVE A,CURCNT(TXT) ;Get current string
AOS A ;Move one past (should be a null)
CAML A,STRCNT(TXT) ;Was "?" first thing typed?
ERRLJF GJFX34 ;Yes, then break on it
TQNE <OSTRF> ;GJ%OFG, parse only?
TQNE <ASTAF> ;GJ%IFG, normal indexable bit?
SKIPA ;No to either
ERRLJF GJFX34 ;GJ%OFG and not GJ%IFG, this prevents a loop
CALL INFTST ;(/A) Test for no input JFN
ERRLJF GJFX34 ;None so break out now
MOVEI A,.CHNUL ;Erase the "?"...
DPB A,CURPNT(TXT) ;...by overwriting it with a null
MOVE B,LDPNT(TXT) ;Save TEXTI% context by putting
MOVEM B,LDPTMP ; these variables in the TRVAR
MOVE B,LDCNT(TXT)
MOVEM B,LDCTMP
MOVE B,CURPNT(TXT)
MOVEM B,CRPTMP
MOVE B,CURCNT(TXT)
MOVEM B,CRCTMP
TQNN <DEVF> ;Device specified
CALL DEFDEV ;(/DEV) No, so get default
HRRZ B,FILDEV(JFN) ;Has to be some flavor of DSK:
CAIE B,DSKDTB ;On disk?
JRST QUEST2 ;Nope, ding user and restart
TQO <NREC> ;Turn off recognition
TQNE <EXTFF> ;Extension being specified?
CALLRET QEXTN ;Yes
TQNN <NAMF> ;Name specified?
CALLRET QNAM ;No, must be entering it
TQNN <VERF> ;Version specified?
CALLRET QVER ;No, must be entering it
JRST QUEST3 ;Must be in STR or DIR field, no help
QUEST2: CALL DING ;(/) Can't help in any later fields
QUEST3: MOVE A,CRCTMP ;Now restore TEXTI% context from TRVAR
MOVEM A,CURCNT(TXT)
MOVE A,CRPTMP
MOVEM A,CURPNT(TXT)
MOVE A,LDCTMP
MOVEM A,LDCNT(TXT)
MOVE A,LDPTMP
MOVEM A,LDPNT(TXT)
MOVE A,MPP ;Get saved stack pointer
MOVE A,0(A) ;Find out what is there
TXNE A,IMCFLG ;Last call internal?
ERRLJF (GJFX34) ;Yes, return illegal "?" error to COMND%
CALL RETYPE ;(/) Retype the input text
CALL BACKIT ;(/) Backup over the NUL (was the "?")
; CALLRET RESCAN ;Re-establish TEXTI% context
;RESCAN - Routine to initiate a rescan of the user's input.
;The JFN block is initialized.
;
; Call with:
; TESTI% arguments setup
; CALL RESCAN
;
; Returns:
; +1 - Error,
; A/ Error code
; +2 - Success, String retyped on screen
RESCAN: STKVAR <TMPFLN> ;Save TEXTI% buffer here
NOINT ;Touching sensitive things
HLRZ A,FILLNM(JFN) ;Preserve TEXTI% buffer info
MOVEM A,TMPFLN ; in this location
HRRZS FILLNM(JFN) ;Now make believe it isn't there
CALL RELJFN ;(JFN/) Go cleanup
CALL ASGJFN ;(/JFN) Go get another JFN
IFNSK.
MOVEI A,JSBFRE ;None left
SKIPE B,TMPFLN ;If there is something to release,
CALL RELFRE ;(B/) The release it
ERRLJF GJFX3 ;Return error to user
ENDIF.
MOVE A,TMPFLN ;Setup old retype stuff
HRLM A,FILLNM(JFN)
OKINT ;Now we can be interrupted
XCTU [HLLZ F,0(E)] ;Get user flags again
SETZ F1, ; and clear others
MOVE A,STRPNT(TXT) ;Reinitialize pointer to input string
MOVEM A,LDPNT(TXT)
SETZM LDCNT(TXT) ;Zap input count
CALL SETTMP ;(JFN/) Get another temp block and continue
RETBAD() ;Something is wrong
RETSKP ;Return to GCH loop
;[7.1014]
;QNAM - Routine that is called when a question mark has been entered
;in the file name part of the file spec. This routine is the first
;step when printing out a list of candidates for the name field.
;
; Call with:
; TEXTI% arguments setup
; CALLRET QNAM
;
; Returns:
; JRST QUEST3 - When finished
QNAM: TQNN <DIRSF> ;Any directory *'s?
CALL QSNAM ;(/) No, append star and find first file
IFSKP. ;If first one found
DO. ;Loop through all candidates
LOAD A,FLNSB,(JFN) ;Print this name
CALL QNXTL ;(A/) Do the printing
CALL QVNAM0 ;(A/) Now look for next name
EXIT. ;No more, retype
LOOP. ;Do next candidate
ENDDO.
ENDIF.
JRST QUEST3 ;No directory match
;[7.1014]
;QEXTN - Routine that is called when a question mark has been entered
;in the extension part of the file spec. This routine is the first
;step when printing out a list of candidates for the extension field.
;
; Call with:
; TEXTI% arguments setup
; CALLRET QEXTN
;
; Returns:
; JRST QUEST3 - When finished
QEXTN: TQNN <DIRSF,NAMSF> ;Any directory or name *'s?
CALL QSEXT ;(/) No, append star and find first file
IFSKP. ;If first one found
DO.
LOAD A,FLESB,(JFN) ;Print this name
MOVE B,1(A) ;Look at the first word of the string
TLNE B,774000 ;Is first character a NUL?
IFSKP. ;It is null
MOVEI A,[ASCIZ /[Null]/] ;It is, so make dummy entry
SOS A ;Set up as string block
ENDIF.
CALL QNXTL ;(A/) Print out string
CALL QVEXT0 ;(A/) Now look for next extension
EXIT. ;None left, retype
LOOP. ;Do next candidate
ENDDO.
ENDIF.
JRST QUEST3 ;Stars somewhere or no match
;[7.1014]
;QVER - Routine that is called when a question mark has been entered
;in the version part of the file spec. This routine is the first
;step when printing out a list of candidates for the version field.
;
; Call with:
; TEXTI% arguments setup
; CALLRET QVER
;
; Returns:
; JRST QUEST3 - When finished
QVER: TQNN <DIRSF,NAMSF,EXTSF> ;Any dir, name, or extension *'s?
CALL QSVER ;(/) No, make it a star and find first file
IFSKP. ;If found first file
DO. ;Now loop through all versions
TMSG </
/> ;Make it neat
LOAD B,FLVNO,(JFN) ;Get version number
CALL DNOUT ;(B/) Print decimal version
CALL QVVER0 ;(/) Now get next version
EXIT. ;None left, retype
LOOP. ;Do next version
ENDDO.
ENDIF.
JRST QUEST3 ;Stars seen or no match
;[7.1014]
;The following routines are for stepping the name, ext and version fields
;and assuring that at least one file is accessible with the new field
;value.
;
; Called with:
; no arguments
; CALL QVNAM (to find first one)
; CALL QVNAM0 (when current name is being stepped)
; or
; CALL QVEXT (to find first one)
; CALL QVEXT0 (when stepping current extension)
; or
; CALL QVVER (to find first one)
; CALL QVVER0 (when stepping current version)
;
; Returns:
; +1 - No file found
; A/ Error code
; +2 - Success, file found
; With FLNSB(JFN) setup or
; With FLESB(JFN) setup or
; With FLVNO(JFN) setup
QVNAM: SETZ A, ;Find first name in this directory
JRST QVNAM1
QVNAM0: LOAD A,FLNSB,(JFN) ;Step the current name
CALL LKPTR ;(A/A) Need a lookup ptr
QVNAM1: TQO <NAMSF,STEPF> ;Flag that we are stepping
CALL NAMLKX ;(A/A,B) Find next name
RETBAD() ;Match is impossible
NOINT ;Match found
HRRZ A,FILTMP(JFN) ;Got one, exchange old name block
LOAD B,FLNSB,(JFN) ; and new one
STOR A,FLNSB,(JFN)
HRRM B,FILTMP(JFN)
OKINT ;Done touching sensitive areas
CALL SETTMP ;(JFN/) Now reinitialize FILTMP ptr
RETBAD() ;Error
CALL QVEXT ;(/) Now look for acceptable extension and version
JRST QVNAM0 ;None for this name, step it
RETSKP ;Got one, return
; Step extension field
QVEXT: SETZ A, ;Find first extension, this name
JRST QVEXT1
QVEXT0: LOAD A,FLESB,(JFN) ;Step current extension
CALL LKPTR ;(A/A) Need a lookup pointer
QVEXT1: TQO <EXTSF,STEPF> ;Note that we are stepping
CALL EXTLKX ;(A/A,B) Find next one
RETBAD() ;Pass error back
NOINT ;Can't be interrupted
HRRZ A,FILTMP(JFN) ;Got file, exchange old ext block
LOAD B,FLESB,(JFN) ; and new one
STOR A,FLESB,(JFN)
HRRM B,FILTMP(JFN)
OKINT ;Back to normal
CALL SETTMP ;(JFN/) Reinitialize FILTMP
RETBAD() ;Error
CALL QVVER ;(/) Now look for acceptable version
JRST QVEXT0 ;None for this ext, step to next
RETSKP ;Got one
; Step version field
QVVER: SETZ A, ;Find the first version
JRST QVVER1
QVVER0: LOAD A,FLVNO,(JFN) ;Step current version
QVVER1: TQO <VERSF,STEPF> ;Note stepping version
CALL GTVER ;(A/) Find next one and check access
RETBAD() ;There ain't one
RETSKP ;Found one
;GTVER - Routine to locate a file version
;
; Call with:
; A/ Desired version number
; Assumes F, F1, DEV, JFN, & STS are setup
; CALL GTVER
;
; Returns:
; +1 - Error, file not found
; +2 - Success,
; A/ version number
GTVER: HRRZ B,DEV ;Get device
HRRZ B,NLUKD(B) ;Check for some flavor of DSK:
CAIN B,MDDNAM ;If not MDD device,
JRST GTVER1 ; don't call USTDIR
CALL VERLUK ;(B/B) Find file but don't lock
RET ;Not found, return to caller
GTVER0: TQO <VERF,VERTF> ;Show version found
HRRM A,FILVER(JFN) ;And put it in JFN block in JSB
RETSKP ;Done
GTVER1: CALL VERLKX ;(B/B) Lookup requested version
RET ;Not there
MOVEM B,FILFDB(JFN) ;Remember FDB address
TQNE <ASTF> ;If output stars, then nothing really done
JRST GTVER0 ;Save the version and return
MOVE A,B ;Copy FDB address
PUSH P,.FBGEN(A) ;Save version number too
TQNE <DIRSF,NAMSF,EXTSF,VERSF> ;Stepping anything?
TQNE <NEWF,NEWVF> ;New file or version?
JRST GTVER2 ;New file or not stepping
MOVX B,FC%DIR ;Flag
CALL ACCCHK ;(A,B/) No, do directory list access check
JRST GTVER3 ;Bad news, see if we can try another
GTVER2: TQO <VERF,VERTF> ;Show version found and typed
POP P,A ;Recover version number
HLRZS A
STOR A,FLVNO,(JFN) ;And store it
CALL USTDIR ;(/) OK, release the directory
RETSKP ;And return
GTVER3: CALL USTDIR ;(/) Invalid access, release the directory
POP P,A ;Recover version
HLRZS A
TQNN <DIRSF,NAMSF,EXTSF,VERSF> ;Stepping anything?
RET ;No, just return
TQO <STEPF> ;Yes, step to next file
TQNE <RVERF> ; after installing right target version
SETZ A, ;Get highest version only
TQNE <HVERF> ;Highest only?
MOVEI A,-1 ;No, want all
TQNE <LVERF> ;Lowest only?
MOVEI A,-2 ;Yes, flag it
JRST GTVER ;Now go try it
;[7.1014]
;QSNAM, QSEXT, QSVER - Routines that append a * to the field currently
;being entered and fakes *'s for the remaining fields. It aids in
;the "?" when parsing a file. There are 3 entry points as noted below.
;
; Call with:
; no arguments
; CALL QSNAM - name being entered (returns nam*.*.*)
; CALL QSEXT - extension being entered (returns nam.ext*.*)
; CALL QSVER - version being entered (returns nam.ext.*)
;
; Returns:
; +1 - Error, no files can be recognized
; +2 - Fake input fields setup
QSNAM: CALL QSTAR ;(/) Stuff a * in name
CALL ENDNAM ;(/) Punctuate name field with "."
RET ;Couldn't do it
QSEXT: CALL QSTAR ;(/) Stuff * in extension
CALL ENDEX7 ;(/) Punctuate this field
RET ;Shucks
QSVER: CALL QSTAR ;(/) Jam a * in version
CALL ENDEX7 ;(/) and find version
RET ;Non-existant
RETSKP ;Done
;[7.1014]
;QSTAR - This routine stuffs a * in for the user (aids in "?" whilest
;parsing a filename).
;
; Call with:
; partial input in TEXTI% buffers
; CALL QSTAR
;
; Returns:
; +1 - Always, * stuffed in input buffers & old file flag set
QSTAR: MOVEI A,"*" ;This character
TQO <STARF> ;Note * seen
CALL LTR ;(A/) Put * in FILTMP and set WLDF
RETBAD() ;Couldn't do it
TQO <ASTAF,OLDNF> ;* allowed, old file only
TQZ <OUTPF,NEWNF> ;Old files only!
TQZ <ASTF> ;Clear bit possibly set due to OSTRF
RET ;Fini
;[7.1014]
;QNXTL - Routine to print out a candidate string
;
; Call with:
; A/ Address of string block
; CALL QNXTL
;
; Returns:
; +1 - Always
;
; Clobbers A,B,C
QNXTL: STKVAR <TMPA> ;Place to save A
MOVEM A,TMPA ;Hold onto address of string block
TMSG </
/> ;Neatness counts
MOVE B,TMPA ;Retrieve address of string block
HRROI B,1(B) ;Now convert it into string pointer
CALLRET TSTR1 ;Output string, but don't put in buffer
;[7.1014]
;LKPTR - Routine to compute a lookup pointer for a string block
;
; Call with:
; A/ Address of block
; CALL LKPTR
;
; Returns:
; +1 - Always with A/ lookup pointer (-# words,,first word-1)
;
; Clobbers A,B,C
LKPTR: HRRZI B,1(A) ;Address of start of string
HRLI B,(POINT 7,) ;Make it a pointer
LKPTR0: ILDB C,B ;Find end of string
JUMPN C,LKPTR0
HRRZ C,A ;Start of block
SUBI C,-1(B) ;-Number of words
HRL A,C ;Make A and IOWD
RET ;And away we go
; Set up temp string block for this jfn
; Call: JFN IN JFN
; JSYS SETTMP
; Sets up filopt(jfn) and rh(filtmp(jfn)) and filcnt(jfn)
; Clobbers a,b,c
; Clears num
SETTMP: HRRZ A,FILTMP(JFN) ; Is block assigned?
JUMPN A,SETTM1 ; Yes, use it
MOVEI B,MAXLW+1
NOINT
CALL ASGJFR ; Assign a free storage area in psb
RETBAD (GJFX22,<OKINT>) ; No room
HRRM A,FILTMP(JFN) ; Save in tmpptr
OKINT
SETTM1: HRLI A,(<POINT 7,0,35>)
MOVEM A,FILOPT(JFN) ; Set filopt(jfn)
MOVEI A,MAXLC
CALL TSTLNG ;ALLOWING LONG NAMES
IFNSK. ;IF NOT,
MOVEI A,MAXSHT ;GET MAX SIZE FOR A NAME THEN
TQNE <EXTFF> ;ABOUT TO COLLECT AN EXTENSION?
MOVEI A,MAXEXT ;YES. USE MAX SIZE OF AN EXTENSION THEN
ENDIF.
MOVEM A,FILCNT(JFN)
MOVEM A,CNTWRD(TXT) ;REMEMBER THIS
MOVEI NUM,0 ; Clear number
TQZ <NEGF>
RETSKP
;ROUTINE TO PUT AN ALTMODE BACK INTO THE INPUT BUFFER
;RETURNS +1 IF ERROR
;RETURNS+2 WITH ALTMODE IN BUFFER IF RECOGNITION WAS BEING DONE
STOUAL: SKIPA A,[SAWALT!SAWF] ;LOOK FOR EITHER IF ENTERED HERE
STOALT: MOVX A,SAWALT ;SEE IF SAW AN ALTMODE
TDNN A,FLAGS(TXT) ;DID WE?
RETSKP ;NO, RETURN IMMEDIATELY
ANDCAM A,FLAGS(TXT) ;YES. TURN IT OFF NOW
LDB A,CURPNT(TXT) ;GET LAST CHAR IN BUFFER
CAIN A,.CHESC ;IS IT AN ALTMODE?
RETSKP ;YES, ALL THROUGH
MOVEI A,.CHESC ;NO, PUT AN ALTMODE IN
SOSG CURCNT(TXT) ;IF THERE IS ROOM
RETBAD (GJFX51) ;NO ROOM
IDPB A,CURPNT(TXT) ;PUT ALTMODE IN BUFFER
MOVEI B,0 ;END WITH NULL
MOVE C,CURPNT(TXT)
IDPB B,C ;DONT UPDATE BYTE POINTER
RETSKP ;AND EXIT
; Get character from string OR file
; Call: CALL GCH
; Return
; +1 ; No more input
; +2 ; Ok, in a, the character
; Clobbers b
GCH: SKIPG LDCNT(TXT) ; IF ANY CHARS IN BUFFER, GET THEM FIRST
TQNN <STRF> ; Does string exist?
JRST GCH1 ; No, get from file
XCTBUU [ILDB A,2] ; Get character increment byte ptr
JUMPE A,GCH2 ;AT THE END OF THE STRING?
ANDI A,177 ;USE ONLY 7-BIT ASCII
CAIN A,"-" ;[7415] Are we in line continuation?
IFNSK. ;[7415] Possibly...
UMOVE B,2 ;[7415] Preserve the byte pointer from user
XCTBUU [ILDB A,2] ;[7415] Get next character
CAIN A,.CHLFD ;[7415] Is it a line feed?
JRST GCH ;[7415] We have continuation, ignore the continuation characters
CAIN A,.CHCRT ;[7415] How about a CR then LF?
IFNSK. ;[7415] Saw CR...
XCTBUU [ILDB A,2] ;[7415] ...now eat LF
JRST GCH ;[7415] And continue
ENDIF. ;[7415] End of -CRLF combination
UMOVEM B,2 ;[7415] Put user's byte pointer back
MOVEI A,"-" ;[7415] And restore the right character
ENDIF. ;[7415] End line continuation
SOSG CURCNT(TXT) ;[7415] Will this character fit?
RETBAD (GJFX51) ;[7415] No. Tell the user
IDPB A,CURPNT(TXT) ;YES. STASH IT AWAY
MOVEI B,0 ;PUT A NULL AT END
MOVE C,CURPNT(TXT) ;WITHOUT UPDATING THE POINTER
IDPB B,C
RETSKP ;AND FINISH UP
GCH2: TQZ <STRF> ; No more string input
GCH1: SOSGE LDCNT(TXT) ;MORE IN BUFFER?
JRST RFALSE ;NO. GO BACK
ILDB A,LDPNT(TXT) ;YES. GET THE NEXT BYTE
RETSKP ;AND RETURN THE BYTE
;SETUP RDTXT BLOCK
SRDTXT: PUSH P,B ;SAVE COUNT
IDIVI B,5 ;GET NUMBER OF WORDS
SKIPE C ;INTEGRAL NUMBER?
AOS B ;NO. GET ONE MORE WORD FOR THE SLOP
ADDI B,VARC+1 ;GET ADDITIONAL WORDS NEEDED
NOINT ;PRESERVE THE SANCTITY OF THE JSB
CALL ASGJFR ;GET SOME SPACE
JRST [ OKINT ;NOT THERE APPARENTLY
POP P,0(P) ;CLEAN UP THE STACK
ERRLJF (GJFX22)] ;GO COMPLAIN TO THE CALLER
MOVEI TXT,1(A) ;ESTABLISH ARG REGION
HRLI A,(<POINT 7,0,35>) ;MAKE IT A STRING POINTER
HRLM A,FILLNM(JFN) ;SAVE THE BLOCK ADDRESS FOR RELJFN
OKINT ;GOT IT. ALLOW INTERRUPTS
ADDI A,VARC ;TO BEGINNING OF STRING SPACE
HRRZ B,A
SETZM 1(B) ;INITIALIZE FIRST WORD OF STRING TO NULL
SETZM STRPNT(TXT) ;CLEAR RDTXT INPUT
SETZM FLAGS(TXT) ;CLEAR FLAGS
SETZM STPCNT(TXT) ;CLEAR LOGICAL NAME STEP COUNT
POP P,B ;RESTORE ORIGINAL BYTE COUNT
RET
;SETUP INTERNAL ^R BUFFER
RTYSET: STKVAR <RTY0P,RTY1P>
MOVX A,RIEFLG ;SEE IF THIS IS A RETURN ON EMPTY CALL
TXNE C,G1%RIE ;...
IORM A,FLAGS(TXT) ;YES, REMEMBER THIS FOR LATER
TXNN C,G1%RBF ;IS ^R BUFFER CONTIGUOUS?
XCTU [SKIPN A,.GJCPP(D)] ;IS THERE A BUFFER?
JRST GJF01 ;NO. GO ON
TLC A,-1 ;YES. MAKE IT A GOOD POINTER
TLCN A,-1
HRLI A,(<POINT 7,0>)
IBP A ;AND INCREMENT IT
CALL DBP ;DECREMENT
MOVEM A,RTY0P ;SAVE FINAL POINTER
GJF01: TQNN <STRF> ;HAVE A STRING POINTER?
IFSKP.
UMOVE A,2 ;YES. GET IT
IBP A ;INCREMENT IT
CALL DBP ;AND DECREMENT IT
MOVEM A,RTY1P ;SAVE IT FOR TESTING
ENDIF.
HRRZ A,E
UMOVE A,.GJRTY(A) ;AND GET ^R POINTER
TLC A,-1 ;MAKE ^R POINTER VALID
TLCN A,-1
HRLI A,(<POINT 7,0>)
IBP A ;INCREMENT IT
CALL DBP ;AND DECREMENT IT
MOVE B,A ;AND PUT IT IN B
MOVE D,STRCNT(TXT) ;MAX BYTE COUNT
MOVE A,ARGCR(TXT) ;GET BACK MAIN POINTER
TQNE <STRF> ;FROM A STRING IN MEMORY
JRST GTJ02 ;YES - NO CTRL/R BUFFER
GTJTP: CAME B,RTY1P ;SAME AS MAIN POINTER?
CAMN B,RTY0P ;AT THE END
JRST GTJ02 ;YES
XCTBU [ILDB C,B] ;GET A BYTE
JUMPE C,GTJ02 ;NULL ENDS BUFFER
SOSGE D ;MAKE SURE THIS ONE FITS
ERRLJF (GJFX51) ;IT DOESN'T
IDPB C,A ;COPY INTO MONITOR BUFFER
JRST GTJTP ;GO DO MORE
GTJ02: HRRZM D,STRCNT(TXT) ;BYTE SIZE
RET
;SETUP USER-PROVIDED JFN
USRJFN: HRRZ JFN,E
XCTU [SKIPL JFN,10(JFN)] ; Yes, get his version of jfn
CAIL JFN,MJFN
ERRLJF GJFX1,<MOVEM JFN,ERRSAV>
CAIE JFN,.PRIIN ;PRIMARY INPUT?
CAIN JFN,.PRIOU ;NO. PRIMARY OUTPUT?
ERRLJF GJFX1,<MOVEM JFN,ERRSAV> ;YES. CANT SPECIFY THAT JFN
GTJFZ2: NOINT
LOCK JFNLCK
GTJFZ3: CAMGE JFN,MAXJFN ; Above currently available jfn's?
IFSKP.
PUSH P,JFN ; Yes, sve this
MOVE JFN,MAXJFN
AOS MAXJFN
IMULI JFN,MLJFN
CALL RELJF2
POP P,JFN
JRST GTJFZ3
ENDIF.
IMULI JFN,MLJFN ;MAKE IT A USEABLE JFN
SKIPN FILSTS(JFN) ; Is this jfn free?
CAIN JFN,0 ;AND NOT 0?
IFSKP.
CALL ASGJF1 ; Yes, assign it
ELSE.
UNLOCK JFNLCK ;[7345]ALREADY IN USE. UNLOCK THE JFN
OKINT ;[7345]AND GO OKINT
TQNN <JFNAF> ;[7345]DOES USER WANT TO ASSIGN AN ALTERNATE?
ERRLJF GJFX2,<MOVEM JFN,ERRSAV> ;[7345]NO. THEN PUNT
CALL ASGJFN ;[7345](/JFN)YES. GET A DIFFERENT JFN
ERRLJF(GJFX3) ;[7345]COULDN'T. SAY NO MORE JFNS
ENDIF.
RET
; Assign a jfn
; Call: CALL ASGJFN
; Return
; +1 ; Error none available
; +2 ; Ok, in jfn the jfn
; Clobbers jfn
ASGJFN: NOINT
LOCK JFNLCK
MOVN JFN,MAXJFN ; Get current max jfn
HRLZS JFN ; Form aobjn pointer
JRST ASGJF5 ;SKIP JFN 0
ASGJF0: SKIPN FILSTS(JFN)
JRST ASGJF3
ASGJF5: ADD JFN,[XWD 1,MLJFN]
JUMPL JFN,ASGJF0
ASGJF2: CAIL JFN,RJFN
JRST ASGJF4
SUB JFN,[XWD 1,0]
AOS MAXJFN
ASGJF3: HRRZ A,JFN
CAIE A,101*MLJFN
CAIN A,100*MLJFN
JRST ASGJF5 ; Primary io designator is skipped
AOS (P)
SETZM FILLNM(JFN)
ASGJF1: HRLI JFN,(ASGF)
HRRZ A,JFN ;GET ADDRESS ONLY
HLLZM JFN,FILSTS(A) ; Mark this jfn as assigned
HRRZS JFN
SETZM FILST1(JFN) ;RESET FLAGS IN FILST1
SETONE ASGF2,(JFN) ;[7384]AND LIGHT ASGF SHADOW BIT
HRRZ A,FORKN ; Get fork number
HRLZM A,FILVER(JFN)
SETZM FILTMP(JFN)
SETZM FILDDN(JFN)
SETZM FILNEN(JFN)
SETZM FILACT(JFN)
SETZM FILNND(JFN)
HLLZS FILIDX(JFN)
SETZM FILMS1(JFN)
SETZM FILCOD(JFN) ;CLEAR UNIQUE CODE FIELD
SETZM FILOFN(JFN) ;CLEAR THIS WORD IN CASE DEVICE CARES
HRRZS FILMS2(JFN) ; CLEAR MASK WORDS
SETZM FILFDB(JFN) ; CLEAR FDB ADDRESS WORD
SETZRO FLDIR,(JFN) ; ZERO POINTER TO DIR STRING
SETZRO FLATL,(JFN)
SETOM FILLCK(JFN)
ASGJF4: UNLOCK JFNLCK
OKINT
RET
; Release jfn
; Call: IN JFN, JFN
; CALL RELJFN
; Clobbers a,b,c,d
RELJFN::
RELJFX:
NOINT
LOCK JFNLCK
SKIPN A,FILSTS(JFN) ;ALLREADY RELEASED?
JRST RELJF4 ;yes Already released
HRRZ A,FILDEV(JFN) ;GET THE DISPATCH ADDRESS FROM THE JFN
SKIPE A ;DEVICE DISPATCH SET?
CALL @RLJFD(A) ;YES...RELEASE ANY DEVICE SPECIFIC STORAGE
NOP ;IGNORE NON-SKIP RETURN
MOVE A,FILSTS(JFN) ;GET THE STATUS AGAIN
MOVE B,FILST1(JFN) ;[7384]GET MORE STATUS BITS
TXNE A,ASGF ;[7384]WAS THIS JFN BEING ASSIGNED?
TXNN B,ASGF2 ;[7384]BE SURE ASGF IS LIT, NOT BLKF
SKIPA ;[7384]JFN IS NOT BEING ASSIGNED
JRST RELJF0 ;YES, DONT CHECK SPOOLING
HRRZ A,FILIDX(JFN) ;SEE IF THIS IS A SPOOLED DEVICE
MOVE B,DEVCH1(A) ;GET CHARACTERISTICS OF ORIGINAL DEV
SKIPE SPIDTB+.SPQSR ;IS THERE A PID TO SEND TO?
TLNN B,(D1%SPL) ;YES, IS THIS A SPOOLED DEVICE?
JRST RELJF0 ;NO, DONT SEND ANY MESSAGES TO QUASAR
MOVE C,DEVCHR(A) ;SEE IF THIS IS AN INPUT DEVICE
BLCAL. DSKOK,<<FILDEV(JFN)>> ;REAL DISK?
SKIPA ;NO
TLNE C,(DV%IN) ;IF AN INPUT DEVICE, DONT SEND MESSAGE
JRST RELJF0 ;NOT OPENED, DONT SEND MESSAGE
CALL GETFDB ;GET THE FDB MAPPED
JRST RELJF0 ;FOULED UP, DONT SEND MESSAGE
EA.ENT
MOVE T2,.FBBYV(T1) ;SET UP FOR MESSAGE
MOVE T3,.FBSIZ(T1) ;SPOOL MESSAGE HAS FBBYV AND FBSIZ
CALL USTDIR ;UNLOCK FROM GETFDB
MOVE T1,JFN ;SET UP FOR SENDING MESSGE
CALL SPLMES ;TELL QUASAR OF SPOOLED FILE
BUG.(CHK,NOSPLM,GTJFN,SOFT,<RELJFN - Could not send spool message to QUASAR>,,<
Cause: Could not tell QUASAR of spooled file for output.
Action: See if QUASAR is running and check to see that the system has some
IPCF free space available. If the system appears to be normal and
if this BUG persists, make it dumpable and submit an SPR with the
dump and a copy of MONITR.EXE. If possible, include any known
method for reproducing the problem and/or the state of the system
at the time the BUG was observed.
>,,<DB%NND>) ;[7.1210]
RELJF0: CALL RELJF3 ;RELEASE COMMON STUFF
TXNE B,TRNSF ;[7384]A TRANSITIONAL FILE?
JRST RELJF4 ;[7384]NO
MOVE A,FILST1(JFN) ;[7384]GET SECOND STATUS WORD
TXNE B,ASGF ;[7384]WAS THIS BEING CREATED?
TXNN A,ASGF2 ;[7384]MAKE SURE ASGF IS LIT, NOT BLKF
JRST RELJF4 ;NO. CANT BE A RDTXT BUFFER THEN
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF LOGICAL NAME CHAIN
CALL RELLNS ;RELEASE LOGICAL NAME STRING
MOVEI A,JSBFRE ;SET UP TO RELEASE RDTXT BUFFER
HLRZ B,FILLNM(JFN)
SKIPE B ;A RDTXT BLOCK THERE?
CALL RELFRE ;YES. RELEASE IT
HRRZS FILLNM(JFN) ;CLEAR OUT RDTXT BUFFER POINTER
RELJF4: SETZM FILDEV(JFN) ;CLEAR THIS TO AVOID ANY CONFUSION
UNLOCK JFNLCK
OKINT
RET
;COMMON SUBROUTINE CALLED BY RELFJN AND CLRJFN TO CLEAN UP THE JFN
;BLOCK BEFORE RELEASING IT OR STARTING PARSE ALL OVER
RELJF3: MOVE A,FILSTS(JFN) ; GET STATUS BITS
TXNE A,NONXF ; IS THIS A NON-EXISTENT FDB
CALL DELJFB ; YES, GO DELETE FDB IF FILE IS NON-X
MOVEI A,JSBFRE ; COMMON RELEASE SUBROUTINE
LOAD B,FLNOD,(JFN) ;RELEASE NODE IF ANY
SKIPE B
CALL RELFRE
HLRZ B,FILDDN(JFN)
SKIPE B
CALL RELFRE ; Release device string block
LOAD B,FLDIR,(JFN) ;SEE IF THERE IS A DIR NAME STRING
SKIPE B
CALL RELFRE ;YES, GO RELEASE IT
HLRZ B,FILNEN(JFN)
SKIPE B
CALL RELFRE ; Release name string block
HRRZ B,FILNEN(JFN)
SKIPE B
CALL RELFRE ; Release extension string block
LOAD B,FLDMS,(JFN) ; GET DIR WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
LOAD B,FLNMS,(JFN) ; NAME WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
LOAD B,FLEMS,(JFN) ; EXTENSION WILD MASK
SKIPE B ; HAVE ONE?
CALL RELFRE ; YES. RELEASE IT
SKIPLE B,FILACT(JFN) ;HAVE AN ACCOUNT STRING?
CALL RELFRE ; Release storage for account string
SETZ B, ; GET A ZERO
STOR B,FLDMS,(JFN) ; CLEAR DIR WILD MASK
STOR B,FLNMS,(JFN) ; CLEAR NAME WILD MASK
STOR B,FLEMS,(JFN) ; CLEAR EXTENSION WILD MASK
CALL RELATR ; GO RELEASE ATTRIBUTE LIST
MOVEI A,JSBFRE
MOVE B,FILSTS(JFN)
MOVE C,FILST1(JFN) ;[7384]GET ADDITIONAL STATUS BITS
TXNE B,ASGF ;[7384] Was this jfn being assigned?
TXNN C,ASGF2 ;[7384]MAKE SURE ASGF LIT, NOT BLKF
IFNSK. ;[7408]
SETZM FILLFW(JFN) ;[7408] No. Zap this word
JRST RELJF2 ;[7408] Go finish up
ENDIF. ;[7408]
TXNE B,TRNSF ;[7206] WAS THIS JFN TRANSITIONAL?
JRST RELJF2 ;[7206][7408] Yes, no TEMP block to release
;..
;..
HRRZ B,FILTMP(JFN)
SKIPE B
CALL RELFRE ; Release temp block
LOAD B,FLTSD,(JFN) ; RELEASE OTHER TEMP BLOCK
SKIPE B ; IF ANY
CALL RELFRE
SETZM FILTMP(JFN) ; CLEAR OUT POINTER TO WORD
RELJF2: SETZM FILDDN(JFN)
SETZM FILNEN(JFN)
SETZM FILPRT(JFN)
SETZM FILACT(JFN)
HLLZS FILIDX(JFN)
SETZM FILFDB(JFN) ;CLEAR FDB ADDRESS WORD
SETZRO FLDIR,(JFN) ;ZERO DIR NAME STRING AREA
MOVE B,FILSTS(JFN) ;SAVE THIS IN CASE IT IS NEEDED
SETZB STS,FILSTS(JFN)
SETOM FILLCK(JFN)
RET ;ALL DONE
RELATR: LOAD B,FLATL,(JFN) ;GET POINTER TO ATTRIBUTE LIST
JUMPE B,R ;IF EMPTY, THEN DONE
LOAD C,PRFXL,(B) ;GET POINTER TO NEXT ITEM ON LIST
STOR C,FLATL,(JFN) ;REMOVE FIRST ITEM FROM CHAIN
LOAD C,PRFXS,(B) ;GET SIZE OF BLOCK
MOVEM C,0(B) ;PUT SIZE IN FIRST WORD OF BLOCK
MOVEI A,JSBFRE
CALL RELFRE ;RELEASE THE BLOCK
JRST RELATR ;LOOP BACK TILL LIST IS EMPTY
;ROUTINE TO RELEASE LOGICAL NAME STRINGS
;ACCEPTS IN A/ ADDRESS OF CHAIN HEADER WORD
; CALL RELLNS
;RETURNS +1 ALWAYS
RELLNS::STKVAR <RELLNA>
HRRZM A,RELLNA ;SAVE POINTER TO CHAIN
RELLN1: CALL REL1LN ;GO RELEASE THE FIRST LOGICAL NAME BLOCK
RET ;ALL DONE
MOVE A,RELLNA ;LOOP BACK FOR ALL ELEMENTS
JRST RELLN1 ;LOOP BACK TILL ALL ARE RELEASED
;ROUTINE TO RELEASE THE FIRST LOGICAL NAME ON THE LIST
;ACCEPTS IN A/ ADDRESS OF CHAIN POINTER WORD
; CALL REL1LN
;RETURNS +1: NO MORE LOGICAL NAMES
; +2: OK
REL1LN::STKVAR <REL1LA>
HRRZM A,REL1LA ;SAVE ADDRESS OF CHAIN POINTER
HRRZ A,@REL1LA ;GET POINTER TO FIRST LN BLOCK
JUMPE A,R ;NO MORE
LOAD B,LNMPNT,(A) ;GET POINTER TO NAME STRING
MOVEI A,JSBFRE ;STORAGE CAME FROM JSB
CALL RELFRE ;RELEASE IT
HRRZ B,@REL1LA ;GET BACK POINTER TO BLOCK
LOAD C,LNMLNK,(B) ;GET POINTER TO NEXT BLOCK
HRRM C,@REL1LA ;UPDATE POINTER TO FIRST BLOCK
MOVEI C,LNHDRL ;GET LENGTH OF HEADER BLOCK
MOVEM C,0(B) ;FOR RELFRE
CALL RELFRE ;GIVE BACK SPACE FOR HEADER
RETSKP ;AND RETURN
; Terminate string
; Call: FILOPT(JFN) ; Addresses last byte of string
; RH(FILTMP(JFN)) ; Addresses beginning of string block
; CALL ENDSTX
; Returns with a null deposited on the end of the string and
; In a, a pointer to the string as required by the recognition routines
; Does not modify filopt(jfn), clobbers a,b
ENDSTX::MOVE A,FILOPT(JFN)
MOVEI B,0
IDPB B,A ; Append null to string
LDB B,[POINT 6,A,5] ; ZERO OUT THE REST OF THE WORD
SUBI B,^D35 ; GET NEGATIVE NUMBER OF BITS TO SAVE
MOVSI C,400000 ; BUILD A MASK OF BITS TO PRESERVE
ASH C,(B) ; BUILD MASK
HRRZ B,A ; GET ADDRESS OF LAST WORD
ANDM C,(B) ; ZERO THE LOW ORDER BITS IN THE WORD
SUB A,FILTMP(JFN)
MOVNI A,-1(A) ; Number of full words instring
HRL A,FILTMP(JFN)
MOVSS A ; Yields iowd # fuul words, first word
RET
; Trim temp storage block and return excess to free store pool
; Call: FILOPT(JFN) ; Addresses the last byte of the string
; RH(FILTMP(JFN)) ; Addresses the beginning of the string block
; CALL ENDTMP
; Returns in a, origin of the string block
; Deposits a null byte on the end of the string
; Returns excess storage in the block to free storage pool
; Clears rh(filtmp(jfn))
; Clobbers a,b,c,d
; Leaves psi off
ENDTMP: MOVEI B,0
IDPB B,FILOPT(JFN) ; Deposit a null on the end
HRRZ A,FILTMP(JFN) ; Origin of block
MOVE B,FILOPT(JFN)
CALL TRMBLK ; Trim excess from the block
NOINT
HRRZ A,FILTMP(JFN)
HLLZS FILTMP(JFN)
RET
; Trim excess from a block and return it to free storage
; Call: A ; Origin of the block
; RH(B) ; Last location in block used
; CALL TRMBLK
; Clobbers a,b,c,d
TRMBLK::MOVEI C,JSBFRE ;SET UP ARGUMENTS FOR TRIMER
CALLRET TRIMER ;DO THE TRIMMING
;ROUTINE TO TRIM THE UNUSED PART OF A BLOCK FROM A FREE STORAGE POOL
;ACCEPTS IN A/ ORIGIN OF BLOCK
; B/ LAST LOCATION USED
; C/ POOL TO WHICH THE REMAINDER IS TO BE RETURNED
; CALL TRIMER
;RETURNS +1 ALWAYS
TRIMER::MOVEI B,1(B) ; Loc of first unused word
HRRE D,(A) ; Original length of block
SUBI D,(B)
ADDI D,(A) ; Length of excess
JUMPLE D,CPOPJ ; No excess
NOINT
HRROM D,(B) ; Make residue into legit block
MOVNS D
ADDM D,(A) ; Shorten original block
MOVEI B,(B)
MOVE A,C ; GET ADDRESS OF POOL TO RELEASE INTO
CALL RELFRE ; Release the residue
OKINT
RET
; I-o routines for local use
; Call: B ; Pointer to string to be typed
; CALL TSTRB ; If b addresses a string block
; Or
; CALL TSTR ; If b address the first byte
; Outputs the string to the file specified in the call to gtjfn
; Clobbers A,B,C
;
;Returns: +1: Always
;
; CALL TSTRQC
;
;Accepts: B/ Address of first byte of remainder of string to be typed
;
;This routine is used by DEFNAM, DEFEXT, RECNAM, and RECEXT to insure
;that the field which is being recognized is of a valid length. This is
;only of interest when G1%NLN is set in the GTJFN call (no long names).
;Clobbers A,B,C.
;
;Return: +1: Error - field is too long (G1%NLN is in effect)
; +2: Success
TSTRQC: CALL LENOK ;(/A) Check on length of field
RETBAD() ;Invalid length - return error
CALL TSTRQ ;(B) Length is ok - complete field
RETSKP ;Return success
TSTRQ: SETO A, ;REMEMBER TO DO QUOTEING
JRST TSTR0
TSTRB: HRLI B,(<POINT 7,0,34>) ;POINTER TO BEGINNING OF STRING
TSTR: MOVEI A,0 ;NO QUOTEING
TSTR0: STKVAR <TSTRA>
TLC B,-1 ;ASCIZ BYTE POINTER IN B?
TLCN B,-1 ;...
HRLI B,(POINT 7,0) ;YES, SET UP LEGAL BYTE POINTER
MOVEM A,TSTRA ;SAVE QUOTEING FLAG
MOVEM B,LDPNT(TXT) ;SAVE POINTER
SKIPG CURCNT(TXT) ;ANY ROOM LEFT?
JRST TSTR0C ;NO
;..
;..
TSTR0A: ILDB A,B ;GET NEXT CHAR
JUMPE A,TSTR0B ;NULL = DONE
SKIPE TSTRA ;DOING QUOTING?
CALL QUOCHK ;YES, SHOULD IT BE QUOTED?
JRST TSTR0D ;NO
MOVEI C,"V"-100 ;YES, PUT IN A ^V
IDPB C,CURPNT(TXT) ;QUOTE THIS CHARACTER
SOSG CURCNT(TXT) ;ENOUGH ROOM FOR ANOTHER CHARACTER
JRST TSTR0C ;NO
TSTR0D: IDPB A,CURPNT(TXT) ;STORE THE CHARACTER
SOSLE CURCNT(TXT) ;ANY MORE ROOM?
JRST TSTR0A ;YES, LOOP BACK FOR MORE
TSTR0B: MOVE B,CURPNT(TXT) ;AND END WITH A NULL
IDPB A,B
TSTR0C: MOVE B,LDPNT(TXT) ;RESTORE B
SETZM LDCNT(TXT) ;ZAP THE INPUT COUNT
TSTR1: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
MOVEI C,0
SOUT
ERJMP R ;[7300][7420] Catch JSYS error
RET
;LENOK - Routine to check the length of the field being output.
;It is needed for GTJFN calls with G1%NLN set and recognition is being
;performed. We must check the length of the field we are returning to
;insure that it is not "long". This routine is only needed when
;recognition is used on the filename or extension before the maximum
;number of allowable characters is entered. Otherwise, the
;code at DPST handles the invalid field length.
;
;Returns: +1: Invalid length - error code is in A
; +2: Length is valid
;
;Uses registers A,C, and D. Preserves B.
LENOK: CALL TSTLNG ;Are long names allowed?
IFSKP. ;Yes
RETSKP ;Nothing more to do then
ENDIF.
LOAD C,FLNSB,(JFN) ;Get the pointer to the file name
TQNE <EXTF> ;Parsing an extension?
LOAD C,FLESB,(JFN) ;Yes, so get to pointer to the extension
HRLI C,(<POINT 7,0,34>) ;Point to the first character
SETZM D ;Init character counter
DO.
ILDB A,C ;Get a character
JUMPE A,LENOK1 ;No more to get
AOS D ;Count the character
JRST TOP. ;Get another one
ENDDO.
LENOK1: MOVEI C,MAXSHT ;Get max size for a name
MOVEI A,GJFX41 ;Get correct error code
TQNN <EXTF> ;Parsing an extension?
IFSKP. ;Yes
MOVEI C,MAXEXT ;Use max size of an extension then
MOVEI A,GJFX42 ;And get correct error code
ENDIF.
CAMLE D,C ;Are we over the limit?
RET ;Yes, return the error code
RETSKP ;Not over the limit - return success
;ROUTINE TO CHECK IF A CHARACTER NEEDS QUOTING
;ACCEPTS IN A/ CHAR
;RETURNS +1: DO NOT QUOTE
; +2: QUOTE IT
QUOCHK::SAVET ;[9041] Clobbers no ACs
MOVE B,A ;GET CHAR INTO B FOR CPTAB
IDIVI B,^D36/CCSIZE ;GET CLASS CODE
LDB B,CPTAB(C) ;GET CODE
CAIL B,ECHDTB-CHDTB ;LEGAL?
RET ;NO
MOVSI A,400000 ;NOW BUILD MASK
MOVNS B
LSH A,(B)
TXNE A,QUOMSK ;IS THIS A STANDARD CHARACTER?
RET ;YES, DO NOT QUOTE IT
RETSKP ;NO, QUOTE IT
QUOMSK==1B<UPPER>!1B<LOWER>!1B<DIGITC>!1B<UPPERT>!1B<UPPERP>!1B<UPPERA>!1B<LOWERT>!1B<LOWERP>!1B<LOWERA>!1B<MINUSC>
; Ding the bell
; Call: CALL DING
DING: HRRZ A,E
XCTU [HLRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
JRST RFALSE
MOVEI B,7 ; Fall into outch to type a bell
CALL OUTCH1 ;DONT INSERT IN USER'S STRING
JRST RFALSE
; Output character
; Call: B ; The character right justified
; CALL OUTCH
; Outputs the character on the file specified in the call to gtjfn
; Clobbers a-D
OUTCH: SKIPG CURCNT(TXT) ;ROOM LEFT IN USER'S STRING
JRST OUTCH1 ;NO, DONT PUT CHARACTERS IN STRING
IDPB B,CURPNT(TXT) ;PUT IT IN THE STRING
MOVE A,CURPNT(TXT) ;STORE A NULL AT END OF STRING
SETZ C,
SOSLE CURCNT(TXT) ;AND ADJUST THE COUNT
IDPB C,A ;ONLY STORE NULL IF ENOUGH ROOM
OUTCH1: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
BOUT
ERJMP R ;[7300][7420] Catch JSYS error
RET
;TEST FOR INPUT STRING COMING FROM A FILE
; RETURN +1: NOT COMING FROM FILE
; +2: COMING FROM FILE, A/ JFN
INFTST: HRRZ A,E
XCTU [HLRZ A,.GJSRC(A)]
TXNE E,-1B17 ;FULL BLOCK?
TXNE E,GJ%FNS ;NO, JFN'S SUPPLIED?
CAIN A,.NULIO ;AND NULL?
RET ;NOT FILE
RETSKP ;FILE
;SET MODES ON INPUT FILE IF THERE IS ONE
SETINF: CALL INFTST
JRST GTJFZ1
RFCOC
DMOVEM B,INFCOC
RFMOD ;GET MODE BITS TOO
TXZ B,TT%OSP ;FORGET OUTPUT SUPPRESS
MOVEM B,INFMOD
TRZ B,3B29 ;CLEAR DATA MODE FIELD
TRO B,17B23+1B29 ;SET BREAK ON EVERYTHING
SFMOD ;AND PUT IT IN EFFECT
CALL SFCC0
GTJFZ1: RET
;RESTORE INFILE MODES WHEN LEAVING GTJFN
ENDINF: CALL INFTST
JRST ENDL55 ;NO INPUT FILE
MOVE B,INFMOD
SFMOD ;SET IT BACK
DMOVE B,INFCOC
SFCOC
ENDL55: RET
SFCCON: MOVE B,TTICB1
MOVE C,TTICB2 ;STANDARD SETTINGS
JRST SFCC
SFCC0: DMOVE B,[BYTE (2)1,1,1,1,1,1,0,2,1,2,2,1,2,2,1,1,1,1
BYTE (2)0,1,1,0,0,0,1,1,1,0,1,1,1,2]
SFCC: CALL INFTST
RET
SFCOC
RET
; Output number
; Call: B ; The number
; CALL DNOUT ; For decimal output
; Or
; CALL ONOUT ; For octal output
; Clobbers a,c
DNOUT: SKIPA C,[12]
ONOUT: MOVEI C,10
MOVE A,CURPNT(TXT) ;GET TAIL OF DATA
NOUT ;PUT NUMBER IN THE STRING
JFCL
MOVEM C,LDCNT(TXT) ;SAVE RADIX
MOVE C,CURPNT(TXT) ;GET START TO CALCULATE NUMBER TRANSFERRED
CMPAR: IBP C ;MOVE IT
SOS CURCNT(TXT) ;COUNT FIRST ONE
CAME C,A ;THERE YET?
JRST CMPAR ;NO. GO ON
NOUTA: MOVEM A,CURPNT(TXT) ;UPDATED TAIL POINTER
MOVE C,LDCNT(TXT) ;RESTORE RADIX
SETZM LDCNT(TXT) ;JUST TO BE SAFE
ANOUT: HRRZ A,E
XCTU [HRRZ A,1(A)]
TLNE E,777777
TLNE E,2
CAIN A,377777
RET
NOUT
ERJMP R ;[7300][7420] Catch JSYS error
RET
; Process errors during gtjfn
; Call: A ; Error number
; JRST ERRDO
ERRDO: PUSH P,A ;SAVE ERROR CODE
JUMPE TXT,ERRDO2 ;IF TXT NOT SET UP, SKIP THESE STEPS
CALL STRUSR ;PUT DATA IN USER'S BUFFER
CALL RELJFX
ERRDO2: CALL ENDINF ;RESTORE TTY MODES
POP P,A ;ERROR CODE
RETERR () ;AND GO TO ERROR EXIT
;THESE ROUITNES ARE USED BY THE RDTXT FACILITIES IN GTJFN
BACKIT: SETO A, ;[7.1014] Move over recognition character
ADJBP A,CURPNT(TXT) ;[7.1014] Tail pointer
MOVEM A,CURPNT(TXT) ;SAVE NEW POINTER
SOS LDCNT(TXT) ;ADJUST COUNT
AOS CURCNT(TXT) ;INCREASE COUNT
RET ;AND DONE
GTINPT: HRRZ A,E
XCTU [MOVE A,1(A)] ;GET JFN'S
RET ;AND DONE
;ROUTINE TO STEP A LOGICAL NAME TO NEXT SET OF DEFAULTS
STEPLN: TXNN F,GJ%NS ;USER WANT TO PREVENT SEARCHING?
TQNN <OLDNF> ;NO, MUST HAVE OLD-FILE-ONLY BIT ON
RET ;OTHERWISE CANNOT STEP LN
MOVE B,CURPNT(TXT) ;GET POINTER
ILDB C,B ;WAS POINTER BACKED UP
JUMPE C,STPLN1 ;IF NULL, POINTER WAS NOT BACKED UP
IBP CURPNT(TXT) ;STEP OVER CHARACTER
SOS CURCNT(TXT) ;BACK UP OVER TERMINATOR
STPLN1: PUSH P,A ;SAVE THE ERROR CODE
CALL LNSTEP ;STEP THE LOGICAL NAME
JRST PA1 ;NO MORE DEFINITION BLOCKS
CALL STOALT ;FIND LOST ALTMODE
JFCL
CALL CLRJFS ;CLEAR OUT JFN BLOCK (EXCEPT FILLNM)
HRROS 0(P) ;MAKE ERROR CODE NEGATIVE
AOS STPCNT(TXT) ;INCREMENT THE STEP COUNTER
CALL SETTMP ;GO GET A TEMPORARY STRING
MOVEM A,0(P) ;STORE THIS ERROR CODE INSTEAD
JRST PA1 ;AND RETURN
CLRJFS: NOINT ;ROUTINE TO CLR JFN ON LN STEP
LOCK JFNLCK
JRST CLRJF1 ;DONT CLEAR OUT LOGICAL NAME
CLRJFN: NOINT ;PREVENT INTERRUPTS
LOCK JFNLCK ;LOCK UP THE JFN'S
MOVEI A,FILLNM(JFN) ;GET ADDRESS OF CHAIN HEADER WORD
CALL RELLNS ;RELEASE LOGICAL NAME SPACE
CLRJF1: CALL RELJF3 ;CLEAR COMMON CELLS
CALL ASGJF1 ;REASSIGN THE JFN
HRRZ STS,E
XCTU [HLLZ F,0(STS)] ;GET BACK USER'S FLAGS
CAIN STS,1 ;SHORT FORM? (OR DOESN'T MATTER)
TQZ <JFNRD> ;YES, GJ%XTN IS NOT ALLOWED
SETZ STS, ;CLEAR PROCESSING FLAGS
AND F1,[STRF+IGIVF] ; Leave string flg & find invisible
CALL SETSTR ;SET STAR BITS IN STS
MOVX B,RIEFLG ;CLEAR THE APPROPRIATE FLAGS
ANDM B,FLAGS(TXT) ;ONLY THE TEMPORARY ONES
RET ;AND DONE
SETSTR: TQNE <OSTRF> ;OUTPUT STARS ALLOWED?
TQNE <ASTAF> ;YES. INPUT STARS TOO?
RET ;NO. DONT SET ANYTHING
TQO <ASTF> ;YES. ALLOW STARS
RET ;AND RETURN
STRUSR: TQNN <JFNRD> ;SPECIFYING A RETURN BUFFER?
RET ;NO. JUST GIVE UP THEN
CALL STOUAL ;PUT ESCAPE AT END IF APPROPRIATE
JFCL ;IT HAS TO WORK
HRRZ D,E
XCTU [HRRZ D,11(D)] ;GET NEW FLAG WORD
CAIGE D,1 ;ENOUGH WORDS IN NEW BLOCK?
RET ;NO. CANT COPY
HRRZ B,E
UMOVE B,12(B) ;YES. GET THE STRING
TLC B,-1
TLCN B,-1 ; A -1 IN THE LEFT HALF?
HRLI B,(<POINT 7,0>) ;YES. PUT IN GOOD LEFT HALF
MOVE C,STRCNT(TXT) ;GET INITIAL COUNT
SUB C,CURCNT(TXT) ;SUBTRACT CURRENT COUNT
JUMPE C,R ;IF NONE USED,NO COPY.
PUSH P,[0] ;ASSUME NO COUNT
CAIGE D,2 ;USED SOME. DID HE GIVE A COUNT?
JRST NOCNT ;NO. GO ON
HRRZ D,E
XCTU [SKIPG A,13(D)] ;YES. GET IT
JRST NOCNT ;BAD COUNT. DONT BELIEVE IT
SUB A,C ;CALCULATE BYTES LEFT IN HIS BUFFER
UMOVEM A,13(D) ;AND RETURN IT TO HIM
SKIPLE A ;ROOM FOR A NULL AT THE END?
AOS 0(P) ;YES. SAY SO
NOCNT: MOVE A,STRPNT(TXT) ;POINTER TO START OF TEXT
MOVBYT: ILDB D,A ;GET A BYTE
XCTBU [IDPB D,B] ;STORE IT IN HIS STRING
SOJG C,MOVBYT ;DO THEM ALL
HRRZ C,E
UMOVEM B,12(C) ;RETURN UPDATED POINTER
POP P,A ;THE FLAG
JUMPE A,R ;ROOM FOR A NULL?
SETZ D, ;YES
XCTBU [IDPB D,B] ;SO PUT IT IN
RET ;AND FINISHED
;ROUTINE TO SEE IF LONG NAMES ARE ALLOWED. PRESERVES ALL
;REGISTERS
TSTLNG: SAVET ;SAVE ALL TEMPS
TQNN <JFNRD> ;HAVE EXTENDED BLOCK
RETSKP ;NO. ALLOW LONG NAMES
HRRZ A,E
UMOVE A,11(A) ;YES. GET FLAGS
TXNN A,G1%NLN ;ALLOWED?
RETSKP ;YES
RET ;NO
ENDTV. ;END TRVAR AT .GTJFN ENTRY
; Get next jfn
; Call: LH(1) ; Flags dirsf...hverf
; RH(1) ; Jfn
; GNJFN
; Returns
; +1 ; Error, jfn not attached to name, no more names
; +2 ; Ok, the jfn refers to the next file in the directory
GNJMSK==STRSF+DIRSF+NAMSF+EXTSF+VERSF+RVERF+HVERF+LVERF+FXPRT+FXACT+FXTMP
; MASK OF BITS TO KEEP FROM USER'S AC1
.GNJFN::MCENT
ACVAR <JQ1,JQ2>
STKVAR <OFILUC,VERNUM> ;[7380] Old STR unique code and version
HRRZ JFN,1
NOINT ;[8801] Get the lock with no interruptions
LOCK JFNLCK ;[8801] Can't let anyone in
CALL CHKJFN
RETERR(,<UNLOCK JFNLCK ;[8801] Done with lock
OKINT>) ;[8801] Interrupts are fine now
JFCL
RETERR(DESX4,<UNLOCK JFNLCK ;[8801] Lock finished
OKINT>) ;[8801] And interrupts are OK
OKINT ;[8801] CHKJFN made us NOINT 1 too many times
TQNE <ASTF>
ERUNLK(DESX7,<UNLOCK JFNLCK>) ;[8801] Output stars not allowed
TQNE <OPNF>
ERUNLK(OPNX1,<UNLOCK JFNLCK>) ;[8801] And file can't be open
LOAD JQ1,FLUC,(JFN) ;GET STRUCTURE UNIQUE CODE AT START
MOVEM JQ1,OFILUC ;SAVE OLD STR UNIQUE CODE
XCTU [HLLZ F1,1]
AND F1,[GNJMSK] ;KEEP ONLY CERTAIN BITS FROM USER
TXO F1,GNJFF ;REMEMBER THIS IS A GNJFN
TXNN F1,NAMSF ;WANT TO STEP THE NAME?
IFSKP.
HLRZ A,FILNEN(JFN) ;YES. GET NAME STRING
CALL GNJFN3 ;GO MAKE SURE IS BIG ENOUGH
RETERR (GJFX22,<UNLOCK JFNLCK ;[8801] Release lock
CALL UNLCKF>) ;[8801] Block too small, and none left
HRLM A,FILNEN(JFN) ;NEW STRING POINTER
ENDIF.
TXNN F1,EXTSF ;WANT TO STEP THE EXTENSION?
IFSKP.
HRRZ A,FILNEN(JFN) ;YES. GET EXTENSION STRING
CALL GNJFN3 ;GO MAKE SURE IS BIG ENOUGH
RETERR (GJFX22,<UNLOCK JFNLCK ;[8801] Release JFN lock
CALL UNLCKF>) ;[8801] Block too small and no more
HRRM A,FILNEN(JFN) ;NEW STRING
ENDIF.
TXO STS,ASGF!TRNSF ;MARK AS TRANSITIONAL
TXZ STS,NAMEF ;AND MAKE IT APPEAR UNASSIGNED
MOVEM STS,FILSTS(JFN) ;AND IN THE JFN AS WELL
SETONE ASGF2,(JFN) ;[7384]LIGHT ASGF SHADOW BIT AS WELL
UNLOCK JFNLCK ;[8801] No we have indicated that the JFN is ours
CALL UNLCKF ;DO UNLOCK
;..
;..
GNJFN1: SETZM FILTMP(JFN) ;[7408]
SETZM FILPRT(JFN) ;[7408]
SETZM FILOPT(JFN) ;[7408]
TQO <STEPF>
TQO <IGIVF> ; Make sure we see invisible files
UMOVE A,1 ; GET USER FLAGS
MOVX F,IGDLF+OLDNF ;Assume Ignore Deleted + Old Files Only
; TXNE A,GJ%GND ;Were deleted files considered?
; MOVX F,OLDNF ;No, so do not allow them to be found
HRRZ A,FILVER(JFN) ;GET CURRENT VERSION
TQNE <HVERF> ;NEW VERSION WANTED?
MOVNI A,1
TQNE <RVERF> ;MOST RECENT VERSION WANTED?
MOVNI A,0
TQNE <LVERF> ;LOWEST VERSION WANTED?
MOVNI A,2
TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF
IFNSK. ;[7371]
MOVEI A,GNJFX1 ;[7371] Will fail, give proper return
JRST GNFAIL ;[7371]
ENDIF. ;[7371]
MOVEM A,VERNUM ;[7380] Save version number
CALL VANISH ;[7393] (JFN/T1) Did file disappear on us?
RETERR(,<PUSH P,A ;[7393] Save error code
CALL RELJFX ;[7393] (/T1) Release JFN
POP P,A>) ;[7393] Tell user the error
SETZM FILTMP(JFN) ;[7371]
SETZM FILPRT(JFN) ;[7371]
SETZM FILOPT(JFN) ;[7371]
MOVE A,VERNUM ;[7380]
CALL VERLUK
GNFAIL: RETERR(,<CAIL A,GJFX36 ;ONE OF THE FILE OR DIRECTORY ERRORS?
CAILE A,GJFX40 ;STILL?
MOVEI A,GNJFX1 ;NO. GIVE STANDARD MESSAGE
PUSH P,A ;SAVE ERROR CODE OVER RELJFN
CALL RELJFX ;RELEASE THE JFN
POP P,A>)
;..
;..
HRRM A,FILVER(JFN)
MOVEM B,FILFDB(JFN) ; REMEMBER THE FDB ADDRESS
BLCAL. DSKOK,<DEV> ;SEE IF REAL FDB
JRST GNJFN2 ;ISN'T
CALL GETFDB
JRST GNJFN1
PUSH P,A
MOVX B,FC%DIR ;B/DIRECTORY-LIST ACCES
CALL ACCCHK
JRST [ CALL USTDIR
POP P,A
JRST GNJFN1]
MOVX B,DC%RD
CALL DIRCHK
JRST [ CALL USTDIR
POP P,A
JRST GNJFN1]
MOVE A,0(P) ;GET FDB ADDRESS BACK AGAIN
CALL COMACT ;SEE IF THE ACCOUNT STRING MATCHES
JRST [ CALL USTDIR ;IT DOESNT, STEP TO NEXT FILE
POP P,A
JRST GNJFN1]
POP P,A
MOVE A,.FBCTL(A)
CALL USTDIR
;..
;..
GNJFN2: UMOVE B,1
TLNN B,(1B12)
TXNN A,FB%DEL
IFNSK.
TLNN B,(1B13)
TXNE A,FB%DEL
JRST GNJFN1
ENDIF.
TXNE B,GJ%GIV ; Ignore fact file invisible?
TXNN A,FB%INV ; No, is it invisible?
IFSKP. < ; Taking or file visible
JRST GNJFN1> ; Invisible & not taking
NOINT ;PROTECT THINGS AGAIN
AOS FILLCK(JFN) ;GET THE LOCK
TXZ STS,ASGF!TRNSF ;MAKE IT A REAL JFN AGAIN
TXO STS,NAMEF ;SAY NAME IS NOW ASSIGNED
LOAD JQ2,FLUC,(JFN) ;GET THE CURRENT STRUCTURE UNIQUE CODE
MOVE A,JQ2 ;NOW LOCK THIS STRUCTURE
CALL CNVSTR ;...
JFCL ;IF DISMOUNTED, ERROR WILL BE SEEN LATER
HLRZ A,FILDDN(JFN) ;NOW UPDATE THE DEVICE NAME STRING
CAMN JQ2,OFILUC ;DID IT GET CHANGED DURING THIS GNJFN?
JRST GNJFN4 ;NO (WILL NOT CHANGE FOR NON-STRUCTURE DEVICES)
CALL CNVSIX ;GO UPDATE THE DEV NAME STRING
RETERR(,<PUSH P,A ;FAILED TO GET SPACE, SAVE ERROR CODE
CALL RELJFX
CALL UNLCKF
POP P,A>)
HRLM A,FILDDN(JFN) ;SAVE NEW STRING POINTER TO DEVICE
GNJFN4: SETZRO ASGF2,(JFN) ;[7384]CLEAR ASGF SHADOW BIT
;[7384]CALL TO UNLCKF WILL CLEAR ASGF
CALL UNLCKF ;RELEASE JFN AND STR LOCK
SETZ A,
CAME JQ1,JQ2 ;DID THE STR CHANGE DURING THIS CALL?
TXO T1,GN%STR ;YES, TELL THE USER OF THIS CHANGE
TQNE <DIRXF>
TXO T1,GN%DIR ;NOTE DIRECTORY CHANGED
TQNE <NAMXF>
TXO T1,GN%NAM ;NOTE NAME CHANGED
TQNE <EXTXF>
TXO T1,GN%EXT ;NOTE EXTENSION CHANGED
XCTU [HLLM A,1]
SMRETN
;ROUTINE TO MAKE SURE JSB STRING POINTED TO BY A IS BIG ENOUGH TO
;BE STEPPED. IF NOT, IT WILL ATTEMPT TO GET ANOTHER ONE OF THE
;PROPER SIZE AND COPY THE CURRENT INFO INTO IT.
;ACCEPTS:
; A/ JSB STRING ADDRESS
;RETURNS:
; +1/ FAILED. INPUT AREA NOT LARGE ENOUGH AND NO MORE JSB
; SPACE
; +2/ SUCCESS. A= NEW AREA
GNJFN3: STKVAR <SVPNTR,SVNEW> ;SOME WORK CELLS
JUMPE A,R ;IF NO BUFFER, ERROR
HRRZ B,0(A) ;GET CURRENT SIZE
CAIN B,MAXLW+1 ;LARG ENOUGH?
RETSKP ;YES. ALL DONE
MOVEI B,MAXLW+1 ;NO. MUST GET ONE OF PROPER SIZE
MOVEM A,SVPNTR ;SAVE INPUT
CALL ASGJFR ;GET SOME SPACE
RET ;NONE THERE.
MOVEM A,SVNEW ;SAVE NEW AREA
HRL A,SVPNTR ;GET OLD POINTER
AOBJN A,.+1 ;INCREMENT BOTH
MOVE B,SVPNTR ;OLD AREA
HRRZ C,0(B) ;LENGTH OF OLD AREA
ADDI C,-2(A) ;WHERE THE BLT SHOULD END
BLT A,0(C) ;MOVE NAME
MOVEI A,JSBFRE ;THE BLOCK HEADER
CALL RELFRE ;RELEASE IT
MOVE A,SVNEW ;THE NEW BLOCK
RETSKP ;DONE
;[7371]
;This routine is called before GNJFN% does its thing. It checks
;to see if the file that we are stepping off of has gone away.
;It could have disappeared via an untimely RENAME or it could
;have been deleted and expunged. Neither of which is good because
;the LOOKUP routines expect the file to still exist. If this file
;does not exist, then the LOOKUP routines will not set up FILOPT
;correctly and when directories are stepped, we will either hang in
;an infinite loop or we will cause an ILMNRF (because of FILOPT).
;
;Accepts:
; JFN/ JFN of file to check for existance.
;
;Returns:
; +1 if the file in the JFN block of the JSB pointed to by JFN
; is no longer there.
; T1/ Error code
;
; +2 if the file still exists
VANISH: EA.ENT ;[7371] Be in section 0/1
STKVAR <OLDFLG> ;[7371] Keep flags and (TXT) for later
HRRZ T1,FILDEV(JFN) ;[7.1064] Has to be some flavor of DSK:
CAIE T1,DSKDTB ;[7.1064] Is this JFN on a disk file?
RETSKP ;[7.1064] Nope, return OK
MOVEM F1,OLDFLG ;[7371] Put them here
TXZ F1,<GNJFF!DIRSF!ASTF!STRSF!NAMSF!EXTSF!VERSF!STEPF> ;[7393] Don't step anything
HRRZ T1,FILVER(JFN) ;[7393] Get version number
CALL VERLUK ;[7393] (T1/T2) Find that file
JRST GONE ;[7393] It ain't there
MOVE F1,OLDFLG ;[7371] Get flags back
RETSKP ;[7371] And continue, file is still here
GONE: MOVEI T1,GNJFX2 ;[7371] Return vanished file error
RET ;[7371]
ENDAV.
TNXEND
END