Google
 

Trailing-Edge - PDP-10 Archives - tops20_version7_0_monitor_sources_clock - monitor-sources/gtjfn.mac
There are 52 other files named gtjfn.mac in the archive. Click here to see a list.
; 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,.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 .GJRTY(D)]	;IS THERE A ^R BUFFER?
	JRST USDFL1		;NO. USE VALUE WE NOW HAVE
	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.
>,,<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			;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
	CALL CHKJFN
	 RETERR()
	 JFCL
	 RETERR(DESX4)
	TQNE <ASTF>
	ERUNLK(DESX7)		; Output stars not allowed
	TQNE <OPNF>
	ERUNLK(OPNX1)
	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,<CALL UNLCKF>) ;NOT, AND NO MORE SPACE
	  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,<CALL UNLCKF>) ;NOT BIG ENOUGH AND NO SPACE
	  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
	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