.TITLE	FFSCAN - FREE FORMAT SCAN AND CONVERT
	.IDENT	/17MAY7/	;13:05:00  LV
;	.ENTRY	FFSCAN - FREE FORMAT SCAN AND CONVERT
;
;+
; F F S C A N
;
; PURPOSE:	FREE FORMAT SCAN AND CONVERT ROUTINE FOR FORTRAN.
;		THIS SET OF SUBROUTINES ALLOWS A FORTRAN PROGRAM
;		TO DO FREE-FORMAT SCANNING AND CONVERSION OF A
;		LINE OF ASCII CHARACTERS.
;
; INTERFACE:	CALLING SEQUENCE:  (FORTRAN-CALLABLE SUBROUTINES)
;			CALL FFINIT(PTRS,LINE,LGTH,IERR)
;			CALL FFRST(PTRS)
;			CALL FFINTG(PTRS,IVAL)
;			CALL FFREAL(PTRS,RVAL)
;			CALL FFDBLE(PTRS,DVAL)
;			CALL FFSTR(PTRS,STRNG,N)
;			CALL FFOCT(PTRS,IVAL)
;			CALL FFSKIP(PTRS)
;
;		NOTE:  SEE DESCRIPTIONS BELOW.
;
; METHOD:	FFINIT IS CALLED TO INITIALIZE THE SCAN, THEN
;		FFINTG, FFREAL, FFDBLE, FFSTR, AND FFOCT MAY BE
;		CALLED TO CONVERT INDIVIDUAL ITEMS IN THE LINE.  
;		FFRST MAY BE CALLED AT ANY TIME TO START THE SCAN OVER.
;
;		AN ITEM IN THE LINE IS TERMINATED BY A COMMA, SPACE,
;		OR TAB, AND LEADING SPACES AND TABS IN AN ITEM 
;		ARE IGNORED.
;
;		ALL SUBROUTINES IN THIS PACKAGE ARE RE-ENTRANT 
;
; LANGUAGE:	MACRO-11
;
;-
; REVISIONS:
; 30-MAR-75		MODIFIED FOR RSX-11D
; 07-APR-75		EXTENSIVELY MODIFIED TO FIX BUGS CAUSED BY
;			PREVIOUS ATTEMPT TO ADAPT TO RSX-11D
; 05-AUG-75		CHANGED TO INTERFACE TO NEW FORTRAN IV LIBRARY
; 13-AUG-75	MK	CONDITIONAL CODE FOR FORTRAN IV PLUS ADDED
; 27-JAN-77	MK	ADDED RECOGNITION OF TAB AS SPACING AND
;			DELIMITER CHARACTER
; 17-MAY-77	LV	UPDATED TO CONFORM TO STANDARDS
;
;
;****	DEFINE F4P TO ASSEMBLE FOR FORTRAN IV PLUS.
;****	LEAVE F4P UNDEFINED TO ASSEMBLE FOR FORTRAN IV.
F4P=0
;
	.GLOBL	FFINIT,FFRST,FFINTG,FFREAL,FFDBLE,FFSTR,FFOCT,FFSKIP
;
F0=	%0
	.PAGE;
;+
; F F I N I T
;
;	SUBROUTINE FFINIT(PTRS,LINE,LGTH,IERR)
;
;	INITIALIZES THE SCAN OF LINE.
;
;	PTRS:	A 4-WORD ARRAY USED TO STORE INFORMATION NEEDED
;		BY THE SCAN.  IF PTRS IS AN INTEGER ARRAY, AND
;		ONE-WORD INTEGER MODE IS USED, THE ELEMENTS ARE
;		AS FOLLOWS:
;		PTRS(1): ADDRESS OF IERR
;		PTRS(2): ADDRESS OF NEXT BYTE TO BE SCANNED
;		PTRS(3): ADDRESS OF BYTE AFTER LAST BYTE TO BE
;		     SCANNED.
;		PTRS(4): ADDRESS OF LINE.
;
;	LINE:	LINE TO BE SCANNED.
;
;	LGTH:	MAXIMUM NUMBER OF CHARACTERS TO BE SCANNED.
;
;	IERR:	THIS IS SET TO LOGICAL .TRUE. (INTEGER -1) IF AN
;		ERROR OCCURS IN CONVERTING AN ITEM.  IT IS SET
;		TO .FALSE. (INTEGER 0) WHEN FFINIT OR FFRST IS
;		CALLED.  IT IS NOT CHANGED IF NO ERROR OCCURS IN
;		CONVERTING AN ITEM.  THUS SEVERAL ITEMS MAY BE
;		CONVERTED, AND IERR CHECKED TO SEE WHETHER ANY
;		ONE OF THEM WAS IN ERROR.
;
;-
FFINIT:	MOV	2(R5),R0	;GET PTRS ADDR
	MOV	10(R5),(R0)	;SAVE IERR ADDR
	CLR	@(R0)+		;INIT IERR
	MOV	4(R5),(R0)	;INIT SCAN PTR
	MOV	(R0)+,(R0)
	MOV	(R0)+,(R0)	;SAVE LINE ADDR
	ADD	@6(R5),-(R0)	;FORM SCAN LIMIT
	RTS	PC
;
;+
; F F R S T 
;
;	SUBROUTINE FFRST(PTRS)
;
;	RESETS THE SCAN TO THE BEGINNING OF THE LINE, AND RESETS
;	IERR TO ZERO (.FALSE.).
;-
;
FFRST:	MOV	2(R5),R0
	CLR	@(R0)+		;RESET IERR
	MOV	4(R0),(R0)	;RESET SCAN
	RTS	PC
	.PAGE;
;+
;
;
; F F I N T G
;
;	SUBROUTINE FFINTG(PTRS,IVAL)
;
; F F R E A L 
;
;	SUBROUTINE FFREAL(PTRS,RVAL)
;
;
; F F D B L E
;
;	SUBROUTINE FFDBLE(PTRS,DVAL)
;
;	CONVERT THE NEXT ITEM IN THE LINE TO AN INTEGER, REAL, OR
;	DOUBLE PRECISION VALUE, AND STORE THE RESULT IN IVAL, RVAL,
;	OR DVAL RESPECTIVELY.  IERR IS SET .TRUE. AND THE VALUE
;	TO ZERO IF THE ITEM IS NOT LEGAL.
;
;	A LEGAL ITEM IS A DECIMAL NUMBER WITH OR WITHOUT A DECIMAL
;	POINT AND/OR AN EXPONENT FIELD.  IT MUST BE IN THE RANGE
;	-32768 TO 32767 FOR FFINTG.  ITS MAGNITUDE MUST BE ZERO OR
;	IN THE RANGE 2.939E-39 TO 1.701E38 FOR FFREAL OR FFDBLE.
;	AN EMPTY ITEM IS LEGAL, AND IS CONVERTED TO ZERO.
;
;	IF A NON-INTEGER IS CONVERTED BY FFINTG, ITS FRACTIONAL
;	PART IS LOST.  THIS IS NOT TREATED AS AN ERROR.
;-
;
FFINTG:	MOV	#-1,-(SP)	;SET INTG FLAG
	BR	FFIRD
FFREAL:	MOV	#1,-(SP)	;SET REAL FLAG
	BR	FFIRD
FFDBLE:	CLR	-(SP)		;SET DBLE FLAG
;
;	FFINTG/FFREAL/FFDBLE COMMON
;
FFIRD:	MOV	2(R5),R0	;GET PTRS
	TST	(R0)+		;SKIP IERR ADDR
	MOV	(R0)+,R1	;GET SCAN PTR
	JSR	PC,SKPB		;SKIP BLANKS
	MOV	R1,R2		;SAVE START OF FIELD
1$:	CMP	R1,(R0)		;AT END-OF-LINE?
	BEQ	3$		;BRANCH IF YES
	JSR	PC,GETC1	;LOOK FOR DELIM
	BNE	1$		;CHECK NEXT CHAR IF NO
	MOV	R1,-(R0)	;UPDATE SCAN PTR
	DEC	R1		;BACK UP OVER DELIM
	BR	4$
3$:	MOV	R1,-(R0)	;UPDATE SCAN PTR
4$:	MOV	4(R5),R4	;GET VAL ADDR
	SUB	R2,R1		;FORM FIELD WIDTH
	BEQ	ZWDTH		;BRANCH IF ZERO
;
;	CONVERT VALUE
;
CONVRT:	MOV	R2,-(SP)	;FIELD START
	MOV	R1,-(SP)	;FIELD WIDTH
	CLR	-(SP)		;D=0 (IN EW.D)
	CLR	-(SP)		;P FACTOR = 0
	JSR	PC,RCI$		;CONVERT NUMBER
	BCS	ERREX		;ERROR
	TST	10(SP)		;TYPE?
	BEQ	1$		;DBLE
	BMI	CONVTI		;INTG
	ASL	4(SP)		;ROUND TO REAL
	ADC	2(SP)
	ADC	(SP)
	BCS	ERREX		;CATCH ROUND OVERFLOW
	BVS	ERREX
	MOV	(SP)+,(R4)+	;STORE REAL VALUE
	MOV	(SP)+,(R4)+
	CMP	(SP)+,(SP)+	;ADJUST STACK
	BR	OKEX
1$:	MOV	(SP)+,(R4)+	;STORE DBLE VALUE
	MOV	(SP)+,(R4)+
	MOV	(SP)+,(R4)+
	MOV	(SP)+,(R4)+
	BR	OKEX
;
;	CONVERT INTEGER
;
CONVTI:	CMP	(SP),#044000	;CHECK FOR VALID POS INTEGER
	BLO	1$		;BRANCH IF OK
	CMP	(SP),#144000	;CHECK FOR VALID NEG INTEGER
	BLT	1$		;BRANCH IF OK
	BGT	ERREX		;BRANCH IF DEFINITELY BAD
	TSTB	3(SP)		;CHECK FOR -2**15
	BNE	ERREX		;BRANCH IF NO (BAD)
1$:
	.IF	DF,F4P
	SETI
	SETD
	LDD	(SP)+,F0	;GET VALUE
	STCDI	F0,@4(R5)	;CONVERT TO INTEGER AND STORE
	.IFF
	MOV	(SP)+,R4
	JSR	R4,CID$		;CONVERT TO INTEGER
	3$
3$:	MOV	(SP)+,@4(R5)	;STORE VAL
	.ENDC
;
;	OK EXIT
;
OKEX:	TST	(SP)+
	RTS	PC
;
;	ERROR EXIT
;
ERREX:	MOV	2(R5),R0	;GET PTRS
	MOV	#177777,@(R0)+	;SET IERR
	ADD	#10,SP		;ADJUST STACK
;
;	ZERO FIELD WIDTH
;
ZWDTH:	TST	(SP)+		;TYPE?
	BMI	2$		;BRANCH IF INTG
	BGT	1$		;BRANCH IF REAL
	CLR	(R4)+		;CLEAR VAL
	CLR	(R4)+
1$:	CLR	(R4)+
2$:	CLR	(R4)+
	RTS	PC
	.PAGE;;
;+
;
;
; F F S T R
;
;	SUBROUTINE FFSTR(PTRS,STRNG,N)
;
;	MOVES THE NEXT N CHARACTERS OF THE LINE INTO THE ARRAY STRNG.
;	LEADING SPACES ARE IGNORED, AND THE SCAN TERMINATES ON A
;	COMMA, SPACE, OR THE END OF THE LINE.  A TERMINATING COMMA
;	OR SPACE IS NOT MOVED TO STRNG.  STRNG IS PADDED WITH SPACES
;	IF THE SCAN TERMINATES BEFORE N CHARACTERS HAVE BEEN MOVED.
;	THE SCAN SKIPS TO A TERMINATOR OR THE END OF LINE IF N CHAR-
;	ACTERS ARE MOVED BEFORE THE SCAN HAS TERMINATED.
;-
;
FFSTR:	MOV	2(R5),R0	;GET PTRS
	TST	(R0)+		;SKIP IERR ADDR
	MOV	(R0)+,R1	;GET SCAN PTR
	MOV	4(R5),R2	;GET STRNG ADDR
	MOV	@6(R5),R3	;GET N
	JSR	PC,SKPB		;SKIP BLANKS
1$:	JSR	PC,GETC		;GET CHAR
	BEQ	3$		;GO PAD IF NO MORE
	TST	R3		;STRNG FULL YET?
	BLE	1$		;BRANCH IF YES
	MOVB	R4,(R2)+	;PUT CHAR IN STRNG
	DEC	R3		;COUNT
	BR	1$
2$:	MOVB	#' ,(R2)+	;PAD STRNG
3$:	DEC	R3		;STRNG FULL YET?
	BGE	2$		;BRANCH IF NO
	MOV	R1,-(R0)	;UPDATE SCAN PTR
	RTS	PC
	.PAGE;
;+
;
;
; F F O C T 
;
;	SUBROUTINE FFOCT(PTRS,IVAL)
;
;	CONVERTS THE NEXT ITEM IN THE LINE TO AN INTEGER VALUE AND
;	STORES THE RESULT IN IVAL.  IERR IS SET .TRUE. AND THE VALUE
;	TO ZERO IF THE ITEM IS NOT LEGAL.
;
;	A LEGAL ITEM CONSISTS ONLY OF OCTAL DIGITS.  IF IT HAS A
;	VALUE GREATER THAN 177777 (OCTAL) THE RIGHTMOST 16 BITS
;	ARE STORED.  AN EMPTY ITEM IS LEGAL, AND IS CONVERTED TO ZERO.
;-
FFOCT:	MOV	2(R5),R0	;GET PTRS
	TST	(R0)+		;SKIP IERR ADDR
	MOV	(R0)+,R1	;GET SCAN PTR
	JSR	PC,SKPB		;SKIP BLANKS
	CLR	R2		;INITIALIZE VAL
	CLR	R3		;INITIALIZE ERR FLAG
1$:	JSR	PC,GETC		;GET CHAR
	BEQ	2$		;BRANCH IF NO MORE
	SUB	#60,R4		;FORM OCTAL DIGIT
	ASL	R2		;INSERT IN VAL
	ASL	R2
	ASL	R2
	BIS	R4,R2
	BIS	R4,R3		;SET ERR FLAG IF NOT OCTAL
	BR	1$
2$:	MOV	R1,-(R0)	;UPDATE SCAN PTR
	BIT	#177770,R3	;NON-OCTAL DIGIT SEEN?
	BEQ	3$		;BRANCH IF NO
	MOV	#177777,@-(R0)	;SET IERR
	CLR	R2		;SET VAL TO ZERO
3$:	MOV	R2,@4(R5)	;STORE VAL
	RTS	PC
	.PAGE;;
;+
;
;
; F F S K I P
;
;	SUBROUTINE FFSKIP(PTRS)
;
;	SKIPS THE NEXT ITEM IN THE LINE.
;-
;
FFSKIP:	MOV	2(R5),R0	;GET PTRS
	TST	(R0)+		;SKIP IERR
	MOV	(R0)+,R1	;GET SCAN PTR
	JSR	PC,SKPB		;SKIP BLANKS
1$:	JSR	PC,GETC		;SKIP CHARS
	BNE	1$
	MOV	R1,-(R0)	;UPDATE SCAN PTR
	RTS	PC
;
;	SKIP BLANKS SUBROUTINE
;
SKPB1:	INC	R1		;POINT TO NEXT CHAR
SKPB:	CMP	R1,(R0)		;AT END-OF-LINE?
	BEQ	1$		;RETURN IF YES
	CMPB	(R1),#' 	;BLANK?
	BEQ	SKPB1		;CONTINUE IF YES
	CMPB	(R1),#11	;TAB?
	BEQ	SKPB1		;CONTINUE IF YES
1$:	RTS	PC
;
;	GET CHAR SUBROUTINE
;
GETC:	CMP	R1,(R0)		;AT END-OF-LINE?
	BEQ	GETCE		;RETURN IF YES
GETC1:	MOVB	(R1)+,R4	;GET CHAR
	CMPB	R4,#',		;DELIMITER (COMMA)?
	BEQ	GETCE		;RETURN IF YES
	CMPB	R4,#' 		;DELIMITER (SPACE)?
	BEQ	GETCE		;RETURN IF YES
	CMPB	R4,#11		;DELIMITER (TAB)?
GETCE:	RTS	PC		;Z=1 IF YES
	.END