.MCALL	.MODULE
.MODULE	INDAS2,VERSION=02,COMMENT=<Validating responses to ASK directives> GLOBAL=.IAS2

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

	.MCALL	.PRINT, .RCTRLO
	.MCALL	FDBDF$, DEFIN$

FDBDF$				;Define FDB offsets
DEFIN$				;Definitions for IND files

	.PSECT	INDAS2
	.SBTTL	INDAS2 - Process answer

;+
;INDAS2
;This routine is entered after recieving a response from an ask directive.
;It processes the reponse for escape characters.  If there are no escape
;characters it falls through to LOGCAL to determine the type of response
;to process.
;
; Input:  R1 -> Terminal FDB
;	  R2 -> Answer buffer
;	  R3 =  Answer length
;	  F.ESC in F$FLGS is set if escape character is part of response.
;			  This bit is cleared at end of process.
;-

	.ENABL	LSB

INDAS2::MOVB	#<LOGF>,SPSDF+SETYP ;Assume answer is not defaulted
	MOVB	#<LOGF>,SPSAM+SETYP ;Assume terminator not altmode
	MOVB	#<LOGF>,SPSES+SETYP
	BITB	#<F.ESC>,F$FLGS(R1) ;Escape character part of string?
	BEQ	LOGCAL		;No, go parse string
	BICB	#<F.ESC>,F$FLGS(R1) ;Make sure bit is cleared
	CMP	#<1>,R3		;Is it the only character?
	BNE	ANSERR		;No, invalid answer
	BIT	#<ESCAPE>,.LIFLG ;Is escape a valid line terminator?
	BEQ	INVANS		;No, error
	CLRB	SPSAM+SETYP	;Set <ALTMOD> true
	.ASSUME <LOGT> EQ 0
	CLRB	SPSES+SETYP	;Same with <ESCAPE>
	.ASSUME <LOGT> EQ 0
	RETURN

	.DSABL	LSB
	.SBTTL	LOGCAL - Check for and process logical response

;+
;LOGCAL
;The following routine determines if the response was made to a .ASK
;directive (logical).  If it has the first character is checked for
;a valid response (Y or string beginning with Y, N or string beginning
;with N, or carriage return for NO).  If the response is invalid an
;error message is printed and the prompt is repeated. Otherwise, the
;symbol value is set to yes or no.
;-

	.ENABL	LSB

LOGCAL:	MOV	R2,R0		;Point R0 to the answer buffer
	MOV	R3,R1		;Point R1 to the terminal FDB
	CLRB	ASKBUF(R1)	;Set null terminator
	TSTB	SYMTP		;Logical symbol (.ASK directive)?
	.ASSUME <TF> EQ 0
	BNE	STRING		;No
	MOVB	DEF,SETYP(R5)	;Get the default response
	TST	R1		;Have any characters been read?
	BNE	1$		;Yes, check response
	CLRB	SPSDF+SETYP	;Set special symbol to TRUE
	RETURN

1$:	CLRB	SETYP(R5)	;Assume TRUE
	.ASSUME <LOGT> EQ 0
	BICB	#<40>,@R0	;Convert lower case response to upper case
	CMPB	#<'Y>,@R0	;Is it yes?
	BEQ	2$		;Branch if YES	
	CMPB	#<'N>,@R0	;Is it no?
ANSERR:	BNE	INVANS		;No, print error message and re-prompt
	INCB	SETYP(R5)	;Set symbol FALSE
	.ASSUME <LOGF> EQ 1
2$:	RETURN

	.DSABL	LSB
	.SBTTL	STRING - Check for and process string response

;+
;STRING
;The following routine processes string responses. If valid string
;the special symbols <STRLEN>, <RAD50>, and <ALPHAN> are set accordingly.
;The string is also assigned to the specified symbol.
;-

	.ENABL	LSB

STRING:	CMPB	SYMTP,#<STR>	;Is symbol a string?
	BNE	NUMBER		;No
	TST	R1		;Take the default?
	BNE	2$
	CLRB	SPSDF+SETYP	;Set special <DEFAUL> symbol to true
	.ASSUME <LOGT> EQ 0
	MOV	DEF,R1		;Get the address of the default string
	BEQ	2$		;If equal, there is no default
	CLR	R3		;Initialize counter
1$:	INC	R3		;Increament the count
	MOVB	(R1)+,(R0)+	;Move the character in
	BNE	1$		;Branch if more
	DEC	R3		;Adjust the counter
	MOV	R2,R0		;Get start of default string
	MOV	R3,R1		;Get character count
2$:	CALL	TSTRAN		;Is the string length within specified range?
	BCS	SLENER		;No, error
	MOV	R1,SPSSL+SEVAL	;Store length in <STRLEN>
	CALL	CKTYPE		;Set <RAD50> and <ALPHAN> special symbols
	CALL	ASVALS		;Assign string value
	BCS	3$		;Error
	RETURN

3$:	TRAP	ERSOV		;Error - symbol table overflow

	.DSABL	LSB
	.SBTTL	NUMBER - Process numeric response

;+
;NUMBER
;This routine processes numeric responses (.ASKN).  Default response is
;check first (<RET>).  If it is <DEFAUL> and <OCTAL> are set and the default
;is checked to make sure it falls in the specified range.  If a value is
;entered, the Radix is determined and the response is checked against the
;range.
;-

	.ENABL	LSB

NUMBER:	TST	R1		;Any response?
	BNE	1$		;Branch if yes

;+
;Default response.
;-

	CLRB	SPSDF+SETYP	;Set <DEFAUL> special symbol to "TRUE"
	.ASSUME <LOGT> EQ 0
	MOV	DEF,R4		;Get the default
	BR	7$		;Exit in common code

;+
;Value was specified.  Get its radix and convert the ASCII number string to a
;one word value.
;-

1$:	ADD	#ASKBUF-1,R1	;Point to last character in string
	CMPB	@R0,#<LB>	;First character '#'?
	BNE	2$		;Branch if no
	CMPB	@R1,#<DOT>	;Last character a dot?
	BEQ	INVANS		;Yes, invalid answer
	TSTB	(R0)+		;Adjust pointer to skip over pound sign
	BR	3$		;Convert number and process

2$:	CMPB	@R1,#<DOT>	;End in dot?
	BEQ	4$		;Convert to decimal value
	BITB	#1,LIMTYP	;Do we have a decimal symbol?
	BNE	4$		;Branch if yes
3$:	CALL	$COTB		;Convert as octal value
	BCS	INVANS		;Branch if error
	BR	5$		;Join common routine

4$:	CALL	$CDTB		;Treat as decimal value
	BCS	INVANS		;Branch if error
5$:	MOV	R1,R4		;Get numeric response in R4
	CMPB	R2,#<DOT>	;End in dot?
	BNE	6$		;Branch if no
	MOVB	(R0)+,R2	;Move in next character for $NNBLK
6$:	CALL	$NNBLK		;Is remainder of string empty?
	BCC	INVANS		;No, error



;+
;Comman code.
;-

7$:	MOVB	LIMTYP,SYMTP	;Set symbol type
	MOV	R4,R1		;Get value in R1
	CALL	TSTRAN		;Is response in range?
	BCS	BADRNG		;No - error
	MOV	R4,SEVAL(R5)	;Store the value
	MOVB	SYMTP,SETYP(R5) ;Store the symbol type
	CLRB	SPSOCT+SETYP	;Initialize special <OCTAL> symbol to TRUE
	.ASSUME <LOGT> EQ 0
	BITB	#<1>,SYMTP	;Default to decimal?
	BEQ	8$		;No
	INCB	SPSOCT+SETYP	;Yes, set <OCTAL> false
	.ASSUME <LOGF> EQ 1
8$:	RETURN			;Return to caller with c-bit cleared

	.DSABL	LSB
	.SBTTL	Error message processing for invalid responses

;+
;These errors are printed when the reponses to a prompt violates a
;restriction concerning responses to ask directives.  These errors are
;printed and the c-bit is set to notify INDAS1 to reprompt for a valid
;response rather than abort the operation.
;-

	.ENABL	LSB

INVANS:	.PRINT	#INAMSG		;Invalid answer error
	BR	1$

SLENER:	.PRINT	#ISLMSG		;Invalid string length
	BR	1$

BADRNG:	.PRINT	#IVMSG		;Answer out of range
1$:	SEC			;C-bit set to repeat prompt
	RETURN

	.DSABL	LSB


	.SBTTL	TSTRAN - Test for valid default

;+
;TSTRAN
;The following routine compares the default specification with both the low
;limit and high limit to make sure it is within the range specification.
;
; Call: CALL	TSTRAN		;Test for valid default
;
; Input:  R1 = Default specification
;
; Output: C-bit clear -> Within range
;	  C-bit set   -> Outside of range
;-

	.ENABL	LSB

TSTRAN::CMP	R1,LOW		;Was the answer within range?
	BLO	1$		;No, return with c-bit set
	CMP	HIGH,R1		;Check high limit & return with c-bit set/clr
1$:	RETURN

	.DSABL	LSB
	.SBTTL	CKTYPE - Check string type

;+
;CKTYPE
;Check type of string returned.  <RAD50> and <ALPHAN> are set TRUE or FALSE
;according to the string that is just read.
;
;Input:  R0 -> String
;	 R1 =  Length of the string
;-

	.ENABL	 LSB

CKTYPE::CLRB	SPS50+SETYP	;Assume string is RAD50
	.ASSUME <LOGT> EQ 0
	CLRB	SPSAN+SETYP	;Assume ALPHANUMERIC
	.ASSUME <LOGT> EQ 0
	SAVE	<R2,R0,R1>	;R1 saved last for following test
	BEQ	5$		;A null string is always RAD50 & ALPHANUMERIC
1$:	MOVB	(R0)+,R2	;Get next byte from string
	CMPB	R2,#'0		;Below numeric values?
	BLO	2$		;Branch if not in range
	CMPB	R2,#'9		;In numeric range?
	BLOS	4$		;Yes, preserve TRUE for RAD50 and ALPHAN
	CMPB	R2,#'A		;ALPHA character?
	BLO	2$		;Branch if out of range
	CMPB	R2,#'Z		;Above ALPHA range?
	BLOS	4$		;Branch out if valid RAD50 and ALPHAN
	CMPB	R2,#<'A+40>	;Lowcase alpha character
	BLO	2$		;Branch out if not possible
	CMPB	R2,#<'Z+40>	;In valid range?
	BLOS	3$		;Yes, but invalid for RAD50
2$:	MOVB	#<LOGF>,SPSAN+SETYP ;Not alphanumeric
	CMPB	#<DOT>,R2	;Dot?
	BEQ	4$		;Branch if yes. Dot is a valid RAD50 character
	CMPB	#'$,R2		;Dollar sign?
	BEQ	4$		;Branch if yes. Dollar sign is valid RAD50
3$:	MOVB	#<LOGF>,SPS50+SETYP ;The character is not valid RAD50
4$:	DEC	R1		;Decrement character count.
	BGT	1$		;Branch back if not done
5$:	RESTOR	<R1,R0,R2>
	RETURN

	.DSABL	LSB
	.END