;3/9/84    STEVEN G. MCNAUGHTON  &  RICH EAKIN
; QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
; *									*
; *									*
; *									*


SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV

.OFINI
.OFDEF	DDB,D.DDB			;FILE DDB
.OFDEF	ODDB,D.DDB			;OUTPUT DDB
.OFSIZ	IMPSIZ


VMAJOR=1.
VMINOR=1.
VSUB=1.
VEDIT=101.

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


TOP:
	GETIMP	IMPSIZ,A5,EXIT
	MOV	A2,D3
	CLR	D2			;COLUMN PER PAGE TALLY

	BYP				;BYPASS BLANKS ON COMMAND LINE
	LIN
	JEQ	DEFAUL
	BYP
	MOVB	(A2),D1
	CMPB	D1,#'/			;IS IT A SLASH?
	BEQ	DCHK
	JMP	COMLP

DCHK:
	MOVB	(A2)+,D1
	MOVB	(A2),D1	
	CMPB	D1,#'P			;IS IT A P FOR PRINT?
	JNE	CERROR			;NO ! COMMAND ERROR
	LEA	A2,INDEV
	MOVW	#0,(A2)
	LEA	A2,INDRV
	MOVW	#-1,(A2)
	LEA	A2,DEFLG
	MOVW	#1,(A2)			;SET THE DEFAULT FLAG
	CLR	D1
	MOVW	#177400,D1
	TCRT
	CLR	D1
	JMP	OUTDB

COMLP:
	CLR	D4
	CLR	D2
	CLR	D1
	LEA	A1,INDEV	
	MOVB	(A2)+,(A1)+
	MOVB	(A2)+,(A1)+
	MOVB	(A2)+,(A1)+
	LEA	A1,INDRV
	MOVB	(A2)+,(A1)+
	BYP
	LIN
	JEQ	CERROR
	CLR	D1
	MOVB	(A2),D1
	CMPB	D1,#':
	JEQ	ADDONE
	MOVB	(A2),(A1)
	BYP
	LIN				;ANY MORE NUMBERS
	JEQ	CERROR
	MOVB	(A2)+,D1
	MOVB	(A2),D1
	CMPB	D1,#':
	JNE	CERROR
ADDONE:
	MOVB	(A2)+,D1
SLCHK:
	BYP
	LIN
	JEQ	CONNUM
	MOVB	(A2)+,D1
	CMPB	D1,#'/			;IS IT A SLASH?
	BEQ	PCHK
	JMP	CERROR


PCHK:	MOVB	(A2),D1	
	CMPB	D1,#'P			;IS IT A P FOR PRINT?
	JNE	CERROR			;NO ! COMMAND ERROR
	CLR	D4
	MOVW	#1,D4			;SET A FLAG (PRINT FLAG)

CONNUM:
	LEA	A2,INDRV
	GTDEC
NUMDUN:	LEA	A2,INDRV
	MOVW	D1,(A2)
	CLR	D1
	MOVW	#177400,D1		;CLEAR THE SCREEN
	TCRT
	CLR	D1
	CLR	D3
	TST	D4
	JEQ	INITDB
	JMP	OUTDB

DEFAUL:
	LEA	A2,INDEV
	MOVW	#0,(A2)
	LEA	A2,INDRV
	MOVW	#-1,(A2)
	LEA	A2,DEFLG
	MOVW	#1,(A2)
	CLR	D1
	MOVW	#177400,D1
	TCRT
	JMP	INITDB

OUTDB:
	CLR	D1
	LEA	A2,DEFLG
	MOVW	(A2),D1
	TST	D1
	JEQ	IDDBO

	JOBIDX	A3
	LEA	A2,SCRAT
	MOVW	JOBDEV(A3),(A2)+	
	CLR	D1
	MOVW	JOBDRV(A3),D1
	LEA	A1,PACBUF
	SAVE	D3
	MOV	A2,D3
	LEA	A2,ASCBUF
	DCVT	0,OT$MEM
	MOVB	#40,(A2)
	LEA	A2,ASCBUF
	PACK
	MOV	D3,A2
	LEA	A1,PACBUF
	MOVW	(A1),(A2)
	CLR	D1
	REST	D3
	BR	LDDBO

IDDBO:
	LEA	A2,INDEV
	LEA	A1,PACBUF
	PACK
	LEA	A2,SCRAT
	LEA	A1,PACBUF
	MOVW	(A1),(A2)+
	SAVE	D3
	MOV	A2,D3	
	LEA	A2,ASCBUF
	LEA	A1,INDRV
	CLR	D1
	MOVW	(A1),D1
	DCVT	0,OT$MEM
	LEA	A1,PACBUF
	MOVB	#40,(A2)
	LEA	A2,ASCBUF
	PACK
	CLR	D1
	MOV	D3,A2
	LEA	A1,PACBUF
	MOVW	(A1),(A2)	
	REST	D3

LDDBO:	LEA	A2,JUNK			;LOAD A OUTPUT FILESPEC IN
	MOVW	#377,(A2)+
	MOVW	#377,(A2)+
	MOVW	#377,(A2)+
	LEA	A2,JUNK
	FSPEC   ODDB(A5),UFD
	LEA	A2,SCRAT
	LEA	A1,D.FIL+ODDB(A5)		;YES - LOAD THE OUTPUT DDB FSPEC
	MOVW	(A2)+,(A1)+
	MOVW	(A2)+,(A1)+
	MOVW	#[UFD],(A1)
	INIT	ODDB(A5)		;INIT IT
	TYPESP	<Print option has been initiated - output to:>
	PFILE 	ODDB(A5)
	CRLF

	LOOKUP	ODDB(A5)		;DOES IT ALREADY EXIST?
	BNE	OPNIT			;NO OPEN IT FOR OUTPUT
	DSKDEL	ODDB(A5)		;YES - DELETE THE OLD ONE
OPNIT:
	OPENO	ODDB(A5)		;OPEN THE OUTPUT FILE
	LEA	A3,FLAG			;SET THE PRINT FLAG
	MOVW	#1,(A3)			;#1 MEANS PRINT COMMAND IS SPECIFIED

	
	LEA	A2,ODDB(A5)
	OUTSP	OT$DDB,<Possible UFD blocks on:>
	EVEN
	CLR	D1
	LEA	A2,INDEV		;GET THE DEVICE TO SEARCHED
	MOVB	(A2),D1			;GET THE FIRST BYTE
	TST	D1			;IS IT A ZERO (DEFAULT DEVICE)?
	BEQ	PDFLT			;YES - GET THE DEFAULT AND PRINT IT
	MOVB	(A2)+,D1		;GET THE FIRST BYTE
	FILOTB	ODDB(A5)		;NO - PRINT THE FIRST CHARACTER
	MOVB	(A2)+,D1	
	FILOTB	ODDB(A5)
	MOVB	(A2),D1
	FILOTB	ODDB(A5)
	LEA	A2,INDRV
	CLR	D1
	MOVW	(A2),D1
	LEA	A2,ODDB(A5)
	DCVT	0,OT$DDB
	CLR	D1
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	JMP	INITDB
PDFLT:
	
	JOBIDX	A3
	CLR	D1
	MOVW	JOBDEV(A3),D1	
	LEA	A1,PACBUF
	MOVW	D1,(A1)
	LEA	A2,ASCBUF	
	UNPACK
	LEA	A2,ASCBUF
	MOVB	(A2)+,D1
	FILOTB	ODDB(A5)
	MOVB	(A2)+,D1
	FILOTB	ODDB(A5)
	MOVB	(A2)+,D1
	FILOTB  ODDB(A5)
	CLR	D1
	MOVW	JOBDRV(A3),D1
	LEA	A2,ODDB(A5)
	DCVT	0,OT$DDB
	CLR	D1
	MOVB	#15,D1			;OUTPUT A CARRIAGE RETURN
	FILOTB	ODDB(A5)
	MOVB	#12,D1			;OUTPUT A LINE FEED
	FILOTB	ODDB(A5)

INITDB:	
	LEA	A2,SCRAT		;LOAD A DUMMY FILESPEC IN
	MOVW	#377,(A2)+
	MOVW	#377,(A2)+
	MOVW	#377,(A2)+
	LEA	A2,SCRAT
	FSPEC	DDB(A5)
	LEA	A1,PACBUF		;LOAD THE RAD 50 BUFFER
	LEA	A2,INDEV		;LOAD THE ASCII DEVICE NAME
	PACK				;PACK WILL CONVERT 3 BYTES AND LEAVE A2
					;POINTING AT THE NEXT BYTE!
	LEA	A1,PACBUF
	LEA	A3,D.DEV+DDB(A5)	;GET THE DEVICE TO BE SEARCHED
	MOVW	(A1),(A3)		;LOAD THE DEVICE NAME
	CLR	D1
	LEA	A2,INDRV
	MOVW	(A2),D1
	LEA	A3,D.DRV+DDB(A5)
	MOVW	D1,(A3)

	TYPESP	<UFD search commencing on:>
	CLR	D1
	LEA	A3,DEFLG
	MOVW	(A3),D1
	TST	D1
	JNE	DEFLOG
	CLR	D1
	LEA	A3,INDEV
	MOVB	(A3)+,D1
	TTY
	MOVB	(A3)+,D1
	TTY
	MOVB	(A3)+,D1
	TTY
	LEA	A3,INDRV
	MOVW	(A3)+,D1
	DCVT	0,OT$TRM
	CRLF
	JMP	TYPTWO
DEFLOG:
	JOBIDX	A3
	CLR	D1
	MOVW	JOBDEV(A3),D1	
	LEA	A1,PACBUF
	MOVW	D1,(A1)
	LEA	A2,ASCBUF	
	UNPACK
	LEA	A2,ASCBUF
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	MOVB	(A2)+,D1
	TTY
	CLR	D1
	MOVW	JOBDRV(A3),D1
	DCVT	0,OT$TRM
	CRLF
TYPTWO:
	INIT	DDB(A5)			;INITIALIZE THE DDB
	CTRLC	EXIT


	MOV	D.DVR+DDB(A5),A3		;GET THE DEVICE DRIVER ADDRESS
	MOV	24(A3),D1
	LEA	A2,BLOCKS
	MOV	D1,(A2)
	TYPESP	<This device contains a total block count of:>
	DCVT	0,OT$TRM
	CLR	D1
	CRLF
	TYPECR	<The following blocks appear to be User File Directories:>
	CRLF

STLOOP:
	MOV	#1,D0			;D0 TALLY FOR BLOCK NUMBER

SCNBLK:
	CTRLC	EXIT
	CLR	D1
	LEA	A1,DDB+D.REC(A5)		;LOAD BLOCK # INTO DDB
	MOV	D0,(A1)
        READ	DDB(A5)			;READ THE BLOCK
	MOV	DDB+D.BUF(A5),A1		;ADDRESS THE READ BUFFER AREA
	ADD	#6,A1
	MOVW	(A1),D1			;MOVE THE SIXTH WORD IN
					;THIS WILL BE THE FIRST EXTENSION
	MOV	#21.,D3
EXTCHK:	CTRLC	EXIT

	CMPW	D1,#[REN]
	JEQ	FOUND
	CMPW	D1,#[OLD]
	JEQ	FOUND
	CMPW	D1,#[BAS]
	JEQ	FOUND
	CMPW	D1,#[M68]
	JEQ	FOUND
	CMPW	D1,#[RUN]
	JEQ	FOUND

	CMPW	D1,#[LIT]
	JEQ	FOUND
	CMPW	D1,#[SYS]
	JEQ	FOUND
	CMPW	D1,#[BAK]
	JEQ	FOUND
	CMPW	D1,#[IDX]
	JEQ	FOUND
	CMPW	D1,#[IDA]
	JEQ	FOUND

	CMPW	D1,#[SEQ]
	JEQ	FOUND
	CMPW	D1,#[LST]
	JEQ	FOUND
	CMPW	D1,#[DAT]
	JEQ	FOUND
	CMPW	D1,#[TXT]
	JEQ	FOUND
	CMPW	D1,#[BV]
	JEQ	FOUND

	CMPW	D1,#[DBD]
	JEQ	FOUND
	CMPW	D1,#[DBK]
	JEQ	FOUND
	CMPW	D1,#[CPY]
	JEQ	FOUND
	CMPW	D1,#[S]
	JEQ	FOUND
	CMPW	D1,#[R]
	JEQ	FOUND

	CMPW	D1,#[RPT]
	JEQ	FOUND
	CMPW	D1,#[SAV]
 	JEQ	FOUND
	CMPW	D1,#[OBJ]
	JEQ	FOUND
	CMPW	D1,#[SYM]
	JEQ	FOUND
	CMPW	D1,#[INI]
	JEQ	FOUND

	CMPW	D1,#[MNU]
	JEQ	FOUND
	CMPW	D1,#[CMN]
 	JEQ	FOUND
	CMPW	D1,#[HLP]
	JEQ	FOUND
	CMPW	D1,#[HLV]
	JEQ	FOUND
	CMPW	D1,#[QRY]
	JEQ	FOUND

	CMPW	D1,#[CMD]
	JEQ	FOUND
	CMPW	D1,#[DO]
	JEQ	FOUND
	CMPW	D1,#[SV]
	JEQ	FOUND
	CMPW	D1,#[LSP]
 	JEQ	FOUND

	CMPW	D1,#[VUE]
	JEQ	FOUND
	CMPW	D1,#[SBR]
	JEQ	FOUND
	CMPW	D1,#[UNV]
	JEQ	FOUND
	CMPW	D1,#[LIB]
	JEQ	FOUND



	SUB	#1,D3
	TST	D3
	BEQ	ADDBLK
	ADD	#14,A1
	MOVW	(A1),D1
	JMP	EXTCHK

ADDBLK:
	SAVE	D1,A2
	LEA	A2,BLOCKS
	MOV	(A2),D1
	CMP	D0,D1
	JEQ	EXPRP
	REST	D1,A2
	ADD	#1,D0
	JMP	SCNBLK

EXPRP:
	REST	D1,A2
	JMP	EXIT


FOUND:
	SAVE	D1

	CLR	D4
	CMP	D2,#10.			;OUTPUT IN 10(DEC) COLUMNS
	BNE	PRNTIT
	LEA	A3,FLAG
	MOVW	(A3),D4
	CMPW	D4,#1
	BNE	SCRIT
	MOVB	#15,D1
	FILOTB  ODDB(A5)
	MOVB	#12,D1
	FILOTB  ODDB(A5)
	REST	D1
SCRIT:	CRLF
	MOV	#0,D2
PRNTIT:
	LEA	A3,FLAG
	MOVW	(A3),D4
	MOV	D0,D1
	OCVT	0,OT$TRM
	TAB
	CMPW	D4,#1
	BNE	JUMP
	LEA	A2,ODDB(A5)
	OCVT	0,OT$DDB
	CLR	D1
	MOVB	#11,D1			;PRINT A TAB
	FILOTB	ODDB(A5)
JUMP:	ADD	#1,D2
	JMP	ADDBLK

JUNK:	BLKB	6
SCRAT:	BLKB	6			;SCRATCH AREA
INDEV:	BLKB	4
INDRV:  BLKB    2
FLAG:	BLKB	2
DEFLG:	BLKB	2
PACBUF:	BLKB	4
ASCBUF: BLKB	4
DRIVE:	BLKB	6
BLOCKS:	BLKB	4


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


PERROR:
	CLR	D1
	MOVB	#'^,D1
	TTY
	TYPECR	<Specification error>


EXIT:
	CLR	D1
	LEA	A3,FLAG
	MOVW	(A3),D1
	CMPW	D1,#1
	BNE	FALOUT
	CLR	D1
	MOVB	#15,D1			;OUTPUT A CARRIAGE RETURN
	FILOTB	ODDB(A5)
	MOVB	#12,D1			;OUTPUT A LINE FEED
	FILOTB	ODDB(A5)
	CLOSE	ODDB(A5)
FALOUT:	CRLF
	EXIT
END