F4P=0
;;	FREE FORMAT SCAN AND CONVERT ROUTINE FOR FORTRAN
;;
;;	AUTHOR: M.KELLOGG, LAMPF
;;
;;	13-AUG-75
;;
;;	THIS SET OF SUBROUTINES ALLOWS A FORTRAN PROGRAM TO DO
;;	FREE-FORMAT SCANNING AND CONVERSION OF A LINE OF ASCII
;;	CHARACTERS.  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 OR SPACE,
;;	AND LEADING SPACES IN AN ITEM ARE IGNORED.
;;
;;	ALL SUBROUTINES IN THIS PACKAGE ARE RE-ENTRANT (IF ANYONE
;;	CARES).
;;
;	13-AUG-75
;	CONDITIONAL CODE FOR FORTRAN IV PLUS ADDED
;	5-AUG-75
;	CHANGED TO INTERFACE TO NEW FORTRAN IV LIBRARY
;	7-APR-75
;	EXTENSIVELY MODIFIED TO FIX BUGS CAUSED BY PREVIOUS ATTEMPT
;	TO ADAPT TO RSX-11D
;	MODIFIED 30 MARCH 1975 FOR RSX-11D
;
	.TITLE	FFSCAN
	.GLOBL	FFINIT,FFRST,FFINTG,FFREAL,FFDBLE,FFSTR,FFOCT,FFSKIP
;
F0=	%0
	.PAGE;;
;;	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
;
;;
;;	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;;
;;	SUBROUTINE FFINTG(PTRS,IVAL)
;;	SUBROUTINE FFREAL(PTRS,RVAL)
;;	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;;
;;	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;;
;;	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;;
;;	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
;
SKPB:	CMP	R1,(R0)		;AT END-OF-LINE?
	BEQ	1$		;RETURN IF YES
	CMPB	(R1)+,#' 	;BLANK?
	BEQ	SKPB		;CONTINUE IF YES
	DEC	R1		;BACK UP OVER NON-BLANK
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?
	BEQ	GETCE		;RETURN IF YES
	CMPB	R4,#' 		;DELIMITER?
GETCE:	RTS	PC		;Z=1 IF YES
	.END