.TITLE	PROMPT
	.IDENT	/V01/
	.SBTTL	DESCRIPTION
;
;
;  COMPONENT:	PROMPT
;
;  DATE:	10-JUL-79
;
;  AUTHOR:	GR JOHNSON
;		BATTELLE NORTHWEST
;		P O BOX 999
;		RICHLAND WA 99352
;
;  SOURCE:	MACRO-11
;
;  CALLER:	FORTRAN IV-PLUS
;
;  CALLING SEQUENCE:
;
;		CALL PROMPT(LUN,PRMPT,IBUF,[ILEN],[RAL],[NOECHO],[ISW])
;
;		LUN	= INTEGER CONTAINING A LOGICAL UNIT NUMBER.
;
;		PRMPT	= VARIABLE OR ARRAY CONTAINING THE PROMPT STRING
;			  TO BE WRITTEN BEFORE ACCEPTING TERMINAL INPUT.
;			  THE STRING MAY CONTAIN UP TO 80 ASCII CHARACTERS
;			  INCLUDING THE MANDATORY NULL TERMINATOR.
;
;		IBUF	= VARIABLE OR ARRAY TO RECEIVE TERMINAL INPUT.
;
;		ILEN	= OPTIONAL INTEGER ARGUMENT SPECIFYING THE NUMBER
;			  OF CHARACTERS TO BE INPUT.  (DEFAULT=1)
;
;		RAL	= OPTIONAL LITERAL 'READALL' INDICATING THAT ALL
;			  EIGHT BITS OF THE BYTE ARE TO BE INPUT WITHOUT
;			  INTERFERENCE BY THE TERMINAL DEVICE HANDLER.
;
;		NOECHO	= OPTIONAL LITERAL 'NOECHO' INDICATING THAT CHAR-
;			  ACTERS INPUT WILL NOT BE ECHOED BY THE TERMINAL
;			  DEVICE HANDLER.
;
;		ISW	= VARIABLE TO RECEIVE THE INTEGER STATUS WORD.
;
;			  +NN = SUCCESS.  NN CHARACTERS RECEIVED.
;
;			  -10 = END-OF-FILE ENCOUNTERED
;
;			  -NN = OTHER FCS ERROR CODE
;
;
;  DESCRIPTION:
;
;	"PROMPT" INPUTS AN ARRAY OF BYTES USING THE QIO IO.RPR (READ
;  WITH PROMPT) FUNCTION.  THE ROUTINE MAY BE USED WHENEVER IT IS DE-
;  SIRABLE TO INPUT CHARACTERS FROM A TERMINAL DEVICE USING THE SPECIAL
;  HANDLING OPTIONS PROVIDED.
;
;	PROMPT INPUT REQUESTS ARE SATISFIED WHEN EITHER THE USER BUFFER IS
;  FILLED (ILEN CHARACTERS HAVE BEEN READ), OR ONE OF THE TERMINATION
;  CHARACTERS (CARRIAGE RETURN OR ESCAPE) IS TYPED.  THE USER BUFFER IS
;  BLANK FILLED ON RETURN AND THE ACTUAL NUMBER OF CHARACTERS INPUT IS
;  RETURNED IN THE INTEGER STATUS WORD.
;
;
;  EXAMPLES:
;
;		CALL PROMPT(5,'CHARACTER? ',CHAR)
;
;		CALL PROMPT(5,'PASSWORD? ',PASWRD,6,,'NOECHO')
;
;
;	IN THE FIRST EXAMPLE A SINGLE ASCII CHARACTER IS INPUT FROM THE
;  TERMINAL.  THE SECOND EXAMPLE DEMONSTRATES HOW PROMPT MIGHT BE USED TO
;  INPUT A "SECRET" PASSWORD. 
;
;

	.SBTTL	SYMBOL DEFINITIONS
;
;
					;
	.PSECT				;
	.MCALL	QIOW$,DIR$		;
					;
 
DPB:	QIOW$	IO.RPR,,,,QIOST,,<,,,PRMPT,>	; DECLARE QIO DPB
 
					;
QIOBF  = Q.IOPL+0			; QIO BUFFER ADDRESS OFFSET
QIOBFL = Q.IOPL+2			; QIO BUFFER LENGTH OFFSET
QIOPR  = Q.IOPL+6			; QIO PROMPT STRING ADDRESS OFFSET
QIOPRL = Q.IOPL+10			; QIO PROMPT STRING LENGTH OFFSET
					;
QIOST:	.WORD	0,0			; QIO STATUS BLOCK
					;
PRMPT:	.BYTE	015,012			; CR,LF
	.BLKB	80.			; 80 CHARACTER BUFFER
					;

	.SBTTL	ENTRY POINT -- PERFORM QIO IO.RPR
;
;
					;
PROMPT::				;
					;
	MOV	#DPB,R0			; QIO DPB ADDRESS TO R0
	MOV	#IO.RPR,Q.IOFN(R0)	; DEFAULT FUNCTION TO QIO DPB
	MOV	@2(R5),Q.IOLU(R0)	; LUN TO QIO DPB
	MOVB	@2(R5),Q.IOEF(R0)	; SET EVENT FLAG FOR QIO AND WAIT
	MOV	6(R5),QIOBF(R0)		; BUFFER ADDRESS TO QIO DPB
	MOV	#1,QIOBFL(R0)		; DEFAULT BUFFER LENGTH TO QIO DPB
					;
	MOV	4(R5),R1		; PROMPT STRING ADDRESS TO R1
	MOV	#PRMPT+2,R2		; LOCAL PROMPT BUFFER ADDRESS TO R2
	MOV	#2,R3			; INITIAL CHARACTER COUNT <CR><LF>
2$:	MOVB	(R1)+,(R2)+		; COPY PROMPT STRING TO LOCAL BUFFER
	BEQ	4$			; BRANCH FROM COPY UPON EOS
	INC	R3			; ELSE, INCREMENT CHARACTER COUNT
	BR	2$			; AND CONTINUE TO COPY
4$:	MOV	R3,QIOPRL(R0)		; PROMPT LENGTH TO QIO DPB
					;
	CMPB	#4,(R5)			; FOUR ARGUMENTS?
	BGT	12$			; NO, GO ISSUE QIO
	TST	10(R5)			; NULL ARGUMENT?
	BLT	6$			; YES, NEXT ARGUMENT
	MOV	@10(R5),QIOBFL(R0)	; NO, ILEN TO QIO DPB
					;
6$:	CMPB	#5,(R5)			; FIVE ARGUMENTS?
	BGT	12$			; NO, GO ISSUE QIO
	TST	12(R5)			; NULL ARGUMENT?
	BLT	10$			; YES, NEXT ARGUMENT
	BIS	#TF.RAL,Q.IOFN(R0)	; NO, ASSUME 'READALL'
					;
10$:	CMPB	#6,(R5)			; SIX ARGUMENTS?
	BGT	12$			; NO, GO ISSUE QIO
	TST	14(R5)			; NULL ARGUMENT?
	BLT	12$			; YES, NEXT ARGUMENT
	BIS	#TF.RNE,Q.IOFN(R0)	; NO, ASSUME 'NOECHO'
					;
12$:	DIR$	#DPB			; ISSUE QIO DIRECTIVE
	MOVB	@#$DSW,R4		; DIRECTIVE ERROR?
	BCS	RTN			; YES, RETURN ERROR CODE
13$:	MOVB	QIOST,R4		; I-O ERROR?
	BLT	RTN			; YES, RETURN ERROR CODE
					;
14$:	MOV	QIOBFL(R0),R2		; BUFFER LENGTH TO R2
	SUB	QIOST+2,R2		; SUBTRACT CHARACTERS INPUT
	BEQ	SUC			; BRANCH IF BUFFER FILLED
	MOV	6(R5),R1		; BUFFER ADDRESS TO R1
	ADD	QIOST+2,R1		; POINT PAST LAST CHARACTER INPUT
16$:	MOVB	#040,(R1)+		; BLANK FILL BUFFER
	SOB	R2,16$			;
					;

	.SBTTL	PROCESS ERRORS AND RETURN TO CALLER
;
;
					;
SUC:	MOV	QIOST+2,R4		; ISW = CHARACTERS INPUT
					;
					;
RTN:	CMPB	#7,(R5)			; SEVEN ARGUMENTS?
	BGT	2$			; NO, RETURN TO CALLER
	TST	16(R5)			; NULL ARGUMENT?
	BLT	2$			; YES, RETURN TO CALLER
	MOV	R4,@16(R5)		; NO, RETURN STATUS
2$:	RTS	PC			; RETURN TO CALLER
	.END				;