Oakland CPM Archive/oakcpm.iso/cpm/list/ep-src.ark/NDEFF.MAC

Text File | 1988-05-21 | 20KB | 1,342 lines

    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