.TITLE	DIA
	.IDENT	/MRH001/
	.MCALL	FINIT$,FSRSZ$,QIOW$,DIR$,CALL,RETURN
	.MCALL	OPEN$,OPEN$R,GET$,CLOSE$
	.MCALL	CSI$,CSI$1,CSI$2,GMCR$,EXIT$S,GTIM$
	.MCALL	GCML$,RCML$,GCMLB$,PRINT$
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A
	.MCALL	FDOP$R,NMBLK$,CSI$SW,CSI$ND,CSI$SV
;+
;
; DIA[BLO] PROGRAM TO OUTPUT FILES TO DIABLO PRINTER IN WRITE PASS ALL
; MODE SO VARIOUS ESC SEQUENCES WORK
;
;CALLING SEQUENCE
;
;MCR>DIA[BLO] DEV:[UIC]NAME.TYPE
;
;		F. BORGER
;		MICHAEL REESE MEDICAL CENTER
;
;		DEC 1980
;
;
; EVF'S AND LUNS
;
OUTLUN	=1	;OUTPUT LUN
OUTEVF	=1	;AND EVF
;
TILUN	=2	;TERMINAL IO LUN
TIEVF	=2	;AND EVF
;
TIFLUN	=3	;TERMINAL "FILE" LUN
TIFEVF	=3	;AND EVF
;
INFLUN	=4	;THE FIRST IN-FILE LUN
INFEVF	=4	;AND EVF

	.SBTTL	MAIN LINE CODE
START:	FINIT$				;SET UP FOR FILE IO FOR FILE I/O
	GCML$	#GCBLK			;GET THE COMMAND LINE
	CMPB	#GE.EOF,GCBLK+G.ERR 	;END OF FILE ON COMMAND INPUT ?
	BNE	5$			;NO
	EXIT$S				;YES, QUIT
5$:	TSTB	GCBLK+G.ERR		;ANY OTHER ERRORS ?
	BPL	6$			;NO
	DIR$	#ERPRI			;REPORT COMMAND LINE FILE ERROR
	DIR$	#CMDERR
	EXIT$S
6$:					;FILL IN POINTERS IN CSI BLOCK
	MOV	GCBLK+G.CMLD+2,CSBLK+C.CMLD+2
	MOV	GCBLK+G.CMLD,CSBLK+C.CMLD
	CSI$1	#CSBLK			;AND PARSE IT
	CSI$2	#CSBLK,OUTPUT,#SWTAB	;TRY FOR AN OUTPUT SPEC
22$:	BITB	#CS.NMF,C.STAT(R0) 	;IS A NAME GIVEN?
	BNE	4$			;YES
	DIR$	#ERPRI
	DIR$	#NAMERR
	EXIT$S
4$:	FDOP$R	#INFDB,,#CSBLK+C.DSDS	;FILL IN FILE NAME TO BE LISTED
REGO:	OPEN$R	#INFDB			;AND OPEN IT
	BCC	FIRST			;BR IF OK
	DIR$	#ERPRI			;ELSE REPORT PROBLEM
	DIR$	#NAMERR
	EXIT$S
FIRST:					;TRANSFER INITIALIZING LINE TO DIABLO
	CLR	SPEFLG			;CLEAR "SPECIAL FILE" FLAG
	GET$	#INFDB,#BUF1,#132.	;GET FIRST RECORD OF FILE
	TSTB	BUF1			;FIRST CHARACTER OF FILE A NULL ?
	BNE	NOTSPE			;NO ,DO INITIAL FORM-FEED
	CMPB	INFDB+F.NRBD,#1		;YES, A 1-CHAR RECORD ?
	BNE	NOTSPE			;IF NOT, DO INITIAL FORM-FEED
	INC	SPEFLG			;SHOW FILE IS SPECIAL
	MOV	#FIRST1,OUTQIO+Q.IOPL	;SKIP INITIAL FORM-FEED
	MOV	#FIRS1L,OUTQIO+Q.IOPL+2
	BR	RESET			;AND START READING WITH NEXT LINE
NOTSPE:	MOV	#FIRSTS,OUTQIO+Q.IOPL	;DO INITIALIZING LINE WITH FF
	MOV	#FIRSTL,OUTQIO+Q.IOPL+2
	DIR$	#OUTQIO
RESET:	MOV	#BUF1,OUTQIO+Q.IOPL	;AND RESET POINTER TO INPUT BUFFER
	MOV	#40,OUTQIO+Q.IOPL+4	;RESET CARRIAGE CONTROL CHARACTER
	.SBTTL	SET UP TRANSFER TO LISTING FILE
	TST	SPEFLG			;SPECIAL FILE ?
	BNE	IN			;IF SO, SKIP NEXT
	CMPB	BUF1,#14		;FIRST CHARACTER OF FILE A FF
	BNE	TABSET			;NO
	CMPB	INFDB+F.NRBD,#1		;YES, A 1-CHAR RECORD ?
	BNE	TABSET			;IF NOT, DO IT ANYWAY
	BR	IN			;IT'S A RUNOFF FILE, FORGET ABOUT TABS
TABSET:	MOV	#TABLIN,OUTQIO+Q.IOPL	;SET UP FOR TAB SETTING QIO
	MOV	#TABLEN,OUTQIO+Q.IOPL+2
	DIR$	#OUTQIO			;SET UP TAB STOPS ON THE DIABLO
	MOV	#BUF1,OUTQIO+Q.IOPL	;RESET POINTER TO INPUT BUFFER
	BR	IN1			;SKIP READ CAUSE WE WANT FIRST LINE

	.SBTTL	MAIN TRANSFER LOOP
IN:	GET$	#INFDB,#BUF1,#132.	;GET A RECORD
IN1:	CMPB	INFDB+F.ERR,#IE.EOF	;END OF FILE
	BEQ	DONE			;YES
	TST	INFDB+F.ERR		;NO
	BPL	333$			;IF PLUS OK
	DIR$	#ERPRI
	DIR$	#FILERR
	JMP	DONE			;AND EXIT
333$:	MOV	INFDB+F.NRBD,OUTQIO+Q.IOPL+2 ;TRANSFER SIZE OF LINE
	TST	SPEFLG			;SPECIAL FILE ?
	BNE	334$			;IF SO, SKIP LENGTH TEST
	CMP	OUTQIO+Q.IOPL+2,#85.	;WILL IT TEAR 8&1/2" PAPER ?
	BLE	334$			;BR IF OK
	MOV	#85.,OUTQIO+Q.IOPL+2	;ELSE LIMIT TO PAPER SIZE
334$:	DIR$	#OUTQIO			;OUTPUT THE LINE
	BCC	IN			;BR IF OK
	DIR$	#ERPRI
	DIR$	#FILERR
DONE:				;NORMAL EXIT
	DEC	COPYCT		;COUNT ONE COPY
	BEQ	DIE		;IF ALL DONE, THEN QUIT
	CLOSE$	#INFDB		;CLOSE FILE
	JMP	REGO		;AND OPEN AGAIN
DIE:	CLOSE$	#INFDB		;CLOSE INPUT FILE
	EXIT$S			;AND EXIT

	.SBTTL	FDB'S
	.SBTTL		INPUT FDB
;
;
; THE INPUT FILE
;
INFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILE ATTRIBUTES
	FDRC$A	,BUF1,132.	;RECORD
	FDOP$A	INFLUN		;FILE NAME
	FDBF$A	INFEVF		;EVF
;
;
;
;
	.SBTTL		TERMINAL FDB
;;;;;
;
; THE TERMINAL'S FDB
;
TIFDB:	FDBDF$			;DEFINE FDB BLOCK
	FDAT$A	R.VAR,FD.CR	;FILES ATTRIBUTES
	FDRC$A	,BUF1,80.	;RECORD
	FDOP$A	TIFLUN,TIDSDS	;FILE NAME
	FDBF$A	TIFEVF		;FILE EVF
;
TIDSDS:	.WORD	LTI,TI
	.WORD	0,0
	.WORD	0,0
;
TI:	.ASCII	/TI:/
LTI=.-TI
	.EVEN
;
	.SBTTL	MISCELLANEOUS
	.SBTTL		CSI CONTROL BLOCK
;
	CSI$
CSBLK:	.BLKB	C.SIZE
	.EVEN
SWTAB:	CSI$SW	CO,,,,,COPYAL	;COPY COUNT SWITCH
	CSI$ND
COPYAL:	CSI$SV	DECIMAL,COPYCT,2 ;2 DIGIT DECIMAL COPY COUNT
	CSI$ND
COPYCT:	.WORD	1		;NORMALLY ONLY 1 COPY
SPEFLG:	.WORD	0		;FLAG FOR SPECIAL FILE
	.SBTTL		GCML CONTROL BLOCK
;
GCLUN	=TILUN
GCBLK:	GCMLB$	2,RNP,,GCLUN
;
	.SBTTL		OTHER THINGS
;
;
BUF1:	.BLKW	132.		;THE RECORD BUFFER
;
	FSRSZ$	2		;ROOM FOR 2 FILES (INPUT & COMMAND)

.SBTTL	QIO DPB'S ETC
;THE TT3 QIO
;
OUTQIO:	QIOW$	IO.WVB!TF.WAL,OUTLUN,OUTEVF,,,,<BUF1,0,0>
;
FIRSTS:	.BYTE	14
FIRST1:	.BYTE	33,37,15	;SET TO 10 CHARACTERS/INCH HORIZ
	FIRSTL=.-FIRSTS
	FIRS1L=FIRSTL-1
	.EVEN
TABLIN:	.REPT	9.
	.ASCII	/        /
	.BYTE	33,61
	.ENDR
	TABLEN=.-TABLIN
	.EVEN
	.SBTTL		ERROR MESSAGES
;
ERPRI:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<PRIMES,PRILEN,44>
PRIMES:	.ASCII	/***DIA---/
PRILEN=.-PRIMES
	.EVEN
NAMERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<NAMMES,NAMLNG,53>
NAMMES:	.ASCII	/BAD FILE NAME***/
NAMLNG=.-NAMMES
	.EVEN
FILERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<FILMES,FILLEN,53>
FILMES:	.ASCII	/ERROR ON FILE IO***/
FILLEN=.-FILMES
	.EVEN
CMDERR:	QIOW$	IO.WVB,TILUN,TIEVF,,,,<CMDMES,CMDLEN,53>
CMDMES:	.ASCII	/ERROR ON INDIRECT COMMAND FILE***/
CMDLEN=.-CMDMES
	.EVEN
;
;
	.END	START