home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / programs / list / ep-src.ark / CSEQ.MAC < prev    next >
Encoding:
Text File  |  1988-05-21  |  46.9 KB  |  3,437 lines
  1.  
  2.  
  3.     INCLUDE BDS.LIB
  4.     INCLUDE EPDATA
  5.  
  6. newline    equ    10
  7.  
  8.     .request WADJUST
  9.  
  10.     .comment    `
  11. /*
  12.     CSEQ and related functions
  13.     Greg Lee, 2/84
  14.  
  15. */
  16.  
  17.  
  18. /************************************************/
  19. /* Processing of commands            */
  20. /*    If a character is returned, it will    */
  21. /*    be put in outbuf            */
  22. /************************************************/
  23.  
  24.  
  25. char cseq()
  26. {/*    int arg, typeval, measure, divisor; */
  27.  /*    char dt3, dt4, dt5, eqref, havearg; */
  28.  
  29.     eqref = FALSE;
  30.  
  31.     scanwhite(FALSE);
  32.  
  33.     /* first char of command                 */
  34.     dt1 = inbuf[inpoint];
  35.  
  36.     /* if eol, continue to next                */
  37.     if (!dt1 || dt1 == '\n')
  38.     {    newinline();
  39.         fgets(inbuf);
  40.         return(0);
  41.     }
  42.  
  43.     /* '\\' is '\'                        */
  44.     if (dt1 == ec)
  45.     {    inpoint++; scrncol++;
  46.         return(dt1);
  47.     }
  48.  
  49.     /* '}' is use all blocks on input line            */
  50.     if (dt1 == '}' && brcpt[cc])
  51.     {    inpoint++; scrncol++;
  52.         allmode = mode;
  53.         mode = brcstk[cc][--brcpt[cc]];
  54.         return(0);
  55.     }
  56.  
  57.     if (dt1 == '{') { modepush(); return(0); }
  58.  
  59.     /* < is backspace                    */
  60.     if (dt1 == '<') {scanwhite(TRUE);  return('\b'); }
  61.  
  62.     /* comment                        */
  63.     if (dt1 == '*') {inbuf[inpoint] = '\0'; return(0); }
  64.  
  65.     /* reference to value                    */
  66.     if (dt1 == '=')
  67.     {    scanwhite(TRUE);
  68.         eqref = TRUE;
  69.         dt1 = inbuf[inpoint];
  70.     }
  71.  
  72.     /* maybe a character given by numeric value        */
  73.     if (isdigit(dt1))
  74.     {    dt1 = numscan();
  75.         scanwhite(FALSE);
  76.         dt2 = 0;
  77.     }
  78.     else
  79.     {    dt2 = inbuf[++inpoint];
  80.         scrncol++;
  81.         dt3 = inbuf[inpoint+1];
  82.         if (isalpha(dt2) || dt2 == '0' || dt2 == '1')
  83.             scanwhite(TRUE);
  84.         else    scanwhite(FALSE);
  85.     }
  86.  
  87.     /* Now we have both command letters    */
  88.  
  89.     /* If both alphabetic, it's a run-off type command */
  90.     if (isalpha(dt1) && isalpha(dt2))
  91.     {    dt1 = toupper(dt1); dt2 = toupper(dt2);
  92.         if (isalpha(dt3) || dt3 == '-') getrlets();
  93.  
  94.         typeval = valtp[dt1-'@'][dt2-'@'];
  95.         arg = val[dt1-'@'][dt2-'@'];
  96.  
  97.         if (eqref) {inject(arg); return(0); }
  98.  
  99.         if (typeval & BRK) {brkflag = TRUE; prtsbuf(); }
  100.  
  101.         if (typeval & FLAGCH) return(arg);
  102.  
  103.         if (typeval & CHARG)
  104.         {    dt3 = inbuf[inpoint];
  105.             if (dt3 == '\n') dt3 = 0;
  106.             val[dt1-'@'][dt2-'@'] = dt3;
  107.             if (dt3) scanwhite(TRUE);
  108.             return(0);
  109.         }
  110.  
  111.         if (dt1 == 'I' && dt2 == 'M')
  112.         {    extract(fnbuf);
  113.             strcat(fnbuf,".TXT"); /* ??? */
  114.             if (fopen(fnbuf) != ERROR) return(0);
  115.             eperror(110);
  116.         }
  117.  
  118.         if (dt1 == 'N' && dt2 == 'B')
  119.         {    brkflag = FALSE;
  120.             prtsbuf();
  121.             return(0);
  122.         }
  123.  
  124.         arg = TRUE;
  125.         havearg = FALSE;
  126.         measure = divisor = 0;
  127.  
  128.         if (isdigit(inbuf[inpoint]))
  129.         {    arg = numscan(); havearg = TRUE;
  130.  
  131.             if (inbuf[inpoint] == '/')
  132.             {    inpoint++; scrncol++;
  133.                 divisor = numscan();
  134.             }
  135.  
  136.             switch (toupper(inbuf[inpoint]))
  137.             { case '.': measure = 1;        break;
  138.               case 'P': measure = POINT;        break;
  139.               case '"': if (typeval & HZNUM)
  140.                     measure = INCH;
  141.                     else if (typeval & VTNUM)
  142.                     measure = VINCH;     break;
  143.               default:  inpoint--; scrncol--;    break;
  144.             }
  145.  
  146.             scanwhite(TRUE);
  147.         }
  148.         else if (inbuf[inpoint] == '=')
  149.         {    havearg = TRUE;
  150.             scanwhite(TRUE);
  151.             if (!isalpha(dt4 = toupper(inbuf[++inpoint])))
  152.                 return(0);
  153.             dt5 = dt2;
  154.             if (!isalpha(dt2 = toupper(inbuf[++inpoint])))
  155.                 return(0);
  156.             if (isalpha(dt3 = inbuf[++inpoint]) || dt3 == '-')
  157.                 getrlets();
  158.             arg = val[dt4-'@'][dt2-'@'];
  159.             dt2 = dt5;
  160.             scrncol += 3;
  161.         }
  162.         else if (dt1 == 'F' && dt2 == 'O') arg = grabfont();
  163.  
  164.         if (typeval & (HZNUM | VTNUM))
  165.         {    if (!measure) measure =
  166.                   (typeval & VTNUM) ? PICA+sl : PICA;
  167.             arg *= measure;
  168.             if (divisor) arg = (arg + divisor - 1)/divisor;
  169.         }
  170.  
  171.         if (typeval & EPSSYN)
  172.         {    dt1 = val[dt1-'@'][dt2-'@'];
  173.             if (!arg)
  174.             {    dt2 = '0';
  175.                 switch (dt1)
  176.                 {    case 'E':
  177.                     case 'G':
  178.                     case  4:
  179.                         dt1++;    break;
  180.                     case 'M':
  181.                     case  15:
  182.                         dt1 += 3; break;
  183.                     case 'S':
  184.                     case '0':
  185.                         dt1 = 'T'; break;
  186.                 }
  187.             }
  188.             else if (dt1 == '0') { dt1 = 'S'; dt2 = '0'; }
  189.             epscommand();
  190.             return(0);
  191.         }
  192.  
  193.         if (dt1 == 'B' && dt2 == 'E')
  194.         {    if (havearg)
  195.             {    brkflag = TRUE;
  196.                 prtsbuf();
  197.             }
  198.             else
  199.             {    modepush();
  200.                 if (arg) mode |= BENT;
  201.                  else mode &= ~BENT;
  202.                 return(0);
  203.             }
  204.         }
  205.  
  206.         val[dt1-'@'][dt2-'@'] = arg;
  207.  
  208.         if (dt1 == 'N' && dt2 == 'C')
  209.           if (arg > 1)
  210.           {    for (cc = 1; cc <= nc; cc++)
  211.             {    brcpt[cc] = 1;
  212.                 brcstk[cc][0] = mode;
  213.             }
  214.             cc = 1;
  215.           }
  216.           else    nc = 0;
  217.  
  218.         if (typeval & BRK) newoutline();
  219.  
  220.         if (dt1 == 'C' && dt2 == 'L') gotocol(arg);
  221.         else if (dt1 == 'S' && dt2 == 'K') skdots += arg;
  222.         else if (dt1 == 'F' && dt2 == 'O')
  223.         {    modepush();
  224.  
  225.             if (arg < 32 && attach[arg]) mode = attach[arg];
  226.  
  227.             if (arg > 7)
  228.             {    arg = mode & 0x700;
  229.                 fo = arg >> 8;
  230.             }
  231.             else arg <<= 8;
  232.  
  233.             mode = (mode & 0xF8FF) | arg;
  234.         }
  235.         else if (dt1 == 'T' && dt2 == 'A')
  236.         {    modepush();
  237.             if (arg) mode |= TALL;
  238.             else mode &= ~TALL;
  239.         }
  240.         else if (dt1 == 'I' && dt2 == 'F')
  241.         {    modepush();
  242.             if (arg) mode |= IGNORE;
  243.             else mode &= ~IGNORE;
  244.         }
  245.         else if (dt1 == 'A' && dt2 == 'T')
  246.         {    if (!havearg) arg = fo;
  247.             if (arg < 32) attach[arg] = mode;
  248.         }
  249.  
  250.     }
  251.  
  252.     /* Otherwise, it's an Epson type command    */
  253.     else epscommand();
  254.  
  255.     return(0);
  256. }            `
  257.  
  258.  
  259.     ext    newinlin,newoutli,loadft,fprefix
  260.     ext    prtsbuf,gotocol,hzspace,inject,eperror,fgets
  261.     ext    fopen,strcat,strcmp,strcpy
  262.  
  263. cseq::
  264.     push    b
  265. ;keep dt1 in C and dt2 in B
  266.  
  267. ;push location most common exit point so can use 'ret' instead of 'jmp'
  268.     lxi    h,csret0
  269.     push    h
  270.  
  271.     cpi    '\'
  272.     jnz    cs_control
  273. ;
  274. ;    eqref = FALSE;
  275.  
  276.     mvi    a,false
  277.     sta    eqref
  278. ;
  279. ;    scanwhite(FALSE);
  280. ;A still FALSE
  281.     call    scanwhit
  282. ;
  283. ;    /* first char of command                 */
  284. ;    dt1 = inbuf[inpoint];
  285.  
  286.     call    inbch
  287. cs_control:
  288.     mov    c,a
  289. ;
  290. ;    /* if eol, continue to next                */
  291. ;    if (!dt1 || dt1 == '\n')
  292. ;    {    newinline();
  293. ;        fgets(inbuf);
  294. ;        return(0);
  295. ;    }
  296.  
  297.     ora    a
  298.     jz    cs1
  299.     cpi    newline
  300.     jnz    cs2
  301. cs1:
  302.     lxi    h,0
  303.     lda    val + 54*('R'-'@') + 2*('L'-'@')
  304.     ora    a
  305.     jnz    $+6
  306.     shld    inpoint
  307.     xra    a
  308.     sta    scrncol        ;tab action will not be correct
  309. ;    call    newinlin    ;don't want all newinline actions
  310.  
  311.     lhld    inpoint        ;usually 0
  312.     lxi    d,inbuf
  313.     dad    d
  314.     push    h
  315.     call    fgets
  316.     pop    d
  317.     ret
  318. ;
  319. ;    /* '\\' is '\'                        */
  320. ;    if (dt1 == ec)
  321. ;    {    inpoint++; scrncol++;
  322. ;        return(dt1);
  323. ;    }
  324.  
  325. cs2:
  326.     lhld    ec
  327.     cmp    l
  328.     jnz    cs3
  329.     call    nxspnt
  330.     pop    h
  331.     mov    l,c
  332.     mvi    h,0
  333.     pop    b
  334.     ret
  335. ;
  336. ;    /* '}' is use all blocks on input line            */
  337. ;    if (dt1 == '}' && brcpt[cc])
  338. ;(ch. so brcpt[cc]=0 does not prevent)
  339. ;    {    inpoint++; scrncol++;
  340. ;        allmode = mode;
  341. ;        mode = brcstk[cc][--brcpt[cc]];
  342. ;        return(0);
  343. ;    }
  344.  
  345. cs3:
  346.     cpi    '}'
  347.     jnz    cs4
  348.     call    nxspnt
  349.     lhld    mode
  350.     shld    allmode
  351.  
  352.     call    get_brc
  353.  
  354.     MOV    A,E    ;replaces "&& brcpt[cc]"
  355.     ORA    D
  356.     rz
  357.  
  358.     dcx    d
  359.     mov    m,d
  360.     dcx    h
  361.     mov    m,e
  362.     xchg
  363.     dad    h
  364.     PUSH    H
  365.  
  366.     lhld    cc
  367.     lxi    d,12
  368.     call    usmul
  369.     lxi    d,brcstk
  370.     dad    d
  371.  
  372.     pop    d
  373.     dad    d
  374.  
  375.     mov    a,m
  376.     inx    h
  377.     mov    h,m
  378.     mov    l,a
  379.     shld    mode
  380.     ret
  381. ;
  382. ;    if (dt1 == '{') { modepush(); return(0); }
  383.  
  384. cs4:
  385.     cpi    '{'
  386.     jz    modepush
  387. ;
  388. ;    /* < is backspace                    */
  389. ;    if (dt1 == '<') {scanwhite(TRUE);  return('\b'); }
  390.  
  391. cs5:
  392.     cpi    '<'
  393.     jnz    cs6
  394. ;    mvi    a,ttrue
  395.     call    scanwhit
  396.     pop    h
  397.     lxi    h,BCKFLAG    ;was 8
  398.     pop    b
  399.     ret
  400. ;
  401. ;    /* comment                        */
  402. ;    if (dt1 == '*') {inbuf[inpoint] = '\0'; return(0); }
  403.  
  404. cs6:
  405.     cpi    '*'
  406.     jnz    cs7
  407.     call    nxspnt    ;scan over the '*'
  408. cs6a:    pop    h    ;discard csret0 ret
  409.     lxi    h,0ffh    ;signal end of input line
  410.     pop    b
  411.     ret
  412. ;
  413. ;    /* reference to value                    */
  414. ;    if (dt1 == '=')
  415. ;    {    scanwhite(TRUE);
  416. ;        eqref = TRUE;
  417. ;        dt1 = inbuf[inpoint];
  418. ;    }
  419.  
  420. cs7:
  421.     cpi    '='
  422.     jnz    cs8
  423.     mvi    a,1
  424.     sta    eqref
  425.     call    scanwhit
  426.     call    inbch
  427.     mov    c,a
  428. ;
  429. ;    /* maybe a character given by numeric value        */
  430. ;    if (isdigit(dt1))
  431. ;    {    dt1 = numscan();
  432. ;        scanwhite(FALSE);
  433. ;        dt2 = 0;
  434. ;    }
  435.  
  436. cs8:
  437.     cpi    '('
  438.     jnz    cs8.1
  439.     call    csterm
  440.     jmp    cs8.2
  441. cs8.1:
  442.  
  443. ;^char = '\=$char'
  444.     cpi    ' '
  445.     jnc    cs8.1a
  446.     ori    '@'
  447.     cpi    'Z'
  448.     rnc
  449.     mov    l,a
  450.     jmp    cs12a.1
  451.  
  452. cs8.1a:
  453.     cpi    '^'
  454.     jnz    cs8a
  455.     call    nxspnt
  456.     call    inbch
  457.     ani    1fh
  458.     mov    c,a
  459.     call    nxspnt
  460. ;use this char
  461.     mov    l,c
  462. cs8.2:
  463.     pop    d
  464.     mvi    h,0
  465.     pop    b
  466.     ret
  467.  
  468. cs8a:    call    isdec
  469.     jc    cs9
  470.  
  471.     call    numscan
  472.     mov    a,l
  473.     mov    c,a
  474. cs8b:
  475.     xra    a
  476.     mov    b,a
  477.     call    scanwhit
  478.  
  479. ;Change: now not to Epson if 20h
  480.     mov    l,c
  481.     mvi    a,' '
  482.     cmp    l
  483.     jnz    cs12
  484. ;rather use this char
  485.     pop    d
  486.     mvi    h,0
  487.     pop    b
  488.     ret
  489.  
  490. ;    else
  491. ;    {    dt2 = inbuf[++inpoint];
  492. ;        scrncol++;
  493. ;        dt3 = inbuf[inpoint+1];
  494. ;        if (isalpha(dt2) || dt2 == '0' || dt2 == '1')
  495. ;            scanwhite(TRUE);
  496. ;        else    scanwhite(FALSE);
  497. ;    }
  498.  
  499. cs9:    call    nxspnt
  500.  
  501.     mov    a,c
  502.     cpi    '.'
  503.     rz
  504.  
  505.     cpi    '-'
  506.     mvi    l,SOFTHY
  507.     jz    cs8.2
  508.  
  509.     cpi    ','
  510.     jz    sw1
  511.     call    inbch
  512.     mov    b,a
  513.  
  514.     INX    H
  515.     MOV    A,M
  516.     STA    DT3
  517.  
  518.     mov    a,b
  519.     call    up$alph
  520.     jnc    cs10
  521.  
  522.     mov    a,c
  523.     cpi    '$'
  524.     jz    cs12
  525.  
  526. ;check for Fdig
  527.     cpi    'f'
  528.     mov    a,b
  529.     jnz    cs9a
  530.     call    isdec
  531.     jc    cs9a
  532.     sui    '0'
  533.     mov    l,a
  534.     mvi    h,0
  535.     shld    arg
  536.     inr    a
  537.     call    scanwhit
  538.     jmp    cs_FO
  539.  
  540. cs9a:
  541. ;    mov    a,b
  542.     cpi    '0'
  543.     jz    cs10
  544.     cpi    '1'
  545.     JZ    CS10
  546.     xra    a
  547. cs10:
  548.     call    scanwhit
  549.  
  550. ;
  551. ;    /* Now we have both command letters    */
  552. ;
  553. ;    /* If both alphabetic, it's a run-off type command */
  554. ;    if (isalpha(dt1) && isalpha(dt2))
  555. ;    {    dt1 = toupper(dt1); dt2 = toupper(dt2);
  556. ;        if (isalpha(dt3) || dt3 == '-') getrlets();
  557.  
  558. cs12:
  559.     mov    a,c
  560.     call    up$alph
  561.     jc    epscomma
  562.     mov    l,a
  563.  
  564. ;check for '$'digit
  565.  
  566.     cpi    '@'
  567.     jnz    cs12a
  568.     mov    a,b
  569.  
  570.     call    isdec
  571.     jc    cs12a
  572.  
  573.     call    numscan    ;$1->main file name
  574.     inx    h    ;$1->1st com-line arg
  575.     lda     gargc
  576.     dcr    a
  577.     cmp    l
  578.     rc
  579.     dad    h    ;word array
  580.     xchg
  581.     lhld    gargv
  582.     dad    d
  583.     mov    a,m
  584.     inx    h
  585.     mov    h,m
  586.     mov    l,a
  587.     push    h
  588. ;    xra    a
  589. ;    call    scanwhit
  590.     call    sw1
  591.     pop    h
  592.     jmp    sdirect
  593.  
  594. cs12a:
  595.     mov    a,b
  596.  
  597. ;small letter followed by non-alpha is short for \=<letter>$
  598.     call    up$alph
  599.     jnc    cs12b
  600.     mov    a,c
  601.     cpi    '$'
  602.     jz    cs12a.1
  603.     cpi    'a'
  604.     jc    cs12b        
  605.     cpi    'z'+1
  606.     jnc    cs12b
  607. cs12a.1:
  608.     mvi    b,'$'
  609.     mvi    a,ttrue
  610.     sta    eqref
  611.     sta    dt3
  612.  
  613. cs12b:    mov    a,b
  614.     call    up$alph
  615.     jc    epscomma
  616.  
  617. ;change the 2 letters to upper case
  618.     mov    b,a
  619.     mov    c,l
  620.  
  621.     lda    dt3
  622.     cpi    '-'
  623.     jz    cs13
  624.  
  625.     call    upalph
  626.     jc    cs13a
  627.  
  628. cs13:    call    getrlets
  629.  
  630. cs13a:
  631. ;allow for some synonyms
  632.     lxi    h,cs14
  633.     push    h
  634.  
  635.     lxi    h,..syns-2
  636. cs13b:    inx    h
  637.     inx    h
  638.     mov    a,m
  639.     ora    a
  640.     rz
  641.     inx    h
  642.     mov    d,m
  643.     inx    h
  644.     cmp    c
  645.     jnz    cs13b
  646.     mov    a,d
  647.     cmp    b
  648.     jnz    cs13b
  649.     mov    c,m
  650.     inx    h
  651.     mov    b,m
  652.     ret
  653.  
  654. ;(this ought to be made configurable)
  655. ..syns:
  656.     db    'FI','CO'
  657.     db    'LE','SL'
  658.     db    'LM','AD'
  659.     db    0
  660.  
  661. ;
  662. ;        typeval = valtp[dt1-'@'][dt2-'@'];
  663. ;        arg = val[dt1-'@'][dt2-'@'];
  664.  
  665. ;cs14:
  666. varval:
  667.     mov    l,c
  668.     mvi    h,0
  669.     lxi    d,-'@'
  670.     dad    d
  671.     lxi    d,27
  672.     call    usmul
  673.     PUSH    H
  674.  
  675.     lxi    d,valtp
  676.     dad    d
  677.     push    h
  678.  
  679.     mov    l,b
  680.     mvi    h,0
  681.     lxi    d,-'@'
  682.     dad    d
  683.  
  684.     pop    d
  685.     dad    d
  686.  
  687.     MOV    A,M
  688.     STA    TYPEVAL
  689.     shld    typvadr
  690.  
  691. ;if macro, treat as '\=...'
  692.     lxi    h,eqref
  693.     ani    MCRO
  694.     ora    m
  695.     mov    m,a
  696.  
  697. ;[dt1-'@']
  698.     POP    H
  699. ;val is word array
  700.     DAD    H
  701.  
  702.     lxi    d,val
  703.     dad    d
  704. ;val[dt1-'@']
  705.     push    h
  706.  
  707.     mov    l,b
  708.     mvi    h,0
  709.     lxi    d,-'@'
  710.     dad    d
  711. ;...[dt2-'@'] word ref.
  712.     dad    h
  713.  
  714.     pop    d
  715.     dad    d
  716.  
  717.     SHLD    VLDTADR
  718.  
  719.     mov    a,m
  720.     inx    h
  721.     mov    h,m
  722.     mov    l,a
  723.     shld    arg
  724.     ret
  725.  
  726. cs14:    call    varval
  727.     shld    oldarg
  728. ;
  729. ;        if (eqref) {inject(arg); return(0); }
  730.  
  731.     LDA    eqref
  732.     ora    a
  733.     jz    cs15
  734.  
  735. ;check for STRING here, and if so, redirect input
  736.  
  737.     ani    MCRO
  738.     jnz    cs14s
  739.  
  740.     mvi    a,'@'
  741.     cmp    c
  742.     jnz    cs14v
  743.     cmp    b
  744.     jnz    cs14s
  745. ;here it was '\=$$'
  746.     call    sundirect
  747. ;    xra    a
  748. ;    jmp    scanwhit
  749.     jmp    sw1
  750.  
  751. cs14v:    cmp    b
  752.     jnz    cs14a
  753. cs14s:
  754. ;arg still in HL
  755.     mov    a,h
  756.     ora    l
  757. ;if nothing stored for this string variable, ignore it
  758.     jnz    sdirect
  759.     ret
  760.  
  761. cs14a:
  762. ;arg still in HL
  763.     push    h
  764.     call    inject
  765.     pop    d
  766.     ret
  767. ;
  768. ;        if (typeval & BRK) {brkflag = TRUE; prtsbuf(); }
  769.  
  770. cs15:
  771.     LDA    TYPEVAL
  772.     mov    e,a
  773.     ani    BRKAFT
  774.     mov    a,e
  775.     jz    cs15a
  776.     sta    bkaft
  777. cs15a:    ANI    BRK
  778. ;    jz    cs15b
  779.     cnz    csprtsbuf
  780.     jmp    cs15b
  781.  
  782. ;the coming call to prtsbuf may lead to other cseq calls for
  783. ;headings or footings, so have to save some values now
  784. csprtsbuf:
  785.     lhld    vldtadr
  786.     push    h
  787.     lhld    arg
  788.     push    h
  789.     lda    typeval
  790.     push    psw
  791.     lhld    typvadr
  792.     push    h
  793.  
  794.     mvi    a,1
  795.     sta    brkflag
  796.     call    prtsbuf
  797.  
  798.     pop    h
  799.     shld    typvadr
  800.     pop    psw
  801.     sta    typeval
  802.     pop    h
  803.     shld    arg
  804.     shld    oldarg
  805.     pop    h
  806.     shld    vldtadr
  807.     ret
  808.  
  809. ;check for no num. arg
  810. cs15b:    lda    typeval
  811.     mov    e,a
  812.     ani    ARGTRUE
  813.     cpi    ARGTRUE
  814.     jnz    cs16
  815.     lxi    h,1
  816.     shld    arg
  817.     jmp    cs56
  818. ;
  819. ;        if (typeval & FLAGCH) return(arg);
  820.  
  821. cs16:
  822. ;    LDA    TYPEVAL
  823. ;    mov    e,a
  824.     mov    a,e
  825.     ANI    FLAGCH
  826.     jz    cs17
  827.  
  828. ;check for in-adjust and out-adjust
  829.     lda    pn
  830.     ani    1
  831.     mov    e,a
  832.  
  833.     mov    a,c
  834.     cpi    'I'
  835.     jnz    cs16o
  836.     mov    a,e
  837.     xri    1
  838.     mov    e,a
  839.     jmp    cs16p
  840.  
  841. ;    mov    a,c
  842. cs16o:    cpi    'O'
  843.     jnz    cs16a
  844. cs16p:    mov    a,b
  845.     cpi    'A'
  846.     jnz    cs16a
  847. ;if even page and out-adjust, no action
  848. ;    lda    pn
  849. ;    ani    1
  850.     mov    a,e
  851.     ora    a
  852.     rz
  853. cs16a:
  854.     lda    arg
  855.     cpi    PAFLAG
  856.     jz    getchar##
  857.     
  858.     pop    h
  859.     mov    l,a
  860.     mvi    h,0
  861.     pop    b
  862.     ret
  863. ;
  864. ;        if (typeval & CHARG)
  865. ;        {    dt3 = inbuf[inpoint];
  866. ;            if (dt3 == '\n') dt3 = 0;
  867. ;            val[dt1-'@'][dt2-'@'] = dt3;
  868. ;            if (dt3) scanwhite(TRUE);
  869. ;            return(0);
  870. ;        }
  871. ;(keep "dt3" in A)
  872. cs17:
  873. ;    LDA    TYPEVAL
  874.     mov    a,e
  875.     ani    CHARG
  876.     jz    cs20
  877.  
  878.     call    inbch
  879.     call    isdec
  880.     jc    cs17a
  881.     call    numscan
  882.     mov    a,l
  883.     jmp    cs18    ;(blanks will not be skipped after '0')
  884. cs17a:
  885.     cpi    newline
  886.     jnz    cs18
  887.     xra    a
  888. cs18:
  889.     lhld    vldtadr
  890.     mov    m,a
  891.  
  892.     ora    a
  893.     jnz    scanwhit
  894.     ret    ;to next
  895. csret0:
  896.     lxi    h,0
  897.     pop    b
  898.     ret
  899.  
  900. cs20:
  901. ;this seems a good place to store a string
  902.     mvi    a,'@'
  903.     cmp    c
  904.     jz    cs$S
  905.     cmp    b
  906.     jnz    cs20a
  907.  
  908. cs$S:    push    b    ;use C for last char
  909.     lhld    _$point
  910.     shld    arg
  911.     push    h
  912. cs$L:
  913.     call    inbch
  914.     ora    a
  915.     jz    cs$d
  916.     cpi    0ah
  917.     jz    cs$d
  918.     pop    h
  919.     mov    m,a
  920.     mov    c,a
  921.     inx    h
  922.     push    h
  923.     call    nxspnt
  924.     jmp    cs$L
  925.  
  926. cs$d:    pop    h
  927. ;see if had '\' at eol
  928.     lda    ec
  929.     cmp    c
  930.     jnz    cs$e
  931. ;if so, back to store over it and continue with new input line
  932.     dcx    h
  933.     push    h
  934.     call    cs1
  935.     jmp    cs$L
  936.  
  937. ;else time to quit
  938. cs$e:    mvi    m,0
  939.     inx    h
  940.     shld    _$point
  941. freram    equ    011BH
  942. ;have we overlapped into font storage area?
  943.     xchg
  944.     lhld    freram
  945.     call    albu
  946.     jc    cs$ok
  947. ;yes, we have -- allot 512 more bytes for string storage
  948.     inr    h
  949.     inr    h
  950.     shld    freram
  951. ;reset allocation pointers
  952.     call    freeall##
  953. ;mark any resident fonts as unallocated
  954.     xra    a
  955.     mvi    e,NUMFTS*2
  956.     lxi    h,ftp
  957. cs$ua:    mov    m,a
  958.     inx    h
  959.     dcr    e
  960.     jnz    cs$ua
  961. cs$ok:    pop    b
  962.     jmp    cs56    ;go store arg in variable
  963. ;
  964. ;        if (dt1 == 'I' && dt2 == 'M')
  965. ;        {    extract(fnbuf);
  966. ;add call to fprefix()
  967. ;extract changed so it will get extension, too
  968. ;            strcat(fnbuf,".TXT"); /* ??? */
  969. ;            if (fopen(fnbuf) != ERROR) return(0);
  970. ;            eperror(110);
  971. ;        }
  972.  
  973. cs20a:
  974.     mov    a,c
  975.     cpi    'I'
  976.     jnz    cs22
  977.     mov    a,b
  978.     cpi    'M'
  979.     jnz    cs22
  980.  
  981.     lxi    h,fnbuf
  982.     push    h
  983.  
  984.     push    h
  985.     call    fprefix
  986.     pop    d
  987.  
  988.  
  989. ;extract arg in HL = fnbuf, which was on stack
  990.     pop    h
  991.     push    h
  992.  
  993.     call    extract
  994.  
  995.     pop    h
  996.     rc
  997. ;fnbuf address is still on the sttack
  998. ;    lxi    h,fnbuf
  999.     push    h
  1000.     call    fopen
  1001.     pop    d
  1002.     inx    h
  1003.     mov    a,h
  1004.     ora    l
  1005.     rnz
  1006.  
  1007.     lxi    h,110
  1008.     push    h
  1009.     call    eperror
  1010.  
  1011. ;
  1012. ;        if (dt1 == 'N' && dt2 == 'B')
  1013. ;        {    brkflag = FALSE;
  1014. ;            prtsbuf();
  1015. ;            return(0);
  1016. ;        }
  1017.  
  1018. cs22:
  1019.     mov    a,c
  1020.     cpi    'N'
  1021.     jnz    cs23
  1022.     mov    a,b
  1023.     cpi    'B'
  1024.     jnz    cs23
  1025.  
  1026.     xra    a
  1027.     sta    brkflag
  1028.     jmp    prtsbuf
  1029. ;
  1030. ;        arg = TRUE;
  1031. ;        havearg = FALSE;
  1032. ;        measure = divisor = 0;
  1033.  
  1034. cs23:
  1035.     xra    a
  1036.     sta    havearg
  1037.     call    csnumini
  1038. ;
  1039. ;        if (isdigit(inbuf[inpoint]))
  1040. ;        {    arg = numscan(); havearg = TRUE;
  1041. ;
  1042. ;            if (inbuf[inpoint] == '/')
  1043. ;            {    inpoint++; scrncol++;
  1044. ;                divisor = numscan();
  1045. ;            }
  1046. ;
  1047. ;            switch (toupper(inbuf[inpoint]))
  1048. ;            { case '.': measure = 1;        break;
  1049. ;              case 'P': measure = POINT;        break;
  1050. ;              case '"': if (typeval & HZNUM)
  1051. ;                    measure = INCH;
  1052. ;                    else if (typeval & VTNUM)
  1053. ;                    measure = VINCH;     break;
  1054. ;              default:  inpoint--; scrncol--;    break;
  1055. ;            }
  1056. ;
  1057. ;            scanwhite(TRUE);
  1058. ;        }
  1059.  
  1060.     call    inbch
  1061.     sta    argsign
  1062.     cpi    '+'
  1063.     jz    cs23a
  1064.     cpi    '-'
  1065.     jnz    cs23b
  1066. cs23a:
  1067.     call    scanwhit
  1068.     call    inbch
  1069. cs23b:    call    isdec
  1070.     jc    cs35
  1071.  
  1072.     lxi    h,measure
  1073.     dcr    m    ;back to 0
  1074.     call    dimdnum
  1075.     jmp    cs44a
  1076.  
  1077. csnumini:
  1078.     lxi    h,0
  1079.     shld    divisor
  1080.     inx    h
  1081.     shld    measure
  1082.     shld    arg
  1083.     ret
  1084.  
  1085. dimdnum:
  1086.     call    numscan
  1087.     shld    arg
  1088.     mvi    a,1
  1089.     sta    havearg
  1090.  
  1091. ;;-    LDA    TYPEVAL
  1092. ;;-    ANI    HZNUM OR VTNUM
  1093. ;;-    JZ    CS33    ;A = 0, so pass false to scanwhit
  1094.  
  1095.      call    inbch
  1096.     cpi    '/'
  1097.     jnz    cs24
  1098.  
  1099.     call    nxspnt
  1100.     call    numscan
  1101.     shld    divisor
  1102.  
  1103. cs24:
  1104.     call    inbch
  1105.     call    upalph
  1106.  
  1107.     lxi    h,1    
  1108.     cpi    '.'
  1109.     jz    cs32    ;A not 0, so pass true to scanwhit
  1110.     lxi    h,point
  1111.     cpi    'P'
  1112.     jz    cs32    ;A not 0, so pass true to scanwhit
  1113.     cpi    '"'
  1114.     mvi    a,0    ;pass FALSE to scanwhit
  1115.     jnz    cs33
  1116.  
  1117. ;              case '"': if (typeval & HZNUM)
  1118. ;                    measure = INCH;
  1119. ;                    else if (typeval & VTNUM)
  1120. ;                    measure = VINCH;     break;
  1121.  
  1122.     lda    typeval
  1123.     lhld    typvadr
  1124.     ora    m
  1125.     lxi    h,VINCH
  1126.     ani    VTNUM
  1127.     jnz    cs32
  1128.     lxi    h,INCH
  1129. cs32:    inr    a    ;pass TRUE to scanwhite
  1130.     shld    measure
  1131. cs33:
  1132.     call    scanwhit
  1133.     jmp    dimension
  1134.  
  1135. ;        else if (inbuf[inpoint] == '=')
  1136. ;        {    havearg = TRUE;
  1137. ;            scanwhite(TRUE);
  1138. ;            if (!isalpha(dt4 = toupper(inbuf[++inpoint])))
  1139. ;                return(0);
  1140. ;            dt5 = dt2;
  1141. ;            if (!isalpha(dt2 = toupper(inbuf[++inpoint])))
  1142. ;                return(0);
  1143. ;            if (isalpha(dt3 = inbuf[++inpoint]) || dt3 == '-')
  1144. ;                getrlets();
  1145. ;            arg = val[dt4-'@'][dt2-'@'];
  1146. ;            dt2 = dt5;
  1147. ;            scrncol += 3;
  1148. ;        }
  1149.  
  1150. cs35:
  1151. ;'=' is implicit after \if
  1152.     mov    a,c
  1153.     cpi    'I'
  1154.     jnz    cs35a
  1155.     mov    a,b
  1156.     cpi    'F'
  1157.     jz    cs35b
  1158. cs35a:    call    inbch
  1159.     cpi    '='
  1160.     jnz    cs40
  1161.     call    scanwhit
  1162.  
  1163.  
  1164. cs35b:
  1165.     mvi    a,ttrue
  1166.     sta    havearg
  1167.  
  1168.     call    inbch
  1169.     call    isdec
  1170.     jc    cs35c
  1171. ;here it's '... = number'
  1172.     call    dimdnum
  1173.     jmp    cs39b
  1174.  
  1175. ;(if STRING here, will get pointer)
  1176.  
  1177. cs35c:
  1178. ;(moved above)
  1179. ;;    mvi    a,ttrue
  1180. ;;    sta    havearg
  1181.  
  1182.     push    b    ;save key letters
  1183.  
  1184.     call    vvarval
  1185.     jmp    cs39a
  1186.  
  1187. vvarval:
  1188. ;make sure contents of var is interpreted as dots or 'n' or 'b'
  1189. ;;-    lxi    h,1
  1190. ;;-    shld    measure
  1191.     call    inbch
  1192.     call    up$alph
  1193.     jc    funnyvar
  1194.     mov    c,a
  1195.  
  1196.     call    nxspnt    ;scan over 1st letter
  1197.     call    inbch
  1198.     call    up$alph
  1199. ;if c =  @ and have digit here, may wish to test gargc
  1200.     jc    funnyvar
  1201.     mov    b,a
  1202.  
  1203.     call    nxspnt    ;scan over 2nd letter
  1204.     call    inbch
  1205.     call    up$alph
  1206.     jnc    cs38
  1207.  
  1208.     cpi    '-'
  1209.     jnz    cs39
  1210. cs38:    call    getrlets
  1211. cs39:    call    sw1
  1212. ;;-    lda    typeval
  1213. ;;-    push    psw
  1214.  
  1215.     mov    a,b
  1216.     cpi    'P'
  1217.     jnz    cs39np
  1218.     mov    a,c
  1219.     cpi    'H'
  1220.     jnz    cs39vp
  1221.     call    getlindent##
  1222.     xchg
  1223.     lhld    glen
  1224.     jmp    cs39xp
  1225. cs39vp:    cpi    'V'
  1226.     jnz    cs39np
  1227.     lhld    vposition
  1228.     xchg
  1229.     lhld    skdots
  1230. cs39xp:    dad    d
  1231.     shld    arg
  1232.     mov    a,b
  1233.     ora    a
  1234.     ret
  1235.  
  1236. cs39np:
  1237.     lhld    typvadr
  1238.     push    h
  1239.     lhld    vldtadr
  1240.     push    h
  1241.  
  1242.     call    varval
  1243.  
  1244.     pop    h
  1245.     shld    vldtadr
  1246.     pop    h
  1247.     shld    typvadr
  1248. ;;-    pop    psw
  1249. ;;-    sta    typeval
  1250.  
  1251.  
  1252. ;if it was '... = <string>', signal to mark it as a macro
  1253.     mov    a,c
  1254.     cpi    '@'
  1255.     rz
  1256.     mov    a,b
  1257.     cpi    '@'
  1258.     ret
  1259.  
  1260. cs39a:
  1261.     pop    b    ;get back key letters
  1262.     jz    cs39c    ;special case of var = string-var
  1263.  
  1264. ;here we can expect the rest of an expression
  1265. cs39b:
  1266.     call    csexp1
  1267. ;;;    jmp    cs56
  1268.     jmp    cs44a
  1269.  
  1270. csexp1:
  1271.     call    cssterm
  1272.     call    opletchk
  1273.     rnz
  1274. ;well, here's a comparison operator
  1275.     push    b    ;save key letters
  1276.     mov    c,a    ;put op letter in C
  1277.     call    nxspnt    ;scan over it
  1278.     call    inbch    ;next possible op letter to B
  1279.     mov    b,a
  1280.     call    opletchk
  1281.     cz    nxspnt    ;if it is, scan it, too
  1282.     call    sw1    ;over to beginning of next term
  1283.  
  1284.     call    csterm    ;set arg to val of next term
  1285.     push    d    ;save val of terms before comparison op
  1286.     call    cssterm    ;add or subtr any further terms
  1287.             ;cumulative returned in HL
  1288.     pop    d
  1289.     call    cscfterm    ;determine value of comparison
  1290.     shld    arg    ;and that's the new arg
  1291.     pop    b    ;restore key letters
  1292.     ret
  1293.  
  1294. cssterm:
  1295.     call    csmterm
  1296.  
  1297.     cpi    '+'
  1298.     jz    $+6
  1299.     cpi    '-'
  1300.     rnz
  1301.     push    psw
  1302.     call    scanwhit
  1303.     call    csterm
  1304.  
  1305.     push    d
  1306.     call    csmterm
  1307.     pop    d
  1308.  
  1309.     pop    psw
  1310.     cpi    '+'
  1311.     jz    $+6
  1312.     call    cmh
  1313.     dad    d
  1314.     shld    arg
  1315.     jmp    cssterm
  1316.  
  1317. csmterm:
  1318.     push    h
  1319.     call    inbch
  1320.     pop    h
  1321.     cpi    '*'
  1322.     jz    $+6
  1323.     cpi    '/'
  1324.     rnz
  1325.     push    psw
  1326.     call    scanwhit
  1327.     call    csterm
  1328.     pop    psw
  1329.     cpi    '*'
  1330.     jz    $+9
  1331.     call    usdiv
  1332.     jmp    $+6
  1333.     call    usmul
  1334.     shld    arg
  1335.     jmp    csmterm
  1336.  
  1337. csterm:
  1338.     push    h
  1339.     push    d
  1340.     call    inbch
  1341.     pop    d
  1342.     pop    h
  1343.     cpi    '('
  1344.     jnz    csimple
  1345.     call    scanwhit
  1346.     xra    a
  1347.     sta    vsflag
  1348.     call    csterm
  1349.     push    d
  1350.     call    csexp1
  1351.     call    inbch
  1352.     cpi    ')'
  1353.     jnz    funnyvar
  1354.     call    scanwhit
  1355.     lda    vsflag
  1356.     ora    a
  1357.     lhld    arg
  1358.     pop    d
  1359.     rz
  1360.     mov    l,m
  1361.     mvi    h,0
  1362.     shld    arg
  1363.     ret
  1364.  
  1365. csimple:
  1366.     push    b    ;keep the op letters
  1367.     lhld    arg    ;save value of first term
  1368.     push    h
  1369.     call    inbch    ;see if next is number
  1370.     call    isdec
  1371.     jc    cs39b.1    ;if not, must be a variable
  1372.     call    csnumini
  1373.     call    dimdnum
  1374.     jmp    cs39b.2
  1375. cs39b.1:
  1376.     call    vvarval
  1377.     jnz    cs39b.2
  1378.     sta    vsflag
  1379. cs39b.2:
  1380.     lhld    arg    ;this is value of 2nd term
  1381.     pop    d    ;this is first
  1382.     pop    b    ;here are the op letters
  1383.     ret
  1384.  
  1385. vsflag:    db    0
  1386.  
  1387. ;check if A has a possible comparison op letter
  1388. opletchk:
  1389.     cpi    '='
  1390.     rz
  1391.     cpi    '<'
  1392.     rz
  1393.     cpi    '>'
  1394.     ret
  1395.  
  1396. cscfterm:
  1397.     call    eqwel
  1398.     mvi    a,'='
  1399.     jz    .cft
  1400.     call    albu
  1401.     mvi    a,'<'
  1402.     jc    .cft
  1403.     mvi    a,'>'
  1404.  
  1405. .cft:    lxi    h,1
  1406.     cmp    c
  1407.     rz
  1408.     cmp    b
  1409.     rz
  1410.     dcx    h
  1411.     ret
  1412.  
  1413.  
  1414.  
  1415. cs39c:
  1416.     mvi    a,MCRO
  1417.     sta    typeval
  1418.     lhld    typvadr
  1419.     mov    m,a
  1420. ;... and block further special actions in case redefining native word
  1421.     lxi    b,0
  1422. ;... and go store argument
  1423.     jmp    cs56    
  1424.  
  1425.  
  1426. funnyvar:
  1427.     lxi    h,146
  1428.     push    h
  1429.     call    eperror##
  1430.  
  1431.  
  1432. ;        else if (dt1 == 'F' && dt2 == 'O') arg = grabfont();
  1433.  
  1434. cs40:
  1435.  
  1436.     mov    a,c
  1437.     cpi    'G'
  1438.     jnz    cs40a
  1439.     mov    a,b
  1440.     cpi    'F'
  1441.     jz    cs40b
  1442. cs40a:
  1443.     mov    a,c
  1444.     cpi    'F'
  1445.     jnz    cs41
  1446.     mov    a,b
  1447.     cpi    'O'
  1448.     jnz    cs41
  1449.     xra    a
  1450. cs40b:    sta    gfflag
  1451.     call    grabfont
  1452.     rc
  1453.     shld    arg
  1454.     jmp    cs56    ;? does not allow inc/dec
  1455. ;
  1456. ;        if (typeval & (HZNUM | VTNUM))
  1457. ;        {    if (!measure) measure =
  1458. ;                  (typeval & VTNUM) ? PICA+sl : PICA;
  1459. ;            arg *= measure;
  1460. ;            if (divisor) arg = (arg + divisor - 1)/divisor;
  1461. ;        }
  1462.  
  1463. dimension:
  1464. ;;-    lda    typeval
  1465. ;;-    mov    e,a
  1466. ;;-    ani    HZNUM or VTNUM
  1467. ;;-    rz
  1468.  
  1469.     lhld    measure
  1470.     mov    a,h
  1471.     ora    l
  1472.     jnz    cs44
  1473.  
  1474.     lda    typeval
  1475.     mov    e,a
  1476.     ani    VTNUM
  1477.     jnz    cs42.0
  1478.     mov    a,e
  1479.     ani    HZNUM
  1480.     inx    h    ;HL = 1
  1481.     jz    cs42
  1482.     lxi    h,PICA
  1483.     jmp    cs42
  1484. cs42.0:
  1485.     lhld    sl
  1486.     xchg
  1487.     lhld    cheight
  1488.     dad    d
  1489. cs42:    shld    measure
  1490.  
  1491. cs44:    xchg
  1492.     lhld    arg
  1493.     call    usmul    ;was smul
  1494.     shld    arg
  1495.  
  1496.     lhld    divisor
  1497.     mov    a,h
  1498.     ora    l
  1499.     rz
  1500.  
  1501.     push    h
  1502. ;make following divide a rounding operation
  1503.     xchg
  1504.     lhld    arg
  1505.     dad    d
  1506.     dcx    h
  1507.     xchg
  1508. ; DE = arg + (divisor - 1)
  1509.     pop    h
  1510. ; DE / divisor
  1511.     call    usdiv    ;was 'sdiv'
  1512.     shld    arg
  1513.     ret
  1514.  
  1515. cs41:
  1516. ;here when no numerical argument
  1517.     lxi    h,0
  1518.     shld    measure
  1519.     call    dimension
  1520.  
  1521. cs44a:
  1522. ;get back type in case var. in expression had some different type
  1523.     lhld    typvadr
  1524.     mov    a,m
  1525.     sta    typeval
  1526.  
  1527.     lhld    arg
  1528.     xchg
  1529.     lhld    oldarg
  1530.     lda    argsign
  1531.     cpi    '-'
  1532.     push    psw
  1533.     cz    cmd
  1534.     dad    d
  1535.     pop    psw
  1536.     jz    cs44b
  1537.     cpi    '+'
  1538.     jnz    cs45
  1539. cs44b:    shld    arg
  1540.     sta    havearg
  1541. ;
  1542. ;        if (typeval & EPSSYN)
  1543. ;        {    dt1 = val[dt1-'@'][dt2-'@'];
  1544. ;            if (!arg)
  1545. ;            {    dt2 = '0';
  1546. ;                switch (dt1)
  1547. ;                {    case 'E':
  1548. ;                    case 'G':
  1549. ;                    case  4:
  1550. ;                        dt1++;    break;
  1551. ;                    case 'M':
  1552. ;                    case  15:
  1553. ;                        dt1 += 3; break;
  1554. ;                    case 'S':
  1555. ;                    case '0':
  1556. ;                        dt1 = 'T'; break;
  1557. ;                }
  1558. ;            }
  1559. ;            else if (dt1 == '0') { dt1 = 'S'; dt2 = '0'; }
  1560. ;            epscommand();
  1561. ;            return(0);
  1562. ;        }
  1563.  
  1564. cs45:
  1565.     lda    typeval
  1566.     ani    epssyn
  1567.     jz    cs52
  1568.     lhld    vldtadr
  1569.  
  1570.     mov    c,m
  1571.  
  1572.     lhld    arg
  1573.     mov    a,h
  1574.     ora    l
  1575.     jnz    cs50
  1576.  
  1577.     mvi    b,'0'
  1578.  
  1579.     mov    a,c
  1580.     cpi    'E'
  1581.     jz    cs46
  1582.     cpi    'G'
  1583.     jz    cs46
  1584.     cpi    4
  1585.     jz    cs46
  1586.     cpi    'M'
  1587.     jz    cs47
  1588.     cpi    15
  1589.     jz    cs47
  1590.     cpi    'S'
  1591.     jz    cs48
  1592.     cpi    '0'
  1593.     jz    cs48
  1594.     jmp    cs51
  1595. cs46:
  1596.     inr    a
  1597.     jmp    cs50a
  1598. cs47:
  1599.     adi    3
  1600.     jmp    cs50a
  1601. cs48:
  1602.     mvi    a,'T'
  1603.     jmp    cs50a
  1604. cs50:
  1605.     mov    a,c
  1606.     cpi    '0'
  1607.     jnz    cs51
  1608.  
  1609.     mvi    b,'0'
  1610.  
  1611.     mvi    a,'S'
  1612. cs50a:
  1613.     mov    c,a
  1614. cs51:
  1615.     jmp    epscomma
  1616.  
  1617. ;
  1618. ;        if (dt1 == 'B' && dt2 == 'E')
  1619. ;        {    if (havearg)
  1620. ;            {    brkflag = TRUE;
  1621. ;                prtsbuf();
  1622. ;            }
  1623. ;            else
  1624. ;            {    modepush();
  1625. ;                if (arg) mode |= BENT;
  1626. ;                 else mode &= ~BENT;
  1627. ;                return(0);
  1628. ;            }
  1629. ;        }
  1630.  
  1631. cs52:
  1632.     mov    a,c
  1633.     cpi    'B'
  1634.     jnz    cs56
  1635.     mov    a,b
  1636.     cpi    'E'
  1637.     jnz    cs56
  1638.  
  1639.     lda    havearg
  1640.     ora    a
  1641.     jz    cs53
  1642.  
  1643. ;    mvi    a,1
  1644. ;    sta    brkflag
  1645. ;    call    prtsbuf
  1646.     call    csprtsbuf
  1647.     jmp    cs56
  1648.  
  1649. cs53:    call    modepush
  1650.  
  1651.     lhld    arg
  1652.     mov    a,h
  1653.     ora    l
  1654.     lhld    mode
  1655.     jz    cs54
  1656.  
  1657. ;    lhld    mode
  1658.     lxi    d,bent
  1659.     mov    a,h
  1660.     ora    d
  1661.     mov    h,a
  1662.     mov    a,l
  1663.     ora    e
  1664.     mov    l,a
  1665.     jmp    cs55
  1666.  
  1667. cs54:
  1668. ;    lhld    mode
  1669.     lxi    d,not bent    ;0DFFFH
  1670.     mov    a,h
  1671.     ana    d
  1672.     mov    h,a
  1673.     mov    a,l
  1674.     ana    e
  1675.     mov    l,a
  1676. cs55:
  1677.     shld    mode
  1678.     ret
  1679. ;
  1680. ;        val[dt1-'@'][dt2-'@'] = arg;
  1681.  
  1682. cs56:
  1683.     lhld    arg
  1684.     xchg
  1685.     lhld    vldtadr
  1686.     mov    m,e
  1687.     inx    h
  1688.     mov    m,d
  1689.  
  1690. ;
  1691. ;        if (dt1 == 'N' && dt2 == 'C')
  1692. ;          if (arg > 1)
  1693. ;          {    for (cc = 1; cc <= nc; cc++)
  1694. ;            {    brcpt[cc] = 1;
  1695. ;                brcstk[cc][0] = mode;
  1696. ;            }
  1697. ;            cc = 1;
  1698. ;          }
  1699. ;          else    nc = 0;
  1700.  
  1701.     mov    a,c
  1702.     cpi    'N'
  1703.     jnz    cs60
  1704.     mov    a,b
  1705.     cpi    'C'
  1706.     jnz    cs60
  1707.  
  1708.     lda    arg
  1709.     cpi    2
  1710.     jc    cs59
  1711.     lxi    h,1
  1712.     shld    cc
  1713.     push    b
  1714. ;C = the column = 1
  1715.     mov    c,l
  1716. ;B = nc + 1
  1717.     inr    a
  1718.     mov    b,a
  1719. cs57:
  1720.     xra    a
  1721. ;index from current C
  1722.     mov    l,c
  1723.     mov    h,a
  1724.  
  1725. ;word index for brcpt
  1726.     dad    h
  1727. ;save a copy
  1728.     push    h
  1729.  
  1730.     lxi    d,brcpt
  1731.     dad    d
  1732.     mvi    m,1
  1733.     inx    h
  1734.     mov    m,a
  1735.  
  1736.     pop    h
  1737. ;each col gets 6 words on stack
  1738.     lxi    d,6
  1739.     call    usmul
  1740.     lxi    d,brcstk
  1741.     dad    d
  1742.  
  1743.     xchg
  1744.     lhld    mode
  1745.     xchg
  1746.     mov    m,e
  1747.     inx    h
  1748.     mov    m,d
  1749.  
  1750. ;next col
  1751.     inr     c
  1752.     mov    a,c
  1753.     cmp    b
  1754.     jnz    cs57
  1755.  
  1756. cs58:    pop    b
  1757.     jmp    cs60
  1758.  
  1759. cs59:    lxi    h,0
  1760.     shld    nc
  1761. ;
  1762. ;        if (typeval & BRK) newoutline();
  1763.  
  1764. cs60:
  1765.     lda    typeval
  1766.     mov    e,a
  1767.     ani    brk
  1768.     jz    cs60.2
  1769.     mov    a,e
  1770.     ani    HZNUM
  1771.     jz    cs60.1
  1772.     xra    a
  1773.     sta    mcinok
  1774. cs60.1:    call    newoutli
  1775. cs60.2:
  1776.  
  1777. ;here begin various ad hoc actions for certain commands
  1778.  
  1779.     lxi    h,.csTAB-3
  1780. .csSWLOOP:
  1781.     inx    h
  1782.     inx    h
  1783.     inx    h
  1784.     mov    a,m
  1785.     ora    a
  1786.     rz
  1787.     inx    h
  1788.     cmp    c
  1789.     jnz    .csSWLOOP
  1790.     mov    a,m
  1791.     cmp    b
  1792.     jnz    .csSWLOOP
  1793.     inx    h
  1794.     mov    e,m
  1795.     inx    h
  1796.     mov    d,m
  1797.     xchg
  1798.     pchl
  1799.  
  1800. .csTAB:
  1801.     db    'CL'
  1802.     dw    cs_CL
  1803.     db    'TB'
  1804.     dw    cs_TB
  1805.     db    'TS'
  1806.     dw    cs_TB
  1807.     db    'HS'
  1808.     dw    cs_HS
  1809.     db    'SK'
  1810.     dw    cs_SK
  1811.     db    'SU'
  1812.     dw    cs_SK
  1813.     db    'FO'
  1814.     dw    cs_FO
  1815.     db    'TA'
  1816.     dw    cs_TA
  1817.     db    'IF'
  1818.     dw    cs_IF
  1819.     db    'AT'
  1820.     dw    cs_AT
  1821.     db    'ER'
  1822.     dw    cs_ER
  1823.     db    'GT'
  1824.     dw    cs_GT
  1825.     db    'RU'
  1826.     dw    cs_RU
  1827.     db    'WF'
  1828.     dw    cs_WF
  1829.     db    'RL'
  1830.     dw    cs_RL
  1831.  
  1832.     if    lvers
  1833.  
  1834.     .request DRAW
  1835.  
  1836.     db    'NO'
  1837.     dw    cs_NO
  1838.     db    'DR'
  1839.     dw    cs_DR
  1840.     endif
  1841.  
  1842.     db    0
  1843.  
  1844. ;
  1845. ;        if (dt1 == 'C' && dt2 == 'L') gotocol(arg);
  1846.  
  1847. cs_RL:    lda    arg
  1848.     ora    a
  1849.     jz    cs6a
  1850.     lhld    inpoint
  1851.     shld    rlpoint
  1852.     ret
  1853.  
  1854. cs_CL:
  1855.     lhld    arg
  1856.     push    h
  1857.     call    gotocol
  1858.     pop    d
  1859.     ret
  1860.  
  1861.     if    lvers
  1862. cs_DR:    jmp    draw##
  1863.  
  1864. cs_NO:
  1865.     lda    arg
  1866.     cpi    NUMLINES
  1867.     rnc
  1868.  
  1869.     mov    l,a
  1870.     mvi    h,0
  1871.     lxi    d,lilist
  1872.     dad    h    ;4 words each line
  1873.     dad    h
  1874.     dad    h
  1875.     dad    d
  1876. ;if one endpoint already defined, make this the other endpoint
  1877.     mov    a,m
  1878.     inx    h
  1879.     ora    m
  1880.     dcx    h
  1881.     jz    $+7
  1882.     inx    h
  1883.     inx    h
  1884.     inx    h
  1885.     inx    h
  1886.  
  1887. ;enter v. position
  1888.     push    h
  1889.     lhld    vposition
  1890.     xchg
  1891.     lhld    skdots
  1892.     dad    d
  1893.     xchg
  1894.     pop    h
  1895.     mov    m,e
  1896.     inx    h
  1897.     mov    m,d
  1898.     inx    h
  1899.  
  1900.     jmp    .csRU1
  1901.  
  1902.     endif
  1903.  
  1904. cs_RU:
  1905.     lda    arg
  1906.     cpi    NUMRULES
  1907.     rnc
  1908.     mov    l,a
  1909.     inr    a
  1910.     sta    grfflag
  1911.  
  1912. ;;    mov    l,a cf. above
  1913.     mvi    h,0
  1914.     lxi    d,rulist
  1915.     dad    h    ;2 words each rule (eventually 4?)
  1916.     dad    h
  1917.     dad    d
  1918. ;if one endpoint already defined, make this the other endpoint
  1919.     mov    a,m
  1920.     inx    h
  1921.     ora    m
  1922.     inx    h
  1923.     jnz    $+5
  1924.     dcx    h
  1925.     dcx    h
  1926.  
  1927. .csRU1:
  1928.     push    h
  1929. ;;    call    getlindent##
  1930.     call    inover##
  1931.     xchg
  1932.     lhld    mcoloffset
  1933.     dad    d
  1934.     xchg
  1935.     jmp    .csTB3
  1936.  
  1937.  
  1938. cs_CT:
  1939.     mvi    e,32*2
  1940.     xra    a
  1941.     lxi    h,utabs
  1942. .csCT1:    mov    m,a
  1943.     inx    h
  1944.     dcr    e
  1945.     jnz    .csCT1
  1946.     ret
  1947.  
  1948. cs_TB:
  1949.     mov    d,a    ;save 2nd letter
  1950.     lda    arg
  1951.     mov    e,a
  1952.     lda    havearg
  1953.     ora    a
  1954.     lxi    h,nexttab
  1955.     jz    $+4
  1956.     mov    m,e
  1957.  
  1958.     mov    a,m
  1959.     inr    m
  1960. .csTB1:
  1961.     ;only 32 stops allowed
  1962.     cpi    32
  1963.     rnc
  1964.     mov    l,a
  1965.     mvi    h,0
  1966.     mov    a,d
  1967.     lxi    d,utabs
  1968.     dad    h
  1969.     dad    d    ;HL -> value tab stop
  1970.     cpi    'S'
  1971.     jnz    cs61v
  1972. .csTB2:    push    h
  1973.     call    getlindent##
  1974. .csTB3:    lhld    glen
  1975.     dad    d
  1976. ;if 0, up a teeny bit so it counts as set
  1977.     mov    a,h
  1978.     ora    l
  1979.     jnz    $+4
  1980.     inx    h
  1981.  
  1982.     xchg
  1983.     pop    h
  1984.     mov    m,e
  1985.     inx    h
  1986.     mov    m,d
  1987.     ret
  1988.  
  1989. cs61v:    mov    e,m
  1990.     inx    h
  1991.     mov    d,m
  1992.     dcx    h
  1993. ;if no stop has been set, treat \tb as \ts (a la TEX)
  1994.     mov    a,d
  1995.     ora    e
  1996.     jz    .csTB2
  1997.  
  1998.     push    d
  1999.     call    gotocol
  2000.     pop    d
  2001.     ret
  2002.  
  2003. cs_HS:
  2004.     lhld    arg
  2005.     push    h
  2006.     call    hzspace
  2007.     pop    d
  2008.     ret
  2009.  
  2010. cs_WF:
  2011.     lda    havearg
  2012.     ora    a
  2013.     lda    arg
  2014.     jnz    $+5
  2015.     mvi    a,100
  2016.  
  2017.     call    wadjust##
  2018.     shld    st
  2019.     xchg
  2020.     shld    sh
  2021.     ret
  2022.  
  2023. ;        else if (dt1 == 'S' && dt2 == 'K') skdots += arg;
  2024.  
  2025. cs_SK:
  2026.     lhld    skdots
  2027.     xchg
  2028.     lhld    arg
  2029.     cpi    'U'    ;was it skip-up?
  2030. ;(added)
  2031. ;check continuing vertical rules (will this work?)
  2032.     jnz    docvrule##
  2033.  
  2034.     cz    cmh
  2035.     dad    d
  2036.     shld    skdots
  2037.     ret
  2038.  
  2039. ;        else if (dt1 == 'F' && dt2 == 'O')
  2040. ;        {    modepush();
  2041. ;
  2042. ;            if (arg < 32 && attach[arg]) mode = attach[arg];
  2043. ;
  2044. ;            if (arg > 7)
  2045. ;            {    arg = mode & 0x700;
  2046. ;                fo = arg >> 8;
  2047. ;            }
  2048. ;            else arg <<= 8;
  2049. ;
  2050. ;            mode = (mode & 0xF8FF) | arg;
  2051. ;        }
  2052.  
  2053.  
  2054. cs_FO:
  2055.     call    modepush
  2056.  
  2057.     lhld    arg
  2058.     xchg
  2059.     lxi    h,149
  2060.     mov    a,d
  2061.     ora    a
  2062.     jnz    cs_ER1    ;font >= 256?
  2063.     mov    a,e
  2064.     cpi    32
  2065.     jnc    cs_ER1
  2066.  
  2067.     xchg
  2068.     dad    h
  2069.     lxi    d,attach
  2070.     dad    d
  2071.     mov    a,m
  2072.     inx    h
  2073.     mov    h,m
  2074.     mov    l,a
  2075.  
  2076.     ora    h
  2077.     jz    cs64
  2078.     shld    mode
  2079.     mov    a,h
  2080.     ani    7
  2081.     sta    fo
  2082.     ret
  2083.  
  2084.  
  2085. cs64:
  2086. ;if no attachment, and arg > 7, that's an error
  2087.     lxi    h,148
  2088.     lda    arg
  2089.     cpi    7+1
  2090.     jnc    cs_ER1
  2091.  
  2092. ;else OK, so enter into font var and mode
  2093.     sta    fo
  2094.     mov    e,a
  2095.     lda    mode+1
  2096.     ani    0f8h
  2097.     ora    e
  2098.     jmp    cs71
  2099.  
  2100.  
  2101. ;        else if (dt1 == 'T' && dt2 == 'A')
  2102. ;        {    modepush();
  2103. ;            if (arg) mode |= TALL;
  2104. ;            else mode &= ~TALL;
  2105. ;        }
  2106.  
  2107. cs_TA:
  2108.     call    modepush
  2109.  
  2110.     LDA    MODE+1
  2111.     ANI    (not tall) shr 8
  2112.     MOV    D,A
  2113.     lhld    arg
  2114.     mov    a,h
  2115.     ora    l
  2116.     MOV    A,D    
  2117.     jz    CS71    ;cs68
  2118.     ORI    tall shr 8
  2119.     JMP    CS71
  2120.  
  2121. ;        else if (dt1 == 'I' && dt2 == 'F')
  2122. ;        {    modepush();
  2123. ;            if (arg) mode |= IGNORE;
  2124. ;            else mode &= ~IGNORE;
  2125. ;        }
  2126.  
  2127. cs_IF:
  2128.  
  2129. ;in case of 'if = <string>' remove macro designation
  2130.     lhld    typvadr
  2131.     mvi    m,0
  2132.  
  2133. ;if not looking a block in the face, just skip rest of line on false
  2134.     call    inbch
  2135.     cpi    '{'
  2136.     jz    .csIF1
  2137.     lhld    arg
  2138.     mov    a,h
  2139.     ora    l
  2140.     rnz
  2141.     jmp    cs6a    ;return as for \*
  2142.  
  2143. .csIF1:
  2144.     call    modepush
  2145.  
  2146.     LDA    MODE+1
  2147.     ANI    (not ignore) shr 8
  2148.     MOV    D,A
  2149.     lhld    arg
  2150.     mov    a,h
  2151.     ora    l
  2152.     MOV    A,D
  2153.     jnz    cs71
  2154.     ORI    ignore shr 8
  2155. cs71:    STA    MODE+1
  2156.     ret
  2157. ;        else if (dt1 == 'A' && dt2 == 'T')
  2158. ;        {    if (!havearg) arg = fo;
  2159. ;            if (arg < 32) attach[arg] = mode;
  2160. ;        }
  2161.  
  2162. cs_AT:
  2163.     LDA    havearg
  2164.     ora    a
  2165.     jnz    cs74
  2166.  
  2167.     lhld    fo
  2168.     shld    arg
  2169.  
  2170.     call    dokern
  2171.  
  2172. cs74:
  2173.     lhld    arg
  2174.     mov    a,h
  2175.     ora    a
  2176.     rnz    ;should be error
  2177.     mov    a,l
  2178.     cpi    32
  2179.     rnc    ;should be error
  2180.  
  2181.     dad    h
  2182.     lxi    d,attach
  2183.     dad    d
  2184.  
  2185.     xchg
  2186.     lhld    mode
  2187.     xchg
  2188.  
  2189.     mov    m,e
  2190.     inx    h
  2191.     mov    m,d
  2192.     ret
  2193.  
  2194. dokern:
  2195.     mov    e,l    ;arg = fo
  2196.     lhld    val + 2*('K'-'@')
  2197.     mov    a,h    ;no kern string defined?
  2198.     ora    l
  2199.     rz
  2200.     mov    a,m    ;kern string null?
  2201.     ora    a
  2202.     rz
  2203.     dcr    e    ;attach 0 request?
  2204.     rm
  2205.     push    h
  2206.     mov    l,e
  2207.     mvi    h,0
  2208.     dad    h
  2209.     lxi    d,klist
  2210.     dad    d
  2211.     pop    d
  2212.     mov    m,e
  2213.     inx    h
  2214.     mov    m,d
  2215.     pop    h    ;escape from call
  2216.     ret
  2217.  
  2218.  
  2219.  
  2220. ;new command ERror
  2221. cs_ER:
  2222.     lxi    h,300
  2223. cs_ER1:
  2224.     push    h
  2225.     call    eperror##
  2226.  
  2227. cs_GT:
  2228. ;eol in inbuf is where to append string from console
  2229.     call    .fendin
  2230. ;add a blank to separate from any preceding command name
  2231.     mvi    m,' '
  2232.     inx    h
  2233. ;    push    h
  2234.     call    gets##
  2235. ;    pop    h
  2236. ;gets terminates it with a nul, but we want a newline,
  2237. ; so find the new end ..
  2238.     call    .fendin
  2239. ;and supply the termination
  2240.     mvi    m,0ah
  2241.     inx    h
  2242.     mvi    m,0
  2243.     ret
  2244.  
  2245. ;a little routine to find the end of the string or line
  2246. ;in inbuf
  2247. .fendin:
  2248.     lxi    h,inbuf-1
  2249. .fei1:    inx    h
  2250.     mov    a,m
  2251.     ora    a
  2252.     rz
  2253.     cpi    0ah
  2254.     jnz    .fei1
  2255.     ret
  2256.  
  2257. ;
  2258. ;    }
  2259. ;
  2260. ;    /* Otherwise, it's an Epson type command    */
  2261. ;    else epscommand();
  2262. ;
  2263. ;    return(0);
  2264. ;}
  2265.  
  2266. ;isdig -- return c if A is digit
  2267.     .comment    `
  2268. same as runtime routine isdec
  2269. isdig:    cpi    '0'
  2270.     rc
  2271.     cpi    '9'+1
  2272.     cmc
  2273.     ret
  2274.             `
  2275.  
  2276. ;
  2277. ;numscan()
  2278. ;{    int n;
  2279. ;
  2280. ;    n = atoi(inbuf+inpoint);
  2281. ;    while (isdigit(inbuf[inpoint]))
  2282. ;        { inpoint++; scrncol++; }
  2283. ;    return(n);
  2284. ;}
  2285.  
  2286.  
  2287. ;NUMSCAN is now modified version of ATOI
  2288.     .comment    `
  2289. int atoi(n)
  2290. char *n;
  2291. {
  2292.     int val; 
  2293.     char c;
  2294.     int sign;
  2295.     val=0;
  2296.     sign=1;
  2297.     while ((c = *n) == '\t' || c== ' ') ++n;
  2298.     if (c== '-') {sign = -1; n++;}
  2299.     while (  isdigit(c = *n++)) val = val * 10 + c - '0';
  2300.     return sign*val;
  2301. }            `
  2302.  
  2303. numscan:
  2304.  
  2305. ;val in HL, assumed 0
  2306.     lxi    h,0
  2307.  
  2308. ;loop here until no longer a digit
  2309.     push    h
  2310. ;can loop back to here with HL already pushed
  2311. .ai4a:
  2312.     call    inbch
  2313.     pop    h
  2314.  
  2315.     call    isdec
  2316.     rc
  2317.  
  2318.     sui    '0'    ;save binary of digit
  2319.     mov    e,a
  2320.     mvi    d,0
  2321.     push    d
  2322. ;multiply val by 10
  2323.     lxi    d,10
  2324.     call    usmul    ;(was smul)
  2325. ;add in binary of digit
  2326.     pop    d
  2327.     dad    d
  2328.  
  2329. ;            ;point next char
  2330.     push    h
  2331.     call    nxspnt
  2332.     jmp    .ai4a
  2333.  
  2334.  
  2335.  
  2336.  
  2337.     .comment    `
  2338. /************************************************/
  2339. /* When '{', push mode onto brcstk        */
  2340. /************************************************/
  2341. modepush()
  2342. {
  2343.     if (inbuf[inpoint] == '{' && brcpt[cc] < (BSTKSIZE-1))
  2344.                     should be " < BSTKSIZE"
  2345.     {    inpoint++; scrncol++;
  2346.         brcstk[cc][brcpt[cc]++] = mode;
  2347.         brccount = 0;
  2348.     }
  2349. }            `
  2350.  
  2351. modepush:
  2352.     call    inbch
  2353.     cpi    '{'
  2354.     rnz
  2355.  
  2356.     call    nxspnt
  2357.     call    pshbrc##
  2358.  
  2359.     lxi    h,0
  2360.     shld    brccount
  2361. ;mpu1:
  2362.     ret
  2363.  
  2364.  
  2365.     .comment    `
  2366. /************************************************/
  2367. /* Set mode per Epson command            */
  2368. /************************************************/
  2369. epscommand()
  2370. {
  2371.     modepush();
  2372.  
  2373.     switch (dt1)
  2374.     {
  2375.      case 'M': mode |=   ELITE;    break;    /* Elite    */
  2376.      case 'P': mode &=  ~ELITE;    break;
  2377.      case '_':                /* Underlined    */
  2378.      case '-':    eparg(UNDRLN);    break;
  2379.      case 15 : mode |=  CMPRSSD;    break;    /* Compressed    */
  2380.      case 18 : mode &= ~CMPRSSD;    break;
  2381.      case 'E': mode |=  EMPHSZD;    break;    /* Emphasized    */
  2382.      case 'F': mode &= ~EMPHSZD;    break;
  2383.      case 'G': mode |=  DBLSTRK;    break;    /* Double Strike */
  2384.      case 'H': mode &= ~DBLSTRK;    break;
  2385.      case 'W':    eparg(EXPNDD);    break;    /* Expanded    */
  2386.      case  4 : mode |=  ITALIC;    break;    /* Slanted    */
  2387.      case  5 : mode &= ~ITALIC;    break;
  2388.      case 'p': if (!mx) eparg(PRPTNL);
  2389.                     break;    /* Proportional    */
  2390.      case 'S': if (dt2 == '0') mode |= SUBSCRPT;
  2391.             else       mode |= SUPSCRPT;    break;
  2392.      case 'T': mode &= ~(SUPSCRPT | SUBSCRPT);    break;
  2393.      default:  if (dt2 > ' ') PTESCCH(dt1);
  2394.            if (dt2) PTCH(dt2);
  2395.            while ((dt1 = inbuf[inpoint]) != '\n')
  2396.            {    if (isdigit(dt1)) PTCH(numscan());
  2397.             else if (dt1 > ' ') { PTCH(dt1); inpoint++; }
  2398.             else scanwhite(TRUE);
  2399.            }
  2400.            break;
  2401.     }
  2402. }            `
  2403.  
  2404.  
  2405.  
  2406. epscomma:
  2407.     call    modepush
  2408. ;    lda    dt1
  2409.     mov    a,c
  2410.  
  2411.     lxi    d,elite
  2412.     cpi    'M'
  2413.     jz    emor
  2414.     lxi    d,not elite
  2415.     cpi    'P'
  2416.     jz    emand
  2417.     lxi    d,undrln
  2418.     cpi    '_'
  2419.     jz    emarg
  2420.     cpi    '-'
  2421.     jz    emarg
  2422.     lxi    d,cmprssd
  2423.     cpi    15
  2424.     jz    emor
  2425.     lxi    d,not cmprssd
  2426.     cpi    18
  2427.     jz    emand
  2428.     lxi    d,emphszd
  2429.     cpi    'E'
  2430.     jz    emor
  2431.     lxi    d,not emphszd
  2432.     cpi    'F'
  2433.     jz    emand
  2434.     lxi    d,dblstrk
  2435.     cpi    'G'
  2436.     jz    emor
  2437.     lxi    d,not dblstrk
  2438.     cpi    'H'
  2439.     jz    emand
  2440.     LXI    D,expndd
  2441.     cpi    'W'
  2442.     jz    emarg
  2443.     lxi    d,italic
  2444.     cpi    4
  2445.     jz    emor
  2446.     lxi    d,not italic
  2447.     cpi    5
  2448.     jz    emand
  2449.     cpi    'p'
  2450.     jz    em13
  2451.     cpi    'S'
  2452.     jz    em15
  2453.     lxi    d,not (supscrpt or subscrpt)    ;0E7FFH
  2454.     cpi    'T'
  2455.     jz    emand
  2456.     jmp    em19
  2457.  
  2458. em13:    lda    mx
  2459.     ora    a
  2460.     rnz
  2461.     lxi    d,prptnl
  2462. emarg:
  2463. ;    LDA    dt2
  2464.     mov    a,b
  2465.     cpi    '0'
  2466.     jnz    emor
  2467.     CALL    CMD
  2468.     dcx    d    ;undo 'inx d' in cmd
  2469. emand:
  2470.     lhld    mode
  2471.     mov    a,h
  2472.     ana    d
  2473.     mov    h,a
  2474.     mov    a,l
  2475.     ana    e
  2476.     mov    l,a
  2477.     shld    mode
  2478.     RET
  2479.  
  2480. em15:
  2481.     lxi    d,subscrpt
  2482. ;    LDA    dt2
  2483.     mov    a,b
  2484.     cpi    '0'
  2485.     JZ    EMOR
  2486.     lxi    d,supscrpt
  2487. emor:
  2488.     lhld    mode
  2489.     mov    a,h
  2490.     ora    d
  2491.     mov    h,a
  2492.     mov    a,l
  2493.     ora    e
  2494.     mov    l,a
  2495.     shld    mode
  2496.     RET
  2497.  
  2498. em19:
  2499. ;    lda    dt1
  2500.     mov    a,c
  2501.     cpi    ' '
  2502.     jc    em19ne
  2503.  
  2504.     mvi    a,27
  2505.     call    pr1##
  2506.  
  2507. em19ne:
  2508. ;    lda    dt1
  2509.     mov    a,c
  2510.     call    pr1##
  2511.  
  2512. ;    lda    dt2
  2513.     mov    a,b
  2514.     ora    a
  2515.     jz    em20
  2516.  
  2517.     call    pr1##
  2518.  
  2519. em20:    call    inbch
  2520. ;    sta    dt1
  2521.     mov    c,a
  2522.     cpi    newline
  2523.     rz
  2524.     call    isdec
  2525.     JC    em21
  2526.     call    numscan
  2527.  
  2528.     mov    a,l
  2529.     call    pr1##
  2530.  
  2531.     jmp    em20    ;em23
  2532.  
  2533. em21:
  2534.     CPI    ' '
  2535.     jc    em22
  2536.  
  2537.     call    pr1##
  2538.  
  2539.     call    nxpnt
  2540.     jmp    em20    ;em23
  2541.  
  2542. em22:    mvi    a,ttrue
  2543.     call    scanwhit
  2544.     jmp    em20
  2545.  
  2546.  
  2547. ;(no longer used)
  2548. ;/************************************************/
  2549. ;/* Epson type '0' or '1' argument        */
  2550. ;/************************************************/
  2551. ;eparg(msk)
  2552. ;int msk;
  2553. ;{
  2554. ;    if (dt2 == '0')        mode &= ~msk;
  2555. ;            else    mode |=  msk;
  2556. ;}
  2557. ;/* end cseq related functtions */
  2558. ;
  2559.  
  2560.     .comment    `
  2561. /************************************************/
  2562. /* Get 2 letters from long runoff commands    */
  2563. /************************************************/
  2564. getrlets()
  2565. {    char c;
  2566.  
  2567.     /* scan any further alphas        */
  2568.     if (inbuf[inpoint] != '-')
  2569.         while
  2570.         (    isalpha(c = inbuf[++inpoint])
  2571.             || c == SOFTHY
  2572.         )
  2573.         ;
  2574.  
  2575.     /* compound name?            */
  2576.     if (inbuf[inpoint] == '-')
  2577.     {    c = inbuf[inpoint+1];
  2578.         if (isalpha(c))
  2579.         {    dt2 = toupper(c);
  2580.             while
  2581.             (    isalpha(c = inbuf[++inpoint])
  2582.                 || c == SOFTHY
  2583.             )
  2584.             ;
  2585.         }
  2586.     }
  2587.  
  2588.     scanwhite(FALSE);
  2589. }            `
  2590.  
  2591.  
  2592. getrlets:
  2593.     call    inbch
  2594.     cpi    '-'
  2595.     jz    gr3
  2596.  
  2597.     call    grsb
  2598.     cpi    '-'
  2599.     jnz    gr6
  2600.  
  2601. gr3:
  2602. ;    lhld    inpoint
  2603. ;    inx    h
  2604. ;    lxi    d,inbuf
  2605. ;    dad    d
  2606.     call    inbch
  2607.     inx    h
  2608.  
  2609.     mov    a,m
  2610.     call    up$alph
  2611.     jc    gr6
  2612.  
  2613. ;    sta    dt2
  2614.     mov    b,a
  2615.     call    grsb
  2616.  
  2617. gr6:
  2618. ;    xra    a
  2619. ;    jmp    scanwhit
  2620.     jmp    sw1
  2621.  
  2622. grsb:    call    nxspnt
  2623.     call    inbch
  2624.     cpi    softhy
  2625.     jz    grsb
  2626.     cpi    softhya
  2627.     jz    grsb
  2628.     call    up$alph
  2629.     jnc    grsb
  2630.     ret
  2631.  
  2632.     .comment    `
  2633.  
  2634. /********************************************************/
  2635. /* Condense compound names                */
  2636. /********************************************************/
  2637. extract(name)
  2638. char *name;
  2639. {    int i;
  2640.     char c, hycount;
  2641.  
  2642.     /* extract the name        */
  2643.     for (i = 0, hycount = 0;
  2644.             isalpha(c = inbuf[inpoint])
  2645.             || isdigit(c)
  2646.             || c == '-'
  2647.             || c == SOFTHY
  2648.             || c == SOFTHYA
  2649.         
  2650.             ; inpoint++, scrncol++)
  2651.         if (c == '-')
  2652.         {    hycount++;
  2653.             if (hycount == 1 && i > 4) i = 4;
  2654.             else if (hycount == 2 && i > 6) i = 6;
  2655.             else if (i > 7) i = 7;
  2656.         }
  2657.         else if (i < 8 && c != SOFTHY && c != SOFTHYA)
  2658.             name[i++] = toupper(c);
  2659.  
  2660.     scanwhite(FALSE);
  2661.  
  2662.     /* terminate string        */
  2663.     name[i] = '\0';
  2664. }            `
  2665.  
  2666. extract:
  2667.  
  2668. ;pointer to destination for processed name is passed in HL
  2669. ;raw name comes from input stream or argv, if "$"n
  2670.  
  2671.     push    b
  2672.  
  2673. ;not in C vers.: find end of string to allow for possible file prefix
  2674.     shld    orgetname
  2675. et0:
  2676.     mov    a,m
  2677.     inx    h
  2678.     ora    a
  2679.     jnz    et0
  2680.     dcx    h
  2681.     shld    etname
  2682.  
  2683. ;call inbch, check for '$'digits, if so use *(gargv+2*number),->et1+3
  2684.  
  2685. ;i = 0
  2686.     MVI    B,0
  2687.  
  2688. ;hycount = 0
  2689.     xra    a
  2690.     sta    ethy
  2691.     sta    et$flag
  2692.     sta    .xtflag
  2693. et01:
  2694.     call    inbch
  2695.     cpi    '$'
  2696.     jnz    et1b
  2697.     sta    et$flag
  2698.     call    nxspnt
  2699. ;what if it's not a digit?? present code assumes 0
  2700. ;    call    inbch
  2701. ;    call    isdec
  2702. ;(possibly just a '$' should refer to next cmd. line arg)
  2703. ;    lxi    h,1
  2704. ;    jc    $+6
  2705.     call    numscan    ;$1->main file name
  2706.     inx    h    ;$1->1st com-line arg
  2707.     lda    gargc
  2708.     dcr    a
  2709.     cmp    l
  2710.     pop    d
  2711.     rc
  2712.     push    d
  2713.     dad    h    ;word array
  2714.     xchg
  2715.     lhld    gargv
  2716.     dad    d
  2717.     mov    a,m
  2718.     inx    h
  2719.     mov    h,m
  2720.     mov    l,a
  2721.     shld    etparm
  2722.  
  2723.  
  2724. et1:    lda    et$flag
  2725.     ora    a
  2726.     jz    et1a
  2727.     lhld    etparm
  2728.     mov    a,m
  2729.     inx    h
  2730.     shld    etparm
  2731.     jmp    et1b
  2732.  
  2733. et1a:    call    nxspnt
  2734.     call    inbch
  2735. et1b:    MOV    C,A
  2736.  
  2737.     cpi    ':'
  2738.     jnz    et1ba
  2739.     dcr    b
  2740.     jnz    et8
  2741.     lhld    etname
  2742.     mov    a,m
  2743.     lhld    orgetname
  2744.     mov    m,a
  2745.     inx    h
  2746.     mvi    m,':'
  2747.     inx    h
  2748.     shld    etname
  2749. ;if already looking at cmd line arg, go scan next char
  2750.     lda    et$flag
  2751.     ora    a
  2752.     jnz    et1
  2753. ;else scan over the ':' and go try for '$' again
  2754.     call    nxspnt
  2755.     jmp    et01
  2756.  
  2757. et1ba:
  2758.     lda    .xtflag
  2759.     ora    a
  2760.     jz    et1c    ;continue if not storing extension
  2761.     inr    a
  2762.     sta    .xtflag    ;note one more ext. letter stored
  2763.     mov    a,c
  2764.     call    flchar
  2765.     mov    c,a
  2766.     jnc    et6a    ;if good letter, go store it
  2767.     jmp    et8    ;else exit
  2768.  
  2769. et1c:
  2770.     mov    a,c
  2771.     cpi    '-'
  2772.     jz    et2a    ;was et2
  2773.     cpi    SOFTHY    ;1EH
  2774.     jz    et1    ;was et2
  2775.     cpi    SOFTHYA    ;1FH
  2776.     jz    et1    ;was et2
  2777. etnd:
  2778.     ora    a
  2779.     jz    et8
  2780.     call    flchar
  2781.     mov    c,a
  2782. ;    jc    et8
  2783.     jnc    et6
  2784.  
  2785.     cpi    '.'
  2786.     jnz    et8
  2787. ;make sure no extension yet
  2788.     lxi    h,.xtflag
  2789.     mov    a,m
  2790.     ora    a
  2791.     jnz    et8
  2792. ;here start to append extension
  2793.     inr    m
  2794.     jmp    et6a
  2795.  
  2796. ;et2:
  2797. ;    MOV    A,C
  2798. ;    cpi    '-'
  2799. ;    jnz    et6
  2800.  
  2801. et2a:
  2802. ;hycount++
  2803.     LXI    H,ETHY
  2804.     inr    m
  2805.  
  2806.     mvi    a,1
  2807.     cmp    m
  2808.     jnz    et3
  2809. ;hycount is 1
  2810.     mvi    a,4
  2811.     cmp    b
  2812.     jc    et5
  2813. et3:
  2814.     mvi    a,2
  2815.     cmp    m
  2816.     jnz    et4
  2817.  
  2818.     mvi    a,6
  2819.     cmp    b
  2820.     jc    et5
  2821. et4:
  2822.     mvi    a,7
  2823.     cmp    b
  2824.     jnc    et1
  2825. et5:
  2826.     mov    b,a
  2827.     jmp    et1
  2828. et6:
  2829.     mov    a,b
  2830.     cpi    8
  2831.     jnc    et1
  2832.  
  2833. ;now never get here with soft hyphen
  2834. ;    mov    a,c
  2835. ;    cpi    SOFTHY    ;1EH
  2836. ;    jz    et1
  2837. ;    cpi    SOFTHYA    ;1FH
  2838. ;    jz    et1
  2839.  
  2840. et6a:
  2841.     LHLD    ETNAME
  2842.     MOV    E,B
  2843.     MVI    D,0
  2844.     DAD    D    ;name[i]
  2845.     MOV    M,C    ; = c
  2846. ;terminate after ea. c, so don't have to at end
  2847.     inx    h
  2848.     mvi    m,0
  2849.  
  2850.     INR    B    ;i++
  2851. ;if storing file extension, see if all stored
  2852.     lda    .xtflag
  2853.     cpi    4
  2854.     jnz    et1    ;if not, loop
  2855.     call    nxspnt    ;position at next char
  2856.  
  2857. et8:
  2858. ;    xra    a    ;start with current char
  2859. ;    call    scanwhit
  2860.     call    sw1
  2861.     pop    b
  2862.     ora    a    ;clear carry signals "got one"
  2863.     ret
  2864.  
  2865. etname:        dw    0
  2866. orgetname:    dw    0
  2867. ethy:        db    0
  2868. et$flag:    db    0
  2869. etparm:        dw    0
  2870.  
  2871. .xtflag:    db    0
  2872.  
  2873.     .comment    `
  2874.  
  2875. /********************************************************/
  2876. /* Process name after 'fo'                */
  2877. /********************************************************/
  2878. grabfont()
  2879. {    int i, newreq;
  2880.     char gname[9];
  2881.  
  2882.     extract(gname);
  2883.  
  2884.     /* already know about this one?    */
  2885.     for (i = 0; i < nextft && strcmp(ftname[i], gname); i++);
  2886.  
  2887.     /* if not, request load        */
  2888.     if (i == nextft)
  2889.     {    if ((newreq = nextft) >= NUMFTS) i--;
  2890.         strcpy(ftname[i], gname);
  2891.         /* if newreq=NUMFTS, newreq-1= i will be loaded    */
  2892.         if (loadft(newreq) == ERROR)
  2893.         {    /* mark out name    */
  2894.             ftname[i][0] = 0;
  2895.             return(-1);
  2896.         }
  2897.         nextft = i + 1;
  2898.     }
  2899.  
  2900.     /* and cause fo to be number of font + 1    */
  2901.     return(i + 1);
  2902. }            `
  2903.  
  2904.  
  2905. grabfont:
  2906.     push    b
  2907.  
  2908.     LXI    H,GNAME
  2909.     mvi    m,0
  2910.     push    h
  2911.  
  2912.     call    extract
  2913.     pop    h
  2914.     jnc    gf01
  2915.     pop    b
  2916.     ret
  2917. gf01:
  2918. ;8th bit of 1st char is graphic font flag
  2919.     lda    gfflag
  2920.     ora    a
  2921.     mov    a,m
  2922.     jz    $+6
  2923.     ori    80h
  2924.     mov    m,a
  2925.  
  2926. ;remove any file extension
  2927. gf02:
  2928.     mov    a,m
  2929.     ora    a
  2930.     jz    gf03
  2931.     inx    h
  2932.     cpi    '.'
  2933.     jnz    gf02
  2934.     dcx    h
  2935.     mvi    m,0
  2936. gf03:    xra    a
  2937.     sta    gfflag
  2938.     mov    b,a
  2939. gf1:
  2940.     LDA    NEXTFT
  2941.     DCR    A
  2942.     JM    gf2
  2943.     CMP    B
  2944.     JC    gf2
  2945.  
  2946.     call    getftn
  2947.  
  2948. ;don't try to match a disk prefix
  2949.     call    afterpref
  2950.  
  2951.     lxi    d,gname
  2952.     xchg
  2953.     call    afterpref
  2954.     xchg
  2955.  
  2956.  
  2957.     call    strcmp
  2958.  
  2959.     mov    a,h
  2960.     ora    l
  2961.     jz    gf2
  2962.  
  2963.     INR    B
  2964.     jmp    gf1
  2965.  
  2966.  
  2967. afterpref:
  2968.     push    h
  2969. .aftu:    mov    a,m
  2970.     ora    a
  2971.     jz    .aftx
  2972.     cpi    ':'
  2973.     inx    h
  2974.     jnz    .aftu
  2975.     xthl
  2976. .aftx:    pop    h
  2977.     ret
  2978.  
  2979.  
  2980. ;    /* if not, request load        */
  2981. ;    if (i == nextft)
  2982.  
  2983. gf2:
  2984.     LDA    NEXTFT
  2985.     CMP    B
  2986.     jnz    gf5
  2987. ;    {    if ((newreq = nextft) >= NUMFTS) i--;
  2988.  
  2989. ;    LDA    NEXTFT
  2990.     MOV    C,A
  2991.     CPI    NUMFTS
  2992.     jc    gf3
  2993.     DCR    B
  2994. ;        strcpy(ftname[i], gname);
  2995.  
  2996. gf3:
  2997.     call    getftn
  2998.     lxi    d,gname
  2999.     call    strcpy
  3000.  
  3001. ;        /* if newreq=NUMFTS, newreq-1= i will be loaded    */
  3002. ;        if (loadft(newreq) == ERROR)
  3003.  
  3004.     MOV    L,C
  3005.     MVI    H,0
  3006.  
  3007.     push    h
  3008.     call    loadft
  3009.     pop    d
  3010.     inx    h
  3011.     mov    a,h
  3012.     ora    l
  3013.     jnz    gf4
  3014. ;        {    /* mark out name    */
  3015. ;            ftname[i][0] = 0;
  3016. ;            return(-1);
  3017. ;        }
  3018.  
  3019.     call    getftn
  3020.  
  3021.     mvi    m,0
  3022.     lxi    h,-1
  3023.     jmp    gf6
  3024. ;        nextft = i + 1;
  3025. ;    }
  3026. ;
  3027.  
  3028. gf4:
  3029.     MOV    A,B
  3030.     INR    A
  3031.     sta    nextft
  3032. ;    /* and cause fo to be number of font + 1    */
  3033. ;    return(i + 1);
  3034. ;}
  3035.  
  3036. gf5:
  3037.     INR    B
  3038.     MOV    L,B
  3039.     MVI    H,0
  3040. gf6:
  3041.     pop    b
  3042.     ora    a
  3043.     ret
  3044.  
  3045. ;made external
  3046. ;gname:    db    0,0,0,0,0,0,0,0,0,0,0,0,0
  3047.  
  3048.  
  3049.     .comment    `
  3050. /************************************************/
  3051. /* discard white space in input line        */
  3052. /************************************************/
  3053. scanwhite(next)
  3054. int next;
  3055. {        char c;
  3056.  
  3057.         if (next) {inpoint++; scrncol++; }
  3058.  
  3059.         while ((c = inbuf[inpoint]) == ' '
  3060.                      || c == '\t'
  3061.                      || c == SOFTSP)
  3062.         {    inpoint++;
  3063.             scrncol++;
  3064.             if (c == '\t')
  3065.              while (scrncol & 7) scrncol++;
  3066.         }
  3067. }            `
  3068.  
  3069. ;(next in A)
  3070. scanwhit:
  3071.     ora    a
  3072.     cnz    nxspnt
  3073. sw1:    call    inbch
  3074.     cpi    ' '
  3075.     jz    sw2
  3076.     cpi    9
  3077.     jz    sw2
  3078.     cpi    SOFTSP
  3079.     rnz
  3080. sw2:
  3081.     push    psw
  3082.     call    nxspnt
  3083.     pop    psw
  3084.     cpi    9
  3085.     jnz    sw1
  3086.     lxi    h,scrncol
  3087.     mvi    a,7
  3088. sw3:    ana    m
  3089.     jz    sw1
  3090.     inr    m
  3091.     jmp    sw3
  3092.  
  3093.  
  3094. ;point HL at current input character and get it in A
  3095. inbch::
  3096. ;if no indirection, go get char from input line
  3097.     lda    _$lev
  3098.     ora    a
  3099.     jz    .inbo
  3100. ;when indirection:
  3101. ; index the pointer on the indirection stack
  3102.     dcr    a
  3103.     mov    l,a
  3104.     mvi    h,0
  3105.     dad    h
  3106.     lxi    d,_$stack
  3107.     dad    d
  3108.     mov    e,m
  3109.     inx    h
  3110.     mov    d,m
  3111.     xchg
  3112. ; and get the character here
  3113.     mov    a,m
  3114. ;(to extend the tab=end-of-field convention to arguments in
  3115. ; strings, check here for tab char)
  3116.     ora    a
  3117.     rnz
  3118. ;if we're at the end of the string,
  3119. ; check to see if scanning the argument to a macro
  3120. .inbup:    lxi    h,_$upflag
  3121.     mov    a,m
  3122.     mvi    m,0
  3123.     lxi    h,_$lev
  3124.     dcr    m
  3125.     ora    a
  3126. ; if not, down one level of indirection, and go get the char there
  3127.     jz    inbch
  3128. ; but if so, return up one level of indirection
  3129.     inr    m
  3130.     inr    m
  3131.     jmp    inbch
  3132.  
  3133. .inbo:
  3134. ;get current tab char to check for end of arg field
  3135.     lda    tc
  3136.     lhld    inpoint
  3137.     lxi    d,inbuf
  3138.     dad    d
  3139. ;if no tab char defined, can't be end of field
  3140.     ora    a
  3141.     jz    .inbnt
  3142. ;if this is not the tab char, also can't be end of field
  3143.     cmp    m
  3144.     jnz    .inbnt
  3145. ;if not scanning an arg string, also can't be end of field
  3146.     lda    _$upflag
  3147.     ora    a
  3148.     jz    .inbnt
  3149. ;aha! we're at end of field, so skip the tab char and
  3150. ; return up one level (without zeroing the _$upflag)
  3151.     call    nxspnt
  3152.     jmp    .inbup
  3153.  
  3154. .inbnt:
  3155.     mov    a,m
  3156.     cpi    0ah    ;if eol, check for '\$$' ref.
  3157.     rnz
  3158.     lda    _$upflag
  3159.     ora    a
  3160.     mvi    a,0ah
  3161. ;if not scanning arg, just return the newline
  3162.     rz
  3163. ;else return up to the higher level of indirection
  3164.     call    nxpnt    ;to skip the nl
  3165.     jmp    .inbup
  3166.  
  3167. nxspnt::
  3168.     lda    _$lev
  3169.     ora    a
  3170.     jz    .nxso
  3171.  
  3172.     dcr    a
  3173.     mov    l,a
  3174.     mvi    h,0
  3175.     dad    h
  3176.     lxi    d,_$stack
  3177.     dad    d
  3178.     mov    e,m
  3179.     inx    h
  3180.     mov    d,m
  3181.     inx    d
  3182.     mov    m,d
  3183.     dcx    h
  3184.     mov    m,e
  3185.     xchg
  3186.     ret
  3187.  
  3188. .nxso:    lxi    h,scrncol
  3189.     inr    m
  3190. nxpnt:
  3191.     lhld    inpoint
  3192.     inx    h
  3193.     shld    inpoint
  3194.     ret
  3195.  
  3196. ;temporarily cancel input redirect to pick up a string argument
  3197. sundirect:
  3198.     lxi    h,_$lev
  3199.     mov    a,m
  3200.     ora    a
  3201. ;nop if no current redirection
  3202. ;(a natural extension would be to get a string from the console)
  3203.     rz
  3204.     dcr    m
  3205. ;signal to come back up when reach eol
  3206.     sta    _$upflag
  3207.     ret
  3208.  
  3209. shfdown::
  3210.     lxi    h,_$upflag+1
  3211.     mov    a,m
  3212.     dcx    h
  3213.     mov    m,a
  3214. ;called by processline when it hits a '\*'
  3215. sddown::
  3216.     lxi    h,_$lev
  3217.     mov    a,m
  3218.     ora    a
  3219.     rz
  3220.     dcr    m
  3221.     ret
  3222.  
  3223. ;special version of sdirect for use during processing of
  3224. ; heading and footing lines -- will go up one extra level
  3225. ; to get past the level of a possible macro looking at
  3226. ; an argument, then sddown will be called afterwards to get back
  3227. shfdirect::
  3228.     push    h
  3229.     lxi    h,_$upflag
  3230.     mov    a,m
  3231.     mvi    m,0
  3232.     inx    h
  3233.     mov    m,a
  3234.     inx    h
  3235.  
  3236. ;    lxi    h,_$lev
  3237.     inr    m
  3238.     lxi    d,150
  3239.     jmp    .sdir0
  3240.  
  3241. ;redirect input to the string variable whose address is in HL
  3242. sdirect::
  3243.     push    h
  3244. ;message "string reference in argument"
  3245.     lxi    d,151
  3246.     lda    _$upflag
  3247.     ora    a
  3248.     jnz    .sdirerr
  3249. ;message "too much nesting"
  3250.     dcx    d
  3251.     lxi    h,_$lev
  3252. .sdir0:    mov    a,m
  3253.     cpi    MAXSNEST
  3254.     jz    .sdirerr
  3255.     inr    m
  3256.     mvi    h,0
  3257.     mov    l,a
  3258.     dad    h
  3259.     lxi    d,_$stack
  3260.     dad    d
  3261.     pop    d
  3262.     mov    m,e
  3263.     inx    h
  3264.     mov    m,d
  3265.     ret
  3266.  
  3267. .sdirerr:
  3268.     push    d
  3269.     call    eperror
  3270.  
  3271. _$upflag:    db    0
  3272.         db    0
  3273. _$lev:        db    0
  3274. ;made external
  3275. ;_$stack:    dw    0,0,0,0,0,0,0,0,0,0
  3276. _$point:    dw    _$buf    ;1024 bytes at end of externals
  3277.  
  3278.  
  3279. up$alph:
  3280.     cpi    '$'
  3281.     jnz    upalph
  3282.     mvi    a,'@'
  3283.     ret
  3284. upalph:
  3285.     cpi    'A'
  3286.     rc        ;not alpha if before A
  3287.     cpi    'z'+1
  3288.     cmc
  3289.     rc        ;not alpha if after z
  3290.     cpi    'Z'+1
  3291.     cmc
  3292.     rnc        ;alpha if from A to Z
  3293.     cpi    'a'
  3294.     rc        ;not alpha if between Z and a
  3295.     sui    20H    ;else lower case alpha, to upper
  3296.     ret        ;carry must be clear, so signal alpha
  3297.  
  3298. ;test if legal file character other than '.'
  3299. flchar:
  3300.     cpi    '!'
  3301.     rc
  3302.     cpi    '*'
  3303.     jz    fl0
  3304.     cpi    ','
  3305.     jz    fl0
  3306.     cpi    '.'
  3307.     jz    fl0
  3308.     CPI    '9'+1
  3309.     jc    fl1
  3310.     cpi    '@'
  3311.     jc    fl0
  3312.     cpi    '\'
  3313.     jz    fl0
  3314.     cpi    '{'
  3315.     jz    fl0
  3316.     call    upalph
  3317. fl1:    ora    a
  3318.     ret
  3319. fl0:    ora    a
  3320.     cmc
  3321.     ret
  3322.  
  3323.  
  3324. ;hold addr of val[dt1-'@'][dt2-'@'] and valtp...
  3325. vldtadr:    dw    0
  3326. typvadr:    dw    0
  3327.  
  3328. arg:        dw    0
  3329. oldarg:        dw    0
  3330. argsign:    db    0
  3331. typeval:    dw    0
  3332. measure:    dw    0
  3333. divisor:    dw    0
  3334.  
  3335. ;dt1:        db    0
  3336. ;dt2:        db    0
  3337. dt3:        db    0
  3338. ;dt4:        db    0
  3339. dt5:        db    0
  3340. eqref:        db    0
  3341. havearg:    db    0
  3342.  
  3343. ;made external
  3344. ;utabs:        dw    0,0,0,0,0,0,0,0
  3345. ;        dw    0,0,0,0,0,0,0,0
  3346. ;        dw    0,0,0,0,0,0,0,0
  3347. ;        dw    0,0,0,0,0,0,0,0
  3348.  
  3349.  
  3350. ;
  3351. ;/************************************************/
  3352. ;/* Pop mode from brcstk                */
  3353. ;/************************************************/
  3354. ;modepop()
  3355. ;{
  3356. ;    if (brcpt[cc])
  3357. ;    {    mode = brcstk[cc][--brcpt[cc]];
  3358. ;        return(TRUE);
  3359. ;    }
  3360. ;    else return(FALSE);
  3361. ;}
  3362.  
  3363.  
  3364.  
  3365. modepop::
  3366.     call    get_brc
  3367.     xchg
  3368.     mov    a,h
  3369.     ora    l
  3370.     rz    ;ret false in HL
  3371.  
  3372. ;do the predecrement now
  3373.     dcx    h
  3374. ;save for below
  3375.     push    h
  3376. ;store it back
  3377.     xchg
  3378.     mov    m,d
  3379.     dcx    h
  3380.     mov    m,e
  3381.  
  3382.  
  3383.     lhld    cc
  3384.  
  3385. ;    lxi    d,12
  3386. ;    call    usmul
  3387.     dad    h    ;*2
  3388.     dad    h    ;*4
  3389.     mov    d,h
  3390.     mov    e,l
  3391.     dad    h    ;*8
  3392.     dad    d    ;*8 + *4 = *12
  3393.  
  3394.     lxi    d,brcstk
  3395.     dad    d
  3396.  
  3397.     xchg
  3398. ;col. base in DE
  3399.  
  3400. ;now get back decremented brcpt[cc]
  3401.     pop    h
  3402. ;word address
  3403.     dad    h
  3404. ;and complete the index
  3405.     dad    d
  3406.  
  3407.     mov    a,m
  3408.     inx    h
  3409.     mov    h,m
  3410.     mov    l,a
  3411.     shld    mode
  3412.  
  3413.     lxi    h,ttrue
  3414.     ret
  3415.  
  3416. get_brc::
  3417.     lhld    cc
  3418.     dad    h
  3419.     lxi    d,brcpt
  3420.     dad    d
  3421.     mov    e,m
  3422.     inx    h
  3423.     mov    d,m
  3424.     ret
  3425.  
  3426. getftn::
  3427.     mov    l,b
  3428.     mvi    h,0
  3429.     lxi    d,LENFTN
  3430.     call    usmul
  3431.     lxi    d,ftname
  3432.     dad    d
  3433.     ret
  3434.  
  3435.     end
  3436.  
  3437.