;------------------------------------------------------------------------------
;
;		Name: USER_OPEN
;
;		Type: Multilple Function (MACRO)
;
;     		Author:	T.W.Fredian
;			MIT Plasma Fusion Center
;
;		Date:	January 26, 1983
;
;    		Version:
;
;    		Purpose: Used to permit qio access to files with fortran.
;			 Returns channel and file size information and
;			 provides file truncation capability. Files opened
;			 with these useopens cannot be accessed using fortran
;			 reads and writes and the dispose= keyword on the
;			 close of the file will have no effect. To make the
;			 logical unit reuseable for normal RMS access you must
;			 deassign the channel using SYS$DASSGN(%VAL(channel))
;			 and then use the close (unit= ) statement.
;
;               Types of useropens provided:
;
;                   USER_OPEN$OLD        - open old file
;                   USER_OPEN$NEW        - open new file
;                   USER_OPEN$TRUNCATE   - open old file and truncate it
;                                          to the size specified by the
;                                          INITIALSIZE keyword of the open
;
;              To receive the channel, open RMS status and size of the file
;              include a common USER_OPEN as follows:
;
;              Common /USER_OPEN/ CHANNEL,STATUS,SIZE
;              Integer*4 CHANNEL - I/O channel assigned to the file
;              Integer*4 STATUS  - RMS status return of open
;              Integer*4 SIZE    - Size of the file opened in blocks
;
;------------------------------------------------------------------------------
;
;	Call seqence: NONE - USEROPEN keyword of fortran OPEN statement
;                     for example:
;
;           External USER_OPEN$NEW
;           .
;           .
;           .
;           OPEN (UNIT=lun,FILE=filename,....,USEROPEN=USER_OPEN$NEW)
;
;------------------------------------------------------------------------------
;
; 	Description:
;
; Entry mask for USER_OPEN$OLD
; Get the FAB address
; Set the user file open bit
; Open old file
; Save the channel
; Save the size
; Save the status
; Return

; Entry mask for USER_OPEN$NEW
; Get the FAB address
; Set the user file open bit
; Open new file
; Save the channel
; Save the size
; Save the status
; Return

; Entry mask for USER_OPEN$TRUNCATE
; Get the FAB address
; Get the RAB address
; Save the size
; Open old file
; Connect file to record stream
; Load the size of the file in the RAB
; Set the access mode to relative file address
; Find the last record in the file
; Place the end of file marker at this location
; Mark the file to be truncated on close
; Close the file
; Return

; End
;
;+-----------------------------------------------------------------------------

	.TITLE	USER_OPEN
	.IDENT	/V_830128/

;
;------------------------------------------------------------------------------
;
; Global variables:
;
	.PSECT	USER_OPEN	LONG,PIC,OVR,GBL,SHR,NOEXE

CHANNEL:	.BLKL	1			; Channel number
STATUS:		.BLKL	1			; Status return of open
SIZE:		.BLKL	1			; Size of file

;
;------------------------------------------------------------------------------
;
; Executable:
;
	.PSECT	$CODE	LONG,PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC

	.ENTRY	USER_OPEN$OLD,^M<R2>		; Entry mask for USER_OPEN$OLD
        MOVL	4(AP),R2			; Get the FAB address
	INSV	#1,#FAB$V_UFO,#1,FAB$L_FOP(R2)	; Set the user file open bit
	$OPEN	FAB=(R2)			; Open old file
        MOVL	FAB$L_STV(R2),CHANNEL		; Save the channel
	MOVL	FAB$L_ALQ(R2),SIZE		; Save the size
	MOVL	R0,STATUS			; Save the status
	RET					; Return

        .ENTRY  USER_OPEN$NEW,^M<R2>		; Entry mask for USER_OPEN$NEW
	MOVL	4(AP),R2			; Get the FAB address
	INSV	#1,#FAB$V_UFO,#1,FAB$L_FOP(R2)	; Set the user file open bit
	INSV	#0,#FAB$V_CBT,#1,FAB$L_FOP(R2)	; Disable contiguous best try
	$CREATE	FAB=(R2)			; Open new file
        MOVL	FAB$L_STV(R2),CHANNEL		; Save the channel
	MOVL	FAB$L_ALQ(R2),SIZE		; Save the size
	MOVL	R0,STATUS			; Save the status
	RET					; Return

	.ENTRY	USER_OPEN$TRUNCATE,^M<R2,R3,R4,R5>	; Entry mask for USER_OPEN$TRUNCATE
        MOVL	4(AP),R2			; Get the FAB address
	MOVL	8(AP),R3			; Get the RAB address
	MOVL	FAB$L_ALQ(R2),R4		; Save the size
	INCL	R4				; Increment the size
	INSV	#0,#FAB$V_SQO,#1,FAB$L_FOP(R2)	; Clear the sequential only bit
	$OPEN	FAB=(R2)			; Open old file
	BLBC	R0,CLOSE			; If unsuccessful branch to close
	$CONNECT RAB=@8(AP)			; Connect file to record stream
        BLBC	R0,CLOSE			; If unsuccessful branch to close
	MOVL	R4,RAB$L_RFA0(R3)		; Load the size of the file in the RAB
	MOVW	#0,RAB$W_RFA4(R3)
	MOVB	#RAB$C_RFA,RAB$B_RAC(R3)	; Set the access mode to relative file address
	$FIND	RAB=(R3)			; Find the last record in the file
	BLBC	R0,CLOSE			; If unsuccessful branch to close
	$TRUNCATE RAB=(R3)			; Place the end of file marker at this location
	INSV	#1,#FAB$V_TEF,#1,FAB$L_FOP(R2)	; Mark the file to be truncated on close
CLOSE:	PUSHL	R0				; Save error status
	$CLOSE	FAB=(R2)			; Close the file
	POPL	R0				; Restore error status
	MOVL    R0,STATUS			; Return the status
	RET					; Return

	.END					; End