.TITLE	FLERSX
	.IDENT	/15SEP0/
         .NLIST    BEX

;+
; - F L E R S X
;****NAME:   FILE FLERSX.MAC
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  MACRO SUPPORT ROUTINES FOR THE FLECS TRANSLATOR
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 	(CM) PROPER HANDLING OF BLANK LINES
;	(CM) PROPER HANDLING OF ( FOLLOWING TAB
; 02-SEP-75 (MK) ADD SPOOLING CODE
; 09-SEP-75 (MK) TENDENCY TO LEAVE EMPTY FILES LYING AROUND FIXED
; 17-OCT-75 (MK) FIXED TO ACCEPT COMMAND LINES FROM MCR
; 12-AUG-76 (MK) MADE RSX 11M/11D COMPATIBLE
; 28-JUN-77 (MK) ADD RSK'S REWRITE OF THE GET SUBROUTINE WITH IMPROVED
;		 TAB HANDLING
; 02-JUN-78 (MK) REMOVE FF ON FIRST PAGE
; 14-FEB-80 (MAO) ADD /FU, PSECT MACVAL
; 02-MAY-80 (MAO) ADD EXFLE ENTRY POINT, EXIT-WITH-STATUS
; 08-JUL-80 (MAO) CATSUB TREAT ZERO-LENGTH LINES CORRECTLY
; 15-SEP-80 (MAO) FF IN COL 1--> NEW PAGE
;
;****CALLING SEQUENCE:  SEE INDIVIDUAL ROUTINES
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
;****NOTES:  
;
;-
;
         .MCALL    GCML$,CSI$,CSI$1,CSI$2,GCMLB$,OPEN$W,OPEN$R,DIR$,CLOSE$
         .MCALL    QIOW$,NMBLK$,FDBDF$,FDAT$A,FDRC$A,FDOP$A,DELET$
         .MCALL    GET$,PUT$
	.MCALL	EXST$S						;MAO050280
	.MCALL	CSI$SW,CSI$ND,PRINT$				;MK090275

BLANK=	40
TAB=	11
TRUE=	-1			;VALUE OF FORTRAN .TRUE.
CHCMNT=103			;FORTRAN COMMENT CHARACTER "C"

;+
; - S T R E Q
;****NAME:   FUNCTION STREQ
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  TEST FOR STRING EQUALITY
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
;
;****CALLING SEQUENCE:  L=STREQ(A,B)
;
;		INPUT: 
;
; A	=STRING OF NON-ZERO LENGTH
; B	=STRING OF NON-ZERO LENGTH
; 
;	       OUTPUT:  
;
; STREQ	=(L*2) .T. IF STRINGS ARE IDENTICAL IN LENGTH AND CONTENTS,
;	       .F. IF OTHERWISE.
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
; LENGTH/PAR:  
;
;****NOTES:  
;
;-
;
;   *** LOGICAL FUNCTION STREQ(A,B)

STREQ::  CLR       R0             ; SET RETURN VALUE TO FALSE
         MOV       2(R5),R1       ; R1 POINTS TO STRING A
         MOV       4(R5),R2       ; R2 TO B
         MOV       (R1),R3        ; GET LENGTH TO R3
         CMP       (R1)+,(R2)+    ; CHECK LENGTHS MATCH
         BNE       2$
1$:      CMPB      (R1)+,(R2)+    ; COMPARE BYTE BY BYTE
         BNE       2$
         SOB       R3,1$
         DEC       R0             ; SET RETURN TRUE
2$:      RTS       PC
;+
; - S T R L T
;****NAME:   FUNCTION STRLT
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  DETERMINE WHETHER ONE STRING IS LEXICOGRAPHICALLY
;		LESS THAN ANOTHER.
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
;
;****CALLING SEQUENCE:  L=STRLT(A,B)
;
;		INPUT: 
;
; A	=STRING OF NON-ZERO LENGTH
; B	=STRING OF NON-ZERO LENGTH
; 
;	       OUTPUT:  
;
; STRLT	=(L*2) SET .TRUE. IF THE STRING A IS LEXICOGRAPHICALLY STRICTLY
;		LESS THAN STRING B.
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
; LENGTH/PAR:  
;
;****NOTES:  
;
;-

;   *** LOGICAL FUNCTION STRLT(A,B)

STRLT::  CLR       R0             ; SET RETURN VALUE FALSE
         MOV       2(R5),R1
         MOV       4(R5),R2
         MOV       (R1)+,R3       ; SET LENGTH TO MIN OF THE TWO STRINGS
         CMP       R3,(R2)+
         BLE       1$
         MOV       -2(R2),R3
1$:      CMPB      (R1)+,(R2)+    ; COMPARE BYTE BY BYTE
         BLT       2$
         BGT       3$
         SOB       R3,1$
         CMP       @2(R5),@4(R5)  ; IF EQUAL UP TO MIN LENGTH -
         BGE       3$             ; TRUE IF A SHORTER
2$:      DEC       R0             ; SET RETURN VALUE TRUE
3$:      RTS       PC
;+
; - G E T C H
;****NAME:   SUBROUTINE GETCH
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  RETRIEVE INDIVIDUAL CHARACTER FROM A STRING
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 02-SEP-75 (MK) REWORK CODE
;
;****CALLING SEQUENCE:  CALL GETCH(WD,POS,CH)
;
;		INPUT: 
;
; WD	=(I*2) LOCATION IN STRING CONTAINING CHARACTER
; POS	=(I*2) WHICH CHARACTER IN WD TO RETRIEVE (1-NCHPWD)
; 
;	       OUTPUT:  
;
; CH	=(I*2) INTEGER VALUE OF CHARACTER AT SPECIFIED LOCATION
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
; LENGTH/PAR:  
;
;****NOTES:  
;
;-

;   *** SUBROUTINE GETCH(WORD,POS,VALUE)

GETCH::  MOV       2(R5),R0       ; MOVE ADDR OF WORD TO R0
         ADD       @4(R5),R0      ; ADD POSITION
	CLR	R1		;CLEAR HIGH BYTE		;MK090275
	BISB	-(R0),R1	;GET CHAR			;MK090275
	MOV	R1,@6(R5)	;STORE CHAR			;MK090275
         RTS       PC
;+
; - P U T C H
;****NAME:   SUBROUTINE PUTCH
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  PUT A CHARACTER INTO A STRING
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 02-SEP-75 (MK) REWORK CODE
;
;****CALLING SEQUENCE:  CALL PUTCH(WD,POS,CH)
;
;		INPUT: 
;
; POS	=(I*2) LOCATION IN WD TO REPLACE (1-NCHPWD)
; CH	=(I*2) INTEGER VALUE OF CHARACTER TO PUT IN STRING
; 
;	       OUTPUT:  
;
; WD	=(I*2) WORD IN STRING TO HAVE A CHARACTER REPLACED
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
; LENGTH/PAR:  
;
;****NOTES:  
;
;-

;   *** SUBROUTINE PUTCH(WORD,POS,VALUE)

PUTCH::  MOV       2(R5),R0
         ADD       @4(R5),R0
         MOVB      @6(R5),-(R0)					;MK090275
         RTS       PC
;+
; - C H T Y P
;****NAME:   FUNCTION CHTYP
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  RETURN CODE FOR CHARACTER TYPE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 17-OCT-75 (MK) BRANCH MORE SENSIBLY AFTER TEST
;
;****CALLING SEQUENCE:  	I=CHTYP(CH)
;
;		INPUT: 
;
; CH	=(I*2) INTEGER REPRESENTING CHARACTER CODE FOR THE CHARACTER
; 
;	       OUTPUT:  
;
; CHTYP	=(I*2) SYNTACTIC CATEGORY FOR THE CHARACTER
;	=1, LETTER, A-Z OR LOWER CASE A-Z
;	=2, DIGIT, 0-9
;	=3, HYPHEN OR MINUS SIGN
;	=4, LEFT PARENTHESIS
;	=5, RIGHT PARENTHESIS
;	=6, BLANK
;	=7, ANY OTHER CHARACTER
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
; LENGTH/PAR:  
;
;****NOTES:  
;
;-

;   *** INTEGER FUNCTION CHTYP(CHAR)

CHTYP::  MOV       #1,R0          ; SET REUTRN VALUE TO 1
         MOV       @2(R5),R1      ; GET CHAR TO R1
         CMP       R1,#'A         ; TYPE=1 IF A-Z
         BLT       2$						;MK101775
         CMP       R1,#'Z
         BLE       9$
1$:      CMP       R1,#141        ; TYPE=1 IF LITTLE A-Z
         BLT       2$
         CMP       R1,#172
         BLE       9$
2$:      INC       R0
         CMP       R1,#'0         ; TYPE=2 IF 0-9
         BLT       3$
         CMP       R1,#'9
         BLE       9$
3$:      INC       R0             ; TYPE=3 IF '-'
         CMP       R1,#'-
         BEQ       9$
         INC       R0
         CMP       R1,#'(         ; TYPE=4 IF '('
         BEQ       9$
         INC       R0
         CMP       R1,#')         ; TYPE=5 IF')'
         BEQ       9$
         INC       R0             ; TYPE=6 IF BLANK OR TAB
         CMP       R1,#BLANK
         BEQ       9$
         CMP       R1,#TAB
         BEQ       9$
         INC       R0             ; ALL ELSE TYPE=7
9$:      RTS       PC
;+
; - C A T S U B
;****NAME:   SUBROUTINE CATSUB
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  CONCATENATE A PORTION OF ONE STRING TO ANOTHER.
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 08-JUL-80 (MAO) IF LEN.LE.0, DO NOTHING AS PER ORIGINAL SPECS
;
;****CALLING SEQUENCE:  CALL CATSUB(A,B,START,LEN)
;
;		INPUT: 
;
; A	=STRING TO BE APPENDED TO
; B	=STRING FROM WHICH A SUBSTRING IS EXTRACTED AND APPENDED TO A
; START	=(I*2) FIRST CHARACTER IN B TO EXTRACT
; LEN	=(I*2) NUMBER OF CHARACTERS TO EXTRACT (IF=0, A IS NOT MODIFIED)
; 
;	       OUTPUT:  
;
; A	=ORIGINAL STRING + LEN CHARACTERS FROM B
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
; LENGTH/PAR:  
;
;****NOTES:  
;
;-

;   *** SUBROUTINE CATSUB(A,B,BSTART,LENGTH)

CATSUB:: MOV       2(R5),R1       ; GET ADDR OF A AND B STRINGS
         MOV       4(R5),R2
         MOV       @10(R5),R3     ; GET LENGTH TO MOVE
	BLE	2$		;NOOP IF LENGTH .LE.0	;MAO070880
         ADD       (R1),R1        ; MOV R1 TO END OF STRING A
         ADD       #2,R1
         ADD       R3,@2(R5)      ; UPDATE LENGTH OF STRING A
         ADD       @6(R5),R2      ; MOV R2 TO START CHAR OF B
         INC       R2
1$:      MOVB      (R2)+,(R1)+    ; MOVE DATA
         SOB       R3,1$
         BIT       #1,R1          ; IF ODD # OF CHARS PAD A BLANK
         BEQ       2$
         MOVB      #BLANK,(R1)
2$:      RTS       PC

;+
; - O P E N F
;****NAME:   SUBROUTINE OPENF
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  GET COMMAND LINE FOR FLECS, OPEN INPUT AND OUTPUT FILES
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 02-SEP-75 (MK) ADD SPOOLING CODE
; 09-SEP-75 (MK) DELETE ZERO-LENGTH FILES
; 17-OCT-75 (MK) GET MCR COMMAND LINE
; 14-FEB-80 (MAO) ADD /FU
; 02-MAY-80 (MAO) USE EXFLE INSTEAD OF EXIT$S
;
;****CALLING SEQUENCE:  CALL OPENF(CALLNO,DONE,SVER)
;
;		INPUT: 
;
; CALLNO=(I*2)NUMBER OF TIMES OPENF HAS BEEN CALLED BEFORE THIS
; SVER	=STRING TO HEAD FLL PAGES
; 
;	       OUTPUT:  
;
; DONE	=(L*2) .TRUE. IF NO MORE INPUT PRESENT, .FALSE. OTHERWISE
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  TIME, DATE, [XXX,YYY]EXFLE
; DISK FILES:  FLX, FTN AND FLL FILES
; DEVICES:     DISK FILES
; SGAS:        NONE
; EVENT FLAGS: 1
; SYSTEM DIR:  GCML$,CSI$1,CSI$2,OPEN$W,OPEN$R,DIR$,DELET$
;		CLOSE$
; LENGTH/PAR:  
;
;****NOTES:  
;
;-

;   *** SUBROUTINE OPENF(CALLNO,DONE,SVER)

OPENF::  MOV       6(R5),R1       ; COPY OVER SVER TO HEADING
         MOV       (R1)+,R3
         MOV       #SVER,R2       ; PICK UP HEADING ADDRESS
1$:      MOVB      (R1)+,(R2)+    ; MOVE DATA
         SOB       R3,1$
         MOV       #TB,R5         ; GET TIME AND DATE TO HEADING
         JSR       PC,TIME
         MOV       #DB,R5
         JSR       PC,DATE
SOPEN:   MOV       #PAGE,R0       ; RESET PAGE AND LINE COUNTS AND
         CLR       (R0)+          ; FORT AND LIST FLAGS
         CLR       (R0)+
         CLR       (R0)+
         CLR       (R0)+
         MOVB      #'1,ERNUM      ; SET ERROR=1
         GCML$     #GCBUF         ; GET COMMAND			;MK101775
	BCC	1$						;MAO021480
	JMP	EXFLE						;MAO050280
1$:	TST	GCBUF+G.CMLD	;ANYTHING TYPED?		;MK101775
	BEQ	SOPEN		;NO				;MK101775
	CSI$1	#CSIBLK,GCBUF+G.CMLD+2,GCBUF+G.CMLD		;MK101775
         BCS       TYPERR
FTOPN:   MOVB      #'2,ERNUM      ; SET ERROR=2
	CLR	LSTFUL		;SET /FU DEFAULT TO .F. 	;MAO021480
         CSI$2     #CSIBLK,OUTPUT,#FUSW
         BCS       TYPERR
	TST	LSTFUL			;/FU?			;MAO021480
	BEQ	1$			;NO, BRANCH		;MAO021480
	MOV	#TRUE,LSTFUL		;YES, SET .T.		;MAO021480
1$:
         BITB      #5,C.STAT(R0)  ; IS EITHER FILNAME OR DEV SPECIFIED
         BEQ       FLOPN          ; IF NOT NO FORT I/O
         MOV       (PC)+,@(PC)+   ; MOVE EXTENSION 'FTN' TO NAME BLOCK
         .RAD50    /FTN/
         .WORD     NAMBLK+14
         OPEN$W    #FTNFDB
         BCS       TYPERR
         INC       FTNFLG         ; SET FORT FLAG ON SHOWING IT IS OPEN
         BITB      #CS.MOR,C.STAT+CSIBLK ; MORE FOR OUTPUT ???
         BEQ       FXOPN
FLOPN:   MOVB      #'3,ERNUM      ; TRY TO PICK UP THE LISTING FILE
	CLR	SPOOL		;SET SPOOLING DEFAULT		;MK090275
         CSI$2     #CSIBLK,OUTPUT,#SPSW				;MK090275
         BCS       TYPERR
	BITB	#5,C.STAT(R0)	;IS DEV OR FILENAME SPECIFIED	;MK101775
	BEQ	FXOPN		;NO - NO LISTING		;MK101775
         MOV       (PC)+,@(PC)+   ; 'FLL' EXTENSION TO DEFAULT NAME BLOCK
         .RAD50    /FLL/
         .WORD     NAMBLK+14
         OPEN$W    #FLLFDB
         BCS       TYPERR
         INC       FLLFLG
FXOPN:   MOVB      #'4,ERNUM
         CSI$2     #CSIBLK,INPUT
         BCS       TYPERR
         MOV       (PC)+,@(PC)+   ; SET DEFAULT TO 'FLX'
         .RAD50    /FLX/
         .WORD     NAMBLK+14
         OPEN$R    #FLXFDB
         BCS       TYPERR
         RTS       PC

; COMMAND ERROR; TYPE MESSAGE AND DELETE ANY OPEN OUTPUT FILES

TYPERR:	DIR$	#ERMESG		;TELL USER HE GOOFED		;MK090975
	INC	SEVFLG		;ONE MORE SEVERE ERROR		;MAO050280
	TST	FTNFLG		;FTN FILE OPEN?			;MK090975
	BEQ	1$		;NO				;MK090975
	DELET$	#FTNFDB		;YES - SCRATCH IT		;MK090975
1$:	TST	FLLFLG		;LIST FILE OPEN?		;MK090975
	BEQ	2$		;NO				;MK090975
	DELET$	#FLLFDB		;YES - BYEBYE			;MK090975
2$:	JMP	SOPEN		;TRY AGAIN			;MK090975
	.PAGE
;+
; - E X F L E
;****NAME:   SUBROUTINE EXFLE
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  EXIT ROUTINE FOR FLECS TO RETURN EXIT STATUS TO CALLER
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     M. OOTHOUDT
; DATE:       02-MAY-80
; REVISIONS:
;
;****CALLING SEQUENCE:  CALL EXFLE
;
;		INPUT: NONE
;
;	       OUTPUT: NONE
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  EXST$S
; LENGTH/PAR:  
;
;****NOTES:  
;	1.  THIS ROUTINE USES THE VALUE OF VARIBLES SEVFLG, ERRFLG,
; AND WRNFLG TO DETERMINE IF IT SHOULD EXIT WITH A SEVERE ERROR, AN
; ERROR, A WARNING OR SUCCESS.  THE PURPOSE OF EXIT-WITH-STATUS IS TO
; ALLOW A TASK THAT RUNS FLECS (EG. INDIRECT MCR OR SPAWN) TO DETERMINE
; IF FLECS WAS SUCCESSFUL.  EG. THE CALLER MIGHT SPAWN FORTRAN IF AND
; ONLY IF FLECS IS SUCCESSFUL.
;
;	2.  THE STATUS VALUES RETURNED ARE
; SEVERE - FLECS ABORTED EXTERNALLY (EXEC FUNCTION),
;	   FLECS SELF-ABORTED DUE TO TABLE OVERFLOW, OR
;	   INPUT ERROR IN COMMAND LINE.
; ERROR  - TRANSLATION ERROR IN PROCESSING SOURCE FILE.
; WARNING- TRANSLATION WARNING IN SOURCE FILE.
; SUCCESS- NONE OF THE ABOVE.
;
;	3.  BECAUSE "FLE @FILE" IS LEGAL, IT IS NECESSARY FOR FLECS TO
; KEEP A SUM OF ALL ERRORS AND WARNINGS SO THAT WHEN IT FINALLY
; EXITS, IT WILL KNOW IF SUCH PROBLEMS OCCURRED ON ANY TRANSLATION,
; NOT JUST THE LAST ONE DONE.
;
;	4.  AN INPUT ERROR IS TREATED AS A SEVERE ERROR MAINLY TO
; DISTINGUISH IT FROM A TRANSLATION PROBLEM.  ALSO THIS USAGE IS FAIRLY
; COMMON AND MAKES REASONABLE SENSE IN INDIRECT MCR OR SPAWN MODES.
;
;-
EXFLE::
	CLOSE$    #GCBUF         ; CLOSE OUT COMMAND INPUT
;
	TST	SEVFLG		;ANY SEVERE ERRORS?
	BEQ	5$		;NO
	EXST$S	#EX$SEV		;YES
5$:
	TST	ERRFLG		;ANY TRANSLATION ERRORS?
	BEQ	10$		;NO
	EXST$S	#EX$ERR		;YES
10$:
	TST	WRNFLG		;ANY WARNINGS?
	BEQ	15$		;NO
	EXST$S	#EX$WAR		;YES
15$:
	EXST$S	#EX$SUC		;NO PROBLEMS
	.PAGE
;+
; - G E T
;****NAME:   SUBROUTINE GET
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  READ A LINE FROM THE FLX FILE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 28-JUN-77 (MK) REPLACE WITH RK'S VERSION, SEE NOTE 1.
;
;****CALLING SEQUENCE:  CALL GET(LINENO,STRING,ENDFIL)
;
;		INPUT: 
;
; LINENO=(I*2) NUMBER OF LAST LINE READ FROM FLX FILE
; 
;	       OUTPUT:  
;
; LINENO=(I*2) INCREMENTED BY ONE FOR EACH LINE READ FROM FLX FILE
; STRING=STRING OF UP TO 72 CHARACTERS READ FROM FLX FILE
; ENDFIL=(L*2) SET TO .TRUE. IF READ EOF, .FALSE. OTHERWISE
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  FLX READ
; DEVICES:     DISK
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  GET$
; LENGTH/PAR:  
;
;****NOTES:  
;	1. REWRITTEN JUNE 28, 1977 BY RICHARD KITTELL, LASL MP-1 TO
;	 HANDLE TAB CHARACTERS PROPERLY: (1) A TAB IN THE STATEMENT
;	 NUMBER FIELD FOLLOWED BY A BLANK OR A DIGIT 0-9 MOVES THE DIGIT
;	 TO THE CONTINUATION FIELD; (2) A TAB IN THE STATEMENT NUMBER
;	 FIELD FOLLOWED BY ANY OTHER CHARACTER MOVES THAT CHARACTER TO THE
;	 STATEMENT FIELD; (3) A TAB ANYWHERE ELSE IS REPLACED BY ENOUGH
;	 BLANKS TO BRING THE COLUMN NUMBER TO A MULTIPLE OF 8; (4) ALL
;	 TABS IN COMMENT LINES ARE HANDLED AS IN -3-, ABOVE.
;
;-
;   *** SUBROUTINE GET(LINENO,STRING,ENDFIL)
;
;

GET::
	INC	@2(R5)		;BUMP LINE NUMBER
	CLR	@4(R5)		;ZERO LENGTH COUNTER
	MOV	#TRUE,@6(R5)	;ASSUME EOF
	GET$	#FLXFDB		;READ A LINE
	BCS	12$		;RETURN IF EOF
	CLR	@6(R5)		;NOT EOF
	MOV	4(R5),R1	;ADDR OF STRING
	ADD	#2,R1		;MAKE ROOM FOR LENGTH
	MOV	FLXFDB+F.NRBD,R2 ;GET INPUT LENGTH
	BLE	12$		;RETURN IF NULL LINE
	CMP	R2,#72.		;CHOP OFF AT 72 CHARACTERS
	BLE	13$
	CMPB	FLXBUF,#CHCMNT	;UNLESS ITS A COMMENT LINE
	BEQ	13$
	MOV	#72.,R2
13$:
	MOV	#FLXBUF,R3	;GET INPUT ADDR
1$:
	CMPB	@R3,#TAB	;IS THIS CHARACTER A TAB?
	BNE	6$		;NO
	CMP	R2,#1		;IS IT THE LAST CHARACTER?
	BLE	7$		;YES, SKIP IT
	CMPB	FLXBUF,#CHCMNT	;IS THIS LINE A COMMENT?
	BEQ	14$		;YES, TREAT AS NORMAL TAB
	CMP	@4(R5),#6	;ARE WE IN THE LABEL FIELD?
	BGE	14$		;NO
2$:
	CMPB	1(R3),#BLANK	;IS THE NEXT CHARACTER A BLANK?
	BEQ	25$		;YES
	CMPB	1(R3),#'0	;IS THE NEXT CHAR A DIGIT?
	BLT	3$		;NO
	CMPB	1(R3),#'9
	BGT	3$		;NO
25$:
	MOV	#5,R4		;YES, MOVE TO THE CONTINUATION FIELD
	BR	4$
3$:
	MOV	#6,R4		;MOVE TO STATEMENT FIELD
4$:
	SUB	@4(R5),R4	;CALCULATE # OF BLANKS NEEDED
5$:
	MOVB	#BLANK,(R1)+	;PUT REQUESTED # OF BLANKS IN
	INC	@4(R5)		;UPDATE LENGTH
	CMP	@4(R5),#72.	;IS THAT THE LAST WE HAVE ROOM FOR?
	BGE	10$		;YES
	SOB	R4,5$
	INC	R3		;POINT TO NEXT INPUT CHARACTER
	BR	7$
6$:
	MOVB	(R3)+,(R1)+	;TRANSFER CHARACTER FROM IN TO OUT
	INC	@4(R5)		;BUMP LENGTH
	CMP	@4(R5),#72.	;IS THAT ALL WE HAVE ROOM FOR?
	BGE	10$		;YES
7$:
	SOB	R2,1$		;PROCESS THE WHOLE LINE
10$:
	CMPB	-(R1),#BLANK	;IS LAST CHAR A BLANK?
	BNE	12$		;NO
	DEC	@4(R5)		;DON'T RETURN IT
	BGT	10$		;TRY TO FIND NON-BLANK
12$:
	RETURN
14$:
	MOVB	#BLANK,(R1)+	;PUT IN A BLANK
	INC	@4(R5)		;BUMP COLUMN NUMBER
	CMP	@4(R5),#72.	;HAVE WE GOT A LINE FULL?
	BGE	10$		;YES
	BIT	#7,@4(R5)	;IS THE COLUMN A MULTIPLE OF 8. ?
	BNE	14$		;NOT YET
	INC	R3		;POINT TO NEXT INPUT CHARACTER
	BR	7$		;NOW IT IS

;+
; - P U T
;****NAME:   SUBROUTINE PUT
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  OUTPUT TO FORTRAN, LISTING OR ERROR STREAMS
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 02-JUN-78 (MK) NO FF ON PAGE 1 OF FLL FILE
; 15-SEP-80 (MAO) FF IN COL 1--> NEW PAGE
;
;****CALLING SEQUENCE:  CALL PUT(LINENO,STRING,IOCLASS)
;
;		INPUT: 
;
; LINENO=(I*2) CONTROL
;	=0, COL 1-5 SHOULD BE LEFT BLANK
;	>0, PUT LINENO IN COL 1-5
;	<0, PUT ABS(LINENO) IN COL 1-5, BUT OVERPRINT WITH HYPHENS
; STRING= STRING TO BE PUT OUT
; IOCLAS=(I*2) WHICH OUTPUT CLASS IS TO BE USED:
;	=1, FTN (NOTE LINENO CAN ONLY BE POSITIVE)
;	=2, LIST
;	=3, ERROR
; 
;	       OUTPUT:  NONE
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  [XXX,YYY]PUTNUM
; DISK FILES:  FTN, FLL FILES
; DEVICES:     DISK
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  PUT$
; LENGTH/PAR:  
;
;****NOTES:  
;
;-
;   *** SUBROUTINE PUT(LINENO,STRING,IOCLAS)

PUT::    MOV       @2(R5),LINNUM  ; PICK UP LINE NUMBER AND STRING ADDR
         MOV       4(R5),STRADR
         CMP       #1,@6(R5)      ; CHECK IOCLAS - IF 1 GO TO FORT
         BEQ       7$
         TST       FLLFLG         ; CHECK LISTING OPEN - IF NOT IGNORE
         BEQ       6$
	MOV	STRADR,R1		;CHECK FOR FORM FEED ;MAO150980
	CMPB	2(R1),#14				;MAO150980
	BNE	1$			;NOT FF		;MAO150980
	CLR	LINCNT			;IS FF, FORCE NEW PAGE	;MAO150980
	MOVB	#40,2(R1)		;BLANK IT OUT	;MAO150980
1$:	TST       LINCNT         ; START NEW PAGE ???
         BNE       3$
         INC       PAGE           ; YES - INC PAGE # AND PUT IN HEADING
         MOV       #HB,R5
         JSR       PC,PUTNUM
	CMP	   #1,PAGE	; IF FIRST PAGE, NO FORM FEED	;MK020678
	BEQ	   2$					     	;MK020678
         PUT$      #FLLFDB,#HLINE,#HLEND-HLINE			;MK020678
	 BR	    20$						;MK020678
2$:	 PUT$	    #FLLFDB,#SVER,#HLEND-SVER			;MK020678
20$:      MOV       #-56.,LINCNT
3$:      MOV       #FLLBUF,R1     ; BLANK FRONT OF LINE
         MOV       #4,R2
         MOV       #"  ,(R1)+
         SOB       R2,.-4
         TST       LINNUM
         BEQ       5$             ; IF LINENO = 0 LEAVE BLANK
         BGT       4$             ; IF GT 0 USE IT
         NEG       LINNUM         ; LESS USE IT WITH '*' IN FRONT
         MOVB      #'*,FLLBUF+1
4$:      MOV       #JB,R5         ; GO PUT LINE NUMBER FRONT OF LINE
         JSR       PC,PUTNUM
5$:      MOV       STRADR,R1      ; COPY STRING OVER
         MOV       (R1)+,R3
         MOV       R3,R4
         ADD       #12,R4
         MOV       #FLLBUF+12,R2
         MOVB      (R1)+,(R2)+    ; MOVE STRING TO OUTPUT BUFFER
         SOB       R3,.-2
         PUT$      #FLLFDB,#FLLBUF,R4
         INC       LINCNT
6$:      RTS       PC

7$:      TST       FTNFLG         ; FORT I/O ACTIVE???
         BEQ       6$             ; NO - RETURN
         MOV       STRADR,R1
         MOV       (R1)+,R3       ; GET LENGTH OF STRING TO R3
         MOV       R3,R4
         MOV       #FTNBUF,R2
         MOVB      (R1)+,(R2)+    ; COPY DATA OVER
         SOB       R3,.-2
         MOV       #78.,R3
         SUB       R4,R3          ; FIND OUT HOW MANY BLANKS TO PAD
         BLE       8$
         MOVB      #BLANK,(R2)+      ; MOVE THEM
         SOB       R3,.-4
8$:      MOV       #KB,R5         ; I/O LIST FOR PUTNUM CALL
         JSR       PC,PUTNUM      ; MOVE LINE # TO COL 75-79
         PUT$      #FTNFDB
         RTS       PC

;+
; - C L O S E F
;****NAME:   SUBROUTINE CLOSEF
;    FILE:   [XXX,YYY]FLERSX.MAC
;    TKB:    
;
;****PURPOSE:  CLOSE OPEN FILES
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     CHRIS MEYERS, EUGENE REGISTER GUARD, EUGENE OREGON
; DATE:       25-OCT-74
; REVISIONS:
; 02-SEP-75 (MK) ADD SPOOLING CODE
; 17-OCT-75 (MK) PUT COMMAND LINE INTO FLL FILE
; 02-MAY-80 (MAO) EXIT WITH STATUS FLAGS INCREMENTED
;
;****CALLING SEQUENCE:  	CALL CLOSEF(MINCNT,MAJCNT)
;
;		INPUT: 
;
; MINCNT=(I*2) COUNT OF MINOR ERRORS (WARNINGS) ENCOUNTERED
; MAJCNT=(I*2) COUNT OF MAJOR ERRORS ENCOUNTERED.  IF MAJCNT=-1, A
;		SYMBOL TABLE OVERFLOW HAS OCCURRED.
; 
;	       OUTPUT:  NONE
;
;	CMN BLOCK I/O: NONE
;
;****DIALOG: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  [XXX,YYY]PUTNUM,EXFLE
; DISK FILES:  FLX, FTN AND FLL FILES
; DEVICES:     DISK
; SGAS:        NONE
; EVENT FLAGS: 1
; SYSTEM DIR:  DIR$, PUT$, CLOSE$, PRINT$
; LENGTH/PAR:  
;
;****NOTES:  
;
;-
;   *** SUBROUTINE CLOSEF(WARN,ERROR)

; THIS ROUTINE NOW DOES THE FOLLOWING:
;
;	1. IF THERE ARE ANY ERRORS, OUTPUTS ERROR COUNT TO BOTH THE
;	   LISTING AND THE TERMINAL.
;	2. IF 'ERROR' IS NEGATIVE (INDICATING AN ABORT) OUTPUTS AN ABORT
;	   MESSAGE TO THE TERMINAL.
;	3. ALWAYS OUTPUTS THE COMMAND LINE TO THE LISTING (IF OPEN).
;	4. CLOSES FILES.
;	5. IF 'ERROR' IS NEGATIVE, EXITS; OTHERWISE, RETURNS.

CLOSEF::							;MK090275
	MOV	@2(R5),NWRN	;GET WARNING COUNT		;MK090275
	MOV	@4(R5),NERRS	;GET ERROR COUNT		;MK090275
	BPL	5$		;NOT AN ABORT			;MK090275
	DIR$	#QIOAB		;OUTPUT ABORT MESSAGE		;MK090275
	JSR	PC,3$		;CLOSE FILES			;MK090275
	INC	SEVFLG		;SEVERE ERROR			;MAO050280
	JMP	EXFLE		;BUG OUT			;MAO050280
5$:	BNE	1$		;GOT SOME ERRORS?		;MK090275
	TST	NWRN		;NO - WARNINGS, MAYBE?		;MK090275
	BEQ	3$		;NO				;MK090275
	INC	WRNFLG		;GOT SOME WARNINGS		;MAO050280
	BR	20$						;MAO050280
1$:
	INC	ERRFLG		;GOT SOME ERRORS		;MAO050280
20$:
         MOV       #LB,R5         ; USE PUTNUM ON EACH
         JSR       PC,PUTNUM
         MOV       #MB,R5
         JSR       PC,PUTNUM
         TST       FLLFLG         ; LISTING OPEN ???
         BEQ       2$
         PUT$      #FLLFDB,#NER,#NERL-NER
2$:      DIR$      #QIOE          ; IF NOT - QIO IT TO 'CO'

3$:	TST	FLLFLG		;LISTING?			;MK090275
	BEQ	4$		;NO				;MK090275
	MOV	GCBUF+G.CMLD+2,R1 ;GET START OF COMMAND LINE	;MK101775
	MOVB	#12,-(R1)	;PREFIX WITH CR-LF		;MK101775
	MOVB	#15,-(R1)					;MK101775
	ADD	#2,GCBUF+G.CMLD	;ADJUST LENGTH OF LINE		;MK101775
	PUT$	#FLLFDB,R1,GCBUF+G.CMLD ;PUT LINE TO LISTING	;MK101775
4$:      CLOSE$    #FTNFDB
	TST	SPOOL		;SPOOLING REQUESTED?		;MK090275
	BNE	6$		;NO				;MK090275
	BITB	#FD.DIR,FLLFDB+F.RCTL ;LISTING ON DIRECTORY DEV?;MK090275
	BEQ	6$		;NO				;MK090275
	PRINT$	#FLLFDB		;SPOOL IT			;MK090275
6$:      CLOSE$    #FLLFDB
         CLOSE$    #FLXFDB
         RTS       PC

;   *** DATA ***

PAGE:    .WORD     0
LINCNT:  .WORD     0
FTNFLG:  .WORD     0
FLLFLG:  .WORD     0
SPOOL:	.WORD	0	;SET NON-ZERO TO DISABLE SPOOLING (/-SP);MK090275
ERBUF:   .ASCII    /ERROR /
ERNUM:   .ASCII    /  - COMMAND IGNORED/
EREND:
         .EVEN
GCBUF:	GCMLB$	2,FLE,CMDBUF,1					;MK081775
CMDOUT:  .ASCII    <15><12>
CMDBUF:  .BLKB     82.
ERMESG:	QIOW$	IO.WLB,2,1,,,,<ERBUF,EREND-ERBUF,40,,,>		;MK081276
         CSI$
CSIBLK:  .BLKB     C.SIZE
SPSW:	CSI$SW	SP,1,SPOOL,CLEAR,NEG				;MK090275
	CSI$ND							;MK090975
FUSW:	CSI$SW	FU,2,LSTFUL,SET,NEG				;MAO021480
	CSI$ND							;MAO021480
NAMBLK:  NMBLK$    ,FLX,,SY,0					;MK081775
FTNFDB:  FDBDF$
         FDAT$A    R.VAR,FD.CR
         FDRC$A    0,FTNBUF,80.
         FDOP$A    3,CSIBLK+C.DSDS,NAMBLK

FLLFDB:  FDBDF$
         FDAT$A    R.VAR,FD.CR
         FDRC$A    0,FLLBUF,132.
         FDOP$A    4,CSIBLK+C.DSDS,NAMBLK

FLXFDB:  FDBDF$
         FDRC$A    0,FLXBUF,80.
         FDOP$A    5,CSIBLK+C.DSDS,NAMBLK

FTNBUF:  .BLKB     80.
FLLBUF:  .ASCII    /          /
         .BLKB     122.
FLXBUF:  .BLKB     80.

NERRS:   .WORD     0		;# TRANSLATION ERRORS FOR THIS CALL
NWRN:    .WORD     0		;# TRANSLATION WARNINGS FOR THIS CALL
SEVFLG:	.WORD	0		;SUM OF SEVERE ERRORS
ERRFLG:	.WORD	0		;SUM OF ERRORS
WRNFLG:	.WORD	0		;SUM OF WARNINGS
LB:      .WORD     2,NER+2,NERRS
MB:      .WORD     2,NWR-2,NWRN
NER:     .ASCII    <15><12><40><40>
TNER:    .ASCII    /      ERRORS, /
NWR:     .ASCII    /      WARNINGS/
NERL:
ABMSG:	.ASCII	/FLECS ABORTED: TABLE OVERFLOW/			;MK090275
ABEND:
         .EVEN
QIOE:	QIOW$	IO.WLB,2,1,,,,<TNER,NERL-TNER,40,,,>		;MK081276
QIOAB:	QIOW$	IO.WLB,2,1,,,,<ABMSG,ABEND-ABMSG,40,,,>		;MK081276
HLINE:   .ASCII    <15><14>
SVER:    .ASCII    /                          /
DSPOT:   .ASCII    /            /
TSPOT:   .ASCII    /          /
         .ASCII    /PAGE/
PSPOT:   .ASCII    /        /
         .ASCII    <15><12>
HLEND:
	.EVEN							;MK090275
TB:      .WORD     1,TSPOT
DB:      .WORD     1,DSPOT
HB:      .WORD     2,PSPOT,PAGE
KB:      .WORD     2,FTNBUF+72.,LINNUM
JB:      .WORD     2,FLLBUF,LINNUM
LINNUM:  .WORD     0
STRADR:  .WORD     0
;
; SPECIAL PSECT (FORTRAN COMMON BLOCK) TO PASS VALUES BACK TO FLECS ROUTINES
;
	.PSECT	MACVAL,RW,D,OVR,GBL				;MAO021480
;
LSTFUL:	.WORD	0			;/FU INDICATOR		;MAO021480
;
         .END