.MCALL .MODULE
.MODULE	INDAS1,VERSION=02,COMMENT=<Set prompt to recieve response> GLOBAL=.IAS1

; 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 and data definitions

	.MCALL	.RCTRLO
	.MCALL	FDBDF$, FERDF$, DEFIN$, .TTINR, RT5DF$

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

	.PSECT	INDAS1

	.NLIST	BEX

YESNO:	.ASCIZ	\? [Y/N D:\	;Question suffix
TIMMSG:	.ASCIZ	/ T:/		;Timeout message
	.EVEN

	.LIST	BEX
	.SBTTL	INDAS1 - Prompt and read answer

;+
;INDAS1
;Read ASK prompt into buffer (TERM), display it on the console, and
;get response.  This routine is entered in two ways:
;	1. Normal entry - first execution of an ask directive.
;	2. If invalid input was entered to an ask directive.
;In the second case, the c-bit is set upon entry.  If an error had
;occured, the prompt buffer still contains the prompt so branch to
;re-prompt.
;-

	.ENABL	LSB
INDAS1::BICB	#<1>,SYMTP	;Reset bit 0 of symbol type (may have been set
				;if invalid answer was received)
	BCS	1$		;Branch if entering routine for a re-try
	CALL	SETPMT		;First time through. Set up prompt string
1$:	.RCTRLO			;Reset CTRL/O
	BIT	#<TYPAHD>,.LFLG2 ;Is typeahead enabled
	BNE	2$		;Branch if so
	CALL	FLUSH		;Flush characters
2$:	MOV	#TERM,R0	;Get start of buffer
	MOV	#TTFDB,R1	;Point R1 at terminal FDB.
	MOV	#ASKBUF,R2	;Point to the answer buffer.
	MOV	#ASKBL,R3	;Set maximum length of answer in R3.
	CALL	$RDREC		;Read the answer.
	BCS	3$		;Error
	RETURN

3$:	CMP	#<IE.EOF>,F$ERR(R1) ;End of file? (^Z)
	BNE	4$		;No, real error
	TRAP	EREOF		;Yes - print @ <EOF> and exit

4$:	MOV	R1,R0		;FDB must be in R0 on error
	TRAP	ERNPS		;Error reading input.

	.DSABL	LSB
	.SBTTL	SETPMT - Set up prompt string

;+
;SETPMT
;The following routine creates the prompt for all ask directive types.
;The text string is stored in TERM followed by the appropriate suffixs.
;-

	.ENABL	LSB

SETPMT:	MOV	CLPTR,R0	;Get pointer to command line
	CALL	$GNBLK		;Get first non-blank character
	BCC	1$		;Branch if no error
	TRAP	ERSYN		;Syntax error

1$:	MOVB	SYMTP,LIMTYP	;Set limit type equal to symbol type
	CMPB	R2,#<OPBRK>	;Is there possible arguments?
	BNE	2$		;No arguments
	CALL	GETRAN		;Check for range and store
	BR	3$		;Execute common routine

2$:	MOV	CLPTR,R0	;No arguments supplied - restore R0
3$:	CALL	PRSYM		;Parse symbol and locate table entry
	MOV	R0,R2		;Use R2 as pointer
	MOV	#TERM,R0	;Point to buffer to store prompt

;+
;Start storing the prompt string.
;-

4$:	BIT	#<PREFIX>,.LIFLG ;Suppress asterisk?
	BEQ	5$		;Yes
	MOVB	#<ASTER>,(R0)+	;Store asterisk indicating prompt
	MOVB	#<SPA>,(R0)+	;Store a token space
5$:	TSTB	(R2)+		;Skip over separating character
	BEQ	6$		;If equal, no prompt string
	MOV	R2,-(SP)	;Save pointer to start of prompt string
	ADD	#PMTSZ+1,@SP	;Add in valid pmt size +1 to end on 0 end
	CALL	MOVIN		;Move the characters into the buffer
	CMP	(SP)+,R2	;Invalid number of characters in prompt?
	BLT	13$		;Branch if yes
6$:	BIT	#<SUFFIX>,.LIFLG ;Suppress default and ASK type?
	BEQ	18$		;Yes
	TSTB	SYMTP		;Is this logical symbol?
	.ASSUME	<TF> EQ 0
	BNE	8$		;No
;+
;Append "? [Y/N]:" logical prefix onto prompt string.
;-

	MOV	#YESNO,R2	;Point to second character of question suffix
	CALL	MOVIN		;Move in text
	MOVB	#'N,@R0		;Assume default answer is NO
	TST	DEF		;What is the default response?
	.ASSUME	<LOGF> EQ 1
	BNE	7$		;Default response is NO
	MOVB	#'Y,@R0		;Store default response
7$:	TSTB	(R0)+		;Move pointer
	BR	15$		;Branch to common routine
;+
;If not logical ask directive, append first part of prefix onto prompt.
;-

8$:	MOVB	#<SPA>,(R0)+	;Move in a space
	MOVB	#'[,(R0)+	;Move in open bracket for ASK type
	MOVB	#'S,@R0		;Assume string
	BITB	#<STR>,SYMTP	;Are we processing a string symbol?
	BNE	10$		;Yes, we have the right notation
	BITB	#<OCTAL>,.LIFLG	;Octal mode?
	BNE	9$		;Branch if yes
	BISB	#1,LIMTYP	;Set to decimal
9$:	MOVB	#'O,@R0		;Assume octal
	BITB	#1,LIMTYP	;Are we processing an octal value?
	BEQ	10$		;Branch if yes
	MOVB	#'D,@R0		;Display decimal

;+
;Store arguments if they have been specified.
;-

10$:	TSTB	(R0)+		;Adjust pointer to next byte in string
	TSTB	ARG		;Were arguments specified
	BEQ	17$		;No, nothing to display
	CMP	R0,#<TRMEND-3>	;Potential buffer overflow?
	BGE	13$		;Yes, error
	MOVB	#<SPA>,(R0)+	;Yes, start with blank
	MOVB	#<'R>,(R0)+	;and "R"
	MOVB	#<COLON>,(R0)+	;and ":"
	MOV	LOW,R1		;Point to low limit
	CALL	CNV		;Convert to ASCII
	CALL	MOVIN		;Move the characters into the buffer
	MOVB	#'-,(R0)+	;Store a "-"
	MOV	HIGH,R1		;Point to high limit
	CALL	CNV		;Convert to ASCII
	CALL	MOVIN		;Move the characters into the buffer

;+
;Store default values for string and numeric directives.
;-

11$:	CMP	R0,#<TRMEND-3>	;Potential buffer overflow?
	BGE	13$		;Yes, error
	MOV	DEF,R2		;Get default value
	BNE	12$		;If not equal, a default is specified
	BITB	#<STR>,LIMTYP	;Processing a string?
	BNE	17$		;Branch if yes. Don't display default/timeout
12$:	MOVB	#<SPA>,(R0)+	;Insert a blank
	MOVB	#'D,(R0)+	;and "D"
	MOVB	#<COLON>,(R0)+	;and ":"
	BITB	#<STR>,LIMTYP	;String directive?
	BEQ	14$		;No, convert word to numeric string
	MOVB	#<DQUOT>,(R0)+	;Store double quote for start of string dflt
	CALL	MOVIN		;Move the characters into the buffer
	MOVB	#<DQUOT>,(R0)+	;End string default with double quote
	BR	15$		;Rejoin common routine

13$:	TRAP	ERPMT		;Buffer overflow

14$:	MOV	R2,R1		;R1 contains value to convert for CNV
	CALL	CNV		;Convert to ASCII
	CALL	MOVIN		;Move the characters into the buffer



;+
;Store timeout value.
;-

15$:	CMP	R0,#<TRMEND-2>	;Potential buffer overflow?
	BGE	13$		;Yes, error
	TST	TMOUT		;Timeout specified?
	BEQ	17$		;No, finish string
	MOV	#TIMMSG,R2	;Point to time message
	CALL	MOVIN		;Move it in
	MOV	TMOUT,R2	;Point to timeout text
16$:	MOV	TIMVAL,R1	;Get time value to convert and store
	CALL	CNV		;Convert value and store in string
	CALL	MOVIN		;Move it in
	MOVB	TIMUNT,(R0)+	;Store the time unit
17$:	MOVB	#<CLBRK>,(R0)+	;Store a "]"
	MOVB	#<COLON>,(R0)+	;and a ":"
18$:	CMP	R0,#<TRMEND-2>	;Potential buffer overflow?
	BGE	13$		;Yes, error
	MOVB	#<SPA>,(R0)+	;Store a blank
	MOVB	#200,(R0)+	;Set no carriage return.
	RETURN

	.DSABL	LSB
	.SBTTL	MOVIN - Move characters into buffer

;+
;MOVIN
;Move the characters into the buffer designated for ask directive prompt.
;
; Input: R0 -> next character slot in buffer to store
;	 R2 -> next character to store in prompt string
;
; Output:R0 -> next character slot in buffer to store
;-

	.ENABL	LSB

MOVIN:	CMP	R0,#TRMEND	;Buffer overflow?
	BGE	1$		;Yes, error
	MOVB	(R2)+,(R0)+	;Copy text
	BNE	MOVIN		;Loop until null byte found
	DEC	R0		;Adjust pointer to discard null byte
	RETURN

1$:	TRAP	ERPMT		;Buffer overflow

	.DSABL	LSB
	.SBTTL	CNV - Convert DECIMAL or OCTAL to ASCII

;+
;CNV
;The following is an internal subroutine that converts a numeric value
;(DECIMAL or OCTAL) to ASCII.  The value (if octal) can be 6 characters
;long where if decimal can be 5 numbers long with a decimal point making
;6.  These characters are stored in area allocated in front of ASKBUF.
;These characters are copied into the prompt string upon return.
;
;       *****CSIBLK is used as the storage buffer.*****
;
; Input:  R0 -> next available byte in prompt string
;
; Output: R0 same as input
;	  R2 -> start of mini-storage buffer (CSIBLK)
;-

	.ENABL	LSB

CNV:	SAVE	<R0>
	MOV	#CSIBLK,R0	;Point to 6 byte area to store 
	CLR	R2		;No leading zeroes
	BITB	#<1>,LIMTYP	;Is the type decimal?
	BNE	1$		;Yes
	CALL	$CBOMG		;Convert OCTAL to ASCII
	BR	2$		;Check for buffer overflow

1$:	CALL	$CBDMG		;Convert DECIMAL to ASCII
	MOVB	#<DOT>,(R0)+	;Store a trailing dot
2$:	CLRB	@R0		;End line with null
	MOV	#CSIBLK,R2	;Point to start of mini-buffer for storing
	CMP	#<CSIBLK+7>,R0	;Have we over-extended ourselves?
	BLT	3$		;Yes, set c-bit
	RESTOR	<R0>
	RETURN

3$:	TRAP	ERBRD		;Bad range or default specification

	.DSABL	LSB
	.SBTTL	GETRAN - Process range specifications

;+
;GETRAN
;Entered to set up possible range, default or timeout arguments for all ask
;directives.  Arguments are tested for their validity and stored in the
;appropriate storage locations.  If an argument is blank the default value
;is used.  First, check for ":" or "]".  If colon, the first argument field is
;not used.  If close bracket, give syntax error.  Check if the directive is
;a logical ASK directive or not.  If it is not a logical directive process
;the argument as the low limit.  If it is, check for a valid default and
;store it.
;
; Input: R0 -> text string
;-

	.ENABL	LSB
GETRAN::MOVB	@R0,ARG		;Set non zero to show arguments are present
	MOVB	SYMTP,-(SP)	;Save symbol type
	BITB	#<STR>,@SP	;String (.ASKS)?
	BEQ	1$		;Branch if no
	CLR	DEF		;Initialize to assume no default specified
1$:	CALL	COLCHK		;Check for colon or close bracket
	  TRAP	ERSYN		;Close bracket - syntax error
	  BR	2$		;No colon or close bracket
	  BR	3$		;Double colon
	 .BR	BL1ARG		;First argument was not specified

BL1ARG:	TSTB	@SP		;Logical ASK directive?
	.ASSUME	<TF> EQ 0
	BEQ	TIMARG		;Yes, process as if timeout specified
	TSTB	-(R0)		;No, process high limit
	BR	7$

;+
;Logical ask directive (.ASK)
;-

2$:	TSTB	-(R0)		;Back pointer up to first character
	TSTB	@SP		;Logical ASK directive?
	.ASSUME	<TF> EQ 0
	BNE	4$		;Branch if no
	CALL	EVNX		;Convert
	TSTB	R1		;False?
	BNE	12$		;Branch if no
	CLR	DEF		;Yes, set default to TRUE
	.ASSUME	<LOGT> EQ 0
	BR	12$		;Is there a timeout argument?

3$:	TSTB	-(R0)		;Back pointer up
	TSTB	@SP		;Logical ASK directive?
	.ASSUME	<TF> EQ 0
	BNE	7$		;Branch if no
	TRAP	ERSYN		;Yes, syntax error
;+
;NUMERIC or STRING ASK DIRECTIVE (.ASKN or .ASKS)
;Entry for string or numerical ask directives. Get ranges and store.
;-

4$:	CALL	EVNX		;Get low limit
	CMP	R1,LOW		;Was specified lower than valid low range?
	BLO	11$		;Yes, bad default specification
	MOV	R1,LOW		;Store the low limit
	BITB	#<STR>,@SP	;String (.ASKS)?
	BNE	5$		;Yes, don't set default
	MOV	R1,DEF		;Make tentative default update
5$:	BISB	SYMTP,LIMTYP	;Store the radix (OCTAL or DECIMAL)
6$:	TSTB	@SP		;Logical ASK directive?
	.ASSUME	<TF> EQ 0
	BEQ	12$		;Yes, check for timeout argument
7$:	CALL	COLCHK		;Check for colon or close bracket
	  BR	15$		;Encountered a close bracket
	  TRAP	ERSYN		;No colon or close bracket
	  BR	8$		;Double colon
	 .BR	LIMHGH		;Fall through to process high limit

LIMHGH:	CALL	EVNX		;Get high limit
	CMP	R1,LOW		;Compare limits for valid range
	BLO	11$		;High limit less than low limit - error
	MOV	R1,HIGH		;Store high limit
	BISB	SYMTP,LIMTYP	;Update limit type
8$:	CALL	COLCHK		;Check for colon
	  BR	15$		;Close bracket
	  TRAP	ERSYN		;No colon or close bracket
	  BR	12$		;Double colon
	 .BR	DEFLT		;Fall through to process default argument

DEFLT:	BITB	#<STR>,@SP	;Sting default?
	BEQ	9$		;Branch if no
	CALL	GSVAL		;Get string value
	MOV	R5,DEF		;Store address where string is stored
	ADD	R1,R5		;Point to end of string
	CLRB	@R5		;Make sure it ends in null byte
	TSTB	-(R0)		;Adjust pointer
	BR	10$		;Make sure it's in range

9$:	CALL	EVNX		;Get default
	MOV	R1,DEF		;Store the default
	BISB	SYMTP,LIMTYP	;Update limit type
10$:	CALL	TSTRAN		;Check that low <= default <= high
	BCC	12$		;No error - check for timout
11$:	TRAP	ERBRD		;Bad range or default specification

;+
;Check for timeout argument or end of list.
;-

12$:	CALL	COLCHK		;Check for colon or close bracket?
	  BR	15$		;Close bracket
	  NOP			;No colon or close bracket
13$:	  TRAP	ERSYN		;Double colon
	 .BR	TIMARG		;Fall through to process timeout argument

TIMARG:	MOV	R0,TMOUT	;Set non-blank to show timeout value present
	MOVB	LIMTYP,-(SP)	;Save incase we need to restore
	CALL	TIMCAL		;Convert time, even w/o timout
				;This will update the pointer past range specs
	BIT	#<TIMOUT>,.LIFLG ;Is timeout enabled?
	BNE	14$		;Keep timeout status
	CLR	TMOUT		;Ignore the time out
	MOVB	@SP,LIMTYP	;Restore old contents incase it was changed
14$:	TST	(SP)+		;Clean up
	CMPB	(R0)+,#<CLBRK>	;Next character must be "]"
	BNE	13$		;Syntax error if not
15$:	MOVB	(SP)+,SYMTP	;Restore symbol type
	RETURN

	.DSABL	LSB
	.SBTTL	COLCHK - Search for delimiters

;+
;COLCHK
;The following subroutine searches for colons (field seperators) or
;a close bracket (terminates the range/default field).
;
;Input:  R0 -> character to test
;
;Call::	CALL	COLCHK		;Check for colon or close bracket
;	.WORD			;Encountered a close bracket
;	.WORD			;No colon or close bracket
;	.WORD			;Double colon
;	.BR	X		;Fall through to process high limit
; X:
;+

	.ENABL	LSB

COLCHK:	CMPB	(R0)+,#<COLON>	;Character a colon?
	BEQ	1$		;Yes
	CMPB	-1(R0),#<CLBRK>	;No, how about a close bracket?
	BEQ	5$		;Yes
	BR	4$		;No, neither a colon or close bracket

1$:	CMPB	@R0,#<COLON>	;Double colons (::)?
	BEQ	3$		;Yes
	CMPB	@R0,#<CLBRK>	;No, how about colon-close bracket(:])?
	BNE	2$		;No, must be colon followed by an argument
	TRAP	ERSYN		;Yes, syntax error

2$:	ADD	#2,@SP		;Set up return for colon argument (:arg)
3$:	ADD	#2,@SP		;Set up return for double colon (::)
4$:	ADD	#2,@SP		;Set up return for no colon or close bracket
5$:	RETURN

	.DSABL	LSB

	.END