.TITLE FILERSX
	.IDENT /850304/
;+
;.ENTRY FILERSX
; - F I L E R S X
; FILE:       FILERSX.MAC
; SYSTEM:     VMS V4.0
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT (BASED ON FLERSX OF CHRIS MEYERS)
; DATE:       04-MAR-85
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: MACRO SUPPORT ROUTINES FOR THE FLECS TRANSLATOR ROUTINES
;		IN FILE FILE.FLX.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  SEE INDIVIDUAL ROUTINES
;
;****NOTES:  
;	1.  These routines are supplied in MACRO instead of FORTRAN
; because similar PDP routines using FORTRAN READ/WRITES took ???? times
; as much CPU time as these MACRO routines!
;-

	.PSECT FLEDAT RW,I,LCL,REL,CON
 
;	Data
 
	.MCALL OPEN$W,OPEN$R,CLOSE$,DELET$,GET$,PUT$,NMBLK$
	.MCALL FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDOF$L
 
	FDOF$L			;define fdb offsets locally
 
	FALSE	= 0		;F77 FALSE
	NUMINC	= 3		;# of possible .INCLUDE file levels
	NUMCTX	= 3		;# of words to save per .INCLUDE file
	TRUE	= -1		;F77 TRUE
 
DDDSC:	.BLKW 6			;FCS DATA SET DESCRIPTOR
 
FLLFDB: FDBDF$			;DEFINE FDB FOR FLL OUTPUT FILE
	FDAT$A R.VAR,FD.CR
	FDRC$A 0,,132.
	FDOP$A 4,,NAMBLK	;LUN=4
 
FLXCTX:	.REPT NUMINC		;SAVE POSITION IN .INCLUDE FILES
	.BLKW NUMCTX
	.ENDR
 
FLXFDB:	FDBDF$			;DEFINE FDB FOR FLX & .INC INPUT FILES
	FDRC$A 0		;NO REC ATTRIBUTES SET
	FDOP$A 2,,NAMBLK	;LUN=2
 
FLXFNB:	.REPT  NUMINC		;SAVED FILENAME BLOCK FOR .INC FILES
	.BLKW S.FNBW
	.ENDR
 
FTNFDB:	FDBDF$			;DEFINE FDB FOR FTN OUTPUT FILE
	FDAT$A R.VAR,FD.CR	;FILE ATTRIBUTES
	FDRC$A 0,,80.		;NO REC ATTRIBUTES SET
	FDOP$A 3,,NAMBLK	;LUN=3
 
IMPFDB:	FDBDF$			;DEFINE FDB FOR .IMPLICIT NONE FILE
	FDAT$A R.VAR,FD.CR
	FDRC$A 0,,80.
	FDOP$A 5		;LUN=5
 
NAMBLK:	NMBLK$ ,FLX,,SY,0
 
OPNFLL:	.WORD 0		;<>0 ==>FLL file open
OPNFLX:	.WORD 0		;<>0 ==>FLX file open
OPNFTN:	.WORD 0		;<>0 ==>FTN file open

;	Code
 
	.PSECT FLECOD RO,I,LCL,REL,CON
 
;+
;.ENTRY FCLOSE
; - F C L O S E
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Close files for CLOSEF.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FCLOSE
;
;    INPUT:  None
;
;    MODIFIED: None
;
;    OUTPUT:  None
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  .FLX, .FTN, & .FLL files
;	DEVICES:     Device above files are on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  CLOSE$
;
;****NOTES:  
;-

FCLOSE::
 
	TST OPNFLX		;.FLX FILE OPEN?
	BEQ 10$
	CLOSE$ #FLXFDB		;Yes, Close FLX file
	CLR OPNFLX		;	AND FLAG IT CLOSED
 
10$:	TST OPNFTN		;.FTN FILE OPEN?
	BEQ 20$
	CLOSE$ #FTNFDB		;YES, CLOSE IT
	CLR OPNFTN		;	AND FLAG IT CLOSED

20$:	TST OPNFLL		;.FLL FILE OPEN?
	BEQ 30$
	CLOSE$ #FLLFDB		;YES, CLOSE IT
	CLR OPNFLL		;	AND FLAG IT CLOSED
 
30$:
	RTS PC

;+
;.ENTRY FGET
; - F G E T
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Get input line for GET.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FGET (NCHAR,INPUT,EOF,ERR1,ERR2)
;
;    INPUT:  None
;
;    MODIFIED: None
;
;    OUTPUT:  
;
; NCHAR	= (I*2) # of characters in INPUT
; INPUT = (I*2) line read from input file
; EOF	= (L*2) .T.==>read end-of-file on input
; ERR1	= (I*2) IO error code, 0==>no error
; ERR2	= (I*2) IO error type (defined only if ERR1<>0)
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  Current input file (.FLX or .INCLUDE)
;	DEVICES:     Device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  GET$
;
;****NOTES:  
;-

FGET::
	CLR @6(R5)	;ASSUME NO ERRORS
	CLR @10(R5)
	CLR @12(R5)
 
	GET$ #FLXFDB,4(R5),#80.		;GET AN INPUT LINE
	BCS 10$				;ANY ERRORS?
5$:
	MOV FLXFDB+F.NRBD,@2(R5)	;NO, GET # CHAR INPUT
	RTS PC
 
10$:
	CMPB #IE.EOF,FLXFDB+F.ERR	;EOF ERROR?
	BNE 20$
	MOV #TRUE,@6(R5)		;YES
	RTS PC
 
20$:
	MOVB FLXFDB+F.ERR,R0		;SIGN EXTEND ERROR BYTE
	MOV R0,@10(R5)			;RETURN ERROR
	MOVB FLXFDB+F.ERR+1,@12(R5)	;RETURN ERROR CLASS
	BR 5$				;PROCESS WHAT WE GOT

;+
;.ENTRY FIMPCL
; - F I M P C L
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Close a file for IMPCLS
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FIMPCL
;
;    INPUT:  None
;
;    MODIFIED: None
;
;    OUTPUT:  None
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  Innnnn.FID
;	DEVICES:     device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  CLOSE$
;
;****NOTES:  
;-

FIMPCL::
	CLOSE$ #IMPFDB

	RTS PC

;+
;.ENTRY FIMPOP
; - F I M P O P
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Open a file for IMPOPN
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FIMPOP (NAME,IMPDSC)
;
;    INPUT:  
;
; NAME	= (byte array) file name
; IMPDSC= (2X4 I*2 array) descriptor for file name, see note 1.
;
;    MODIFIED: None
;
;    OUTPUT:  None
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  In.FID
;	DEVICES:     device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  
;
;****NOTES:  
;	1. THE DSC ARRAYS ARE ARRANGED AS FOLLOWS:
; XDSC(M,1) = INFORMATION FOR DEVICE
; XDSC(M,2) = INFORMATION FOR DIRECTORY
; XDSC(M,3) = INFORMATION FOR FILE NAME
; XDSC(M,4) = INFORMATION FOR THE WHOLE FILE NAME INC DEV, DIR, NAME.
;
; XDSC(1,N) = LENGTH OF THE FIELD (0==>NO FIELD IN INPUT)
; XDSC(2,N) = INDEX IN ARRAY XNAME OF THE START OF THE FIELD
;-

FIMPOP::
	MOV 2(R5),R0		;ADDR OF FILENAME
	MOV 4(R5),R1		;ADDR DESCRIPTOR TABLE
	JSR PC,SETDD		;SET UP DATA SET DESCRIPTOR
 
	OPEN$W #IMPFDB,,#DDDSC	;OPEN THE FILE
 
	RTS PC

;+
;.ENTRY FIMPWR
; - F I M P W R
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Write a line to a file for IMPWRT
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FIMPWR (LINE, LEN)
;
;    INPUT:  
;
; LINE	= (byte array) line to output
; LEN	= (I*2) length of LINE in bytes
;
;    MODIFIED: None
;
;    OUTPUT:  None
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  In.FID
;	DEVICES:     device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  PUT$
;
;****NOTES:  
;-

FIMPWR::
 
	PUT$ #IMPFDB,2(R5),@4(R5)	;output line
 
	RTS PC

;+
;.ENTRY FOPN
; - F O P N
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Open .FLX, .FTN & .FLL files for OPENF.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  
;
; CALL FOPN (LINE,FLXDEF,FLXDSC,FORT,FTNDEF,FTNDSC,
;		LIST,FLLDEF,FLLDSC,ERRNUM)
;
;    INPUT:  
;
; LINE	= (BYTE ARRAY) LINE CONTAINING FILE NAMES.
; FLXDEF= (4L*1) DEFAULT FILE EXTENSION IN ASCII (EG. ".FLX").
; FLXDSC= (2X4 I*2 ARRAY) DESCRIPTOR FOR FILE NAME, SEE NOTE 1.
; FORT  = (L*2) .T. IF SHOULD OPEN .FTN OUTPUT FILE
; FTNDEF= (4L*1) DEFAULT FILE EXTENSION IN ASCII (EG. ".FTN").
; FTNDSC= (2X4 I*2 ARRAY) DESCRIPTOR FOR FILE NAME, SEE NOTE 1.
; LIST	= (L*2) .T. IF SHOULD OPEN .FLL OUTPUT FILE
; FLLDEF= (4L*1) DEFAULT FILE EXTENSION IN ASCII (EG. ".ALL").
; FLLDSC= (2X4 I*2 ARRAY) DESCRIPTOR FOR FILE NAME, SEE NOTE 1.
; 
;    MODIFIED: None
;
;    OUTPUT:  
;
; ERRNUM = (I*2) ERROR STATUS
;	 = 0, SUCCESS
;	 = 1, OPEN ERROR ON .FLX FILE
;	 = 2, OPEN ERROR ON .FTN FILE
;	 = 3, OPEN ERROR ON .FLL FILE
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  .FLX, .FTN & .FLL files
;	DEVICES:     Device files are on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  
;
;****NOTES:  
;	1. THE DSC ARRAYS ARE ARRANGED AS FOLLOWS:
; XDSC(M,1) = INFORMATION FOR DEVICE
; XDSC(M,2) = INFORMATION FOR DIRECTORY
; XDSC(M,3) = INFORMATION FOR FILE NAME
; XDSC(M,4) = INFORMATION FOR THE WHOLE FILE NAME INC DEV, DIR, NAME.
;
; XDSC(1,N) = LENGTH OF THE FIELD (0==>NO FIELD IN INPUT)
; XDSC(2,N) = INDEX IN ARRAY XNAME OF THE START OF THE FIELD
;-

FOPN::
	CLR @24(R5)		;ASSUME SUCCESS
 
;----------------------------------------------------------------------
;	OPEN .FLX FILE
;----------------------------------------------------------------------
 
				;SET UP FLX DATA SET DESCRIPTOR
	MOV 2(R5),R0		;ADDR OF FILENAME
	MOV 6(R5),R1		;ADDR CALLER DESCRIPTOR TABLE
	JSR PC,SETDD 
 
	MOV 4(R5),R0		;ADDR DEFAULT EXTENSION
	INC R0			;SKIP OVER THE PERIOD
	CLR R1			;TELL $CAT5 "NO PERIODS"
	CALL $CAT5		;ASCII-->RAD50
	MOV R1,N.FTYP+NAMBLK	;SAVE NAME IN NAME BLOCK
 
;	NOW OPEN THE FILE
 
	OPEN$R #FLXFDB,,#DDDSC
	BCC 20$
 
	MOV #1,@24(R5)		;FLAG OPEN ERROR ON FLX FILE
	BR 1000$
 
20$:
	INC OPNFLX		;FLAG IT OPEN
 
	CMP @10(R5),#FALSE	;IS THERE TO BE AN FTN FILE?
	BEQ 200$

;----------------------------------------------------------------------
; OPEN THE .FTN FILE
;----------------------------------------------------------------------
 
				;YES, SET UP DESCRIPTOR FOR FTN FILE
	MOV 2(R5),R0		;ADDR FILENAME
	MOV 14(R5),R1		;ADDR CALLER DESCRIPTOR TABLE
	JSR PC,SETDD
 
	MOV 12(R5),R0		;ADDR DEFAULT EXTENSION
	INC R0			;SKIP THE PERIOD
	CLR R1			;TELL CAT5 "NO PERIODS"
	CALL $CAT5		;ASCII-->RAD50
	MOV R1,N.FTYP+NAMBLK	;STORE IN NAME BLOCK
 
	OPEN$W #FTNFDB,,#DDDSC	;OPEN THE FILE
	BCC 120$
	MOV #2,@24(R5)		;FLAG AS OPEN ERROR ON FTN FILE
	BR 1000$
 
120$:
	INC OPNFTN		;FLAG .FTN FILE OPEN
 
200$:
	CMP @16(R5),#FALSE	;IS THERE TO BE A .FLL FILE?
	BEQ 300$
 
;-------------------------------------------------------------------
; OPEN .FLL FILE
;-------------------------------------------------------------------
 
	MOV 2(R5),R0		;YES, SET UP DATASET DESCRIPTOR
	MOV 22(R5),R1
	JSR PC,SETDD
 
	MOV 20(R5),R0		;SET UP DEFAULT EXTENSION
	INC R0			;SKIP OVER PERIOD
	CLR R1			;TELL CAT5 "NO PERIODS"
	CALL $CAT5		;ASCII-->RAD50
	MOV R1,N.FTYP+NAMBLK
 
	OPEN$W #FLLFDB,,#DDDSC	;OPEN THE FILE
	BCC 220$
 
	MOV #3,@24(R5)		;FLAG AS .FLL FILE ERROR
	BR 1000$
 
220$:
	INC OPNFLL		;FLAG .FLL FILE AS OPEN
 
300$:
 	RTS PC
 
;--------------------------------------------------------------------
; ON OPEN ERROR, CLOSE ALL FILES, DELETING .FTN & .FLL FILES
;--------------------------------------------------------------------
 
1000$:
	TST OPNFLX		;.FLX FILE OPEN?
	BEQ 1100$
	CLOSE$ #FLXFDB		;YES, CLOSE IT
	CLR OPNFLX		;	AND FLAG IT CLOSED
 
1100$:
	TST OPNFTN		;.FTN FILE OPEN?
	BEQ 1200$
	DELET$ #FTNFDB		;YES, CLOSE & DELETE IT
	CLR OPNFTN		;	AND FLAG IT CLOSED
 
1200$:
	TST OPNFLL		;.FLL FILE OPEN?
	BEQ 1300$
	DELET$ #FLLFDB		;YES, CLOSE & DELETE IT
	CLR OPNFLL		;	AND FLAG IT CLOSED
 
1300$:
	RTS PC

;	Internal subroutine to set up DATA SET DESCRIPTOR
 
SETDD:
 
	MOV #DDDSC,R2		;ADDR FCS DESCRIPTOR
	MOV #3,R3		;# OF FIELDS TO FILL IN
1$:
	MOV (R1)+,(R2)+		;LENGTH
	BEQ 5$			;ANY CHARACTERS?
	MOV (R1)+,(R2)		;YES, GET INDEX
	DEC (R2)		;MAKE A BYTE OFFSET
	ADD R0,(R2)+		;ADDRESS OF ITEM
	BR 10$
5$:
	CMP (R1)+,(R2)+		;SET POINTERS PAST NULL ITEM
10$:
	SOB R3,1$		;NEXT ITEM IN DATA SET
 
	RTS PC

;+
;.ENTRY FOPNIN
; - F O P N I N
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Open an .INCLUDE file for OPNINC.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FOPNIN(INCLVL,NAME,FILDSC,IERR)
;
;    INPUT:  
;
; INCLVL= (I*2) INCLUDE level of file to open
; NAME	= (byte array) name of file
; FILDSC= (2X4 I*2 array) descriptor for file name, see note 1.
;
;    MODIFIED: None
;
;    OUTPUT:  
;
; IERR	= (I*2) 0==> success, <>0 ==> failure
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  .INCLUDE file
;	DEVICES:     Device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  
;
;****NOTES:  
;	1. THE DSC ARRAYS ARE ARRANGED AS FOLLOWS:
; XDSC(M,1) = INFORMATION FOR DEVICE
; XDSC(M,2) = INFORMATION FOR DIRECTORY
; XDSC(M,3) = INFORMATION FOR FILE NAME
; XDSC(M,4) = INFORMATION FOR THE WHOLE FILE NAME INC DEV, DIR, NAME.
;
; XDSC(1,N) = LENGTH OF THE FIELD (0==>NO FIELD IN INPUT)
; XDSC(2,N) = INDEX IN ARRAY XNAME OF THE START OF THE FIELD
;-

FOPNIN::
				;Save current context
	MOV	@2(R5),R3		;FIND LOCATION TO PUT CONTEXT
	DEC	R3			;INCLUDE LEVEL OF OLD FILE
	MUL	#NUMCTX*2,R3		;BYTE OFFSET
	MOV	R3,R4			;R3 WILL BE USED BY .MARK
	ADD	#FLXCTX,R4		;ADDR
	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	@2(R5),R1		;FIND LOCATION TO SAVE FNB
	DEC	R1			;INCLUDE LEVEL OF OLD FILE
	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	#^RFLX,NAMBLK+N.FTYP	;SET DEFAULT FOR EXTENSION
	CLR	@10(R5)			;ASSUME SUCCESS
	MOV	4(R5),R0		;ADDR OF FILE NAME
	MOV	6(R5),R1		;ADDR USER DESCRIPTOR TABLE
	JSR PC,SETDD			;SET UP DATA SET DESCRIPTOR
 
	OPEN$R	#FLXFDB
	BCC	40$
	MOV	#3,@10(R5)		;OPEN ERROR
40$:
	RTS PC

;+
;.ENTRY FPUT
; - F P U T
; IDENT:      /850304/
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO11
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Output to .FLL or .FTN file for PUT.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FPUT (CLASS,LINE,LEN)
;
;    INPUT:  
;
; CLASS	= (I*2) IO class for output: 1-->FTN, 2-->FLL
; LINE	= (byte array) line to output
; LEN	= (I*2) number of bytes in the array
;
;    MODIFIED: None
;
;    OUTPUT:  None
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  .FTN or .FLL file
;	DEVICES:     Device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  
;
;****NOTES:  
;-

FPUT::
	CMP @2(R5),#1			;FORT OUTPUT?
	BNE 20$
	PUT$ #FTNFDB,4(R5),@6(R5)	;OUTPUT IT
	RTS PC
 
20$:
	PUT$ #FLLFDB,4(R5),@6(R5)	;LIST IT
	RTS PC

;+
;.ENTRY FROPN
; - F R O P N
; IDENT:     /850304/ 
; FILE:       FILERSX.MAC
; SYSTEM:     RSX V4.1
; LANGUAGE:   MACRO 32
; AUTHOR:     M. OOTHOUDT
; DATE:       850304
;-
; REFERENCES: 
;
; REVISIONS:  
;+
;
;****PURPOSE: Reopen previous level of .INCLUDE for ROPN.
;
;****RESTRICTIONS:  
;
;****CALLING SEQUENCE:  CALL FROPN (INCLVL,CLS)
;
;    INPUT:  
;
; INCLVL= (I*2) .INCLUDE level to go to
; CLS	= (L*2) .T. ==> close file for next deeper .INCLUDE level
;
;    MODIFIED: None
;
;    OUTPUT:  None
;
;    CMN BLOCKS USED:  None
;
;****RESOURCES:
;	LIBRARIES:   None
;	OTHER SUBR:  None
;	DISK FILES:  .INCLUDE files
;	DEVICES:     Device file is on
;	SGAS:        None
;	EVENT FLAGS: None
;	SYSTEM DIR:  
;
;****NOTES:  
;	1. Under RSX there is not enough virtual address space to
; have all levels of .INCLUDE files open at the same time.  Thus we
; have only one open at a time and save information to allow simple
; reopenning and repositioning of less deeply nested files.
;-

FROPN::
	CMP	@4(R5),#FALSE		;CLOSE CURRENTLY OPEN FILE?
	BEQ	1$
	CLOSE$	#FLXFDB			;YES
 
1$:
	MOV	#S.FNBW,R2		;RESTORE FNB, # WORDS IN FNB
	MOV	#FLXFDB+F.FNB,R0	;ADDR TO PUT FNB
	MOV	@2(R5),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$
 
	OPEN$R	#FLXFDB			;REOPEN FILE
 
	MOV	@2(R5),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)+,R1		;RETRIEVE CONTEXT
	MOV	(R4)+,R2
	MOV	(R4)+,R3
	CALL	.POINT			;RESTORE CONTEXT
	RTS PC
	.END