/
/ Open a file.
/

	.globl	fopen
	.globl	__ferr

/
/ Global data.
/

__ferr:	.blkw	1

/
/ FILE *fopen(name, mode);
/ char *name, *mode;
/ mode is "r", "w" or "a".
/ mode "n" sets VF_NOS, IO.WAL on output.
/ mode "u" sets VF_UBF, record I/O only (No rec. buf).
/ mode "u" => mode "n".
/
/ Returns NULL on errors. Global cell _ferr gets
/ the FCS error code.
/

R	=	-2		/Read flag
W	=	-4		/Write flag
A	=	-6		/Append flag
LBUF	=	-22		/Get lun buffer (6 words)
UIC	=	-26		/UIC
RATT	=	-30		/IO.RAT done flag
RATBK	=	-36		/IO.RAT parameter block
NOS	=	-40		/No newlines flag
UBF	=	-42		/Unbuffered flag
FIX	=	-44		/Fixed-length record flag

fopen:	jsr	r0,__csav	/Get a stack frame.
	sub	$36.,sp		/

/
/ Gather options.
/ Ignore those that you don't like.
/
	clr	r4
	clr	R(r5)		/Clear option flags.
	clr	W(r5)		/
	clr	A(r5)		/
	clr	NOS(r5)		/
	clr	UBF(r5)		/
	clr	FIX(r5)		/

	mov	14(r5),r0	/Get pointer to options.

1:	movb	(r0)+,r1	/Get option character.
	beq	1f		/Br at the end.

	cmp	r1,$'r		/Read.
	bne	0f
	inc	R(r5)
	br	1b

0:	cmp	r1,$'w		/Write.
	bne	0f
	inc	W(r5)
	br	1b

0:	cmp	r1,$'a		/Append.
	bne	0f
	inc	A(r5)
	br	1b

0:	cmp	r1,$'f		/Fixed length records
	bne	0f
	inc	FIX(r5)
	inc	NOS(r5)
	inc	UBF(r5)
	br	1b

0:	cmp	r1,$'n		/No newlines.
	bne	0f
	inc	NOS(r5)
	br	1b

0:	cmp	r1,$'u		/Unbuffered.
	bne	1b
	inc	UBF(r5)
	br	1b

1:	mov	R(r5),r0	/Check that only 1 of
	add	W(r5),r0	/"r", "w" or "a" has
	add	A(r5),r0	/been specified.
	dec	r0		/Well?
	beq	0f		/We live right!
	mov	$IE.BAD,r0	/Make up an error code
	br	9f		/

/
/ Allocate an IOV and a lun.
/

0:	mov	__nlun,r0	/Size of lun table.
	mov	$__luns,r3	/Pointer to lun table.

0:	dec	r0		/Free lun has a NULL entry.
	bmi	8f		/Br if no lun available.
	tst	(r3)+
	bne	0b
	sub	$__luns,r3	/Figure out lun number.
	asr	r3

	mov	$V_LENG,r0	/Allocate IOV.
	call	__aloc
	tst	r0
	beq	8f

	mov	r0,r4		/Get IOV pointer in r4.
	mov	$VF_BAD,r0	/Set V_FLAG word.
	tst	R(r5)
	bne	0f
	mov	$VF_OUT,r0

0:	tst	NOS(r5)		/Set VF_NOS if "n".
	beq	0f
	bis	$VF_NOS,r0

0:	tst	UBF(r5)		/Set VF_UBF if "u"
	beq	0f
	bis	$VF_UBF,r0
	bis	$VF_NOS,r0	/Someday fix the assembler!!!!

0:	mov	r0,V_FLAG(r4)	/Finish setting up the IOV.
	mov	$-1,V_UGET(r4)
	clr	V_R0(r4)
	clr	V_RBUF(r4)
	clr	V_BBUF(r4)
	mov	r3,V_LUN(r4)

/
/ Assign the lun.
/ This also sets up the record buffer size in V_RBSZ
/ and reads the FCS attributes into V_RTYP through V_FFBY.
/

	call	aslun
	bcs	9f

/
/ Set read seek address.
/ 1 for files.
/ 0 for devices.
/

0:	clr	V_RBYT(r4)
	clr	V_RBLK(r4)
	clr	V_RBLK+2(r4)
	bit	$VF_FIL,(r4)
	beq	0f
	inc	V_RBLK+2(r4)

/
/ Allocate buffers.
/ Don't allocate the record buffer if "u".
/

0:	tst	UBF(r5)		/Skip if "u".
	bne	0f
	mov	V_RBSZ(r4),r0	/Allocate record buffer.
	inc	r0		/+1 for "n" or NOS.
	call	__aloc
	tst	r0
	beq	8f
	mov	r0,V_RBUF(r4)
	mov	r0,V_R1(r4)

/
/ Allocate block buffer.
/ Skip if record device.
/ Always 512. bytes long.
/

0:	bit	$VF_REC,V_FLAG(r4)
	bne	0f
	mov	$512.,r0
	call	__aloc
	tst	r0
	beq	8f
	mov	r0,V_BBUF(r4)

/
/ Final touches.
/ Set the IOV pointer into the _luns table.
/ Preset the FCS attributes if writing.
/ Check attributes if appending. If ok, seek to EOF.
/ Also read in the last block, if partially written.
/

0:	mov	V_LUN(r4),r0
	asl	r0
	mov	r4,__luns-2(r0)

	tst	W(r5)
	beq	3f
	tst	FIX(r5)
	beq	0f
	movb	$R.FIX,V_RTYP(r4)
	clrb	V_RATT(r4)
	mov	16(r5),V_RSIZ(r4)
	br	2f

0:
	movb	$R.VAR,V_RTYP(r4)
	movb	$FD.CR,V_RATT(r4)
	clr	V_RSIZ(r4)

2:
	clr	V_EFBK(r4)
	mov	$1,V_EFBK+2(r4)
	clr	V_FFBY(r4)
	br	1f

3:	tst	A(r5)
	beq	1f
	bit	$VF_REC,V_FLAG(r4)
	bne	1f
	cmpb	V_RTYP(r4),$R.FIX
	beq	2f
	cmpb	V_RATT(r4),$FD.CR
	bne	0f
2:
	mov	V_EFBK(r4),V_RBLK(r4)
	mov	V_EFBK+2(r4),V_RBLK+2(r4)
	mov	V_FFBY(r4),V_RBYT(r4)
	beq	1f
	call	__rvb
	bcs	9f
	br	1f

0:	mov	$IE.RAT,r0
	br	9f

1:	mov	r4,r0
	jmp	__cret

/
/ On errors, stuff the error code into _ferr and
/ return NULL.
/ Also free any remains of the bad open.
/

8:	mov	$IE.NBF,r0
9:	mov	r0,__ferr
	tst	r4
	beq	1f

	bit	$VF_FIL,V_FLAG(r4)
	beq	0f
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	$IO.DAC,r0
	call	__qiow

0:	mov	V_RBUF(r4),r0
	beq	0f
	call	__free

0:	mov	V_BBUF(r4),r0
	beq	0f
	call	__free

0:	mov	r4,r0
	call	__free

1:	clr	r0
	jmp	__cret

/
/ This routine, given a pathname (at 12(r5), the first arg.
/ of fopen, assigns the lun specified by V_LUN(r4).
/ Assigning the lun includes accessing of files, creation
/ of files, and reading of FCS attributes.
/ Returns with the c bit set and an error code in r0 if
/ anything funny happens.
/
/ First, initialise the filename block.
/

aslun:
	mov	r4,r0
	add	$V_FID,r0
	mov	r4,r1
	add	$V_LENG,r1
0:
	cmp	r0,r1
	bhis	0f
	clr	(r0)+
	br	0b
0:
	mov	$'S+['Y<<8.],V_DVNM(r4)
	mov	__uic5,UIC(r5)
	mov	__uic5+2,UIC+2(r5)

/
/ Parse the name.
/ Any uic is saved in UIC(r5) and UIC+2(r5).
/ Devices and filenames go straight into the filename
/ block.
/

	mov	12(r5),r2

nxt:
	mov	r2,r1
	movb	(r2)+,r0
	beq	done

	cmp	r0,$'[
	bne	0f
	call	getuic
	bcc	nxt
	br	9f

0:
	cmp	r0,$':
	beq	dev
	cmp	r0,$'.
	beq	fil
	cmp	r0,$';
	beq	fil
	movb	(r2)+,r0
	beq	fil
	br	0b

/
/ Device name.
/

dev:
	sub	r1,r2
	cmp	r2,$3
	blo	2f

	mov	r1,r2
	mov	r4,r1
	add	$V_DVNM,r1
	movb	(r2)+,(r1)
	bicb	$' ,(r1)+
	movb	(r2)+,(r1)
	bicb	$' ,(r1)+

	clr	(r1)
0:
	movb	(r2)+,r0
	cmp	r0,$':
	beq	nxt
	sub	$'0,r0
	cmp	r0,$9
	bhi	2f
	asl	(r1)
	mov	(r1),-(sp)
	asl	(r1)
	asl	(r1)
	add	(sp)+,(r1)
	add	r0,(r1)
	br	0b

2:
	mov	$IE.BDV,r0
	br	9f

/
/ File name.
/

fil:
	dec	r2
	mov	r2,-(sp)
	mov	r2,r0
	sub	r1,r0
	mov	r4,r2
	add	$V_FNAM,r2
	mov	$9.,r3
	call	move
	mov	(sp)+,r2
	bcs	2f

	movb	(r2)+,r0
	beq	done
	cmp	r0,$'.
	bne	1f

	mov	r2,r1
0:
	movb	(r2)+,r0
	beq	0f
	cmp	r0,$';
	bne	0b

0:
	dec	r2
	mov	r2,-(sp)
	mov	r2,r0
	sub	r1,r0
	mov	r4,r2
	add	$V_FTYP,r2
	mov	$3.,r3
	call	move
	mov	(sp)+,r2
	bcs	2f

	tstb	(r2)+
	beq	done

/ If next is "-" set version to "-1"
/ For Paul.

1:	cmpb	(r2),$'-	/ Well ?
	bne	1f		/ No.
	mov	$-1,r1		/ Use version -1
	br	4f

1:
	clr	r1
0:
	movb	(r2)+,r0
	beq	0f
	sub	$'0,r0
	cmp	r0,$7
	bhi	2f
	asl	r1
	asl	r1
	asl	r1
	add	r0,r1
	br	0b

2:
	mov	$IE.BNM,r0
	br	9f

0:
4:
	mov	r1,V_FVER(r4)


/
/ Assign the lun to the device in V_DVNM and V_UNIT.
/

done:
	mov	V_UNIT(r4),-(sp)
	mov	V_DVNM(r4),-(sp)
	mov	V_LUN(r4),-(sp)
	mov	$7.+[4.<<8.],-(sp)
	emt	377		/ALUN$S
	bcc	0f
	mov	_dsw,r0
	br	9f

/
/ Get information regarding the lun.
/

0:
	mov	r5,-(sp)
	add	$LBUF,(sp)
	mov	V_LUN(r4),-(sp)
	mov	$5.+[3.<<8.],-(sp)
	emt	377		/GLUN$S

/
/ Record device.
/ Set the record flag, and the tty flag if required.
/ Set V_RBSZ from the device record size.
/

	mov	LBUF+4(r5),r0
	bit	$FD.REC,r0
	beq	0f
	bis	$VF_REC,V_FLAG(r4)
	mov	LBUF+12(r5),V_RBSZ(r4)
	bit	$FD.TTY,r0
	beq	7f
	bis	$VF_TTY,V_FLAG(r4)
	br	7f

/
/ Block device.
/ Set default record size.
/ If no filename (or not a directory
/ device) skip the file access, but set
/ FCS attributes for 512 byte fixed
/ length records.
/

0:	mov	V_FNAM(r4),r1
	bis	V_FTYP(r4),r1
	beq	0f
	bit	$FD.DIR,r0
	bne	1f

0:	mov	$512.,V_RBSZ(r4)	/Make large enough
	movb	$R.FIX,V_RTYP(r4)
	clrb	V_RATT(r4)
	mov	$512.,V_RSIZ(r4)
	br	7f

1:	bis	$VF_FIL,V_FLAG(r4)
	mov	$133.,V_RBSZ(r4)   / Handle an LP:

/
/ Set directory id to the mfd (-1,-1).
/ Then perform lookup on the ufd, if required.
/

	mov	$-1,V_DID(r4)
	mov	$-1,V_DID+2(r4)

	bit	$FD.SDI,r0	/single directory device?
	bne	0f

	mov	r4,r0		/Save user filename
	add	$V_FNAM,r0
	mov	r5,r1
	add	$LBUF,r1
	mov	(r0)+,(r1)+
	mov	(r0)+,(r1)+
	mov	(r0)+,(r1)+
	mov	(r0)+,(r1)+
	mov	(r0),(r1)

	mov	$-1,(r0)	/Reset to ufd
	mov	$15172,-(r0)	/DIR in radix 50
	clr	-(r0)
	mov	UIC+2(r5),-(r0)
	mov	UIC(r5),-(r0)

	mov	r4,-(sp)
	add	$V_FID,(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	$IO.FNA,r0
	call	__qiow
	bcc	0f
	cmp	r0,$IE.NSF	/Create no directory error
	bne	9f
	mov	$IE.BDR,r0
	br	9f

0:
	mov	V_FID(r4),V_DID(r4)
	mov	V_FID+2(r4),V_DID+2(r4)
	clr	V_FID(r4)

	mov	r5,r0		/Restore user filename
	add	$LBUF,r0
	mov	r4,r1
	add	$V_FNAM,r1
	mov	(r0)+,(r1)+
	mov	(r0)+,(r1)+
	mov	(r0)+,(r1)+
	mov	(r0)+,(r1)+
	mov	(r0),(r1)

/
/ Lookup the user's file.
/

0:
	clr	RATT(r5)	/Read attributes not done

	mov	r4,-(sp)
	add	$V_FID,(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	$IO.FNA,r0
	call	__qiow
	bcc	1f

/
/ If the error is file not found and the access mode
/ is writing or appending, create the file.
/

	tst	R(r5)
	bne	9f
	cmp	r0,$IE.NSF
	bne	9f

	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	r4,-(sp)
	add	$V_FID,(sp)
	mov	$IO.CRE,r0
	call	__qiow
	bcs	9f

	tst	V_FVER(r4)		/ Bad. version ?
	bgt	0f			/ No.
	mov	$1,V_FVER(r4)		/ Make OK.

0:	mov	r4,-(sp)
	add	$V_FID,(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	mov	$IO.ENA,r0
	call	__qiow
	bcs	9f

/
/ Fake the read attributes.
/

	inc	RATT(r5)	/Set read done

	mov	r4,r0
	add	$V_RTYP,r0
	movb	$R.VAR,(r0)+
	movb	$FD.CR,(r0)+
	clr	(r0)+
	clr	(r0)+
	clr	(r0)+
	clr	(r0)+
	mov	$1,(r0)+
	clr	(r0)+

/
/ Access the file.
/ This will also read the attributes, if necessary.
/

1:
	mov	$[-4&377]+[16<<8.],RATBK(r5)
	mov	r4,RATBK+2(r5)
	add	$V_RTYP,RATBK+2(r5)
	clr	RATBK+4(r5)

	clr	-(sp)
	mov	$100000,-(sp)
	clr	-(sp)
	clr	-(sp)
	clr	-(sp)
	tst	RATT(r5)
	bne	0f
	mov	r5,(sp)
	add	$RATBK,(sp)
0:
	mov	r4,-(sp)
	add	$V_FID,(sp)
	mov	$IO.ACR,r0
	tst	R(r5)
	bne	0f
	mov	$IO.ACE,r0
0:
	call	__qiow
	bcs	9f

7:
	clc
	return

9:
	sec
	return

/
/ `Getuic', with a little help from his friend
/ `getf', parses a uic string and stuffs the
/ result (in radix50) into UIC(r5) and UIC+2(r5).
/ These words are used as the first 2 words of
/ the UFD name.
/

getuic:
	call	getf		/Group
	bcs	0f
	mov	r3,UIC(r5)

	cmpb	(r2)+,$',
	bne	0f

	call	getf		/User
	bcs	0f
	mov	r3,UIC+2(r5)

	cmpb	(r2)+,$']
	bne	0f
	clc
	return

0:
	mov	$IE.BDI,r0
	sec
	return

getf:
	clr	r1
0:
	movb	(r2)+,r0	/Convert to binary
	sub	$'0,r0
	cmp	r0,$7
	bhi	0f
	asl	r1		/ash $3,r1
	asl	r1		/
	asl	r1		/
	add	r0,r1
	br	0b

0:
	dec	r2
	cmp	$377,r1
	blo	0f		/Illegal field

	clr	r3		/Convert to rad50
	swab	r1		/ash $7,r1
	asrb	r1		/
	ror	r1		/
	call	1f
	call	1f
	call	1f
	clc

0:
	return

1:
	clr	r0		/Convert 1 digit
	asl	r1		/ashc $3,r0
	rol	r0		/
	asl	r1		/
	rol	r0		/
	asl	r1		/
	rol	r0		/
	call	mul503		/mul $50,r3
	add	r0,r3
	add	$36,r3
	return

/
/ Move a field of characters, performing an ascii
/ to radix 50 conversion along the way.
/ A short source field is padded with blanks.
/
/ r0=input count
/ r1=input pointer
/ r2=output pointer
/ r3=output count (mod 3)
/

move:
	cmp	r3,r0		/Check for too long
	blo	1f

0:
	mov	r3,-(sp)
	mov	r2,-(sp)
	clr	r3
	call	movec
	bcs	0f
	call	movec
	bcs	0f
	call	movec
	bcs	0f
	mov	(sp)+,r2
	mov	r3,(r2)+
	mov	(sp)+,r3
	sub	$3,r3
	bne	0b
	clc
	br	1f

0:
	mov	(sp)+,r2
	mov	(sp)+,r3
1:
	return

movec:
	clr	r2		/Pad with blanks
	dec	r0
	bmi	1f

	movb	(r1)+,r2	/Convert to rad50
	cmp	r2,$' 
	blo	0f
	beq	2f

	cmp	r2,$'$
	beq	3f

	cmp	r2,$'.
	beq	4f

	cmp	r2,$'0
	blo	0f
	cmp	r2,$'9
	blos	4f

	cmp	r2,$'A
	blo	0f
	cmp	r2,$'Z
	blos	5f

	cmp	r2,$'a
	blo	0f
	cmp	$'z,r2
	blo	0f

	sub	$40,r2
5:
	sub	$56,r2
4:
	sub	$11,r2
3:
	add	$27,r2
2:
	sub	$40,r2

1:
	call	mul503		/mul $50,r3
	add	r2,r3
	clc

0:
	return
 
/
/ r3 = 050 * r3
/
 
mul503:
	asl	r3
	asl	r3
	asl	r3
	mov	r3,-(sp)
	asl	r3
	asl	r3
	add	(sp)+,r3
	return
