Google
 

Trailing-Edge - PDP-10 Archives - tops20v41_monitor_sources - monitor-sources/gtjfn.mac
There are 52 other files named gtjfn.mac in the archive. Click here to see a list.
; 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 
;Edit 6731 to GTJFN.MAC by LOMARTIRE on Tue 25-Jun-85
;		Remove edit 6713 until a better solution is found
;Edit 6730 to GTJFN.MAC by MOSER on Tue 18-Jun-85
;		FIX 3157 - RETURN CORRECT SETDEV ERROR - LOGICAL NAME LOOPS
;EDIT 6730 - RETURN SETDEV ERROR EXCEPT STRX09 - FIX EDIT 3175
;Edit 6713 to GTJFN.MAC by LOMARTIRE on Thu 28-Mar-85, for SPR #19910
;		Make GNJFN deal with deleted versions better
;Edit 6708 to GTJFN.MAC by LOMARTIRE on Wed 13-Mar-85
;		Fix a typo in edit 6704 (the final, final fix)
;Edit 6704 to GTJFN.MAC by LOMARTIRE on Wed 13-Mar-85
;		Use correct field length in edit 6701
;Edit 6701 to GTJFN.MAC by LOMARTIRE on Mon 4-Mar-85, for SPR #17125
;		Make G1%NLN work with recognition
;Edit 6685 to GTJFN.MAC by LOMARTIRE on Thu 31-Jan-85, for SPR #20532
;		Make system wide logicals search job then system wide tables
;Edit 3195 to GTJFN.MAC by LOMARTIRE on Wed 9-Jan-85, for SPR #20453
;		Prevent ILMNRF in RECDIR with parse-only JFN no-match
;Edit 3175 to GTJFN.MAC by LOMARTIRE on Fri 26-Oct-84, for SPR #20339
;		Return GJFX24 not STRX09 when device expansion in logical 
;;		name fails.
;Edit 3103 to GTJFN.MAC by CJOHNSON on Wed 25-Apr-84, for SPR #19927
;		Remove faulty edit 3077
;Edit 3077 to GTJFN.MAC by CJOHNSON on Fri 24-Feb-84, for SPR #19927
;		Make STRDEV determine name of public structure (fix DSK*:)
;Edit 3050 to GTJFN.MAC by MOSER on Tue 6-Dec-83 - PREVENT ILMNRF
;EDIT 3050 - PREVENT ILMNRF WHEN PARSE ONLY HAS ATRIBUTES.
; NOTE: EDIT 3050 WAS IN 4.1 AND SIRUS AS EDIT 1980 BY PED
;Edit 3013 to GTJFN.MAC by PRATT on Mon 12-Sep-83, for SPR #17124
;		Fix GJ%MSG problem which causes user confusion.
;Edit 3011 to GTJFN.MAC by TBOYLE on Wed 7-Sep-83, for SPR #17233
;		Make DEFEXT: return GJFX23 error if it occurs.
;Edit 2945 by LOMARTIRE on Wed 6-Apr-83, for SPR #18751
;		Do not output SYS: when escape first character hit.
; UPD ID= 58, FARK:<5-WORKING-SOURCES.MONITOR>GTJFN.MAC.2,   9-Jun-82 13:01:28 by DONAHUE
;Edit 2625 - Don't allocate CTRL/R buffer if string is from memory
; UPD ID= 478, SNARK:<5.MONITOR>GTJFN.MAC.18,  16-Feb-82 16:39:59 by GROUT
;Revision of TCO 5.1656 - fix typographical error
; UPD ID= 442, SNARK:<5.MONITOR>GTJFN.MAC.17,  26-Jan-82 10:02:43 by GROUT
;TCO 5.1656 - Don't expand existing DSK: if G1%SLN set
; UPD ID= 300, SNARK:<5.MONITOR>GTJFN.MAC.16,  28-Oct-81 11:33:19 by MURPHY
;Take out TCO 5.1415 because it affects external behaviour of GTJFN.
; UPD ID= 254, SNARK:<5.MONITOR>GTJFN.MAC.15,  12-Oct-81 11:41:35 by COBB
;TCO 5.1562 - Insert default fields when GJ%OFG (parse-only)
; 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
; 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
;<4.MONITOR>GTJFN.MAC.35, 15-Oct-79 16:19:01, Edit by SCHMITT
;TCO 4.2252 - HAVE GNJFN CLR IGDLF ONLY IF WANT LOWEST NON-DELETED VERSION
;<OSMAN.MON>GTJFN.MAC.1, 10-Sep-79 15:32:38, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>GTJFN.MAC.33,  3-Aug-79 11:48:18, EDIT BY DBELL
;MOVE CHECKING FOR G1%SLN TO A BETTER PLACE
;<4.MONITOR>GTJFN.MAC.32, 26-Jun-79 11:24:37, EDIT BY DBELL
;TCO 4.2311 - IMPLEMENT G1%SLN TO PREVENT EXPANSION OF LOGICAL NAMES
;<4.MONITOR>GTJFN.MAC.31, 12-Jun-79 08:30:50, EDIT BY MILLER
;DON'T CALL DEVAV IN SETDEV IF PARSE-ONLY
;<4.MONITOR>GTJFN.MAC.30,  6-Jun-79 19:05:17, EDIT BY DBELL
;REMOVE TCO 4.2252, IT CAUSED OTHER BUGS.
;<4.MONITOR>GTJFN.MAC.29, 30-May-79 11:49:34, EDIT BY DBELL
;TCO 4.2262 - SET GNJFF TO INDICATE A GNJFN IS BEING DONE
;<4.MONITOR>GTJFN.MAC.28, 29-May-79 16:09:19, EDIT BY KIRSCHEN
;REMOVE SPOOLED FILE FORMS ATTRIBUTE FROM ATTRIBUTE LIST
;<4.MONITOR>GTJFN.MAC.27, 18-May-79 11:26:26, EDIT BY DBELL
;TCO 4.2252 - HAVE GNJFN ONLY SET IGDLF IF WE WANT DELETED FILES.
;<4.MONITOR>GTJFN.MAC.26, 17-May-79 08:44:12, EDIT BY BLOUNT
;TAKE OFF-LINE OUT OF PRFXTB
;MERGE ARNIE'S CHANGES INTO SOURCES:
;<4.MONITOR>GTJFN.MAC.26, 19-Apr-79 14:33:41, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.25, 19-Apr-79 14:26:24, EDIT BY MILLER
;FIX CODE AT DEFDI1 TO CHECK FOR ASTF
;<4.MONITOR>GTJFN.MAC.24, 12-Apr-79 17:20:38, EDIT BY MILLER
;MAKE PARSE ONLY WORK ON DEVICE NAMES
;<4.MONITOR>GTJFN.MAC.23, 21-Mar-79 12:43:16, EDIT BY BOSACK
;ADD MONUMENTS TO NOINTNESS IN CHKDSK AND CNVSIX HEADINGS
;<4.MONITOR>GTJFN.MAC.22, 15-Mar-79 14:25:30, EDIT BY KIRSCHEN
;FIX OKINT FREE SPACE ASSIGN AT STODN1
;<4.MONITOR>GTJFN.MAC.21, 15-Mar-79 13:31:37, EDIT BY DBELL
;TCO 4.2215 - CLEAR THE RIGHT FLAG WHEN DEFAULTING DSK*: AT DEFSDV
;<4.MONITOR>GTJFN.MAC.20,  6-Mar-79 10:13:40, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.19,  5-Mar-79 13:15:55, EDIT BY MILLER
;CALL RELMT FROM RELJFN IF JFN IS ON AN MT
;<4.MONITOR>GTJFN.MAC.18,  4-Mar-79 17:24:47, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>GTJFN.MAC.17, 19-Feb-79 13:47:28, EDIT BY DBELL
;TCO 4.2193 - MAKE RECOGNITION OF DSK*: WORK PROPERLY AT DFDVTY
;<4.MONITOR>GTJFN.MAC.16, 11-Jan-79 10:30:01, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.15, 10-Jan-79 10:36:16, EDIT BY MILLER
;BE SURE TO CLEAR NREC IN ENDEXT
;<4.MONITOR>GTJFN.MAC.14, 19-Dec-78 12:26:36, EDIT BY MILLER
;DON'T ALLOW GTJFN ON MTX: IF DEVICE ASSIGNED TO ANOTHER JOB
;<4.MONITOR>GTJFN.MAC.13, 15-Dec-78 12:51:43, EDIT BY MILLER
;<4.MONITOR>GTJFN.MAC.12, 15-Dec-78 12:50:00, EDIT BY MILLER
;MAKE SURE GNJFN ALWAYS UNLOCKS JFN AND GOES OKINT
;<4.MONITOR>GTJFN.MAC.11,  4-Dec-78 14:46:44, EDIT BY MILLER
;ZERO FILOFN IN ASGJFN
;<4.MONITOR>GTJFN.MAC.10, 23-Nov-78 21:58:14, EDIT BY ZIMA
;TCO 4.2097 - CHECK FOR DISK FILE JFN BEFORE GOING OKINT IN GNJFN
;<4.MONITOR>GTJFN.MAC.9, 16-NOV-78 14:11:46, Edit by KONEN
;ALLOW A PARSE-ONLY JFN FOR A FILE ON AN UNMOUNTED STR
;<KONEN>GTJFN.MAC.3, 31-Jul-78 11:19:46, Edit by KONEN
;DO NOT ALLOW A JFN FOR A FILE ON AN UNMOUNTED STRUCTURE
;INSTALLED ARCHIVE SYSTEM MODIFICATIONS, OFFLINE ATTRIBUTE
;<4.MONITOR>GTJFN.MAC.6, 17-Oct-78 10:00:40, EDIT BY MILLER
;CHANGE ACCESS TO TAPE-ACCESS
;<4.MONITOR>GTJFN.MAC.5, 16-Oct-78 17:40:57, EDIT BY DBELL
;TCO 4.2045 - ACCEPT COMMA AS CONFIRMATION CHAR AFTER RECOGNITION IS DONE
;<4.MONITOR>GTJFN.MAC.4, 13-Oct-78 11:01:56, EDIT BY MILLER
;ADD ACCESS ATTRIBUTE
;<4.MONITOR>GTJFN.MAC.3, 16-Aug-78 16:38:18, EDIT BY ENGEL
;FIX AT ENDAL2 FOR GJ%IFG AND GJ%OFG CASE
;<4.MONITOR>GTJFN.MAC.2,  7-Jul-78 15:14:26, Edit by HEMPHILL
;IF DIRECTORY LOOKUP FAILS IN DEFDI0, STEP STRUCTURE IF ALLOWED
;<4.MONITOR>GTJFN.MAC.1,  7-Jul-78 14;IF DIRECTORY LOOKUP FAILS IN ENDDI0, STEP STRUCTURE IF ALLOWED

	SEARCH PROLOG
	TTITLE GTJFN		; & gnjfn
	SWAPCD
PNCATT==:";"			;PUNCTUATION FOR ATTRIBUTES
PNCVER==:"."			;PUNCTUATION FOR VERSION
PNCPFX==:":"			;PREFIX PUNCTUATION FOR ATTRIBUTES
WLDCHR==:"%"			; WILD CHARACTER


;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

;GENERAL DEFINITIONS FOR RDTXT PROCESSING

VARC==17			;WORDS OF STACK NEEDED FOR RDTXT STUFF
STRPNT==0			;OFFSET ON STACK FOR MAIN STRING POINTER
STRCNT==1			;OFFSET FOR MAX CHARACTER COUNT
LDPNT==2			;OFFSET FOR BYTE POINTER FOR ILDB'S
LDCNT==3			;OFFSET FOR 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

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 (TXT,P6)			;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

PFLMOD::POINT 4,FILSTS(JFN),35	; MODE OF OPEN
PBYTPO::POINT 6,FILBYT(JFN),5	; Points to "p" of file byte pointer
PBYTSZ::POINT 6,FILBYT(JFN),11	; Points to "s" of file byte pointer


;DEFINITIONS OF ENTITIES IN THE TXT BLOCK

DEFSTR (PFXVAL,PREFIX(TXT),35,9) ;POINTER TO THE PREFIX VALUE
; 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

;	LH(E)	; Flags
;	RH(E)	; Default version
;	LH(E+1)	; Input jfn (377777 means none)
;	RH(E+1)	; Output jfn (377777 means none)
;	E+2	; Default string pointer device
;	E+3	; Default string pointer directory
;	E+4	; Default string pointer name
;	E+5	; Default string pointer extension
;	E+6	; Default string pointer protection
;	E+7	; Default string pointer account
;	E+10	; Desired jfn if jfnf=1 (optional)
;	E+11	;ALTERNATE FLAGS,,COUNT (CONTROLLED BY JFNRD)
;	E+12	;RETURN BUFFER ADDRESS
;	E+13	;RETURN BUFFER ADDRESS SIZE IN WORDS
;	E+14	; ^R BUFFER(CONTROLLED BY G1%RBF)
;	E+15	; POINTER TO DESTINATION BUFFER
;	E+16	;POINTER TO ARBITRARY ATTRIBUTES BLOCK
; 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(17)			; Null
	CC1(17)			; Control-a
	CCN 17,4		; Control-b to e
	CC1(6)			; Control-f
	CCN 17,2		; Control-g & h
	CC1(5)			; TAB
	CC1(7)			; LF
	CC1(17)			; Control-k
	CC1(7)			;CONTROL-L (FF)
	CC1(34)			;CONTROL-M (CR)
	CCN 17,4		; Control-n - q
	CC1(3)			; Control-r
	CCN 17,2		; Control-s, t
	CC1 (2)			;CONT-U
	CC1(16)			; Control-v
	CC1(2)			; Control-w
	CC1(17)			; Control-x
	CC1(17)			; CONTROL-Y
	CC1(7)			;CONTROL-Z
	CC1(10)			; Alt-mode
	CCN 17,3		; 34-36
	CC1(7)			; Eol
	CC1(5)			; Space
	CCN 7,3			; ! " #
	CC1(0)			; $
	CC1(33)			; %
	CC1 (17)		; &
	CCN 7,3			;' ( )
	CC1(20)			; Asterisk
	CC1(7)			; +
	CC1(4)			; Comma
	CC1(30)			; -
	CC1(14)			; Dot
	CC1(7)			; Slash
	CCN 21,12		; Digits
	CC1(11)			; Colon
	CC1(15)			; Semi-colon
	CC1(12)			; <
	CC1(7)			; =
	CC1(13)			; >
	CC1(32)			; ?
	CC1(7)			; @
	CC1(24)			; A
	CCN 0,16		; B - o
	CC1(23)			; P
	CCN 0,3			; Q - s
	CC1(22)			; T
	CCN 0,6			; U - z
	CC1 (12)		; [
	CC1 (17)		;\
	CC1 (13)		; ]
	CC1 (17)		; ^
	CC1(0)			; _
	CC1(17)			; Acute accent
	CC1(27)			; Lower case a
	CCN 1,16		; Lower case b - o
	CC1(26)			; Lower case p
	CCN 1,3			; Lower case q - s
	CC1(25)			; Lower case t
	CCN 1,6			; Lower case u - z
	CCN 17,4		; Curly brackets vert bar complement
	CC1(2)			; Rubout

	QW
.GTJFN::MCENT			; Enter slow code
	SETZ TXT,		; 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,0(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>
	;TQNE <OSTRF>		;TCO 5.1415 -  IS THIS A PARSE ONLY JFN
	;TQO <ASTF>		; YES, SAY SO
	TLNE E,2		; 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 INFTST
	JRST GTJFZ1
	RFCOC
	PUSH P,B
	PUSH P,C
	RFMOD			;GET MODE BITS TOO
	TXZ B,TT%OSP		;FORGET OUTPUT SUPPRESS
	PUSH P,B		;SAVE THEM
	TRZ B,3B29		;CLEAR DATA MODE FIELD
	TRO B,17B23+1B29	;SET BREAK ON EVERYTHING
	SFMOD			;AND PUT IT IN EFFECT
	CALL SFCC0
GTJFZ1:	TLNN E,777777		; Can't specify jfn if short form
	TQNN <JFNF>		; Is user trying to specify jfn?
	JRST GTJF1		; No.
	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:	CAML JFN,MAXJFN		; Above currently available jfn's?
	 JRST [	PUSH P,JFN	; Yes, sve this
		MOVE JFN,MAXJFN
		AOS MAXJFN
		IMULI JFN,MLJFN
		CALL RELJF2
		POP P,JFN
		JRST GTJFZ3]
	IMULI JFN,MLJFN		;MAKE IT A USEABLE JFN
	SKIPN FILSTS(JFN)	; Is this jfn free?
	JRST [	JUMPE JFN,.+1	;AND NOT 0?
		CALL ASGJF1	; Yes, assign it
		JRST GTJF01]
	UNLOCK JFNLCK
	OKINT
	TQNN <JFNAF>
	ERRLJF GJFX2,<MOVEM JFN,ERRSAV>
GTJF1:	CALL ASGJFN
	ERRLJF(GJFX3)		; Jfn not available
GTJF01:	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,11(D)]	; Want to find invisible files?
	 TQO <IGIVF>		; Yes, flag that fact
	XCTU [HRRZ A,11(D)]	;YES. GET SIZE OF EXTENDED BLOCK
	CAIGE A,2		;IS THERE A COUNT GIVEN?
	JRST USDFLT		;NO. GO AROUND THE REST
	XCTU [SKIPG B,13(D)]	;YES. IS IT NON-ZERO?
	MOVEI B,DEFINP		;NO. USE THE DEFAULT
	CAIGE A,3		;HAVE A ^R BUFFER?
	JRST USDFL1		;NO. GO ON THEN
	XCTU [SKIPN 14(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
USDFL2:	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
	; ..
;GTJFN...

	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
	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,11(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
	CAIGE B,3		;INCLUDE A ^R BUFFER?
	JRST GJF00		;;NO.
	XCTU [SKIPN B,14(D)]	;IS IT NON-ZERO?
	JRST GJF00		;NO. GO ON
	PUSH P,[0]		;A TEST WORD ON THE STACK
	PUSH P,[0]		;AND ANOTHER FOR THE MAIN STRING
	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,12(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,0(P)		;SAVE FINAL POINTER
GJF01:	TQNE <STRF>		;HAVE A STRING POINTER?
	JRST [	UMOVE A,2	;YES. GET IT
		IBP A		;INCREMENT IT
		CALL DBP	;AND DECREMENT IT
		MOVEM A,-1(P)	;SAVE IT FOR TESTING
		JRST .+1]	;AND GO INLINE
	HRRZ A,E
	UMOVE A,14(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
;**;[2625] Add 2 lines at GTJTP:-1L	PED	9-JUN-82
	TQNE <STRF>		;[2625] FROM A STRING IN MEMORY?
	JRST GTJ02		;[2625] YES - NO CTRL/R BUFFER
GTJTP:	CAME B,-1(P)		;SAME AS MAIN POINTER?
	CAMN B,0(P)		;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
	SUB P,BHC+2		;CLEAN UP THE STACK
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,11(D)]	;GET COUNT
	CAIGE C,3		;HAVE A ^R POINTER?
	JRST GTJF12		;NO. GO ON THEN
	XCTU [SKIPE 14(D)]	;IS ^R BUFFER NON-ZERO?
	XCTU [SKIPN C,13(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)	;"
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
	 ERJMP [MOVE T1,LSTERR	;TRAP ERRORS (ERRLJF NOT GOOD ENOUGH)
		JRST ERRDO]	; AND EXIT WITH ERROR, RELEASING JFN
	HRRZ C,ARGDC(TXT)
	HLL C,ARGFLG(TXT)	;GET THE FLAGS
	TXNN C,RD%BTM	;FOUND A REAL BREAK CHARACTER?
	JRST [	TRNN C,-1	;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,11(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
	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:	CALL GCH		; Get next character
GTJF23:	 JRST [	JUMPN A,ERRDO	; IF A NON-ZERO, ERROR
		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
	TQZE <CNTVF>		; Control-v pending?
	JRST [	CALL UCCH	; Yes, ignore any special meanings
		 JRST ERRDO	;ERROR DURING HANDLING OF THIS CHAR
		JRST GTJF2]
	MOVX B,SAWCR		;SEE IF JUST SAW A CR
	TDNE B,FLAGS(TXT)	;DID WE?
	JRST [	ANDCAM B,FLAGS(TXT) ;YES. TURN OFF BIT
		CAIE A,.CHLFD	;IS THIS A LINE FEED?
		ERRLJF(GJFX4)	;NO. ILLEGAL CHARACTER THEN
		JRST .+1]	;YES. GO USE IT
	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>
	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
; 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
	CALL ENDDEV		; (11) colon
	CALL BEGDIR		; (12) <
	CALL ENDDIR		; (13) >
	CALL ENDNAM		; (14) .
	CALL ENDEXT		; (15) ;
	TQOA <CNTVF>		; (16) control-v
ILLCHR:!ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (17) illegal character
	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
	ERRLJF GJFX4,<MOVEM A,ERRSAV> ; (31) ^X IS AN illegal character
QBRK:!	ERRLJF (GJFX34)		; (32) ?
WILDC:!	CALL QUEST		;(33) WILD CARD CHARACTER
CARRET:!CALL DOCR		; (34) CARRIAGE RETURN
	DEPHASE			; END OF ADDRESS RELOCATION
ECHDTB:
; Continuation of gtjfn code

; 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:	SUBI A,40		; 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:	TQNE <STARF>
	JRST [	MOVX B,WLDF	;SET WILD BIT IN FLAGS
		IORM B,FLAGS(TXT)
		JRST .+1]	; AND GO INLINE
	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
; 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>
	RETBAD(GJFX6)
	TQOE <DEVF>
	RETBAD (GJFX6)		; Device already specified (syntax)
	CALL ENDSTR		; Terminate string, get lookup pointer
	MOVEM A,ENDDVS		; SAVE STRING POINTER FOR LATER
	TQZE <STARF>		; WAS A STAR OF SOME SORT TYPED?
	JRST ENDSDV		; YES
	CALL CHKLNM		; GO SEE IF THIS IS A LOGICAL NAME
	 JRST [	MOVE A,ENDDVS	;IF NO LOG NAME, GO LOOK UP DEVICE
		JRST ENDDV0]
	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 LNKLNM		;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

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:	CALL STRDEV		; SET UP FIRST STR IN LIST
	 RETBAD ()		; ILLEGAL USE OF STAR
	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:	SKIPA B,[DWLDF]		;GET ONE TYPE OF WILD FLAG
STRDEV:	MOVX B,WLDF		;OR ANOTHER TYPE
	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
	MOVE B,[ASCIZ/PS/]	;START AT STRUCTURE 0
	MOVEM B,1(A)		;STORE NEW STRING OVER OLD ONE
	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 ENDSTR		; Terminate string, get lookup pointer
	HRRZ B,FILDEV(JFN)	;SEE IF THIS IS A DISK
	CAIN B,DSKDTB		;IF NOT, DONT CALL DIRLKX
	TQNE <ASTF>		;DOING PARSE ONLY?
	JRST ENDDI2		;YES. DO IT THEN
	LOAD B,FILUC,(JFN)	; GET STRUCTURE NUMBER
	CALL DIRLKX		; Lookup directory (no recognition)
	 JRST ENDDI1		; Failed
	HRRM A,FILDDN(JFN)	; Save directory number
	CALL ENDTMP		; TIE OFF THE DIRECTORY NAME STRING
	STOR A,FILDIR,(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:	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,FILDMS,(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
	 MOVEI A,GJFX17		;NO SUCH DIRECTORY
	 RETBAD()		;GIVE IT UP
	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,FILDIR,(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

;HERE IF NON-DIRECTORY DEVICE OR SCAN ONLY

ENDDI2:	CALL ENDTMP		; FINISH OFF THE STRING
	HLLZS FILDDN(JFN)	; NO DIRECTORY NUMBER
	STOR A,FILDIR,(JFN)	; STORE THE POINTER TO DIRECTORY STRING
	OKINT			; ALLOW INTS
	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
ENDNA3:	TQO <NAMF>		; NO WE HAVE A NAME
	TQNE <DIRF>		; Do we have a directory yet?
	JRST ENDNA0		; YES, GO USE ITK
	CALL DEFDIR		; No. default it
	 JUMPN A,R		; RETURN IF FATAL ERROR
ENDNA0:	TQZE <STARF>
	JRST STARNM
	CALL ENDSTR		; Terminate string, get lookup pointer
	CALL NAMLKX		; Look up name without recognition
	 JRST STEPLN		; NO SUCH NAME, GO STEP LOGICAL NAME
	 RETBAD 		; AMBIGUOUS 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:	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,FILNMS,(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
	 RETBAD			;AMBIGUOUS NAME
	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
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 ENDSTR		; No, terminate, get lookup pointer
	CALL EXTLKX		; Lookup extension without recognition
	 JRST STEPLN		; NO SUCH EXT, GO STEP LOGICAL NAME
	 RETBAD			; AMBIGUOUS EXT
	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:	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,FILEMS,(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
	 RETBAD			; AMBIGUOUS
	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 ENDSTR		; Account is a string
	CALL ENDTMP
	MOVEM A,FILACT(JFN)	; Save positive account block pointer
	OKINT
	TQNN <VERF>		; HAVE A VERSION YET?
	JRST [	CALL DEFVER	; NO, GO GET ONE
		 RETBAD ()	; FAILED
		JRST .+1]	; HAVE A VERSION, CAN NOW CHECK ACCOUNT
	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?
	JRST [	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
	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?
	SKIPA			;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 VERLUK		; Lookup this version
	 JRST STEPLN		; GO TRY TO STEP LOGICAL NAME
	HRRM A,FILVER(JFN)
	MOVEM B,FILFDB(JFN)	; REMEMBER THE FDB ADDRESS
	TQO <VERTF>		; Remember that version was input
	JRST ENDEX0
STRVER:	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 ENDSTR		;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
;**;[3050] Add 2 lines at ENDARB:+14L	TAM	6-DEC-83
	SKIPN C			;[3050] IS THERE ONE?
	RETBAD (GJFX40)		;[3050] NO - ERROR
	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 ENDSTR		;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
	 ERJMP [MOVE A,LSTERR	;FAILED, GET THE ERROR CODE
		RETBAD ()]	;AND GIVE THE FAILURE RETURN
	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/COPIES/],,.PFCOP	;SPOOLED FILE COPIES
	[ASCIZ /DATA/],,.PFOPT	;NETWORK OPTIONAL DATA
	[ASCIZ/EXPIRATION-DATE/],,.PFEXP ;MAGTAPE EXPRIATION DATE
	[ASCIZ/FORMAT/],,.PFFMT	;MAGTAPE FORMAT
;	[ASCIZ/FORMS/],,.PFFRM	;SPOOLED FILE FORMS
	[ASCIZ/P/],,.PFPRT	;PROTECTION
	[ASCIZ /PASSWORD/],,.PFPWD ;NETWORK PASSWORD STRING
	[ASCIZ/POSITION/],,.PFPOS ;MAGTAPE POSITION
	[ASCIZ/PREALLOCATE/],,.PFALC ;PREALLOCATE DISK SPACE
	[ASCIZ/RECORD-LENGTH/],,.PFRLN ;MAGTAPE RECORD LENGTH
	[ASCIZ /TAPE-ACCESS/],,.PFACC ;ACCESS CODE ON MT DEVICE
	[ASCIZ/TEST/],,NOATRF	;TEST OF NOATRF FLAG
	[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>
	CALL GLNDEV		; GET LOGICAL NAME DEFAULT
	 SKIPA			; NONE EXISTS
	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,2(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
	CALL CHKLNM		; 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
	CALL SETDEV		; SET UP DEVICE INFORMATION
;**;[3175]  Replace 1 line with 4 at DFDV0A:+5		DML	26-OCT-84
	IFNSK.			;[3175] No such device
;**;[6730] ADD 1 LINE AT DFDV0A:+7L	TAM	18-JUN-85
	  CAIN A,STRX09		;[6730] STR MNT ERR?
	  MOVEI A,GJFX24	;[3175] Return the correct error code
	  JRST STEPLN		;[3175] Step logical name
	ENDIF.			;[3175] 
	NOINT
	HLRZ A,FILTMP(JFN)
	HRRZS FILTMP(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>
	HRRZ B,FILLNM(JFN)	;SEE IF THERE IS A LOGICAL NAME
	JUMPN B,RFALSE		;IF YES, DONT TYPE ANYTHING OUT
	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
	HLRZ A,FILTMP(JFN)	;GET POINTER TO DEFAULT STRING
	HRRZS FILTMP(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
;**;[2945]  Delete 7 lines at DFDVL2:+2		DML	6-APR-83
;[2945]	MOVE B,1(A)		;GET FIRST WORD OF STRING
;[2945]	TRZ B,677		;CLEAR OUT POSSIBLE GARBAGE BITS
;[2945]	CAME B,[ASCIZ/DSK/]	;IS THE NAME "DSK"?
;[2945]	 CALL DFDVTY		;NO, THEN GO TYPE IT MAYBE
;[2945]	JFCL			;DFDVTY SKIPS SOMETIMES
;[2945]	MOVE A,DEFDVS		;GET BACK POINTER TO STRING
;[2945]	MOVE B,DEFDVI		;GET BACK INDEX
	MOVEI C,FILLNM(JFN)	;GET ADDRESS OF CHAIN HEADER WORD
	MOVE D,STPCNT(TXT)	;GET CURRENT STEP COUNTER
	CALL LNKLNM		;ADD THIS LOGICAL NAME TO CHAIN
	 JRST [	OKINT
		RETBAD ()]	;PROBLEM OCCURED
	OKINT			;TURN ON INTERRUPTS AGAIN
	CALL GLNDEV		;NOW GET PHYSICAL DEVICE
	 SKIPA			;THERE WASNT ONE
	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>
	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?
	SKIPA			; YES, ALL IS OK
	JRST [	MOVEI A,GJFX38	; CANNOT GET OLD FILE ON OUTPUT ONLY DEV
		JRST STEPLN]	; GO SEE IF LOGICAL NAME CAN BE STEPPED
	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?
	SKIPA			;DON'T DO DEVAV
	JRST [	CALL DEVAV	;YES. CHECK IF AVAILABLE
		 RETBAD (OPNX7)	;NOT. GIVE ERROR THEN
		JRST .+1]	;IT IS. PROCEED
	HLRZ B,DEV		;GET UNIT # (MAY BE STR #)
	CAIN D,DSKDTB		;IS THIS A DISK DEVICE?
	CAIN B,-1		;YES - SPECIFIC STRUCTURE?
	RETSKP			;NO, ALL DONE
	STOR C,FILUC,(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		;DID USER MOUNT THIS STRUCTURE
	 JRST [ UNLOCK JSSTLK	; NO, FAIL
		OKINT		;ALLOW INTERRUPTS NOW
		TQNN <ASTF>	;PARSE-ONLY?
		RETBAD		;NO
		SETZ C,		;YES, STRUCTURE IS OK
		HRRM C,FILIDX(JFN) ;CLEAR INDEX INTO DEVICE TABLES
		STOR C,FILUC,(JFN) ;CLEAR UNIQUE CODE
		MOVEM C,FILDEV(JFN) ;CLEAR DEVICE
		RETSKP]
	UNLOCK JSSTLK		;UNLOCK STR INFO LOCK IN JSB
	OKINT			;ALLOW INTERRUPTS NOW
	RETSKP			;RETURN SUCCESSFULLY

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:	CAME DEV,[-1,,DSKDTB]	;IS THIS "DSK"?
	RETSKP			;NO, NO CHANGE NEEDED
	STKVAR <CHKDSN>		;SAVE NAME POINTER
	MOVEM A,CHKDSN
	MOVE B,FLAGS(TXT)	;GET FLAGS INTO B
	TXNE B,NOLOGF		;ARE WE EXPANDING LOGICAL NAMES?
	CALL CHKLN1		;IF NOT, IS DSK: DEFINED?
	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,FILUC,(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
	CAIGE B,3		;LARGE ENOUGH FOR STRUCTURE NAME?
	JRST [	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)
		JRST .+1]
	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

;**;[6685]  Replace 3 lines with 1 at CHKLN2:+0		DML	31-Jan-85
CHKLN2:	TQNE <PHYOF>		;[6685] 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

LNKLNM::STKVAR <LNKLNP,LNKLNI,LNKLNC,LNKLNS>
	HRRZM C,LNKLNC		;SAVE ADDRESS OF CHAIN HEADER
	MOVX C,SAWSLN		;SET UP TO MARK SAWSLN
	SKIPLE B		;IS THIS A SYSTEM LN?
	IORM C,FLAGS(TXT)	;YES, REMEMBER WE HAVE SEEN IT
	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
	 SKIPA			; NO
	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,3(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
	HRRZ B,FILDEV(JFN)	;SEE IF THIS IS A DISK
	CAIE B,DSKDTB		;IF NOT, DONT CALL DIRLKX
	JRST DEFDI3		;NOT A DISK
	LOAD B,FILUC,(JFN)	;GET STRUCTURE NUMBER
	CALL DIRLKX		; Look it up
	 JRST DEFDI7		; Failed
	HRRM A,FILDDN(JFN)
	CALL GTCSCD		;GET CONNECTED STR,,DIRECTORY
	LOAD B,FILUC,(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
DEFDI3:	NOINT
	HLRZ B,FILTMP(JFN)
	STOR B,FILDIR,(JFN)	; SAVE THE NAME IN THE JFN BLOCK
	HRRZS FILTMP(JFN)
	OKINT
	TQO <DIRF>
	JRST RFALSE		;RETURN WITH A=0

DEFDI1:	HRRZ A,FILDEV(JFN)	;GET DISPATCH ADDRESS
;**;[7135]  Rearrange code at DEFDI1:+1			DML	15-Aug-85
	CAIE A,DSKDTB		;[7135] Is this the disk?
	JRST DEFDI4		;[7135] No, dont set directory number or string
	LOAD A,JSCDS		;[7135] GET POINTER TO NAME STRING IN JSB
	JN JSCDF,,DEFDI5	;[7135] IF VALID, GO COPY IT TO FLDIR
	TQNE <ASTF>		;[7135] Is it a real JFN?
	JRST DEFDI4		;[7135] No, dont set directory number or string
	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,FILUC,(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
;**;[7135]  Replace 1 line with 7 at DEFDI5:+1		DML	15-Aug-85
	IFNSK.			;[7135] Failed
	  TQNE <ASTF>		;[7135] Is it a real JFN?
	  JRST DEFDI4		;[7135] No, so dont worry about error
	  RETBAD		;[7135] Yes, give error return
	ENDIF.			;[7135]
	TQNE <ASTF>		;[7135] Is it a real JFN?
	JRST DEFDI4		;[7135] No, so dont store anymore info
	LOAD A,FILUC,(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
	HLRZ B,FILTMP(JFN)
	STOR B,FILDIR,(JFN)	; SAVE THE NAME IN THE JFN BLOCK
	HRRZS FILTMP(JFN)
	OKINT
	CALL DEVSTP		; Step the structure
	 JRST STEPLN		; Failed, try stepping the logical name
	CALL GTCSCD		;GET CONNECTED STR,,DIRECTORY
	LOAD B,FILUC,(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 FILDIR(JFN)

STORDN::STKVAR <STODNA,STODNL>
	SE1CAL
	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,FILDIR,(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,FILDIR,(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,FILDIR,(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::	SAVEP
	HRRZ A,FILDEV(JFN)	;IS THIS THE DISK?
	CAIE A,DSKDTB		;...
	RETSKP			;NO, THEN RETURN OK
	LOAD A,FILDIR,(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,FILUC,(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
	HLRZ A,FILTMP(JFN)	; GET TEMP STRING
	STOR A,FILDMS,(JFN)	; TO MASK FIELD
	HRRZS FILTMP(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,FILDMS,(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:	HLRZ B,FILTMP(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
	 SKIPA			; THERE WAS NONE
	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,4(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
	 RETBAD ()		; AMBIGUOUS NAME
	MOVEM A,FILFDB(JFN)	; REMEMBER THE FDB ADDRESS
	NOINT
	HLRZ B,FILTMP(JFN)
	HRRZS FILTMP(JFN)
	HRLM B,FILNEN(JFN)
	OKINT
	TQO <NAMF,NAMTF>
;**;[6701]  Replace 5 lines with 6 at DEFNM1:+13	DML	27-Feb-85
	TQNN <NREC>		;[6701] 
	HRLI B,(<POINT 7,0,34>)	;[6701] Set up byte pointer
	CALL TSTRQC		;[6701] (B) Output the default name
	 RETBAD()		;[6701] Error - invalid field length
	AOS (P)			;[6701] Adjust for skip return
	JRST RFALSE		;[6701] 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
	HLRZ A,FILTMP(JFN)	; GET DEFAULT POINTER
	STOR A,FILNMS,(JFN)	; TO MASK
	HRRZS FILTMP(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
	 RETBAD ()		;AMBIGUOUS
	MOVEM A,FILFDB(JFN)	;REMEMBER THE FDB ADDRESS
	CALL STRNA1		;FINISH UP
	 RETBAD ()
	TQZ <EXTFF>
	TQO <NAMF,NAMTF>
	LOAD B,FILNMS,(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
;**;[3011] REPLACE ONE LINE AT DEFEXT: + 5L WITH 3.	TAB	7-SEP-83
;[3011]	 JRST RFALSE
	 JRST [	CAIE 1,GJFX23	;[3011] SKIP IF DIRECTORY FULL
		JRST RFALSE	;[3011] ELSE SAY NO MATCH.
		RETBAD]		;[3011] RETURN AS ERROR
	 JRST RFALSE		; None such
	MOVEM A,FILFDB(JFN)	; REMEMBER THE FDB ADDRESS
	NOINT
	HLRZ B,FILTMP(JFN)
	HRRZS FILTMP(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
;**;[6701]  Replace 1 line with 4 at DFSTRR:-6		DML	27-Feb-85
	SOS (P)			;[6701] Do not assume success return yet
	CALL TSTRQC		;[6701] (B) Output the default extension
	 RETBAD()		;[6701] Error - invalid field length
	AOS (P)			;[6701] 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
	HLRZ A,FILTMP(JFN)	; GET DEFAULT POINTER
	STOR A,FILEMS,(JFN)	; TO MASK FIELD
	HRRZS FILTMP(JFN)	; CLEAR OUT DEFAULT POINTER
	OKINT
DFSTE2:	CALL STREX1
	 RETBAD
	TQO <EXTF>		;SAY SAW AN EXTENSION
	LOAD B,FILEMS,(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
	 SKIPA			; NONE FOUND
	RETSKP			; GOT ONE
	JUMPN A,R		; IF ERROR, RETURN IMMEDIATELY
	HRRZ A,E
	TLNN E,777777		; No default if short form
	XCTU [SKIPN A,5(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
	JRST [	HRRZ A,E
		XCTU [HRRE A,0(A)]	;NONE, Get USER DEFINED default version
		JRST .+1]
	TQNE <TMPFF>
	SKIPE A			;TEMPORARY AND WANT "DEFAULT"?
	JRST DEFVR1
	MOVE A,JOBNO		; Default becomes job number for temp
	ADDI A,^D100000
	JRST DEFVR2		;GO DO IT
DEFVR1:	SKIPN A
	TQNN <OUTPF>
	JRST .+2
	SOS A			; 0 default becomes -1 for output
	CAMN A,[-3]		;-3 MEANS *
	JRST [	TQNN <ASTAF>	;STARS ALLOWED?
		TQNE <ASTF>	;* ALREADY SEEN?
		SKIPA		;ALLOW IT
		RETBAD (GJFX31)	;NO, GIVE AN ERROR NOW
		JRST DFSTRV]	;YES, DEFAULT THE VERSION TO *
	CAMN A,[-2]		;-2 MEANS LOWEST
	TQO <LVERF>
	CAMN A,[-1]		;-1 MEANS NEXT HIGHER
	TQO <HVERF>
	SKIPN A
	TQO <RVERF>
DEFVR2:	CALL VERLUK		; Extant?
	 JRST STEPLN		; NO, STEP THE LOGICAL NAME
	HRRM A,FILVER(JFN)
	MOVEM B,FILFDB(JFN)	; REMEMBER THE FDB ADDRESS
	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?
	SKIPA			;NO
	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
	SKIPN B			;ENDED WITH A NUL?
	JRST [	SETO B,		;YES, BACK UP THE BYTE POINTER ONCE
		ADJBP B,A	;SO THE DATA FIELD APPEARS TO BE NULL
		MOVE A,B
		JRST .+1]
	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,FILATL,(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:	HLRZ A,FILTMP(JFN)	;FIRST CHECK LEGALITY OF ATTRIBUTE
	LOAD B,PFXVAL		;GET THE PREFIX VALUE
	HRRZ C,DEV		;GET DISPATCH ADDRESS ONLY
;**;[3050] ADD 2 LINES AT ADDATR:+3L	TAM	6-DEC-83
	SKIPN C			;[3050] IS THERE ONE?
	RETBAD (GJFX40)		;[3050] NO - ERROR
	CALL @ATRD(C)		;CALL DEVICE DEPENDENT MODULE FOR OK
	 RETBAD ()		;ILLEGAL ATTRIBUTE FOR THIS DEVICE
	NOINT			;DISALLOW INTERRUPTS
	HLRZ A,FILTMP(JFN)	;PICK UP THE DATA STRING
	HRRZS FILTMP(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,FILATL,(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,FILATL,(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
	SKIPA
	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
	 ERJMP [MOVE A,LSTERR	;GET THE ERROR CODE
		RETBAD ()]	;AND RETURN
	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,7(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
	HLRZ A,FILTMP(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
	HLRZ A,FILTMP(JFN)	; THE STRING POINTER
	HRRZS FILTMP(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
	 SKIPA			; NONE
	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,6(A)]	; Get the default protection from user
	RETSKP
DEFPR1:	CAMG A,[6B2-1]		; Must be numeric
	CAMGE A,[5B2]
	JRST [	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
		HLRZ A,FILTMP(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
		HLRZ B,FILTMP(JFN) ;THE JSB SPACE
		HRRZS FILTMP(JFN)
		MOVEI A,JSBFRE
		CALL RELFRE	;FREE THE BLOCK
		OKINT
		JRST DEFPR2]	;GO MARK IT
	MOVEM A,FILPRT(JFN)
DEFPR2:	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 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:	STKVAR <XCTV,BYTSAV,STTSAV>
	MOVEM B,XCTV		;SAVE INSTRUCTION TO GET BYTES
REDFL1:	XCT XCTV		;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,16		; Character quote?
	 JRST REDFL3
	CAIN C,20
	JRST REDFST
	CAIL C,21
	CAILE C,27
	CAIN C,30
	JRST REDFL4
	CAIN C,14		; DOT?
	JRST REDFL4		; YES, DOT IS LEGAL IN DIR NAMES AND ACCOUNTS
	CAILE C,1		; 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
	SKIPA			;NO. DONT RAISE IT
	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:	HLRZ A,FILTMP(JFN)
	MOVE B,C
	CALL TRMBLK		; Trim the block and return excess
	HLRZ A,FILTMP(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 XCTV		;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?
	SKIPA			;ALLOW IT
	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
	HLRZ A,FILTMP(JFN)
	JUMPN 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
		HRRZS FILTMP(JFN); NO STRING NOW
		CALL RELFRE	;FREE IT UP
		OKINT		;ALLOW INTS AGAIN
		JRST .+1]	;AND GO GET A NEW BLOCK
	MOVEI B,MAXLW+1
	NOINT
	CALL ASGJFR
	RETBAD (GJFX22,<OKINT>)	; Insufficient space
	HRLM A,FILTMP(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
	HRRZ A,FILDEV(JFN)	;SEE IF THIS IS THE DISK
	CAIE A,DSKDTB		;...
	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 ENDSTR		; Terminate string, get lookup pointer
	PUSH P,FILOPT(JFN)	; Save filopt(jfn) for typing out tail
	HRRZ B,FILDEV(JFN)	;SEE IF THIS IS A DISK
	CAIE B,DSKDTB		;IF NOT, DONT CALL DIRLKX
;**;[3195]  Change 1 line at RECDI1:+4			DML	9-Jan-85
	JRST RECDI3		;[3195] NOT A DISK
	LOAD B,FILUC,(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?
;**;[3195]  Change 1 line at RECDI1:+10			DML	9-Jan-85
		JRST RECDI3	;[3195] YES. TREAT AS IF AMBIGUOUS THEN
		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,FILDIR,(JFN)	;STORE IT IN THE JFN BLOCK
	OKINT			;UNLOCK FROM ENDTMP
	POP P,B
	TQNN <NREC>		;WANT RECOGNITION?
	JRST [	CALL TSTRQ	;YES. TYPE OUT REST OF NAME
		CALL BRKOUT	;OUTPUT THE PUNCTUAUTION
		JRST .+1]	;AND GO FINISH UP
	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
;**;[3195]  Change 1 line at RECDI2:+1			DML	9-Jan-85
RECDI3:	POP P,B			;[3195]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 [	JUMPN A,R	;IF ERROR, RETURN NOW
		MOVEI A,GJFX19	;IF NO ERROR, STEP LOGICAL NAME
		JRST STEPLN]
	 CALLRET DING
	RETSKP

RECEXX:	CALL ENDSTR		; Terminate string, get lookup pointer
	PUSH P,FILOPT(JFN)	; Save filopt(jfn) for typing out tail
	CALL EXTLUK		; Lookup extension
	 JRST [	POP P,FILOPT(JFN)
		TQNE <OLDNF>	;IF OLD FILE DESIRED,
		JRST RFALSE	;GO STEP LOGICAL NAME
		TQNE <NREC>	;DOING RECOGNITION?
		RETBAD		;NO, GO RETURN THE ERROR
		RETSKP]		; RETURN AMBIG
	 JRST [	POP P,FILOPT(JFN)
		RETSKP]		; Ambiguous
	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
;**;[6701]  Replace 1 line with 2 at RECXX1:-9		DML	27-Feb-85
	CALL TSTRQC		;[6701] (B) Yes, output tail
	 RETBAD()		;[6701] 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
	AOS 0(P)		;GIVE DOUBLE SKIP RETURN
	RETSKP
RECEX0:	MOVE C,FILCNT(JFN)
	CAME C,CNTWRD(TXT)
	JRST RECEX1		;HAVE PARTIAL STRING, GO RECOGNIZE
	CALL DEFEXT		;TRY FOR DEFAULT VALUE FIRST
	 SKIPA
	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 [	JUMPN A,R	;IF ERROR, RETURN NOW
		MOVEI A,GJFX19	;EXTENSION NOT FOUND
		RET]
	 JRST DING
	RETSKP


; Recognize name
; This routine operates in the same way as recdir and recext above

RECNA0:	TQNN <DEVF>		;SEEN A DEVICE YET?
	JRST [	CALL DEFDEV	;NO, GO GET DEFAULTED DEVICE
		 SKIPA
		RETSKP		;DEVICE NAME WAS RECOGNIZED, STOP HERE
		JUMPE A,.+1	;IF NO ERRORS, GO DEFAULT IN NAME
		RETBAD ()]	;OTHERWISE, EXIT
	TQNN <DIRF>		;SEEN A DIRECTORY YET?
	JRST [	CALL DEFDIR	;NO, GO DEFAULT ONE
		 SKIPA
		RETSKP		;DIR WAS RECOGNIZED, STOP HERE
		JUMPE A,.+1	;IF NO ERRORS CONTINUE ON
		RETBAD ()]	;OTHERWISE EXIT
	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
	 JRST [	JUMPN A,R	;IF ERROR EXIT
		MOVE C,FILCNT(JFN)
		CAMN C,CNTWRD(TXT)
		CALL DEFNAM
		 SKIPA
		JRST .+1
		JUMPE A,DING	;IF NO ERRORS, RING THE BELL
		RETBAD ()]
	TQNN <NREC>		;DOING RECOGNITION?
	TQNE <NNAMF>
	RETSKP			;NO, DONT TYPE OUT "."
	CHOUT "."
	TQO <EXTFF>
	RETSKP
RECNAM:	CALL RECNA1
	 SKIPA
	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 ENDSTR		; Terminate string, get lookup pointer
	PUSH P,FILOPT(JFN)	; Save filopt(jfn) for typing tail
	CALL NAMLUK		; Lookup name in directory
	 JRST [	POP P,FILOPT(JFN)
		TQNN <OLDNF>	;NEW FILES ALLOWED?
		TQNE <NREC>	;AND TRYING TO RECOGNIZE?
		JRST STEPLN	;YES, GO STEP LOGICAL NAME
		JRST RFALSE]	;NO, RETURN AMBIG
	 JRST [	POP P,FILOPT(JFN)
		JRST RFALSE]	; Ambiguous
	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>
;**;[6704]  Change 1 line of edit 6701			DML	12-Mar-85
;**;[6701]  Replace 2 lines with 4 at RECPRE:-6		DML	27-Feb-85
	IFSKP.			;[6701] 
	  CALL TSTRQC		;[6704][6701] (B) Type remainder
	   RETBAD() 		;[6701] Error - invalid field length
	ENDIF.			;[6701] 
	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 ENDSTR		;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
	 ERJMP [MOVE A,LSTERR	;GET THE ERROR CODE
		RETBAD ()]
	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
   REPEAT 0,<			; Repeat zero historical code
DELALL:	TMSG </___
/>
	NOINT
	CALL RELJFX		; Release jfn (to clear free storage)
	CALL ASGJFN		; And reassign
	RETBAD (GJFX3,<OKINT>)	; Should not happen, but in case
	OKINT
	HRRZ F1,E
	XCTU [HLLZ F,0(F1)]
	MOVEI F1,0
	CALLRET SETTMP		; And start over
   >				; End of REPEAT ZERO historical code


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:	TQNN <STARF>
	JRST ENDLZ1
	CALL [	TQNE <DIRFF> ;COLLECTING DIRECTORY?
		JRST [	CALL ENDDIR ;YES. GO FINISH IT UP
			 RET	 	;FAILED
			TQNN <NREC> ;DOING RECOGNITION?
			CALL BRKOUT ;YES. OUTPUT TERMINATOR
			RETSKP]	  ;DONE
		TQNN <NAMF>
		CALLRET ENDNA3
		CALLRET ENDEX8]
	 JRST [	JUMPL A,GTJFST	; IF <0, LN WAS STEPPED
		JRST ERRDO]	; ELSE, NO STEP
ENDLZ1:	MOVE C,FILCNT(JFN)
	TQNN <DIRFF>		;COLLECTING A DIRECTORY?
	CAME C,CNTWRD(TXT)	; Is input string NON-null?
	JRST [	TQNN <NREC>	;YES. DOING RECOGNITION?
		TXNN F1,STRSF!DIRSF!NAMSF!EXTSF!VERSF ;YES. SEEN A STAR?
		SKIPA		;NO. GO DO LOOKUP
		CALL [	TQNE <EXTF> ;GOT EXTENTION FIELD YET?
			RET	;YES, RECOGNITION AFTER EXT IS OK
			CALL DING ;NO, RETURN AMBIGUOUS
			MOVEI A,0
			RETSKP]
		CALL RECFL0
		 SKIPA
		JRST .+1	; FOUND ONE
		JUMPE A,GTJF2	; AMBIGUOUS
		JUMPG A,ERRDO	; ERROR
		TQNE <ASTF>	; PARSE ONLY?
		JRST ENDAL4	; YES, CONTINUE
		JRST GTJFST]	; RETRY - LOGICAL NAME WAS STEPPED
	MOVE C,FLAGS(TXT)	;SEE IF GETTING AN ATTRIBUTE
	TXNE C,ARBATF		;...
	JRST [	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
	TQNE <NAMF,NNAMF>	; Do we have a name?
	JRST ENDAL0		; Yes.
	CALL DEFNAM		; No, try the default name
	 JRST [	JUMPL A,GTJFST	; LN WAS STEPPED, GO RETRY
		JUMPG A,ERRDO	; ERROR OCCURED
		CALL RECNAM	; NO DEFAULT, SEE IF A NO-NAME DEVICE
		 SKIPA
		JRST ENDAL0	; YES, THEN THROUGH WITH GTJFN JSYS
		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
ENDAL0:	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
	TQNN <VERF>		; Do we have a version?
	JRST [	CALL DEFVER	; No, default it
		 SKIPA		; ERROR
		JRST .+1	;FOUND A VERSION NUMBER
		JUMPGE A,ERRDO	;ERROR
		CALL STOALT	;LN WAS STEPPED, PUT ALTMODE BACK IF NEEDED
		 JRST ERRDO	;ERROR ENCOUNTERED
		JRST GTJFST]	;GO REPROCESS THE COMMAND
	TQNN <NEWF,NEWVF>
	JRST [	TQNN <ASTF>	; Parse only?
		JRST ENDAL7	; No, Continue...
		JRST .+1]	; Yes, check fields to insert
	TQNN <PRTF>		; Do we have protection?
	JRST [	CALL DEFPRT	; No, default it
		 JRST ERRDO
		JRST .+1]
	TQNN <ACTF>		; Do we have an account?
	JRST [	CALL DEFACT	; No, default it
		 JRST ERRDO
		JRST .+1]
ENDAL7:	CALL DEFATR		;GET SET UP ANY DESIRED ATTRIBUTES
	 JRST ERRDO		;FAILED
REPEAT 0,<	TQNE <RTYPF>	; User request retyping name?
	JRST [	TMSG1 </
/>
		SETZ C,		; USE DEFAULT FLAGS
		HRRZ A,E
		XCTU [HRRZ A,1(A)] ;OUTPUT JFN
		TLNE E,777777
		TLNE E,2
		CAIN A,377777	;NULL?
		JRST .+1	;MUST BE A NOOP
		CALL JFNSM	;PRINT THE FILE NAME
		 JFCL
		JRST .+1]>	;ALL DONE
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?
	JRST [	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
;**;[3013] Replace 2 lines with 1 line @ENDAL-2/<tab>+10  JMP Sep 12,83
		CALL RETYPE	;[3013] RE-TYPE THE EDITED LINE
		JRST MRTEXT]	;AND GO GET SOME MORE INPUT
	ERRLJF GJFX15		; Improper confirmation
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
	TQNN <ACTF>		; Do we have an account string?
	JRST [	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]
	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,NLUKD(E)		;SEE IF REAL DISK FILE
	POP P,E			;RESTORE E
	CAIN A,MDDNAM		;...
	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
	SKIPLE B,FILPRT(JFN)
	CALL RELFRE		; And protection
	SETZM FILPRT(JFN)	; AND PROTECTION WORD
ENDLS1:	HRRZ B,FILTMP(JFN)
	SKIPE B
	CALL RELFRE		; And temp
	HLRZ B,FILTMP(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)
	OKINT
	CALL INFTST
	 JRST ENDL55		;NO INPUT FILE
	POP P,B			;GET ORIGINAL JFN MODE WORD
	SFMOD			;SET IT BACK
	POP P,C
	POP P,B
	SFCOC
ENDL55:	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
	TQNN <IGIVF>
	 TXO JFN,GJ%GIV		; Not seeing invisible files
ENDA51:	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			; ""
	HRRZ A,NLUKD(NUM)	;MAKE SURE THIS FILE HAS A REAL FDB
	CAIE A,MDDNAM		;DOES IT?
	JRST ENDL58		;NO. RETURN NOW
	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?
	SKIPA			; NO
	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
	 SKIPA			;NO
	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
	 JRST [	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
	 JRST [	CALL DING
		JRST GTJF2]
	JRST ENDAL4

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
	TQNN <ASTF>		;* ALREADY SEEN?
	TQNE <ASTAF>
	SKIPA A,FILCNT(JFN)	;ALLOW IT
	RETBAD (GJFX31)		; Illegal *
	MOVE B,CNTWRD(TXT)	;GET MAX VALUE
	CAIN A,-1(B)		; HAVE SOMETHING ALREADY?
	TQNE <STARF>		; ALREADY SEENA STAR?
	JRST [	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
		JRST .+1]	;PROCEED
STAR2:	TQNE <OSTRF>
	TQO <ASTF>		; Set * bit in sts
	TQO <STARF>
	RETSKP

QUEST:	TQNE <NUMFF>		; FOR WILD CHARS. ON A NUMBER?
	RETBAD (GJFX4)		; YES. ILLEGAL CHARACTER THEN
	CALL DPST		; SAVE BYTE
	 RETBAD()		; NO ROOM
	TQNN <ASTF>		;* ALREADY SEEN?
	TQNE <ASTAF>		; STARS ALLOWED?
	SKIPA			;ALLOW IT
	RETBAD (GJFX31)		; NO. GIVE BAD RETURN
	MOVX A,WLDF		; FOR FLAGS
	IORM A,FLAGS(TXT)	;REMEMBER WILD CHAR SEEN
	CALLRET STAR2		; GO DO THE * STUFF

; 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
	 SKIPA			;NO
	JRST SETTM2		;YES
	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
SETTM2:	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?
	SOSG CURCNT(TXT)	;YES. WILL THIS ONE FIT?
	RETBAD (GJFX51)		;NO. TELL HIM
	ANDI A,177		;USE ONLY 7-BIT ASCII
	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
; 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
	HRRZ A,FORKN		; Get fork number
	HRLZM A,FILVER(JFN)
	SETZM FILTMP(JFN)
	SETZM FILDDN(JFN)
	SETZM FILNEN(JFN)
	SETZM FILACT(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 FILDIR,(JFN)	; ZERO POINTER TO DIR STRING
	SETZRO FILATL,(JFN)
	SETOM FILLCK(JFN)
ASGJF4:	UNLOCK JFNLCK
	OKINT
	RET
; Release jfn
; Call:	IN JFN, JFN
;	CALL RELJFN
; Clobbers a,b,c,d

RELJFN::CALL RELMT		;SEE IF NEED TO CLEAN UP MT DATA BASE
RELJFX:	NOINT
	LOCK JFNLCK
	SKIPN A,FILSTS(JFN)
	JRST RELJF4		; Already released
	TXNE A,ASGF		;WAS THIS JFN 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
	HRRZ B,FILDEV(JFN)	;SEE IF THIS FILE WAS ACTUALLY OPENED
	TLNN C,(DV%IN)		;IF AN INPUT DEVICE, DONT SEND MESSAGE
	CAIE B,DSKDTB		;IF IT IS DSK, IT WAS OPENED
	JRST RELJF0		;NOT OPENED, DONT SEND MESSAGE
	CALL GETFDB		;GET THE FDB MAPPED
	 JRST RELJF0		;FOULED UP, DONT SEND MESSAGE
	SE1CAL
	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(NOSPLM)
RELJF0:	CALL RELJF3		;RELEASE COMMON STUFF
	TXNN B,TRNSF		;A TRANSITIONAL FILE?
	TXNN B,ASGF		;WAS THIS BEING CREATED?
	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
	HLRZ B,FILDDN(JFN)
	SKIPE B
	CALL RELFRE		; Release device string block
	LOAD B,FILDIR,(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,FILDMS,(JFN)	; GET DIR WILD MASK
	SKIPE B			; HAVE ONE?
	CALL RELFRE		; YES. RELEASE IT
	LOAD B,FILNMS,(JFN)	; NAME WILD MASK
	SKIPE B			; HAVE ONE?
	CALL RELFRE		; YES. RELEASE IT
	LOAD B,FILEMS,(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,FILDMS,(JFN)	; CLEAR DIR WILD MASK
	STOR B,FILNMS,(JFN)	; CLEAR NAME WILD MASK
	STOR B,FILEMS,(JFN)	; CLEAR EXTENSION WILD MASK
	CALL RELATR		; GO RELEASE ATTRIBUTE LIST
	MOVEI A,JSBFRE
	MOVE B,FILSTS(JFN)
	TXNN B,ASGF		; Was this jfn being assigned?
	JRST [	SETZM FILLFW(JFN) ;NO. ZAP THIS WORD
		TXNE B,ASTF	;SCAN ONLY?
		JRST RELJF1	;YES. CHECK FOR PROTECTION
		JRST RELJF2]	;GO FINISH UP
	HRRZ B,FILTMP(JFN)
	SKIPE B
	CALL RELFRE		; Release temp block
	HLRZ B,FILTMP(JFN)	; RELEASE OTHER TEMP BLOCK
	SKIPE B			; IF ANY
	CALL RELFRE
	SETZM FILTMP(JFN)	; CLEAR OUT POINTER TO WORD
RELJF1:	SKIPLE B,FILPRT(JFN)	;HAVE A PROTECTION STRING?
	CALL RELFRE		; Release space for protection block
RELJF2:	SETZM FILDDN(JFN)
	SETZM FILNEN(JFN)
	SETZM FILPRT(JFN)
	SETZM FILACT(JFN)
	HLLZS FILIDX(JFN)
	SETZM FILFDB(JFN)	;CLEAR FDB ADDRESS WORD
	SETZRO FILDIR,(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,FILATL,(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,FILATL,(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 ENDSTR
; 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

ENDSTR::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
;**;[6701]  Add comments for edit 6701			DML	27-Feb-85
; 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.
;
;Both return:	+1:	Error - field is too long (G1%NLN is in effect)
;		+2:	Success

;**;[6704]  Delete 5 lines of edit 6701			DML	12-Mar-85
;**;[6701]  Add 9 lines before TSTRQ:+0			DML	27-Feb-85
TSTRQC:	CALL LENOK 		;[6701] (/A) Check on length of field
	 RETBAD()		;[6701] Invalid length - return error
	CALL TSTRQ		;[6701] (B) Length is ok - complete field
	RETSKP			;[6701] 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
	RET
;**;[6701]  Add 47 lines after TSTR1:+8			DML	27-Feb-85
;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.

;**;[6708]  Change 2 lines of edit 6704			DML	13-Mar-85
;**;[6704]  Replace 9 lines with 8 in edit 6701		DML	12-Mar-85
LENOK:	CALL TSTLNG		;[6704][6701] Are long names allowed?
	IFSKP.			;[6704][6701] Yes
	  RETSKP		;[6704][6701] Nothing more to do then
	ENDIF.			;[6704][6701] 
	HLRZ C,FILNEN(JFN)	;[6708][6704] Get the pointer to the file name
	TQNE <EXTF>		;[6704] Parsing an extension?
	HRRZ C,FILNEN(JFN)	;[6708][6704] Get the pointer to extension
	HRLI C,(<POINT 7,0,34>) ;[6704] Point to the first character
	SETZM D			;[6701] No, we must check the field length
	DO.			;[6701] 
       	  ILDB A,C		;[6701] Get a character
	  JUMPE A,LENOK1	;[6701] No more to get
	  AOS D			;[6701] Count the character
	  JRST TOP.		;[6701] Get another one
	ENDDO.			;[6701] 
LENOK1:	MOVEI C,MAXSHT		;[6701] Get max size for a name
	MOVEI A,GJFX41		;[6701] Get correct error code
	TQNN <EXTF>		;[6701] Parsing an extension?
	IFSKP.			;[6701] Yes
	  MOVEI C,MAXEXT	;[6701] Use max size of an extension then
	  MOVEI A,GJFX42	;[6701] And get correct error code
	ENDIF.			;[6701] 
       	CAMLE D,C          	;[6701] Are we over the limit?
	RET			;[6701] Yes, return the error code
	RETSKP			;[6701] 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
	RET

INFTST:	HRRZ A,E
	XCTU [HLRZ A,1(A)]
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	RET
	RETSKP

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
	RET
	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 INFTST
	 JRST ERRDO1		;ALL DONE
	MOVE D,0(P)		;ERROR CODE
	MOVE P,MPP
	ADD P,BHC+3		;POINT TO SAVED WORDS
	POP P,B			;RECOVER SAVED MODES
	SFMOD
	POP P,C
	POP P,B
	SFCOC
	SKIPA A,D		;SET UP ERROR
ERRDO1:	POP P,A			;ERROR CODE
	RETERR ()		;AND GO TO ERROR EXIT
;THESE ROUITNES ARE USED BY THE RDTXT FACILITIES IN GTJFN

BACKIT:	MOVE A,CURPNT(TXT)	;TAIL POINTER
	BKJFN			;MOVE OVER RECOGNITION CHARACYER
	 JFCL
	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
; 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
	STKVAR <OFILUC>		; OLD STR UNIQUE CODE
	HRRZ JFN,1
	CALL CHKJFN
	 RETERR()
	 JFCL
	 RETERR(DESX4)
	TQNE <ASTF>
	ERUNLK(DESX7)		; Output stars not allowed
	TQNE <OPNF>
	ERUNLK(OPNX1)
	LOAD Q1,FILUC,(JFN)	;GET STRUCTURE UNIQUE CODE AT START
	MOVEM Q1,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
	TXNE F1,NAMSF		;WANT TO STEP THE NAME?
	JRST [	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
		JRST .+1]	;AND DONE
	TXNE F1,EXTSF		;WANT TO STEP THE EXTENSION?
	JRST [	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
		JRST .+1]	;DONE
	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
	CALL UNLCKF		;DO UNLOCK
GNJFN1:	SETZM FILTMP(JFN)
	SETZM FILPRT(JFN)
	SETZM FILOPT(JFN)
	TQO <STEPF>
	TQO <IGIVF>		; Make sure we see invisible files
	UMOVE A,1		; GET USER FLAGS
;**;[6731]  Remove edit 6713				DML	25-Jun-85
;**;[6713]  Replace 1 line with 3 at GNJFN1:+6		DML	28-Mar-85
	MOVX F,IGDLF+OLDNF	;[6731] Assume Ignore Deleted + Old Files only
	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
	SKIPA A,[GNJFX1]	;WILL FAIL, GIVE PROPER RETURN
	CALL VERLUK
	 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
	HRRZ A,DEV
	HRRZ A,NLUKD(A)
	CAIE A,MDDNAM
	 JRST [	SETZ A,
		JRST GNJFN2]	; Not fdb for non-mdd devices
	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
	 JRST [	TLNN B,(1B13)
		TXNE A,FB%DEL
		 JRST GNJFN1
		JRST .+1]
	TXNE B,GJ%GIV		; Ignore fact file invisible?
	TXNN A,FB%INV		; No, is it invisible?
	 CAIA			; 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 Q2,FILUC,(JFN)	;GET THE CURRENT STRUCTURE UNIQUE CODE
	MOVE A,Q2		;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 Q2,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:	CALL UNLCKF		;RELEASE JFN AND STR LOCK
	SETZ A,
	CAME Q1,Q2		;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

	TNXEND
	END