.TITLE	ACPOPEN - CREATE A FILE USING ACP QIO'S
;
;	This Fortran callable function creates a file in
;	the user's default directory and prepares it for
;	access using virtual I/O. It is used by software
;	designed to recover ODS-2 files from corrupted media.
;
;	INPUTS:
;
;	  1	Address of the channel number (long) assigned to the output device
;	  2	Address of an event flag number (long) to use
;	  3	Address of initial allocation (long)
;	  4	Address of the file header from the corrupted disk
;	  5	Address of the destination directory ID
;	  6	Adress of a quadword to receive I/O status
;
;	OUTPUTS:
;
;	  1	Function return value (long) is the VMS error code
;		or success code of the last correctly completed operation
;
;
;	Description:
;
;	ACP IO$_CREATE with IO$M_CREATE ! IO$M_ACCESS is used to create a
;	file, enter it into the directory, and open it for write. An
;	attributes list is provided to force the output file to have 
;	characteristics identical to the input file header. The following
;	information, from the input header is used:
;
;		The complete attributes area
;		All dates - creation, revision...
;		Owner UIC
;		Protection mask
;		File name
;
;	Characteristics NOT preserved are:
;
;		Placement control
;		Journal flags (FH2$W_JOURNAL)
;		File Characteristics (FH2$L_FILECHAR)
;		File ID
;		Directory link
;
;	NOTE - None of the modules support multi-header files!!!
;
;	The new file will be created with an initial allocation identical
;	to the old allocation. In some cases this will waste some space -
;	ie if the old device cluster size forced allocation of more space
;	than necessary and the new device cluster size would allow a better
;	fit to actual file size. Old allocation is determined from analysis
;	of the header map area, NOT from file attributes.
;
;	4/23/84 - Moved write attributes to the "close", FIB$M_EXTEND
;		  must be clear for IO$_DEACCESS.
;

	$ATRDEF
	$FIBDEF
	$FH2DEF
	$FI2DEF		; HEADER IDENTIFICATION AREA DEFS
	$FATDEF		; HEADER ATTRIBUTES AREA DEFS
	$IODEF

;
;	DATA STORAGE AREA
;

;	F I B


FIB:	.BYTE	0[FIB$C_LENGTH]		; RESERVE SPACE
;
FIB_DESCR: 				; DESCRIPTOR FOR QIO
	.LONG	FIB$C_LENGTH
	.ADDRESS	FIB


;	ATTRIBUTES LIST FOR WRITE ATTRIBUTES

ATR_LIST:

	.WORD	ATR$S_RECATTR
	.WORD	ATR$C_RECATTR
P_RECATTR:	.LONG	0

	.WORD	ATR$S_CREDATE
	.WORD	ATR$C_CREDATE
P_CREDATE:	.LONG	0

	.WORD	ATR$S_REVDATE
	.WORD	ATR$C_REVDATE
P_REVDATE:	.LONG	0

	.WORD	ATR$S_EXPDATE
	.WORD	ATR$C_EXPDATE
P_EXPDATE:	.LONG	0

	.WORD	ATR$S_BAKDATE
	.WORD	ATR$C_BAKDATE
P_BAKDATE:	.LONG	0

	.WORD	ATR$S_UIC
	.WORD	ATR$C_UIC
P_UIC:	.LONG	0

	.WORD	ATR$S_FPRO
	.WORD	ATR$C_FPRO
P_FPRO:	.LONG	0

	.LONG	0

ATT_LEN = . - ATR_LIST

;
; ATTRIBUTE LIST DESCRIPTOR
;
ATR_DESCR:
	.LONG	ATT_LEN
	.ADDRESS	ATR_LIST


;	FILE NAME DESCRIPTOR - DYNAMICALLY FILLED

FILENAME_DESCR:
	.LONG	0		; LENGTH (BYTES)
	.LONG	0		; LOCATION (IN CALLERS FILE HEADER)

;
;	QIO DPB FOR THE OPEN
;
QIO_OPEN: $QIOW	P1=FIB_DESCR, -
		P2=FILENAME_DESCR, -
		FUNC=IO$_CREATE!IO$M_CREATE!IO$M_ACCESS,-
		IOSB=IO_STATUS
;
;	DITTO FOR THE CLOSE
;
QIO_CLOSE: $QIOW P1=FIB_DESCR, -
		P5=ATR_LIST, -
		FUNC=IO$_DEACCESS, -
		IOSB=IO_STATUS
;
IO_STATUS: .QUAD	0


	.ENTRY	ACPOPEN, ^M<R2,R3,R4,R5,R6,R7,R8>
;
;	GET SOME USEFUL POINTERS
;
	MOVL	16(AP),R6		; HEADER LOC TO R6
	MOVAL	FIB,R7			; FIB TO R7
	MOVAL	ATR_LIST,R8		; ATTRIBUTE LIST TO R8
;
;	INIT THE FIB FOR CREATE
;
	MOVL	#FIB$M_WRITE,FIB$L_ACCTL(R7) ; WRITE ACCESS
	CLRB	FIB$B_WSIZE(R7)		; DEFAULT WINDOW SIZE
;		FIB$W_FID		; FILLED BY "CREATE"
	MOVL	20(AP),R2		; LOC OF DIRECTORY ID
	MOVL	(R2)+,FIB$W_DID(R7)	; DID - FIRST 4 BYTES
	MOVW	(R2),FIB$W_DID+4(R7)	;	LAST 2 BYTES
;		FIB$L_WCC		; CONTEXT FORWILD CARDS
	MOVW	#FIB$M_NEWVER,FIB$W_NMCTL(R7) ; NO SUPERSEDE
	MOVW	#FIB$M_EXTEND!FIB$M_ALDEF,FIB$W_EXCTL(R7) ; DO INITIAL ALLOCATION
	MOVL	@12(AP),FIB$L_EXSZ(R7)	; INITIAL ALLOCATION SIZE
	CLRL	FIB$L_EXVBN(R7)		; STARTING VBN OF ALLOCATION(MUST BE 0)
	CLRB	FIB$B_ALOPTS(R7)	; NO PLACEMENT CONTROL
	CLRB	FIB$B_ALALIGN(R7)	; NO PLACEMENT LOCATION DATA PRESENT
;
;	FILL IN THE ATTRIBUTE LIST POINTERS
;
	ADDL3	#FH2$W_RECATTR,R6,P_RECATTR
	MOVZBL	FH2$B_IDOFFSET(R6),R2	; ID AREA OFFSET (WORDS)
	ADDL	R2,R2			; OFFSET (BYTES)
	ADDL	R6,R2			; ADDRESS OF ID AREA
	ADDL3	#FI2$Q_CREDATE,R2,P_CREDATE
	ADDL3	#FI2$Q_REVDATE,R2,P_REVDATE
	ADDL3	#FI2$Q_EXPDATE,R2,P_EXPDATE
	ADDL3	#FI2$Q_BAKDATE,R2,P_BAKDATE
	ADDL3	#FI2$T_FILENAME,R2,R3	  ; LOC OF FILENAME IN HEADER ID AREA
	MOVL	R3,FILENAME_DESCR+4	  ;   TO FILENAME DESCRIPTOR
	LOCC	#^A/ /,#20,(R3)		  ; LOCATE END OF FILE NAME 
	SUBL3	R0,#20,FILENAME_DESCR	  ; LENGTH OF NAME TO DESCRIPTOR

	ADDL3	#FH2$L_FILEOWNER,R6,P_UIC ; OWNER UIC
	ADDL3	#FH2$W_FILEPROT,R6,P_FPRO ; FILE PROTECTION
;
	MOVL	@4(AP),QIO_OPEN+QIOW$_CHAN; SET THE CHANNEL
	MOVL	@8(AP),QIO_OPEN+QIOW$_EFN ; SET THE EVENT FLAG
;
	MOVL	@4(AP),QIO_CLOSE+QIOW$_CHAN; SET THE CHANNEL FOR DEACCESS
	MOVL	@8(AP),QIO_CLOSE+QIOW$_EFN ; SET THE EVENT FLAG
;
	$QIOW_G	QIO_OPEN		; OPEN THE FILE
	MOVQ	IO_STATUS,@24(AP)	; RETURN THE I/O STATUS
	RET
;
;
	.SBTTL 	ACPCLOSE
;
;	CLOSE THE FILE CREATED BY ACPOPEN
;
;	INPUTS: CHANNEL AND FLAG FROM ACPOPEN, FIB FROM ACPOPEN
;
;	OUTPUT: FUNCTION RETURN CODE IN R0 AND I/O STATUS BLOCK
;
	.ENTRY	ACPCLOSE, ^M<>

	CLRW	FIB+FIB$W_EXCTL		; EXTEND MUST BE CLEAR
	$QIOW_G	QIO_CLOSE		; CLOSE THE FILE
	MOVQ	IO_STATUS,@4(AP)	; RETURN THE I/O STATUS
	RET

	.END