.TITLE	RESFOR - RESEQUENCE FORTRAN SOURCE
;
; IDENTIFICATION - 950037
;
; REV _J   V 3.0	- ACCEPT WILDCARD FILE SPECIFICATIONS - 03/83.
; REV _K   V 3.1	- ADD "INQUIRE" STATEMENT "ERR=" RESEQUENCE - 04/83.
; REV _L   V 3.2	- PARAMETERIZE CONTINUATION STATEMENT BUFFER
;			  SIZE.  OPTIMIZE WILDCARD FILE PROCESSING - 05/83.
;
;++
;
; RESFOR.MAR - Resequences labels of Fortran source code.  Fortran must
; be compilable under DEC software.  A known limitation is that Fortran
; keywords (e.g., "If", "Do", "Goto", "Read") must not be broken up and
; continued.  Note this does not apply to Fortran statements, only the
; Fortran keywords.  Also, continued executable Fortran statements with
; embedded comments (inline or otherwise), will produce unpredictable
; results.
;
; Resequencing is carried out in two passes.  The first pass builds a label
; map of old and new labels (lbl_data).  Also, relevant continued lines are
; identified by record number (ctn_data).  If more than one program unit is
; present, information is stored (mdl_data) regarding the whereabouts of
; the units and their respective label maps.
;
; The second pass is the resequencing pass.  Each relevant Fortran statement
; is identified and the labels, if any, are resequenced using the label
; map built during pass one.
;
; William W. Brown, BASD - January 1981
;
;--
;
; User definable program parameters:
;
; Maximum number of different labels to be resequenced - if too small,
; "Maximum number of labels exceeded" error will be generated.
LBLQTY=1024
;
; Maximum number of lines having continuations - if too small,
; "Maximum number of continuation lines exceeded" error will be generated.
CTNQTY=256
;
; Maximum size of continuation line buffer - if too small,
; "Continuation buffer overflow" error will be generated.
CTNBSZ=512
;
; Maximum number of subroutines to be resequenced at once - if too small,
; "Maximum number of subprograms exceeded" error will be generated.
MDLQTY=64
	;
	; Utility Macros:
	;
	; Case Branch Macro (Byte)
	;
.MACRO CASE	CSE,LST,TYP=B,LOW=#0,HGH=S^#,?BAS,?MAX
	CASE'TYP	CSE,LOW,HGH'<<MAX-BAS>/2>-1
	;
	; Used repetition to generate word case offsets
BAS:
	.IRP		EP,<LST>
	.SIGNED_WORD	EP-BAS
	.ENDR
MAX:
.ENDM	CASE
	;
	; Type String to User Console Macro
	;
.MACRO	TYPE	STRING
	.SAVE
	.PSECT	STRING_IO,NOWRT			; Change PSECT
	TMPA=.					; Save current location
	.ASCII	"STRING"			; String to be typed to console
	TMPL=.-TMPA				; Compute length of string
	.RESTORE				; Restore PSECT
	MOVL	#TMPA,TYPE_RAB+RAB$L_RBF	; Store start address in RAB
	MOVW	#TMPL,TYPE_RAB+RAB$W_RSZ	; Store string lenght in RAB
	$PUT	RAB=TYPE_RAB			; "Put" it according to RAB
.ENDM	TYPE
	;
	; On Error Macro
	;
.MACRO	ON_ERROR	DEST,?LABEL		; DEST is passed; LABEL computed
	BLBS	R0,LABEL			; Ok if low bit set
	BRW	DEST				; Error; branch to error handler
LABEL:
.ENDM	ON_ERROR
	;
	; Data Storage Definitions
	;
	.PSECT	DATA,LONG
	;
	; FAB and RAB for TYPE Macro
	;
TYPE_FAB:
	$FAB	FNM=<SYS$OUTPUT:>,-
		RAT=CR
TYPE_RAB:
	$RAB	FAB=TYPE_FAB
IN_FAB:
	$FAB	DNM=<.FOR>,-			; Default input file type
		FAC=GET,-			; Read only
		FOP=<SQO,NAM>,-			; Sequential only, name block
		NAM=IN_NAM			; Name block for wildcard resol.
	$NAMDEF
IN_NAM:
	$NAM	RSA=IN_RES_STR,-		; Result buffer address
		RSS=NAM$C_MAXRSS,-		; Result buffer size
		ESA=IN_EXP_STR,-		; Expanded buffer address
		ESS=NAM$C_MAXRSS		; Expanded buffer size
IN_RAB:
	$RAB	FAB=IN_FAB,-
		UBF=IO_BUF,-
		USZ=128
OUT_FAB:
	$FAB	FNS=13,-			; Output file name/type size
		FNA=OUTFIL,-			; and start address
		FAC=PUT,-			; Write access
		FOP=SQO,-			; Sequential only
		RAT=CR,-				; Carriage attributes
		NAM=OUT_NAM			; Name block for delete on close
OUT_NAM:
	$NAM
OUT_RAB:
	$RAB	FAB=OUT_FAB,-
		RBF=IO_BUF,-
		RSZ=72
IN_RES_STR:
		.BLKB	NAM$C_MAXRSS		; Resultant string buffer
IN_EXP_STR:
		.BLKB	NAM$C_MAXRSS		; Expanded string buffer
OUTFIL:
		.BLKB	13			; Output file buffer for FAB
	;
	; All storage necessary to accept command line
	;
PROMPT:	.WORD	8,0			; Required length of prompt
	.LONG	QUERY			; Address of literal prompt
QUERY:	.ASCII	"$_File: "		; Literal 8 byte prompt
CMDLEN=50				; Maximum command string length
STRING:	.WORD	CMDLEN,0		; Required length for TPARSE
	.LONG	CMDSTR			; and start address
CMDSTR:	.BLKB	CMDLEN			; Buffer for command string
	;
	; Character table used for SCANC and SPANC:
	;
	; 2 - digit
	; 4 - space or tab
	; 8 - "(", ")" or "'"
	; 16,17 - alphabetic (upper and lower case)
	; 17 - keyword alphabetic: a,b,c,d,e,f,g,i,o,p,r,t,u,w
	;	(Above correspond to first letters of Fortran keywords
	;	that may have Fortran labels associated with them)
	; 32 - "$", "_", or "."
	; 0 - all other
	;
CHRTAB:
	.BYTE	0[9],4,0[22],4,0[3],32,0,0,8,8,8,0[4],32,0
	.BYTE	2[10],0[7]
	.BYTE	17[7],16,17,16[5],17,17,16,17,16,17,17,16,17,16[3]
	.BYTE	0[4],32,0
	.BYTE	17[7],16,17,16[5],17,17,16,17,16,17,17,16,17,16[3]
	.BYTE	0[5]
	.BYTE	0[128]
	;
	; Label map, end and start address, length
	;
LBL_DATA:
	.BLKB	8*LBLQTY	; Buffer to hold "was-is" label relationship
LBLEND=.-8			; Mark near end of this buffer for error catch
LBLBEG:	.ADDRESS	LBL_DATA; Store address of map beginning
LBLLEN:	.WORD	0		; Reserve space for map length to bound search
	;
	; Continuation line information
	;
	; Ctn_data - Even word: record number of each continued line in file
	;	     Odd word : number of continued lines making up the
	;			associated continued statement
CTN_DATA:
	.BLKW	2*CTNQTY
CTNEND=.
	;
	; Multiple subroutines in module (file) information
	;
	; Mdl_data - Each longword: end address of section of label map
	;			associated with particular program unit
MDL_DATA:
	.BLKA	 MDLQTY
MDLEND=.
MDLPTR:	.ADDRESS MDL_DATA	; Points to appropriate address in mdl_data
	;
	; Miscellaneous Variables and Buffers
	;
PZERLB:	.PACKED 00000000	; Zero packed decimal
PINCRE:	.PACKED	20		; Label increment; default is 20.
PNEWLB:	.PACKED	00000000	; New label incremented by pincre
PFMTLB:	.PACKED	00000000	; Special format label if requested
PFMTIN:	.PACKED	00498000	; Starting format label (minus pincre)
CMPBUF:	.ASCII	"ABCDEFGH"	; General purpose compare buffer
ENDSTR:	.ASCII	"END"		; Used to find "End" statement or "End="
ERRSTR:	.ASCII	"ERR"		; Used to find "Err=" qualifier
FMTSTR:	.ASCII	"FORMATFMT"	; Used to find "Format" statements or "Fmt="
SPCADD:	.ADDRESS	0	; Address hold for special continue routine
STM_MSZ:	.WORD	0	; Maximum length of statement and leader 
CTN_MSZ:	.WORD	0	; Maximum length of continuation and leader 
CTN_MFSZ:	.WORD	0	; Maximum length of continuation w/o leader
CTN_ASZ:	.LONG	0	; Actual length of continuation line leader
CTN_LDR:	.ASCII	"     &		"
		.BLKB	56	; Continuation line leader buffer
CTN_BUF:	.BLKB	CTNBSZ	; Continuation line buffer; multiple lines
CBFEND=.
IO_BUF:		.BLKB	128	; Main record I-O buffer; one line
	;
	; Byte, word and longword lowercase to uppercase bit masks
	;
LCMSKB=32
LCMSKW=8224
LCMSKL=538976288
	;
	; Bit masks for flagging
	;
BIT16=65536
BIT17=131072
BIT18=262144
BIT19=524288
BIT20=1048576
BIT21=2097152
BIT22=4194304
	;
	; All data structures needed to determine statement type
	;
	; Fortran keywords by length and frequency of usage
FTNSTM:
	.ASCII	"IFGODO"
	.ASCII	"END"
	.ASCII	"GOTOTYPECALLOPENREADFIND"
	.ASCII	"WRITECLOSEPRINT"
	.ASCII	"ACCEPTENCODEDECODEASSIGNDELETEREWINDUNLOCK"
	.ASCII	"REWRITEINQUIREENDFILE"
	.ASCII	"BACKSPAC"
	;
	; Keyword number (0-23) of first keyword in each length class (0-9)
	;
	;	0 1 2 3 4  5  6  7  8  9
FTNIDX:	.BYTE	0,0,0,3,4,10,13,20,23,24
	;
	; Keyword attribute:	0- No comment
	;			1- "Go " with or without "To"
	;			2- "End"
	;			3- "Backspace"
	;			4- Direct access I-O possibility
	;			5- "Encode" or "Decode"
	;
FTNATT:	.BYTE	0,1,0,2,0[4],4[3],0[3],5[2],0,4,0[5],3
	;
	; Address of each keyword in keyword list: FTNSTM
FTNADD:
	.ADDRESS	FTNSTM
	.ADDRESS	FTNSTM+2
	.ADDRESS	FTNSTM+4
	.ADDRESS	FTNSTM+6
	.ADDRESS	FTNSTM+9
	.ADDRESS	FTNSTM+13
	.ADDRESS	FTNSTM+17
	.ADDRESS	FTNSTM+21
	.ADDRESS	FTNSTM+25
	.ADDRESS	FTNSTM+29
	.ADDRESS	FTNSTM+33
	.ADDRESS	FTNSTM+38
	.ADDRESS	FTNSTM+43
	.ADDRESS	FTNSTM+48
	.ADDRESS	FTNSTM+54
	.ADDRESS	FTNSTM+60
	.ADDRESS	FTNSTM+66
	.ADDRESS	FTNSTM+72
	.ADDRESS	FTNSTM+78
	.ADDRESS	FTNSTM+84
	.ADDRESS	FTNSTM+90
	.ADDRESS	FTNSTM+97
	.ADDRESS	FTNSTM+104
	.ADDRESS	FTNSTM+111
FTNTYP:	.BYTE	0
	;
	; TPARSE global data - used to analyze the command string
	;
	$TPADEF
TPARSE_BLOCK:
	.LONG	TPA$K_COUNT0
	.LONG	TPA$M_ABBREV
	.LONG	CMDLEN
	.LONG	CMDSTR
	.BLKL	TPA$K_LENGTH0-16
PARSER_FLAGS:	.BLKL	1		; To hold bit flag parsing results
INCREMENT:	.BLKL	1		; To hold user increment if any
FORMAT_LABEL:	.BLKL	1		; To hold user format label if any
INC_FLAG=1
FOR_FLAG=2
	$INIT_STATE	SWI_STATE,SWI_KEY
	$STATE	OPTIONS
	$TRAN	'/'
	$TRAN	TPA$_LAMBDA,TPA$_EXIT
	$STATE
	$TRAN	'INCREMENT',PARSE_INC,,INC_FLAG,PARSER_FLAGS
	$TRAN	'FORMAT_LABEL',PARSE_FOR,,FOR_FLAG,PARSER_FLAGS
	$STATE	PARSE_INC
	$TRAN	':'
	$TRAN	'='
	$STATE
	$TRAN	TPA$_DECIMAL,OPTIONS,,,INCREMENT
	$STATE	PARSE_FOR
	$TRAN	':'
	$TRAN	'='
	$STATE
	$TRAN	TPA$_DECIMAL,OPTIONS,,,FORMAT_LABEL
	$END_STATE

	;
	; Main entry: Process command line including any qualifiers
	;
	.PSECT	CODE,EXE,NOWRT,LONG
	.ENTRY	RESFOR, ^M<>		; Main entry point
	;
5$:	PUSHAL	PROMPT			; Push prompt address to stack
	PUSHAL	STRING			; Push target string address
	CALLS	#2,LIB$GET_FOREIGN	; Get the entire command line
	CMPL	#RMS$_EOF,R0		; Was EOF (Control-Z) given
	BNEQ	10$			; If not, continue
	MOVL	#RMS$_NMF,R0		; EOF; Simulate no more files - exit
	BRW	EXIT
10$:	ON_ERROR	RESERR		; On error, branch to error handler
	SPANC	#CMDLEN,CMDSTR,CHRTAB,#4; Were non-blanks given
	BEQL	5$			; No: just re-issue the prompt
	PUSHAL	SWI_KEY			; Save address of keyword table
	PUSHAL	SWI_STATE		; Save address of state table
	PUSHAL	TPARSE_BLOCK		; Save address of tparse block
	CALLS	#3,G^LIB$TPARSE		; Parse the command line
	BLBS	R0,15$			; On success, continue
	MOVZBL	#5,R0			; Indicate qualifier error message need
	BRW	RESERR			; and proceed to error handler
	;
	; Command line successfully parsed with TPARSE.  Store file in FAB.
	;
15$:	MOVB	TPARSE_BLOCK+TPA$L_STRINGCNT,-
			IN_FAB+FAB$B_FNS ; Store file name size
	MOVL	TPARSE_BLOCK+TPA$L_STRINGPTR,-
			IN_FAB+FAB$L_FNA ; Store file name address
	$PARSE	FAB=IN_FAB		; Parse (wildcard?) file specification
	ON_ERROR	RESERR		; On error, branch to error handler
	BBC	#NAM$V_WILDCARD,IN_NAM+NAM$L_FNB,OPNFIL ; Branch if no wildcards
	;
	;
	; Main file processing loop for RESEQUENCE!!  Handle wildcard specs.
	;
RESFIL:	$SEARCH	FAB=IN_FAB		; Find next file
	ON_ERROR	EXIT		; On error, branch to error handler
OPNFIL:	$OPEN	FAB=IN_FAB		; Open input file
	ON_ERROR	RESERR		; On error, branch to error handler
	$CONNECT	RAB=IN_RAB	; Connect stream
	ON_ERROR	RESERR		; On error, branch to error handler
	$RAB_STORE	RAB=IN_RAB,-	; First pass need only access input
			ROP=LOC		; file in "LOCATE" mode
	;
	; Initialize data structures and qualifier values for this RESEQUENCE
	;
	MOVAL	LBL_DATA,LBLBEG		; Initialize label map start address
	CLRW	LBLLEN			; and map length
	MOVAL	MDL_DATA,MDLPTR		; Initialize module data start address
	MOVP	#8,PZERLB,PNEWLB	; Set current new label field to zeros
	CLRL	R10			; Clear the flag longword
	BLBC	PARSER_FLAGS,20$	; Branch if no special increment
	MOVL	INCREMENT,R1		; Store increment
	BEQL	15$			; Yes: illegal qualifier value
	CMPL	R1,#99			; Is increment greater than 99
	BGTRU	15$			; Yes: illegal qualifier value
	CVTLP	R1,#2,PINCRE		; No: convert increment value to packed
20$:	BBC	#1,PARSER_FLAGS,40$	; Branch if no special format label
	MOVL	FORMAT_LABEL,R1		; Store format label
	CMPL	R1,#50000		; Is format label greater than 50000
	BLEQU	30$			; No: format label value ok
15$:	MOVZBL	#5,R0			; Indicate qualifier error message need
	BRW	RESERR			; and proceed to error handler
30$:	CVTLP	R1,#6,PFMTIN		; Convert the format label to packed
	SUBP4	#2,PINCRE,#6,PFMTIN	; Adjust initial format label by incre
	MOVP	#6,PFMTIN,PFMTLB	; Initialize the format label hold
	BISB2	#4,R10			; Set the special format label flag
40$:	MOVAL	PNEWLB,R8		; Store address of new label string
	MOVAL	CTN_DATA,R11		; and store address of continuation data
	MOVAL	LBL_DATA,R9		; Initialize R9 to label map address
	MOVB	#^A';',(R9)+		; First byte in map must be ";"
	CLRW	R7			; Initialize record counter to zero
	;
	; Main loop of first pass: Build old-new label map
	;
	; R0,R1,R2,R3 - scratch
	; R4 - address of character in statement under examination
	; R6 - first, record start address; later, end of record (eor) address
	; R7 - record number
	; R8 - address of "Pnewlb" or "Pfmtlb" - new labels
	; R9 - address of next available byte in label map
	; R10 - bit flags set:	7 6 5 4 3 2 1 0
	;			    | | | | | |__ at valid continuation line
	;			    | | | | |____ not 1st line of continuation
	;			    | | | |______ special format labels reqst'd
	;			    | | |________ special format label used
	;			    | |__________ at "End" statement
	;			    |____________ non-zero label digit found
	; R11 - pointer into ctn_data structure
	;
GETLBL:	$GET	RAB=IN_RAB		; Begin with locate of first record
	ON_ERROR	RESETF		; At end, proceed to second pass
	INCW	R7			; Adjust record number
	BVC	10$			; Check for too many records
	MOVZBL	#9,R0			; Set file too big error
	BRW	RESERR			; and proceed to error handler
10$:	MOVL	IN_RAB+RAB$L_RBF,R6	; Store address of first byte in R6
	BSBW	CHKCOM			; Confirm we are not on comment line
	ON_ERROR	MAPLBL		; Prepare to get next record if comment
	ADDL3	#5,R6,R2		; Store address of continuation field
	MOVL	R4,R0			; Save current record length
	MOVL	R6,R4			; Set R4 to address of label field
	ADDL2	R0,R6			; Compute end of record (eor) address
	CMPB	#^A'D',R5		; Does label start with "D"
	BNEQ	20$			; No: begin to examine field
	INCL	R4			; Yes: adjust label field pointer
20$:	CMPB	#9,(R4)			; Is this label field byte a tab
	BNEQ	25$			; No: continue
	SCANC	#1,B^1(R4),CHRTAB,#2	; Yes: does digit follow tab
	BEQL	GETKWD			; No: not a continuation line
	BRB	40$			; Yes: this is a continuation line
25$:	CMPB	#32,(R4)		; No: is byte a space
	BEQL	35$			; Yes: proceed to next byte
	BBS	#5,R10,30$		; No: skip if past first non-zero digit
	CMPB	#^A'0',(R4)		; Is digit a leading zero
	BEQL	35$			; Yes: do not append it to map
	BISB2	#32,R10			; No: set non-zero digit found flag
30$:	MOVB	(R4),(R9)+		; Append digit to label map
35$:	AOBLSS	R2,R4,20$		; Examine next byte in label field
					; At continuation field; does the field
	SCANC	#1,(R4),CHRTAB,#4	; contain a space or tab character
	BNEQ	GETKWD			; Yes: not at a continuation line
					; No: have a continuation line; if not
40$:	BLBC	R10,50$			; part of a valid statement, ignore it
	BBSS	#1,R10,45$		; Valid: branch if not 1st cnt'd line
	SUBW3	#1,R7,(R11)+		; 1st: store the former record number
	CLRW	(R11)			; and clear number of continued lines
	CMPL	#CTNEND,R11		; Has data structure overflowed?
	BGTRU	45$			; No: continue
	MOVZBL	#1,R0			; Yes: set error flag to error one
	BRW	RESERR			; Proceed to error handler
45$:	INCW	(R11)			; Increment number of continuations
50$:	BICB2	#32,R10			; Clear non-zero digit found flag
	BRW	GETLBL			; and examine next Fortran line
GETKWD:	INCL	R4			; Starting at next character
	SUBL3	R4,R6,R0		; compute length to bound search
	SPANC	R0,(R4),CHRTAB,#4	; Get to next non-blank
	BNEQ	40$			; Branch if non-blank found ok
	BRW	GETLBL			; Have line with just spaces; next rec
40$:	MOVL	R1,R4			; Update character address
	MOVZBL	(R4),R1			; Store ASCII code of first alpha
	BICB2	#1,R10			; Clear valid statement bit (false)
	CMPB	#17,CHRTAB[R1]		; Is it of valid type
	BNEQ	MAPLBL			; No: branch with valid bit clear
	BISB2	#1,R10			; Yes: set the valid statement bit
	BICL3	#LCMSKL,(R4),CMPBUF	; Mask out lowercase
	CMPC3	#3,CMPBUF,ENDSTR	; Are we at an "End" statement
	BNEQ	MAPLBL			; No: must not have "End" statement
	ADDL3	#3,R4,R1		; Yes: compute trailing address
	SUBL3	R1,R6,R0		; Compute length to bound search
	SPANC	R0,(R1),CHRTAB,#4	; Are there trailing non-blanks
	BEQL	50$			; No: have a valid "End" statement
	CMPB	#^A'!',(R1)		; Yes: have we found an in-line comment
	BNEQ	MAPLBL			; No: must not have "End" statement
50$:	BISB2	#16,R10			; Have "End": set flag for later
MAPLBL:	BBCC	#1,R10,20$		; Branch if last line not continued
	ADDL2	#2,R11			; Adjust ctn_data pointer to next word
20$:	BBSC	#5,R10,25$		; Branch if label digits found
	BRW	85$			; No label digits found
25$:	CMPL	#LBLEND,R9		; Is label map too full
	BGTR	30$			; No: continue
	CLRL	R0			; Yes: set error flag to error zero
	BRW	RESERR			; Proceed to error handler
30$:	BBC	#2,R10,40$		; Branch if no special format labels
					; Special format labels requested
	BICL3	#LCMSKL,(R4),CMPBUF	; Mask out any lowercase characters
	BICW3	#LCMSKW,B^4(R4),CMPBUF+4; in 6 bytes alphabetic string
	CMPC3	#6,CMPBUF,FMTSTR	; Are we at a "Format" statement
	BNEQ	40$			; No: branch
	ADDL3	#6,R4,R1		; Yes: compute trailing byte address
	SUBL3	R1,R6,R0		; Compute length to bound search
	SPANC	R0,(R1),CHRTAB,#4	; Get to next non-blank
	CMPB	#^A'(',(R1)		; Is it required trailing "("
	BNEQ	40$			; No: not a format statement
	BISB2	#8,R10			; Yes: set special label used flag
	MOVAL	PFMTLB,R8		; Store address of format label
40$:	MOVB	#^A'*',(R9)+		; Append delimiter to map
	ADDP4	#2,PINCRE,#6,(R8)	; Increment new label by increment
	CVTPS	#6,(R8),#6,CMPBUF	; Convert packed to numeric string
	SKPC	#^A'0',#5,CMPBUF+2	; Get to next non-zero digit
	MOVC3	R0,(R1),(R9)		; Move new label to label map
	MOVL	R3,R9			; Update available map byte address
	MOVB	#^A';',(R9)+		; Append final delimiter to label map
	BBCC	#3,R10,85$		; Clear 3 bit; branch on no format label
	MOVAL	PNEWLB,R8		; Replace standard label address
	BRW	GETLBL			; and get the next record
85$:	BBSC	#4,R10,90$		; Continue if at "End" statement
	BRW	GETLBL			; Not at "End"; get the next record
90$:	MOVL	MDLPTR,R1		; Place module pointer in R1
	CMPL	#MDLEND,R1		; Are there too many modules
	BGTR	95$			; No: continue
	MOVZBL	#2,R0			; Set error flag to error two
	BRW	RESERR			; Proceed to error handler
95$:	SUBL3	#1,R9,(R1)+		; Store address of last ";" in map
	MOVL	R1,MDLPTR		; Update the address pointer
	BBC	#2,R10,99$		; Branch if format label not requested
					; Special format labels requested
	CMPP3	#8,PFMTIN,PNEWLB	; Have we conflict with ordinary labels
	BGEQ	97$			; No: reset starting format label
	MOVZBL	#3,R0			; Yes: special format label error
	BRW	RESERR			; so proceed to error handler
97$:	MOVP	#6,PFMTIN,PFMTLB	; Re-initialize the format label 
99$:	CLRL	PNEWLB			; Clear the new label string
	BRW	GETLBL			; and get the next record
	;
	; End of pass one: Commence resequencing pass
	;
RESETF:	CMPL	#RMS$_EOF,R0		; Was error an end-of-file
	BEQL	10$			; Yes: all ok; continue
	CMPL	#RMS$_RTB,R0		; No: have some kind of RMS error
	BNEQ	5$			; If "Record too big" set error flag
	MOVZBL	#7,R0			; to seven to indicate condition
5$:	BRW	RESERR			; Branch to fatal error handler
	;
	; Reset input file; Open output file under same name.
	;
10$:	$REWIND	RAB=IN_RAB		; Reset input file to start for pass 2
	ON_ERROR	RESERR		; On error, branch to error handler
	$RAB_STORE	RAB=IN_RAB,-	; Second pass needs to access input
			ROP=ASY		; file in "MOVE" mode - ASY
	$GET	RAB=IN_RAB		; Launch GET of first input file record
	MOVZBW	IN_NAM+NAM$B_NAME,R0	; Move input file name to OUT_FAB addr
	MOVL	IN_NAM+NAM$L_NAME,R1	; File type address
	MOVC5	R0,(R1),#32,#9,OUTFIL	; Pad with spaces
	MOVZBW	IN_NAM+NAM$B_TYPE,R0	; Move input file type to OUT_FAB addr
	MOVL	IN_NAM+NAM$L_TYPE,R1	; File type address
	MOVC5	R0,(R1),#32,#4,OUTFIL+9	; Pad with spaces
	$FAB_STORE	FAB=OUT_FAB,-
			FOP=SQO		; Sequential access only
	$CREATE	FAB=OUT_FAB		; Create a new output file
	ON_ERROR	RESERR		; On error, branch to error handler
	$CONNECT	RAB=OUT_RAB	; and connect it as a new version
	ON_ERROR	RESERR		; On error, branch to error handler
	MOVAL	MDL_DATA,R0		; Get address of module data area
	MOVL	R0,MDLPTR		; Use it to initialize address pointer
	SUBL3	LBLBEG,(R0),R1		; and compute the starting map length
	MOVW	R1,LBLLEN		; placing the result in a word item
	CLRL	R12			; Initialize record counter to zero
	CLRW	(R11)			; Mark end of continuation data struct.
	MOVAL	CTN_DATA,R11		; Initialize continuation pointer

	;
	; Main loop of second pass
	;
	; R0-R5 - scratch
	; R6 - usually alternative byte for routine Advchr search
	; R7 - usually address of character under examination in line
	; R8 - input record start address
	; R9 - (1) label field length; (2) address following ")" in "()" pair
	; R10 - address of byte following last byte in record (eor)
	; R11 - address pointer into ctn_data data structure
	; R12 - (low word) record number
	; R12 - (high word) bit flag set:
	;			7 6 5 4 3 2 1 0
	;			  | | | | | | |__ continued lines read by Reactn
	;			  | | | | | |____ I-O "Fmt=" or "End=" sought
	;			  | | | | |______ I-O "End=" sought
	;			  | | | |________ possibly direct access I-O
	;			  | | |__________ alternate found by Advchr
	;			  | |____________ continuation point advancement
	;			  |______________ processing "DO2WHILE(X)"
	;
REAREC:	MOVAL	IO_BUF,R8		; Store the I-O buffer start address
	CLRL	SPCADD			; Clear the special continue address
10$:	INCW	R12			; Update the record number
	$WAIT	RAB=IN_RAB		; Wait for next input record
	ON_ERROR	EXIT		; At end of file, quit
	MOVL	R8,R6			; Store record start address for routine
	BSBW	CHKCOM			; Check for Fortran comment line
	BLBS	R0,CHKLBL		; If not comment line, check for label
	MOVW	R4,OUT_RAB+RAB$W_RSZ	; Comment: store record size for output
	$PUT	RAB=OUT_RAB		; Put comment record to output file
	ON_ERROR	RESERR		; On error, branch to error handler
	$GET	RAB=IN_RAB		; Get another input file record
	BRB	10$			; and see if it is non-trivial
CHKLBL:	ADDL3	R4,R8,R10		; Get end of record address (eor)
	MOVZBL	#5,R9			; Initialize label length estimate
	CMPB	#^A'D',R5		; Have we a debug statement
	BNEQ	10$			; No: continue
	INCL	R8			; Yes: adjust label field start addr
	MOVB	#4,R9			; Adjust label field length estimate
10$:	LOCC	#9,R9,(R8)		; Does label field have a <tab>
	BEQL	15$			; No: continue
	SUBL3	R8,R1,R9		; Yes: compute actual field length
	BNEQ	15$			; Continue if label field more than tab
	SCANC	#1,B^1(R8),CHRTAB,#2	; Just tab; is following character digit
	BEQL	30$			; No: go find first alphabetic
	BRW	WRTREC			; Yes: have continuation line; write it
15$:	SCANC	R9,(R8),CHRTAB,#2	; Is there a digit in label field
	BEQL	25$			; No: have no label to change
	MOVL	R1,R7			; Yes: store address in R7 for routine
	BSBW	NEWLBL			; Get length and address of new label
	ON_ERROR	RESERR		; On error, branch to error handler
	CMPB	R5,R9			; Is new label longer than old field
	BLEQ	20$			; No: just move with space filler
	MOVZBW	R5,R7			; Yes: save new label length
	SUBB2	R9,R5			; Compute difference in lengths
	ADDL3	R9,R8,R1		; Compute address past old label field
	SUBL3	R1,R10,R0		; Compute distance to record end
	ADDL3	R5,R1,R9		; and then compute new field end addr
	MOVC3	R0,(R1),(R9)		; Move remainder making room for new
	MOVL	R3,R10			; Update end of record address
	MOVC3	R7,(R6),(R8)		; Move new label to old field
	BRB	40$			; All done with label field
20$:	MOVC5	R5,(R6),#32,R9,(R8)	; Move new label (plus spaces) to old
	BRB	40$			; All done with label field
25$:	SCANC	#1,(R1),CHRTAB,#4	; Have no label; is the continuation
					; field a non-blank character
	BNEQ	30$			; No: not part of continued line
	BRW	WRTREC			; Yes: continuation line; just write it
30$:	MOVL	R8,R3			; Prepare to search line for first alpha
40$:	SUBL3	R3,R10,R0		; Compute length to bound search
	SCANC	R0,(R3),CHRTAB,#16	; Scan to alphabetic character
	MOVL	R1,R8			; Save location of alphabetic
CHKFTN:	MOVZBL	(R8),R1			; Get ASCII code of character
	CMPB	#17,CHRTAB[R1]		; Have we a valid alphabetic
	BNEQ	10$			; No: just write this record
	SUBL3	R8,R10,R0		; Yes: compute number of bytes to end
	SPANC	R0,(R8),CHRTAB,#16	; Get to next non-alphabetic
	SUBL3	R8,R1,R7		; Compute length of alpha string and
					; do a case branch on the length of
					; the alphabetic string
	CASE	R7,<WRTREC WRTREC 30$ 30$ 30$ 25$ 25$ 20$ 20$>
10$:	BRW	WRTREC			; String longer than 8 bytes; write
20$:	BICW3	#LCMSKW,B^6(R8),CMPBUF+6; Mask lowercase in 7th and 8th bytes
25$:	BICW3	#LCMSKW,B^4(R8),CMPBUF+4; Mask lowercase in 5th and 6th bytes
30$:	BICL3	#LCMSKL,(R8),CMPBUF	; Mask lowercase in 1st - 4th bytes
	MOVAB	FTNIDX[R7],R1		; Store address of low index
	MOVZBL	(R1)+,R4		; Move low index to AOBLSS register
	MOVZBL	(R1),R5			; Next byte is AOBLSS high index
	MOVAL	FTNADD[R4],R6		; Get address of ftnstm start
40$:	CMPC3	R7,@(R6)+,CMPBUF	; Have we a keyword Fortran statement
	BEQL	50$			; Yes: branch
	AOBLSS	R5,R4,40$		; No: continue looking until done
	BRW	WRTREC			; Do not have a statement with labels
50$:	ADDL2	R8,R7			; Compute address of delimiter byte
	MOVB	FTNATT[R4],R3		; Get attribute of the keyword
	CASE	R3,<90$ 55$ 60$ 70$>	; and use it in case branch
	BRB	90$			; Continue with all other
55$:	SUBL3	R7,R10,R0		; "Go" - compute length to bound search
	SPANC	R0,(R7),CHRTAB,#4	; Get address of next non-blank
	BICW3	#LCMSKW,(R1),CMPBUF	; Mask out any lowercase characters
	CMPW	#^A'TO',CMPBUF		; See if "To" follows the "Go"
	BNEQ	95$			; No: not a "Go To" statement
	ADDL3	#2,R1,R7		; Yes: update address of delimiter byte
	BRB	90$			; and continue
60$:	SUBL3	R7,R10,R0		; "End" - compute length to bound search
	SPANC	R0,(R7),CHRTAB,#4	; Are there any more non-blanks
	BEQL	65$			; No: have "End" statement
	CMPB	#^A'!',(R1)		; Yes: have we found an in-line comment
	BNEQ	95$			; No: not a genuine "End" statement
65$:	MOVL	MDLPTR,R5		; Have "End": store address pointer
	MOVL	(R5)+,LBLBEG		; Get the new map start address
	SUBL3	LBLBEG,(R5),R0		; and compute the new map length
	MOVW	R0,LBLLEN		; placing result in a word item
	MOVL	R5,MDLPTR		; Restore new address pointer
	BRW	WRTREC			; Write the "End" statement
70$:	BICB3	#LCMSKB,(R7)+,CMPBUF	; Mask out any lowercase characters
	CMPB	#^A'E',CMPBUF		; "Backspac" - is it "Backspace"
	BNEQ	95$			; No: just write this record; yes...
90$:	MOVB	R4,FTNTYP		; Save type of Fortran statement
	CMPW	R12,(R11)		; Are we at a continued line
	BNEQ	CHKDEL			; No: continue
	SCANC	#1,(R7),CHRTAB,#16	; Yes: is delimiter byte alphabetic
	BNEQ	95$			; Yes: this statement has no label
	BSBW	REACTN			; No: may have label; read ctn lines
	ON_ERROR	RESERR		; On error, branch to error handler
	BRB	CHKDEL			; Entire record now in CTN_BUF; continue
95$:	BRW	WRTREC			; Statement has no Fortran label
	;
	; R7 - address of delimiter byte
	; R10 - address of eor byte
	;
CHKDEL:	SUBL3	R7,R10,R4		; Compute length to eor from delimiter
	SPANC	R4,(R7),CHRTAB,#4	; Find next non-blank character
	BEQL	70$			; None found: write the record
	CMPB	#^A'(',(R1)		; Is it a left parenthesis
	BNEQ	10$			; No: what is it then
	ADDL3	#1,R1,R7		; Yes: store address after "("
	MOVZBL	FTNTYP,R4		; Examine type of statement
	CMPB	#4,FTNATT[R4]		; Is direct access I-O a possibility
	BNEQ	5$			; No: continue
	BISL2	#BIT19,R12		; Yes: set the direct access flag
5$:	CLRB	R6			; Clear alternate byte register
	BSBW	ADVCHR			; Find byte after right parenthesis
	ON_ERROR	RESERR		; On error, branch to error handler
	BICL2	#BIT19,R12		; Clear the direct access flag
	MOVL	R8,R9			; Store result in more permanent reg
	SUBL3	R9,R10,R0		; Compute distance from it to eor
	SPANC	R0,(R9),CHRTAB,#4	; and get to the next non-blank
	BEQL	80$			; None found: resequence labels
	BRB	40$			; Examine the non-blank further
10$:	CLRL	R9			; Clear right parenthesis address reg
	CMPW	R4,R0			; Is non-blank the delimiter character
	BNEQ	35$			; No: check for trailing "="
					; Label may follow keyword without space
	SPANC	R4,(R7),CHRTAB,#2	; Get to next non-digit
	BEQL	80$			; Branch if all remaining bytes digits
	CMPW	R4,R0			; Is non-digit the delimiter character
	BEQL	70$			; Yes: have no label here
	BSBW	PCKSTM			; Check packed statement for label
	ON_ERROR	WRTREC		; On error - statement has no label
	BRB	80$			; Packed statement has label
35$:	MOVL	R1,R7			; Save address of the non-blank
40$:	CMPB	#^A'=',(R1)		; Is non-blank an equal sign - assignmt
	BNEQ	80$			; No: statement has label
70$:	BRW	WRTREC			; Statement has no label; write it
80$:	CASE	FTNTYP,-
<IF GO DO GO GO IO CL OC IO OC IO OC IO IO IO IO GO OC OC OC IO OC OC OC>
	;
	; Change old Fortran statement label to new
	;
	; R7 - if "(" present: address 1 after "("; otherwise: address of first
	;	non-blank past Fortran keyword
	; R9 - address of byte after ")" if "()" pair present; otherwise clear
	; R10 - eor
	;
DO:	SCANC	#1,(R7),CHRTAB,#2	; Is byte a digit
	BEQL	10$			; No: not a valid do loop construct
	BSBW	INTCHG			; Yes: interchange old "Do" label w/ new
	ON_ERROR	RESERR		; On error, branch to error handler
10$:	BRW	WRTREC			; Done with "Do"
OC:	TSTL	R9			; Is there a "()" pair
	BEQL	20$			; No: just write record
	MOVL	R7,SPCADD		; Store address after "(" for wrtspc
	BSBW	EQLLBL			; Find "Err=" if any
	ON_ERROR	RESERR		; On error, branch to error handler
20$:	BRW	WRTREC			; Done with "Open-close"
CL:	SUBL3	R7,R10,R0		; Get number of bytes to eor to bound
	LOCC	#^A'(',R0,(R7)		; Search for call statement "("
	BEQL	40$			; If none: no label in this "Call"
	ADDL3	#1,R1,R7		; Store address after "(" for Advchr
	MOVL	R7,SPCADD		; and save it for continuation processor
	MOVB	#8,CHRTAB+38		; Store correct mask in "&" table entry
10$:	MOVB	#^A'*',R6		; Store "*" in alternate byte register
	BSBW	ADVCHR			; Locate "*" or "&" or ")" whichever 1st
	ON_ERROR	RESERR		; On error, branch to error handler
	BBC	#20,R12,30$		; If ")" found, just write record
	SPANC	R2,(R8),CHRTAB,#4	; Get to next non-blank character
	MOVL	R1,R7			; Update current byte address
	SCANC	#1,(R7),CHRTAB,#2	; Is non-blank a digit
	BEQL	10$			; No: continue checking for "*" or "&"
	DECL	R8			; Adjust address to that of "*" or "&"
15$:	CMPB	#^A',',-(R8)		; Is preceding character a comma
	BEQL	20$			; Yes: continue
	CMPB	#^A'(',(R8)		; Is it a left parenthesis
	BEQL	20$			; Yes: continue
	SCANC	#1,(R8),CHRTAB,#4	; Niether "," nor "("; is it space-tab
	BEQL	10$			; If non-blank, no label with "*"
	BRB	15$			; Have blank; find preceding non-blank
20$:	BSBW	INTCHG			; Interchange old label with new
	ON_ERROR	RESERR		; On error, branch to error handler
	BRB	10$			; Otherwise, repeat until ")" found
30$:	CLRB	CHRTAB+38		; Reset "&" entry to zero
40$:	BRW	WRTREC			; Done with "Call" return labels
IF:	TSTL	R0			; Was non-blank found after ")"
	BEQL	20$			; No: have invalid Fortran statement
	MOVL	R9,SPCADD		; Store address after ")" for wrtspc
	SCANC	#1,(R1),CHRTAB,#2	; Yes: is non-blank a digit
	BNEQ	10$			; Yes: continue
	SUBL3	#1,R1,R8		; No: compute address of non-digit
	BRW	CHKFTN			; Handle logical "If"
10$:	MOVL	R1,R7			; Have arithmetic "If"
	BSBW	INTCHG			; Interchange first label
	ON_ERROR	RESERR		; On error, branch to error handler
	SUBL3	R7,R10,R0		; Compute length to bound search
	SCANC	R0,(R7),CHRTAB,#2	; Find next digit
	BEQL	20$			; If none: bad Fortran error
	MOVL	R1,R7			; Store non-digit address for routine
	BSBW	INTCHG			; Interchange second label
	ON_ERROR	RESERR		; On error, branch to error handler
	SUBL3	R7,R10,R0		; Compute length to bound search
	SCANC	R0,(R7),CHRTAB,#2	; Find next digit
	BEQL	20$			; If none: bad Fortran error
	MOVL	R1,R7			; Store non-digit address for routine
	BSBW	INTCHG			; Interchange third label
	ON_ERROR	RESERR		; On error, branch to error handler
	BRW	WRTREC			; Done with arithmetic "If"
20$:	MOVZBL	#4,R0			; Set error flag to invalid Fortran
	BRW	RESERR			; and go to the fatal error handler
GO:	TSTL	R9			; Have we "(" (computed "Goto")
	BEQL	10$			; No: handle "Goto-Assign" statements
	MOVL	R7,SPCADD		; Store address after "(" for wrtspc
5$:	SUBL3	R7,R9,R0		; and handle "On-X-Goto"
	SCANC	R0,(R7),CHRTAB,#2	; Is there a digit remaining before ")"
	BEQL	20$			; No: done with computed "Goto"
	MOVL	R1,R7			; Yes: store address for subroutine
	BSBW	INTCHG			; Interchange old label with new
	ON_ERROR	RESERR		; On error, branch to error handler
	BRB	5$			; Continue to next label
10$:	SCANC	#1,(R7),CHRTAB,#2	; Is non-blank a digit
	BEQL	15$			; No: have an assigned "Goto"
	BSBW	INTCHG			; Yes: have "Assign" or simple "Goto"
	ON_ERROR	RESERR		; On error, branch to error handler
	BRW	WRTREC			; Done with all "Goto" and "Assign"
15$:	SUBL3	R7,R10,R0		; Is there a statement label list
	LOCC	#^A'(',R0,(R7)		; Find out by locating "("
	BEQL	20$			; No: no statement label list; done
	MOVL	R1,R7			; Yes: update delimiter byte address
	SUBL3	R7,R10,R0		; Compute length
	LOCC	#^A')',R0,(R7)+		; Locate corresponding ")"
	BEQL	20$			; None: (???) just write the record
	ADDL3	#1,R1,R9		; Update parenthesis end address
	BRB	5$			; and handle as if computed "Goto"
20$:	BRW	WRTREC			; Done with "Goto"
IO:	TSTL	R9			; Is there a "()" pair
	BNEQ	10$			; Yes: handle as unit number given
	MOVL	R7,SPCADD		; Store address of non-blank for wrtspc
	SCANC	#1,(R7),CHRTAB,#2	; Have default unit; is byte a digit
	BEQL	5$			; No: must be format array or "*"
	BSBW	INTCHG			; Yes: resequence format label
	ON_ERROR	RESERR		; On error, branch to error handler
5$:	BRW	WRTREC			; Done with default unit I-O
					; Have I-O with unit number and "()"
10$:	BSBW	EQLLBL			; Find "Err=" if any
	ON_ERROR	RESERR		; On error, branch to error handler
	MOVZBL	FTNTYP,R4		; Examine type of statement
	CMPB	#5,FTNADD[R4]		; Is statement "Encode" or "Decode"
	BEQL	50$			; Yes: handle conventional format
	BISL2	#BIT17,R12		; No: set bit 17 to indicate "Fmt="
	BSBW	EQLLBL			; Find "Fmt=" if any
	ON_ERROR	RESERR		; On error, branch to error handler
	BLBS	R1,60$			; Branch if "Fmt=" label found and fixed
50$:	MOVB	#^A',',R6		; Store comma in alternate byte register
	BSBW	ADVCHR			; Locate comma or ")"
	ON_ERROR	RESERR		; On error, branch to error handler
	BBC	#20,R12,70$		; If ")" found, just write record
	SPANC	R2,(R8),CHRTAB,#4	; Find a non-blank after the comma
	MOVL	R1,R7			; Store address of non-blank for later
	SCANC	#1,(R7),CHRTAB,#2	; Is non-blank in fact a digit
	BEQL	60$			; No: branch
	BSBW	INTCHG			; Yes: resequence it
	ON_ERROR	RESERR		; On error, branch to error handler
60$:	CMPB	#8,FTNTYP		; Is statement a "Read"
	BNEQ	70$			; No: all done with unit I-O
	CMPB	#^A')',(R7)		; Yes: are we at ")"
	BEQL	70$			; Yes: just write the record
	BISL2	#393216,R12		; No: set bits 17 & 18 to find "End="
	BSBW	EQLLBL			; Find "End=" if any
	ON_ERROR	RESERR		; On error, branch to error handler
70$:	MOVL	R9,SPCADD		; Save address of byte after ")"
	;
	; Prepare to write the Fortran statement
	;
WRTREC:	BBSC	#16,R12,20$		; Branch on continuation flag set
	MOVAL	IO_BUF,R7		; Store output record start address
	SUBL3	R7,R10,R9		; Compute output record length
	CMPW	#72,R9			; Is it greater than 72 bytes
	BGEQ	5$			; No: just write simple record
					; Yes: line exceeded 72 bytes during
					; label resequence; handle as continued
	SCANC	R9,IO_BUF+1,CHRTAB,#16	; Get to first letter of Fortran keyword
	MOVL	R1,R8			; Save its address for leader builder
	BSBW	BLDLDR			; Build the continuation line leader
	BSBW	WRTCTN			; and write statement
	ON_ERROR	RESERR		; On error, branch to error handler
5$:	MOVW	R9,OUT_RAB+RAB$W_RSZ	; Store output record size
	$PUT	RAB=OUT_RAB		; and put it to the output file
	ON_ERROR	RESERR		; On error, branch to error handler
	$GET	RAB=IN_RAB		; Initiate getting the next record
	CMPW	R12,(R11)		; Have we just processed a continuation
	BNEQ	40$			; No: continue
	ADDL2	#4,R11			; Yes: update ctn_data address pointer
	BRB	40$			; Process next record if any
	;
	; Line was processed by subroutine Reactn; record is in CTN_BUF and
	; may exceed 72 bytes.  Next input record already in io_buf.
	;
20$:	MOVAL	CTN_BUF,R7		; Line may exceed 72 bytes; write it
	MOVL	R7,OUT_RAB+RAB$L_RBF	; Change the output buffer to CTN_BUF
	SUBL3	R7,R10,R9		; Compute the record's length
	CMPW	STM_MSZ,R9		; Is it greater than maximum allowed
	BGEQ	30$			; No: just write simple record
	BSBW	WRTCTN			; Yes: write continued statement
	ON_ERROR	RESERR		; On error, branch to error handler
30$:	MOVW	R9,OUT_RAB+RAB$W_RSZ	; Store length of remaining record
	$PUT	RAB=OUT_RAB		; and put it to the output file
	ON_ERROR	RESERR		; On error, branch to error handler
40$:	MOVAL	IO_BUF,OUT_RAB+RAB$L_RBF; Return output buffer to IO_BUF
	BRW	REAREC			; Next record already in io-buf; analyze
	;
	;
	;
	; RESEQUENCE error handler - terminates current file processing.
	;
RESERR:	MOVL	R0,R4			; Save error code in permanent register
	MOVW	TYPE_FAB+FAB$W_IFI,R0	; Check console IFI
	BNEQ	10$			; Don't re-open console
	$CREATE	FAB=TYPE_FAB		; Open console for output
	ON_ERROR	30$		; Error while doing error recovery!!
	$CONNECT	RAB=TYPE_RAB	; Connect console
	ON_ERROR	30$		; Error while doing error recovery!!
10$:	CMPL	#16,R4			; Was error an RMS error
	BGEQ	20$			; No: show standard RESEQUENCE error
	BRW	ERRRMS			; and then show the RMS message
20$:	CASE	R4,<E0 E1 E2 E3 E4 E5 E6 E7 E8 E9>
30$:	$EXIT_S	R0			; Error recovery error
	;
	; RESEQUENCE error message section.
	;
E0:	TYPE	<%RES-E-MAXLBLEXC, maximum number of labels exceeded>
	BRW	ERRFIN
E1:	TYPE	-
	<%RES-E-MAXCTNEXC, maximum number of continued lines exceeded>
	BRW	ERRFIN
E2:	TYPE	<%RES-E-MAXSUBEXC, maximum number of subprograms exceeded>
	BRW	ERRFIN
E3:	TYPE	-
	<%RES-E-FMTLOVLP, resequenced label overlaps user FORMAT label>
	BRW	ERRFIN
E4:	TYPE	<%RES-E-ILLFORTR, illegal FORTRAN>
	BRW	ERRREC
E5:	TYPE	<%RES-E-INVQUAVAL, invalid qualifier or value>
	BRW	ERRFIN
E6:	TYPE	<%RES-E-INVLBLREF, invalid label referenced>
	BRW	ERRREC
E7:	TYPE	<%RES-E-RECTOOBIG, FORTRAN record too big>
	BRW	ERRFIN
E8:	TYPE	<%RES-E-CTNBUFOVF, continuation line buffer overflow>
	BRW	ERRREC
E9:	TYPE	<%RES-E-FILTOOBIG, file too big>
	BRW	ERRFIN
ERRRMS:	TYPE	<%RES-E-FILEIO, file I/O error>; Preface with general error
	$EXIT_S	R4			; Show the RMS error and quit
	;
	; Show error causing FORTRAN record and delete output file.
	;
ERRREC:	BBS	#16,R12,10$		; Branch if record in continuation area
	MOVAL	IO_BUF,R2		; Store address of I/O buffer
	BRB	20$			; Continue
10$:	MOVAL	CTN_BUF,R2		; Record in continuation buffer
20$:	SUBL3	R2,R10,R1		; Compute the record length
	MOVW	R1,TYPE_RAB+RAB$W_RSZ	; and store it for typer
	MOVL	R2,TYPE_RAB+RAB$L_RBF	; Also the record start address
	$PUT	RAB=TYPE_RAB		; Show fatal error record
	$FAB_STORE	FAB=OUT_FAB,-
			FOP=DLT		; Make output file disposal "Delete"
	;
	; Show resequence not complete warning and file specification. 
	;
ERRFIN:	MOVW	IN_FAB+FAB$W_IFI,R0	; Check input file IFI
	BNEQ	10$			; Branch if open
					; Error before input file opened
	MOVL	#RMS$_NMF,R0		; Simulate SEARCH "no more files"
	BRW	EXIT			; to bring orderly error exit
10$:	TYPE <%RES-W-ERRINPFIL, resequence error processing file ->
	MOVZBW	IN_NAM+NAM$B_RSL,-
		TYPE_RAB+RAB$W_RSZ	; Store file spec size
	MOVAL	IN_RES_STR,-
		TYPE_RAB+RAB$L_RBF	; Also the file spec start address
	$PUT	RAB=TYPE_RAB		; Show input file specification
	MOVL	#RMS$_EOF,R0		; Send EOF signal to exit handler
	;
	;
	; All normal termination.  Confirm all files under wildcard processed.
	;
EXIT:	CMPL	#RMS$_EOF,R0		; Check for RMS end-of-file on GET
	BNEQ	10$			; If EOF,
	$CLOSE	FAB=IN_FAB		; close input file
	ON_ERROR	RESERR		; On error, branch to error handler
	MOVW	OUT_FAB+FAB$W_IFI,R0	; Check output file IFI
	BEQL	5$			; Don't close file if not open
	$CLOSE	FAB=OUT_FAB		; Close output file 
	ON_ERROR	RESERR		; On error, branch to error handler
5$:	BBC	#NAM$V_WILDCARD,IN_NAM+NAM$L_FNB,20$ ; All done if no wildcards
	BRW	RESFIL			; Resume $SEARCH for next file spec
	;
	; Check for "No More Files" error from $SEARCH.
	;
10$:	CMPL	#RMS$_NMF,R0		; Not EOF; is condition no more files?
	BEQL	20$			; If not,
	BRW	RESERR			; have legitimate RMS error
20$:	MOVL	#^X00010001,R0		; This is successful normal completion
	$EXIT_S	R0			; Done with RESEQUENCE

	; Check if Fortran line is comment
	;
	; Inputs:
	;
	; R6 - Start address of record
	;
	; Outputs:
	;
	; R0 - Error code - clear if statement is comment
	; R1-R3 - Destroyed
	; R4 - Record size from RAB (<=72)
	; R5 - Uppercase ASCII of first byte if it is non-blank (zero otherwise)
	; R6 - Untouched
	;
CHKCOM::CLRL	R5			; Clear first byte of record output
	MOVZWL	IN_RAB+RAB$W_RSZ,R4	; Store record size
	BEQL	50$			; If zero, treat as Fortran comment
	CMPW	#72,R4			; Is it greater than 72 bytes
	BGEQ	20$			; No: see if record has non-blanks
	MOVW	#72,R4			; Effective size of record is 72...
					; we ignore columns 73-80
20$:	SPANC	R4,(R6),CHRTAB,#4	; Check record for any non-blank
	BEQL	50$			; If just blanks, treat as comment
	CMPL	R1,R6			; Is non-blank in column one
	BNEQU	30$			; No: see if it is "!" comment
	BICB3	#LCMSKB,(R6),R5		; Mask out a lowercase alphabetic
	CMPB	#^A'C',R5		; Is first byte a "C" or "c"
	BEQL	50$			; Yes: we have classic comment
	CMPB	#^A'!',(R6)		; Is first byte a "!"
	BEQL	50$			; Yes: we have inline comment
	CMPB	#^A'*',(R6)		; Is first byte a "*"
	BEQL	50$			; Yes: we have non-standard comment
	BRB	40$			; Have non-comment Fortran
30$:	CMPB	#^A'!',(R1)		; Is non-blank byte a "!"
	BNEQ	40$			; No: comment not possible
					; May have inline comment
	SUBL2	#5,R1			; Check if "!" is continuation chr by
	CMPL	R1,R6			; comparing adjusted address with start
	BNEQ	50$			; If not in column 6, we have comment
	LOCC	#9,#5,(R6)		; May still have comment...
	BNEQ	50$			; but only if Tab is present in leader
					; We have continuation line with "!"
40$:	MOVB	#1,R0			; Have non-comment - Return success
	RSB
50$:	CLRB	R0			; We are on a Fortran comment line
	RSB
	;
	;
	; Interchange Old Label with New
	;
	; Inputs:
	;
	; R7 - Address of first digit in old label string (5 digits or less)
	; R9 - Clear or address of right parenthesis
	; R10 - Address of first byte past current record (eor)
	;
	; Outputs:
	;
	; R0 - Error code
	; R1-R6 - Destroyed
	; R7 - Address of byte after inserted new label
	; R8 - Destroyed
	; R9 - If clear: change in number of characters; otherwise new
	;	address of right parenthesis
	; R10 - New address of first byte past current record (eor)
	;
INTCHG::BSBB	NEWLBL			; Get length and address of new label
	ON_ERROR	20$		; If label not found, fatal error
	MOVL	R5,R8			; Store length in more permanent reg
					; Now compute the address of byte after
	ADDL3	R7,R8,R2		; New label when it replaces old label
	CMPL	R2,R4			; Do labels end at same address
	BEQL	10$			; Yes: do simple move
	SUBL3	R4,R10,R0		; No: compute number of bytes to eor
	BNEQ	5$			; Branch if old label end not eor
					; Old label end is eor; just make the
	MOVL	R2,R10			; New eor the new label end address
	BRB	10$			; and make a simple move
5$:	MOVC3	R0,(R4),(R2)		; Move characters following old label
	SUBL2	R10,R3			; Compute change in characters
	ADDL2	R3,R10			; Use change to adjust eor address
	ADDL2	R3,R9			; and address of byte following ")"
10$:	MOVC3	R8,(R6),(R7)		; Move new label to old
	MOVL	R3,R7			; Return location of trailing non-digit
	MOVB	#1,R0			; Set return code to success
20$:	RSB
	;
	;
	; Find New Label in Label Map
	;
	; Inputs:
	;
	; R7 - Address of first digit in old label string (5 digits or less)
	; R10 - Address of first byte past current record (eor)
	;
	; Outputs:
	;
	; R0 - Error code
	; R1-R3 - Destroyed
	; R4 - Address of old label end
	; R5 - Length of new label in label map
	; R6 - Address of new label in label map
	; R7 - Untouched
	; R10 - Untouched
	;
NEWLBL::SPANC	#6,(R7),CHRTAB,#2	; Find non-digit after old label
	CMPL	R10,R1			; Was last digit past eor
	BGEQ	5$			; No: continue
	MOVL	R10,R1			; Yes: make sure address is just eor
5$:	CMPB	#^A'0',(R7)		; Is first digit a leading zero
	BNEQ	10$			; No: continue
	MOVL	R1,R2			; Yes: save address of trailing byte
	SUBL3	R1,R7,R0		; Compute length of whole digit string
	SKPC	#^A'0',R0,(R7)		; Find next non-zero digit
	BEQL	30$			; On fail, have fatal label error
	SUBL3	R1,R2,R6		; Place digit string length in R6
	MOVC3	R6,(R1),CMPBUF+1	; Move remaining digit string to buffer
	BRB	20$			; Done with leading zero exception
10$:	SUBL3	R7,R1,R6		; Place digit string length in R6
	MOVC3	R6,(R7),CMPBUF+1	; Move digit string to search buffer
20$:	MOVB	#^A'*',(R3)		; Append asterisk to search buffer
	MOVB	#^A';',CMPBUF		; Lead with semi-colon delimiter
	MOVL	R1,R4			; Save address of digit string end
	ADDB2	#2,R6			; Compute new length of search buffer
	MOVL	LBLBEG,R0		; Store address of map's first byte
	MATCHC	R6,CMPBUF,LBLLEN,(R0)	; Find old label in label map
	BEQL	40$			; Branch on successful label match
30$:	MOVZBL	#6,R0			; Set return code to "Invalid label"
	RSB				; and return with error
40$:	MOVL	R3,R6			; Store address of map's new label
	LOCC	#^A';',#6,(R6)		; Find ";" that trails new label
	SUBL3	R6,R1,R5		; Store new label length in R5
	MOVB	#1,R0			; Set return code to success
	RSB
	;
	; Read Continuations
	;
	; Inputs:
	;
	; R7 - Address of delimiter byte in io_buf
	; R8 - Address of first byte of Fortran keyword
	; R10 - Address of eor
	; R11 - Address in ctn_data holding record number of the
	;	present continued Fortran line
	;
	; Outputs:
	;
	; R0 - Error code
	; R1-R6 - Destroyed
	; R7 - New address of delimiter byte in CTN_BUF
	; R8 - Address of io_buf
	; R9 - Number of continuation lines processed
	; R10 - New address of eor in CTN_BUF
	; R11 - Address in ctn_data of next continued record number
	;
REACTN::BISL2	#BIT16,R12		; Set the continuations read flag
	BSBW	BLDLDR			; Build continuation line leader
	MOVAL	IO_BUF,R8		; Store address of the I-O buffer
	SUBL2	R8,R7			; Compute distance to delimiter byte
	MOVAL	CTN_BUF,R2		; Store address of CTNBSZ byte buffer &
	ADDL2	R2,R7			; use it to get new address of delimiter
	SUBL3	R8,R10,R0		; Compute length to eor
	MOVC3	R0,(R8),(R2)		; Move io_buf to CTN_BUF
	$GET	RAB=IN_RAB		; Initiate getting first continuation
	MOVL	R3,R10			; Update the eor address register
	CLRL	R6			; Clear a loop counter
	MOVZWL	B^2(R11),R9		; Store number continued lines present
	ADDL2	#4,R11			; Update ctn_data address pointer
10$:	INCW	R12			; Increment the record counter
	$WAIT	RAB=IN_RAB		; Wait for the next record
	ON_ERROR	40$		; On error, branch to error handler
	MOVZBL	#6,R0			; Field length is normal (6 bytes)
	CMPB	#9,(R8)			; Is first character a tab
	BNEQ	30$			; No: have ordinary continuation line
	MOVB	#2,R0			; Yes: have continued line using tab
30$:	SUBW3	R0,IN_RAB+RAB$W_RSZ,R1	; Adjust size accounting for ctn field
	ADDL3	R0,R8,R2		; Compute address after ctn field
	SPANC	R1,(R2),CHRTAB,#4	; Get to non-blank after ctn field
	MOVC3	R0,(R1),(R10)		; Append continuation to CTN_BUF
	$GET	RAB=IN_RAB		; and initiate getting next record
	MOVL	R3,R10			; Update eor address
	CMPL	#CBFEND,R10		; Have we overflowed continuation buffer
	BGTRU	35$			; If no, maybe read more
	MOVZBL	#8,R0			; Continuation line buffer overflow
	BRB	40$			; Proceed to error handler
35$:	AOBLSS	R9,R6,10$		; If more continued lines: repeat
	MOVB	#1,R0			; Set return code to success
					; Next rec already on its way
40$:	RSB     
	;
	; Build Continuation Leader
	;
	; Inputs:
	;
	; R8 - Address of first byte of Fortran keyword
	;
	; Outputs:
	;
	; R0-R6 - Destroyed
	; R8 - Untouched
	;
BLDLDR::CLRL	R6			; Clear register for use as counters
	MOVAL	IO_BUF,R4		; Store record start address
10$:	ADDL2	#^X00010001,R6		; Increment both counters
	CMPB	#9,(R4)+		; Are we at a tabulation character
	BNEQ	15$			; No: continue to next byte
	DIVB3	#8,R6,R0		; Yes: how many tab stops have we got
	INCB	R0			; Calculate next tab stop
	MULB3	#8,R0,R6		; which becomes new effective byte count
	BVC	15$			; Have we too many tabs (overflow)
	MOVL	#^X00010008,R6		; Yes: just use an acceptable default
	BRB	20$			; Continue; this should rarely happen
15$:	CMPL	R4,R8			; Have we reached first letter of keywrd
	BNEQ	10$			; No: examine next byte of leader
20$:	EXTV	#16,#8,R6,R2		; Extract actual number of bytes
	MOVB	#72,R1			; Store maximum number of bytes/line
	SUBB3	R2,R6,R0		; Difference between effective & actual
	CMPB	#8,R0			; Is difference one tab stop or more
	BGTR	30$			; No: maximum is source line maximum
	SUBB3	R0,#80,R1		; Yes: maximum is related to screen size
30$:	MOVZBW	R1,STM_MSZ		; Store statement maximum size
	DIVB2	#8,R6			; Calculate number of leader tab stops
	BEQL	35$			; Branch if no tab stops in leader
	DECB	R6			; Want one fewer tab than in stm leader
	MOVC5	#0,(R8),#9,R6,CTN_LDR+8	; Move correct number of tabs to leader
35$:	ADDB3	#8,R6,R2		; Calculate actual leader size
	MOVZBL	R2,CTN_ASZ		; and store it for later
	MULB2	#8,R6			; Calculate effective leader size
	ADDB2	#16,R6			; accounting for continuation constant
	MOVB	#72,R1			; Store maximum number of bytes/line
	SUBB3	R2,R6,R0		; Difference between effective & actual
	CMPB	#8,R0			; Is difference one tab stop or more
	BGTR	40$			; No: maximum is source line maximum
	SUBB3	R0,#80,R1		; Yes: maximum is related to screen size
40$:	MOVZBW	R1,CTN_MSZ		; Store continuation maximum size
	SUBW3	R6,#80,CTN_MFSZ		; Also compute maximum Fortran size
					; when part of continued line
	RSB
	;
	; Write Continuations
	;
	; Inputs:
	;
	; R7 - Address of first byte in current record
	; R10 - Eor byte address
	;
	; Outputs:
	;
	; R0 - Error code
	; R1-R6 - Destroyed
	; R7 - Starting address of remaining record
	; R8 - Destroyed
	; R9 - Length of record remaining in output buffer (LEQ than 72)
	; R10 - Eor address of remaining record (same as input)
	;
WRTCTN::PUSHL	R11			; Save R11 to free up register
	MOVZWL	STM_MSZ,R11		; Load maximum size of source line and
					; its leader (fits on one screen line)
	TSTL	SPCADD			; Use special continuation processing
	BEQL	5$			; No: must use default processing
	BSBW	WRTSPC			; Yes: handle with special ctn write
	BLBC	R1,20$			; Use default processor if necessary
5$:	MOVW	R11,OUT_RAB+RAB$W_RSZ	; Set output buffer size to max size
	$PUT	RAB=OUT_RAB		; Put partial record to output file
	ON_ERROR	20$		; On error, branch to error handler
	MOVW	#72,OUT_RAB+RAB$W_RSZ	; Reset output buffer size to default
	ADDL2	R11,R7			; Calculate end of record address
	SUBL2	#6,R7			; Determine default leader start addr
	BRB	15$			; Prepare to write next record
10$:	$PUT	RAB=OUT_RAB		; Put partial record to output file
	ON_ERROR	20$		; On error, branch to error handler
	ADDL2	#66,R7			; Calc remaining record start address
15$:	MOVL	R7,OUT_RAB+RAB$L_RBF	; and store it in out_rab
	MOVL	#^A'    ',(R7)		; Store 4 spaces in continuation field
	MOVW	#^A' &',B^4(R7)		; and append " &" as continuation mark
	SUBL3	R7,R10,R9		; Compute the remaining record length
	CMPW	#72,R9			; Is it greater than 72 bytes
	BLSS	10$			; Yes: repeat this process
	MOVB	#1,R0			; No: set return code to success
20$:	POPL	R11			; Restore R11
	RSB				; Return to write remaining record
	;
	; Advance to Character
	;
	; Inputs:
	;
	; R6 - ASCII code of alternate search byte; otherwise clear
	; R7 - Address of byte on which to begin search
	; R10 - Eor address
	; R12 - Bit 19: set if a direct access I-O check required
	;
	; Outputs:
	;
	; R0 - Error code
	; R1 - Low bit set when alternate byte was found first
	; R2 - If alternate found, number of bytes to eor; otherwise scratch
	; R3-R5 - Destroyed
	; R6 - Same as input
	; R7 - Updated to "r" address if (r'u) present; otherwise untouched
	; R8 - Address after alternate byte or ")", whichever first
	; R10 - Same as input
	; R12 - Bit 19: cleared if "r'u" found; otherwise set
	;       Bit 20: cleared if alternate byte not found; otherwise set
	;
ADVCHR::MOVZBL	#1,R4			; Set parenthesis counter to one
	MOVL	R7,R8			; Store address of start byte
	TSTB	R6			; Is alternate search byte reg clear
	BEQL	10$			; Yes: branch
	MOVZBL	R6,R6			; No: build index out of ASCII code
	MOVB	CHRTAB[R6],R5		; Save chrtab mask value
	MOVB	#8,CHRTAB[R6]		; Replace with mask eight - "()'"
10$:	SUBL3	R8,R10,R0		; Compute distance to eor
	SCANC	R0,(R8),CHRTAB,#8	; and find next "()'" or alternate
	BEQL	25$			; On fail, have a fatal error
	SUBB3	#39,(R1)+,R2		; Tranform ASCII code for case branch
	MOVL	R1,R8			; Update to address of byte following
	CASE	R2,<15$ 35$ 40$>	; Branch on "' ( )"
	CMPB	#1,R4			; Have alternate; is just one "("
	BNEQ	10$			; No: alternate inside new "()"
	BISL2	#BIT20,R12		; Yes: set alternate byte found flag
	MOVL	R0,R2			; Save number of bytes to eor
	MOVB	#1,R0			; Set return code to success
	BRB	50$			; and prepare to exit
15$:	SUBL3	R8,R10,R3		; Have "'"; compute distance to eor
	BBC	#19,R12,20$		; Branch if direct access problem ok
	BSBW	DAEVAL			; See if I-O of form (r'u,...)
	BRB	10$			; Direct access ok; continue with search
20$:	LOCC	#^A"'",R3,(R8)		; Locate corresponding "'"
	BNEQ	30$			; Branch on success
25$:	MOVZBL	#4,R0			; Fatal "Invalid Fortran" error
	BRB	45$			; Clean-up and return with error
30$:	ADDL3	#1,R1,R8		; Examine the following byte
	CMPB	#^A"'",(R8)		; Is next byte another "'"
	BNEQ	10$			; If no, we have end of string
	INCL	R8			; Have quote within quote
	BRB	15$			; Continue search for end quote
35$:	INCB	R4			; Have "("; increment counter
	BRB	10$			; and continue search for ")"
40$:	SOBGTR	R4,10$			; Have ")"; repeat on counter not zero
	BICL2	#BIT20,R12		; Have last corresponding ")"
	MOVB	#1,R0			; Set return code to success
45$:	TSTB	R6			; Was there an alternate given
	BEQL	60$			; No: branch
50$:	MOVB	R5,CHRTAB[R6]		; Yes: replace original mask in chrtab
60$:	RSB				; All done     
	;
	; Direct Access I-O Evaluator
	;
	; Inputs:
	;
	; R3 - Number of bytes to eor from "'"
	; R7 - Address of first byte in string
	; R8 - Address of byte after "'"
	; R10 - Eor address
	; R12 - Bit 19: set
	;
	; Outputs:
	;
	; R0 - Error code
	; R1-R3 - Scratch
	; R7 - Address of "r" if (r'u) present; otherwise untouched
	; R8 - Address of first byte after correct "'"
	; R10 - Untouched
	; R12 - Bit 19: cleared
	;
DAEVAL::BICL2	#BIT19,R12		; Clear the direct access flag
	LOCC	#^A"'",R3,(R8)		; Do we have a matching "'"
	BEQL	70$			; No: have direct access I-O statement
					; May still have direct access I-O
	PUSHL	R1			; Save address of second "'" on stack
	SUBL3	#2,R8,R1		; Compute address before "'"
10$:	SCANC	#1,(R1),CHRTAB,#4	; Is it space or tab
	BNEQ	40$			; Yes: continue looking back
	SCANC	#1,-(R1),CHRTAB,#50	; No: is it a legal unit specifier char
	BEQL	60$			; No: do not have direct access I-O
	POPL	R1			; Yes: have direct access I-O; pop stack
	BRB	70$			; and retire with address of "r"
40$:	DECL	R1			; Adjust address back one byte
	CMPL	R1,R7			; Have we gone before start
	BGEQ	10$			; No: continue looking
					; Yes: do not have direct access I-O
60$:	ADDL3	#1,(SP)+,R8		; Compute address after second "'"
	RSB				; Return
70$:	MOVL	R8,R7			; Update R7 to address of "r" in (r'u)
	RSB
	;
	; Find "Err=", "Fmt=" or "End="
	;
	; Inputs:
	;
	; R7 - Address of first byte in string
	; R9 - Address of first byte after ")"
	; R10 - Eor address
	; R12 - Bit 17: set if looking for "Fmt=" or "End="; clear: "Err="
	;       Bit 18: set if looking for "End="; clear: "Fmt="
	;
	; Outputs:
	;
	; R0 - Error code
	; R1 - Low bit set if label found and changed
	; R2-R6 - Scratch
	; R7 - Untouched
	; R8 - Destroyed
	; R9 - New address of first byte after ")"
	; R10 - New eor
	; R12 - Bit 17: clear
	;       Bit 18: clear
	;
EQLLBL::MOVB	#^A',',R6		; Set alternate delimiter to ","
	PUSHL	R7			; Save the address held in R7 on stack
	MOVL	R7,R8			; Start with first byte
	SUBL3	R8,R9,R2		; Compute number of bytes to ")"
10$:	SPANC	R2,(R8),CHRTAB,#4	; Get to next non-blank
	MOVL	R1,R7			; Update current address
	BICL3	#LCMSKL,(R1),CMPBUF	; Mask out lowercase
	BBC	#17,R12,30$		; Do we want to handle "Err="; branch
	BBC	#18,R12,25$		; Do we want to handle "Fmt="; branch
	CMPC3	#3,CMPBUF,ENDSTR	; "End="; are next 3 bytes "End"
	BNEQ	40$			; No: continue looking until ")"
	BRB	35$			; Yes: check for equal sign
25$:	CMPC3	#3,CMPBUF,FMTSTR+6	; "Fmt="; are next 3 bytes "Fmt"
	BNEQ	40$			; No: continue looking until ")"
	BRB	35$			; Yes: check for equal sign
30$:	CMPC3	#3,CMPBUF,ERRSTR	; "Err="; are next 3 bytes "Err"
	BNEQ	40$			; No: continue looking until ")"
35$:	ADDL2	#3,R7			; Adjust current address to after string
	SUBL3	R7,R9,R0		; Yes: compute length to ")"
	SPANC	R0,(R7),CHRTAB,#4	; Get to next non-blank
	CMPB	#^A'=',(R1)+		; Is it an equal sign
	BNEQ	40$			; No: resume equal search
	SUBL3	R1,R9,R0		; Yes: compute length to bound search
	SPANC	R0,(R1),CHRTAB,#4	; Get to next non-blank
	SCANC	#1,(R1),CHRTAB,#2	; Is it a digit
	BEQL	50$			; No: (???) just write this record
	MOVL	R1,R7			; Yes: place address in R7 for routine
	BSBW	INTCHG			; Interchange old label with new
	ON_ERROR	60$		; On error, branch to error handler
	MOVB	#1,R1			; Set the label found and fixed flag
	BRB	55$			; Prepare to leave
40$:	CMPL	R7,R9			; Have we passed ")"
	BGEQU	50$			; Yes: done with equal label search
	BSBW	ADVCHR			; No: find next delimiting ","
	ON_ERROR	60$		; On error, branch to error handler
	BBC	#20,R12,50$		; Found ")"; all done
	BRW	10$			; Branch if comma found (alternate)
50$:	CLRB	R1			; Clear the label found and fixed flag
55$:	MOVB	#1,R0			; Set error code to success
60$:	POPL	R7			; Restore original address from stack
	BICL2	#393216,R12		; Clear both R12 flag bits
	RSB
	;
	; Special Continuation Line Processor
	;
	; Inputs:
	;
	; R7 - Address of first byte in current record
	; R10 - Eor byte address
	; R11 - Maximum size of statement and leader so that it will
	;		fit on one VT100 screen line (without wrap around)
	;
	; Outputs:
	;
	; R0 - Error code
	; R1 - Low bit set if default continuation processing still needed
	; R2-R6 - Destroyed
	; R7 - Starting address of remaining record
	; R8 - Destroyed
	; R9 - Length of record remaining in output buffer (LEQ than 72)
	;	(but not if default processing is needed on return)
	; R10 - Eor address of remaining record (same as input)
	; R11 - Maximum size of continuation and leader so that it will
	;		fit on one VT100 screen line (without wrap around)
	;
WRTSPC::MOVL	R7,R9			; Save record start address
	MOVL	SPCADD,R7		; Get start address to be used by Advchr
	BICL2	#BIT21,R12		; Clear continuation pointer moved flag
	MOVB	#^A',',R6		; Place comma as alternate for Advchr
	SUBL3	R9,R7,R0		; Compute number of bytes from start
	CMPW	R11,R0			; Is it greater than max size allowed
	BGTR	5$			; No: find 1st continuation break point
	BRW	30$			; Yes: must use default processor
5$:	BSBW	ADVCHR			; Find byte after comma or ")"
	ON_ERROR	10$		; If no "," or trailing ")", branch
	SUBL3	R9,R8,R0		; Compute distance from record start
	CMPW	R11,R0			; Is it greater than max size allowed
	BLSS	20$			; Yes: write to previous comma
	BISL2	#BIT21,R12		; Set continuation pointer moved flag
	MOVL	R8,R7			; Store address after ")" or ","
	BBS	#20,R12,5$		; If "," found, look for more
	MOVW	R0,R8			; Store length of remaining Fortran
	BRW	40$			; Found ")"; return to write this record
10$:	SUBL3	R7,R10,R2		; Compute number bytes remaining
	CMPW	CTN_MFSZ,R2		; Will remaining Fortran fit on one line
	BGEQ	25$			; Yes: write first part of record
	BRW	30$			; No: must use default continuation
					; processor for this record
20$:	SUBL3	R7,R10,R2		; Compute number of characters remaining
25$:	SUBL3	R9,R7,R1		; Compute record length
	MOVW	R1,OUT_RAB+RAB$W_RSZ	; and store it in output RAB
	$PUT	RAB=OUT_RAB		; Put record to output file
	ON_ERROR	50$		; On error, proceed to error handler
	SPANC	R2,(R7),CHRTAB,#4	; Get to next non-blank character
	MOVL	R8,R7			; Save address of byte after comma
	MOVL	R0,R8			; Save length of remaining Fortran
	SUBL3	CTN_ASZ,R1,R9		; Compute start address for ctn leader
	MOVC3	CTN_ASZ,CTN_LDR,(R9)	; Move the continuation leader to addr
	MOVL	R9,OUT_RAB+RAB$L_RBF	; and store as new record start address
	CMPW	CTN_MFSZ,R8		; Is remaining Fortran too long
	BGEQ	35$			; No: we are done with continuations
	MOVZWL	CTN_MSZ,R11		; Maximum number of bytes in source and
					; leader for continuation screen line
	BBC	#20,R12,30$		; If "," not found, use default processr
	BBSC	#21,R12,28$		; If pointer has moved, do again
					; Comma found and pointer not moving
					; Will line and comma be written next?
	SUBL3	R9,R7,R0		; No. of bytes from beginning to comma
	CMPW	R11,R0			; Is it greater than what can be written
	BLSS	30$			; If yes, use default processor
28$:	ADDL3	CTN_ASZ,R9,R7		; Resume search just past leader
	BRW	5$			; Look for next continuation break point
					; Use default continuation processor
30$:	MOVL	R9,R7			; Reset R7 to next output start address
	MOVB	#1,R1			; Indicate default processing required
	RSB
35$:	ADDW2	CTN_ASZ,R8		; Compute actual continuation rec length
40$:	MOVL	R9,R7			; Restore last record output start addr
	MOVZWL	R8,R9			; Save record length
	MOVB	#1,R0			; Set return code to success
50$:	CLRB	R1			; Indicate default processing not nec.
	RSB

	;
	; Packed Statement with Label Analyzer
	;
	; Inputs:
	;
	; R1 - Address of non-digit following suspected label digit string
	; R7 - Address of first digit in label
	; R10 - Address of eor
	;
	; Outputs:
	;
	; R0 - Error code: low bit clear if no label found
	; R1-R6 - Scratch
	; R7 - Same as input
	; R8 - Scratch
	; R10 - Same as input
	;
	; This routine checks packed statements - i.e. Fortran with no spaces.
	;
PCKSTM::SUBL3	R1,R10,R4		; Compute length to eor 
	SPANC	R4,(R1),CHRTAB,#4	; Find next non-blank character
	BEQL	80$			; If none, digit string is label
	CMPW	R4,R0			; Is space between label and non-digit
	BNEQ	50$			; Yes: check for array "("
	CMPB	#^A',',(R1)		; No space follows digit; have we a ","
	BEQL	80$			; Yes: packed statement w/ label - done
	;
	; Just handled cases like "TYPE20,I" and "DO20,J=M,N".  The only
	; remaining legal possibilities that I know of are DO statements
	; like "DO20I=M,N" or "DO20WHILE(X) - neither of which deserve to be
	; RESEQUENCE'd!  Try anyhow.
	;
	CMPB	#2,FTNTYP		; Have we a packed DO statement
	BNEQ	70$			; No: statement has no label
	BSBW	PCKDO			; Analyze packed DO - DO WHILE construct
	ON_ERROR	70$		; Statement has no label
	BRB	60$			; Confirm DO WHILE not DO1WHILE(X)=1
	;
	; Check for case like "TYPE20(I)=3" or "DO200WHILE(X)=1"
	;
50$:	CMPB	#^A'(',(R1)		; Have we an array reference
	BEQL	70$			; Yes: must be assignment statement
60$:	CMPB	#^A'=',(R1)		; Have we assignment statement "="
	BNEQ	80$			; No: have packed statement
70$:	CLRB	R0			; Indicate no label in statement
	RSB
80$:	MOVB	#1,R0			; Packed statement has label
	RSB
	;
	; Packed Statement with Label Analyzer - DO statement
	;
	; Inputs:
	;
	; R1 - Address of non-digit following suspected label
	; R4 - Number of bytes to eor from address in R1
	; R7 - Address of first digit in label
	; R10 - Address of eor
	;
	; Outputs:
	;
	; R0 - Error code: low bit clear if no label found
	; R1 - If DO WHILE, address of non-blank after ")", if any, otherwise,
	;	address of first digit in label string.
	; R2-R6 - Scratch
	; R7 - Same as input
	; R8 - Scratch
	; R10 - Same as input
	;
	; Checks statements of form "DO20I=5" and "DO20WHILE(X)=5".
	;
PCKDO::	BICL2	#BIT22,R12		; Clear DO WHILE statement bit
	MOVL	R1,R8			; Save address of non-digit after label
	LOCC	#^A'(',R4,(R8)		; Find "(" of DO WHILE construct
	BEQL	5$			; If none, look for DO "=" instead
	BISL2	#BIT22,R12		; Set DO WHILE statement bit
	SUBL3	R8,R1,R4		; Compute length to "(" from non-digit
5$:	LOCC	#^A'=',R4,(R8)		; Search for "=" part of DO statement
	BNEQ	10$			; If found, we may have simple DO
	BBS	#22,R12,50$		; No "="; if "(", may have DO WHILE
	BRB	90$			; Have neither DO nor DO WHILE
10$:	BICL2	#BIT22,R12		; Clear DO WHILE statement bit
	SUBL3	R1,R10,R4		; Compute length to eor
	MOVL	R1,R8			; Save address of DO "="
	LOCC	#^A"'",R4,(R8)		; Do we have character constant quote
	BNEQ	90$			; Yes: Obviously not a DO statement
20$:	LOCC	#^A'(',R4,(R8)		; Find array "(" if any
	BNEQ	40$			; Found "("; see if prior ","
	MOVL	R10,R1			; Comma search will be to eor
40$:	SUBL2	R8,R1			; Compute length for search
	LOCC	#^A',',R1,(R8)		; Search for required DO ","
	BNEQ	80$			; Have very "packed" DO stmt.
	CMPL	R1,R10			; Are we at eor (without ",")
	BEQL	90$			; No: do not have a DO statement
	;
	; Handling case like "DO200I=A(1,3),B" or "DO200WHILE(X)".  In either 
	; case, get passed ")".
	;
50$:	CLRB	R6			; Clear alternate delimiter
	MOVL	R7,SPCADD		; Save label start pointer temporarily
	ADDL3	#1,R1,R7		; Address of one after "("
	BSBW	ADVCHR			; Find corresponding ")"
	ON_ERROR	90$		; If none, just assume no label
	MOVL	SPCADD,R7		; Restore label start pointer
	CLRL	SPCADD			; Reset continue address buffer clear
	SUBL3	R8,R10,R4		; Compute length to eor
	BBC	#22,R12,20$		; Resume search for "DO" comma
	;
	; After ")" of probable "DO200WHILE(X)" statement; confirm we do not
	; have assignment statement - "DO200WHILE(1)=N".
	;
	SPANC	R4,(R8),CHRTAB,#4	; Find next non-blank after ")"
	BNEQ	85$			; Non-blank must not be assignment "="
80$:	MOVL	R7,R1			; Statement has label; return start addr
85$:	MOVB	#1,R0			; Set error code success
	RSB
90$:	CLRB	R0			; Statement has no label
	RSB
	.END	RESFOR