home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / ENTERPRS / CPM / UTILS / S / SMC21SRC.LZH / CC31.C < prev    next >
Text File  |  2000-06-30  |  7KB  |  265 lines
  1. /*
  2. ** lval[0] - symbol table address, else 0 for constant
  3. ** lval[1] - type of indirect obj to fetch, else 0 for static
  4. ** lval[2] - type of pointer or array, else 0 for all other
  5. ** lval[3] - true if constant expression
  6. ** lval[4] - value of constant expression
  7. ** lval[5] - true if secondary register altered
  8. ** lval[6] - function address of highest/last binary operator
  9. ** lval[7] - stage address of "oper 0" code, else 0
  10. */
  11.  
  12. /*
  13. ** skim over terms adjoining || and && operators
  14. */
  15. skim(opstr, testfunc, dropval, endval, heir, lval)
  16.   char *opstr;
  17.   int (*testfunc)(), dropval, endval, heir, lval[]; {   /*13*/
  18.   int k, hits, droplab, endlab;
  19.   hits=0;
  20.   while(1) {
  21.     k=plnge1(heir, lval);
  22.     if(nextop(opstr)) {
  23.       bump(opsize);
  24.       if(hits==0) {
  25.         hits=1;
  26.         droplab=getlabel();
  27.         }
  28.       dropout(k, testfunc, droplab, lval);
  29.       }
  30.     else if(hits) {
  31.       dropout(k, testfunc, droplab, lval);
  32.       const(endval);
  33.       jump(endlab=getlabel());
  34.       postlabel(droplab);
  35.       const(dropval);
  36.       postlabel(endlab);
  37.       lval[1]=lval[2]=lval[3]=lval[7]=0;
  38.       return 0;
  39.       }
  40.     else return k;
  41.     }
  42.   }
  43.  
  44. /*
  45. ** test for early dropout from || or && evaluations
  46. */
  47. dropout(k, testfunc, exit1, lval) 
  48.   int k, (*testfunc)(), exit1, lval[]; {                /*13*/
  49.   if(k) rvalue(lval);
  50.   else if(lval[3]) const(lval[4]);
  51.   (*testfunc)(exit1); /* jumps on false */              /*13*/
  52.   }
  53.  
  54. /*
  55. ** plunge to a lower level
  56. */
  57. plnge(opstr, opoff, heir, lval)
  58.   char *opstr;
  59.   int opoff, (*heir)(), lval[]; {                       /*13*/
  60.   int k, lval2[8];
  61.   k=plnge1(heir, lval);
  62.   if(nextop(opstr)==0) return k;
  63.   if(k) rvalue(lval);
  64.   while(1) {
  65.     if(nextop(opstr)) {
  66.       bump(opsize);
  67.       opindex=opindex+opoff;
  68.       plnge2(op[opindex], op2[opindex], heir, lval, lval2);
  69.       }
  70.     else return 0;
  71.     }
  72.   }
  73.  
  74. /*
  75. ** unary plunge to lower level
  76. */
  77. plnge1(heir, lval) int (*heir)(), lval[]; {     /*13*/
  78.   char *before, *start;
  79.   int k;
  80.   setstage(&before, &start);
  81.   k= (*heir)(lval);               /*13*/
  82.   if(lval[3]) clearstage(before,0); /* load constant later */
  83.   return k;
  84.   }
  85.  
  86. /*
  87. ** binary plunge to lower level
  88. */
  89. plnge2(oper, oper2, heir, lval, lval2)
  90.   int (*oper)(), (*oper2)(), (*heir)(), lval[], lval2[]; {    /*13*/
  91.   char *before, *start;
  92.   setstage(&before, &start);
  93.   lval[5]=1;          /* flag secondary register used */
  94.   lval[7]=0;          /* flag as not "... oper 0" syntax */
  95.   if(lval[3]) {       /* constant on left side not yet loaded */
  96.     if(plnge1(heir, lval2)) rvalue(lval2);
  97.     if(lval[4]==0) lval[7]=stagenext;
  98.     const2(lval[4]<<dbltest(oper, lval2, lval));     /*34*/
  99.     }
  100.   else {              /* non-constant on left side */
  101.     push();
  102.     if(plnge1(heir, lval2)) rvalue(lval2);
  103.     if(lval2[3]) {    /* constant on right side */
  104.       if(lval2[4]==0) lval[7]=start;
  105.       if(oper==ffadd) { /* may test other commutative operators */
  106.         csp=csp+2;
  107.         clearstage(before, 0);
  108.         const2(lval2[4]<<dbltest(oper, lval, lval2));   /* load secondary */
  109.         }
  110.       else {
  111.         const(lval2[4]<<dbltest(oper, lval, lval2));    /*34*/
  112.                                             /* load primary */
  113.         smartpop(lval2, start);
  114.         }
  115.       }
  116.     else {            /* non-constants on both sides */
  117.       smartpop(lval2, start);
  118.                                                           /*34*/
  119.         if(dbltest(oper, lval,lval2)) doublereg();        /*34*/
  120.         if(dbltest(oper, lval2,lval)) {                   /*34*/
  121.           swap();
  122.           doublereg();
  123.           if(oper==ffsub) swap();
  124.           }
  125.                                                           /*34*/
  126.       }
  127.     }
  128.   if(oper) {
  129.     if(lval[3]=lval[3]&lval2[3]) {
  130.       lval[4]=calc(lval[4], oper, lval2[4]);
  131.       clearstage(before, 0);  
  132.       lval[5]=0;
  133.       }
  134.     else {
  135.       if((lval[2]==0)&(lval2[2]==0)) {
  136.        (*oper)();       /*13*/
  137.         lval[6]= oper;    /* identify the operator */
  138.         }
  139.       else {
  140.         (*oper2)();                                   /*13*/
  141.         lval[6]= oper2;   /* identify the operator */
  142.         }
  143.       }
  144.     if(oper==ffsub) {
  145.       if((lval[2]==CINT)&(lval2[2]==CINT)) {
  146.         swap();
  147.         const(1);
  148.         ffasr();  /** div by 2 **/
  149.         }
  150.       }
  151.     if((oper==ffsub)|(oper==ffadd)) result(lval, lval2);
  152.     }
  153.   }
  154. calc(left, oper, right) int left, (*oper)(), right; {     /*13*/
  155.        if(oper ==  ffor) return (left  |  right);
  156.   else if(oper == ffxor) return (left  ^  right);
  157.   else if(oper == ffand) return (left  &  right);
  158.   else if(oper ==  ffeq) return (left  == right);
  159.   else if(oper ==  ffne) return (left  != right);
  160.   else if(oper ==  ffle) return (left  <= right);
  161.   else if(oper ==  ffge) return (left  >= right);
  162.   else if(oper ==  fflt) return (left  <  right);
  163.   else if(oper ==  ffgt) return (left  >  right);
  164.   else if(oper == ffasr) return (left  >> right);
  165.   else if(oper == ffasl) return (left  << right);
  166.   else if(oper == ffadd) return (left  +  right);
  167.   else if(oper == ffsub) return (left  -  right);
  168.   else if(oper ==ffmult) return (left  *  right);
  169.   else if(oper == ffdiv) return (left  /  right);
  170.   else if(oper == ffmod) return (left  %  right);
  171.   else return 0;
  172.   }
  173.  
  174. expression(const, val) int *const, *val;  {
  175.   int lval[8];
  176.   if(heir1(lval)) rvalue(lval);
  177.   if(lval[3]) {
  178.     *const=1;
  179.     *val=lval[4];
  180.     }
  181.   else *const=0;
  182.   }
  183.  
  184. heir1(lval)  int lval[];  {
  185.   int k,lval2[8], oper;
  186.   k=plnge1(heir3, lval);
  187.   if(lval[3]) const(lval[4]);
  188.        if(match("|="))  oper= ffor;
  189.   else if(match("^="))  oper= ffxor;
  190.   else if(match("&="))  oper= ffand;
  191.   else if(match("+="))  oper= ffadd;
  192.   else if(match("-="))  oper= ffsub;
  193.   else if(match("*="))  oper= ffmult;
  194.   else if(match("/="))  oper= ffdiv;
  195.   else if(match("%="))  oper= ffmod;
  196.   else if(match(">>=")) oper= ffasr;
  197.   else if(match("<<=")) oper= ffasl;
  198.   else if(match("="))   oper= 0;
  199.   else return k;
  200.   if(k==0) {
  201.     needlval();
  202.     return 0;
  203.     }
  204.   if(lval[1]) {
  205.     if(oper) {
  206.       push();
  207.       rvalue(lval);
  208.       }
  209.     plnge2(oper, oper, heir1, lval, lval2);
  210.     if(oper) pop();
  211.     }
  212.   else {
  213.     if(oper) {
  214.       rvalue(lval);
  215.       plnge2(oper, oper, heir1, lval, lval2);
  216.       }
  217.     else {
  218.       if(heir1(lval2)) rvalue(lval2);
  219.       lval[5]=lval2[5];
  220.       }
  221.     }
  222.   store(lval);
  223.   return 0;
  224.   }
  225.  
  226. heir3(lval)  int lval[]; {
  227.   return skim("||", eq0, 1, 0, heir4, lval);
  228.   }
  229.  
  230. heir4(lval)  int lval[]; {
  231.   return skim("&&", ne0, 0, 1, heir5, lval);
  232.   }
  233.  
  234. heir5(lval)  int lval[]; {
  235.  return plnge("|", 0, heir6, lval);
  236.   }
  237.  
  238. heir6(lval)  int lval[]; {
  239.   return plnge("^", 1, heir7, lval);
  240.   }
  241.  
  242. heir7(lval)  int lval[]; {
  243.   return plnge("&", 2, heir8, lval);
  244.   }
  245.  
  246. heir8(lval)  int lval[];  {
  247.   return plnge("== !=", 3, heir9, lval);
  248.   }
  249.  
  250. heir9(lval)  int lval[];  {
  251.  return plnge("<= >= < >", 5, heir10, lval);
  252.   }
  253.  
  254. heir10(lval)  int lval[];  {
  255.   return plnge(">> <<", 9, heir11, lval);
  256.   }
  257.  
  258. heir11(lval)  int lval[];  {
  259.  return plnge("+ -", 11, heir12, lval);
  260.   }
  261.  
  262. heir12(lval)  int lval[];  {
  263.  return plnge("* / %", 13, heir13, lval);
  264.   }
  265.