home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols200 / vol224 / c80v-2.c < prev    next >
Text File  |  1994-07-13  |  31KB  |  1,383 lines
  1. /*    >>>>>>> start of cc5 <<<<<<<    */
  2. /*
  3.     history...
  4.         14 Jul 84  When profiling, not generating ':'
  5.     after label equated to zero.
  6.         27 Jun 84  No longer generating ENDDATA label
  7.     at end of program (duty taken over by ZLINK).
  8.         25 Jun 84  When profiling, the equate has
  9.     the ZMAC syntax. '\l' added.
  10.         10 Oct 83  Converted DB, DW, and DS to DEFB,
  11.     DEFW, and DEFS.  Added colon after ENDDATA.
  12.         1 Sept 83  calling nl() before outputting
  13.     call to ccalls().
  14.         26 Aug 83  added code to link call counts
  15.     (header, trailer)
  16.         29 Jun 83  addim() now calls outasm
  17.     rather than ot to print the literal.
  18.         7 Mar 83  prefix "&" no longer accepts function
  19.     name.
  20.         1 Feb 83  Declaring "enddata" at the end
  21.     of the allocated memory (=top of heap).
  22.         29 Jan 83  prefix "&" can return address of
  23.     function.
  24.         27 Oct 82  Generating no extra nl() after
  25.     "dstore", updating Zsp in same routines that generate
  26.     calls to floating point routines.
  27.         23 Oct 82  rewrote value-returning expr
  28.     in "fnumber".
  29.         10 Oct 82  Corrected Zsp accounting.
  30.     Moved type coersion to a subroutine. Checking operand
  31.     types for integer operations.
  32.         9 Oct 82  Automatically widening before:
  33.     + - * / < <= == != >= >.  Short-circuit evaluation of
  34.     DOUBLE tests.
  35.         6 Oct 82  Generating calls to "qfloat" rather
  36.     than "qqfloat".
  37.         11 Sept 82  Generating no POP DE instructions
  38.     for most operators.
  39.         5 Sept 82  "constant" doing explicit "dload"
  40.     for floating constants.
  41.         3 Sep 82  Accepting floating constants.
  42.         31 Aug 82  Performing monadic "-" on
  43.     floating point variables.
  44.         30 Aug 82  Automatic conversions to and
  45.     from DOUBLE on assignments. Adjusting stack after
  46.     double precision comparisons. Comparisons now yield
  47.     integers.
  48.         29 Aug 82  monadic "&" now generates
  49.     a correct variable name.
  50.         12 Aug 82 Corrected "number" to return
  51.     type correctly.
  52.         11 Aug 82 Rewrote dbltest.
  53.         9 Aug 82  Started installing floating
  54.     point comparisons.
  55.         7 Aug 82  Modified for floating point
  56.     expressions.
  57.         5 Aug 82  Converted JZ to JP Z,
  58.     Converted several calls to ot() to outasm() to
  59.     eliminate unwanted tabs.  Added some comments.
  60.         3 Aug 82  Corrected immed(), removed two
  61.     unnecessary tests for >0, removed one unnecessary
  62.     8-bit mask.
  63.         1 Aug 82  generating Zilog mnemonic
  64.     output rather than Intel.
  65.         18 Jul 82  Corrected expression analyzer
  66.     per J. E. Hendrix (ddj n62 p41);
  67.         1 Jul 82   Replaced calls to "ccpchar" with
  68.     inline code, per Ron Cain, DDJ n48 p6.
  69.         Implemented backslash escape sequences for
  70.     character and string literals, per J. E. Hendrix,
  71.     DDJ n56 p6.
  72.         18 Apr 81    Preceding names by Q rather
  73.     than QZ, to shorten them.
  74. */
  75.  
  76. /*
  77. ** lval[0] - symbol table address, else 0 for constant
  78. ** lval[1] - type of indirect object to fetch, else 0
  79.         for static object
  80. ** lval[2] - type of pointer or array, else 0
  81. ** lval[3] - type of value calculated  jrvz 8/7/82
  82. */
  83. expression()
  84. {
  85.     int lval[4];    /* jrvz 8/7/82 */
  86.     if(heir1(lval))rvalue(lval);
  87.     return lval[3];  /* return type  jrvz 8/7/82 */
  88. }
  89. heir1(lval)
  90.     int lval[];
  91. {
  92.     int k,lval2[4];
  93.     k=heir2(lval);
  94.     if (match("="))
  95.         {if(k==0){needlval();return 0;
  96.         }
  97.         if (lval[1])zpush();
  98.         if(heir1(lval2))rvalue(lval2);
  99.         force(lval[3],lval2[3]); /* jrvz 10/10/82 */
  100.         store(lval);
  101.         return 0;
  102.         }
  103.     else return k;
  104. }
  105. heir2(lval)
  106.     int lval[];
  107. {    int k,lval2[4];
  108.     k=heir3(lval);
  109.     blanks();
  110.     if(ch()!='|')return k;
  111.     if(k)rvalue(lval);
  112.     while(1)
  113.         {if (match("|"))
  114.             {zpush();
  115.             if(heir3(lval2)) rvalue(lval2);
  116.             intcheck(lval,lval2);
  117.                 /* jrvz 10/10/82 */
  118.             zor();
  119.             }
  120.         else return 0;
  121.         }
  122. }
  123. heir3(lval)
  124.     int lval[];
  125. {    int k,lval2[4];
  126.     k=heir4(lval);
  127.     blanks();
  128.     if(ch()!='^')return k;
  129.     if(k)rvalue(lval);
  130.     while(1)
  131.         {if (match("^"))
  132.             {zpush();
  133.             if(heir4(lval2))rvalue(lval2);
  134.             intcheck(lval,lval2);
  135.                 /* jrvz 10/10/82 */
  136.             zxor();
  137.             }
  138.         else return 0;
  139.         }
  140. }
  141. heir4(lval)
  142.     int lval[];
  143. {    int k,lval2[4];
  144.     k=heir5(lval);
  145.     blanks();
  146.     if(ch()!='&')return k;
  147.     if(k)rvalue(lval);
  148.     while(1)
  149.         {if (match("&"))
  150.             {zpush();
  151.             if(heir5(lval2))rvalue(lval2);
  152.             intcheck(lval,lval2);
  153.                 /* jrvz 10/10/82 */
  154.             zand();
  155.             }
  156.         else return 0;
  157.         }
  158. }
  159. heir5(lval)
  160.     int lval[];
  161. {
  162.     int k,lval2[4];
  163.     k=heir6(lval);
  164.     blanks();
  165.     if((streq(line+lptr,"==")==0)&
  166.         (streq(line+lptr,"!=")==0))return k;
  167.     if(k)rvalue(lval);
  168.     while(1)
  169.         {if (match("=="))
  170.             {if(lval[3]==DOUBLE)dpush();
  171.                     /* jrvz 8/9/82 */
  172.             else zpush();
  173.             if(heir6(lval2))rvalue(lval2);
  174.             if(widen(lval,lval2))
  175.                     /* jrvz 10/9/82 */
  176.                 {deq();
  177.                 lval[3]=cint;
  178.                 }    /* jrvz 8/9/82 */
  179.             else zeq();
  180.             }
  181.         else if (match("!="))
  182.             {if(lval[3]==DOUBLE)dpush();
  183.                     /* jrvz 8/9/82 */
  184.             else zpush();
  185.             if(heir6(lval2))rvalue(lval2);
  186.             if(widen(lval,lval2))
  187.                     /* jrvz 10/9/82 */
  188.                 {dne();
  189.                 lval[3]=cint;
  190.                 }    /* jrvz 8/9/82 */
  191.             else zne();
  192.             }
  193.         else return 0;
  194.         }
  195. }
  196. heir6(lval)
  197.     int lval[];
  198. {
  199.     int k,lval2[4];
  200.     k=heir7(lval);
  201.     blanks();
  202.     if((streq(line+lptr,"<")==0)&
  203.         (streq(line+lptr,">")==0)&
  204.         (streq(line+lptr,"<=")==0)&
  205.         (streq(line+lptr,">=")==0))return k;
  206.         if(streq(line+lptr,">>"))return k;
  207.         if(streq(line+lptr,"<<"))return k;
  208.     if(k)rvalue(lval);
  209.     while(1)
  210.         {if (match("<="))
  211.             {if(lval[3]==DOUBLE)dpush();
  212.             else zpush();    /* jrvz 8/9/82 */
  213.             if(heir7(lval2))rvalue(lval2);
  214.             if(widen(lval,lval2))
  215.                     /* jrvz 10/9/82 */
  216.                 {dle();
  217.                 lval[3]=cint; continue;
  218.                 }
  219.             if(lval[2]|lval2[2])
  220.                 {ule();
  221.                 continue;
  222.                 }
  223.             if(cptr=lval2[0])
  224.                 if(cptr[ident]==pointer)
  225.                 {ule();
  226.                 continue;
  227.                 }
  228.             zle();
  229.             }
  230.         else if (match(">="))
  231.             {if(lval[3]==DOUBLE)dpush();
  232.             else zpush();    /* jrvz 8/9/82 */
  233.             if(heir7(lval2))rvalue(lval2);
  234.             if(widen(lval,lval2))
  235.                     /* jrvz 10/9/82 */
  236.                 {dge();
  237.                 lval[3]=cint; continue;
  238.                 }
  239.             if(lval[2]|lval2[2])
  240.                 {uge();
  241.                 continue;
  242.                 }
  243.             if(cptr=lval2[0])
  244.                 if(cptr[ident]==pointer)
  245.                 {uge();
  246.                 continue;
  247.                 }
  248.             zge();
  249.             }
  250.         else if((streq(line+lptr,"<"))&
  251.             (streq(line+lptr,"<<")==0))
  252.             {inbyte();
  253.             if(lval[3]==DOUBLE)dpush();
  254.             else zpush();  /* jrvz 8/10/82 */
  255.             if(heir7(lval2))rvalue(lval2);
  256.             if(widen(lval,lval2))
  257.                     /* jrvz 10/9/82 */
  258.                 {dlt();
  259.                 lval[3]=cint; continue;
  260.                 }
  261.             if(lval[2]|lval2[2])
  262.                 {ult();
  263.                 continue;
  264.                 }
  265.             if(cptr=lval2[0])
  266.                 if(cptr[ident]==pointer)
  267.                 {ult();
  268.                 continue;
  269.                 }
  270.             zlt();
  271.             }
  272.         else if((streq(line+lptr,">"))&
  273.             (streq(line+lptr,">>")==0))
  274.             {inbyte();
  275.             if(lval[3]==DOUBLE)dpush();
  276.             else zpush();  /* jrvz 8/10/82 */
  277.             if(heir7(lval2))rvalue(lval2);
  278.             if(widen(lval,lval2))
  279.                     /* jrvz 10/9/82 */
  280.                 {dgt();
  281.                 lval[3]=cint; continue;
  282.                 }
  283.             if(lval[2]|lval2[2])
  284.                 {ugt();
  285.                 continue;
  286.                 }
  287.             if(cptr=lval2[0])
  288.                 if(cptr[ident]==pointer)
  289.                 {ugt();
  290.                 continue;
  291.                 }
  292.             zgt();
  293.             }
  294.         else return 0;
  295.         }
  296. }
  297. /*    >>>>>> start of cc6 <<<<<<    */
  298.  
  299. heir7(lval)
  300.     int lval[];
  301. {
  302.     int k,lval2[4];
  303.     k=heir8(lval);
  304.     blanks();
  305.     if((streq(line+lptr,">>")==0)&
  306.         (streq(line+lptr,"<<")==0))return k;
  307.     if(k)rvalue(lval);
  308.     while(1)
  309.         {if (match(">>"))
  310.             {zpush();
  311.             if(heir8(lval2))rvalue(lval2);
  312.             zpop();
  313.             intcheck(lval,lval2);
  314.                 /* jrvz 10/10/82 */
  315.             asr();
  316.             }
  317.         else if (match("<<"))
  318.             {zpush();
  319.             if(heir8(lval2))rvalue(lval2);
  320.             intcheck(lval,lval2);
  321.                 /* jrvz 10/10/82 */
  322.             asl();
  323.             }
  324.         else return 0;
  325.         }
  326. }
  327. heir8(lval)
  328.     int lval[];
  329. {
  330.     int k,lval2[4];
  331.     k=heir9(lval);
  332.     blanks();
  333.     if((ch()!='+')&(ch()!='-'))return k;
  334.     if(k)rvalue(lval);
  335.     while(1)
  336.         {if (match("+"))
  337.             {if(lval[3]==DOUBLE)dpush();
  338.                     /* jrvz 8/7/82 */
  339.             else zpush();
  340.             if(heir9(lval2))rvalue(lval2);
  341.             if(dbltest(lval,lval2))
  342.                 scale(lval[2]);  /* jrvz 8/7/82 */
  343.             if(widen(lval,lval2))
  344.                     /* jrvz 10/9/82 */
  345.                 {dadd();
  346.                 }
  347.             else    /* jrvz 8/8/82 */
  348.                 {zpop();if(dbltest(lval2,lval))
  349.                 {if(lval2[2]!=cchar)
  350.                     {swap();scale(lval2[2]);
  351.                     }
  352.                 }
  353.                 zadd();
  354.                 result(lval,lval2);
  355.                 }
  356.             }
  357.         else if (match("-"))
  358.             {if(lval[3]==DOUBLE)dpush();
  359.             else zpush();
  360.             if(heir9(lval2))rvalue(lval2);
  361.             if(dbltest(lval,lval2))
  362.                 scale(lval[2]); /* jrvz 8/7/82 */
  363.             if(widen(lval,lval2))
  364.                     /* jrvz 10/9/82 */
  365.                 {dsub();
  366.                 }
  367.             else
  368.                 {if(dbltest(lval2,lval))
  369.                     {swapstk();
  370.                     scale(lval2[2]);
  371.                     /* jrvz 8/8/82 */
  372.                     swapstk();
  373.                     }
  374.                 zsub();
  375.                 if((lval[2]==cint)
  376.                 &(lval2[2]==cint))
  377.                     {swap();
  378.                     immed(); ol("1");
  379.                     asr(); /*  div by 2  */
  380.                     }
  381.                 else if((lval[2]==DOUBLE)
  382.                 &(lval2[2]==DOUBLE))
  383.                     {swap();
  384.                     immed(); ol("6");
  385.                     div(); /* div by 6 */
  386.                     } /* jrvz 8/8/82 */
  387.                 result(lval,lval2);
  388.                 }
  389.             }
  390.         else return 0;
  391.         }
  392. }
  393. heir9(lval)
  394.     int lval[];
  395. {
  396.     int k,lval2[4];
  397.     k=heira(lval);
  398.     blanks();
  399.     if((ch()!='*')&(ch()!='/')&
  400.         (ch()!='%'))return k;
  401.     if(k)rvalue(lval);
  402.     while(1)
  403.         {if (match("*"))
  404.             {if(lval[3]==DOUBLE) dpush();
  405.                     /* jrvz 8/7/82 */
  406.             else zpush();
  407.             if(heir9(lval2))rvalue(lval2);
  408.             if(widen(lval,lval2))
  409.                     /* jrvz 10/9/82 */
  410.                 {dmul();
  411.                 }
  412.             else mult();
  413.             }
  414.         else if (match("/"))
  415.             {if(lval[3]==DOUBLE) dpush();
  416.                     /* jrvz 8/7/82 */
  417.             else zpush();
  418.             if(heira(lval2))rvalue(lval2);
  419.             if(widen(lval,lval2))
  420.                     /* jrvz 10/9/82 */
  421.                 {ddiv();
  422.                 }
  423.                     /* jrvz 8/7/82 */
  424.             else
  425.                 {zpop(); div();
  426.                 }
  427.             }
  428.         else if (match("%"))
  429.             {zpush();
  430.             if(heira(lval2))rvalue(lval2);
  431.             zpop();
  432.             intcheck(lval,lval2);
  433.                 /* jrvz 10/10/82 */
  434.             zmod();
  435.             }
  436.         else return 0;
  437.         }
  438. }
  439. heira(lval)
  440.     int lval[];
  441. {
  442.     int k;
  443.     char *ptr;
  444.     if(match("++"))
  445.         {if((k=heira(lval))==0)
  446.             {needlval();
  447.             return 0;
  448.             }
  449.         if(lval[1])zpush();
  450.         rvalue(lval);
  451.         intcheck(lval,lval);    /* jrvz 10/10/82 */
  452.         if(lval[2]==DOUBLE)  /* jrvz 8/7/82 */
  453.             addimm("6");
  454.         else
  455.             {inc();
  456.             if(lval[2]==cint) inc();
  457.             }
  458.         store(lval);
  459.         return 0;
  460.         }
  461.     else if(match("--"))
  462.         {if((k=heira(lval))==0)
  463.             {needlval();
  464.             return 0;
  465.             }
  466.         if(lval[1])zpush();
  467.         rvalue(lval);
  468.         intcheck(lval,lval);    /* jrvz 10/10/82 */
  469.         if(lval[2]==DOUBLE)  /* jrvz 8/7/82 */
  470.             addimm("0-6");
  471.         else
  472.             {dec();
  473.             if(lval[2]==cint) dec();
  474.             }
  475.         store(lval);
  476.         return 0;
  477.         }
  478.     else if (match("-"))
  479.         {k=heira(lval);
  480.         if (k) rvalue(lval);
  481.         if(lval[3]==DOUBLE)dneg();
  482.         else neg();
  483.         return 0;
  484.         }
  485.     else if(match("*"))
  486.         {k=heira(lval);
  487.         if(k)rvalue(lval);
  488.         if(ptr=lval[0])  /* get type from sym table */
  489.             lval[3]=lval[1]=ptr[type];
  490.                     /* jrvz 8/7/82 */
  491.         else lval[3]=lval[1]=cint;
  492.              /* ...else assume int  jrvz 8/7/82 */
  493.         lval[2]=0;  /*  flag as not pointer or array */
  494.         return 1;  /* dereferenced pointer is lvalue */
  495.         }
  496.     else if(match("&"))
  497.         {k=heira(lval);
  498.         ptr=lval[0];
  499.         if(k==0)
  500.             {error("illegal address");
  501.             return 0;
  502.             }
  503.         ptr=lval[0];
  504.         lval[2]=ptr[type];
  505.         lval[3]=cint;    /* jrvz 8/7/82 */
  506.         if(lval[1])return 0;
  507.         /* global & non-array */
  508.         immed();
  509.         outname(ptr);
  510.             /* formerly outsym   jrvz 8/29/82 */
  511.         nl();
  512.         lval[1]=ptr[type];
  513.         return 0;
  514.         }
  515.     else 
  516.         {k=heirb(lval);
  517.         if(match("++"))
  518.             {if(k==0)
  519.                 {needlval();
  520.                 return 0;
  521.                 }
  522.             if(lval[1])zpush();
  523.             rvalue(lval);
  524.             intcheck(lval,lval);
  525.                     /* jrvz 10/10/82 */
  526.             if(lval[2]==DOUBLE)  /* jrvz 8/7/82 */
  527.                 {zpush();
  528.                 addimm("6");
  529.                 store(lval);
  530.                 mainpop();
  531.                 }
  532.             else
  533.                 {inc();
  534.                 if(lval[2]==cint) inc();
  535.                 store(lval);
  536.                 dec();
  537.                 if(lval[2]==cint) dec();
  538.                 }
  539.             return 0;
  540.             }
  541.         else if(match("--"))
  542.             {if(k==0)
  543.                 {needlval();
  544.                 return 0;
  545.                 }
  546.             if(lval[1])zpush();
  547.             rvalue(lval);
  548.             intcheck(lval,lval);
  549.                 /* jrvz 10/10/82 */
  550.             if(lval[2]==DOUBLE)  /* jrvz 8/7/82 */
  551.                 {zpush();
  552.                 addimm("0-6");
  553.                 store(lval);
  554.                 mainpop();
  555.                 }
  556.             else
  557.                 {dec();
  558.                 if(lval[2]==cint) dec();
  559.                 store(lval);
  560.                 inc();
  561.                 if(lval[2]==cint) inc();
  562.                 }
  563.             return 0;
  564.             }
  565.         else return k;
  566.         }
  567.     }
  568. /*    >>>>>> start of cc7 <<<<<<    */
  569.  
  570. heirb(lval)
  571.     int *lval;
  572. {    int k;char *ptr;
  573.     k=primary(lval);
  574.     ptr=lval[0];
  575.     blanks();
  576.     if((ch()=='[')|(ch()=='('))
  577.     while(1)
  578.         {if(match("["))
  579.             {if(ptr==0)
  580.                 {error("can't subscript");
  581.                 junk();
  582.                 needbrack("]");
  583.                 return 0;
  584.                 }
  585.             else if(ptr[ident]==pointer)rvalue(lval);
  586.             else if(ptr[ident]!=array)
  587.                 {error("can't subscript");
  588.                 k=0;
  589.                 }
  590.             zpush();
  591.             expression();
  592.             needbrack("]");
  593.             scale(ptr[type]); /* jrvz 8/8/82 */
  594.             zpop();
  595.             zadd();
  596.             lval[0]=lval[2]=0;
  597.             lval[3]=lval[1]=ptr[type];
  598.                     /* jrvz 8/7/82 */
  599.             k=1;
  600.             }
  601.         else if(match("("))
  602.             {if(ptr==0)
  603.                 {callfunction(0);
  604.                 }
  605.             else if(ptr[ident]!=function)
  606.                 {rvalue(lval);
  607.                 callfunction(0);
  608.                 }
  609.             else callfunction(ptr);
  610.             k=lval[0]=0;
  611.             lval[3]=ptr[type]; /* jrvz 8/7/82 */
  612.             }
  613.         else return k;
  614.         }
  615.     if(ptr==0)return k;
  616.     if(ptr[ident]==function)
  617.         {immed();
  618.         outname(ptr);
  619.         nl();
  620.         return 0;
  621.         }
  622.     return k;
  623. }
  624. primary(lval)
  625.     int *lval;
  626. {    char *ptr,sname[namesize];int num[1];
  627.     int k;
  628.     lval[2]=0;  /* clear pointer/array type */
  629.     if(match("("))
  630.         {k=heir1(lval);
  631.         needbrack(")");
  632.         return k;
  633.         }
  634.     if(symname(sname))
  635.         {if(ptr=findloc(sname))
  636.             {getloc(ptr);
  637.             lval[0]=ptr;
  638.             lval[3]=lval[1]=ptr[type];
  639.                     /* jrvz 8/7/82 */
  640.             if(ptr[ident]==pointer)
  641.                 {lval[1]=cint;
  642.                 lval[2]=ptr[type];
  643.                 lval[3]=cint; /* jrvz 8/7/82 */
  644.                 }
  645.             if(ptr[ident]==array)
  646.                 {lval[2]=ptr[type];
  647.                 lval[3]=cint; /* jrvz 8/7/82 */
  648.                 return 0;
  649.                 }
  650.             else return 1;
  651.             }
  652.         if(ptr=findglb(sname))
  653.             if(ptr[ident]!=function)
  654.             {lval[0]=ptr;
  655.             lval[1]=0;
  656.             lval[3]=ptr[type];  /* jrvz 8/7/82 */
  657.             if(ptr[ident]!=array)
  658.                 {if(ptr[ident]==pointer)
  659.                     {lval[2]=ptr[type];
  660.                     lval[3]=cint;
  661.                     /* jrvz 8/7/82 */
  662.                     }
  663.                 return 1;
  664.                 }
  665.             if(ptr[ident]==array)
  666.                 lval[3]=cint; /* jrvz 8/30/82*/
  667.             immed();
  668.             outname(ptr);nl();
  669.             lval[1]=lval[2]=ptr[type];
  670.             return 0;
  671.             }
  672.         ptr=addglb(sname,function,cint,0);
  673.         lval[0]=ptr;
  674.         lval[1]=0;
  675.         lval[3]=cint;  /* jrvz 8/7/82 */
  676.         return 0;
  677.         }
  678.     if(constant(num,&lval[3]))  /* jrvz 8/7/82 */
  679.         return(lval[0]=lval[1]=0);
  680.     else
  681.         {error("invalid expression");
  682.         immed();outdec(0);nl();
  683.         junk();
  684.         return 0;
  685.         }
  686. }
  687. /* Complains if an operand isn't int      jrvz 10/10/82 */
  688. intcheck(v1,v2)
  689. int v1[],v2[];    /* pointers to operand dope arrays */
  690. {    if((v1[3]==DOUBLE)|(v2[3]==DOUBLE))
  691.         error("operands must be int");
  692. }
  693. /* Forces result, having type t2, to have type t1
  694.                     jrvz 10/10/82 */
  695. force(t1,t2) int t1,t2;
  696. {    if(t1==DOUBLE)
  697.         {if(t2!=DOUBLE) callrts("qfloat");
  698.         }
  699.     else if (t2==DOUBLE)
  700.         {if(t1!=DOUBLE) callrts("qifix");
  701.         }
  702. }
  703. /* If only one operand is DOUBLE, converts the other one to
  704.   DOUBLE.  Returns 1 if result will be DOUBLE.    jrvz 10/9/82 */
  705. widen(v1,v2) int v1[],v2[];
  706. {    if(v2[3]==DOUBLE)
  707.         {if(v1[3]!=DOUBLE)
  708.             {dpush2();
  709.                 /* push 2nd operand UNDER 1st */
  710.             mainpop();
  711.             callrts("qfloat");
  712.             callrts("dswap");
  713.             v1[3]=DOUBLE; /* type of result */
  714.             }
  715.         return 1;
  716.         }
  717.     else
  718.         {if(v1[3]==DOUBLE)
  719.             {callrts("qfloat");
  720.             return 1;
  721.             }
  722.         else return 0;
  723.         }
  724. }
  725. /*
  726. ** true if val1 -> int pointer or int array and
  727. **    val2 not ptr or array
  728. */
  729. dbltest(val1,val2) int val1[], val2[];
  730. {    if(val1[2])        /* rewritten    jrvz 8/11/82 */
  731.         {if(val1[2]==cchar) return 0;
  732.         if(val2[2])return 0;
  733.         return 1;
  734.         }
  735.     else return 0;
  736. }
  737. /*
  738. ** determine type of binary operation
  739. */
  740. result(lval,lval2) int lval[],lval2[];
  741. {    if(lval[2] & lval2[2])
  742.         lval[2]=0;  /* ptr-ptr => int */
  743.     else if(lval2[2])  /* ptr +- int => ptr */
  744.         {lval[0]=lval2[0];
  745.         lval[1]=lval2[1];
  746.         lval[2]=lval2[2];
  747.         }
  748. }
  749. store(lval)
  750.     int *lval;
  751. {    if (lval[1]==0)putmem(lval[0]);
  752.     else putstk(lval[1]);
  753. }
  754. rvalue(lval)
  755.     int *lval;
  756. {    if((lval[0] != 0) & (lval[1] == 0))
  757.         getmem(lval[0]);
  758.         else indirect(lval[1]);
  759. }
  760. test(label)
  761.     int label;
  762. {
  763.     needbrack("(");
  764.     expression();
  765.     needbrack(")");
  766.     testjump(label);
  767. }
  768. constant(val,t)
  769.     int val[],
  770.     *t;    /* type  jrvz 8/7/82 */
  771. {    if (fnumber(val))    /* jrvz 9/3/82 */
  772.         {t[0]=DOUBLE;
  773.         immed();printlabel(litlab);outbyte('+');
  774.         outdec(val[0]); nl();
  775.         callrts("dload");
  776.         return 1;
  777.         }
  778.     else if (number(val))
  779.         {t[0]=cint; immed();    /* jrvz 8/30/82 */
  780.         }
  781.     else if (pstr(val))
  782.         {t[0]=cint; immed();
  783.         }
  784.     else if (qstr(val))
  785.         {t[0]=cint;
  786.         immed();printlabel(litlab);outbyte('+');
  787.         }
  788.     else return 0;    
  789.     outdec(val[0]);
  790.     nl();
  791.     return 1;
  792. }
  793. fnumber(val)
  794.     int val[];
  795. {    double *dp,    /* used to store the result */
  796.     sum,        /* the partial result */
  797.     scale;        /* scale factor for next digit */
  798.     char *start,    /* copy of pointer to starting point */
  799.     *s;        /* points into source code */
  800.     int k,    /* flag and mask */
  801.     minus;    /* negative if number is negative */
  802.     start=s=line+lptr;    /* save starting point */
  803.     k=minus=1;
  804.     while(k)
  805.         {k=0;
  806.         if(*s=='+')
  807.             {++s; k=1;
  808.             }
  809.         if(*s=='-')
  810.             {++s; k=1; minus=(-minus);
  811.             }
  812.         }
  813.     while(numeric(*s))++s;
  814.     if(*s++!='.')return 0;    /* not floating point */
  815.     while(numeric(*s))++s;
  816.     lptr=(s--)-line;    /* save ending point */
  817.     sum=0.;    /* initialize result */
  818.     while(*s!='.')    /* handle digits to right of decimal */
  819.         sum=(sum+float(*(s--)-'0'))/10.;
  820.     scale=1.;    /* initialize scale factor */
  821.     while(--s>=start)    /* handle remaining digits */
  822.         {sum=sum+scale*float(*s-'0');
  823.         scale=scale*10.;
  824.         }
  825.     if(match("e"))    /* interpret exponent */
  826.         {int neg, /* nonzero if exp is negative */
  827.         expon;        /* the exponent */
  828.         if(number(&expon)==0)
  829.             {error("bad exponent");
  830.             expon=0;
  831.             }
  832.         if(expon<0)
  833.             {neg=1; expon=-expon;
  834.             }
  835.         else neg=0;
  836.         if(expon>38)
  837.             {error("overflow");
  838.             expon=0;
  839.             }
  840.         k=32;    /* set a bit in the mask */
  841.         scale=1.;
  842.         /* find 10**expon by repeated squaring */
  843.         while(k)
  844.             {scale=scale*scale;
  845.             if(k&expon) scale=scale*10.;
  846.             k=k>>1;
  847.             }
  848.         if(neg) sum=sum/scale;
  849.         else    sum=sum*scale;
  850.         }
  851.     if(minus<0) sum=-sum;
  852.     if(litptr+6>=litmax)
  853.         {error("string space exhausted");
  854.         return 0;
  855.         }
  856.         /* get location for result & bump litptr */
  857.     val[0]=litptr;
  858.     dp=litq+litptr;
  859.     litptr=litptr+6;
  860.     *dp=sum;    /* store result */
  861.     return 1;    /* report success */
  862. }
  863. number(val)
  864.     int val[];
  865. {    int k,minus;char c;
  866.     k=minus=1;
  867.     while(k)
  868.         {k=0;
  869.         if (match("+")) k=1;
  870.         if (match("-"))
  871.             {minus=(-minus);k=1;
  872.             }
  873.         }
  874.     if(numeric(ch())==0)return 0;
  875.     while (numeric(ch()))
  876.         {c=inbyte();
  877.         k=k*10+(c-'0');
  878.         }
  879.     if (minus<0) k=(-k);
  880.     val[0]=k;
  881.     return 1;
  882. }
  883. pstr(val)
  884.     int val[];
  885. {    int k;char c;
  886.     if (match("'"))
  887.         {k=0;
  888.         while((ch())!=39)
  889.             k=(k&255)*256 + (litchar()&127);
  890.         lptr++;        /*  jeh 11/10/82 */
  891.         val[0]=k;
  892.         return 1;
  893.         }
  894.     return 0;
  895. }
  896. qstr(val)
  897.     int val[];
  898. {    char c;
  899.     if (match(quote)==0) return 0;
  900.     val[0]=litptr;
  901.     while (ch()!='"')
  902.         {if(ch()==0)break;
  903.         if(litptr>=litmax)
  904.             {error("string space exhausted");
  905.             while(match(quote)==0)
  906.                 if(gch()==0)break;
  907.             return 1;
  908.             }
  909.         litq[litptr++]=litchar(); /* jeh  7/1/82 */
  910.         }
  911.     gch();
  912.     litq[litptr++]=0;
  913.     return 1;
  914. }
  915.  
  916. /* Return current literal char & bump lptr    jeh 7/1/82 */
  917. litchar()
  918. {    int i,oct;
  919.     if(ch()!=92)return gch();
  920.     if(nch()==0)return gch();
  921.     gch();
  922.     if(ch()=='b'){++lptr; return  8;} /* BS */
  923.     if(ch()=='t'){++lptr; return  9;} /* HT */
  924.     if(ch()=='l'){++lptr; return 10;} /* LF */
  925.     if(ch()=='f'){++lptr; return 12;} /* FF */
  926.     if(ch()=='n'){++lptr; return 13;} /* CR */
  927.     i=3; oct=0;
  928.     while(((i--)>0)&(ch()>='0')&(ch()<='7'))
  929.         oct=(oct<<3)+gch()-'0';
  930.     if(i==2)return gch(); else return oct;
  931. }
  932. /*    >>>>>> start of cc8 <<<<<<<    */
  933.  
  934. /* Begin a comment line for the assembler */
  935. comment()
  936. {    outbyte(';');
  937. }
  938.  
  939. /* Put out assembler info before any code is generated */
  940. header()
  941. {    comment();    outstr(BANNER);        nl();
  942.     comment();    outstr(AUTHOR);        nl();
  943.     comment();    outstr(VERSION);    nl();
  944.     comment();                nl();
  945.     if(mainflg){        /* do stuff needed for first */
  946. /*         ol("ORG 100h");    /* assembler file. NOT USED for ZMAC */
  947.         ol("LD HL,(6)");   /* set up stack */
  948.         ol("LD SP,HL");
  949.         callrts("ccgo");
  950.             /* set default drive for CP/M */
  951.         zcall("main");
  952.              /* call code generated by small-c */
  953.         if(profile)
  954.             {ol("global ccregis"); /* using these */
  955.             ol("global cccalls"); /* labels from */
  956.             ol("global ccleavi"); /* profiling routine */
  957.             immed(); printlabel(firstfct); nl();
  958.             callrts("cccalls");
  959.             }
  960.         zcall("exit");
  961.             /* do an exit        gtf 7/16/80 */
  962.         }
  963. }
  964. /* Print any assembler stuff needed after all code */
  965. trailer()
  966. {    if(profile) {printlabel(lastfct); ol("= 0");}
  967.     /* ol("END"); */    /*...note: commented out! */
  968.  
  969.     nl();
  970.     /* 6 May 80 rj errsummary() now goes to console */
  971.     comment();
  972.     outstr(" --- End of Compilation ---");
  973.     nl();
  974. }
  975. /* Print out a name such that it won't annoy the assembler */
  976. /*    (by matching anything reserved, like opcodes.) */
  977. /*    gtf 4/7/80 */
  978. outname(sname)
  979. char *sname;
  980. {    int len, i,j;
  981.  
  982.     outasm("q");
  983.         /* qz => q to shorten names (4/18/81, jrvz) */
  984.     len = strlen(sname);
  985.     if(len>(ASMPREF+ASMSUFF)){
  986.         i = ASMPREF;
  987.         len = len-ASMPREF-ASMSUFF;
  988.         while(i--)    /* jrvz 8/3/82 */
  989.             outbyte(raise(*sname++));
  990.         while(len--)    /* jrvz 8/3/82 */
  991.             ++sname;
  992.         while(*sname)
  993.             outbyte(raise(*sname++));
  994.         }
  995.     else    outasm(sname);
  996. /* end outname */}
  997. /* Fetch a static memory cell into the primary register */
  998. getmem(sym)
  999.     char *sym;
  1000. {    if((sym[ident]!=pointer)&(sym[type]==cchar))
  1001.         {ot("LD A,("); outname(sym+name);
  1002.         outasm(")"); nl();
  1003.         callrts("ccsxt");
  1004.         }
  1005.     else if((sym[ident]!=pointer)&(sym[type]==DOUBLE))
  1006.         {immed(); outname(sym+name); nl();
  1007.         callrts("dload");
  1008.         }        /* jrvz 8/7/82 */
  1009.     else
  1010.         {ot("LD HL,("); outname(sym+name); outasm(")");
  1011.         nl();
  1012.         }
  1013.     }
  1014. /* Fetch the address of the specified symbol */
  1015. /*    into the primary register */
  1016. getloc(sym)
  1017.     char *sym;
  1018. {    immed();
  1019.     outdec(((sym[offset]&255)+
  1020.         ((sym[offset+1])<<8))-
  1021.         Zsp);
  1022.         /* 2nd 8-bit mask removed  jrvz 8/3/82 */
  1023.     nl();
  1024.     ol("ADD HL,SP");
  1025.     }
  1026. /* Store the primary register into the specified */
  1027. /*    static memory cell */
  1028. putmem(sym)
  1029.     char *sym;
  1030. {    if((sym[ident]!=pointer)&(sym[type]==DOUBLE))
  1031.         {immed(); outname(sym+name); nl();
  1032.         callrts("dstore");
  1033.         }        /* jrvz 8/7/82 */
  1034.     else    {if((sym[ident]!=pointer)&(sym[type]==cchar))
  1035.             {ol("LD A,L");
  1036.             ot("LD (");
  1037.             outname(sym+name); outasm("),A");
  1038.             }
  1039.         else
  1040.             {ot("LD (");
  1041.             outname(sym+name); outasm("),HL");
  1042.             }
  1043.         nl();
  1044.         }
  1045.     }
  1046. /* Store the specified object type in the primary register */
  1047. /*    at the address on the top of the stack */
  1048. putstk(typeobj)
  1049.     char typeobj;
  1050. {    if(typeobj==DOUBLE)
  1051.         {mainpop();
  1052.         callrts("dstore");
  1053.         }
  1054.     else
  1055.         {if(typeobj==cchar)
  1056.             {zpop();
  1057.             ol("LD A,L"); ol("LD (DE),A");
  1058.             }    /* jrvz 7/1/82 */
  1059.         else
  1060.             {callrts("ccpint"); popped();
  1061.             }
  1062.  
  1063.         }
  1064.     }
  1065. /* Fetch the specified object type indirect through the */
  1066. /*    primary register into the primary register */
  1067. indirect(typeobj)
  1068.     char typeobj;
  1069. {    if(typeobj==cchar)callrts("ccgchar");
  1070.     else if(typeobj==DOUBLE)    /* jrvz 8/7/82 */
  1071.         callrts("dload");
  1072.     else callrts("ccgint");
  1073. }
  1074. /* Swap the primary and secondary registers */
  1075. swap()
  1076. {    ol("EX DE,HL");
  1077. }
  1078. /* Print partial instruction to get an immediate value */
  1079. /*    into the primary register */
  1080. immed()
  1081. {    ot("LD HL,");
  1082. }
  1083. /* Push the primary register onto the stack */
  1084. zpush()
  1085. {    ol("PUSH HL");
  1086.     Zsp=Zsp-2;
  1087. }
  1088. /* Push the primary floating point register onto the stack
  1089.                         jrvz 8/7/82 */
  1090. dpush()
  1091. {    callrts("dpush");
  1092.     Zsp=Zsp-6;
  1093. }
  1094. /* Push the primary floating point register, preserving
  1095.     the top value  jrvz 8/7/82 */
  1096. dpush2()
  1097. {    callrts("dpush2");
  1098.     Zsp=Zsp-6;
  1099. }
  1100. /* Pop the top of the stack into the primary register
  1101.                     jrvz 10/11/82 */
  1102. mainpop()
  1103. {    ol("POP HL");
  1104.     Zsp=Zsp+2;
  1105. }
  1106. /* Pop the top of the stack into the secondary register */
  1107. zpop()
  1108. {    ol("POP DE");
  1109.     Zsp=Zsp+2;
  1110. }
  1111. /* Adjust the stack counter for 2 bytes popped off stack */
  1112. popped()
  1113. {    Zsp=Zsp+2;
  1114. }
  1115. /* Swap the primary register and the top of the stack */
  1116. swapstk()
  1117. {    ol("EX (SP),HL");
  1118. }
  1119. /* Call the specified subroutine name */
  1120. zcall(sname)
  1121.     char *sname;
  1122. {    ot("CALL ");
  1123.     outname(sname);
  1124.     nl();
  1125. }
  1126. /* Call a run-time library routine */
  1127. callrts(sname)
  1128. char *sname;
  1129. {
  1130.     ot("CALL ");
  1131.     outasm(sname);
  1132.     nl();
  1133. /*end callrts*/}
  1134.  
  1135. /* Return from subroutine */
  1136. zret()
  1137. {    ol("RET");
  1138. }
  1139. /* Perform subroutine call to value on top of stack */
  1140. callstk()
  1141. {    immed();
  1142.     outasm("$+5");
  1143.     nl();
  1144.     swapstk();
  1145.     ol("JP (HL)");
  1146.     Zsp=Zsp-2;
  1147.     }
  1148. /* Jump to specified internal label number */
  1149. jump(label)
  1150.     int label;
  1151. {    ot("JP ");
  1152.     printlabel(label);
  1153.     nl();
  1154.     }
  1155. /* Test the primary register and jump if false to label */
  1156. testjump(label)
  1157.     int label;
  1158. {    ol("LD A,H");
  1159.     ol("OR L");
  1160.     ot("JP Z,");
  1161.     printlabel(label);
  1162.     nl();
  1163.     }
  1164. /* Print pseudo-op to define a byte */
  1165. defbyte()
  1166. {    ot("DEFB ");
  1167. }
  1168. /*Print pseudo-op to define storage */
  1169. defstorage()
  1170. {    ot("DEFS ");
  1171. }
  1172. /* Print pseudo-op to define a word */
  1173. defword()
  1174. {    ot("DEFW ");
  1175. }
  1176. /* Modify the stack pointer to the new value indicated */
  1177. modstk(newsp)
  1178.     int newsp;
  1179.  {    int k;
  1180.     k=newsp-Zsp;
  1181.     if(k==0)return newsp;
  1182.     if(k>=0)
  1183.         {if(k<7)
  1184.             {if(k&1)
  1185.                 {ol("INC SP");
  1186.                 --k;
  1187.                 }
  1188.             while(k)
  1189.                 {ol("POP BC");
  1190.                 k=k-2;
  1191.                 }
  1192.             return newsp;
  1193.             }
  1194.         }
  1195.     if(k<0)
  1196.         {if(k>-7)
  1197.             {if(k&1)
  1198.                 {ol("DEC SP");
  1199.                 ++k;
  1200.                 }
  1201.             while(k)
  1202.                 {ol("PUSH BC");
  1203.                 k=k+2;
  1204.                 }
  1205.             return newsp;
  1206.             }
  1207.         }
  1208.     swap();
  1209.     immed();outdec(k);nl();
  1210.     ol("ADD HL,SP");
  1211.     ol("LD SP,HL");
  1212.     swap();
  1213.     return newsp;
  1214. }
  1215. /* Multiply the primary register by the length of
  1216.     some variable                jrvz 8/7/82 */
  1217. scale(t)
  1218. int t;    /* type */
  1219. {    if(t==cchar) return;
  1220.     if(t==DOUBLE) sixreg();
  1221.     else doublereg();
  1222. }
  1223. /* Double the primary register */
  1224. doublereg()
  1225. {    ol("ADD HL,HL");
  1226. }
  1227. /* Multiply the primary register by the length of a double
  1228.     (preserve DE)                jrvz 8/7/82 */
  1229. sixreg()
  1230. {    ol("LD B,H");
  1231.     ol("LD C,L");
  1232.     ol("ADD HL,BC");
  1233.     ol("ADD HL,BC");
  1234.     ol("ADD HL,HL");
  1235. }
  1236. /* Add a constant to the primary register  jrvz 10/11/82 */
  1237. addimm(x) char *x;
  1238. {    ot("LD DE,"); outasm(x); nl(); zadd();
  1239. }
  1240. /* Add the primary and secondary registers
  1241.     (result in primary) */
  1242. zadd()
  1243. {    ol("ADD HL,DE");
  1244. }
  1245. /* Add the primary floating point register to the
  1246.   value on the stack (under the return address)
  1247.   (result in primary)              jrvz 8/8/82 */
  1248. dadd(){    callrts("dadd"); Zsp=Zsp+6;}
  1249. /* Subtract the primary register from the TOS */
  1250. /*    (TOS = value under the return address) */
  1251. /*    (results in primary) */
  1252. zsub()
  1253. {    callrts("ccsub"); popped();
  1254. }
  1255. /* Subtract the primary floating point register from the
  1256.   value on the stack (under the return address)
  1257.   (result in primary)                jrvz 8/8/82 */
  1258. dsub()
  1259. {    callrts("dsub"); Zsp=Zsp+6;}
  1260. /* Multiply the primary and TOS */
  1261. /*    (results in primary */
  1262. mult()
  1263. {    callrts("ccmult"); popped();
  1264. }
  1265. /* Multiply the primary floating point register by the value
  1266.   on the stack (under the return address)
  1267.   (result in primary)                jrvz 8/8/82 */
  1268. dmul()
  1269. {    callrts("dmul"); Zsp=Zsp+6;}
  1270. /* Divide the secondary register by the primary */
  1271. /*    (quotient in primary, remainder in secondary) */
  1272. div()
  1273. {    callrts("ccdiv");
  1274. }
  1275. /* Divide the value on the stack (under the return address)
  1276.   by the primary floating point register (quotient in primary)
  1277.                         jrvz 8/8/82 */
  1278. ddiv()
  1279. {    callrts("ddiv"); Zsp=Zsp+6;}
  1280. /* Compute remainder (mod) of secondary register divided */
  1281. /*    by the primary */
  1282. /*    (remainder in primary, quotient in secondary) */
  1283. zmod()
  1284. {    div();
  1285.     swap();
  1286.     }
  1287. /* Inclusive 'or' the primary and the TOS */
  1288. /*    (results in primary) */
  1289. zor()
  1290.     {callrts("ccor"); popped();}
  1291. /* Exclusive 'or' the primary and TOS */
  1292. /*    (results in primary) */
  1293. zxor()
  1294.     {callrts("ccxor"); popped();}
  1295. /* 'And' the primary and TOS */
  1296. /*    (results in primary) */
  1297. zand()
  1298.     {callrts("ccand"); popped();}
  1299. /* Arithmetic shift right the secondary register number of */
  1300. /*     times in primary (results in primary) */
  1301. asr()
  1302.     {callrts("ccasr");}
  1303. /* Arithmetic left shift the TOS number of */
  1304. /*    times in primary (results in primary) */
  1305. asl()
  1306.     {callrts("ccasl"); popped();}
  1307. /* Form two's complement of primary register */
  1308. neg()
  1309.     {callrts("ccneg");}
  1310. /* Negate the primary floating point register */
  1311. dneg()
  1312.     {callrts("minusfa");}
  1313. /* Form one's complement of primary register */
  1314. com()
  1315.     {callrts("cccom");}
  1316. /* Increment the primary register by one */
  1317. inc()
  1318.     {ol("INC HL");}
  1319. /* Decrement the primary register by one */
  1320. dec()
  1321.     {ol("DEC HL");}
  1322.  
  1323. /* Following are the conditional operators */
  1324. /* They compare the TOS against the primary */
  1325. /* and put a literal 1 in the primary if the condition is */
  1326. /* true, otherwise they clear the primary register */
  1327.  
  1328. /* Test for equal */
  1329. zeq()
  1330.     {callrts("cceq"); popped();}
  1331. /* Test for not equal */
  1332. zne()
  1333.     {callrts("ccne"); popped();}
  1334. /* Test for less than (signed) */
  1335. zlt()
  1336.     {callrts("cclt"); popped();}
  1337. /* Test for less than or equal to (signed) */
  1338. zle()
  1339.     {callrts("ccle"); popped();}
  1340. /* Test for greater than (signed) */
  1341. zgt()
  1342.     {callrts("ccgt"); popped();}
  1343. /* Test for greater than or equal to (signed) */
  1344. zge()
  1345.     {callrts("ccge"); popped();}
  1346. /* Test for less than (unsigned) */
  1347. ult()
  1348.     {callrts("ccult"); popped();}
  1349. /* Test for less than or equal to (unsigned) */
  1350. ule()
  1351.     {callrts("ccule"); popped();}
  1352. /* Test for greater than (unsigned) */
  1353. ugt()
  1354.     {callrts("ccugt"); popped();}
  1355. /* Test for greater than or equal to (unsigned) */
  1356. uge()
  1357.     {callrts("ccuge"); popped();}
  1358.  
  1359. /* The following conditional operations compare the
  1360.    top of the stack (TOS) against the primary floating point
  1361.    register (FA), resulting in 1 if true and 0 if false */
  1362.  
  1363. /* Test for floating equal */
  1364. deq()
  1365.     {callrts("deq"); Zsp=Zsp+6;}
  1366. /* Test for floating not equal */
  1367. dne()
  1368.     {callrts("dne"); Zsp=Zsp+6;}
  1369. /* Test for floating less than   (that is, TOS < FA)    */
  1370. dlt()
  1371.     {callrts("dlt"); Zsp=Zsp+6;}
  1372. /* Test for floating less than or equal to */
  1373. dle()
  1374.     {callrts("dle"); Zsp=Zsp+6;}
  1375. /* Test for floating greater than */
  1376. dgt()
  1377.     {callrts("dgt"); Zsp=Zsp+6;}
  1378. /* Test for floating greater than or equal */
  1379. dge()
  1380.     {callrts("dge"); Zsp=Zsp+6;}
  1381.  
  1382. /*    <<<<<  End of small-c compiler  >>>>>    */
  1383.