.enabl	mcl
.module	LRGFRE,version=01,comment=<Largest-free-space function>
.psect	$DIR.I,rw,i,lcl,rel,con
.rem	%
FORTRAN callable function to return the largest free space on a device.
(Will optionally return second largest as well)
Calling method:
	I = LRGFRE  ( DEV , ISIZ1 [,IBLK1 [,ISIZ2,IBLK2 [,IERR ] ] ] )
  or	CALL LRGFRE ( DEV , ISIZ1 [,IBLK1 [,ISIZ2,IBLK2 [,IERR ] ] ] )
	Where:
		DEV	is RAD50 device specification (may be first part of
			a file specification)
	    (INTEGER*2 parameters)
		ISIZ1	returns size of largest free space on device.
			(= 0 if no free space)
		IBLK1	(optional) returns block number of largest free
			space on device. (=0 if no free space)
		ISIZ2	(optional) returns size of second largest free space
			on device. (= 0 if there is only one free space)
		IBLK2	(optional) returns block number of second largest free
			space on device. ( =0 if there is only one free space)
		IERR	(optional) error code = same as functional value
	Comments:
		IBLK1 may be left blank, but if so, comma must be included to
		separate ISIZ2. (e.g. CALL LRGFRE (3RSY , IS1,,IS2)
	Returned value: (identical to IERR)
		I = 	 0	no errors
			 1	read error on device
			 2	no I/O channel available
			-1	invalid directory
			-2	no free space on device
			-3	device not found
			-4	device handler not in memory
			-5	device not file-structured
%

d$seg	==: 31.
segsiz	==: 512.
d.tota	==: 0
d.next	==: 2
d.high	==: 4
d.extr	==: 6
 d$xtra	==: 238.
d.strt	==: 10
d.leng	==: 12
e.stat	==: 0
e.name	==: 2
e.leng	==: 10
e.used	==: 12
e.chan	==: 12
e.jnum	==: 13
e.date	==: 14
e.elen	==: 16
e.tent	==: 400
e.mpty	==: 1000
e.perm	==: 2000
e.eos	==: 4000
e.prot	==: 100000
lrgfre::nop
	clr	error
	.dstat	#area,2(r5)
	bcc	10$
5$:	mov	#-3,error
	br	22$
10$:	tst	area+4
	bne	15$
	mov	#-4,error
	br	22$
15$:	tst	area
	bmi	20$
	mov	#-5,error
	br	22$
20$:	mov	#device,r4
	mov	@2(r5),(r4)+
	clr	(r4)+
	clr	(r4)+
	clr	(r4)+
	call	igetc
	mov	r0,r1
	bpl	25$
	mov	#2,error
22$:	call	report
	mov	error,r0
	return
25$:	.lookup	#area,r1,#device
	bcc	30$
	mov	#-3,error
	br	finish
30$:	clr	siz1
	mov	#dirbuf,r2
	clr	$nxtfl
	mov	#1,$nxtsg
loop:	call	nextfl
	bcc	10$
	mov	r0,error
	bmi	finish
	mov	#1,error
	br	finish
10$:	tst	r0
	beq	20$
	bit	#e.mpty,(r0)
	beq	loop
	cmp	flen,siz1
	blos	15$
	mov	siz1,siz2
	mov	blk1,blk2
	mov	flen,siz1
	mov	stblok,blk1
	br	loop
15$:	cmp	flen,siz2
	blos	loop
	mov	flen,siz2
	mov	stblok,blk2
	br	loop
20$:	call	report
	tst	siz1
	bne	finish
	mov	#-2,error
finish:	mov	r1,$nxtfl
	mov	#freec,r5
	call	ifreec
	mov	error,r0
	return
report:	mov	(r5)+,r4
	dec	r4
	ble	20$
	tst	(r5)+
	mov	#siz1,r3
5$:	cmp	(r5),#-1
	beq	10$
	mov	(r3)+,@(r5)+
	br	15$
10$:	cmp	(r3)+,(r5)+
15$:	sob	r4,5$
20$:	return
.sbttl	nextfl
$errby	= 52
nextfl:	jsr	r5,$savrg
5$:	mov	$nxtfl,r0
	bne	40$
	mov	$nxtsg,r5
	beq	60$
	mov	r2,r4
	mov	r4,$nxtfl
	add	#d.leng,$nxtfl
	asl	r5
	add	#4,r5
	.readw	#area,r1,r4,#segsiz,r5
	bcc	10$
	movb	@#$errby,r0
	br	80$
10$:	cmp	r5,#6
	bne	15$
	mov	d.high(r4),hiseg
	mov	d.tota(r4),avail
	ble	30$
	cmp	#d$xtra,d.extr(r4)
	blo	30$
	bit	#1,d.extr(r4)
	bne	30$
	mov	d.extr(r4),xtrab
15$:	cmp	d.extr(r4),xtrab
	bne	30$
	cmp	#d$seg,d.tota(r4)
	blo	30$
	cmp	hiseg,d.next(r4)
	blo	30$
20$:	mov	d.next(r4),$nxtsg
	mov	d.strt(r4),stblok
	beq	30$
	clr	flen
	br	5$
30$:	mov	#-1,r0
	br	70$
40$:	bit	#e.eos,(r0)
	beq	50$
	clr	$nxtfl
	br	60$
50$:	add	#e.elen,$nxtfl
	add	xtrab,$nxtfl
	add	flen,stblok
	mov	e.leng(r0),flen
60$:	tst	(pc)+
70$:	sec
80$:	return
.sbttl	$nxent
$nxent:	add	#e.elen,r5
	add	d.extr(r4),r5
	mov	r4,-(sp)
	add	#segsiz*2-1,(sp)
	cmp	(sp)+,r5
	return
.psect	$DIR.D,rw,d,lcl,rel,con
area:	.blkw	5
device:
siz1:	.word	0
blk1:	.word	0
siz2:	.word	0
blk2:	.word	0
error:	.word	0
freec:	.word	1,$nxtfl
$nxtfl:	.word	0
avail:	.word	0
$nxtsg:	.word	0
stblok:	.word	0
flen:	.word	0
hiseg:	.word	0
xtrab:	.word	0
dirbuf:	.blkw	segsiz
	.end
                      