;<FOONEX>GTJSMX.MAC;2 15-Apr-81 16:13:50, Edit by MMCM
; Correct XCTUU's to XCTBU on byte instructions (same on KI, diff on F2)
;<FOONEX>GTJSMX.MAC;1 18-Mar-81 21:50:14, Edit by MMCM
;<MON>GTJSMX.MAC;1		2/26/80			EDIT BY RINDFLEISCH
; Code for SUMEX changes to GTJFN

; GTJFN assembly continues here...

; Indices into extended long GTJFN table (LLTBF flag on in long call)
EXTWD=11	; LH = ctl bits,,RH = # words following
TPPTR=12	; Typescript string pointer
TPCNT=13	; Max typescript characters
PRPTR=14	; Prompt string pointer


; A "retype" buffer is allocated in the JSB free space to hold additional
; control words (first 5 entries) and a typescript of the user's input
; text.  Following are symbols relating to its contents

; Retype buffer size parameters
MAXRW==:^D30+BLKDT	; Retype buffer size in words
MAXRC==:<5*<MAXRW-BLKDT>-1>	; Retype buffer size in characters

; Indices into retype buffer locations
BLKBP=1		; Retype bfr indx - current byte ptr
BLKCT=2		; Retype bfr indx - retype char count remaining
BLKFG=3		; Retype bfr indx - retype/user flags
USRBP=4		; Retype bfr indx - current user typescript ptr
USRCT=5		; Retype bfr indx - user typescript buffer size
BLKDT=6		; Retype bfr indx - first input text word

; Flags used in the retype buffer word BLKFG
; LEFT HALF
LITRF=400000		; Do literal retype of what has been entered
DEVRF=200000		; Non-std default Device - not in retype buffer
DIRRF=100000		; Non-std default Directory - not in retype buffer
USRTY=040000		; User requested copy of typescript (long GTJFN)
USRPR=020000		; User supplied prompt for insertion in retype

; RIGHT HALF (Fetched and returned to LH of extended table word 11)

BRDEL=400000		; On means break if try to delete past input start
MAX6F=100000		; On means names le 6 and ext le 3 chars (not imp)
TPCNF=040000		; On means return confirmation message with typescript
FNNAM=020000		; File is on a no name device
FNVER=010000		; File has a name but no version numbers
FNEWF=004000		; File is new
FNEWV=002000		; File is a new version

; Flags used in DECBUF routine (returned in LH of decremented char)
CTVCHR=400000		; Deleted char was quoted
FILTDN=200000		; FILTMP was empty when deleting this char

NDIG=6			; Max number of digits in prot and acct


; This routine performs a comparison between an input string and a
; "library" string.  Case is ignored ("Ab" = "aB).  The input string
; may contain the characters "*" and "%" as "wild cards".
; "*" means match anything up to the next non-wild card input character.
; "%" means match any one character in the next input slot.
; All strings are ASCIZ.  ^V quotes any input character.
;
;  For example, given the library string "ABCDEFG",
;
;	"ABC*"		would match
;	"%ABC*"		would not match
;	"%B%DE*"	would match
;
;  On entry:
;	AC 1  =	string pointer to input
;	   2  =	string pointer to library
;
;  Returns:
;	+1  No match
;	+2  Wild card match
;
;  Clobbers A,B,C,D

WCNOW=1B0	;on means the last character was a *
INPDN=1B1	;on means the input string is exhausted
LIBDN=1B2	;on means the library string is exhausted

WCCMP::	PUSH	P,STS			;SAVE AC
	PUSH	P,[0]			;INPUT PTR AFTER *
	PUSH	P,[0]			;LIBRARY PTR AFTER *
	SETZ	STS,			;CLEAR STATUS

;  Get an input string char
WCCMP0:	ILDB	C,A			;GET THE NEXT INPUT CHAR
	JUMPE C,[TLO STS,(INPDN)	;IF 0, SET INPUT DONE FLAG
		 TLNN STS,(WCNOW)	;LAST CHAR A *?
		  JRST WCCMP1		;NO, CHECK LIBRARY STRING
		 TLO STS,(LIBDN)	;YES, FAKE LIBRARY DONE TOO
		 JRST WCCMP3]		;AND QUIT
	CAIN	C,"*"			;UNLIMITED WILD CARD?
	 JRST	[TLO STS,(WCNOW)	;YES, SET FLAG
		 MOVEM A,-1(P)		;SAVE INPUT PTR
		 MOVEM B,0(P)		;SAVE LIBRARY PTR
		 JRST WCCMP0]		;GO TRY FOR MORE INPUT
	CAIN	C,"%"			;SINGLE WILD CHARACTER?
	 JRST	[ILDB D,B		;GET ANY NEXT CHAR
		 JUMPN D,WCCMP0		;IF NOT END, MOVE ON
		 TLO STS,(LIBDN)	;LIBRARY DONE
		 JRST WCCMP3]		;WRAP IT UP
	CAIN	C,<"V"-100>		;QUOTED CHAR?
	 JRST	[ILDB C,A		;YES, GET NEXT ONE WHATEVER
		 JUMPN C,WCCMP1		;IF NON-0, LOOK AT LIBRARY
		 TLO STS,(INPDN)	;INPUT DONE, SET BIT
		 JRST WCCMP1]		;AND CONTINUE

; Get a library string char
WCCMP1:	ILDB	D,B			;FETCH THE NEXT LIBRARY CHAR
	JUMPE D,[TLO STS,(LIBDN)	;IF END OF LIBRARY, FLAG IT
		 JRST WCCMP3]		;AND TALLY RESULTS
	CAME	C,D			;OK, DOES INP CHAR MATCH LIB CHAR?
	 JRST	WCCMP2			;NO, SEE ABOUT USING WILD CHAR
	TLZ	STS,(WCNOW)		;TURN OFF RECENT WILD CARD BIT
	JRST	WCCMP0			;TRY NEXT INPUT CHAR

;  Here a mismatch was found.  Check to see if we should quit or search
;  further, using any wild cards to span the mismatch.
WCCMP2:	SKIPN 	A,-1(P)			;PREVIOUS *?
	 JRST 	WCCMP3			;NO, QUIT
	IBP 	0(P)			;YES, BUMP LIB PTR TO SPAN MISMATCH
	MOVE 	B,0(P)			;AND RECOVER IT
	TLZ 	STS,(INPDN!LIBDN)	;CLEAR END OF INPUT FLAGS
	JRST 	WCCMP0			;AND TRY AGAIN

;  Here we have either a match or done everything possible to find one.
;  Tally up the results and compute the proper skip return.
WCCMP3:	SUB	P,[2,,2]		;RESET STACK
	MOVE	C,STS			;SAVE STATUS
	POP	P,STS
	TLNE	C,(INPDN)		;DID WE FINISH THE INPUT?
	TLNN	C,(LIBDN)		;AND THE LIBRARY?
	 POPJ	P,			;NO, RETURN +1
	AOS	0(P)			;YES, RETURN +2
	POPJ	P,


; Routine to locate a file version with acceptable access privileges
; Entry:   A = desired version number
;          JFN, F, F1, DEV, and STS are set up appropriately
; Return:  +1 - Error, no accessible file found
;          +2 - Success, A = version number, B = FDB ctl bits
;
; Access check:
;   IF NEW file or version,
;      ability to create it checked elsewhere, accept it
;   IF OLD file,
;      IF NAMSF = TRUE (wild card name), require PT access on in protection
;      IF NAMSF = FALSE (specific name)
;         IF Login or Connected directory, always allow access
;         IF any other directory, require some access bit on in
;	     appropriate group/other field

GTVER:	HRRZ B,NLUKD(DEV)	; Is this a multi directory device?
	CAIN B,MDDNAM
	 JRST GTVER1		; Yes
	PUSHJ P,VERLUK		; No, don't bother leaving it locked
	 POPJ P,		; Couldn't find it - return +1
	SETZ B,			; Got it, clear ctl bits
GTVER0:	TEST(O,VERF,VERTF)	; Show version found
	HRRM A,FILVER(JFN)	; Install version
	JRST SKPRET		; And return +2

GTVER1:	PUSHJ P,VERLKX		; Lookup requested version - return FDB
	 POPJ P,		; Couldn't get one - return +1
	TEST(NE,ASTF)		; If output stars, nothing really done
	 JRST GTVER0		; Save the version and return
	PUSH P,FDBCTL(A)	; Got one, save the FDB ctl bits
	PUSH P,FDBVER(A)	; And save the version number
	TEST(NE,NEWF,NEWVF)	; New file or version?
	 JRST GTVER2		; Yes, just take it
	HRLI A,-1		; No, do access check
	PUSHJ P,ACCCHK
	 JRST GTVER3		; Bad news, see if we can try another

GTVER2:	TEST(O,VERF,VERTF)	; Show version found and typed
	POP P,A			; Recover version number
	POP P,B			; Recover FDB ctl bits
	HLRZS A
	HRRM A,FILVER(JFN)	; And install it
	PUSHJ P,USTDIR		; OK, release the directory
	JRST SKPRET		; And return +2

GTVER3:	PUSHJ P,USTDIR		; Invalid access, release directory
	POP P,A			; recover this version number
	HLRZS A
	SUB P,[1,,1]		; And clear ctl bits from stack
	TLNN F1,DIRSF!NAMSF!EXTSF!VERSF	; Stepping anything?

	 POPJ P,		; No, return +1
	TEST(O,STEPF)		; Yes, step to the next file
	TEST(NE,RVERF)		; after installing right target version
	 MOVEI A,0
	TEST(NE,HVERF)
	 MOVEI A,-1
	TEST(NE,LVERF)
	 MOVEI A,-2
	JRST GTVER		; Now go try it


; Initiate a rescan of the user's input (from the retype buffer).  The
; JFN block is initialized and a flag is set so the input scanner begins
; looking at the retype buffer as input.
; Entry:   File name strings in process of being collected
; Call:    PUSHJ P,RESCAN
; Return:  +1 always, JFN reinited, RSCNF set

RESCAN:	NOINT
	HRRZ A,FILEXW(JFN)	; Preserve retype buffer info
	PUSH P,A
	HLLZS FILEXW(JFN)	; Now make believe it isn't there
	PUSHJ P,RELJFN		; Go clean up
	PUSHJ P,ASGJFN		; Go get another
	 JRST   [MOVEI A,JSBFRE	; Oops, no more left
		 POP P,B	; Release retype buffer
		 SKIPE B
		 PUSHJ P,RELFRE
		 ERR(GJFX3)]	; And bomb out
	POP P,FILEXW(JFN)	; Set up old retype stuff
	OKINT			; Interrupts again
	XCTUU [HLLZ F,0(E)]	; Fetch his flags again
	MOVEI F1,0		; And clear others
	TEST(NN,TMPFF)		; Temp file specified?
	 TEST(O, SCRF)		; No, then try for normal versions
	CHRTP(0)		; Better be sure retype terminated
	TEST(O,RSCNF)		; Turn for rescan of input
	PUSHJ P,SETRTP		; Reinit retype buffer pointers
	JRST SETTMP		; Get another temp block and continue


; Delete chars from the input buffers until FILTMP is empty.
; Entry:   Input string in FILTMP and RETYPE
; Call:	   PUSHJ P,CNTFLD
; Return:  +1 always, D = Count of chars backspaced (to start of field)
;          Retype and typescript ptrs point to the start of this field.
; Clobbers A,B,C,D

CNTFLD:	PUSH P,[0]		; Create a temporary counter
CNTFL0:	PUSHJ P,DECBUF		; Decrement the buffer once
	 JRST CNTFL1		; OK, no more chars anywhere
	AOS 0(P)		; Got rid of one char, note it
	TLNN A,FILTDN		; FILTMP empty?
	 JRST CNTFL0		; No, do another one
CNTFL1:	POP P,D			; Get count of chars backspaced
	POPJ P,


; Routine to decrement a 7 bit byte pointer.
; Entry:   A contains the byte ptr
; Call:	   PUSHJ P,DECBP
; Return:  +1 always, updated byte ptr in A

DECBP:	ADD A,[070000,,0]	; Back up
	TLNE A,(1B0)		; Overflow?
	 SUB A,[430000,,1]	; Yes, fix it up
	POPJ P,


; Routine to decrement input buffers 1 effective character position.
; The buffers affected include:
;    Retype buffer	ptr in FILEXW(JFN)
;    User typescript	ptr in retype buffer block (if any)

;    Temporary block	ptr in FILTMP(JFN)
; Entry:   Input string being collected
; Call:	   PUSHJ P,DECBUF
; Returns  +1  Nothing more to delete
;	   +2  One character accounted for -
;		RH(A) = character deleted
;		LH(A) = flags
;   		   CTVCHR  Char quoted (preceeded by an odd number of ^V's)
;   		   FILTDN  FILTMP was empty before this char deleted
; If FILTMP was empty on entry, RSCNF is set
; Clobbers A,B,C,D

DECBUF:	HRRZ D,FILEXW(JFN)	; Get retype buffer
	SKIPG D
	 POPJ P,		; Oops, none there.
	MOVEI C,MAXRC		; Compute chars in retype buffer
	SUB C,BLKCT(D)
	SKIPG C			; Anything there?
	 POPJ P,		; No, tell him all clear at +1
	AOS 0(P)		; Got at least one, return +2

; First do the retype buffer
	MOVE A,BLKBP(D)		; ptr to current char in retype
	SETZ B,			; Counter for ^V's
DECBF0:	SOJLE C,DECBF1		; If no PRECEEDING chars, move on
	PUSHJ P,DECBP		; Have one, decrement byte ptr
	LDB D,A			; What is it?
	CAIE D,<"V"-100>	; ^V?
	 JRST DECBF1		; No, quit looking
	AOJA B,DECBF0		; Yes, count it and look for more

DECBF1:	HRRZ D,FILEXW(JFN)	; Restore retype ptr
	MOVE A,BLKBP(D)		; Get current byte ptr
	LDB C,A			; And the character
	TRNE B,1		; Odd number of ^V's?
	 TLO C,CTVCHR		; Yes, add flag
	PUSHJ P,DECBP		; Back up one for real
	AOS BLKCT(D)
	JUMPL C,   [PUSHJ P,DECBP	; ^V, need one more
		    AOS BLKCT(D)
		    JRST .+1]
	MOVEM A,BLKBP(D)	; Update it permanently

; Now do the user typescript
	MOVE A,BLKFG(D)		; Get flags
	TLNN A,USRTY		; Typescript active?
	 JRST DECBF2		; No, just do temp block
	MOVE A,USRBP(D)		; Get user's byte ptr
	PUSH P,C		; Save coded character
	PUSHJ P,DBP		; Do general decrement - may not be 7 bit
	AOS USRCT(D)		; And his count
	SKIPG 0(P)		; ^V too?
	 JRST   [PUSHJ P,DBP	; Yes
		 AOS USRCT(D)

		 JRST .+1]
	MOVEM A,USRBP(D)	; Save it for later
	POP P,C			; And recover the character

; Finally do the temporary block
DECBF2:	MOVE A,FILCNT(JFN)	; Get count remaining
	CAIL A,MAXLC		; Anything in the buffer?
	 JRST   [TLO C,FILTDN	; Show FILTMP was empty
		 JRST DECBF3]
	MOVE A,FILOPT(JFN)	; Get the current byte ptr
	PUSHJ P,DECBP		; Decrement it
	MOVEM A,FILOPT(JFN)	; And return it
	AOS FILCNT(JFN)		; Bump the count
	TEST(NN,NUMFF)		; Entering a number?
	 JRST DECBF3		; No, carry on
	MOVE A,NUM		; Yes, decrement it
	MOVEI B,^D8		; Octal for now
	TEST(NN,OCTF)		; Really decimal?
	 MOVEI B,^D10		; Yes
	IDIV A,B		; Reduce the number
	MOVE NUM,A		; And return the new value

; Done, return char and flags in A
DECBF3:	MOVE A,C		; All done - put "deleted" char in A
	POPJ P,


; Routines to handle user question mark input.  Entered from input char
; dispatch table.  If the input is non-TTY or output NIL, returns
; immediately.  Otherwise, list the candidates for the field currently
; being entered if no previous field had a wild card.  If no candidates
; are found, break with an error.  Scan for candidates is terminated on
; last one or on any input from the user.


QUEST:	HRRZ B,FILEXW(JFN)	; Save the retype buffer status
	MOVE A,BLKCT(B)		; Anything typed yet?
	CAIL A,MAXRC
	 ERRLJF GJFX34		; No, then break on "?"
	MOVE A,BLKFG(B)		; Get user flags
	TLNN A,USRTY		; User typescript?
	 JRST QUEPSH		; No, just go save retype context
	XCTUU [MOVE A,TPPTR(E)]	; Yes, get his real typescript data and
	PUSH P,A		; Save it for later
	XCTUU [MOVE A,TPCNT(E)]
	PUSH P,A
QUEPSH:	PUSH P,BLKBP(B)		; Save retype bfr stuff
	PUSH P,BLKCT(B)
	PUSH P,BLKFG(B)
	PUSH P,USRBP(B)
	PUSH P,USRCT(B)
	PUSHJ P,GSIBE		; Check for anything in input (OR NON-TTY)
	 JRST QUEST2		; Oops, wants us back
	XCTUU [HRRZ A,1(E)]	; Check for output JFN
	TLNE E,777777
	TLNE E,2
	CAIN A,377777
	 JRST QUEST2		; Can't do it
	TEST(NN,DEVF)		; Device specified?
	 PUSHJ P,DEFDEV		; No, get a default
	MOVE B,DLUKD(DEV)	; Has to be multi dir
	CAIE B,MDDDIR
	 JRST QUEST2		; Oops, ding him and restart
	MOVE B,[BYTE (2)0,0,0,0,0,0,0,2,0,0,2,0,0,2,0,0,0,0]  ; Set TTY COCs
	MOVE C,[BYTE (2)0,0,0,0,0,0,0,0,0,0,0,0,0,2]
	PUSHJ P,SFCC		; Output CRLF, EOL, and bells
	TEST(O,NREC)		; Suppress other printout
;;;	MOVEI A,"?"		; Fix user's typescript in case error
;;;	PUSHJ P,USRCH		; Show he typed ?
	PUSHJ P,TRMUTP		; Terminate it
	HRRZ A,FILEXW(JFN)	; And turn off more typescript for now
	MOVSI B,USRTY
	ANDCAM B,BLKFG(A)
	TEST(NE,DIRFF)		; Dispatch on entery state - directory?
	 JRST QDIR		; Yes
	TEST(NE,EXTFF)		; Extension?
	 JRST QEXT		; Yes
	TEST(NN,NAMF)		; Have a name?
	 JRST QNAM		; No, must be entering it
	TEST(NN,VERF)		; Have a version?
	 JRST QVER		; No, must be entering it

QUEST0:	PUSHJ P,GSIBE		; Anything typed?
	 SKIPA			; Yes, eat it
	JRST QUEST3		; No, just retype and return
QUEST1:	XCTUU [HRRZ A,1(E)]	; Something was typed to stop output
	CFOBF			; Clear output buffer
	XCTUU [HLRZ A,1(E)]	; Then point to input and
	RFMOD			; Break on everything so we can eat it
	PUSH P,B
	TRZ B,777700
	IORI B,174100
	SFMOD
	BIN			; Get the input and throw it away
	POP P,B			; Reset mode word
	SFMOD
QUEST2:	PUSHJ P,DING		; Can't help in any later fields
QUEST3:	HRRZ B,FILEXW(JFN)	; Restore retype buffer status
	POP P,USRCT(B)
	POP P,USRBP(B)
	POP P,BLKFG(B)
	POP P,BLKCT(B)
	POP P,BLKBP(B)
	MOVE A,BLKFG(B)		; Get user flags
	TLNN A,USRTY		; User typescript?
	 JRST QUEST4		; No, just go do the retype and rescan
	POP P,A			; Yes, recover his real typescript data
	XCTUU [MOVEM A,TPCNT(E)]  ; and restore it in his block
	POP P,A
	XCTUU [MOVEM A,TPPTR(E)]
QUEST4:	PUSHJ P,RETYPE		; Go retype the input text
	JRST RESCAN		; And rescan to reinit processing


; Here we had a ? while entering a directory
QDIR:	PUSHJ P,QSDIR		; Append star and find first file
QDIR0:	PUSHJ P,GSIBE		; Any input?
	 JRST QUEST1		; Yes, retype and continue
	PUSHJ P,GDNAME		; Get the directory name
	 ERRLJF GJFX17		; Shouldn't happen
	HLRZ A,FILTMP(JFN)	; Print it on the next line
	PUSHJ P,QNXTL
	PUSHJ P,QVDIR0		; Now look for the next directory
	 JRST QUEST0		; None left, retype
	JRST QDIR0		; Go print it


; Here we had a ? while entering a name
QNAM:	TEST(NE,DIRSF)		; Any directory stars?
	 JRST QUEST2		; Yes, can't help him
	PUSHJ P,QSNAM		; Append star and find first file
QNAM0:	PUSHJ P,GSIBE		; Anything input?
	 JRST QUEST1		; Yes, quit
	HLRZ A,FILNEN(JFN)	; Print this name
	PUSHJ P,QNXTL
	PUSHJ P,QVNAM0		; Now look for the next name
	 JRST QUEST0		; None left, beep and retype
	JRST QNAM0		; go print it


; Here we had a ? while entering an extension
QEXT:	TEST(NE,DIRSF,NAMSF)	; Any directory or name stars?

	 JRST QUEST2		; Yes, can't help him
	PUSHJ P,QSEXT		; Append star and find first file
QEXT0:	PUSHJ P,GSIBE		; Anything input?
	 JRST QUEST1		; Yes, quit
	HRRZ A,FILNEN(JFN)	; Print this name
	MOVE B,1(A)		; Look at the first word of the string
	TLNE B,774000		; If it is not null (first char 0)
	 JRST QEXT1		; Print it as is
	MOVEI A,[ASCIZ / [Null]/]  ; Otherwise dummy an entry
	SUBI A,1		   ; Set up as string block
QEXT1:	PUSHJ P,QNXTL
	PUSHJ P,QVEXT0		; Now look for the next extension
	 JRST QUEST0		; None left, beep and retype
	JRST QEXT0		; go print it


; Here we had a ? while entering a version
QVER:	TLNE F1,DIRSF!NAMSF!EXTSF   ; Any dir, name, or ext stars?
	 JRST QUEST2		; Yes, can't help him
	PUSHJ P,QSVER		; Make it a star and find first file
QVER0:	PUSHJ P,GSIBE		; Anything input?
	 JRST QUEST1		; Yes, quit
	TMSG </
  />				; No, print this number
	HRRZ B,FILVER(JFN)
	PUSHJ P,DNOUT
	PUSHJ P,QVVER0		; Now look for the next version
	 JRST QUEST0		; None left, beep and retype
	JRST QVER0		; go print it


; Following are routines for stepping the Dir, Name, Ext, and Version
; fields and assuring that at least one file is accessible with the
; new field value.
; Return:  +1 if none is found
;	   +2 if successful

; Step directory field
QVDIR0:	TEST(O,DIRSF,STEPF)	; Step the current directory number
	HRRZ A,FILDDN(JFN)
	PUSHJ P,@DLUKD(DEV)
	 JFCL
	 POPJ P,		; No more, return +1
	HRRM A,FILDDN(JFN)	; Got one, store the new dir num
	PUSHJ P,USTDIR		; Release the directory
	PUSHJ P,QVNAM		; Now look for acceptable name, ext, ver
	 JRST QVDIR0		; None for this dir, step it
	JRST SKPRET		; Got one, return +2

; Step name field
QVNAM:	SETZ A,			; Find the first name this dir
	JRST QVNAM1

QVNAM0:	HLRZ A,FILNEN(JFN)	; Step the current name
	PUSHJ P,LKPTR		; Need a lookup ptr
QVNAM1:	TEST(O,NAMSF,STEPF)
	PUSHJ P,NAMLKX		; Find the next one
	 JFCL
	 POPJ P,		; No more, return +1
	NOINT
	HRRZ A,FILTMP(JFN)	; Got one, exchange old name block
	HLRZ B,FILNEN(JFN)	; and new one
	HRLM A,FILNEN(JFN)
	HRRM B,FILTMP(JFN)
	OKINT
	PUSHJ P,SETTMP		; And reinit FILTMP ptr
	PUSHJ P,QVEXT		; Now look for acceptable ext and ver
	 JRST QVNAM0		; None for this name, step it
	JRST SKPRET		; Got one, return +2

; Step extension field
QVEXT:	SETZ A,			; Find the first ext this name
	JRST QVEXT1
QVEXT0:	HRRZ A,FILNEN(JFN)	; Step the current extension
	PUSHJ P,LKPTR		; Need a lookup ptr
QVEXT1:	TEST(O,EXTSF,STEPF)
	PUSHJ P,EXTLKX		; Find the next one
	 JFCL
	 POPJ P,		; No more, return +1
	NOINT
	HRRZ A,FILTMP(JFN)	; Got one, exchange old ext block
	HRRZ B,FILNEN(JFN)	; and new one
	HRRM A,FILNEN(JFN)
	HRRM B,FILTMP(JFN)
	OKINT
	PUSHJ P,SETTMP		; And reinit FILTMP ptr
	PUSHJ P,QVVER		; Now look for acceptable ver
	 JRST QVEXT0		; None for this ext, step it
	JRST SKPRET		; Got one, return +2

; Step version field
QVVER:	SETZ A,			; Find the first version this ext
	JRST QVVER1
QVVER0:	HRRZ A,FILVER(JFN)	; Step the current version
QVVER1:	TEST(O,VERSF,STEPF)
	PUSHJ P,GTVER		; Go find next one and check access
	 POPJ P,		; None, return +1
	JRST SKPRET		; Finally we have an acceptable one
				; Return +2


; Routine to skip if input buffer is empty.
; Entry:   From ? routines
; Call:	   PUSHJ P,GSIBE
; Return:  +1, input not empty or non TTY
;	   +2, TTY input empty
; Clobbers A


GSIBE:	PUSHJ P,INFTST		; Check input JFN
	 POPJ P,		; Nope, return +1
	SIBE
	 POPJ P,
	AOS 0(P)
	POPJ P,


; This routine appends a * to the field currently being entered and
; fakes *'s for any remaining fields.
; Entry:   Partial input from user
; Call:    PUSHJ P,QSDIR  directory being entered
;          PUSHJ P,QSNAM  name being entered
;          PUSHJ P,QSEXT  extension being entered
;          PUSHJ P,QSVER  version being entered
; Return:  +1 always, fake input fields set up
QSDIR:	PUSHJ P,QSTAR		; Add a star
	PUSHJ P,ENDDIR		; And find a directory
QSNAM:	PUSHJ P,QSTAR		; Add a star
	PUSHJ P,ENDNAM		; And find a name
QSEXT:	PUSHJ P,QSTAR		; Add a star
	PUSHJ P,ENDEXT		; And find an extension
QSVER:	PUSHJ P,QSTAR		; Make a star version
	PUSHJ P,ENDEXT		; And find a version
	POPJ P,			; Return


; Routine to fake a "*" input by user.
; Entry:   Partial input in buffers
; Call:    PUSHJ P,QSTAR
; Return:  +1 always, * added to input buffers and old file flag set
QSTAR:	MOVEI A,"*"
	PUSHJ P,LTR		; Put it in FILTMP
	PUSHJ P,RTPCH		; And retype buffer (to rescan wild card)
	TEST(O,STARF)
	TEST(O,ASTAF)		; Make the * legal for now
	TEST(Z,OUTPF,NEWNF)	; Only look for old files
	TEST(O,OLDNF)
	POPJ P,


; Routine to print out a candidate string
; Entry:   A = address of string block
; Call:	   PUSHJ P,QNXTL
; Return:  +1 always
; Clobbers A,B,C

QNXTL:	PUSH P,A		; Save block adr for now
	TMSG </
  />

	POP P,B
	PUSHJ P,TSTRB		; Output string
	POPJ P,

; Routine to compute a lookup pointer for a string block:
; Entry:   A = Address of block
; Call:	   PUSHJ P,LKPTR
; Return:  +1, A = lookup pointer:  -# words,,first word - 1
; Clobbers A,B,C

LKPTR:	HRRZI B,1(A)		; Address of start of string
	HRLI B,440700		; Make it a pointer
	ILDB C,B		; Find end of string
	JUMPN C,.-1
	HRRZ C,A		; Start of block
	SUBI C,-1(B)		; -number of words
	HRL A,C			; Make A an IOWD
	POPJ P,


; Routine to fetch a directory name string, given the directory number
; Entry:   Dir number in RH(FILDDN)
; Call:	   PUSHJ P,GDNAME
; Return:  +1  Name not found
;	   +2  Name found and string in temp tmp block - LH(FILTMP)
; Clobbers A,B,C,D

GDNAME:	PUSHJ P,SELTMP		; Get a block
	HRRZ A,FILDDN(JFN)	; Dir number to find
	 JUMPE A,GDNAM0		; None there
	PUSHJ P,GDIRST		; Find the name
	 JRST GDNAM0		; Error, not found
	HLRZ B,FILTMP(JFN)	; Ptr in A, move it to temp tmp
	PUSHJ P,BBLT
	PUSHJ P,USTDIR		; Unlock the directory
	AOS 0(P)		; And return +2
	POPJ P,

GDNAM0:	PUSHJ P,RELTMP		; Bad news, release the temp tmp block
	POPJ P,			; And return +1


; Routine to BLT a block from one place to another
; Entry:   A = Address of source block
;	   B = Address of destination block

; Call:	   PUSHJ P,BBLT
; Return:  +1 always
; Clobbers A,B,C,D

BBLT:	HRRE C,0(A)		; Get origin block size
	HRRE D,0(B)		; And the dest block size
	CAMLE C,D		; Pick the smallest
	MOVE C,D
	HRLI A,1(A)		; Make BLT pointer
	HRRI A,1(B)
	ADDI B,-1(C)		; Stopping location
	CAILE C,1		; If non-trivial block, do copy
	BLT A,0(B)		; Move it
	POPJ P,


; Set up temporary TMP storage using the left half of FILTMP.  If a
; block is already assigned, don't disturb it.
; Entry:   n/a
; Call:    PUSHJ P,SELTMP
; Return:  +1 always, tmp block set up in LH(FILTMP)
SELTMP:	HLRZ A,FILTMP(JFN)	; Is anything there now?
	 JUMPN A,CPOPJ		; Yes, keep it
	MOVEI B,MAXLW+1		; No, make a new one
	NOINT
	PUSHJ P,ASGJFR
	 JRST   [OKINT		; Bad luck
		 ERRLJF GJFX22]
	HRLM A,FILTMP(JFN)	; Got it - save location
	OKINT
	POPJ P,


; Release the temporary TMP storage from the left half of FILTMP
; Entry:   Tmp block ptr in LH(FILTMP)
; Call:    PUSHJ P,RELTMP
; Return:  +1 always
RELTMP:	MOVEI A,JSBFRE		; Free space location
	HLRZ B,FILTMP(JFN)
	NOINT
	 SKIPE B		; If it is there
	PUSHJ P,RELFRE		; Release it
	HRRZS FILTMP(JFN)
	OKINT
	POPJ P,


; Set up a retype buffer and user control flags in the RH(FILEXW).  Set
; up procedure is like SETTMP but block has more entries:
;

; Word 0  = Header
;      1  = Current byte ptr to last char entered in the block
;      2  = Current count of chars that can be added to the buffer
;		(excludes the terminating 0 - always room for that)
;      3  = Current byte ptr into user typescript buffer
;      4  = Current count of space remaining in user typescript buffer
;      5  = Flags for non-std Dev or Dir and extended user output
;      6  = Start of input text
; Entry:   n/a
; Call:    PUSHJ P,SETRTP
; Return:  +1 always, buffer allocated and initialized
SETRTP:	HRRZ A,FILEXW(JFN)	; Get ptr to existing buffer if there
	JUMPN A,SETRT0		; If already allocated, just init it
	MOVEI B,MAXRW		; Need to allocate one, this many words
	NOINT
	PUSHJ P,ASGJFR
	 JRST   [OKINT		; Bad luck
		 ERRLJF GJFX22]
	HRRM A,FILEXW(JFN)	; Got it, save the address
	OKINT
SETRT0:	MOVEI B,BLKDT(A)	; Set up starting string ptr
	HRLI B,440700
	MOVEM B,BLKBP(A)	; And save it
	MOVEI B,MAXRC		; Set up max char count
	MOVEM B,BLKCT(A)	; And save it
	MOVSI C,LITRF		; Start with literal retype
	TLNN E,777777		; Long GTJFN?
	TEST(NN,LLTBF)		; Yes, long-long table set?
	 JRST SETRT2		; No, just save what we have
	XCTUU [HLR C,EXTWD(E)]	; Yes, get his added flags in RH of BLKFG
	XCTUU [HRRE D,EXTWD(E)]	; And the number of following words
	CAIGE D,2		; Enough for typescript stuff?
	 JRST SETRT2		; No, forget it
	XCTUU [MOVE B,TPPTR(E)]		; Yes, get user's string ptr
	TLCN B,777777		; Any kind of ptr?
	 JRST SETRT1		; No, try prompt ptr
	TLCN B,777777		; If implicit, set it up
	 HRLI B,440700
IFN KIFLG,<
	TLNE B,37		; If KI-10, can't have indir or index
	 JRST SETRT1		; Bad news, ignore his request
	>
	MOVEM B,USRBP(A)	; Save his ptr in our buffer
	XCTUU [SKIPG B,TPCNT(E)]	; Now look at his count
	 MOVEI B,MAXRC		; If non-pos, use our default
	MOVEM B,USRCT(A)	; Save his max count in our buffer
	TLO C,USRTY		; And set bit to show he wants it
SETRT1:	CAIGE D,3		; Enough for a prompt pointer?
	 JRST SETRT2		; No, forget it
	XCTUU [MOVE B,PRPTR(E)]		; Get his prompt pointer
	TLCN B,777777		; Any kind of pointer?
	 JRST SETRT2		; No, wrap it up

	TLCN B,777777		; If implicit, set it up
	 HRLI B,440700
IFN KIFLG,<
	TLNE B,37		; If KI-10, can't have indir or index
	 JRST SETRT2		; Bad news, forget it
	>
	XCTUU [MOVEM B,PRPTR(E)]	; Give it back to him
	TLO C,USRPR		; And set bit to show he has one
SETRT2:	MOVEM C,BLKFG(A)	; Now store the bits
	POPJ P,			; And return


; Cleanup on error.  Make sure user typescript terminated, if any, and
; release the JFN.
; Entry:   Error condition, JFN block partly complete
; Call:	   PUSHJ P,ENDJFN
; Return:  +1 always
ENDJFN:	PUSHJ P,TRMUTP		; Terminate user typescript if needed
	JRST RELJFN		; And then release JFN


; Routine to terminate a user typescript.
; Entry:   Retype buffer set up
; Call:    PUSHJ P,TRMUPT
; Return:  +1 always
TRMUTP:	MOVEI A,0		; Make sure user's typescript has 0
	PUSHJ P,USRCH
	HRRZ A,FILEXW(JFN)	; Get the retype buffer ptr
	SKIPG A			; if one still there
	 POPJ P,
	MOVE C,BLKFG(A)		; and give typescr ptr and count back to
	TLNN C,USRTY		; the user if he wanted it
	 POPJ P,
	MOVE B,USRBP(A)
	XCTUU [MOVEM B,TPPTR(E)]
	MOVE B,USRCT(A)
	XCTUU [MOVEM B,TPCNT(E)]
	POPJ P,


; Routine to copy a string from a trimmed block back to a full-sized
; block, releasing the trimmed block.  Returns NOINT always.
; Entry:   A = address of trimmed block
; Call:    PUSHJ P,FULBLK
; Return:  +1 always, A = new full sized block address, NOINT
; Clobbers A,B,C,D

FULBLK:	NOINT
	HRRZ B,0(A)		; Size of old block
	CAIL B,MAXLW+1		; Full sized already?
	 POPJ P,		; Yes, return
	PUSH P,A		; No, save old block address
	MOVEI B,MAXLW+1		; Get a new block of full size
	PUSHJ P,ASGJFR
	 JRST   [OKINT		; Bad luck, no more room
		 ERRLJF GJFX22]
	SETZM 1(A)		; Make sure at least one 0
	MOVE B,A		; Set up to copy old block
	MOVE A,0(P)
	PUSH P,B
	PUSHJ P,BBLT
	POP P,B
	MOVEI A,JSBFRE		; Done, now release the old one
	EXCH B,0(P)
	PUSHJ P,RELFRE
	POP P,A			; And return the new adr in A
	POPJ P,


; Output a char to the retype buffer and to the user typescript.
; Entry:   A = Character to be output
; Call:    PUSHJ P,RTPCH   Output to both retype and user
;	   PUSHJ P,USRCH   Output to user only
; Return:  +1 always
; Clobbers A,B,C

RTPCH:	TEST(NE,RSCNF)		; If rescan pending, don't touch retype
	 JRST USRCH		; Just go do the user typescript
	HRRZ B,FILEXW(JFN)	; Get retype buffer address

	SKIPG B			; Anything there?
	 POPJ P,		; No, return
	SOSGE BLKCT(B)		; Enough room?
	 ERRLJF GJFX41		; No, bomb out
	IDPB A,BLKBP(B)		; Yes, store it
USRCH:	HRRZ B,FILEXW(JFN)	; Get retype buffer address (may enter here)
	SKIPG B			; Anything there?
	 POPJ P,		; No, return
	MOVE C,BLKFG(B)		; And the flags
	TLNN C,USRTY		; Typescript wanted and legal?
	 POPJ P,		; No, return
	SOSGE USRCT(B)		; Enough room?
	 JRST   [TLZ C,USRTY	; No, turn off flag for more
		 MOVEM C,BLKFG(B)
		 XCTUU [SETOM TPCNT(E)]  ; Neg count to let him know
		 POPJ P,]
	MOVE C,USRBP(B)		; Get user byte ptr
	XCTBU [IDPB A,C]	; Put the byte in his buffer
	JUMPE A, [AOS USRCT(B)	; 0 byte, reset his count
		  POPJ P,]	; And don't update the pointer
	MOVEM C,USRBP(B)	; Resave byte ptr
	POPJ P,


; Output a string to the retype buffer and to the user typescript
; Entry:   A = Address of the string block
; Call:    PUSHJ P,RTSTRB  print from string block
;
; Entry:   A = String pointer to source
; Call:    PUSHJ P,RTSTR   print from string pointer
;
; Return:  +1 always
; Clobbers A,B,C,D

RTSTRB:	HRROI A,1(A)		; Address string part of block
RTSTR:	TLC A,777777		; If implicit, set it up
	TLCN A,777777
	 HRLI A,440700
	HRRZ B,FILEXW(JFN)	; Address of retype buffer
	SKIPG B			; Anything there?
	 POPJ P,		; No, return
	PUSH P,A		; Save copy of ptr for later
	TEST(NE,RSCNF)		; Rescan in progress?
	 JRST RTSTR1		; Yes, don't touch the retype buffer
RTSTR0:	ILDB C,A		; Get input character
	JUMPE C,RTSTR1		; End if 0
	SOSGE BLKCT(B)		; Room for real char?
	 ERRLJF GJFX41		; No, bomb out
	IDPB C,BLKBP(B)		; Put char in retype buffer
	JRST RTSTR0		; And do them all

RTSTR1:	POP P,A			; Recover ptr to start of input string
	MOVE C,BLKFG(B)		; Get retype flags
	TLNN C,USRTY		; Typescript wanted
	 POPJ P,		; No, return now
	MOVE C,USRBP(B)		; Get byte ptr to user buffer
RTSTR2:	ILDB D,A		; Get input char
	JUMPE D,[MOVEM C,USRBP(B)	; Save user's byte ptr
		 POPJ P,]
	SOSGE USRCT(B)		; Room in user's buffer?
	 JRST   [MOVEM C,USRBP(B)	; No, save current byte ptr
		 MOVE C,BLKFG(B)	; Get flags
		 TLZ C,USRTY		; Turn off flag for more
		 MOVEM C,BLKFG(B)
		 XCTUU [SETOM TPCNT(E)]  	; Neg count to let him know
		 POPJ P,]
	XCTBU [IDPB D,C]	; Put the byte in his buffer
	JRST RTSTR2		; Go do them all


; Output a number to the retype buffer and the user typescript
; Entry:   B = number
;	   C = radix
; Call:    PUSHJ P,RTNOUT
; Return:  +1 always
; Clobbers A,B,C,D

RTNOUT:	MOVEI A,1		; Compute biggest number
	MOVEI D,NDIG		; this many digits
RTNOU0:	IMUL A,C
	SOJG D,RTNOU0
	PUSH P,A		; Save divisor
	PUSH P,B		; Number to be converted
	PUSH P,C		; And the radix
	SKIPGE B		; Negative value?
	 JRST   [MOVMM B,-1(P)	; Convert to magnitude
		 CHRTP("-")	; Put out sign
		 JRST .+1]
	MOVE A,-1(P)		; Fetch the number
	CAML A,-2(P)		; Less than biggest?
	 JRST   [RTPMSG("***")	; No, do stars
		 JRST RTNOU3]
RTNOU1:	PUSHJ P,GTDIG		; Go compute a digit

	 JRST   [CHRTP("0")	; Just a 0
		 JRST RTNOU3]
	CAIN A,"0"		; Anything but 0?
	 JRST RTNOU1		; No, look some more
RTNOU2:	PUSHJ P,RTPCH		; OK, go type the char
	PUSHJ P,GTDIG		; get another digit
	 JRST RTNOU3		; No more, quit
	JRST RTNOU2
RTNOU3:	SUB P,[3,,3]		; Reset stack
	POPJ P,


; Routine to compute the next digit from data on the stack:
; Entry:   0(P) = return address
;         -1(P) = radix
;         -2(P) = current remainder
;         -3(P) = current divisor
; Call:	   PUSHJ P,GTDIG
; Return:  +1, no more characters
; 	   +2, A = next character
GTDIG:	MOVE A,-2(P)		; Get current number
	MOVE C,-3(P)		; Get current divisor
	IDIV C,-1(P)		; Compute new divisor
	SKIPG C
	 POPJ P,		; Nothing left
	MOVEM C,-3(P)		; Save new divisor
	IDIV A,C		; Compute next char
	MOVEM B,-2(P)		; Save new remainder
	IORI A,60		; Convert to character
	JRST SKPRET		; And return +2


	END
