home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / misc / smc203.ark / CC31.C < prev    next >
Encoding:
Text File  |  1983-07-28  |  8.4 KB  |  343 lines
  1.  
  2. /*
  3. ** lval[0] - symbol table address, else 0 for constant
  4. ** lval[1] - type of indirect obj to fetch, else 0 for static
  5. ** lval[2] - type of pointer or array, else 0 for all other
  6. ** lval[3] - true if constant expression
  7. ** lval[4] - value of constant expression
  8. ** lval[5] - true if secondary register altered
  9. ** lval[6] - function address of highest/last binary operator
  10. ** lval[7] - stage address of "oper 0" code, else 0
  11. */
  12.  
  13. /*
  14. ** skim over terms adjoining || and && operators
  15. */
  16. skim(opstr, testfunc, dropval, endval, heir, lval)
  17.   char *opstr;
  18.  
  19. #ifdef FULLC
  20.   int (*testfunc)(), dropval, endval, (*heir)(), lval[]; {
  21. #else /* FULLC */
  22.   int testfunc, dropval, endval, heir, lval[]; {
  23. #endif /* FULLC */
  24.  
  25.   int k, hits, droplab, endlab;
  26.   hits=0;
  27.   while(1) {
  28.     k=plung1(heir, lval);
  29.     if(nextop(opstr)) {
  30.       bump(opsize);
  31.       if(hits==0) {
  32.         hits=1;
  33.         droplab=getlabel();
  34.         }
  35.       dropout(k, testfunc, droplab, lval);
  36.       }
  37.     else if(hits) {
  38.       dropout(k, testfunc, droplab, lval);
  39.       const(endval);
  40.       jump(endlab=getlabel());
  41.       postlabel(droplab);
  42.       const(dropval);
  43.       postlabel(endlab);
  44.       lval[1]=lval[2]=lval[3]=lval[7]=0;
  45.       return 0;
  46.       }
  47.     else return k;
  48.     }
  49.   }
  50.  
  51. /*
  52. ** test for early dropout from || or && evaluations
  53. */
  54. #ifdef FULLC
  55. dropout(k, testfunc, exit1, lval) int k, (*testfunc)(), exit1, lval[]; {
  56. #else /* FULLC */
  57. dropout(k, testfunc, exit1, lval) int k, testfunc, exit1, lval[]; {
  58. #endif /* FULLC */
  59.  
  60.   if(k) rvalue(lval);
  61.   else if(lval[3]) const(lval[4]);
  62.  
  63. #ifdef FULLC
  64.   (*testfunc)(exit1); /* jumps on false */
  65. #else /* FULLC */
  66.   testfunc(exit1); /* jumps on false */
  67. #endif /* FULLC */
  68.  
  69.   }
  70.  
  71. /*
  72. ** plunge to a lower level
  73. */
  74. plunge(opstr, opoff, heir, lval)
  75.   char *opstr;
  76.  
  77. #ifdef FULLC
  78.   int opoff, (*heir)(), lval[]; {
  79. #else /* FULLC */
  80.   int opoff, heir, lval[]; {
  81. #endif /* FULLC */
  82.  
  83.   int k, lval2[8];
  84.   k=plung1(heir, lval);
  85.   if(nextop(opstr)==0) return k;
  86.   if(k) rvalue(lval);
  87.   while(1) {
  88.     if(nextop(opstr)) {
  89.       bump(opsize);
  90.       opindex=opindex+opoff;
  91.       plung2(op[opindex], op2[opindex], heir, lval, lval2);
  92.       }
  93.     else return 0;
  94.     }
  95.   }
  96.  
  97. /*
  98. ** unary plunge to lower level
  99. ** renamed "plung1" (original was "plunge1") to have
  100. ** first 6 chars unique for M80 assembler.
  101. */
  102. #ifdef FULLC
  103. plung1(heir, lval) int (*heir)(), lval[]; {
  104. #else /* FULLC */
  105. plung1(heir, lval) int heir, lval[]; {
  106. #endif /* FULLC */
  107.  
  108.   char *before, *start;
  109.   int k;
  110.   setstage(&before, &start);
  111.  
  112. #ifdef FULLC
  113.   k= (*heir)(lval);
  114. #else /* FULLC */
  115.   k= heir(lval);
  116. #endif /* FULLC */
  117.  
  118.   if(lval[3]) clearstage(before,0); /* load constant later */
  119.   return k;
  120.   }
  121.  
  122. /*
  123. ** binary plunge to lower level
  124. ** renamed "plung2" (original was "plunge2") to have
  125. ** first 6 chars unique for M80 assembler.
  126. */
  127. plung2(oper, oper2, heir, lval, lval2)
  128.  
  129. #ifdef FULLC
  130.   int (*oper)(), (*oper2)(), (*heir)(), lval[], lval2[]; {
  131. #else /* FULLC */
  132.   int oper, oper2, heir, lval[], lval2[]; {
  133. #endif /* FULLC */
  134.  
  135.   char *before, *start;
  136.   setstage(&before, &start);
  137.   lval[5]=1;          /* flag secondary register used */
  138.   lval[7]=0;          /* flag as not "... oper 0" syntax */
  139.   if(lval[3]) {       /* constant on left side not yet loaded */
  140.     if(plung1(heir, lval2)) rvalue(lval2);
  141.     if(lval[4]==0) lval[7]=stagenext;
  142.     const2(lval[4]<<dbltest(lval2, lval));
  143.     }
  144.   else {              /* non-constant on left side */
  145.     zzpush();
  146.     if(plung1(heir, lval2)) rvalue(lval2);
  147.     if(lval2[3]) {    /* constant on right side */
  148.       if(lval2[4]==0) lval[7]=start;
  149.       if(oper==zzadd) { /* may test other commutative operators */
  150.         csp=csp+2;
  151.         clearstage(before, 0);
  152.         const2(lval2[4]<<dbltest(lval, lval2));   /* load secondary */
  153.         }
  154.       else {
  155.         const(lval2[4]<<dbltest(lval, lval2));    /* load primary */
  156.         smartpop(lval2, start);
  157.         }
  158.       }
  159.     else {            /* non-constants on both sides */
  160.       smartpop(lval2, start);
  161.       if((oper==zzadd)|(oper==zzsub)) {
  162.         if(dbltest(lval,lval2)) doublereg();
  163.         if(dbltest(lval2,lval)) {
  164.           swap();
  165.           doublereg();
  166.           if(oper==zzsub) swap();
  167.           }
  168.         }
  169.       }
  170.     }
  171.   if(oper) {
  172.     if(lval[3]=lval[3]&lval2[3]) {
  173.       lval[4]=calc(lval[4], oper, lval2[4]);
  174.       clearstage(before, 0);  
  175.       lval[5]=0;
  176.       }
  177.     else {
  178.       if((lval[2]==0)&(lval2[2]==0)) {
  179.  
  180. #ifdef FULLC
  181.         (*oper)();
  182. #else /* FULLC */
  183.         oper();
  184. #endif /* FULLC */
  185.  
  186.         lval[6]= oper;    /* identify the operator */
  187.         }
  188.       else {
  189.  
  190. #ifdef FULLC
  191.         (*oper2)();
  192. #else /* FULLC */
  193.         oper2();
  194. #endif /* FULLC */
  195.  
  196.         lval[6]= oper2;   /* identify the operator */
  197.         }
  198.       }
  199.     if(oper==zzsub) {
  200.       if((lval[2]==CINT)&(lval2[2]==CINT)) {
  201.         swap();
  202.         const(1);
  203.         zzasr();  /** div by 2 **/
  204.         }
  205.       }
  206.     if((oper==zzsub)|(oper==zzadd)) result(lval, lval2);
  207.     }
  208.   }
  209.  
  210. #ifdef FULLC
  211. calc(left, oper, right) int left, (*oper)(), right; {
  212. #else /* FULLC */
  213. calc(left, oper, right) int left, oper, right; {
  214. #endif /* FULLC */
  215.  
  216.        if(oper ==  zzor) return (left  |  right);
  217.   else if(oper == zzxor) return (left  ^  right);
  218.   else if(oper == zzand) return (left  &  right);
  219.   else if(oper ==  zzeq) return (left  == right);
  220.   else if(oper ==  zzne) return (left  != right);
  221.   else if(oper ==  zzle) return (left  <= right);
  222.   else if(oper ==  zzge) return (left  >= right);
  223.   else if(oper ==  zzlt) return (left  <  right);
  224.   else if(oper ==  zzgt) return (left  >  right);
  225.   else if(oper == zzasr) return (left  >> right);
  226.   else if(oper == zzasl) return (left  << right);
  227.   else if(oper == zzadd) return (left  +  right);
  228.   else if(oper == zzsub) return (left  -  right);
  229.   else if(oper ==zzmult) return (left  *  right);
  230.   else if(oper == zzdiv) return (left  /  right);
  231.   else if(oper == zzmod) return (left  %  right);
  232.   else return 0;
  233.   }
  234.  
  235. expression(const, val) int *const, *val;  {
  236.   int lval[8];
  237.   if(heir1(lval)) rvalue(lval);
  238.   if(lval[3]) {
  239.     *const=1;
  240.     *val=lval[4];
  241.     }
  242.   else *const=0;
  243.   }
  244.  
  245. heir1(lval)  int lval[];  {
  246.  
  247. #ifdef FULLC
  248.   int k,lval2[8], (*oper)(), heir3();
  249. #else /* FULLC */
  250.   int k,lval2[8], oper, heir3();
  251. #endif /* FULLC */
  252.  
  253.   k=plung1(heir3, lval);
  254.   if(lval[3]) const(lval[4]);
  255.        if(match("|="))  oper= zzor;
  256.   else if(match("^="))  oper= zzxor;
  257.   else if(match("&="))  oper= zzand;
  258.   else if(match("+="))  oper= zzadd;
  259.   else if(match("-="))  oper= zzsub;
  260.   else if(match("*="))  oper= zzmult;
  261.   else if(match("/="))  oper= zzdiv;
  262.   else if(match("%="))  oper= zzmod;
  263.   else if(match(">>=")) oper= zzasr;
  264.   else if(match("<<=")) oper= zzasl;
  265.   else if(match("="))   oper= 0;
  266.   else return k;
  267.   if(k==0) {
  268.     needlval();
  269.     return 0;
  270.     }
  271.   if(lval[1]) {
  272.     if(oper) {
  273.       zzpush();
  274.       rvalue(lval);
  275.       }
  276.     plung2(oper, oper, heir1, lval, lval2);
  277.     if(oper) zzpop();
  278.     }
  279.   else {
  280.     if(oper) {
  281.       rvalue(lval);
  282.       plung2(oper, oper, heir1, lval, lval2);
  283.       }
  284.     else {
  285.       if(heir1(lval2)) rvalue(lval2);
  286.       lval[5]=lval2[5];
  287.       }
  288.     }
  289.   store(lval);
  290.   return 0;
  291.   }
  292.  
  293. heir3(lval)  int lval[]; {
  294.   int heir4();
  295.   return skim("||", eq0, 1, 0, heir4, lval);
  296.   }
  297.  
  298. heir4(lval)  int lval[]; {
  299.   int heir5();
  300.   return skim("&&", ne0, 0, 1, heir5, lval);
  301.   }
  302.  
  303. heir5(lval)  int lval[]; {
  304.   int heir6();
  305.   return plunge("|", 0, heir6, lval);
  306.   }
  307.  
  308. heir6(lval)  int lval[]; {
  309.   int heir7();
  310.   return plunge("^", 1, heir7, lval);
  311.   }
  312.  
  313. heir7(lval)  int lval[]; {
  314.   int heir8();
  315.   return plunge("&", 2, heir8, lval);
  316.   }
  317.  
  318. heir8(lval)  int lval[];  {
  319.   int heir9();
  320.   return plunge("== !=", 3, heir9, lval);
  321.   }
  322.  
  323. heir9(lval)  int lval[];  {
  324.   int heir10();
  325.   return plunge("<= >= < >", 5, heir10, lval);
  326.   }
  327.  
  328. heir10(lval)  int lval[];  {
  329.   int heir11();
  330.   return plunge(">> <<", 9, heir11, lval);
  331.   }
  332.  
  333. heir11(lval)  int lval[];  {
  334.   int heir12();
  335.   return plunge("+ -", 11, heir12, lval);
  336.   }
  337.  
  338. heir12(lval)  int lval[];  {
  339.   int heir13();
  340.   return plunge("* / %", 13, heir13, lval);
  341.   }
  342. 
  343. σσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσσ