;BLKALC.LIT
;
;
;4/25/84        STEVEN G. MCNAUGHTON  &  RICH EAKIN
;              QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
;
; ***********************************************************************
; *									*
; *   FORMAT FOR USE IS BLKALC <DEVn:> BLOCK</P:[nnn,nn]>		*
; *   									*
; *   If device is left off the user's default device is used.		*
; *									*
; *   Block number is the octal (or Hex) block to be searched for.	*
; *   If job type is SET HEX all numbers begining with a character	*
; *   A - F must be proceeded with a zero (0).				*
; *									*
; *   /P:[nnn,nn] option confines search to a specific account.		*
; *   The brackets are optional.					*
; *									*
; ***********************************************************************

; ***********************************************************************
; *									*
; * NOTE- THE MFD STORAGE AREA WILL HOLD UP TO 6 "COMPRESSED" MFD BLKS	*
; *       (EACH MFD IS STORED AS THE PPN AND POINTER, THE PASSWORD	*
; *       IS NOT STORED. THUS THE "COMPRESSED" TITLE.)			*
; *									*
; ***********************************************************************

; ***********************************************************************
; *									*
; *                 EDIT AND DEVELOPMENT HISTORY			*
; *									*
; ***********************************************************************
; *									*
; * 100. - BASIC SCAN PROGRAM  [SGM]					*
; * 101. - INPUT TO PROGRAM ONLY ON COMMAND LINE  [SGM]			*
; * 102. - OUTPUT PPN AS OCTAL NUMBER REGARDLESS OF JOBTYP  [SGM]	*
; * 103. - ADDED PPN SWITCH OPTION  [SGM]				*
; * 104. - CORRECTED BLOCK NUMBER IN BOUNDS CHECK FOR DEVICES WITH 	*
; *        OVER 32K BYTES PER DISK.  [SGM]  5/18/84			*
; *									*
; ***********************************************************************


SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV


.OFINI					
.OFDEF	DDB,D.DDB			;DUMMY FILE DDB
.OFSIZ	IMPSIZ

VMAJOR=1.				;VERSION NUBMER					
VMINOR=1.
VSUB=1.
VEDIT=104.

HEADER:
	PHDR	-1,PV$RSM!PV$WSM,PH$REE!PH$REU


TOP:
	GETIMP	IMPSIZ,A5,EXIT		;GET SOME IMPURE SPACE
	JOBIDX	A3
	MOVW	2(A3),D1
	LEA	A1,STATUS		;STORE THE JOBTYP
	MOVW	D1,(A1)
	ANDW	#20,D1			;IS J.HEX SET?
	BEQ	RESPRG			;NOPE IN OCTAL
	MOVW	#1,D5			;QUICK STORAGE FOR J.HEX SET
RESPRG:	MOV	A2,D2
	LEA	A3,ASCBUF		;A3 POINTS TO ASCII BUFFER SPACE
	BYP				;BYPASS ANY BLANKS ON COMMAND LINE
	LIN				;END OF LINE?
	JEQ	CERROR
NUMCHK:
	NUM				;IS THE FIRST CHAR NUMERIC?
	JEQ	INPBLK			;YES ! GET THE BLOCK NUMBER
INLINE:					;NO ! GET THE DEVICE AND DRIVE INFO NOW
	MOVB	(A2)+,(A3)+		;FIRST BYTE ON COMMAND LINE TO ASCII BUFFER
	MOVB	(A2)+,(A3)+		;SECOND BYTE ON COMMAND LINE
	MOVB	(A2)+,(A3)		;THIRD BYTE ON COMMAND LINE
	LEA	A3,INDRV		;LOAD THE DRIVE STORAGE AREA
	MOVB	(A2)+,(A3)+		;FOURTH BYTE ON COMMAND LINE TO DRIVE
	BYP				;BYPASS ANY BLANKS
	LIN				;END OF LINE?
	JEQ	CERROR			;*ERROR* WHERE'S THE COLON?
	MOVB	(A2),D1			;CHECK THE COMMAND LINE FOR A COLON
	CMPB	D1,#':			;IS IT A COLON (END OF DEV AND DRV)
	JEQ	PCKIT			;YES ! GO PACK THE DEVICE NAME
	MOVB	(A2)+,(A3)		;GET FINAL CHARACTER OF DRIVE #
	MOVB	(A2),D1			;TEST THE NEXT BYTE ON THE COMMAND LINE
	CMPB	D1,#':			;IS IT A COLON?
	JEQ	PCKIT			;YES - GO PACK THE DEV AND DRV
					;*ERROR* DEV AND DRV MUST END IN COLON
	SUB	#2,A2
	JMP	CERROR
PCKIT:
	ADD	#1,A2			;MOVE TO NEXT BYTE ON COMMAND LINE
	BYP				;BYPASS ANY BLANKS
	LIN				;END OF LINE?
	JEQ	CERROR
NUM2:
	NUM				;IS THIS CHARACTER NUMERIC?
	JNE	CERROR			;*ERROR* - THIS MUST BE A NUMBER!
	CLR	D1			;CLEAR OUT ANY JUNK
	GTOCT				;GET AN OCTAL NUMBER FROM THE COMMAND LINE
	LEA	A3,BLOCK		;STORE THAT OCTAL NUMBER IN THE BLOCK
	MOVW	D1,(A3)			;  TO BE SEARCHED AREA
	BYP				;BYPASS ANY BLANKS
	LIN				;END OF LINE?
	JEQ	GOPCK
SWTCHK:	CMPB	(A2),#'/		;IS IT A SLASH
	JNE	CERROR
	ADD	#1,A2
	CMPB	(A2),#'P		;IS IT A "P"
	JNE	CERROR
	ADD	#1,A2
	CMPB	(A2),#':		;IS IT A COLON
	JNE	CERROR
	ADD	#1,A2
	CMPB	(A2),#'[		;IS THERE A [
	BNE	PPNALC
	ADD	#1,A2
PPNALC:
	TSTW	D5
	BEQ	OCTPPN
HEXPPN:
	LEA	A3,STATUS
	MOVW	(A3),D1	
	JOBIDX	A3
	LEA	A0,2(A3)
	ANDW	#2757,D1		;MASK OFF J.HEX BIT
	MOVW	D1,(A0)	
OCTPPN:
	LEA	A3,PPN1
	CLR	D3
	MOVW	#3,D3			;P1 TALLY (MAX 3 CHARS)
PPNLP:	BYP	
	NUM	
	JNE	CERROR
	MOVB	(A2)+,(A3)+
	BYP
	CLRW	D1
	MOVB	(A2),D1
	CMPB	D1,#',			;GOT A COMMA YET?
	BNE	TALCHK
	ADD	#1,A2
	BR	CVRTP1
TALCHK:
	SUBW	#1,D3
	TSTW	D3
	BNE	PPNLP
	ADD	#1,A2
CVRTP1:	MOVB	#'X,(A3)
PPNAL2:
	LEA	A3,PPN2
	MOVW	#2,D1			;P2 TALLY (MAX 2 CHARS)
PPNLP2:
	CLRW	D1
	CLR	D3
	BYP	
	NUM	
	JNE	CERROR
	MOVB	(A2)+,(A3)+
	BYP
	LIN
	BEQ	CVRTP2
	MOVB	(A2),D3
	CMPB	D3,#']
	BEQ	CVRTP2
	SUBW	#1,D1
	TSTW	D1			;TWO CHARS YET?
	BNE	PPNLP2
CVRTP2:	
	MOVB	#'X,(A3)	
	CLR	D1
	CLR	D2
	LEA	A3,SPPN
	LEA	A2,PPN1
	GTOCT
	MOVB	D1,D3	
	LSLW	D3,#10
	LEA	A2,PPN2
	GTOCT
	MOVB	D1,D3
	MOVW	D3,(A3)			;STORE THE SEARCH PPN NUMBER
	LEA	A3,PPNFLG
	MOVW	#1,(A3)
RESTYP:
	TSTW	D5
	BEQ	GOPCK	
	LEA	A3,STATUS
	CLR	D1
	MOVW	(A3),D1
	JOBIDX	A3
	LEA	A2,2(A3)		
	MOVW	D1,(A2)
	LEA	A3,DEFFLG
	MOVW	(A3),D1
	CMPW	D1,#1
	JEQ	INITDB	

GOPCK:
	CLR	D1			;CLEAR OUT ANY JUNK
	LEA	A2,ASCBUF		;A2 MUST POINT TO ASCII CHARACTERS
	LEA	A1,INDEV		;PACK AND STORE THE DEVICE NAME
	PACK				;
	LEA	A2,INDRV		;GET THE INPUTED DRIVE NUMBER
	GTDEC				;MAKE SURE ITS DECIMAL
	LEA	A2,INDRV		;PUT IT BACK INTO DRIVE # STORAGE
	MOVW	D1,(A2)
	JMP	INITDB			;

INPBLK:
	CLR	D1			;GET THE BLOCK - DSK MUST HAVE BEEN
	GTOCT				;DEFAULTED TO GET HERE!
	LEA	A3,BLOCK		;STORE THE BLOCK NUMBER 
	MOVW	D1,(A3)
DEFAUL:
	LEA	A3,DEFFLG
	MOVW	#1,(A3)
	LEA	A3,INDEV		;DEVICE DEFAULT AREA
	MOVW	#0,(A3)			;MOVE A ZERO FOR DEVICE NAME (FOR IDDB)
	LEA	A3,INDRV		;MOVE A -1 FOR DRIVE NUMBER (FOR IDDB)
	MOVW	#-1,(A3)
	BYP				;BYPASS ANY BLANKS
	LIN				;END OF LINE?
	JNE	SWTCHK

INITDB:					;SET UP AND INIT A DUMMY DDB

	MOVW	#177400,D1		;CLEAR THE SCREEN
	TCRT
	CLR	D1
	LEA	A2,SCRAT		;LOAD A DUMMY FILESPEC IN
	MOV	A2,D0
	MOVW	#377,(A2)+
	MOVW	#377,(A2)+
	MOVW	#377,(A2)
	MOV	D0,A2	
	FSPEC	(A5)			;PROCESS THE FILESPEC (POINTED BY A2)
	LEA	A3,D.DEV(A5)		;PUT THE PROPER DEVICE NAME IN
	LEA	A2,INDEV
	MOVW	(A2),(A3)
	LEA	A3,D.DRV(A5)		;PUT THE PROPER DRIVE NUMBER IN
	LEA	A2,INDRV
	MOVW	(A2),(A3)
	INIT	(A5)			;INITIALIZE THE DDB
	CTRLC	EXIT
	CLR	D1
	TYPESP	<Block allocation search has been initiated on:>
	LEA	A3,D.DEV(A5)		;GET THE DDB'S DEVICE NAME
	MOVW	(A3),D1			;MOVE THE PACKED WORD TO D1
	TST	D1			;IS IT A ZERO?
	BNE	UNPCK			;NOPE - GO UNPACK THE WORD
	JOBIDX	A3			;DEFAULT DEVICE - DETERMINE LOG IN 
	LEA	A2,JBDEV		;   STATUS AND TYPE IT OUT
	CLR	D1
	MOVW	JOBDEV(A3),D1		;GET THE PACKED DEVICE NAME
	LEA	A1,SCRAT		;  AND UNPACK IT
	MOVW	D1,(A1)
	LEA	A2,ASCBUF	
	UNPACK
	LEA	A2,ASCBUF
	TTYL	(A2)			;PRINT THE DEFAULT DEVICE NAME
	CLR	D1
	MOVW	JOBDRV(A3),D1		;GET THE DEFAULT DRIVE NUMBER
	DCVT	0,OT$TRM		;CONVERT AND TYPE IT
	CRLF
	CLR	D1
	JMP	PUTBLK	
UNPCK:
	LEA	A1,INDEV		;GET AND UNPACK THE DEVICE NAME
	LEA	A2,ASCBUF
	UNPACK
	LEA	A2,ASCBUF
	MOVB	(A2)+,D1		;PRINT THE DEVICE NAME
	TTY
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	LEA	A2,INDRV		;GET THE DRIVE NUMBER
	CLR	D1
	MOVB	(A2),D1
	DCVT	0,OT$TRM		;CONVERT AND TYPE IT
	CRLF
	CLR	D1

PUTBLK:
	TYPESP	<Block number to be searched:>
	CLR	D1
	LEA	A1,BLOCK		;GET THE BLOCK NUMBER
	MOVW	(A1),D1
	OCVT	0,OT$TRM		;CONVERT TO OCTAL AND TYPE IT
	CRLF
	CTRLC	EXIT

GETMFD:
	CLR	D1
	MOV	DDB+D.DVR(A5),A3	;GET THE DISK DRIVER ADDRESS
	MOV	24(A3),D2		;GET THE TOTAL NUMBER OF BLOCKS/DISK
	SUB	#1,D2			;SUB 1 - BECAUSE ZERO IS BLOCK #1
	LEA	A3,BLOCK		;GET THE INPUTED BLOCK NUMBER
	MOVW	(A3),D1
;	TSTW	D1								 [104]
;	BMI	NEGERR									[104]
	CMP	D1,D2			;IS THE INPUTED BLOCK LESS THAN BLOCK    [104]
	BLOS	BITNUM			;   PER DISK?				[104]
BIGERR:	TYPECR	<?Block number specified is too large for this device>	
	JMP	EXIT
; NEGERR:	TYPECR	<?Block number specified is a negative octal number>    [104]
;	JMP	EXIT								[104]
BITNUM:	DIV	D2,#4096.		;DIVIDE BY NUMBER OF BITS PER BLOCK
	CLR	D0
	MOVW	D2,D0			;MOVE THE QUOTIENT TO D0
	ROR	D2,#10
	ROR	D2,#10
	CMPW	D2,#0			;DO WE HAVE A PARTIAL BLOCK?
	BEQ	ZCHK			;NO - START BLOCK CHECKING
	ADDW	#1,D0			;YES - ADD 1 TO BITMAP BLOCK AREA
ZCHK:
	TST	D1
	BNE	OCHK
	TYPECR	<Block zero is the device label block>
	JMP	EXIT
OCHK:
	CMPW	D1,#1			;IS IT BLOCK ONE?
	BNE	TCHK			;NOPE - GO ON
	TYPECR	<Block one is always the first MFD block>
	JMP	EXIT
TCHK:
	CMPW	D1,#2			;IS IT BLOCK TWO?
	BNE	BITCHK			;NOPE - CHECK THE BITMAP NOW
	TYPECR	<Block two is always the first BITMAP block>
	JMP	EXIT
BITCHK:
	ADDW	#1,D0
	CMPW	D1,D0			;IS IT IN RANGE OF BITMAP?
	BHI	GOMFD			;NOPE - IT IS A VALID BLOCK NUMBER	[104]
	TYPECR	<Block specified is contained in the BITMAP>
	JMP	EXIT


GOMFD:
	LEA	A3,PPNFLG
	CLR	D2	
	MOVW	(A3),D2
	TSTW	D2
	JEQ	NORPTH
SWTAGN:
	MOV	#1,D1
SWTPTH:
	LEA	A3,SPPN
	MOVW	(A3),D2
	LEA	A1,D.REC(A5)		;LOAD BLOCK #1(MFD) 
	MOV	D1,(A1)
	CLR	D1
        READ	@A5			;READ THE BLOCK
	MOV	D.BUF(A5),A1		;ADDRESS THE READ BUFFER AREA
	CTRLC	EXIT
SWTMOV:
	MOVW	(A1),D1			;TEST WORD TO SEE IF DONE WITH THIS
	TSTW	D1			;   MFD BLOCK, (ZERO PPN HOLE)
	BEQ	SWTDUN
	MOVW	(A1)+,D1		;GET THE PPN 
	CMPW	D1,D2			;IS IT THE TARGET PPN
	BEQ	SWTHIT
	ADD	#6,A1
	CTRLC	EXIT
	BR	SWTMOV			;LOOP AND GET THE NEXT ENTRY IN THE MFD
SWTDUN:	
	MOV	D.BUF(A5),A1
	MOVW	772(A1),D1
	TSTW	D1
	BEQ	NFIMFD
	JMP	SWTPTH
NFIMFD:
	CRLF
	TYPECR	<? PPN specified does not exist.>
	JMP	EXIT

SWTHIT:
	MOVW	(A1),D3			;D3 HOLDS UFD BLOCK#
	LEA	A3,BLOCK
	MOVW	(A3),D2			;D2 HOLDS TARGET BLOCK#
	LEA	A3,SPPN
	MOVW	(A3),D4			;D4 HOLDS PPN#
	TYPECR	<PPN option has been specified for account:>
	JMP	CHKUFD

NORPTH:	LEA	A1,D.REC(A5)		;LOAD BLOCK #1(MFD) 
	MOV	#1,(A1)
        READ	@A5			;READ THE BLOCK
	LEA	A3,MFD			;ADDRESS THE MFD STORAGE AREA
	MOV	D.BUF(A5),A1		;ADDRESS THE READ BUFFER AREA
	CTRLC	EXIT
MFDMOV:
	MOVW	(A1),D1			;TEST WORD TO SEE IF DONE WITH THIS
	TST	D1			;   MFD BLOCK, (ZERO PPN HOLE)
	BEQ	MFDPGE
	MOVW	(A1)+,(A3)+		;MOVE THE PPN INTO STORAGE
	MOVW	(A1)+,(A3)+		;MOVE THE BLOCK POINTER
	MOVW	(A1)+,D1		;CYCLE PAST THE PASSWORD (TO SAVE SPACE)
	MOVW	(A1)+,D1		;CYCLE PAST THE PASSWORD
	CLR	D1			;CLEAR OUT ANY JUNK
	CTRLC	EXIT
	BR	MFDMOV			;LOOP AND GET THE NEXT ENTRY IN THE MFD
MFDPGE:
	MOV	D.BUF(A5),A1
	MOVW	772(A1),D1		;CHECK IF MORE PAGES IN MFD
	TST	D1
	BEQ	MFDDUN			;NO MORE PAGES- GOT ALL THE MFD
	CLR	D2
	LEA	A0,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A0),D2
	CMPW	D2,D1			;IS THE NEXT MFD BLOCK THE TARGET?
	CTRLC	EXIT
	JEQ	MFDBLK			;YES! - GO TO FOUND IN MFD MESSAGE
	LEA	A1,D.REC(A5)		;NOT TARGET - MORE PAGES READ THE NEXT MFD BLOCK
	MOV	D1,(A1)			;LOAD THE NEXT BLOCK NUMBER
	READ	(A5)			;READ IT
	MOV	D.BUF(A5),A1		;RESET I/O BUFFER POINTER - A1 POINTS TO MFD STORAGE
	CTRLC	EXIT
	JMP	MFDMOV			;LOOP UP AND STORE IT
MFDDUN:
	LEA	A1,MFD			;A1 POINTS THE MFD STORAGE
MFDLOP: CTRLC	EXIT
	CLR	D1
	CLR	D2
	CLR	D3
	CLR	D4
	MOVW	(A1),D1			;HAVE WE RUN EVERY MFD?
	TST	D1
	JEQ	NOTALC			;YES! - BLOCK MUST NOT HAVE BEEN ALLOCATED!
	MOVW	(A1)+,D4		;D4 NOW HOLDS THE UFD PPN FOR EACH UFD SEARCH
	MOVW	(A1)+,D3		;D3 NOW HOLDS THE UFD BLOCK NUMBER	
	LEA	A3,CURMFD		;CURMFD NOW HOLDS THE NEXT UFD POINTER
	MOV	A1,(A3)


	LEA	A3,BLOCK		;GET THE INPUT BLOCK NUMBER
	MOVW	(A3),D2			;D2 NOW HOLDS THE TARGET BLOCK
	CMPW	D3,D2			;IS THIS THE BLOCK WE'RE SEARCHING FOR?
	JEQ	UFDBLK			;YES-PRINT THE FOUND IN MFD MESSAGE	
	TST	D3
	JNE     CHKUFD			;IS THE BLOCK POINTER A ZERO?
	LEA	A3,CURMFD		;YES! - LOAD THE THE NEXT MFD ENTRY AND LOOP UP
	MOV	(A3),A1
	JMP	MFDLOP			;LOOP UP TO MFD CHECKS AGAIN



					;NO - GET THE UFD AND CHECK IT
CHKUFD:
	LEA	A3,PPNSTO
	MOVW	(A3),D0
	TSTW	D0
	BEQ	PPNOUT
	CMPW	D4,D0
	JEQ	CHKCON
	CTRLC	EXIT
PPNOUT:	TSTW	D5
	BEQ	OCTUIT
HEXUIT:
	LEA	A3,STATUS
	MOVW	(A3),D1	
	JOBIDX	A3
	LEA	A2,2(A3)
	ANDW	#2757,D1		;MASK OFF J.HEX BIT
	MOVW	D1,(A2)	
OCTUIT:
	SAVE	D2,D3,D4
	TYPE	<[>
	CLR	D2
	CLR	D0
	CLR	D1
	MOVB	D4,D0
	ROR	D4,#10
	MOVB	D4,D2	
	MOVB	D2,D1
	OCVT	0,OT$TRM
	TYPE	<,>
	MOVB	D0,D1
	OCVT	0,OT$TRM
	TYPECR	<]>
	CLR	D1
	CLR	D2
	CLR	D0
	JOBIDX	A3	
	LEA	A2,STATUS		;RESTORE JOBTYP
	MOVW	(A2),D1
	LEA	A2,2(A3)
	MOVW	D1,(A2)
	REST	D2,D3,D4

CHKCON:
	LEA	A3,PPNSTO
	MOVW	D4,(A3)
	LEA	A3,D.REC(A5)		;GET THE READ BLOCK HOLE
	MOV	D3,(A3)			;MOVE THE UFD POINTER IN 
	READ	(A5)			;READ THE UFD BLOCK
	MOV	D.BUF(A5),A1		;REPOSITION THE I/O BUFFER
	LEA	A3,UFD			;LOAD THE UFD STORAGE BUFFER
	MOV	#256.,D0		;TALLY
LOOPER:	MOVW	(A1)+,(A3)+
	SUB	#1,D0
	TST	D0
	BNE	LOOPER

	CLR	D1
	LEA	A1,UFD
	MOVW	(A1),D1			;MOVE THE LINK POINTER TO D1
	LEA	A3,BLOCK		;GET THE TARGET BLOCK	
	MOV	(A3),D2
	CMP	D1,D2			;COMPARE THE LINK POINTER WITH THE TARGET
					;THIS IS A TIME SAVER
	JEQ	UFDBLK			;IT'S THE TARGET ! GO TO FOUND IN UFD
					;MESSAGE
	TST	D1			;NOT THE TARGET - IS IT ZERO (NO LINK)
	BNE	UFDPGE			;
	LEA	A3,UFDLNK		;NO MORE BLOCKS IN UFD - MAKE SURE
					;IT'S CLEAR
	MOVW	#0,(A3)			;CLEAR IT
	CTRLC	EXIT
	BR	UFDSCN			;IT'S CLEARED SO DO THE UFD SCAN
UFDPGE:	LEA	A3,UFDLNK		;STORE THE LINK TO THE NEXT BLOCK IN 
					;THE CURRENT UFD
	MOVW	(A1),(A3)		;SAVE THE LINK POINTER TO THE NEXT BLOCK
UFDSCN:		
	LEA	A1,UFD
	ADD	#2,A1			;GET PAST THE LINK POINTER
UFDLOP:
	CTRLC	EXIT
	CLR	D1
	MOVW	(A1),D1			;TEST TO SEE IF WE ARE DONE WITH THIS
	TST	D1			;UFD BLOCK
	JNE	UFDCON			;NO - CONTINUE WITH THIS UFD BLOCK
	MOVW	2(A1),D1		;TEST THE SECOND RAD 50 TRIPLET
	TST	D1			;FILE NAME MAY ONLY BE 1 WORD LONG
	JNE	UFDCON


UFDTST:
	LEA	A3,UFDLNK		;GET THE UFDLNK
	CLR	D3
	MOVW	(A3),D3			;PUT THE UFD LINK INTO D3
	TST	D3			;ANYTHING THERE?
	JNE	CHKUFD			;YES - GO READ THE NEXT BLOCK AND CHECK IT
UFDDUN:
	LEA	A3,PPNFLG
	CLR	D1
	MOVW	(A3),D1
	TSTW	D1
	BEQ	CONNOR
NFIUFD:
	CRLF
	TYPECR	<? Block number is not contained in the specified PPN.>
	JMP	EXIT

CONNOR:
;	CRLF
	LEA	A3,CURMFD		;NOPE - LOAD THE THE NEXT MFD ENTRY AND LOOP UP
	MOV	(A3),A1
	JMP	MFDLOP			;LOOP UP TO MFD CHECKS AGAIN

UFDCON:
;	TYPE	<.>
	CTRLC	EXIT
	LEA	A3,CURUFD		;SAVE THE CURRENT LOCATION IN THE UFD
	MOV	A1,(A3)
	CLR	D1
	MOVW	(A1),D1
	CMPW	D1,#-1			;IS THIS A :80 FILE? (FREE RECORD)
	JEQ	FILDUN			;YES ! - GO TO THE NEXT FILE
	MOVW	2(A1),D1		;BETTER CHECK THE SECOND HALF OF THE FILE NAME
	CMPW	D1,#-1
	JEQ	FILDUN
	LEA	A3,CURFIL		;STORE THE CURRENT FILE NAME(RAD 50)	
	MOVW	(A1)+,(A3)+		;STORE THE FIRST RAD CHAR
	MOVW	(A1)+,(A3)+		;STORE THE SECOND RAD CHAR
	MOVW	(A1)+,(A3)+		;STORE THE THIRD RAD CHAR
					;A1 NOW POINTS TO THE SIZE OF THE FILE
SIZCHK: MOVW	(A1)+,D3		;MOVE THE FILSIZ TO D3
	CMPW	D3,#1			;IS IT ONLY ONE BLOCK LONG?
	JEQ	FILCHK			;YES CHECK THE FILE POINTER ONLY
ACTCHK:					;A1 NOW POINTS TO THE ACTIVE STATUS WORD
	MOVW	(A1)+,D3		;MOVE THE ACTIVE STATUS TO D3
	CMPW	D3,#-1			;IS IT -1 (RANDOM FILE)
	JEQ	RNDCHK			;YES CHECK THE POINTER AND OFFSET ONLY
GETFIL:
	CLR	D2
	CLR	D1
        CTRLC	EXIT   			;FILE IS MORE THAN ONE BLOCK LONG OR
					;NOT A RANDOM FILE SO WE MUST TRACE IT
					;A1 IS NOW POINTING TO THE LINK POINTER
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D2
	MOVW	(A1),D1			;MOVE THE LINK POINTER TO D1
					;THIS IS ANOTHER TIME SAVER
	CMP	D1,D2			;IS THE POINTER THE TARGET BLOCK?
	JEQ	FILBLK			;YES ! - GO PRINT THE FOUND IN FILE
					;MESSAGE
	LEA	A3,D.REC(A5)		;MOVE THE LINK POINTER TO THE READ BLOCK
	MOV	D1,(A3)			;FIRST BLOCK IS IN READ BLOCK AREA

FILRED:
	READ	(A5)			;READ THE FIRST BLOCK
FILSCN:
	CLR	D1
	CLR	D2
	CTRLC	EXIT
	MOV	D.BUF(A5),A3
	MOVW	(A3),D1			;GET THE NEXT LINK POINTER
	TST	D1			;ARE THERE MORE BLOCKS?
	BEQ	FILDUN			;NO MORE BLOCKS IN THIS FILE
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D2	
	CMPW	D2,D1			;IS THE LINK POINTER THE TARGET?
	JEQ	FILBLK			;YES ! - GO TO FOUND IN FILE MESSAGE
	LEA	A3,D.REC(A5)		;LOAD THE LINK INTO THE READ BUFFER
	MOV	D1,(A3)
	JMP	FILRED			;GO READ THE NEXT FILE BLOCK
FILDUN:
	LEA	A3,CURUFD
	MOV	(A3),A1
	ADD	#14,A1			;NO MORE BLOCKS IN THIS FILE - 	
					;UPDATE A1 TO THE NEXT UFD ENTRY AND LOOP
	CTRLC	EXIT
	JMP	UFDLOP
FILCHK:
	CTRLC	EXIT    		;CHECK HERE IF FILE ONLY ONE BLOCK LONG
					;AT THIS POINT A1 POINTS AT ACTIVE STATUS
	ADD	#2,A1			;UPDATE A1 TO THE LINK POINTER
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	CLR	D1
	CLR	D2
	MOVW	(A3),D1
	MOVW	(A1),D2			;GET THE LINK POINTER
	CMPW	D1,D2			;IS THE LINK AND TARGET THE SAME?
	JEQ	FILBLK			;YES ! - GO TO THE FOUND IN FILE 
					;MESSAGE
					;NO- UPDATE A1 TO NEXT ENTRY IN UFD
	LEA	A3,CURUFD
	MOV	(A3),A1
	ADD	#14,A1
	CTRLC	EXIT
	JMP	UFDLOP			;
RNDCHK:
	CTRLC	EXIT			;CHECK HERE IF FILE IS A RANDOM
					;A1 IS POINTING AT THE LINK POINTER
	CLR	D3
	CLR	D2
	CLR	D1
	MOVW	(A1),D1			;GET THE LINK POINTER
	MOVW	-(A1),D2		;BACK UP PAST THE ACTIVE WORD
	MOVW    -(A1),D2		;D2 NOW HOLDS THE FILE SIZE
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D3
	CMPW	D3,D1			;IS THE TARGET BLOCK HIGHER THAN THE LINK POINTER?
	JEQ	FILBLK			;THEY ARE THE SAME - GO TO FOUND IN
					;FILE MESSAGE
	JLO	NOTHER			;TARGET BLOCK IS LESS THAN POINTER SO IT	[104]
					;CAN'T BE FROM THIS FILE
	ADDW	D2,D1			;TARGET IS HIGHER - ADD SIZE TO LINK POINTER
					;TO DETERMINE FILE WINDOW
	CMPW	D3,D1			;IS THE TARGET BLOCK LESS THAN THE EOF?
	JLOS	FILBLK			;THEY ARE THE SAME -OR TARGET IS LESS	[104]
					;THAN EOF SO IT'S IN THIS FILE - GO TO
					;FOUND IN FILE MESSAGE
NOTHER:
	CTRLC	EXIT			;BLOCK DOESN'T BELONG HERE SO UPDATE A1
					;TO NEXT UFD ENTRY AND GO ON
	LEA	A3,CURUFD
	MOV	(A3),A1
	ADD	#14,A1			;A1 NOW POINTS TO NEXT UFD ENTRY
	JMP	UFDLOP
MFDBLK:
	CRLF
	CTRLC	EXIT			;COME HERE IF TARGET IS FOUND IN MFD
	TYPESP	<Block #>
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D1
	OCVT	0,OT$TRM
	TYPESP	< >  
	TYPECR	<has been found in the Master File Directory>	
	JMP	EXIT	
UFDBLK:
	CRLF
	CTRLC	EXIT			;COME HERE IF TARGET IS FOUND IN UFD
	TYPESP	<Block #>
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D1
	OCVT	0,OT$TRM
	TYPESP	< >  
	TYPESP	<has been found in the User File Directory >	
	LEA	A1,INDEV
	CLR	D1
	MOVW	(A1),D1
	TST	D1
	BNE	TYPDEV

JOBDEF:	JOBIDX	A3			;DEFAULT DEVICE - DETERMINE LOG IN 
	LEA	A2,JBDEV		;   STATUS AND TYPE IT OUT
	CLR	D1
	MOVW	JOBDEV(A3),D1		;GET THE PACKED DEVICE NAME
	LEA	A1,SCRAT		;  AND UNPACK IT
	MOVW	D1,(A1)
	LEA	A2,ASCBUF	
	UNPACK
	LEA	A2,ASCBUF
	TTYL	(A2)			;PRINT THE DEFAULT DEVICE NAME
	CLR	D1
	MOVW	JOBDRV(A3),D1		;GET THE DEFAULT DRIVE NUMBER
	DCVT	0,OT$TRM		;CONVERT AND TYPE IT
	CLR	D1
	BR	TYPCON

TYPDEV:	LEA	A2,ASCBUF		;COME HERE AND UNPACK DEVICE NAME IF NOT
	UNPACK				;   RUNNING ON DEFAULT DEVICE
	LEA	A2,ASCBUF
	MOVB	(A2)+,D1	
	TTY
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	LEA	A2,INDRV		;OUTPUT THE DRIVE NUMBER (NOT DEFAULT)
	CLR	D1
	MOVW	(A2),D1
	DCVT	0,OT$TRM
	CLRW	D1
TYPCON:
	TSTW	D5
	BEQ	OCTSET
HEXSET:
	LEA	A3,STATUS
	MOVW	(A3),D1	
	JOBIDX	A3
	LEA	A2,2(A3)
	ANDW	#2757,D1		;MASK OFF J.HEX BIT
	MOVW	D1,(A2)	
OCTSET:
	MOVB	#':,D1
	TTY
	MOVB	#'[,D1
	TTY
	CLR	D2
	CLR	D3
	CLR	D1
	MOVB	D4,D3			;CONVERT AND OUTPUT THE PPN
	ROR	D4,#10
	MOVB	D4,D2	
	MOVB	D2,D1
	OCVT	0,OT$TRM
	TYPE	<,>
	MOVB	D3,D1
	OCVT	0,OT$TRM
	TYPECR	<]>
	JMP	EXIT	
FILBLK:
	CRLF
	CTRLC	EXIT			;COME HERE IF TARGET IS FOUND IN A FILE
	TYPESP	<Block #>
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D1
	OCVT	0,OT$TRM
	TYPESP	< >  
	TYPESP	<has been found in File:>
	LEA	A1,INDEV		;GET DEVICE NAME
	CLR	D1
	MOVW	(A1),D1
	TST	D1			;IS IT DEFAULT?
	BNE	TYPFIL

	JOBIDX	A3			;DEFAULT DEVICE - DETERMINE LOG IN 
	LEA	A2,JBDEV		;   STATUS AND TYPE IT OUT
	CLR	D1
	MOVW	JOBDEV(A3),D1		;GET THE PACKED DEVICE NAME
	LEA	A1,SCRAT		;  AND UNPACK IT
	MOVW	D1,(A1)
	LEA	A2,ASCBUF	
	UNPACK
	LEA	A2,ASCBUF
	TTYL	(A2)			;PRINT THE DEFAULT DEVICE NAME
	CLR	D1
	MOVW	JOBDRV(A3),D1		;GET THE DEFAULT DRIVE NUMBER
	DCVT	0,OT$TRM		;CONVERT AND TYPE IT
	CLR	D1
	MOVB	#':,D1
	TTY

TYPFIL:	LEA	A3,CURFIL
	LEA	A1,D.FIL(A5)
	MOVW	(A3)+,(A1)+		;MOVE THE FIRST TRIPLET INTO THE DDB
	MOVW	(A3)+,(A1)+		;MOVE THE SECOND TRIPLET INTO THE DDB
	MOVW	(A3),(A1)+		;MOVE THE THIRD TRIPLET INTO THE DDB
	PFILE	(A5)			;PRINT THE FILE SPEC
	CLR	D1
	TSTW	D5
	BEQ	OCTFST
HEXFST:
	LEA	A3,STATUS
	MOVW	(A3),D1	
	JOBIDX	A3
	LEA	A2,2(A3)
	ANDW	#2757,D1		;MASK OFF J.HEX BIT
	MOVW	D1,(A2)	
OCTFST:
	TYPE	<[>
	CLR	D2
	CLR	D3
	CLR	D1
	MOVB	D4,D3
	ROR	D4,#10
	MOVB	D4,D2	
	MOVB	D2,D1
	OCVT	0,OT$TRM
	TYPE	<,>
	MOVB	D3,D1
	OCVT	0,OT$TRM
	TYPECR	<]>
	CRLF
	JMP	EXIT

NOTALC:
	CRLF
	CTRLC	EXIT			;COME HERE IF TARGET IS NOT FOUND
	TYPESP	<Block #>
	LEA	A3,BLOCK		;GET THE TARGET BLOCK
	MOVW	(A3),D1
	OCVT	0,OT$TRM
	TYPESP	< >  
	TYPECR	<has not been allocated!>
	JMP	EXIT	

MFD:	BLKB	1536.			;COMPRESSED MFD STORAGE
UFD:	BLKB	512.			;CURRENT UFD STORAGE
CURMFD:	BLKB	4			;STORAGE FOR WHERE WE ARE AT IN THE MFD
CURUFD:	BLKB	4			;STORAGE FOR WHERE WE ARE AT IN THE UFD
UFDLNK:	BLKB	2			;STORAGE FOR THE LINK POINTER WITHIN AN UFD
CURFIL:	BLKB	6			;STORAGE FOR THE CURRENT FILE NAME
BLOCK:	BLKB	2			;STORAGE FOR THE INPUT BLOCK NUMBER
SCRAT:	BLKB	6			;SCRATCH AREA
JBDEV:	BLKB	2			;JOB DEVICE STORAGE
JBDRV:  BLKB	2			;JOB DRIVE STORAGE
ASCBUF: BLKB	4			;ASCII BUFFER 
INDEV:  BLKB	6
INDRV:  BLKB	2
SPPN:	BLKB	2			;SPECIAL PPN SEARCH PPN NUMBER
PPN1:	BLKB	4			;PPN INPUT CONVERSION STORAGE
PPN2:   BLKB	4			;PPN INPUT CONVERSION STORAGE
PPNFLG:	BLKB	2			;SPECIAL PPN SEARCH FLAG
STATUS:	BLKB	2			;STORAGE FOR JOBTYP
PPNSTO:	BLKB	2			;STORES CURRENT PPN ON DISPLAY
DEFFLG:	BLKB	2			;DEFAUL DEVICE FLAG

CERROR:
	CLR	D1
	MOV	A2,D1
	SUB	D2,D1
	MOV	D1,D2
	ADD	#10,D2
	CLR	D1
ELOOP:
	TST	D2
	BEQ	PERROR
	MOVB	#40,D1
	TTY
	CTRLC	EXIT
	SUB	#1,D2
	BR	ELOOP


PERROR:
	CLR	D1
	MOVB	#'^,D1
	TTY
	TYPECR	<Specification error>
EXIT:
	CLR	D1
	JOBIDX	A3	
	LEA	A2,STATUS		;RESTORE JOBTYP
	MOVW	(A2),D1
	LEA	A2,2(A3)
	MOVW	D1,(A2)
	EXIT
END


.