.TITLE	FLERSX
	.IDENT	/830411/
         .NLIST    BEX

;+
; - F L E R S X
;****NAME:   FILE FLERSX.MAC
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  MACRO SUPPORT ROUTINES FOR THE FLECS TRANSLATOR
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
; 22-JUN-81 (MAO) ADD SUBROUTINE NEWPG
; 29-JUN-81 (MAO) ADD OPNINC AND OTHER .INCLUDE PROCESSING
; 30-JUN-81 (MAO) ADD .PASS_ AND .NAME PROCESSING
; 29-NOV-82 (MAO) CHANGE GET TO HANDLE READ & LONG-LINE ERRORS BETTER.
; 02-DEC-82 (MAO) ALLOW /+-LIST ON .INCLUDE.
; 07-MAR-83 (MAO) CODE TO PUT FORT LINE # IN FLL FILE.
; 11-MAR-83 (MAO) CHANGE <CR><FF> TO <FF><SP> IN HLINE SO WILL WORK
;			RIGHT ON ALL PRINTERS.
; 11-APR-83 (MAO) MAKE DEFAULT /+LI FOR .INCLUDE
;
;****CALLING SEQUENCE:  SEE INDIVIDUAL ROUTINES
;
;	CMN BLOCK I/O: 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$,FDOF$L
         .MCALL    GET$,PUT$
	.MCALL	EXST$S						;MAO050280
	.MCALL	CSI$SW,CSI$SV,CSI$ND,PRINT$				;MK090275

BLANK=	40
TAB=	11
TRUE=	-1			;VALUE OF FORTRAN .TRUE.
	FDOF$L			;DEFINE FDB OFFSETS LOCALLY

;+
; - S T R E Q
;****NAME:   FUNCTION STREQ
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  TEST FOR STRING EQUALITY
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  DETERMINE WHETHER ONE STRING IS LEXICOGRAPHICALLY
;		LESS THAN ANOTHER.
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  RETRIEVE INDIVIDUAL CHARACTER FROM A STRING
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  PUT A CHARACTER INTO A STRING
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  RETURN CODE FOR CHARACTER TYPE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****NOTES:  
;-
;   *** INTEGER FUNCTION CHTYP(CHAR)

CHTYP::  MOV       #1,R0          ; SET RETURN 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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  CONCATENATE A PORTION OF ONE STRING TO ANOTHER.
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****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 LEN.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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  GET COMMAND LINE FOR FLECS, OPEN INPUT AND OUTPUT FILES
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
; 14-FEB-80 (MAO) USE TYPIN,TYPOUT,TYPLST.
; 06-MAR-80 (MAO) IF IN ALECS, PROMPT ALE>
; 02-MAY-80 (MAO) USE EXFLE INSTEAD OF EXIT$S
; 29-JUN-81 (MAO) CLEAR INCLUDE FILE LEVEL
; 30-JUN-81 (MAO) PUT CMD LINE IN H2LINE
; 30-JUN-81 (MAO) PROCESS /CO SWITCH
; 30-JUN-81 (MAO) BETTER ERROR MESSAGES FOR CMD LINE ERRORS
; 02-DEC-82 (MAO) SET VALUE OF FLLON.
;
;****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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  TIME, DATE, [201,13]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$
;
;****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)+
	CLR	INCLVL		;NO INCLUDE FILES YET		;29JUN81MAO
	CLR	INCSTR		;.INCLUDE NOT READ YET		;29JUN81MAO
	TST	ALECS		;ARE WE IN ...ALE?		;MAO030580
	BEQ	10$		;NO, BRANCH			;MAO030580
	MOV	#GCBUF,R0	;GET ADDR OF GCML COMMAND BUFFER;MAO030580
	MOV	#"AL,G.DPRM+2(R0)	;SET GCML PROMPT TO	;MAO030580
	MOVB	#'E,G.DPRM+4(R0) 	;	ALE>		;MAO030580
10$:
         GCML$     #GCBUF         ; GET COMMAND			;MK101775
	BCC	1$						;MAO021480
	JMP	EXFLE						;MAO050280
1$:	TST	GCBUF+G.CMLD	;ANYTHING TYPED?		;MK101775
	BEQ	SOPEN		;NO				;MK101775
	CLR	ERNUM		;ERR 0 = CSI$1 ERROR		;30JUN81MAO
	CSI$1	#CSIBLK,GCBUF+G.CMLD+2,GCBUF+G.CMLD		;MK101775
         BCS       TYPERR
FTOPN:   INC	ERNUM		;ERR 1 = ERROR IN FTN SPECIFIER	 ;30JUN81MAO
	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	TYPOUT,NAMBLK+14	;EXTENSION TO NAMEBLOCK ;MAO021480
         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:   INC	ERNUM		;ERR 2 = ERROR IN LST SPECIFIER	;30JUN81MAO
	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	TYPLST,NAMBLK+14	;EXTENSION TO NAMEBLOCK ;MAO021480
         OPEN$W    #FLLFDB
         BCS       TYPERR
         INC       FLLFLG
	MOV	#1,FLLON	;FLL FIL OUTPUT ON BY DEFAULT	;821202MAO
FXOPN:   INC	ERNUM		;ERR 3 = ERROR IN FLX SPECIFIER	;30JUN81MAO
	CLR	COND		;SET /CO DEFAULT TO NO VALUES	;30JUN81MAO
         CSI$2     #CSIBLK,INPUT,#COSW				;30JUN81MAO
         BCS       TYPERR
	TST	COND		;/CO GIVEN?			;30JUN81MAO
	BEQ	1$		;NO				;30JUN81MAO
	JSR	PC,COPROC	;YES, PROCESS IT		;30JUN81MAO
1$:	MOV	TYPIN,NAMBLK+14		;EXTENSION TO NAMEBLOCK ;MAO021480
         OPEN$R    #FLXFDB
         BCS       TYPERR
 
;	PUT MCR COMMAND LINE INTO H2LINE
 
	MOV	GCBUF+G.CMLD+2,R0	;GET START OF CMD LINE	;30JUN81MAO
	MOV	#H2CMD,R1		;ADDR TO PUT		;30JUN81MAO
	MOV	GCBUF+G.CMLD,R2		;# OF CHARACTERS	;30JUN81MAO
	MOV	R2,H2LEN		;CALC TOTAL LENGTH	;30JUN81MAO
	ADD	#10.,H2LEN					;30JUN81MAO
 
5$:	MOVB	(R0)+,(R1)+		;XFER			;30JUN81MAO
	SOB	R2,5$						;30JUN81MAO
	MOVB	#15,(R1)+		;APPEND <CR><LF>	;30JUN81MAO
	MOVB	#12,(R1)+					;30JUN81MAO
         RTS       PC

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

TYPERR:								;MK090975
	MOV	ERNUM,R1	;ERROR #			;30JUN81MAO
	MUL	#3,R1		;OFFSET TO ERROR TYPE		;30JUN81MAO
	ADD	#ERNAM,R1	;ADDR OF ERROR TYPE		;30JUN81MAO
	MOV	#ERBUF,R0	;ERROR MSG ADDR			;30JUN81MAO
	MOVB	(R1)+,(R0)+	;PUT NAME IN MSG		;30JUN81MAO
	MOVB	(R1)+,(R0)+					;30JUN81MAO
	MOVB	(R1)+,(R0)+					;30JUN81MAO
	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
 
;	Internal routine to process /CO switch values
 
; 1st find last given value (CSI null fills ASCII strings)
 
COPROC:							;30JUN81MAO
	MOV	#10.,R1		;# OF POSSIBLE VALUES		;30JUN81MAO
	MOV	#C10+2,R0	;ADDR OF 10TH VALUE RETURNED	;30JUN81MAO
 
5$:	TST	(R0)		;NON NULL?			;30JUN81MAO
	BNE	10$		;YES				;30JUN81MAO
	SUB	#8.,R0		;NO, NEXT VALUE			;30JUN81MAO
	SOB	R1,5$						;30JUN81MAO
 
10$:	MOV	R1,COND		;SAVE # OF LAST VALUE		;30JUN81MAO
	BEQ	40$		;QUIT IF NONE			;30JUN81MAO
 
; Now find # of last nonnull character in each string (ignores possibility
;	of embedded nulls.  Note, /CO:A::B is possible and allowed.
 
	SUB	#2,R0		;ADDR OF STRING HEADER		;30JUN81MAO
20$:	MOV	#6,R3		;# OF CHAR TO CHECK		;30JUN81MAO
	MOV	R0,R2		;ADDR OF STRING			;30JUN81MAO
	ADD	#8.,R2		;ADDR OF LAST CHAR IN STRING+1	;30JUN81MAO
30$:	TSTB	-(R2)		;NULL?				;30JUN81MAO
	BNE	35$		;NO, QUIT			;30JUN81MAO
	SOB	R3,30$						;30JUN81MAO
35$:	MOV	R3,(R0)		;STORE STRING LENGTH		;30JUN81MAO
	SUB	#8.,R0		;POINT TO NEXT LOWER STRING HEAD;30JUN81MAO
	SOB	R1,20$						;30JUN81MAO
 
40$:	RTS	PC		;ALL DONE			;30JUN81MAO
	.PAGE
;+
; - O P N I N C
;****NAME:   SUBROUTINE OPNINC
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  OPEN AN .INCLUDE FILE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; LANGUAGE:   MACRO-11
; AUTHOR:     M. OOTHOUDT
; DATE:       29-JUN-81
; REVISIONS:
; 02-DEC-82 (MAO) PARSE, SAVE & RESTORE /+-LIST SETTING.
; 11-APR-83 (MAO) MAKE /+LI .INCLUDE DEFAULT
;
;****CALLING SEQUENCE:  CALL OPNINC (NCHAR,NAME,IERR)
;
;		INPUT: 
;
; NCHAR =(I*2) NUMBER OF CHARACTERS IN FILE NAME
; NAME  =(ARRAY) ASCII ARRAY CONTAINING THE FILE NAME
; 
;	       OUTPUT:  
;
; IERR	=(I*2) ERROR RETURN CODE
;	=0, ALL OK
;	=1, ALREADY AT MAXIMUM INCLUDE FILE NESTING DEPTH
;	=2, ERROR IN PARSING GIVEN FILE NAME
;	=3, OPEN ERROR ON INCLUDE FILE
;
;	CMN BLOCK I/O: NONE
;
;	    RESOURCES:
; LIBRARIES:   SYSLIB:CSI$1,CSI$2,CLOSE$,OPEN$R,.POINT,.MARK
; OTHER SUBR:  NONE
; DISK FILES:  INCLUDE FILE
; DEVICES:     DISK FILES
; SGAS:        NONE
; EVENT FLAGS: 1
; SYSTEM DIR:  NONE
;
;****NOTES:  
;-
;   *** SUBROUTINE OPNINC (NCHAR,NAME,IERR)
OPNINC::
	MOV	#1,@6(R5)		;ASSUME NESTING ERROR
	CMP	INCLVL,#NUMINC		;ALREADY AT MAX NEXTING DEPTH?
	BEQ	40$			;YES
 
	MOV	#2,@6(R5)		;ASSUME FILENAME ERROR
	CSI$1	#CSIBLK,4(R5),@2(R5)	;ANALYZE FILE NAME SYNTAX
	BCS	40$
	MOV	#10,LISET		;DEFAULT /+LI IF SW ABSENT;830411MAO
	CSI$2	#CSIBLK,OUTPUT,#LISW	;PARSE FILENAME		;821202MAO
	BCS	40$
 
; GOT A REASONABLE FILE NAME; SAVE CURRENT CONTEXT & CLOSE
 
	MOV	INCLVL,R3		;FIND LOCATION TO PUT CONTEXT
	MUL	#NUMCTX*2,R3		;BYTE OFFSET
	MOV	R3,R4			;R3 WILL BE USED BY .MARK
	ADD	#FLXCTX,R4		;ADDR
	MOV	FLLON,(R4)+		;SAVE FLL LISTING STATUS ;821202MAO
	MOV	#FLXFDB,R0		;GET FDB ADDR
	CALL	.MARK			;GET CONTEXT
	MOV	R1,(R4)+		;SAVE CONTEXT
	MOV	R2,(R4)+
	MOV	R3,(R4)+
 
	MOV	#S.FNBW,R2		;# OF WORDS IN FDB TO SAVE
	MOV	#FLXFDB+F.FNB,R0	;ADDR OF FNB
	MOV	INCLVL,R1		;FIND LOCATION TO SAVE FNB
	MUL	#S.FNBW*2,R1		;BYTE OFFSET
	ADD	#FLXFNB,R1		;ADDR
 
5$:	MOV	(R0)+,(R1)+		;TRANSFER
	SOB	R2,5$
 
	CLOSE$	#FLXFDB			;CLOSE OUT CURRENT INPUT FILE
 
; NOW OPEN THE INCLUDE FILE
 
	MOV	TYPIN,NAMBLK+14		;SET DEFAULT FOR EXTENSION
	MOV	#3,@6(R5)		;ASSUME OPEN ERROR
	INC	INCLVL			;GOING TO A NEW LEVEL
	OPEN$R	#FLXFDB
	BCC	10$			;BRANCH IF OPEN OK
	CALL ROPN			;FAILED, GO BACK TO ORIGINAL FILE
	BR	40$
 
10$:	CLR	@6(R5)			;MARK SUCCESS
	CMP	INCLVL,#1		;IS THIS .INCLUDE FROM MAIN FILE?
	BNE	20$			;NO
	MOV	#1,INCSTR		;YES, SET "NO STAR" FLAG NONZERO
;
;	PROBLEM:  IF OUTPUT IS CURRENTLY ON, BUT /-LI IS IN CURRENT LINE
;	THE .INC LINE WILL NOT BE LISTED.  THEREFORE USE LICHNG FLAG
;	TO TELL PUT TO IGNORE FLLON FLAG FOR THIS LINE.
;
20$:	CLR	LICHNG			;ASSUME NO PROBLEM	;821202MAO
	TST	FLLON			;FLL OUTPUT ON?		;821202MAO
	BEQ	30$			;NO, NO PROBLEM		;821202MAO
	TST	LISET			;FLL OUTPUT TO BE ON?	;821202MAO
	BNE	30$			;YES, NO PROBLEM	;821202MAO
	INC	LICHNG			;MUST FIX PROBLEM	;821202MAO
 
30$:	MOV	LISET,FLLON		;GET SETTING OF /+-LIST	;821202MAO
40$:	RTS	PC
 
; INTERNAL ROUTINE TO REOPEN A PREVIOUS FLX INPUT FILE
;	NOTE WILL REOPEN BY FILEID SINCE THAT WAS SAVED
 
ROPN:
	DEC	INCLVL			;GOING BACK TO PREVIOUS LEVEL
	MOV	#S.FNBW,R2		;RESTORE FNB, # WORDS IN FNB
	MOV	#FLXFDB+F.FNB,R0	;ADDR TO PUT FNB
	MOV	INCLVL,R1		;CALC ADDR OF SAVED FNB
	MUL	#S.FNBW*2,R1		;BYTE OFFSET
	ADD	#FLXFNB,R1		;ADDR
5$:	MOV	(R1)+,(R0)+		;TRANSFER
	SOB	R2,5$
 
	MOV	TYPIN,NAMBLK+14		;DEFAULT EXTENSION
	OPEN$R	#FLXFDB			;REOPEN FILE
 
	MOV	INCLVL,R3		;CALC ADDR OF SAVED CONTEXT
	MUL	#NUMCTX*2,R3		;BYTE OFFSET
	MOV	R3,R4			;.POINT WILL USE R3
	ADD	#FLXCTX,R4		;ADDR
	MOV	(R4)+,FLLON		;RESTORE FLL LISTING STATUS ;821202MAO
	MOV	(R4)+,R1		;RETRIEVE CONTEXT
	MOV	(R4)+,R2
	MOV	(R4)+,R3
	CALL	.POINT			;RESTORE CONTEXT
	RTS	PC
	.PAGE
;+
; - E X F L E
;****NAME:   SUBROUTINE EXFLE
;    FILE:   [XXX,YYY]FLERSX.MAC
;
;****PURPOSE:  EXIT ROUTINE FOR FLECS TO RETURN EXIT STATUS TO CALLER
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; LANGUAGE:   MACRO-11
; AUTHOR:     M. OOTHOUDT
; DATE:       02-MAY-80
; REVISIONS:
;
;****CALLING SEQUENCE:  CALL EXFLE
;
;		INPUT: NONE
;
;	       OUTPUT: NONE
;
;	CMN BLOCK I/O: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  EXST$S
;
;****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:   [201,13]FLERSX.MAC
;
;****PURPOSE:  READ A LINE FROM THE FLX FILE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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.
; 29-JUN-81 (MAO) ON EOF CHECK IF IN INCLUDE FILE.
; 29-NOV-82 (MAO) CHANGE ARG LIST TO RETURN NON-EOF READ ERRORS.
;		  RETUN ERROR IF CONVERTING TABS TO BLANKS-->LINE TOO LONG.
;
;****CALLING SEQUENCE:  CALL GET(LINENO,STRING,ENDFIL,ERR1,ERR2)
;
;		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
; ERR1	=(I*2) .NE.0==>NON-EOF READ ERROR (F.ERR)
; ERR2	=(I*2) DEFINDED ONLY IF ERR1.NE.0;
;		=0==>I/O ERROR, <0==>DSW ERROR (F.ERR+1),
;		>0==>EXPANDING TABS GAVE TOO LONG A LINE.
;
;	CMN BLOCK I/O: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  FLX READ
; DEVICES:     DISK
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  GET$
;
;****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.
;
;	2. THE ABOVE FIX FOR TABS DOES NOT WORK COMPLETELY.
; THERE IS NO GENERAL FIX SINCE THE INDENTATION
; IN THE FLL FILE IS NOT THE SAME NUMBER OF COLUMNS AS A TAB.  AS
; AN EXAMPLE CONSIDER THE FOLLOWING INPUT AND THE RESULTING FLL
; LISTING.  (LOCATION OF TAB COLUMNS SHOWN BY V AND TABS BY *.)
;
;	V	V	V	V
;	WHEN (I.GT.J)			!INPUT AS TYPED BY PROGRAMMER
;	IJKL=1* !A
;	M=2*    !B
;
;	WHEN (I.GT.J)			!FLL LISTING FILE
;	.  IJKL=1*      !A
;	.  M=2* !B
;
; NOTE THERE IS NO (SIMPLE) WAY TO GET THIS EXAMPLE TO WORK OUT RIGHT
; (AND EVEN IF YOU COULD, THINGS WOULDN'T WORK FOR MULTIPLE INDENTATIONS).
;
;	3.  IF ERR1 IS NONZERO, INPUT MAY STILL BE RETURNED TO CALLER.
; EG. FOR A "LINE-TOO-LONG" ERROR, THE TRUNCATED INPUT IS RETURNED.
; NOTE THAT ERR2 MAY HAVE ANY RANDOM VALUE IF ERR1=0.
;-
;   *** SUBROUTINE GET(LINENO,STRING,ENDFIL,ERR1,ERR2)
;
;

GET::
	INC	@2(R5)		;BUMP LINE NUMBER
	CLR	@4(R5)		;ZERO LENGTH COUNTER IN CASE NULL LINE
	MOV	#TRUE,@6(R5)	;ASSUME EOF
	CLR	@10(R5)		;ASSUME NO INPUT ERROR		;821129MAO
23$:	GET$	#FLXFDB		;READ A LINE
	BCC	33$		;CONTINUE IF NO EOF		;29JUN81MAO
	CMPB	#IE.EOF,FLXFDB+F.ERR ;END OF FILE ERROR?	;821129MAO
	BEQ	231$		;YES, BRANCH			;821129MAO
	MOVB	FLXFDB+F.ERR,R0	;SIGN EXTEND BYTE		;821129MAO
	MOV	R0,@10(R5)	;RETURN ERROR			;821129MAO
	MOVB	FLXFDB+F.ERR+1,@12(R5) ;RETURN ERROR CLASS	;821129MAO
	BR	33$		;CONTINUE ON			;821129MAO
 
231$:	TST	INCLVL		;IS EOF FOR INCLUDE FILE?	;29JUN81MAO
	BEQ	12$		;NO, QUIT			;29JUN81MAO
	CLOSE$	#FLXFDB		;CLOSE THE INCLUDE FILE		;29JUN81MAO
	CALL	ROPN		;REOPN PREVIOUS INPUT		;29JUN81MAO
	BR	23$		;GET A LINE FROM PREVIOUS INPUT	;29JUN81MAO
 
33$:	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	;MAO021480
	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?	;MAO021480
	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	20$		;YES				;821129MAO
	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	20$		;YES				;821129MAO
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	20$		;YES				;821129MAO
	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
;
20$:								;821129MAO
	MOV	#IE.RBG,@10(R5)	;FLAG AS TRUNCATED LINE		;821129MAO
	MOV	#1,@12(R5)	;INDICATE LOCAL ERROR		;821129MAO
	BR	10$						;821129MAO
.PAGE
;+
; - P U T
;****NAME:   SUBROUTINE PUT
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  OUTPUT TO FORTRAN, LISTING OR ERROR STREAMS
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
; 18-FEB-80 (MAO) ONLY BLANK PAD THRU COL 72
; 18-FEB-80 (MAO) MAC OUTPUT FOR ...ALE: PREFIX LINE # WITH ;
; 15-SEP-80 (MAO) FF IN COL 1--> NEW PAGE
; 29-JUN-81 (MAO) PREFIX ERROR WITH AN "E"; PREFIX INCLUDE FILE LINES
;			IN FLL FILE WITH "*" AS F4P DOES.
; 30-JUN-81 (MAO) IF PASFLG=.FALSE., NO FTN OUTPUT
; 30-JUN-81 (MAO) PUT OUT HEADER LINE 2 AND ONE LESS LINE/PAGE
; 02-DEC-82 (MAO) CHECK FLLON FLAG TO SEE IF FLL OUTPUT TEMPORARILY OFF
; 07-MAR-83 (MAO) CODE TO PUT FORT LINE # IN FLL FILE.
;
;****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 PREFIX WITH "E"
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  [201,13]PUTNUM
; DISK FILES:  FTN, FLL FILES
; DEVICES:     DISK
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  PUT$
;
;****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$
	TST	FLLON		;OUTPUT TEMPORARILY OFF?	;821202MAO
	BNE	10$		;NO, GO DO IT			;821202MAO
	TST	LICHNG		;PUT OUT LINE ANYWAY?		;821202MAO
	BEQ	6$		;NO, IGNORE IT			;821202MAO
	CLR	LICHNG		;BUT REALLY TURN OFF NOW	;821202MAO
 
10$:	MOV	STRADR,R1	;CHECK FOR FF	;MAO150980
	CMPB	2(R1),#14			;MAO150980
	BNE	1$		;NOT A FF	;MAO150980
	CLR	LINCNT		;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$:	PUT$	#FLLFDB,#H2LINE,H2LEN				;30JUN81MAO
      MOV       #-55.,LINCNT					;30JUN81MAO
3$:      MOV       #FLLBUF,R1     ; BLANK FRONT OF LINE
         MOV       #11,R2					;830307 MAO
         MOV       #"  ,(R1)+
         SOB       R2,.-4
	TST	INCLVL				;IN INCLUDE FILE? ;29JUN81MAO
	BEQ	35$				;NO		  ;29JUN81MAO
	TST	INCSTR				;1ST .INCLUDE?	  ;29JUN81MAO
	BEQ	31$				;NO		  ;29JUN81MAO
	CLR	INCSTR				;YES, CLEAR FLAG  ;29JUN81MAO
	BR	35$				;    AND SKIP *	  ;29JUN81MAO
31$:	MOVB	#'*,FLLBUF+1			;YES, PREFIX	  ;29JUN81MAO
35$:     TST       LINNUM
         BEQ       5$             ; IF LINENO = 0 LEAVE BLANK
         BGT       4$             ; IF GT 0 USE IT
         NEG       LINNUM         ; LESS USE IT WITH 'E' IN FRONT
         MOVB      #'E,FLLBUF+1					;29JUN81MAO
4$:   MOV       #JB,R5         ; GO PUT LINE NUMBER FRONT OF LINE
         JSR       PC,PUTNUM
	MOV	#FNUM,R5	; Arg list to insert for line #	;830307 MAO
	JSR	PC,PUTNUM	; Put in the #			;830307 MAO
5$:      MOV       STRADR,R1      ; COPY STRING OVER
         MOV       (R1)+,R3
         MOV       R3,R4
         ADD       #22,R4		; Total # of characters	;830307 MAO
         MOV       #FLLBUF+22,R2	; Start point for string;830307 MAO
         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
	CMP	PASFLG,#TRUE	;.PASS TURNED OFF FTN OUTPUT?	;30JUN81MAO
	BNE	6$		;YES, QUIT			;30JUN81MAO
	INC	NUMLIN		; One more fort line		;830307 MAO
        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       #72.,R3	;72 COL OF CODE			;MAO180280
         SUB       R4,R3          ; FIND OUT HOW MANY BLANKS TO PAD
         BLE       8$
         MOVB      #40,(R2)+      ; MOVE THEM
         SOB       R3,.-4
8$:	CMP	#TRUE,ALECS	;ARE WE ...ALE?			;MAO180280
	BNE	9$		;NO, BRANCH			;MAO180280
	SUB	#2,R2		;POINT BACK TO COL 71		;MAO180280
	MOV	#" ;,(R2)+	;PUT " ;" IN COL 71-72		;MAO180280
9$:	SUB	#2,R2		;PUTNUM PUTS AT START+2 SO DEC BY 2 MAO180280
	MOV	R2,KB+2		;PLACE TO PUT LINE #		;MAO180280
      MOV       #KB,R5         ; I/O LIST FOR PUTNUM CALL 	;MAO180280
         JSR       PC,PUTNUM	;MOVE LINE # TO COL 73-77
         PUT$      #FTNFDB
         RTS       PC

;+
; - N E W P G
;****NAME:   SUBROUTINE NEWPG
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  PUT OUT A NEW PAGE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V3.2
; LANGUAGE:   MACRO-11
; AUTHOR:     M. OOTHOUDT
; DATE:       22-JUN-81
; REVISIONS:
;
;****CALLING SEQUENCE:  CALL NEWPG
;
;		INPUT: NONE
;
;	       OUTPUT:  NONE
;
;	CMN BLOCK I/O: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****NOTES:  
;-
;   *** SUBROUTINE NEWPG
NEWPG::
	CLR LINCNT			;force new page for next line output
	RTS PC
	.PAGE
;+
; - N E W N A M
;****NAME:   SUBROUTINE NEWNAM
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  CHANGE THE NAME IN HEADER LINE 2 DUE TO .NAME DIRECTIVE
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; LANGUAGE:   MACRO-11
; AUTHOR:     M. OOTHOUDT
; DATE:       30-JUN-81
; REVISIONS:
;
;****CALLING SEQUENCE:  CALL NEWNAM(LEN,NAME)
;
;		INPUT: 
;
; LEN	=(I*2) NUMBER OF CHARACTERS IN NAME
; NAME	=(ASCII ARRAY) THE NAME TO PUT IN THE HEADER
;
;	       OUTPUT:  NONE
;
;	CMN BLOCK I/O: NONE
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  NONE
; DISK FILES:  NONE
; DEVICES:     NONE
; SGAS:        NONE
; EVENT FLAGS: NONE
; SYSTEM DIR:  NONE
;
;****NOTES:  
;-
;   *** SUBROUTINE NEWNAM (LEN,NAME)
NEWNAM::
	MOV	#6,R2			;BLANK FILL
	MOV	#H2NAME,R1		;DESTINATION
1$:	MOVB	#BLANK,(R1)+
	SOB	R2,1$
 
	MOV	@2(R5),R2		;GET LINE LENGTH
	CMP	#6,R2			;>6
	BGE	2$			;NO
	MOV	#6,R2			;TRUNCATE
2$:	TST	R2			;ANY CHARACTERS?
	BLE	4$			;NO
	MOV	4(R5),R0		;ADDR OF ARRAY
	MOV	#H2NAME,R1		;DESTINATION
3$:
	MOVB	(R0)+,(R1)+		;TRANSFER
	SOB	R2,3$
4$:
	RTS	PC


;+
; - C L O S E F
;****NAME:   SUBROUTINE CLOSEF
;    FILE:   [201,13]FLERSX.MAC
;
;****PURPOSE:  CLOSE OPEN FILES
;
;****RESTRICTIONS:  
;
; SYSTEM:     RSX11M V4.0
; 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
;
;	    RESOURCES:
; LIBRARIES:   NONE
; OTHER SUBR:  [201,13]PUTNUM,EXFLE
; DISK FILES:  FLX, FTN AND FLL FILES
; DEVICES:     DISK
; SGAS:        NONE
; EVENT FLAGS: 1
; SYSTEM DIR:  DIR$, PUT$, CLOSE$, PRINT$
;
;****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
FLLON:	.WORD	1	;SET=0 TO TEMPORARILY DISABLE OUTPUT TO	;821202MAO
			;	FLL FILE (EG BY .INC.../-LI)	;821202MAO
ERBUF:	.ASCII	/    SPECIFIER ERROR--COMMAND IGNORED/		;30JUN81MAO
EREND:
	.EVEN
ERNUM:	.WORD	0	;COMMAND LINE ERROR #		;30JUN81MAO
ERNAM:			;TYPE OF COMMAND LINE ERROR	;30JUN81MAO
	.ASCII	/CSI/					;30JUN81MAO
	.ASCII	/FTN/					;30JUN81MAO
	.ASCII	/FLL/					;30JUN81MAO
	.ASCII	/FLX/					;30JUN81MAO
         .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
COSW:	CSI$SW	CO,4,COND,SET,,COVAL				;30JUN81MAO
	CSI$ND
LISW:	CSI$SW	LI,10,LISET,SET,NEG				;821202MAO
	CSI$ND							;821202MAO
COVAL:	CSI$SV	ASCII,C1+2,6					;30JUN81MAO
	CSI$SV	ASCII,C2+2,6					;30JUN81MAO
	CSI$SV	ASCII,C3+2,6					;30JUN81MAO
	CSI$SV	ASCII,C4+2,6					;30JUN81MAO
	CSI$SV	ASCII,C5+2,6					;30JUN81MAO
	CSI$SV	ASCII,C6+2,6					;30JUN81MAO
	CSI$SV	ASCII,C7+2,6					;30JUN81MAO
	CSI$SV	ASCII,C8+2,6					;30JUN81MAO
	CSI$SV	ASCII,C9+2,6					;30JUN81MAO
	CSI$SV	ASCII,C10+2,6					;30JUN81MAO
	CSI$ND							;30JUN81MAO
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    <14><40>
SVER:    .ASCII    /                          /
DSPOT:   .ASCII    /            /
TSPOT:   .ASCII    /          /
         .ASCII    /PAGE/
PSPOT:   .ASCII    /        /
HLEND:
H2LINE:					;.NAME AND CMD LINE	;30JUN81MAO
H2NAME:	.ASCII	/      /		;NAME FROM .NAME	;30JUN81MAO
	.ASCII	/  /						;30JUN81MAO
H2CMD:	.BLKB	82.			;THE CMD LINE		;30JUN81MAO
H2LEN:	.WORD	92.			;TOTAL LENGTH IF ALL USED ;30JUN81MAO
	.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
FNUM:	.WORD	2,FLLBUF+10,NUMLIN	;Arg list for PUTNUM	;830307 MAO
LINNUM:  .WORD     0
STRADR:  .WORD     0
 
; INCLUDE FILE DATA
 
	NUMINC=3		;# OF POSSIBLE INCLUDE FILE LEVELS ;29JUN81MAO
	NUMCTX=4		;# OF WORDS SAVE FOR .INC FILE	;821202MAO
				;	(.MARK-->3, /+-LI-->1)	;821202MAO
 
INCSTR:	.WORD	0		;.NE.0 IF JUST READ .INCLUDE FROM MAIN
				;LEVEL (PREVENTS * ON THAT LINE) ;29JUN81MAO
INCLVL:	.WORD	0		;DEPTH OF INCLUDE FILES (0=MAIN) ;29JUN81MAO
 
LISET:	.WORD	0		;SENSE OF /+-LI FOR .INCLUDE	;821202MAO
LICHNG:	.WORD	0		;.NE.0 IF SHOULD IGNORE FLLON	;821202MAO
 
FLXCTX:			;SAVED POSITION IN FILE			;29JUN81MAO
	.REPT	NUMINC						;29JUN81MAO
	.BLKW	NUMCTX						;29JUN81MAO
	.ENDR							;29JUN81MAO
FLXFNB:			;SAVED FILE NAME BLOCK			;29JUN81MAO
	.REPT	NUMINC						;29JUN81MAO
	.BLKW	S.FNBW						;29JUN81MAO
	.ENDR							;29JUN81MAO
;
; SPECIAL PSECT (FORTRAN COMMON BLOCK) FOR FORT LINE # VARIABLES
;
	.PSECT	FLINE,RW,D,OVR,GBL				;830307 MAO
;
CNTALL:	.WORD 0							;830307 MAO
NUMLIN:	.WORD 0							;830307 MAO
;
; SPECIAL PSECT (FORTRAN COMMON BLOCK) TO PASS VALUES BACK TO FLECS ROUTINES
;
	.PSECT	MACVAL,RW,D,OVR,GBL				;MAO021480
;
ALECS:	.WORD 0			;IS IT FLE OR ALE?		;MAO021480
TYPIN:	.WORD 0			;INPUT FILE EXTENSION		;MAO021480
TYPLST:	.WORD 0			;LIST FILE EXTENSION		;MAO021480
TYPOUT:	.WORD 0			;OUTPUT FILE EXTENSION		;MAO021480
CHCMNT:	.WORD 0			;COMMENT CHARACTER		;MAO021480
LSTFUL:	.WORD 0				;/FU INDICATOR		;MAO021480
 
; SPECIAL PSECT (FORTRAN COMMON BLOCK) FOR /CO VALUES
 
	.PSECT	COND,RW,D,OVR,GBL				;30JUN81MAO
 
PASFLG:	.WORD	0		;.T. IF OUTPUTTING TO FTN FILE	;30JUN81MAO
CNDLVL:	.WORD	0		;NESTING DEPTH OF .PASSx	;30JUN81MAO
OFFLVL:	.WORD	0		;LEVEL AT WHICH OUTPUT TURNED OFF ;30JUN81MAO
COND:	.WORD	0		;/CO INDICATOR & # OF VALUES	;30JUN81MAO
C1:	.WORD	0		;1ST VALUE, # CHAR IN VALUE	;30JUN81MAO
	.BLKB	6		;CHARACTERS			;30JUN81MAO
C2:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C3:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C4:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C5:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C6:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C7:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C8:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C9:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
C10:	.WORD	0						;30JUN81MAO
	.BLKB	6						;30JUN81MAO
 
         .END