ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/BDSC/BDSC-2/L2-225.ARK/SPR.MAC

Text File | 1988-05-21 | 9KB | 655 lines

    .comment    `
Assembler version of BDS-C (v. 2.50) standard library function '_spr'.
Greg Lee, July 1984.
            `


MAXLINE    equ    150    ;maybe this should be 250

; Addresses in C.CCC
agbs    equ    0205H
agbu    equ    01F3H
albs    equ    01FAH
albu    equ    01ECH
bgas    equ    0204H
bgau    equ    01F2H
blas    equ    01F9H
blau    equ    01EBH
cmd    equ    0302H
cmh    equ    02FAH
cmphd    equ    02DDH
eqwel    equ    01E5H
mapuc    equ    059EH
pcind    equ    01CDH
pcinh    equ    01A9H
pmind    equ    01DFH
pminh    equ    01BBH
pncind    equ    01D3H
pncinh    equ    01AFH
pnzind    equ    01C7H
pnzinh    equ    01A3H
ppind    equ    01D9H
ppinh    equ    01B5H
pzind    equ    01C1H
pzinh    equ    019DH
sdiv    equ    02CBH
sdli    equ    0190H
shllbe    equ    02F3H
shlrbe    equ    02E5H
smod    equ    020FH
smul    equ    023FH
usdiv    equ    0289H
usmod    equ    0229H
usmul    equ    026BH



    .comment    `

_spr(fmt,putcf,arg1)
int (*putcf)();
char **fmt;
{
    char _uspr(), c, base, *sptr, *format;
    char wbuf[MAXLINE], *wptr, pf, ljflag, zfflag;
    int width, precision,  *args;
            `

_spr::
    pop    d
;
    pop    h
;    shld    fmt    (save 2 bytes by reusing args)
    shld    args

    pop    h
    shld    putcf
    pop    h
    shld    arg1
; fix back stack
    push    h
    push    h
    push    h
    push    d

    push    b
;BC will hold format

    lxi    h,-MAXLINE    ;still use stack for wbuf
    dad    sp
    sphl
    shld    wbuf
;
;    format = *fmt++;    /* fmt first points to the format string    */

;    lhld    fmt
    lhld    args    ;args was used to hold fmt
    mov    c,m    ;BC = format
    inx    h
    mov    b,m
    inx    h
;    shld    fmt    ;fmt is not subsequently used, so why save it?
    shld    args    ;cf. next statement

;    args = fmt;        /* now fmt points to the first arg value    */

;
;    while (c = *format++)

.p1:
    ldax    b
    inx    b
    ora    a
    jz    .pxOK

;      if (c == '%') {

;c in in A reg.
    cpi    '%'
    jnz    .default

;        wptr = wbuf;

    lhld    wbuf
    shld    wptr

;        precision = 6;

    lxi    h,6
    shld    precision

;        ljflag = pf = zfflag = 0;

    xra    a
    sta    ljflag
    sta    pf
    sta    zfflag

;
;        if (*format == '-') {

    ldax    b
    cpi    '-'
    jnz    .p2

;            format++;
    inx    b

;            ljflag++;

    sta    ljflag

;         }
;
;
;        if (*format == '0') zfflag++;    /* test for zero-fill */

.p2:
    ldax    b
    cpi    '0'
    jnz    .p3
    sta    zfflag
;
;        width = (isdigit(*format)) ? _gv2(&format) : 0;

.p3:
    lxi    h,0    ;width if not digit
;    cpi    '0'    ;already compared above
    jc    .p4
    cpi    '9'+1
    cc    _gv2    ;now uses 'format' (in BC) directly, so no need
            ; to pass it
.p4:    shld    width
;
;        if ((c = *format++) == '.') {

    ldax    b
    inx    b
    cpi    '.'
    jnz    .p6

;            precision = _gv2(&format);

    call    _gv2
    shld    precision

;            pf++;

    lxi    h,pf
    inr    m
;            c = *format++;

    ldax    b
    inx    b

;         }
;
;        switch(toupper(c)) {

.p6:
    cpi    'a'
    jc    .p7
    cpi    'z'+1
    jnc    .p7
    ani    5FH
.p7:
    cpi    'D'
    jz    .decimal
;for next  few branches, value in E will be put in 'base'
    cpi    'U'
    mvi    e,10
    jz    .bval
    cpi    'X'
    mvi    e,16
    jz    .bval
    cpi    'O'
    mvi    e,8
    jz    .bval
    cpi    'C'
    jz    .char
    cpi    'S'
    jz    .string
    cpi    0
    jz    .pxOK
.default:
    call    c_putcf
    jmp    .p1

;
;        case 'D':  if (*args < 0) {
;                *wptr++ = '-';
;                *args = -*args;
;                width--;
;                }

.decimal:
    lhld    args
    mov    e,m
    inx    h
    mov    d,m
    mov    a,d
    ral
    jnc    .unsigned

;*args = -*args
    call    cmd
    mov    m,d
    dcx    h
    mov    m,e

    lhld    wptr
    mvi    m,'-'
    inx    h
    shld    wptr

    lhld    width
    dcx    h
    shld    width

;for the next 3 cases, the value for 'base' was
; put in E before the switch branch
;
;        case 'U':  base = 10; goto val;

.unsigned:
    mvi    e,10
;
;        case 'X':  base = 16; goto val;

;
;        case 'O':  base = 8;  /* note that arbitrary bases can be
;                         added easily before this line */


.bval:    mov    a,e
    sta    base
;
;             val:  width -= _uspr(&wptr,*args++,base);
;               goto pad;
.val:
    lhld    args
    mov    e,m
    inx    h
    mov    d,m
    inx    h
    shld    args
    push    b    ;save format
    mov    c,e    ;pass *args in BC (_uspr now accesses other
    mov    b,d    ;           former arguments directly)
    call    _uspr
    pop    b

    call    cmh
    xchg
    lhld    width
    dad    d
    jmp    ..sw.pad

;
;        case 'C':  *wptr++ = *args++;
;               width--;
;               goto pad;

.char:
    lhld    args
    mov    e,m
    inx    h
    inx    h
    shld    args

    lhld    wptr
    mov    m,e
    inx    h
    shld    wptr

    lhld    width
    dcx    h
..sw.pad:
    shld    width

    jmp    .pad
;
;        case 'S':  if (!pf) precision = 200;
;               sptr = *args++;
;               while (*sptr && precision) {
;                *wptr++ = *sptr++;
;                precision--;
;                width--;
;                }
;(sptr used only for case 'S' -- can use DE to hold its value)

.string:
    lda    pf
    ora    a
    jnz    ..s1

    lxi    h,200
    shld    precision
..s1:
    lhld    args
    mov    e,m
    inx    h
    mov    d,m
    inx    h
    shld    args
;now DE = sptr
..s2:
    ldax    d
    ora    a
    jz    .pad

    lhld    precision
    mov    a,h
    ora    l
    jz    .pad

    dcx    h
    shld    precision

    ldax    d
    inx    d
    lhld    wptr
    mov    m,a
    inx    h
    shld    wptr


    lhld    width
    dcx    h
    shld    width

    jmp    ..s2
;
;             pad:  *wptr = '\0';

.pad:
    lhld    wptr
    mvi    m,0
;             pad2: wptr = wbuf;

    lhld    wbuf
    shld    wptr

;               if (!ljflag)

    lda    ljflag
    ora    a
    jnz    .p8
;                while (width-- > 0)

..pd1:
    lhld    width    ;i.e. "while (--width >= 0)"
    dcx    h
    shld    width
    mov    a,h
    ral
    jc    .p8

;                    if ((*putcf)(zfflag ? '0' : ' ',arg1)
;                        == ERROR) return ERROR;;

    lda    zfflag
    ora    a
    mvi    a,' '
    jz    ..pd2
    mvi    a,'0'
..pd2:
    call    c_putcf
    jmp    ..pd1
;
;               while (*wptr)

.p8:
    lhld    wptr
    mov    a,m
    ora    a
    jz    .p9
;                if ((*putcf)(*wptr++,arg1) == ERROR)
;                    return ERROR;
    inx    h
    shld    wptr
    call    c_putcf
    jmp    .p8

;
;               if (ljflag)

.p9:
    lda    ljflag
    ora    a
    jz    .p1
;                while (width-- > 0)

.p10:
    lhld    width
    dcx    h
    shld    width
    mov    a,h
    ral
    jc    .p1
;                    if ((*putcf)(' ',arg1) == ERROR)
;                        return ERROR;
;               break;
    mvi    a,' '
    call    c_putcf
    jmp    .p10

;
;        case NULL:
;               return OK;

;(same as .pxOK)
;.null:    lxi    h,0
;    jmp    ..ret

;
;        default:   if ((*putcf)(c,arg1) == ERROR)
;                return ERROR;
;         }
;      }
;(default done in place)
;.default:
;    call    c_putcf
;    jmp    .p1

;      else if ((*putcf)(c,arg1) == ERROR)
;            return ERROR;
;(cf. above)



;    return OK;

.pxOK:    lxi    h,0
;}


..ret:
    xchg
    lxi    h,MAXLINE
    dad    sp
    sphl
    xchg
    pop    b
    ret

c_putcf:
arg1    equ    $+1
    lxi    h,0
    push    h

    mov    l,a
    mvi    h,0
    push    h

putcf    equ    $+1
    call    0
    pop    d
    pop    d
    inx    h
    mov    a,h
    ora    l
    rnz
;if error, don't return to caller -- escape from
; function, returning ERROR value
    pop    h
    lxi    h,-1
    jmp    ..ret



;arguments
;fmt:        dw    0     ;(args now used to hold fmt)

;locals
base:        db    0,0    ;2nd byte always 0 -- cf lhld in _uspr
;sptr:        dw    0    ;(*sptr kept in DE when needed)
;format:    dw    0    ;(*format now kept in BC)

wbuf:        dw    0    ;pointer to MAXLINE chars on stack
wptr:        dw    0    ;*wptr
pf:        db    0
ljflag:        db    0
zfflag:        db    0
width:        dw    0
precision:    dw    0
args:        dw    0    ;*args

    .comment    `
/*
    Internal routine used by "_spr" to perform ascii-
    to-decimal conversion and update an associated pointer:
*/

int _gv2(sptr)
char **sptr;
{
    int n;
    n = 0;
    while (isdigit(**sptr)) n = 10 * n + *(*sptr)++ - '0';
    return n;
}            `


_gv2:
;value of n kept in HL
;*sptr (=format) passed and kept in BC

    lxi    h,0
.gvL:
    ldax    b    ;*format
    cpi    '0'
    rc
    cpi    '9'+1
    rnc

    lxi    d,10    ;n = 10 * n
    call    smul

    ldax    b    ;*format++
    inx    b

    sui    '0'
    mov    e,a
    mvi    d,0

    dad    d

    jmp    .gvL

    .comment    `

char _uspr(string, n, base)
char **string;
unsigned n;
{
    char length;
            `

; Now 'n' passed in BC is only arg passed -- *string  (= wptr) and base
;  referred to directly.


_uspr:

;    if (n<base) {

    lhld    base
    mov    e,c
    mov    d,b
    call    albu
    jnc    .up3

;        *(*string)++ = (n < 10) ? n + '0' : n + 55;

    mov    l,c
    mov    h,b
    lxi    d,-10
    dad    d
    jc    .up1

    mov    l,c
    mov    h,b
    lxi    d,'0'
    dad    d
    jmp    .up2

.up1:
    mov    l,c
    mov    h,b
    lxi    d,55
    dad    d
.up2:
    xchg
    lhld    wptr
    mov    m,e
    inx    h
    shld    wptr

;        return 1;
;    }
    lxi    h,1
    ret

;    length = _uspr(string, n/base, base);

.up3:
    lhld    base
    mov    e,c
    mov    d,b
    call    usdiv
;HL = n/base

    push    b    ;save n for mod operation in next statement
    mov    c,l
    mov    b,h
    call    _uspr
    pop    b    ;restore n

    push    h    ;save length for return value

;    _uspr(string, n%base, base);

    lhld    base
    mov    e,c
    mov    d,b
    call    usmod
;HL = n%base

    mov    c,l
    mov    b,h
    call    _uspr

;    return length + 1;
;}
    pop    h
    mvi    h,0
    inr    l
    ret

;*****************************************

    end