.TITLE	EXA -- File examine task
	.ENABL	LC
;
;	  ********   ********    *******   **     **  **     **
;	  *********  *********  *********  **     **  **     **
;	  **     **  **     **  **     **  **     **  ***    **
;	  **     **  **     **  **     **  **     **  ****   **
;	  ********   *********  **     **  **     **  ** **  **
;	  ********   ********   **     **  **  *  **  **  ** **
;	  **     **  **  **     **     **  ** *** **  **   ****
;	  **     **  **   **    **     **  **** ****  **    ***
;	  *********  **    **   *********  ***   ***  **     **
;	  ********   **     **   *******   **     **  **     **
;	
;	
;	  ********    *******   **     **  *********  ********   **
;	  *********  *********  **     **  *********  *********  **
;	  **     **  **     **  **     **  **         **     **  **
;	  **     **  **     **  **     **  **         **     **  **
;	  ********   **     **  **     **  *****      *********  **
;	  ********   **     **  **     **  *****      ********   **
;	  **     **  **     **  **     **  **         **  **     **
;	  **     **  **     **   **   **   **         **   **    **
;	  *********  *********    *****    *********  **    **   **
;	  ********    *******      ***     *********  **     **  **
;	
;	
;	
;	
;		    *   *   **    **   ***    **     *   * 
;		    ** **  *  *  *  *  *  *  *  *   **  ** 
;		    * * *  ****  *     ***   *  *    *   * 
;	  	    *   *  *  *  *  *  *  *  *  *    *   * 
;	  	    *   *  *  *   **   *  *   **    *** ***
;
;
;
;
;			BBC Brown Boveri b.v.
;			afd. industriele automatisering
;			postbus 301, 3000 AH  Rotterdam
;			telefoon: 010-4078911
;
;			Auteur	: J.H.HAMAKERS
;			Account : 1,24
;			File	: EXA.MAC
			.ident	-V02.1a-
; EDITED:
;	23-JAN-85	Add <CR> in clear message to avoid devicebuffer
;			  overflow on first line of page. Take terminal
;			  buffersize as line width for output		;JHA03
;	12-Oct-87	Support VT52 terminals				;JHA04
;			  
	.MCALL	FCSMC$,OFID$R
	.MCALL	DIR$,QIOW$,ASTX$S
	.MCALL	EXIT$S
	.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2
;
FCSMC$
;
;	INPUT FILE FDB
;
FDB1:	FDBDF$
	FDRC$A	,IOBUF,IOBUFL
	FDOP$A	2,CSIB+C.DSDS,DFN1,FO.RD!FA.SHR
;
	RECL=FDB1+F.NRBD
;
DFN1:	NMBLK$	,LST,,SY,0
;
FNB1:	.BLKW	S.FNBW
;
	FSRSZ$	1
;
;	GCML BLOCK
;
GCMLB:	GCMLB$	0,EXA,IOBUF
;
;
;	CSI BLOCK
;
	CSI$
CSIB:	.BLKB	C.SIZE
;
;
;	WORK AREAS
;
;
IOBUF:	.BLKB	255.+2.		; I/O BUFFER				;JHA03
	IOBUFL=.-IOBUF
INBUF:	.BLKB	1		; TERMINAL INPUT BUFFER
	INBUFL=.-INBUF
PRBUF:	.BYTE	15		; TERMINAL PROMPT
	.ASCII	/==>/
	PRBUFL=.-PRBUF
	.EVEN
EOFFL:	0			; EOF flag
LNCNT:	0			; LINE COUNT
LFFLG:	0			; LF FLAG
PGCNT:	0			; PAGE COUNT
NPAGE:	0			; NEW PAGE
IOSB:	0,0			; I/O STATUS BLOCK
PNTR:	IOBUF			; RECORD POINTER
GMCB:
	.BYTE	TC.ANI		; Ansii terminal ?			;JHA04
ANSII:	.BYTE	0		;					;JHA04
	.BYTE	TC.WID		; Bufferwidth				;JHA03
TIBUFB:	.BYTE	0							;JHA03
	.BYTE	TC.TTP		; Terminal type				;JHA04
TTTYP:	.BYTE	0		;					;JHA04
GMCBL=.-GMCB								;JHA03
;
TIBUF:	0								;JHA03
;
;	ERROR MESSAGES
;
;
	.NLIST	BEX
E1:	.ASCII	/EXA -- Command file error/
	E1L=.-E1
E2:	.ASCII	/EXA -- Command syntax error/
	E2L=.-E2
E3:	.ASCII	/EXA -- Open failure on input file/
	E3L=.-E3
E4:	.ASCII	\EXA -- I/o error on input file\
	E4L=.-E4
E5:	.ASCII	\EXA -- Terminaltype not supported\			;JHA04
	E5L=.-E5
CLR:	.ASCII	<33>/)0/<33>/[1;1H/<33>/[2J/<15>			;JHA03
	CLRL=.-CLR
CLR52:	.ASCII	<33>/H/<33>/J/<15>					;JHA04
	CLR52L=.-CLR52							;JHA04
M52EO:	.ASCII	<33>/Y5 /						;JHA04
	.ASCII	<15><12>/<EOF>/						;JHA04
	M52EOL=.-M52EO							;JHA04
M1EOF:	.ASCII	<33>/[22;1H/
M2EOF:	.ASCII	<15><12>/<EOF>/
	M1EOFL=.-M1EOF
	M2EOFL=.-M2EOF
MRK:	.ASCII	<15><12><16>/`u/<17>/ /
	MRKL=.-MRK
MRK52:	.ASCII	<15><12><33>/Fh /<33>/G/				;JHA04
	MRK52L=.-MRK52							;JHA04
CRLF:
	.BYTE	15,12
	.EVEN
;
;	ERROR CONTROL TABLE
;
ERT:	E1,E1L
	E2,E2L
	E3,E3L
	E4,E4L
	E5,E5L
;
;	QIO DIRECTIVE PARAMETER BLOCKS
;
QIO:	QIOW$	IO.ATA,1,1,,,,<UNSOL>
QIO1:	QIOW$	IO.RPR!TF.RNE,1,1,,IOSB,,<INBUF,INBUFL,,PRBUF,PRBUFL,44>
QIO2:	QIOW$	SF.GMC,1,1,,,,<GMCB,GMCBL>				;JHA03
MARK:	QIOW$	IO.WVB,1,1,,,,<MRK,MRKL,0>
NLINE:	QIOW$	IO.WVB,1,1,,,,<CRLF,2,0>
CLEAR:	QIOW$	IO.WVB,1,1,,,,<CLR,CLRL,0>
EOF1:	QIOW$	IO.WVB,1,1,,,,<M1EOF,M1EOFL,0>
EOF2:	QIOW$	IO.WVB,1,1,,,,<M2EOF,M2EOFL,0>
;
;	ENTRY POINT
;
	.LIST	BEX
GO:
	FINIT$			; Init FSR
	DIR$	#QIO2,$DSWR$	; Get characteristics
	TSTB	GMCB+1		; Ansii terminal			;JHA04
	BNE	10$		;  Yes : => 10$
	CMPB	TTTYP,#T.VT52	; VT52 ? 				;JHA04
	BEQ	5$		;  Yes : => 5$				;JHA04
	JMP	EL5		;  No  : => EL5
5$:
;
; Change messages for VT52
;
	MOV	#CLR52,CLEAR+Q.IOPL					;JHA04
	MOV	#CLR52L,CLEAR+Q.IOPL+2					;JHA04
	MOV	#MRK52,MARK+Q.IOPL					;JHA04
	MOV	#MRK52L,MARK+Q.IOPL+2					;JHA04
	MOV	#M52EO,EOF1+Q.IOPL					;JHA04
	MOV	#M52EOL,EOF1+Q.IOPL+2					;JHA04
10$:
	MOVB	TIBUFB,TIBUF	; Copy bufferlength			;JHA03
	BIC	#177400,TIBUF	; No sign extension			;JHA03
	DIR$	#QIO,$DSWR$	; Attatch screen
	MOV	#IO.WLB,QIO+Q.IOFN
				; Alter DPB
GO1:
	CLR	LFFLG		; Reset <LF> flag
	CLR	EOFFL		; Reset <EOF> flag
	CLR	R5		; Error pointer
	GCML$	#GCMLB		; Get commandline
	BCC	30$		;  OK => 30$
	CMPB	#GE.EOF,GCMLB+G.ERR
	BNE	10$		; ^Z => EXIT
	JMP	EXIT		;
10$:
	JMP	EL1		;
20$:
	JMP	EL2		;
30$:
	TST	GCMLB+G.CMLD	; Any input
	BEQ	GO1		;  No: => GO1
;
; Test CSI syntax etc.
;
	CSI$1	#CSIB,GCMLB+G.CMLD+2,GCMLB+G.CMLD
	BCS	20$
	CSI$2	#CSIB,OUTPUT
	BCS	20$
	BITB	#CS.MOR!CS.WLD!CS.EQU,C.STAT(R0)
	BNE	20$
;
; Open file
;
	OPEN$R	#FDB1		; Open file for read
	BCC	40$		; OK => 40$
	JMP	EL3		;  FCS error
40$:
	MOV	#FDB1+F.FNB,R0	; +
	MOV	#FNB1,R1	;
	MOV	#S.FNBW,R2	;  Copy  
50$:
	MOV	(R0)+,(R1)+	;    FNB
	SOB	R2,50$		; -
;
	CLR	NPAGE		; No pages yet
GO2:
	CLR	PGCNT		;+
	CLRB	INBUF		; Clear some things
	CLR	RECL		;-
	CALL	GET		; Get the first record
LOOP1:
	TST	EOFFL		; <EOF> ?
	BNE	EOFLAB		;  Yes: => tell it
	TST	LFFLG		; Typed <LF> ?
	BNE	LOOP2		;  Yes: => LOOP2
	DIR$	#CLEAR,$DSWR$	; Clear screen
LOOP2:
	MOV	#20.,LNCNT	; Next time 20 lines
	INC	PGCNT		; One page more
	CALL	PUT		; Write to screen
10$:
	CALL	GET		; Get next record
	TST	EOFFL		; <EOF> ?
	BNE	EOFLAB		;  Yes: => tell it
	CMPB	(R1),#14	; <FF> ?
	BEQ	20$		;  Yes: => 20$
	TST	LNCNT		; Page full ?
	BLE	20$		;  Yes : => 20$
	CALL	PUT		; Write to screen
	BR	10$		;  => Next record
20$:
	CMP	PGCNT,NPAGE	; Reached wanted page ?
	BLT	LOOP2		;  No : => LOOP2 
	TST	LFFLG		; Typed <LF> ?
	BNE	LOOP1		;  Yes: => LOOP1
	DIR$	#NLINE		; New line
	BR	INPUT		; Read command
EOFLAB:
	TST	LFFLG		; <LF> given ?
	BNE	10$		;  Yes: => 10$
	DIR$	#EOF1		; Tell <EOF>
	BR	INPUT		;  => INPUT
10$:
	CLR	LFFLG		; 
	DIR$	#EOF2		; Tell <EOF>
INPUT:
	DIR$	#QIO1		; Read after prompt
	CMPB	#33,IOSB+1	; <ESC> ?
	BEQ	END		;  Yes: => END
	CMPB	#IE.EOF,IOSB	; ^Z ?
	BEQ	END		;  Yes: => END
	CMPB	#12,INBUF	; <LF> ?
	BNE	20$		;  No: => 20$
	INC	LFFLG		; Say we had a <LF>
	BR	LOOP1		;  => LOOP1
20$:
	CMPB	#'^,INBUF	; "^" ?
	BEQ	30$		;  Yes : => 30$
	CMPB	#'6,INBUF	; "^" unshifted ?
	BNE	40$		;  No :  => 40$
30$:
	MOVB	#'B,INBUF	; Force "B"
40$:
	BICB	#40,INBUF	; Upshift
	CMPB	#'B,INBUF	; "B" ?
	BEQ	END		;  Yes : => END
	CMPB	#'T,INBUF	; "T" ?
	BNE	LOOP1		;  No  : => LOOP1
	CLR	NPAGE		; Page "0"
END:
	CLR	EOFFL		; Not <EOF> anymore
	CLOSE$	#FDB1		; Close the file
	BCS	EL4		; Error => EL4
	CMPB	#IE.EOF,IOSB	; Typed ^Z ?
	BNE	RECY		;  No: => RECY
EXIT:
	EXIT$S			; Exit EXA
RECY:
	CMPB	#33,IOSB+1	; <ESC> ?
	BEQ	JGO		;  Yes : => JGO
	CMPB	#'T,INBUF	; "T" ?
	BEQ	10$		;  Yes : => 10$
	CMPB	#'B,INBUF	; "B" ?
	BNE	JGO		;  Yes : => JGO
;
; Page back
;
	MOV	PGCNT,NPAGE	; Save were we are
	DEC	NPAGE		; Must go one back

10$:
	MOV	#FDB1+F.FNB,R0	; Refix
	MOV	#FNB1,R1	;   the
	MOV	#S.FNBW,R2	;     File
20$:	MOV	(R1)+,(R0)+	;     Descriptor
	SOB	R2,20$		;     Block

	OFID$R	#FDB1		; Open by file ID
	JMP	GO2		; Have another go
;
UNSOL:
	TST	(SP)+		; Must
	CLR	LFFLG		;  clear
	CLRB	INBUF		;   linefeed flag
	ASTX$S			;    and exit
;
;	ERROR TRAP
;
EL5:	INC	R5		;
EL4:	INC	R5		;
EL3:	INC	R5		;
EL2:	INC	R5		;
EL1:	ASL	R5		;
	ASL	R5		;
	ADD	#ERT,R5
	MOV	(R5)+,QIO+Q.IOPL
	MOV	(R5),QIO+Q.IOPL+2
	MOV	#60,QIO+Q.IOPL+4
	DIR$	#QIO
JGO:	JMP	GO1

;
;	READ INPUT FILE
;
;	R1 POINTS TO CURRENT LOCATION IN FILE
;	R4 IS SET TO THE LENGTH OF THE NEW RECORD
;
GET:
	TST	RECL		; Characters pending for PUT ?
	BGT	20$		;  Yes: => 20$	
	MOV	#IOBUF,R1	; R1 => IOBUF
	CLRB	(R1)		; Clear 1st byte
	MOV	R1,PNTR		; Save as "here we are"
	GET$	#FDB1		; Gettit
	BCC	10$		;  OK => 10$
	CMPB	#IE.EOF,FDB1+F.ERR
	BNE	EL4		; Error (no <EOF>) => EL4
	MOV	#1,EOFFL	; Flag <EOF>
	BEQ	90$		;  => 90$
10$:
	MOV	RECL,R4		; Save length
	BEQ	90$		;  Zero ? => 90$
	MOVB	#15,IOBUF(R4)	; Trail with <CR>
20$:
	CLR	R4		; Clear
	MOV	PNTR,R1		; R1 => 'here we are"
	MOV	R1,-(SP)	; Save this
30$:
	CMPB	(R1),#15	; <CR> ?
	BEQ	40$		;  Yes : => 40$
	CMPB	(R1)+,#12	; <LF> ?
	BEQ	50$		;  Yes : => 50$
	INC	R4		; We have 1 more to PUT
	CMP	R4,RECL		; End of record ?
	BLT	30$		;  No  : => 30$
	BR	80$		;  => 80$
40$:
	INC	R1		; Point over <CR>
	CMPB	(R1)+,#12	; <LF> ?
	BEQ	60$		;  Yes : => 60$
	DEC	R1		; It's rubbisch so skip
	BR	70$		;  => 70$
50$:
	CMPB	(R1)+,#15	; <CR> after <LF>
	BEQ	60$		;  Yes : => 60$
	DEC	R1		; It's rubbisch so skip
	BR	70$		;  => 70$
60$:
	DEC	RECL		; Skip 1
70$:
	DEC	RECL		; Skip 1
80$:
	MOV	R1,PNTR		; Save as "here we are"
	MOV	(SP)+,R1	; Old position
	SUB	R4,RECL		; Update Recordlength
90$:
	RETURN

;
;	WRITE TO TERMINAL
;
;
PUT:
	MOV	#40,QIO+Q.IOPL+4; Carriage control
	CLR	R2		; Clear
10$:
	MOV	R1,QIO+Q.IOPL	; R1 => Buffer
	TST	R4		; Count
	BLE	50$		;  Zero : => 50$
20$:
	MOVB	(R1)+,R0	; Take a byte
	CMPB	#14,R0		; <FF> ?
	BNE	30$		;  No  : => 30$
	MOVB	#15,-1(R1)	; Make it a <CR>
	BR	40$		;  => 40$
30$:
	INC	R2		; Another character
	CMPB	#11,R0		; <TAB>
	BNE	40$		;  No  : => 40$
	ADD	#7,R2		; Modulo 
	BIC	#7,R2		;     8
40$:
	CMP	R2,TIBUF	; Does it stil fit on line		;JHA03
	BGE	50$		;  No  : => 50$
	SOB	R4,20$		; Do the rest
50$:
	MOV	R1,-(SP)	; Save pointer
60$:
;
; Don't need <TAB> or <SPACE> at end of line
;
	CMPB	#40,-(R1)	; <SPACE> ?
	BEQ	60$		;  Yes : => 60$ 
	CMPB	#11,(R1)	; <TAB> ?
	BEQ	60$		;  Yes : => 60$ 
;
	INC	R1		; Update
	SUB	QIO+Q.IOPL,R1	; Length
	BGT	70$		; Positive ?
	INC	R1		; No:
	MOVB	#40,@QIO+Q.IOPL ;  A single <SPACE>
70$:
	MOV	R1,QIO+Q.IOPL+2	; Length in DPB
	CMP	PGCNT,NPAGE	; The page we need ?
	BLT	80$		;  No  : => 80$
	DIR$	#QIO		; OUTPUT
80$:
	DEC	LNCNT		; another line
	MOV	(SP)+,R1	; Unsave pointer
	DEC	R4		; More to do ?
	BLE	100$		;  Yes : => 10$
	CMP	PGCNT,NPAGE	; The page we need ?
	BLT	90$		;  No  : => 90$
	DIR$	#MARK		;
90$:
	MOV	#'+,QIO+Q.IOPL+4; Carriage control
	MOV	#3,R2		;
	BR	10$		;
100$:
	RETURN			;
;
	.END	GO