.TITLE	GETREL
	.IDENT	/V1.00/

;+
;
;	Routine to accept a floating number for FORTRAN.  The FORTRAN calling
;	sequence is:
;
;		CALL GETREL (N,FLAG,LOW,HIGH)
;
;		N = REAL*4  TO HOLD INPUT NUMBER
;		FLAG = LOGICAL*1 TO HOLD OK/NOT OK FLAG
;		LOW = REAL*4 LOWEST NUMBER ACCEPTED
;		HIGH = REAL*4 HIGHEST NUMBER ACCEPTED
;
;	D. O'Reilly		17-Dec-82 SKELETON from GETINT
;	D. Carroll		17-DEC-82
;
;-

	.MCALL	QIOW$,DIR$

AC0	=%0
AC1	=%1
AC2	=%2

	.PSECT	DATA,RW,D

INBUFF:	.BLKB	20.
NCHAR:	.WORD	15.
MASK:	.WORD	2
ARGSTG:	.WORD	3,INBUFF,NCHAR,MASK
OUTBUF:	.BLKB	80.
OUTLIN:	.ASCIZ	<33><131><64><40>/Number must be between %I and %I%N/
	.EVEN
ERRMSG:	.ASCII	/Floating point input conversion error./
ELEN	=.-ERRMSG
	.EVEN
LOW:	.BLKB	16.
HIGH:	.BLKB	16.
WRTOUT:	QIOW$	IO.WVB,5,1,,,,<OUTBUF,80.,40>
ERR:	QIOW$	IO.WVB,5,1,,,,<ERRMSG,ELEN,40>
TMPBLK:	.WORD	LOW,HIGH

	.PSECT	ROCODE,RO,I

GETREL::
	MOV	#15.,NCHAR	; RESET THE VALUE
	CLRB	@4(R5)		;SIGNIFY FLAG IS 'FALSE'
5$:	MOV	R5,-(SP)	;SAVE THE CURRENT ARGUEMENT LIST
	MOV	#ARGSTG,R5	;SET UP R5 FOR THE CALL
	CALL	RDLINE		;READ IN THE DATA
	MOV	(SP)+,R5	;RESTORE THE ARGUEMENT LIST
	CMP	#1,NCHAR	; just a dot ?
	BEQ	20$		;IF EQ, NO
	MOV	#INBUFF,R0	;THE INPUT ASCII BUFFER
	ADD	NCHAR,R0	;POINT TO END OF THE GOOD DATA
	CLRB	(R0)		;AND INSERT A <NULL>
;
;	Generate the real value for em
;
	MOV	R5,-(SP)	; save our R5
	MOV	#INBUFF,-(SP)	; place the address of the input on stack
	MOV	NCHAR,-(SP)	; number of characters read 
	BIS	#100000,(SP)	; set to ignore blanks
	CLR	-(SP)		; don't have to be set ...
	CLR	-(SP)		; scale factor
	CALL	RCI$		; convert the value
	BCS	15$		; conversion error encountered
	SETF			; set floating mode
	LDF	(SP),AC0	; load the value returned
	ADD	#10,SP		; clean up the stack
	MOV	(SP)+,R5	; restore R5
	STF	AC0,@2(R5)	; assume the value is good
	LDF	@6(R5),AC0
	CMPF	@2(R5),AC0	; is it high enough ?
	CFCC			; copy the condition codes
	BLT	10$		; too low
	LDF	@10(R5),AC0
	CMPF	@2(R5),AC0	; is it too high ?
	CFCC			; copy the condition codes
	BGT	10$		; error
	MOVB	#-1,@4(R5)	;SIGNIFY 'TRUE' FOR THE FLAG
	BR	20$		;AND GO AWAY SUCCESSFULLY

10$:	MOV	R5,-(SP)	; save R5 for the OTS calls
	MOV	6(R5),R0	; get the number
	MOV	#LOW,R1		; set the output buffer
	CALL	FOUT		; do the floating output
	MOV	(SP),R5		; restore for high part
	MOV	10(R5),R0	; address of the number
	MOV	#HIGH,R1	; output buffer
	CALL	FOUT		; do the output
	MOV	(SP)+,R5	; restore R5
	MOV	#OUTBUF,R0	;THE OUTPUT BUFFER
	MOV	#OUTLIN,R1	;THE FORMAT
	MOV	#TMPBLK,R2	;AND THE ARGUEMENT BLOCK
	CALL	$EDMSG		;FORMAT THE MESSAGE
	SUB	#OUTBUF,R0	;CALCULATE THE LENGTH
	MOV	R0,WRTOUT+Q.IOPL+2 ;PUT INTO QIO DPB
	DIR$	#WRTOUT		;AND WRITE THE MESSAGE OUT
	MOV	#15.,NCHAR	;RESET THE ARGUEMENT LIST
	BR	5$		;AND GO TRY AGAIN

15$:	DIR$	#ERR		; error
	ADD	#10,SP		; clean the stack
	MOV	(SP)+,R5	; restore R5
	BR	5$

20$:	RETURN			;GO AWAY

FOUT:	MOV	R1,-(SP)	; set the output address
	MOV	#15.,-(SP)	; output width
	MOV	#4,-(SP)	; F15.4 output
	CLR	-(SP)		; null scaling
	CLR	-(SP)		; 4 word double prec. value
	CLR	-(SP)
	MOV	2(R0),-(SP)	; zap it on
	MOV	(R0),-(SP)	; got the full value
	CALL	FCO$		; real output
	RETURN
	.END