;MFDPRT.LIT
;
;
;4/10/84            STEVEN G. MCNAUGHTON & RICH EAKIN
;                 QUAKER STATE OIL CORP. RESEARCH CENTER
;
; THIS PROGRAM IS DESIGNED FOR THE AMOS/L SYSTEM.
;
;

; EDIT HISTORY
; 100. - BASIC PRINT TO SCREEN  [SGM]
; 101. - ADDED OUTPUT SWITCH CAPABILITY  [SGM]
; 102. - REMOVED SWITCH TO PRINT - DEFAULTS TO PRINT - NO OPTION   [SGM]
; 103. - CHANGED BLOCK COMPARISON TO LONGWORD FOR DRIVES W/ GREATER
;	THAN 32K BLOCKS.  D. EICHBAUER - MBS DATA SYSTEMS - MERRILL, MI.

SEARCH SYS
SEARCH SYSSYM
SEARCH TRM.UNV


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

VMAJOR=1.
VMINOR=1.
VSUB=1.
VEDIT=103.

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


TOP:
	GETIMP	IMPSIZ,A5,EXIT		;GET SOME IMPURE SPACE
	JOBIDX	A3			;MAKE SURE JOB IS IN OCTAL
	MOVW	2(A3),D1
	LEA	A0,STATUS
	MOVW	D1,(A0)			;STORE THE JOBTYP
	ANDW	#J.HEX,D1
	BEQ	RESPRG
	LEA	A0,2(A3)
	MOVW	(A0),D1
	LEA	A3,STATUS
	MOVW	D1,(A3)
	ANDW	#2757,D1		;MASK OFF J.HEX BIT
	MOVW	D1,(A0)


RESPRG:	LEA	A3,BLOCK
	MOV	#1,(A3)			; (103)
	MOV	A2,D2
	LEA	A3,ASCBUF		;A3 POINTS TO ASCII BUFFER SPACE
	BYP				;BYPASS ANY BLANKS ON COMMAND LINE
	LIN				;END OF LINE?
	JEQ	DEFAUL
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	GOPCK			;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	GOPCK			;YES - GO PACK THE DEV AND DRV
					;*ERROR* DEV AND DRV MUST END IN COLON
	SUB	#2,A2
	JMP	CERROR


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			;

DEFAUL:
	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)

INITDB:					;SET UP AND INIT A DUMMY IDDB
	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	IDDB(A5)		;PROCESS THE FILESPEC (POINTED BY A2)
	LEA	A3,IDDB+D.DEV(A5)	;PUT THE PROPER DEVICE NAME IN
	LEA	A2,INDEV
	MOVW	(A2),(A3)
	LEA	A3,IDDB+D.DRV(A5)	;PUT THE PROPER DRIVE NUMBER IN
	LEA	A2,INDRV
	MOVW	(A2),(A3)
	INIT	IDDB(A5)		;INITIALIZE THE IDDB
	CTRLC	EXIT
	CLR	D1
	TYPESP	<MFD print on device:>
	LEA	A3,IDDB+D.DEV(A5)	;GET THE IDDB'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	ODBCHK	
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

ODBCHK:
	LEA	A3,OPDEV		;OUTPUT DEVICE
	MOVW	#0,(A3)			;DEFAULT DEVICE
	LEA	A3,OPDRV		;OUTPUT DRIVE
	MOVW	#-1,(A3)
ODBINI:
	LEA	A2,BLKBUF
	CLR	D1
	LEA	A3,IDDB+D.DEV(A5)	;GET THE IDDB'S DEVICE NAME
	MOVW	(A3),D1			;MOVE THE PACKED WORD TO D1
	TST	D1			;IS IT A ZERO?
	BNE	UNPCK2			;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,BLKBUF	
	UNPACK
	CLR	D1
	MOVW	JOBDRV(A3),D1		;GET THE DEFAULT DRIVE NUMBER
	DCVT	0,OT$MEM		;CONVERT AND TYPE IT
	CLR	D1
	JMP	DOPRT
UNPCK2:
	CTRLC	EXIT
	LEA	A1,INDEV		;GET AND UNPACK THE DEVICE NAME
	LEA	A2,BLKBUF
	UNPACK
	LEA	A3,INDRV		;GET THE DRIVE NUMBER
	CLR	D1
	MOVB	(A3),D1
	DCVT	0,OT$MEM		;CONVERT AND TYPE IT

DOPRT:	CLR	D1
	LEA	A2,BLKBUF
	FSPEC	ODDB(A5),MFD		;PROCESS THE FILESPEC (POINTED BY A2)
	LEA	A3,ODDB+D.DEV(A5)	;PUT THE PROPER DEVICE NAME IN
	LEA	A2,OPDEV
	MOVW	(A2),(A3)
	LEA	A3,ODDB+D.DRV(A5)	;PUT THE PROPER DRIVE NUMBER IN
	LEA	A2,OPDRV
	MOVW	(A2),(A3)
	INIT	ODDB(A5)		;INITIALIZE THE IDDB
	CTRLC	EXIT
	CLR	D1
	TYPESP	<MFD print has been initiated on:>
	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
	TYPE	<:>	
	PFILE	ODDB(A5)
	CRLF
	LOOKUP	ODDB(A5)		;DOES IT ALREADY EXIST?
	BNE	OPNOP			;NOPE - GO OPEN IT FOR OUTPUT
	DSKDEL	ODDB(A5)		;YES DELETE THE OLD
OPNOP:
	OPENO	ODDB(A5)		;OPEN IT FOR OUTPUT

READBL:
	CLR	D1
	MOV	IDDB+D.DVR(A5),A3	;GET THE DISK DRIVER ADDRESS
	MOV	24(A3),D2		;GET THE TOTAL NUMBER OF BLOCKS/DISK
	LEA	A3,BLOCK		;GET THE INPUTED BLOCK NUMBER
	MOV	(A3),D1			; (103)
	TST	D1			; (103)
	BMI	NEGERR
	CMP	D1,D2		;IS THE INPUTED BLOCK LESS THAN BLOCK (103)
	JLE	GOMFD			;   PER DISK?
BIGERR:	TYPECR	<?Block number specified is too large for this device>	
	JMP	EXIT
NEGERR:	TYPECR	<?Block number specified is a negative octal number>
	JMP	EXIT

GOMFD:
	JOBIDX	A3
	MOV	JOBTRM(A3),A0
	ORW	#1,(A0)			;SET FORCED IMAGE MODE
	LEA	A1,IDDB+D.REC(A5)	;LOAD BLOCK AREA IN DDB
	MOV	D1,(A1)
        READ	IDDB(A5)		;READ THE BLOCK
	CTRLC	EXIT
	MOV     IDDB+D.BUF(A5),A1
	CLR	D1
	MOVW	772(A1),D1
	LEA	A3,BLKLNK
	MOVW	D1,(A3)
	LEA	A3,PASKEY
	MOVW	(A3),D1
	TSTW	D1
	BEQ	PRTBLK
	MOVW	#0,(A3)			;CLEAR PASSKEY
	JMP	OUTDO
PRTBLK:
	TYPE	<Printing output file>
	CRLF
	CLR	D1
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	CLRB	D1
	LEA	A2,ODDB(A5)
	OUTSP	OT$DDB,<Dump of MFD:>

DVPRT:	LEA	A3,IDDB+D.DEV(A5)	;GET THE IDDB'S DEVICE NAME
	MOVW	(A3),D1			;MOVE THE PACKED WORD TO D1
	TST	D1			;IS IT A ZERO?
	BNE	UNPCK3			;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,BLKBUF	
	UNPACK
	LEA	A1,BLKBUF
	LEA	A2,ODDB(A5)
	CLR	D1
	MOVB	(A1)+,D1
	FILOTB	ODDB(A5)
	MOVB	(A1)+,D1
	FILOTB	ODDB(A5)
	MOVB	(A1),D1
	FILOTB  ODDB(A5)
	CLRB	D1
	MOVW	JOBDRV(A3),D1		;GET THE DEFAULT DRIVE NUMBER
	DCVT	0,OT$DDB		;CONVERT AND TYPE IT
	CRLF
	CLR	D1
	JMP	HEDDUN	
UNPCK3:
	LEA	A1,INDEV		;GET AND UNPACK THE DEVICE NAME
	LEA	A2,ASCBUF
	UNPACK
	LEA	A3,ASCBUF
	LEA	A2,ODDB(A5)
	MOVB	(A3)+,D1		;PRINT THE DEVICE NAME
	FILOTB	ODDB(A5)
	MOVB	(A3)+,D1
	FILOTB  ODDB(A5)
	MOVB	(A3)+,D1
	FILOTB	ODDB(A5)
	LEA	A3,INDRV		;GET THE DRIVE NUMBER
	CLR	D1
	MOVB	(A3),D1
	DCVT	0,OT$DDB		;CONVERT AND TYPE IT

HEDDUN:	CLR	D1	
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	FILOTB	ODDB(A5)		;PRINT 2 LINE FEEDS
	OUTSP	OT$DDB,< PPN>
	MOVB	#9.,D1
	FILOTB	ODDB(A5)		;PRINT 2 TABS
	FILOTB	ODDB(A5)
	OUTSP	OT$DDB,<  LINK>
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	FILOTB	ODDB(A5)		;PRINT 2 LINE FEEDS
OUTDO:	CTRLC	EXIT
	MOV	IDDB+D.BUF(A5),A1	;ADDRESS THE READ BUFFER AREA
	LEA	A2,ODDB(A5)
	CLR	D1
PRTLP:	CTRLC	EXIT
	CLR	D1
	CLR	D2
	MOVB	1(A1),D1
	OCVT	0,OT$DDB
	MOVB	#44.,D1
	FILOTB	ODDB(A5)
	MOVW	(A1)+,D2
	MOVB	D2,D1
	OCVT	0,OT$DDB
	MOVB	#9.,D1
	FILOTB	ODDB(A5)		;PRINT 2 TABS
	FILOTB	ODDB(A5)
PRTLP1:
	CTRLC	EXIT
	CLR	D1
	MOVW	(A1)+,D1
	OCVT	6,OT$DDB
	CLR	D1
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	CLRB	D1
	ADD	#4,A1
	MOVW	(A1),D1
	TSTW	D1
	CTRLC	EXIT
	BEQ	DUNPRT
	JMP	PRTLP

DUNPRT:
	CLR	D1
	LEA	A3,BLKLNK
	MOVW	(A3),D1
	LEA	A2,ODDB(A5)
	OUTSP	OT$DDB,<NEXT LINK IN MFD IS:>
	OCVT	6,OT$DDB
	TSTW	D1
	BEQ	ALLDUN
	SAVE	D1
	CLR	D1
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	LEA	A3,PASKEY
	MOVW	#1,(A3)
	CLRW	D1
	REST	D1
	JMP     GOMFD


ALLDUN:	CLR	D1
	MOVB	#15,D1
	FILOTB	ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	MOVW	#177402,D1
	TCRT
	MOVW	#177411,D1
	TCRT
	TYPE	<Output file completed.>
PBLK:
	JMP	EXIT

BLOCK:	BLKB	4		;STORAGE FOR THE INPUT BLOCK NUMBER (103)
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
BLKBUF:	BLKB	8.
OPDEV:	BLKB	2
OPDRV:	BLKB	2
BLKLNK:	BLKB	2
PASKEY: BLKB	2
STATUS: BLKB	2

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
	SUB	#1,D2
	BR	ELOOP


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

EXIT:
	CRLF
	CLR	D1
	MOVB	#15,D1
	FILOTB  ODDB(A5)
	MOVB	#12,D1
	FILOTB	ODDB(A5)
	CLOSE	ODDB(A5)
FINI:
	LEA	A3,STATUS
	CLR	D1
	MOVW	(A3),D1
	JOBIDX	A3
	LEA	A0,2(A3)
	MOVW	D1,(A0)
	EXIT
END