.title	openf
;
;	function called from fortran to open rms files for
;	software tools
;
;	calling sequence:
;		status = openf(ext, ftype, ccontrol, access, age, rab)
;
;		character ext	 ; array with file name (assumed in upper case)
;		integer ftype	 ; file type -- character(0) or binary(1)
;		integer ccontrol ; list(0) or fort(1)
;		integer access	 ; read(1), write(2), readwrite(3), append(4)
;		integer age	 ; old(-1), unk(0), or new(1)
;		integer rab	 ; descriptor to be used with all file prims
;
;		status returned:	err	if error
;					ftype	if successful
;
;	necessary parameters (values of rat4 symbols)
;
err=-3
character=0
binary=1
ext=4
typ=8
cc=12
acc=16
age=20
rab=24
	$devdef		; Device chracteristics
	.psect	st_openf_data	rel,con,gbl,noexe,wrt,rd,pic,noshr,usr,novec,long
name_block:	$nam	; name block for determining process-permanent files
;
;
;	start of code
;
	.psect	st_pure_code	rel,con,lcl,exe,nowrt,rd,pic,shr,usr,novec,long
	.entry	openf	^m<r2,r3>
	calls	#0,getrab		; get a rab address
	movl	r0,r3			; move rab to non-volatile register
	bneq	10$
	brw	operr			; if 0, no rab's available
10$:
	movl	rab$l_fab(r3),r2	; fab address in r2
     $fab_store fab=r2,-		; runtime initialization of fab
		mrs=#0,-		; no maximum record size
		org=seq,-		; seqential organization
		alq=#0,-		; no initial alocation on new files
		fsz=#0,-		; no vfc fields on created files
		fop=tef,-		; truncate file upon closing
		shr=<get,upi>,-		; read sharing if writing file
		rfm=var			; assume character file
     $rab_store rab=r3,-		; runtime initialization of rab
		rac=seq			; sequential record access
	clrl	rab$l_rop(r3)		; clear record processing options
	pushl	ext(ap)			; address of file name on stack
	calls	#1,length		; calculate its length
	pushr	#^m<r0,r1,r2,r3,r4,r5>	; save registers affected by movc
	movc3	r0,@ext(ap),@fab$l_fna(r2) ; copy string into fna buffer
	popr	#^m<r0,r1,r2,r3,r4,r5>	; restore registers
	movb	r0,fab$b_fns(r2)	; size of filespec in fab
	blbc	@typ(ap),cctrl		; if lbc, character file
     $fab_store fab=r2,-		; set up fab for binary file
		rfm=fix,-		; fixed-length records
		mrs=#512		; 512 byte blocks
		brb	access		; skip carriage control stuff
cctrl:
	$fab_store	fab=r2,rat=cr	; assume list carriagecontrol
	blbc	@cc(ap),access		; list carriage control
     $fab_store fab=r2,rat=ftn		; fortran carriage control
access:
	casel	@acc(ap),#1,#4		; case on access mode
case1:	.word	read-case1		; READ
	.word	write-case1		; WRITE
	.word	readwr-case1		; READWRITE
	.word	append-case1		; APPEND
	brw	conerr			; out of range
read:
     $fab_store fab=r2,fac=<get,bro>,-	; read access
		shr=<get,put,upi>	; permit one writer, many readers
     $rab_store	rab=r3,rop=<rah>	; enable readahead
	brb	type
write:
     $fab_store fab=r2,fac=<put,trn,bro>; write access
     $rab_store	rab=r3,rop=<wbh,tpt>	; write behind and truncate
	brb	type
readwr:
     $fab_store	fab=r2,fac=<get,put,trn,bro>	; readwrite access
     $rab_store rab=r3,rop=<wbh,tpt>
	brb	type
append:
     $fab_store fab=r2,fac=<put,trn,bro> ; append access
     $rab_store rab=r3,rop=<tpt,eof,wbh> ; connect at EOF
type:
	moval	name_block,fab$l_nam(r2); fill in name block upon open
	addl3	#1,@age(ap),r0		; place age + 1 in r0
	casel	r0,#0,#2		; case on age + 1
case2:	.word	old-case2		; OLD file
	.word	unk-case2		; UNKNOWN file
	.word	new-case2		; NEW file
	brw	conerr			; out of range
old:
	$open	fab=r2
	brb	tsterr
unk:
     $fab_store fab=r2,fop=<cif,tef>	; create if
new:
	$create fab=r2
tsterr:
	clrl	fab$l_nam(r2)		; no longer need name block
	blbs	r0,25$			; low bit set ==> success
	brw	conerr			; ERROR
25$:
	bbs	#nam$v_ppf,name_block+nam$l_fnb,20$	; no delete if process
							; permanent file
	bbc	#dev$v_fod,fab$l_dev(r2),20$	; dont close non-FODs
	cmpl	@acc(ap),#2		; WRITE access?
	bneq	20$			; NO
	bbs	#fab$v_ftn,fab$b_rat(r2),20$	; no remove/create if cctrl
	bbs	#fab$v_cr,fab$b_rat(r2),20$	; ...
	$close	fab=r2			; close the file
	$erase	fab=r2			; delete the file
     $fab_store fab=r2,fop=tef		; truncate file upon closing
	bisb	#fab$m_cr,fab$b_rat(r2)	; set to LIST carriage control
30$:
	$create	fab=r2			; create new file
20$:
	movl	r3,@rab(ap)		; return rab address
       $connect rab=r3			; connect record stream
	blbc	r0,conerr		; lbc => ERROR
	clrl	rab$l_ctx(r3)		; 0 ==> do not truncate at close
	bbs	#nam$v_ppf,name_block+nam$l_fnb,40$ ; leave proc perm file alone
	bbc	#dev$v_fod,fab$l_dev(r2),40$	; as well as non-FODs
	cmpl	@acc(ap),#2		; WRITE access?
	bneq	40$			; NO
	bbs	#fab$v_ftn,fab$b_rat(r2),50$	; FTN carriage control?
	bisb	#fab$m_cr,fab$b_rat(r2)		; set to LIST carriage ctrl
50$:
;	$rewind	rab=r3			; find first record; guarantees tpt
	incl	rab$l_ctx(r3)		; 1 == > truncate file at close
40$:
	movl	#character,r0		; assume a character file
	bitb	#fab$c_var,fab$b_rfm(r2); check for file type
	bneq	done
	movl	#binary,r0		; have a binary file
done:
	ret
conerr:
	$close	fab=r2			; close file
	pushl	r3
	calls	#1,putrab		; return rab to linked list
operr:
	movl	#err,r0			; return error status
	ret
	.end