.MCALL	.MODULE
.MODULE	RDREC,VERSION=09,COMMENT=<Read record>

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.ENABL	GBL,LC

	.SBTTL	Macro definitions

;+
;External macro library calls.
;-
	.MCALL	.TTYIN, .PRINT, .TTINR, .MRKT, .CMKT
	.MCALL	FDBDF$, FERDF$, RT5DF$, DEFIN$

	FDBDF$				;Define FDB offsets
	FERDF$				;Define file service error codes
	RT5DF$				;Define RT offsets
	DEFIN$				;Definitions for IND files

	.PSECT	$RDREC
	.SBTTL	$RDREC - read record

;+
;$RDREC
;This routine reads the next record from the file indicated by the specified
;FDB.
;
; Input:  R0 = Address of terminal prompt string (0 means do not prompt)
;	  R1 = Address of FDB
;	  R2 = Address of record buffer
;	  R3 = Length of record buffer
;
; Output: R0 = Address of terminal prompt string
;	  R1 = Address of FDB
;	  R2 = Address of record buffer
;	  R3 = Actual length of record
;	  C-bit set if error
;-

	.ENABL	LSB

$RDREC::SAVE	<R2,R4,R5,R0>
	CALL	$CKOPR			;Is the file opened for read?
	BCS	12$			;No
	DEC	R3			;Make room for record terminator
	MOV	#$INPND,R5		;Point to end of buffer
	CALL	ISFLST			;Is device file structured?
	BNE	1$			;Branch if so.

	CALL	$RDTRM			;Read input from the terminal
	BCS	12$			;Branch out if received an error
	BR	4$			;Else continue

1$:	CMP	F$BLKN(R1),#-1		;Have any blocks been read?
	BEQ	3$			;No
	MOV	$IOWNR,R4		;Is the blocking buffer in use?
	BEQ	2$			;No
	CMP	R1,R4			;Does it belong to the current FDB?
	BNE	2$			;No
	CMP	$IBLKN,F$BLKN(R1)	;Is the current block in buffer?
	BEQ	3$			;Yes
2$:	CALL	$READ			;Read back the current block
	BCS	12$			;Branch out if error
3$:	MOV	R1,$IOWNR		;Save current FDB address as owner
4$:	MOV	F$BUFP(R1),R4		;Get current buffer pointer
	BNE	6$			;Branch if non-zero
5$:	INC	F$BLKN(R1)		;Increment block number
	CALL	$READ			;Read next block from file
	BCS	12$			;Branch if error
	MOV	R4,F$BUFP(R1)		;Update buffer pointer
6$:	CMP	R4,R5			;Any bytes remaining in block?
	BHIS	5$			;No
	MOVB	(R4)+,R0		;Is the next character null?
	BEQ	6$			;Yes
	BPL	7$			;No, it's an ASCII character. Branch
	MOV	#<IE.BTP>,F$ERR(R1)	;Bad record type error
	BR	8$			;Set c-bit for error and return

7$:	CMP	#<CR>,R0		;Is the character a carriage return?
	BEQ	6$			;Yes
	CMPB	#<LF>,R0		;Is the character a line feed?
	BEQ	10$			;Yes
	CMPB	#<VT>,R0		;Is the character a vertical tab?
	BEQ	9$			;Yes
	CMPB	#<FF>,R0		;Is the character a form feed?
	BEQ	9$			;Yes
	MOVB	R0,(R2)+		;Move character to record buffer
	DEC	R3			;Is the record buffer full?
	BGT	6$			;No
	MOV	#<IE.DAO>,F$ERR(R1)	;Data overrun error
8$:	SEC				;Set C-bit for error
	BR	12$			;Clean up stack and return to caller

9$:	MOVB	R0,(R2)+		;Move character into record buffer
10$:	CLRB	(R2)			;Append record terminator
	MOV	R4,F$BUFP(R1)		;Save buffer pointer
11$:	MOV	R2,R3			;Calculate record length
	SUB	6(SP),R3		;(end of record - start of record)
	MOV	#<IS.SUC>,F$ERR(R1)	;Indicate success
	CLC				;Make sure C-bit cleared for no error
12$:	RESTOR	<R0,R5,R4,R2>
	RETURN

	.DSABL	LSB
	.SBTTL	$READ - Read logical block from file
 
;+
;$READ
;This routine reads the specified logical block from the
;specified file into the input blocking buffer.
;
; Input:  R1 = Address of FDB
;
; Output: R1 = Address of FDB
;	  C-bit set if error
;-
 
	.ENABL	LSB

$READ:	SAVE	<R3,R5>
	MOV	F$BLKN(R1),R3		;Set up block number
	MOV	#$INPBF,R4		;Set up buffer address
	MOV	#$INPND-$INPBF,R5	;Set up byte count
	CALL	$RDBLK			;Read the block from the file
	BCS	1$			;Branch out if error
	MOV	R3,$IBLKN		;Save current block number
1$:	RESTOR	<R5,R3>
	RETURN

	.DSABL	LSB
	.SBTTL	$RDTRM - Read input from terminal
 
;+
;$RDTRM
;This routine retrieves input from the console terminal
;into the specified record buffer.
;
; Input:  R0 = Address of terminal prompt string (0 means do not prompt)
;	  R1 = Address of FDB
;	  R2 = Address of record buffer
;	  R3 = Length of record buffer
;
; Output: R1 = Address of FDB
;	  R2 = Address of record buffer
;	  R3 = Length of record buffer
;	  R5 = Address of next character after end of record
;	  F$BUFP(R1) contains the record buffer address
;	  C-bit set if error
;	  R0 is destroyed
;-
 
	.ENABL	LSB

$RDTRM::SAVE	<R3,R2>
	MOV	R2,F$BUFP(R1)		;Save buffer pointer in FDB
	TST	R0			;Is a prompt needed?
	BEQ	2$			;No
	CMP	R2,#ASKBUF		;We here because of an ask directive?
	BNE	1$			;Branch if no
	MOVB	#<LOGF>,SPSTMO+SETYP	;Assume no timeout. Initialize
	TST	TMOUT			;Timeout value given?
	BNE	MKTIM			;No, no MRKT
1$:	.PRINT				;Yes, print the prompt
2$:	.TTYIN				;Get a character from terminal
	DEC	R3			;Is the record buffer full?
	BGE	9$			;No
3$:	CALL	FLUSH			;Flush the rest
	MOV	#<IE.DAO>,F$ERR(R1)	;Data overrun error
	BR	12$			;Return to caller with c-bit set

;+
;Entered if timeout value is given in an ask directive.  A MRKT is issued
;for the time specified in the timeout argument of the ask directive. If
;a character is not typed by the time the MRKT timesout a linefeed character
;is inserted into the buffer and normal character processing is done.
;If a character is typed, the timeout value is canceled and normal TTYIN is
;used to get the rest of the characters.  
;-

MKTIM:	.PRINT				;Print the text string prompt
	MOV	(PC)+,@(PC)+		;Initially have a BRANCH
	BCS	.-CVAL+4$		;
	.WORD	CVAL
	.MRKT	#EMTBLK,#TIMBLK,#TCRTN,#1 ;Set the mark time
	BIS	#<TCBIT$>,@#$JSW	;Inhibit wait mode
4$:	.TTINR				;Get a character
CVAL:	.WORD	0			;Time out test word
	CMP	#240,CVAL
	BNE	7$
	MOV	#ASKBUF,R2
	MOV	#5015,(R2)+
5$:	CALL	FLUSH			;Flush the rest
	MOV	R2,R5			;Copy end of buffer
	CLC				;Make sure c-bit clear for no error
6$:	RESTOR	<R2,R3>
	RETURN

7$:	MOVB	R0,-(SP)		;Save the character. CMKT destroyes R0
	.CMKT	#EMTBLK,#1		;Cancel the MRKT
8$:	BIC	#<TCBIT$>,@#$JSW	;Reset the JSW
	MOVB	(SP)+,R0		;Get the value in R0
	DEC	R3			;Decreament the record buffer counter
;+
;Check input for special character.
;-

9$:	MOVB	R0,(R2)+		;Save character in record buffer
	CMPB	#<ESC>,R0		;Escape character?
	BNE	10$			;No, check for other spec. characters
	BISB	#<F.ESC>,F$FLGS(R1)	;Set flag to show esc. char. recieved
	BR	2$

10$:	CMPB	#<LF>,R0		;Is character a line feed?
	BEQ	5$			;End of line, return
	CMPB	#<CTRLZ>,R0		;Is the character a CTRL/Z?
	BNE	2$			;No, get next character
	BIT	#ABORT,.LIFLG		;Is abort enabled?
	BEQ	105$			;Branch if it's disabled
	BIT	#CNTRLZ,.LIFLG		;Is control-z disabled?
	BNE	11$			;Branch if it's enabled
105$:	DECB	R2			;Delete (ignore) the control/z	
	INC	R3			;And adjust the character count
	BR	2$			;Get next character
11$:	.PRINT	#NEWLIN			;Output <CR><LF>
	MOV	#<IE.EOF>,F$ERR(R1)	;End-of-file error
12$:	SEC				;Set C-bit to indicate error
	BR	6$			;Clean up stack and return to caller

FLUSH::	BIS	#<TTSPC$!TCBIT$>,@#$JSW	;Inhibit TT WAIT
13$:	.TTINR				;Clear out rest of buffer
	BCC	13$			;More characters in buffer
	BIC	#<TTSPC$!TCBIT$>,@#$JSW	;Clear inhibit TT WAIT
	RETURN
 
TCRTN:	.PRINT	#NEWLIN			;Output <CR><LF>
	CLRB	SPSTMO+SETYP		;Set timeout symbol to true
	.ASSUME <LOGT> EQ 0
	MOV	#240,CVAL		;Move NOP instruction in
	RETURN

	.DSABL	LSB

	.END