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

Text File | 1988-05-21 | 8KB | 649 lines

    include    BDSYM.EQU
    include    EPDATA

    .comment    `
functions INJECT, FPREFIX, NEWFONTS, LOADI, SAVEI, termput



inject(num)
int num;
{    char i, numfb[10];

            `
numfb    equ    80H

inject::
    pop    d
    pop    h
    push    h
    push    d

    xchg
    lxi    h,val + 54*('R'-'@') + 2*('N'-'@')
    mov    a,m
    mvi    m,0
    xchg

    ora    a
    jnz    roman

    push    b
;    if (!num) {stowc('0'); return; }

    mov    a,h
    ora    l
    jnz    nj1
    lxi    h,'0'
    push    h
    call    stowc##
    pop    d
    pop    b
    ret

;    i = 0;
nj1:    mvi    b,0
    lxi    d,numfb

;    while (num)
.nj2:
    mov    a,h
    ora    l
    jz    .nj3
;    {    numfb[i++] = '0' + (num % 10);

    push    h
    push    d
    lxi    d,10
    xchg
    call    usmod    ;was smod
    mov    a,l
    adi    '0'
    pop    d
    stax    d
    inx    d
    inr    b
    pop    h

;        num = num / 10;
;    }

    push    d
    lxi    d,10
    xchg
    call    usdiv    ;was sdiv
    pop    d
    jmp    .nj2

;    while (i) stowc(numfb[--i]);
.nj3:
    mov    a,b
    ora    a
    jz    .nj4

    dcr    b
    dcx    d
    ldax    d
    mov    l,a
    mvi    h,0
    push    d
    push    h
    call    stowc##
    pop    d
    pop    d
    jmp    .nj3
.nj4:
    pop    b
    ret

;use 80h, since it seems not to be used
;numfb:    ds    10


    .comment    `
(In this version, 'ns' is not used -- we just stow the characters)

roman(arg,ns)
int arg; char *ns;
{    int factr, t, rv;
    char rs[3], *nref, *sref, *rrs;

    *ns = '\0';
    factr = 1000;
    sref = "mdclxvi";
    nref = "1954";

    if (arg)
    for (t = 4; t <= 16; t++)
    {    rrs = rs;
        if (t&1) *rrs++ = sref[2*(t/4)];
        *rrs++ = sref[t/2 - 2];
        *rrs = '\0';
        rv = factr * (nref[t % 4] - '0');
        while (arg >= rv)
        {    strcat(ns, rs);
            arg -= rv;
        }
        if (!(t % 4)) factr /= 10;
    }
}            `


roman:
    mov    a,h
    ora    l
    rz
    shld    arg

    lxi    h,1000
    shld    factr

    push    b

;keep 't' in b
    mvi    b,4
.r1:
;    lxi    h,rs
;    shld    rrs
;keep 'rrs' on stack
    lxi    h,rs
    push    h

    mov    a,b
    ani    1
    jz    .r2

    mov    a,b
    rar        ;(carry is clear)
    ani    0feh
    mov    e,a
    mvi    d,0
    lxi    h,sref
    dad    d
    mov    e,m

;    lhld    rrs
    pop    h
    mov    m,e
    inx    h
;    shld    rrs
    push    h
.r2:
    mov    a,b
    ora    a
    rar
    dcr    a
    dcr    a
    mov    e,a
    mvi    d,0
    lxi    h,sref
    dad    d
    mov    e,m

;    lhld    rrs
    pop    h
    mov    m,e
    inx    h
;    shld    rrs
    push    h

    mvi    m,0

    mov    a,b
    ani    3
    mov    e,a
;    mvi    d,0    (D still 0)
    lxi    h,nref
    dad    d
    mov    a,m

    lhld    factr
    xchg

    mov    l,a
    mvi    h,0

    call    usmul

    shld    rv

.r3:
    lhld    arg
    xchg
    lhld    rv
    call    cmh
    dad    d
    mov    a,h
    ora    a
    jm    .r4
    shld    arg

    lxi    d,rs
.r3a:    ldax    d
    inx    d
    ora    a
    jz    .r3
    push    d
    mov    e,a
    mvi    d,0
    push    d
    call    stowc##
    pop    d
    pop    d
    jmp    .r3a

.r4:
    mov    a,b
    ani    3
    jnz    .r5

    lhld    factr
    lxi    d,10
    xchg
    call    usdiv
    shld    factr

.r5:
    inr    b
    mov    a,b
    cpi    16+1
    pop    h    ;discard rrs
    jc    .r1
    pop    b
    ret

arg:    dw    0
factr:    dw    0
rv:    dw    0
rs:    db    0,0,0
;rrs:    dw    0
sref:    db    'mdclxvi'
nref:    db    1,9,5,4



    .comment    `

/************************************************/
/* Form prefix for filename            */
/************************************************/
fprefix(name)
char *name;
{
    if (val['U'-'@']['S'-'@'])
    {    if (val['U'-'@']['S'-'@'] > 9)
            *name++ = val['U'-'@']['S'-'@']/10 + '0';
        *name++ = (val['U'-'@']['S'-'@'] % 10) + '0';
        *name++ = '/';
    }

    if (val['D'-'@']['I'-'@'])
    {    *name++ = val['D'-'@']['I'-'@'] + '@';
        *name++ = ':';
    }

    *name = '\0';
}            `

fprefix::
    pop    d
    pop    h
    push    h
    push    d

;    if (val['U'-'@']['S'-'@'])

    lda    val + 54*('U'-'@') + 2*('S'-'@')
    ora    a
    jz    .pre2
;    {    if (val['U'-'@']['S'-'@'] > 9)

    cpi    10
    jc    .pre1
;            *name++ = val['U'-'@']['S'-'@']/10 + '0';
    mvi    d,'0'
.1:    sui    10
    jz    .3
    jm    .2
    inr    d
    jmp    .1
.2:    adi    10
.3:    mov    m,d
    inx    h

;        *name++ = (val['U'-'@']['S'-'@'] % 10) + '0';
.pre1:
    adi    '0'
    mov    m,a
    inx    h
;        *name++ = '/';

    mvi    m,'/'
    inx    h

;    }
;
;    if (val['D'-'@']['I'-'@'])
.pre2:
    lda    val + 54*('D'-'@') + 2*('I'-'@')
    ora    a
    jz    .pre3
;    {    *name++ = val['D'-'@']['I'-'@'] + '@';

    adi    '@'
    mov    m,a
    inx    h

;        *name++ = ':';
;    }
    mvi    m,':'
    inx    h
;
;    *name = '\0';
;}
.pre3:
    mvi    m,0
    ret


    .comment    `
(assembler version is entirely different)

    /* mark each font "not loaded yet"    */
newfonts()
{    int i;
    for (i=0; i<NUMFTS; i++)
    {    if (ftp[i]) free(ftp[i]);
        ftname[i][0] = ftp[i] = 0;
    }

    for (i=0; i<32; i++) attach[i] = 0;

    /* next font to load is the first one    */
    nextft = 0;

}            `


newfonts::

    call    freeall##

    xra    a
    sta    nextft

    lxi    h,ftp
    mvi    e,NUMFTS*2
    call    .fille

    lxi    h,ftname
    mvi    e,NUMFTS*LENFTN
    call    .fille

    lxi    h,attach
    mvi    e,32*2

.fille:
    mov    m,a
    inx    h
    dcr    e
    rz
    jmp    .fille


    .comment    `
/************************************************/
/* Load initialization data            */
/************************************************/
loadi(n)
int n;
{    int fd;
    char *iname;

    iname = "ep.ini";
    if (n) iname[6] = '0' + n;

    if ((fd = open(iname,0)) == ERROR)
        eperror(113);
    if (read(fd, val, 21) != 21)
        eperror(114);
    fabort(fd);

}


/************************************************/
/* Save current values as new initialization data*/
/*    (not used now)                */
/************************************************/
savei(n)
int n;
{    int fd, i;
    char *iname;

    iname = "ep.ini";
    if (n) iname[6] = '0' + n;
/* '6' should have been '5' here */
    if ((fd = creat(iname,1)) == ERROR)
        eperror(115);
    if (write(fd, val, 21) != 21)
        eperror(116);
    if (close(fd) == ERROR)
        eperror(117);
}




/************************************************/
/* Load initialization data            */
/************************************************/
loadi(n)
int n;
{    int fd;
    char *iname;
            `
loadi::
    pop    d
    pop    h
    push    h
    push    d

;    iname = "ep.ini";

;    if (n) iname[6] = '0' + n;

    call    .digext

;
;    if ((fd = open(iname,0)) == ERROR)
;        eperror(113);
    lxi    h,0
    push    h
    lxi    h,$epini
    push    h
    call    open##
    pop    d
    pop    d
    inx    h
    mov    a,h
    ora    l
    jnz    .ldi2
    lxi    h,113
    push    h
    call    eperror##

;    if (read(fd, val, 21) != 21)
;        eperror(114);
.ldi2:
    dcx    h
    push    h    ;fd for fabort, below
    lxi    d,21
    push    d
    lxi    d,val
    push    d
    push    h    ;still fd
    call    read##
    pop    d
    pop    d
    pop    d
    lxi    d,-21
    dad    d
    mov    a,h
    ora    l
    jz    .ldi3
    lxi    h,114
    push    h
    call    eperror##

;    fabort(fd);
;
;}
.ldi3:
;    push    h    (still on stack)

    pop    h
    mov    a,l
    call    fabort##
;    pop    d
    ret

$epini:    db    'ep.ini',0

    .comment    `

/************************************************/
/* Save current values as new initialization data*/
/*    (not used now)                */
/************************************************/
savei(n)
int n;
{    int fd, i;
    char *iname;
            `
savei::
    pop    d
    pop    h
    push    h
    push    d


;    iname = "ep.ini";

;    if (n) iname[6] = '0' + n;

    call    .digext

;
;    if ((fd = creat(iname,1)) == ERROR)
;        eperror(115);
.svi1:    lxi    h,1
    push    h
    lxi    h,$epini
    push    h
    call    creat##
    pop    d
    pop    d
    inx    h
    mov    a,h
    ora    l
    jnz    .svi2
    lxi    h,115
    push    h
    call    eperror##

;    if (write(fd, val, 21) != 21)
;        eperror(116);
.svi2:
    dcx    h
    push    h    ;fd for close

    lxi    d,21
    push    d
    lxi    d,val
    push    d
    push    h
    call    write##
    pop    d
    pop    d
    pop    d

    lxi    d,-21
    dad    d
    mov    a,h
    ora    l
    jz    .svi3

    lxi    h,116
    push    h
    call    eperror##


;    if (close(fd) == ERROR)
;        eperror(117);
;}
.svi3:
;    push    h
;    call    close##
    call    .close
    pop    d
    inx    h
    mov    a,h
    ora    l
    rnz
    lxi    h,117
    push    h
    call    eperror##


.digext:
    mvi    e,'i'
    mov    a,l
    ora    a
    jz    .dx1
    adi    '0'
    mov    e,a
.dx1:    lxi    h,$epini+5
    mov    m,e
    ret


;TERMPUT - put char to console if not QC; truncate overlong lines
termput::
    mov    e,a
    lda    val + 54*('P'-'@') + 2*('T'-'@')
    ora    a
    jnz    .tpu1
    lda    val + 54*('Q'-'@') + 2*('C'-'@')
    ora    a
    rnz
.tpu1:    lxi    h,termcnt
    inr    m
    mov    a,e
    cpi    7fh
    jc    $+5
    mvi    e,' '
    cpi    ' '
    jnc    .tpu2
    mvi    e,':'
    cpi    0ah
    jnz    .tpu2
    mov    e,a
    mvi    m,1
.tpu2:
    mov    a,m
    cpi    79
    rnc
;    mov    l,e
;    mvi    h,0
;    push    h
    mov    a,e
    jmp    putchar##
;    call    putchar##
;    pop    h
;    ret

    end