home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / list / ep-src.ark / MISC1.MAC < prev    next >
Encoding:
Text File  |  1988-05-21  |  7.9 KB  |  649 lines
  1.  
  2.     include    BDSYM.EQU
  3.     include    EPDATA
  4.  
  5.     .comment    `
  6. functions INJECT, FPREFIX, NEWFONTS, LOADI, SAVEI, termput
  7.  
  8.  
  9.  
  10. inject(num)
  11. int num;
  12. {    char i, numfb[10];
  13.  
  14.             `
  15. numfb    equ    80H
  16.  
  17. inject::
  18.     pop    d
  19.     pop    h
  20.     push    h
  21.     push    d
  22.  
  23.     xchg
  24.     lxi    h,val + 54*('R'-'@') + 2*('N'-'@')
  25.     mov    a,m
  26.     mvi    m,0
  27.     xchg
  28.  
  29.     ora    a
  30.     jnz    roman
  31.  
  32.     push    b
  33. ;    if (!num) {stowc('0'); return; }
  34.  
  35.     mov    a,h
  36.     ora    l
  37.     jnz    nj1
  38.     lxi    h,'0'
  39.     push    h
  40.     call    stowc##
  41.     pop    d
  42.     pop    b
  43.     ret
  44.  
  45. ;    i = 0;
  46. nj1:    mvi    b,0
  47.     lxi    d,numfb
  48.  
  49. ;    while (num)
  50. .nj2:
  51.     mov    a,h
  52.     ora    l
  53.     jz    .nj3
  54. ;    {    numfb[i++] = '0' + (num % 10);
  55.  
  56.     push    h
  57.     push    d
  58.     lxi    d,10
  59.     xchg
  60.     call    usmod    ;was smod
  61.     mov    a,l
  62.     adi    '0'
  63.     pop    d
  64.     stax    d
  65.     inx    d
  66.     inr    b
  67.     pop    h
  68.  
  69. ;        num = num / 10;
  70. ;    }
  71.  
  72.     push    d
  73.     lxi    d,10
  74.     xchg
  75.     call    usdiv    ;was sdiv
  76.     pop    d
  77.     jmp    .nj2
  78.  
  79. ;    while (i) stowc(numfb[--i]);
  80. .nj3:
  81.     mov    a,b
  82.     ora    a
  83.     jz    .nj4
  84.  
  85.     dcr    b
  86.     dcx    d
  87.     ldax    d
  88.     mov    l,a
  89.     mvi    h,0
  90.     push    d
  91.     push    h
  92.     call    stowc##
  93.     pop    d
  94.     pop    d
  95.     jmp    .nj3
  96. .nj4:
  97.     pop    b
  98.     ret
  99.  
  100. ;use 80h, since it seems not to be used
  101. ;numfb:    ds    10
  102.  
  103.  
  104.     .comment    `
  105. (In this version, 'ns' is not used -- we just stow the characters)
  106.  
  107. roman(arg,ns)
  108. int arg; char *ns;
  109. {    int factr, t, rv;
  110.     char rs[3], *nref, *sref, *rrs;
  111.  
  112.     *ns = '\0';
  113.     factr = 1000;
  114.     sref = "mdclxvi";
  115.     nref = "1954";
  116.  
  117.     if (arg)
  118.     for (t = 4; t <= 16; t++)
  119.     {    rrs = rs;
  120.         if (t&1) *rrs++ = sref[2*(t/4)];
  121.         *rrs++ = sref[t/2 - 2];
  122.         *rrs = '\0';
  123.         rv = factr * (nref[t % 4] - '0');
  124.         while (arg >= rv)
  125.         {    strcat(ns, rs);
  126.             arg -= rv;
  127.         }
  128.         if (!(t % 4)) factr /= 10;
  129.     }
  130. }            `
  131.  
  132.  
  133. roman:
  134.     mov    a,h
  135.     ora    l
  136.     rz
  137.     shld    arg
  138.  
  139.     lxi    h,1000
  140.     shld    factr
  141.  
  142.     push    b
  143.  
  144. ;keep 't' in b
  145.     mvi    b,4
  146. .r1:
  147. ;    lxi    h,rs
  148. ;    shld    rrs
  149. ;keep 'rrs' on stack
  150.     lxi    h,rs
  151.     push    h
  152.  
  153.     mov    a,b
  154.     ani    1
  155.     jz    .r2
  156.  
  157.     mov    a,b
  158.     rar        ;(carry is clear)
  159.     ani    0feh
  160.     mov    e,a
  161.     mvi    d,0
  162.     lxi    h,sref
  163.     dad    d
  164.     mov    e,m
  165.  
  166. ;    lhld    rrs
  167.     pop    h
  168.     mov    m,e
  169.     inx    h
  170. ;    shld    rrs
  171.     push    h
  172. .r2:
  173.     mov    a,b
  174.     ora    a
  175.     rar
  176.     dcr    a
  177.     dcr    a
  178.     mov    e,a
  179.     mvi    d,0
  180.     lxi    h,sref
  181.     dad    d
  182.     mov    e,m
  183.  
  184. ;    lhld    rrs
  185.     pop    h
  186.     mov    m,e
  187.     inx    h
  188. ;    shld    rrs
  189.     push    h
  190.  
  191.     mvi    m,0
  192.  
  193.     mov    a,b
  194.     ani    3
  195.     mov    e,a
  196. ;    mvi    d,0    (D still 0)
  197.     lxi    h,nref
  198.     dad    d
  199.     mov    a,m
  200.  
  201.     lhld    factr
  202.     xchg
  203.  
  204.     mov    l,a
  205.     mvi    h,0
  206.  
  207.     call    usmul
  208.  
  209.     shld    rv
  210.  
  211. .r3:
  212.     lhld    arg
  213.     xchg
  214.     lhld    rv
  215.     call    cmh
  216.     dad    d
  217.     mov    a,h
  218.     ora    a
  219.     jm    .r4
  220.     shld    arg
  221.  
  222.     lxi    d,rs
  223. .r3a:    ldax    d
  224.     inx    d
  225.     ora    a
  226.     jz    .r3
  227.     push    d
  228.     mov    e,a
  229.     mvi    d,0
  230.     push    d
  231.     call    stowc##
  232.     pop    d
  233.     pop    d
  234.     jmp    .r3a
  235.  
  236. .r4:
  237.     mov    a,b
  238.     ani    3
  239.     jnz    .r5
  240.  
  241.     lhld    factr
  242.     lxi    d,10
  243.     xchg
  244.     call    usdiv
  245.     shld    factr
  246.  
  247. .r5:
  248.     inr    b
  249.     mov    a,b
  250.     cpi    16+1
  251.     pop    h    ;discard rrs
  252.     jc    .r1
  253.     pop    b
  254.     ret
  255.  
  256. arg:    dw    0
  257. factr:    dw    0
  258. rv:    dw    0
  259. rs:    db    0,0,0
  260. ;rrs:    dw    0
  261. sref:    db    'mdclxvi'
  262. nref:    db    1,9,5,4
  263.  
  264.  
  265.  
  266.     .comment    `
  267.  
  268. /************************************************/
  269. /* Form prefix for filename            */
  270. /************************************************/
  271. fprefix(name)
  272. char *name;
  273. {
  274.     if (val['U'-'@']['S'-'@'])
  275.     {    if (val['U'-'@']['S'-'@'] > 9)
  276.             *name++ = val['U'-'@']['S'-'@']/10 + '0';
  277.         *name++ = (val['U'-'@']['S'-'@'] % 10) + '0';
  278.         *name++ = '/';
  279.     }
  280.  
  281.     if (val['D'-'@']['I'-'@'])
  282.     {    *name++ = val['D'-'@']['I'-'@'] + '@';
  283.         *name++ = ':';
  284.     }
  285.  
  286.     *name = '\0';
  287. }            `
  288.  
  289. fprefix::
  290.     pop    d
  291.     pop    h
  292.     push    h
  293.     push    d
  294.  
  295. ;    if (val['U'-'@']['S'-'@'])
  296.  
  297.     lda    val + 54*('U'-'@') + 2*('S'-'@')
  298.     ora    a
  299.     jz    .pre2
  300. ;    {    if (val['U'-'@']['S'-'@'] > 9)
  301.  
  302.     cpi    10
  303.     jc    .pre1
  304. ;            *name++ = val['U'-'@']['S'-'@']/10 + '0';
  305.     mvi    d,'0'
  306. .1:    sui    10
  307.     jz    .3
  308.     jm    .2
  309.     inr    d
  310.     jmp    .1
  311. .2:    adi    10
  312. .3:    mov    m,d
  313.     inx    h
  314.  
  315. ;        *name++ = (val['U'-'@']['S'-'@'] % 10) + '0';
  316. .pre1:
  317.     adi    '0'
  318.     mov    m,a
  319.     inx    h
  320. ;        *name++ = '/';
  321.  
  322.     mvi    m,'/'
  323.     inx    h
  324.  
  325. ;    }
  326. ;
  327. ;    if (val['D'-'@']['I'-'@'])
  328. .pre2:
  329.     lda    val + 54*('D'-'@') + 2*('I'-'@')
  330.     ora    a
  331.     jz    .pre3
  332. ;    {    *name++ = val['D'-'@']['I'-'@'] + '@';
  333.  
  334.     adi    '@'
  335.     mov    m,a
  336.     inx    h
  337.  
  338. ;        *name++ = ':';
  339. ;    }
  340.     mvi    m,':'
  341.     inx    h
  342. ;
  343. ;    *name = '\0';
  344. ;}
  345. .pre3:
  346.     mvi    m,0
  347.     ret
  348.  
  349.  
  350.     .comment    `
  351. (assembler version is entirely different)
  352.  
  353.     /* mark each font "not loaded yet"    */
  354. newfonts()
  355. {    int i;
  356.     for (i=0; i<NUMFTS; i++)
  357.     {    if (ftp[i]) free(ftp[i]);
  358.         ftname[i][0] = ftp[i] = 0;
  359.     }
  360.  
  361.     for (i=0; i<32; i++) attach[i] = 0;
  362.  
  363.     /* next font to load is the first one    */
  364.     nextft = 0;
  365.  
  366. }            `
  367.  
  368.  
  369. newfonts::
  370.  
  371.     call    freeall##
  372.  
  373.     xra    a
  374.     sta    nextft
  375.  
  376.     lxi    h,ftp
  377.     mvi    e,NUMFTS*2
  378.     call    .fille
  379.  
  380.     lxi    h,ftname
  381.     mvi    e,NUMFTS*LENFTN
  382.     call    .fille
  383.  
  384.     lxi    h,attach
  385.     mvi    e,32*2
  386.  
  387. .fille:
  388.     mov    m,a
  389.     inx    h
  390.     dcr    e
  391.     rz
  392.     jmp    .fille
  393.  
  394.  
  395.     .comment    `
  396. /************************************************/
  397. /* Load initialization data            */
  398. /************************************************/
  399. loadi(n)
  400. int n;
  401. {    int fd;
  402.     char *iname;
  403.  
  404.     iname = "ep.ini";
  405.     if (n) iname[6] = '0' + n;
  406.  
  407.     if ((fd = open(iname,0)) == ERROR)
  408.         eperror(113);
  409.     if (read(fd, val, 21) != 21)
  410.         eperror(114);
  411.     fabort(fd);
  412.  
  413. }
  414.  
  415.  
  416. /************************************************/
  417. /* Save current values as new initialization data*/
  418. /*    (not used now)                */
  419. /************************************************/
  420. savei(n)
  421. int n;
  422. {    int fd, i;
  423.     char *iname;
  424.  
  425.     iname = "ep.ini";
  426.     if (n) iname[6] = '0' + n;
  427. /* '6' should have been '5' here */
  428.     if ((fd = creat(iname,1)) == ERROR)
  429.         eperror(115);
  430.     if (write(fd, val, 21) != 21)
  431.         eperror(116);
  432.     if (close(fd) == ERROR)
  433.         eperror(117);
  434. }
  435.  
  436.  
  437.  
  438.  
  439. /************************************************/
  440. /* Load initialization data            */
  441. /************************************************/
  442. loadi(n)
  443. int n;
  444. {    int fd;
  445.     char *iname;
  446.             `
  447. loadi::
  448.     pop    d
  449.     pop    h
  450.     push    h
  451.     push    d
  452.  
  453. ;    iname = "ep.ini";
  454.  
  455. ;    if (n) iname[6] = '0' + n;
  456.  
  457.     call    .digext
  458.  
  459. ;
  460. ;    if ((fd = open(iname,0)) == ERROR)
  461. ;        eperror(113);
  462.     lxi    h,0
  463.     push    h
  464.     lxi    h,$epini
  465.     push    h
  466.     call    open##
  467.     pop    d
  468.     pop    d
  469.     inx    h
  470.     mov    a,h
  471.     ora    l
  472.     jnz    .ldi2
  473.     lxi    h,113
  474.     push    h
  475.     call    eperror##
  476.  
  477. ;    if (read(fd, val, 21) != 21)
  478. ;        eperror(114);
  479. .ldi2:
  480.     dcx    h
  481.     push    h    ;fd for fabort, below
  482.     lxi    d,21
  483.     push    d
  484.     lxi    d,val
  485.     push    d
  486.     push    h    ;still fd
  487.     call    read##
  488.     pop    d
  489.     pop    d
  490.     pop    d
  491.     lxi    d,-21
  492.     dad    d
  493.     mov    a,h
  494.     ora    l
  495.     jz    .ldi3
  496.     lxi    h,114
  497.     push    h
  498.     call    eperror##
  499.  
  500. ;    fabort(fd);
  501. ;
  502. ;}
  503. .ldi3:
  504. ;    push    h    (still on stack) 
  505.  
  506.     pop    h
  507.     mov    a,l
  508.     call    fabort##
  509. ;    pop    d
  510.     ret
  511.  
  512. $epini:    db    'ep.ini',0
  513.  
  514.     .comment    `
  515.  
  516. /************************************************/
  517. /* Save current values as new initialization data*/
  518. /*    (not used now)                */
  519. /************************************************/
  520. savei(n)
  521. int n;
  522. {    int fd, i;
  523.     char *iname;
  524.             `
  525. savei::
  526.     pop    d
  527.     pop    h
  528.     push    h
  529.     push    d
  530.  
  531.  
  532. ;    iname = "ep.ini";
  533.  
  534. ;    if (n) iname[6] = '0' + n;
  535.  
  536.     call    .digext
  537.  
  538. ;
  539. ;    if ((fd = creat(iname,1)) == ERROR)
  540. ;        eperror(115);
  541. .svi1:    lxi    h,1
  542.     push    h
  543.     lxi    h,$epini
  544.     push    h
  545.     call    creat##
  546.     pop    d
  547.     pop    d
  548.     inx    h
  549.     mov    a,h
  550.     ora    l
  551.     jnz    .svi2
  552.     lxi    h,115
  553.     push    h
  554.     call    eperror##
  555.  
  556. ;    if (write(fd, val, 21) != 21)
  557. ;        eperror(116);
  558. .svi2:
  559.     dcx    h
  560.     push    h    ;fd for close
  561.  
  562.     lxi    d,21
  563.     push    d
  564.     lxi    d,val
  565.     push    d
  566.     push    h
  567.     call    write##
  568.     pop    d
  569.     pop    d
  570.     pop    d
  571.  
  572.     lxi    d,-21
  573.     dad    d
  574.     mov    a,h
  575.     ora    l
  576.     jz    .svi3
  577.  
  578.     lxi    h,116
  579.     push    h
  580.     call    eperror##
  581.  
  582.  
  583. ;    if (close(fd) == ERROR)
  584. ;        eperror(117);
  585. ;}
  586. .svi3:
  587. ;    push    h
  588. ;    call    close##
  589.     call    .close
  590.     pop    d
  591.     inx    h
  592.     mov    a,h
  593.     ora    l
  594.     rnz
  595.     lxi    h,117
  596.     push    h
  597.     call    eperror##
  598.  
  599.  
  600. .digext:
  601.     mvi    e,'i'
  602.     mov    a,l
  603.     ora    a
  604.     jz    .dx1
  605.     adi    '0'
  606.     mov    e,a
  607. .dx1:    lxi    h,$epini+5
  608.     mov    m,e
  609.     ret
  610.  
  611.  
  612. ;TERMPUT - put char to console if not QC; truncate overlong lines
  613. termput::
  614.     mov    e,a
  615.     lda    val + 54*('P'-'@') + 2*('T'-'@')
  616.     ora    a
  617.     jnz    .tpu1
  618.     lda    val + 54*('Q'-'@') + 2*('C'-'@')
  619.     ora    a
  620.     rnz
  621. .tpu1:    lxi    h,termcnt
  622.     inr    m
  623.     mov    a,e
  624.     cpi    7fh
  625.     jc    $+5
  626.     mvi    e,' '
  627.     cpi    ' '
  628.     jnc    .tpu2
  629.     mvi    e,':'
  630.     cpi    0ah
  631.     jnz    .tpu2
  632.     mov    e,a
  633.     mvi    m,1
  634. .tpu2:
  635.     mov    a,m
  636.     cpi    79
  637.     rnc
  638. ;    mov    l,e
  639. ;    mvi    h,0
  640. ;    push    h
  641.     mov    a,e
  642.     jmp    putchar##
  643. ;    call    putchar##
  644. ;    pop    h
  645. ;    ret
  646.  
  647.     end
  648.  
  649.