include	BDS.LIB


lod	macro
	mov	e,m
	inx	h
	mov	d,m
	endm

sto	macro
	mov	m,e
	inx	h
	mov	m,d
	endm

ind	macro
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a
	endm

	.comment	`
functions ALLOC, FREE, and FREEALL


/*
 * Storage allocation data, used by "alloc" and "free"
 */

struct _header  {
	struct _header *_ptr;
	unsigned _size;
 };

struct _header _base;		/* declare this external data to  */
struct _header *_allocp;	/* be used by alloc() and free()  */
			`
._ptr	equ	0
._size	equ	2

	.comment	`
/*
	Storage allocation functions:
*/

char *alloc(nbytes)
unsigned nbytes;
{
	struct _header *p, *q, *cp;
	int nunits; 
	nunits = 1 + (nbytes + (sizeof (_base) - 1)) / sizeof (_base);
	if ((q = _allocp) == NULL) {
		_base._ptr = _allocp = q = &_base;
		_base._size = 0;
	 }
	for (p = q -> _ptr; ; q = p, p = p -> _ptr) {
		if (p -> _size >= nunits) {
			_allocp = q;
			if (p -> _size == nunits)
				_allocp->_ptr = p->_ptr;
			else {
				q = _allocp->_ptr = p + nunits;
				q->_ptr = p->_ptr;
				q->_size = p->_size - nunits;
				p -> _size = nunits;
			 }
			return p + 1;
		 }
		if (p == _allocp) {
			if ((cp = sbrk(nunits *	 sizeof (_base))) == ERROR)
				return NULL;
			cp -> _size = nunits; 
			free(cp+1);	/* remember: pointer arithmetic! */
			p = _allocp;
		}
	 }
}



			`


alloc::
;	pop	d
;	pop	h
;	push	h
;	push	d

;	push	b	;(not yet used)

;	shld	nbytes

;	nunits = 1 + (nbytes + (sizeof (_base) - 1)) / sizeof (_base);


;	lhld	nbytes
; + (4 - 1)
	inx	h
	inx	h
	inx	h
;	lxi	d,4
;	xchg
;	call	usdiv
	mvi	e,2
	call	shlrbe

	inx	h	;1 +
	shld	nunits

;	if ((q = _allocp) == NULL) {
	lhld	_allocp
	shld	a$q
	mov	a,h
	ora	l
	jnz	.alc1

;		_base._ptr = _allocp = q = &_base;

	lxi	h,_base
	shld	a$q
	shld	_allocp
	shld	_base+._ptr

;		_base._size = 0;
;	 }
	lxi	h,0
	shld	_base+._size

;	for (p = q -> _ptr; ; q = p, p = p -> _ptr) {
.alc1:
	lhld	a$q
	ind
	shld	a$p

;		if (p -> _size >= nunits) {
.alc2:
	lhld	a$p
	inx	h
	inx	h
	lod

	lhld	nunits

	call	albu
	jc	.alc5

;			_allocp = q;
	lhld	a$q
	shld	_allocp

;			if (p -> _size == nunits)

	lhld	a$p
	inx	h
	inx	h
	lod

	lhld	nunits
	call	eqwel
	jnz	.alc3

;				_allocp->_ptr = p->_ptr;

	lhld	a$p
	lod

	lhld	_allocp
	sto
	jmp	.alc4
;			else {
;				q = _allocp->_ptr = p + nunits;
.alc3:

	lhld	a$p
	xchg
	lhld	nunits
	dad	h
	dad	h	;4 bytes per _header
	dad	d

	shld	a$q	;q =

	xchg		;_allocp->_ptr =
	lhld	_allocp
	sto

;				q->_ptr = p->_ptr;

	lhld	a$p
	lod
	lhld	a$q
	sto
;				q->_size = p->_size - nunits;

	lhld	a$p
	inx	h
	inx	h
	lod

	lhld	nunits
	call	cmh
	dad	d

	xchg
	lhld	a$q
	inx	h
	inx	h
	sto
;				p -> _size = nunits;

	lhld	nunits
	xchg

	lhld	a$p
	inx	h
	inx	h
	sto
;			 }
;			return p + 1;
;		 }
.alc4:
	lhld	a$p
	inx	h
	inx	h
	inx	h
	inx	h
;	jmp	.alc8
	ret
;		if (p == _allocp) {
.alc5:
	lhld	a$p
	xchg
	lhld	_allocp
	call	eqwel
	jnz	.alc7
;			if ((cp = sbrk(nunits *	 sizeof (_base))) == ERROR)
	lhld	nunits
;*4
	dad	h
	dad	h

;	push	h
	call	sbrk
;	pop	d

	shld	a$cp

	inx	h
	mov	a,h
	ora	l
	rz
;	jnz	.alc6
;				return NULL;
;	lxi	h,0
;	jmp	.alc8
;			cp -> _size = nunits; 
.alc6:

	lhld	nunits
	xchg
	lhld	a$cp
	inx	h
	inx	h
	sto

;			free(cp+1);	/* remember: pointer arithmetic! */
	lhld	a$cp
	inx	h
	inx	h
	inx	h
	inx	h
;;	push	h
	call	free
;;	pop	d
;			p = _allocp;
;		}
;	 }
;}
	lhld	_allocp
	shld	a$p

;(end for-loop action)
;	for (p = q -> _ptr; ; q = p, p = p -> _ptr) {
.alc7:

	lhld	a$p
	shld	a$q

;	lhld	a$p
	ind
	shld	a$p
	jmp	.alc2

;.alc8:
;	pop	b
;	ret

	.comment	`

free(ap)
struct _header *ap;
{
	struct _header *p, *q;

	p = ap - 1;	/* No need for the cast when "ap" is a struct ptr */

	for (q = _allocp; !(p > q && p < q -> _ptr); q = q -> _ptr)
		if (q >= q -> _ptr && (p > q || p < q -> _ptr))
			break;
	if (p + p -> _size == q -> _ptr) {
		p -> _size += q -> _ptr -> _size;
		p -> _ptr = q -> _ptr -> _ptr;
	 }
	else p -> _ptr = q -> _ptr;

	if (q + q -> _size == p) {
		q -> _size += p -> _size;
		q -> _ptr = p -> _ptr;
	 }
	else q -> _ptr = p;

	_allocp = q;
}
			`

free::
;	pop	d
;	pop	h
;	push	h
;	push	d

;	shld	f$ap

;	push	b


;	p = ap - 1;	/* No need for the cast when "ap" is a struct ptr */

;	lhld	f$ap
	dcx	h
	dcx	h
	dcx	h
	dcx	h
	shld	f$p
;
;	for (q = _allocp; !(p > q && p < q -> _ptr); q = q -> _ptr)

	lhld	_allocp
	shld	f$q

.fr1:
	lhld	f$p
	xchg
	lhld	f$q
	call	agbu
	jnc	.fr2

	lhld	f$q
	lod

	lhld	f$p
	xchg
	call	albu
	jc	.fr5

;		if (q >= q -> _ptr && (p > q || p < q -> _ptr))
;			break;
.fr2:

	lhld	f$q
	lod
	xchg
	call	albu
	jc	.fr4

	lhld	f$p
	xchg
	lhld	f$q
	call	agbu
	jc	.fr5

	lhld	f$q
	lod
	lhld	f$p
	xchg
	call	albu
;	jnc	.fr4
;
;.fr3:	jmp	.fr5
	JC	.fr5

;(end for-loop action)
;	for (q = _allocp; !(p > q && p < q -> _ptr); q = q -> _ptr)
.fr4:
	lhld	f$q
	ind
	shld	f$q
	jmp	.fr1

;	if (p + p -> _size == q -> _ptr) {

.fr5:
	lhld	f$p
	push	h

;	lhld	f$p
	inx	h
	inx	h
	ind
	dad	h
	dad	h

	pop	d
	dad	d

	xchg

	lhld	f$q
	ind

	call	eqwel
	jnz	.fr6
;		p -> _size += q -> _ptr -> _size;
	lhld	f$p
	inx	h
	inx	h
	push	h

	lod
	push	d

	lhld	f$q
;q
	ind
;q -> _ptr
	inx	h
	inx	h
	ind
;q -> _ptr -> _size

	pop	d
	dad	d

	xchg
	pop	h
	sto

;		p -> _ptr = q -> _ptr -> _ptr;
;	 }

	lhld	f$q
;q
	ind
;q -> _ptr
	ind
;q -> _ptr -> _ptr

	xchg
	lhld	f$p
	sto
	jmp	.fr7

;	else p -> _ptr = q -> _ptr;
.fr6:

	lhld	f$q
	lod
	lhld	f$p
	sto
;
;	if (q + q -> _size == p) {
.fr7:
	lhld	f$q
	push	h

;	lhld	f$q
	inx	h
	inx	h
	ind
	dad	h
	dad	h

	pop	d
	dad	d

	xchg

	lhld	f$p
	call	eqwel
	jnz	.fr8

;		q -> _size += p -> _size;

	lhld	f$q
	inx	h
	inx	h
	push	h

	lod

	lhld	f$p
	inx	h
	inx	h
	ind

	dad	d

	xchg
	pop	h
	sto

;		q -> _ptr = p -> _ptr;
;	 }

	lhld	f$p
	lod
	lhld	f$q
	sto

	jmp	.fr9

;	else q -> _ptr = p;
.fr8:

	lhld	f$p
	xchg
	lhld	f$q
	sto
;
;	_allocp = q;
;}
.fr9:
	lhld	f$q
	shld	_allocp

;	pop	b
	ret

freeall::
	lxi	h,0
	shld	_allocp
	lhld	freram
	shld	allocp
	ret

;formerly external
_base:		dw	0,0
_allocp:	dw	0

;alloc arg
;nbytes:	dw	0 not needed
;alloc locals
a$p:		dw	0
a$q:		dw	0
a$cp:		dw	0
nunits:		dw	0

;free arg
;f$ap:		dw	0 not needed
;free locals
f$p:		dw	0
f$q:		dw	0



sbrk::
;	call	ma1toh	;get # of bytes needed in HL
;	xchg		;put into DE

;	pop	h
;	pop	d
;	push	d
;	push	h
	xchg

	lhld	allocp	;get current allocation pointer
	push	h	;save it
	dad	d	;get tentative last address of new segment
	jc	brkerr	;better not allow it to go over the top!
	dcx	h
	xchg		; now last addr is in DE
	lhld	alocmx	;get safety factor
	call	cmh
	dad	sp	;get HL = (SP - alocmx)

	XCHG
	CALL	CMPHD
;	call	cmpdh	;is DE less than HL?
	jnc	brkerr	;if not, can't provide the needed memory.
;	xchg		;else OK.
	inx	h
	shld	allocp	;save start of next area to be allocated
	pop	h	;get pointer to this area
	ret		;and return with it.

brkerr:	pop	h	;clean up stack
	jmp	error	;and return with -1 to indicate can't allocate.

;cmpdh:	mov	a,d
;	cmp	h
;	rc
;	rnz
;	mov	a,e
;	cmp	l
;	ret



	.comment	`
puts(s)
char *s;
{
	while (*s) putchar(*s++);
}
			`
puts::
;	pop	d
;	pop	h
;	push	h
;	push	d

.pts1:

	mov	a,m
	ora	a
	rz

	push	h
;	mov	l,a
;	mvi	h,0
;	push	h
	call	putchar
;	pop	d
	pop	h
	inx	h
	jmp	.pts1


	.comment	`
char *strcat(s1,s2)
char *s1, *s2;
{
	char *temp; temp=s1;
	while(*s1) s1++;
	do *s1++ = *s2; while (*s2++);
	return temp;
}			`

strcat::
;	push	b
;	pop	b
;
;	pop	b
;	pop	d
;	pop	b
;	lxi	h,-8
;	dad	sp
;	sphl
;s1 in DE
;s2 in BC
;NO -- now s1 in HL and s2 in DE


;	mov	h,d	;save s1 for return
;	mov	l,e
;NO -- no return used

.sct1:
	mov	a,m
	inx	h
	ora	a
	jnz	.sct1
	dcx	h

;DE points to 0 at end of s1

.sct2:
	ldax	d
	mov	m,a
	inx	d
	inx	h
	ora	a
	jnz	.sct2
	ret


	.comment	`
int strcmp(s1, s2)
char *s1, *s2;
{
	while (*s1 == *s2++)
		if (*s1++ == '\0')
			return 0;
	return (*s1 - *--s2);
}			`

strcmp::
	.comment	`
	push	b
	pop	b

	pop	b
	pop	d
	pop	b
	lxi	h,-8
	dad	sp
	sphl
;s1 in DE
;s2 in BC
	mov	h,b
	mov	l,c
;s2 in HL
	pop	b	;restore mark stack
			`

	XCHG

.1:
	ldax	d
	ora	a
	jz	.2	;end of s1?
	cmp	m
	inx	h
	inx	d
	jz	.1
;here char's differ, and neither is nul
;A still has current char from s1
	dcx	h	;back to current char of s2
.2:	sub	m	;*s1 - *s2
	mov	l,a
	mvi	h,0
	rnc
	dcr	h	;maybe negative sign
	ret


	.comment	`
char *strcpy(s1,s2)
char *s1, *s2;
{
	char *temp; temp=s1;
	while (*s1++ = *s2++);
	return temp;
}			`
strcpy::
	.comment	`
	push	b
	pop	b
	pop	b
	pop	d
	pop	b
	lxi	h,-8
	dad	sp
	sphl
;s1 in DE
;s2 in BC
			`
;NO -- s1 in HL, s2 in DE


;	push	d	;for return s1
;get s1 in HL
;	xchg
;NO -- return not used

.scpy1:
	ldax	d
	mov	m,a
	inx	d
	inx	h
	ora	a
	jnz	.scpy1
	ret

;
; 
; Functions appearing in this file:
;
; 	getchar	kbhit	ungetch	putchar	gets
;	exit
;


getchar::
	lda	ungetl	;any character pushed back?
	ora	a
	mov	l,a
	jz	gch2
	xra	a	;yes. return it and clear the pushback
	sta	ungetl	;byte in C.CCC.
	mvi	h,0
	ret

gch2:	push	b
	mvi	c,conin
	call	.bdos
	pop	b
	cpi	cntrlc	;control-C ?
	jz	.exit	;if so, exit the program.
	cpi	1ah	;control-Z ?
	lxi	h,-1	;if so, return -1.
	rz
	mov	l,a
	cpi	cr	;carriage return?
	jnz	gch3
	push	b
	mvi	c,conout	;if so, also echo linefeed
	mvi	e,lf
	call	.bdos
	pop	b
	mvi	l,newlin	;and return newline (linefeed)..

gch3:	mvi	h,0
	ret

kbhit::
	lda	ungetl	;any character ungotten?
	mvi	h,0
	mov	l,a
	ora	a
	rnz		;if so, return true

	push	b
	mvi	c,cstat	;else interrogate console status
	call	.bdos
	pop	b

	ora	a	;0 returned by BDOS if no character ready
	lxi	h,0
	rz		;return 0 in HL if no character ready
	inr	l	;otherwise return 1 in HL
	ret

putchar::
;	call	ma1toh	;get character in A

;	pop	d
;	pop	h
;	push	h
;	push	d
;	mov	a,l

	push	b
	mvi	c,conout
	cpi	newlin	;newline?
	jnz	put1	;if not, just go put out the character
	mvi	e,cr	;else...put out CR-LF
	call	.bdos
	mvi	c,conout
	mvi	a,lf

put1:	mov	e,a
	call	.bdos

put2:	mvi	c,cstat	;now, is input present at the console?
	call	.bdos
	ora	a
	jnz	put3
	pop	b	;no...all done.
	ret

put3:	mvi	c,conin	;yes. sample it (this will always echo the
	call	.bdos	;	character to the screen, alas)
	cpi	cntrlc	;is it control-C?
	jz	.exit	;if so, abort and reboot
	pop	b	;else ignore it.
	ret

gets::
;	call	ma1toh	;get destination address

;	pop	d
;	pop	h
;	push	h
;	push	d

	push	b	;save BC
	push	h
	push	h
	lxi	h,-150	;use space below stack for reading line
	dad	sp
	push	h	;save buffer address
	mvi	m,88h	;Allow a max of about 135 characters
	mvi	c,getlin
	xchg		;put buffer addr in DE
	call	.bdos	;get the input line
	mvi	c,conout
	mvi	e,lf	;put out a LF
	call	.bdos
	pop	h	;get back buffer address
	inx	h	;point to returned char count
	mov	b,m	;set B equal to char count
	inx	h	;HL points to first char of line
	pop	d	;DE points to start destination area
copyl:	mov	a,b	;copy line to start of buffer
	ora	a
	jz	gets2
	mov	a,m
	stax	d
	inx	h
	inx	d
	dcr	b
	jmp	copyl
	
gets2:	xra	a	;store terminating null
	stax	d
	pop	h	;return buffer address in HL
	pop	b
	ret



;exit::
;	jmp	.exit

;
; 
; Functions appearing in this file:
;	open	creat	unlink
;	read	write	
;	execl
;



;
; Open:
;	int open(filename,mode)
;	    char *filename;
;
; Open a file for read (mode == 0), write (mode == 1) or both (mode = 2),
; and detect a user-number prefix. Returns a file descriptor.
;

open::
	call	arghak
	xra	a
	call	fgfcb	;any fcb's free?
	jnc	open2	;if not, error
	mvi	a,10	;"no more file slots"
	jmp	error

open2:	sta	tmp
	xchg
	lhld	arg1
	xchg
	push	b
	call	setfcu	;parse name and set usenum
	lda	usrnum
	call	setusr	;set new user number

	mvi	c,openc
	call	.bdos
	cpi	errorv	;successful open?
	pop	b

	mvi	a,11	; set error code in case of error
	jz	oerror	;if error, go abort

	lda	tmp
	call	fgfd	;get HL pointing to fd table entry
	lda	arg2
	ora	a	;open for read?
	mvi	d,3
	jz	open4
	dcr	a
	mvi	d,5
	jz	open4	;write?
	dcr	a
	mvi	a,12	;"bad mode" for open operation...
	jnz	oerror	;...if not mode 2
	mvi	d,7	;else must be mode 2.
open4:	lda	usrnum	;get user number for the file
	add	d	;add r/w bit codes
	mov	m,a	;and store in fd table
	inx	h	;clear max sector number field of fd entry
	xra	a
	mov	m,a
	inx	h
	mov	m,a
	lda	tmp	;get back fd
	mov	l,a
	mvi	h,0
	call	rstusr	;reset user number
	ret

oerror:	call	rstusr	;reset user number
	sta	errnum	;store error code number
	jmp	error	;and return general error condition


;
; Close:
;	close(fd);
;
; Close a file opened via "open" or "creat":
;

;close::
;	jmp	.close	;jump to the close routine in C.CCC


;
; Creat:
;	int creat(filename)
;	    char *filename;
; Creates the named file, first deleting any old versions, and opens it
; for both read and write. Returns a file descriptor.
;

;	ext	unlink,open
creat::
	pop	d
	pop	h
	push	h
	push	d

	push	b
	push	h

;	push	h
	call	unlink	;erase any old versions of file
;	pop	d

	lda	usrnum	;set to appropriate user area computed by "unlink"
	call	setusr
	mvi	c,creatc	;create the file
	lxi	d,fcb	;assume fcb has been set by "unlink"
	call	.bdos
	call	rstusr	;restore previous user number
	cpi	errorv
	pop	h
	pop	b
	jnz	creat0	;if no error, go open
	mvi	a,13	;"can't create file" error code
	sta	errnum
	jmp	error

creat0:	lxi	d,2	;now open for read/write
	push	d
;	lhld	arg1
	push	h
	call	open
	pop	d
	pop	d
	ret


;
; Unlink:
;	unlink(filename)
;	char *filename;
;
; Deletes the named file. User number prefixes are recognized:
;

unlink:
;	call	ma1toh
	push	b
	xchg	
	lxi	h,fcb
	call	setfcu	;parse for fcb and compute user number
	lda	usrnum
	call	setusr	;set to correct user number
	mvi	c,delc	;delete
	call	.bdos
	call	rstusr	;restore original user number
	lxi	h,0
	pop	b	;restore BC
	cpi	errorv	;was BDOS able to find the file?
	rnz		;if so, all done.
	mvi	a,11	;set error code for "file not found"
	sta	errnum
	dcx	h	;return -1
	ret


;
; Fabort:
;	fabort(fd);
; Abort all operations on file fd. Has no effect under MP/M II.
;

fabort::
;	pop	d
;	pop	h
;	push	h
;	push	d
;	mov	a,l

	call	fgfd
	jnc	abrt2	;legal fd?
	mvi	a,7
	sta	errnum	;set "bad fd" error code
	jmp	error
	
abrt2:
	IF NOT MPM2
	mvi	m,0	;clear entry in fd table
	ENDIF

	lxi	h,0
	ret


;
; Read:
;
;	i = read(fd, buf, n);
;
; Read a number of sectors using random-record I/O.
;
; The return value is either the number of sectors successfully
; read, 0 for EOF, or -1 on error with errno() returning the error
; code (or errmsg(n) returning a pointer to an error message).
; 
; The Random Record Field is incremented following each successful
; sector is read, just as if the normal (sequential) read function
; were being used. "seek" must be used to go back to a previous 
; sector.
;

read::

	call	arghak
	lda	arg1
	call	fgfd
	mov	d,m	;save fdt entry in D
	mvi	a,7	;prepare for possible "bad fd"
	jc	rerror

	mov	a,d
	ani	2
	mvi	a,8	;prepare for possible "no read permission"
	jz	rerror

	push	b
	mov	a,d	;get fd table entry
	call	setusr	;set user area to that of the file

	lda	arg1	;get fd
	call	fgfcb
	shld	tmp2	;save fcb address
	lxi	h,0	;clear sector count
	shld	tmp2a
r2:	lhld	arg3	;get countdown
	mov	a,h
	ora	l	;done?
r2aa:	lhld	tmp2a
	jnz	r2a
r2done:	call	rstusr	;reset user number
	pop	b	;yes. return with success count in HL
	ret

r2a:	lhld	arg2	;get transfer addr in DE
	xchg
	mvi	c,sdma	;set DMA there
	call	.bdos

	lhld	tmp2
	xchg
	mvi	c,readr	;code for BDOS random read
	push	d	;save DE so we can fudge nr field if
	call	.bdos	;we stop reading on extent boundary...
	pop	d
	ora	a
	jz	r4	;go to r4 if no problem

	sta	errnum	;otherwise save error code

	cpi	1	;ok, we have SOME kind of hangup...
	jz	r2b	;check for EOF condition:
	cpi	4	;  error codes 1 and 4 both indicate reading
	jz	r2b	;  unwritten data..treat as EOF

	lxi	h,-1	;put ERROR value in HL
	jmp	r2done

r2b:	lhld	tmp2a	;return count
	jmp	r2done

r4:	lhld	arg3	;decrement countdown
	dcx	h
	shld	arg3
	lhld	arg2	;bump DMA address
	lxi	d,128
	dad	d
	shld	arg2
	lhld	tmp2a	;bump success count
	inx	h
	shld	tmp2a
	lhld	tmp2	;get address of fcb
	lxi	b,33	;get addr of random record field
	dad	b
	mov	c,m	;bump
	inx	h	;    value
	mov	b,m	;	  of 
	inx	b	;	    random
	mov	m,b	;		  field
	dcx	h	;			by one
	mov	m,c
	mov	a,b	;overflow past 16-bit record count?
	ora	c
	jnz	r2	; go for next sector if no overflow
	inx	h	;else set 3rd byte of random sector count
	inx	h
	mvi	m,1
	mvi	a,14	;"seek past 65536th record of file"
	sta	errnum
	jmp	r2aa	;and don't read any more.

rerror:	sta	errnum
	jmp	error

;
; Write:
;	i = write(fd, buf, n);
;
; The random sector write function. Returns either the number
; of sectors successfully written, or -1 on hard error. Any return
; value other than n (the third arg) should be considered an error,
; after which errno() can tell you the error condition and errmsg() 
; can return a pointer to an appropriate error message text.
;

write::

	call	arghak
	lda	arg1
	call	fgfd
	shld	arg5	;save pointer to fd table entry
	mov	d,m	;save fd table entry in D
	mvi	a,7	;prepare for possible "bad fd"
	jc	werror

	mov	a,d
	ani	4
	mvi	a,9	;prepare for possible "no write permission"
	jz	werror

	push	b
	mov	a,d	;set user number
	call	setusr
	lda	arg1	;get fd
	call	fgfcb	;compute fcb address
	shld	tmp2	;save it away
	lxi	h,0	;clear success count
	shld	tmp2a

writ1:	lhld	arg3	;done yet?
	mov	a,h
	ora	l
	jnz	writ2

			;take care of maximum sector count for cfsize:
	lhld	tmp2	;get fcb address
	lxi	d,33	;point to random record field
	dad	d
	mov	e,m
	inx	h
	mov	d,m	;DE now holds random record number for next rec
	push	d	;save it
	lhld	arg5	;get fd table pointer
	inx	h	;point to max value
	mov	e,m	;get in DE
	inx	h
	mov	d,m	;now DE is old max value, HL points to end of entry
	xthl		;DE = old max, HL = current sector, STACK = tab ptr
	xchg		;HL = old max, DE = current sector
	call	cmphd	;is  old max less than current sector?
	pop	h	;get tab ptr in HL
	jnc	writ1a	;if old max not < current sector, don't update max
	mov	m,d	;else update max value with new sector number
	dcx	h
	mov	m,e
	
writ1a:	lhld	tmp2a	;if so, return count
wrdone:	call	rstusr	;reset user number
	pop	b
	ret

writ2:	lhld	arg2	;else get transfer address
	push	h	;save on stack
	xchg		;put in DE
	mvi	c,sdma	;set DMA there
	call	.bdos

	pop	h	;get back transfer address
	lxi	d,128	;bump by 128 bytes for next time
	dad	d
	shld	arg2	;save -> to next 128 bytes

	lhld	tmp2	;get addr of fcb
	xchg
	mvi	c,writr	;write random sector
	call	.bdos
	lhld	tmp2a	;get success count in HL
	ora	a	;error?
	jz	writ3	;if not, go do bookkeeping
	
	sta	errnum	;else save error code
	jmp	wrdone
		
writ3:	inx	h	; else bump successful sector count,
	shld	tmp2a

	lhld	arg3	; debump countdown,
	dcx	h
	shld	arg3

	lhld	tmp2	; get address of fcb
	lxi	b,33	; get address of random field
	dad	b
	mov	c,m	; bump 16-bit value at random
	inx	h	; record
	mov	b,m	;	field
	inx	b	;	     of
	mov	m,b	;	       fcb
	dcx	h	;		  by one
	mov	m,c

	mov	a,b	;overflow past 16-bit record count?
	ora	c
	jnz	writ1	; go for next sector if no overflow
	inx	h	;else set 3rd byte of random sector count
	inx	h
	mvi	m,1
	mvi	a,14	;set "past 65536th sector" error code
	sta	errnum
	jmp	writ1a	;and don't read any more.

werror:	sta	errnum
	jmp	error



	end