home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / icont / tcode.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  25KB  |  1,106 lines
  1. /*
  2.  * tcode.c -- translator functions for traversing parse trees and generating
  3.  *  code.
  4.  */
  5.  
  6. #include "::h:gsupport.h"
  7. #include "tproto.h"
  8. #include "tglobals.h"
  9. #include "tree.h"
  10. #include "ttoken.h"
  11. #include "tsym.h"
  12.  
  13. /*
  14.  * Prototypes.
  15.  */
  16.  
  17. hidden int    alclab        Params((int n));
  18. hidden novalue    binop        Params((int op));
  19. hidden novalue    emit        Params((char *s));
  20. hidden novalue    emitl        Params((char *s,int a));
  21. hidden novalue    emitlab        Params((int l));
  22. hidden novalue    emitn        Params((char *s,int a));
  23. hidden novalue    emits        Params((char *s,char *a));
  24. hidden novalue    setloc        Params((nodeptr n));
  25. hidden int    traverse    Params((nodeptr t));
  26. hidden novalue    unopa        Params((int op, nodeptr t));
  27. hidden novalue    unopb        Params((int op));
  28.  
  29. extern int tfatals;
  30. extern int nocode;
  31.  
  32. /*
  33.  * Code generator parameters.
  34.  */
  35.  
  36. #define LoopDepth   20        /* max. depth of nested loops */
  37. #define CaseDepth   10        /* max. depth of nested case statements */
  38. #define CreatDepth  10        /* max. depth of nested create statements */
  39.  
  40. /*
  41.  * loopstk structures hold information about nested loops.
  42.  */
  43. struct loopstk {
  44.    int nextlab;            /* label for next exit */
  45.    int breaklab;        /* label for break exit */
  46.    int markcount;        /* number of marks */
  47.    int ltype;            /* loop type */
  48.    };
  49.  
  50. /*
  51.  * casestk structure hold information about case statements.
  52.  */
  53. struct casestk {
  54.    int endlab;            /* label for exit from case statement */
  55.    nodeptr deftree;        /* pointer to tree for default clause */
  56.    };
  57.  
  58. /*
  59.  * creatstk structures hold information about create statements.
  60.  */
  61. struct creatstk {
  62.    int nextlab;            /* previous value of nextlab */
  63.    int breaklab;        /* previous value of breaklab */
  64.    };
  65. static int nextlab;        /* next label allocated by alclab() */
  66.  
  67. /*
  68.  * codegen - traverse tree t, generating code.
  69.  */
  70.  
  71. novalue codegen(t)
  72. nodeptr t;
  73.    {
  74.    nextlab = 1;
  75.    traverse(t);
  76.    }
  77.  
  78. /*
  79.  * traverse - traverse tree rooted at t and generate code.  This is just
  80.  *  plug and chug code for each of the node types.
  81.  */
  82.  
  83. static int traverse(t)
  84. register nodeptr t;
  85.    {
  86.    register int lab, n, i;
  87.    struct loopstk loopsave;
  88.    static struct loopstk loopstk[LoopDepth];    /* loop stack */
  89.    static struct loopstk *loopsp;
  90.    static struct casestk casestk[CaseDepth];    /* case stack */
  91.    static struct casestk *casesp;
  92.    static struct creatstk creatstk[CreatDepth]; /* create stack */
  93.    static struct creatstk *creatsp;
  94.  
  95.    n = 1;
  96.    switch (TType(t)) {
  97.  
  98.       case N_Activat:            /* co-expression activation */
  99.      if (Val0(Tree0(t)) == AUGAT) {
  100.         emit("pnull");
  101.         }
  102.      traverse(Tree2(t));        /* evaluate result expression */
  103.      if (Val0(Tree0(t)) == AUGAT)
  104.         emit("sdup");
  105.      traverse(Tree1(t));        /* evaluate activate expression */
  106.      setloc(t);
  107.      emit("coact");
  108.      if (Val0(Tree0(t)) == AUGAT)
  109.         emit("asgn");
  110.          free(Tree0(t));
  111.      break;
  112.  
  113.       case N_Alt:            /* alternation */
  114.      lab = alclab(2);
  115.      emitl("mark", lab);
  116.      loopsp->markcount++;
  117.      traverse(Tree0(t));        /* evaluate first alternative */
  118.      loopsp->markcount--;
  119.  
  120. #ifdef EventMon
  121.          setloc(t);
  122. #endif                    /* EventMon */
  123.  
  124.      emit("esusp");                 /*  and suspend with its result */
  125.      emitl("goto", lab+1);
  126.      emitlab(lab);
  127.      traverse(Tree1(t));        /* evaluate second alternative */
  128.      emitlab(lab+1);
  129.      break;
  130.  
  131.       case N_Augop:            /* augmented assignment */
  132.       case N_Binop:            /*  or a binary operator */
  133.      emit("pnull");
  134.      traverse(Tree1(t));
  135.      if (TType(t) == N_Augop)
  136.         emit("dup");
  137.      traverse(Tree2(t));
  138.      setloc(t);
  139.      binop((int)Val0(Tree0(t)));
  140.      free(Tree0(t));
  141.      break;
  142.  
  143.       case N_Bar:            /* repeated alternation */
  144.      lab = alclab(1);
  145.      emitlab(lab);
  146.      emit("mark0");         /* fail if expr fails first time */
  147.      loopsp->markcount++;
  148.      traverse(Tree0(t));        /* evaluate first alternative */
  149.      loopsp->markcount--;
  150.      emitl("chfail", lab);          /* change to loop on failure */
  151.      emit("esusp");                 /* suspend result */
  152.      break;
  153.  
  154.       case N_Break:            /* break expression */
  155.      if (loopsp->breaklab <= 0)
  156.         nfatal(t, "invalid context for break", NULL);
  157.      else {
  158.         for (i = 0; i < loopsp->markcount; i++)
  159.            emit("unmark");
  160.         loopsave = *loopsp--;
  161.         traverse(Tree0(t));
  162.         *++loopsp = loopsave;
  163.         emitl("goto", loopsp->breaklab);
  164.         }
  165.      break;
  166.  
  167.       case N_Case:            /* case expression */
  168.      lab = alclab(1);
  169.      casesp++;
  170.      casesp->endlab = lab;
  171.      casesp->deftree = NULL;
  172.      emit("mark0");
  173.      loopsp->markcount++;
  174.      traverse(Tree0(t));        /* evaluate control expression */
  175.      loopsp->markcount--;
  176.      emit("eret");
  177.      traverse(Tree1(t));        /* do rest of case (CLIST) */
  178.      if (casesp->deftree != NULL) { /* evaluate default clause */
  179.         emit("pop");
  180.         traverse(casesp->deftree);
  181.         }
  182.      else
  183.         emit("efail");
  184.      emitlab(lab);            /* end label */
  185.      casesp--;
  186.      break;
  187.  
  188.       case N_Ccls:            /* case expression clause */
  189.      if (TType(Tree0(t)) == N_Res && /* default clause */
  190.          Val0(Tree0(t)) == DEFAULT) {
  191.         if (casesp->deftree != NULL)
  192.            nfatal(t, "more than one default clause", NULL);
  193.         else
  194.            casesp->deftree = Tree1(t);
  195.             free(Tree0(t));
  196.         }
  197.      else {                /* case clause */
  198.         lab = alclab(1);
  199.         emitl("mark", lab);
  200.         loopsp->markcount++;
  201.         emit("ccase");
  202.         traverse(Tree0(t));        /* evaluate selector */
  203.         setloc(t);
  204.         emit("eqv");
  205.         loopsp->markcount--;
  206.         emit("unmark");
  207.         emit("pop");
  208.         traverse(Tree1(t));        /* evaluate expression */
  209.         emitl("goto", casesp->endlab); /* goto end label */
  210.         emitlab(lab);        /* label for next clause */
  211.         }
  212.      break;
  213.  
  214.       case N_Clist:            /* list of case clauses */
  215.      traverse(Tree0(t));
  216.      traverse(Tree1(t));
  217.      break;
  218.  
  219.       case N_Conj:            /* conjunction */
  220.      if (Val0(Tree0(t)) == AUGAND) {
  221.         emit("pnull");
  222.         }
  223.      traverse(Tree1(t));
  224.      if (Val0(Tree0(t)) != AUGAND)
  225.         emit("pop");
  226.      traverse(Tree2(t));
  227.      if (Val0(Tree0(t)) == AUGAND) {
  228.         setloc(t);
  229.         emit("asgn");
  230.         }
  231.      free(Tree0(t));
  232.      break;
  233.  
  234.       case N_Create:            /* create expression */
  235.      creatsp++;
  236.      creatsp->nextlab = loopsp->nextlab;
  237.      creatsp->breaklab = loopsp->breaklab;
  238.      loopsp->nextlab = 0;        /* make break and next illegal */
  239.      loopsp->breaklab = 0;
  240.      lab = alclab(3);
  241.      emitl("goto", lab+2);          /* skip over code for co-expression */
  242.      emitlab(lab);            /* entry point */
  243.      emit("pop");                   /* pop the result from activation */
  244.      emitl("mark", lab+1);
  245.      loopsp->markcount++;
  246.      traverse(Tree0(t));        /* traverse code for co-expression */
  247.      loopsp->markcount--;
  248.      setloc(t);
  249.      emit("coret");                 /* return to activator */
  250.      emit("efail");                 /* drive co-expression */
  251.      emitlab(lab+1);        /* loop on exhaustion */
  252.      emit("cofail");                /* and fail each time */
  253.      emitl("goto", lab+1);
  254.      emitlab(lab+2);
  255.      emitl("create", lab);          /* create entry block */
  256.      loopsp->nextlab = creatsp->nextlab;   /* legalize break and next */
  257.      loopsp->breaklab = creatsp->breaklab;
  258.      creatsp--;
  259.      break;
  260.  
  261.       case N_Cset:            /* cset literal */
  262.      emitn("cset", (int)Val0(t));
  263.      break;
  264.  
  265.       case N_Elist:            /* expression list */
  266.      n = traverse(Tree0(t));
  267.      n += traverse(Tree1(t));
  268.      break;
  269.  
  270.       case N_Empty:            /* a missing expression */
  271.      emit("pnull");
  272.      break;
  273.  
  274.       case N_Field:            /* field reference */
  275.      emit("pnull");
  276.      traverse(Tree0(t));
  277.      setloc(t);
  278.      emits("field", Str0(Tree1(t)));
  279.      free(Tree1(t));
  280.      break;
  281.  
  282.  
  283.       case N_Id:            /* identifier */
  284.      emitn("var", (int)Val0(t));
  285.      break;
  286.  
  287.       case N_If:            /* if expression */
  288.      if (TType(Tree2(t)) == N_Empty) {
  289.         lab = 0;
  290.         emit("mark0");
  291.         }
  292.      else {
  293.         lab = alclab(2);
  294.         emitl("mark", lab);
  295.         }
  296.      loopsp->markcount++;
  297.      traverse(Tree0(t));
  298.      loopsp->markcount--;
  299.      emit("unmark");
  300.      traverse(Tree1(t));
  301.      if (lab > 0) {
  302.         emitl("goto", lab+1);
  303.         emitlab(lab);
  304.         traverse(Tree2(t));
  305.         emitlab(lab+1);
  306.         }
  307.          else
  308.         free(Tree2(t));
  309.      break;
  310.  
  311.       case N_Int:            /* integer literal */
  312.      emitn("int", (int)Val0(t));
  313.      break;
  314.  
  315.  
  316.       case N_Apply:            /* application */
  317.          traverse(Tree0(t));
  318.          traverse(Tree1(t));
  319.          emitn("invoke", -1);
  320.          break;
  321.  
  322.       case N_Invok:            /* invocation */
  323.      if (TType(Tree0(t)) != N_Empty) {
  324.         traverse(Tree0(t));
  325.          }
  326.      else {
  327.         emit("pushn1");             /* default to -1(e1,...,en) */
  328.         free(Tree0(t));
  329.         }
  330.      if (TType(Tree1(t)) == N_Empty) {
  331.             n = 0;
  332.         free(Tree1(t));
  333.             }
  334.          else
  335.         n = traverse(Tree1(t));
  336.      setloc(t);
  337.      emitn("invoke", n);
  338.      n = 1;
  339.      break;
  340.  
  341.       case N_Key:            /* keyword reference */
  342.      setloc(t);
  343.      emits("keywd", Str0(t));
  344.      break;
  345.  
  346.       case N_Limit:            /* limitation */
  347.      traverse(Tree1(t));
  348.      setloc(t);
  349.      emit("limit");
  350.      loopsp->markcount++;
  351.      traverse(Tree0(t));
  352.      loopsp->markcount--;
  353.      emit("lsusp");
  354.      break;
  355.  
  356.       case N_List:            /* list construction */
  357.      emit("pnull");
  358.      if (TType(Tree0(t)) == N_Empty) {
  359.         n = 0;
  360.         free(Tree0(t));
  361.             }
  362.      else
  363.         n = traverse(Tree0(t));
  364.      setloc(t);
  365.      emitn("llist", n);
  366.      n = 1;
  367.      break;
  368.  
  369.       case N_Loop:            /* loop */
  370.      switch ((int)Val0(Tree0(t))) {
  371.         case EVERY:
  372.            lab = alclab(2);
  373.            loopsp++;
  374.            loopsp->ltype = EVERY;
  375.            loopsp->nextlab = lab;
  376.            loopsp->breaklab = lab + 1;
  377.            loopsp->markcount = 1;
  378.            emit("mark0");
  379.            traverse(Tree1(t));
  380.            emit("pop");
  381.            if (TType(Tree2(t)) != N_Empty) {   /* every e1 do e2 */
  382.           emit("mark0");
  383.           loopsp->ltype = N_Loop;
  384.           loopsp->markcount++;
  385.           traverse(Tree2(t));
  386.           loopsp->markcount--;
  387.           emit("unmark");
  388.           }
  389.                else
  390.           free(Tree2(t));
  391.            emitlab(loopsp->nextlab);
  392.            emit("efail");
  393.            emitlab(loopsp->breaklab);
  394.            loopsp--;
  395.            break;
  396.  
  397.         case REPEAT:
  398.            lab = alclab(3);
  399.            loopsp++;
  400.            loopsp->ltype = N_Loop;
  401.            loopsp->nextlab = lab + 1;
  402.            loopsp->breaklab = lab + 2;
  403.            loopsp->markcount = 1;
  404.            emitlab(lab);
  405.            emitl("mark", lab);
  406.            traverse(Tree1(t));
  407.            emitlab(loopsp->nextlab);
  408.            emit("unmark");
  409.            emitl("goto", lab);
  410.            emitlab(loopsp->breaklab);
  411.            loopsp--;
  412.                free(Tree2(t));
  413.            break;
  414.  
  415.         case SUSPEND:            /* suspension expression */
  416.            if (creatsp > creatstk)
  417.           nfatal(t, "invalid context for suspend", NULL);
  418.            lab = alclab(2);
  419.            loopsp++;
  420.            loopsp->ltype = EVERY;        /* like every ... do for next */
  421.            loopsp->nextlab = lab;
  422.            loopsp->breaklab = lab + 1;
  423.            loopsp->markcount = 1;
  424.            emit("mark0");
  425.            traverse(Tree1(t));
  426.            setloc(t);
  427.            emit("psusp");
  428.            emit("pop");
  429.            if (TType(Tree2(t)) != N_Empty) { /* suspend e1 do e2 */
  430.           emit("mark0");
  431.           loopsp->ltype = N_Loop;
  432.           loopsp->markcount++;
  433.           traverse(Tree2(t));
  434.           loopsp->markcount--;
  435.           emit("unmark");
  436.           }
  437.                else
  438.           free(Tree2(t));
  439.            emitlab(loopsp->nextlab);
  440.            emit("efail");
  441.            emitlab(loopsp->breaklab);
  442.            loopsp--;
  443.            break;
  444.  
  445.         case WHILE:
  446.            lab = alclab(3);
  447.            loopsp++;
  448.            loopsp->ltype = N_Loop;
  449.            loopsp->nextlab = lab + 1;
  450.            loopsp->breaklab = lab + 2;
  451.            loopsp->markcount = 1;
  452.            emitlab(lab);
  453.            emit("mark0");
  454.            traverse(Tree1(t));
  455.            if (TType(Tree2(t)) != N_Empty) {
  456.           emit("unmark");
  457.           emitl("mark", lab);
  458.           traverse(Tree2(t));
  459.           }
  460.                else
  461.           free(Tree2(t));
  462.            emitlab(loopsp->nextlab);
  463.            emit("unmark");
  464.            emitl("goto", lab);
  465.            emitlab(loopsp->breaklab);
  466.            loopsp--;
  467.            break;
  468.  
  469.         case UNTIL:
  470.            lab = alclab(4);
  471.            loopsp++;
  472.            loopsp->ltype = N_Loop;
  473.            loopsp->nextlab = lab + 2;
  474.            loopsp->breaklab = lab + 3;
  475.            loopsp->markcount = 1;
  476.            emitlab(lab);
  477.            emitl("mark", lab+1);
  478.            traverse(Tree1(t));
  479.            emit("unmark");
  480.            emit("efail");
  481.            emitlab(lab+1);
  482.            emitl("mark", lab);
  483.            traverse(Tree2(t));
  484.            emitlab(loopsp->nextlab);
  485.            emit("unmark");
  486.            emitl("goto", lab);
  487.            emitlab(loopsp->breaklab);
  488.            loopsp--;
  489.            break;
  490.         }
  491.      free(Tree0(t));
  492.      break;
  493.  
  494.       case N_Next:            /* next expression */
  495.      if (loopsp < loopstk || loopsp->nextlab <= 0)
  496.         nfatal(t, "invalid context for next", NULL);
  497.      else {
  498.         if (loopsp->ltype != EVERY && loopsp->markcount > 1)
  499.            for (i = 0; i < loopsp->markcount - 1; i++)
  500.           emit("unmark");
  501.         emitl("goto", loopsp->nextlab);
  502.         }
  503.      break;
  504.  
  505.       case N_Not:            /* not expression */
  506.      lab = alclab(1);
  507.      emitl("mark", lab);
  508.      loopsp->markcount++;
  509.      traverse(Tree0(t));
  510.      loopsp->markcount--;
  511.      emit("unmark");
  512.      emit("efail");
  513.      emitlab(lab);
  514.      emit("pnull");
  515.      break;
  516.  
  517.       case N_Proc:            /* procedure */
  518.      loopsp = loopstk;
  519.      loopsp->nextlab = 0;
  520.      loopsp->breaklab = 0;
  521.      loopsp->markcount = 0;
  522.      casesp = casestk;
  523.      creatsp = creatstk;
  524.  
  525.  
  526.      writecheck(fprintf(codefile, "proc %s\n", Str0(Tree0(t))));
  527.      lout(codefile);
  528.      constout(codefile);
  529.  
  530.      emit("declend");
  531.      setloc(t);
  532.      if (TType(Tree1(t)) != N_Empty) {
  533.         lab = alclab(1);
  534.         emitl("init", lab);
  535.         emitl("mark", lab);
  536.         traverse(Tree1(t));
  537.         emit("unmark");
  538.         emitlab(lab);
  539.         }
  540.          else
  541.         free(Tree1(t));
  542.      if (TType(Tree2(t)) != N_Empty)
  543.         traverse(Tree2(t));
  544.          else
  545.         free(Tree2(t));
  546.      setloc(Tree3(t));
  547.      emit("pfail");
  548.      emit("end");
  549.      if (!silent)
  550.         fprintf(stderr, "  %s\n", Str0(Tree0(t)));
  551.      free(Tree0(t));
  552.      free(Tree3(t));
  553.      break;
  554.  
  555.       case N_Real:            /* real literal */
  556.      emitn("real", (int)Val0(t));
  557.      break;
  558.  
  559.       case N_Ret:            /* return expression */
  560.      if (creatsp > creatstk)
  561.         nfatal(t, "invalid context for return or fail", NULL);
  562.      if (Val0(Tree0(t)) == FAIL)
  563.         free(Tree1(t));
  564.          else {
  565.         lab = alclab(1);
  566.         emitl("mark", lab);
  567.         loopsp->markcount++;
  568.         traverse(Tree1(t));
  569.         loopsp->markcount--;
  570.         setloc(t);
  571.         emit("pret");
  572.         emitlab(lab);
  573.         }
  574.      setloc(t);
  575.      emit("pfail");
  576.          free(Tree0(t));
  577.      break;
  578.  
  579.       case N_Scan:            /* scanning expression */
  580.      if (Val0(Tree0(t)) == AUGQMARK)
  581.         emit("pnull");
  582.      traverse(Tree1(t));
  583.      if (Val0(Tree0(t)) == AUGQMARK)
  584.         emit("sdup");
  585.      setloc(t);
  586.      emit("bscan");
  587.      traverse(Tree2(t));
  588.      setloc(t);
  589.      emit("escan");
  590.      if (Val0(Tree0(t)) == AUGQMARK)
  591.         emit("asgn");
  592.      free(Tree0(t));
  593.      break;
  594.  
  595.       case N_Sect:            /* section operation */
  596.      emit("pnull");
  597.      traverse(Tree1(t));
  598.      traverse(Tree2(t));
  599.      if (Val0(Tree0(t)) == PCOLON || Val0(Tree0(t)) == MCOLON)
  600.         emit("dup");
  601.      traverse(Tree3(t));
  602.      setloc(Tree0(t));
  603.      if (Val0(Tree0(t)) == PCOLON)
  604.         emit("plus");
  605.      else if (Val0(Tree0(t)) == MCOLON)
  606.         emit("minus");
  607.      setloc(t);
  608.      emit("sect");
  609.      free(Tree0(t));
  610.      break;
  611.  
  612.       case N_Slist:            /* semicolon-separated expr list */
  613.      lab = alclab(1);
  614.      emitl("mark", lab);
  615.      loopsp->markcount++;
  616.      traverse(Tree0(t));
  617.      loopsp->markcount--;
  618.      emit("unmark");
  619.      emitlab(lab);
  620.      traverse(Tree1(t));
  621.      break;
  622.  
  623.       case N_Str:            /* string literal */
  624.      emitn("str", (int)Val0(t));
  625.      break;
  626.  
  627.       case N_To:            /* to expression */
  628.      emit("pnull");
  629.      traverse(Tree0(t));
  630.      traverse(Tree1(t));
  631.      emit("push1");
  632.      setloc(t);
  633.      emit("toby");
  634.      break;
  635.  
  636.       case N_ToBy:            /* to-by expression */
  637.      emit("pnull");
  638.      traverse(Tree0(t));
  639.      traverse(Tree1(t));
  640.      traverse(Tree2(t));
  641.      setloc(t);
  642.      emit("toby");
  643.      break;
  644.  
  645.       case N_Unop:            /* unary operator */
  646.      unopa((int)Val0(Tree0(t)),t);
  647.      traverse(Tree1(t));
  648.      setloc(t);
  649.      unopb((int)Val0(Tree0(t)));
  650.      free(Tree0(t));
  651.      break;
  652.  
  653.       default:
  654.      emitn("?????", TType(t));
  655.      tsyserr("traverse: undefined node type");
  656.       }
  657.    free(t);
  658.    return n;
  659.    }
  660.  
  661. /*
  662.  * binop emits code for binary operators.  For non-augmented operators,
  663.  *  the name of operator is emitted.  For augmented operators, an "asgn"
  664.  *  is emitted after the name of the operator.
  665.  */
  666. static novalue binop(op)
  667. int op;
  668.    {
  669.    register int asgn;
  670.    register char *name;
  671.  
  672.    asgn = 0;
  673.    switch (op) {
  674.  
  675.       case ASSIGN:
  676.      name = "asgn";
  677.      break;
  678.  
  679.       case AUGCARET:
  680.      asgn++;
  681.       case CARET:
  682.      name = "power";
  683.      break;
  684.  
  685.       case AUGCONCAT:
  686.      asgn++;
  687.       case CONCAT:
  688.      name = "cat";
  689.      break;
  690.  
  691.       case AUGDIFF:
  692.      asgn++;
  693.       case DIFF:
  694.      name = "diff";
  695.      break;
  696.  
  697.       case AUGEQUIV:
  698.      asgn++;
  699.       case EQUIV:
  700.      name = "eqv";
  701.      break;
  702.  
  703.       case AUGINTER:
  704.      asgn++;
  705.       case INTER:
  706.      name = "inter";
  707.      break;
  708.  
  709.       case LBRACK:
  710.      name = "subsc";
  711.      break;
  712.  
  713.       case AUGLCONCAT:
  714.      asgn++;
  715.       case LCONCAT:
  716.      name = "lconcat";
  717.      break;
  718.  
  719.       case AUGSEQ:
  720.      asgn++;
  721.       case SEQ:
  722.      name = "lexeq";
  723.      break;
  724.  
  725.       case AUGSGE:
  726.      asgn++;
  727.       case SGE:
  728.      name = "lexge";
  729.      break;
  730.  
  731.       case AUGSGT:
  732.      asgn++;
  733.       case SGT:
  734.      name = "lexgt";
  735.      break;
  736.  
  737.       case AUGSLE:
  738.      asgn++;
  739.       case SLE:
  740.      name = "lexle";
  741.      break;
  742.  
  743.       case AUGSLT:
  744.      asgn++;
  745.       case SLT:
  746.      name = "lexlt";
  747.      break;
  748.  
  749.       case AUGSNE:
  750.      asgn++;
  751.       case SNE:
  752.      name = "lexne";
  753.      break;
  754.  
  755.       case AUGMINUS:
  756.      asgn++;
  757.       case MINUS:
  758.      name = "minus";
  759.      break;
  760.  
  761.       case AUGMOD:
  762.      asgn++;
  763.       case MOD:
  764.      name = "mod";
  765.      break;
  766.  
  767.       case AUGNEQUIV:
  768.      asgn++;
  769.       case NEQUIV:
  770.      name = "neqv";
  771.      break;
  772.  
  773.       case AUGNMEQ:
  774.      asgn++;
  775.       case NMEQ:
  776.      name = "numeq";
  777.      break;
  778.  
  779.       case AUGNMGE:
  780.      asgn++;
  781.       case NMGE:
  782.      name = "numge";
  783.      break;
  784.  
  785.       case AUGNMGT:
  786.      asgn++;
  787.       case NMGT:
  788.      name = "numgt";
  789.      break;
  790.  
  791.       case AUGNMLE:
  792.      asgn++;
  793.       case NMLE:
  794.      name = "numle";
  795.      break;
  796.  
  797.       case AUGNMLT:
  798.      asgn++;
  799.       case NMLT:
  800.      name = "numlt";
  801.      break;
  802.  
  803.       case AUGNMNE:
  804.      asgn++;
  805.       case NMNE:
  806.      name = "numne";
  807.      break;
  808.  
  809.       case AUGPLUS:
  810.      asgn++;
  811.       case PLUS:
  812.      name = "plus";
  813.      break;
  814.  
  815.       case REVASSIGN:
  816.      name = "rasgn";
  817.      break;
  818.  
  819.       case REVSWAP:
  820.      name = "rswap";
  821.      break;
  822.  
  823.       case AUGSLASH:
  824.      asgn++;
  825.       case SLASH:
  826.      name = "div";
  827.      break;
  828.  
  829.       case AUGSTAR:
  830.      asgn++;
  831.       case STAR:
  832.      name = "mult";
  833.      break;
  834.  
  835.       case SWAP:
  836.      name = "swap";
  837.      break;
  838.  
  839.       case AUGUNION:
  840.      asgn++;
  841.       case UNION:
  842.      name = "unions";
  843.      break;
  844.  
  845.       default:
  846.      emitn("?binop", op);
  847.      tsyserr("binop: undefined binary operator");
  848.       }
  849.    emit(name);
  850.    if (asgn)
  851.       emit("asgn");
  852.  
  853.    }
  854. /*
  855.  * unopa and unopb handle code emission for unary operators. unary operator
  856.  *  sequences that are the same as binary operator sequences are recognized
  857.  *  by the lexical analyzer as binary operators.  For example, ~===x means to
  858.  *  do three tab(match(...)) operations and then a cset complement, but the
  859.  *  lexical analyzer sees the operator sequence as the "neqv" binary
  860.  *  operation.    unopa and unopb unravel tokens of this form.
  861.  *
  862.  * When a N_Unop node is encountered, unopa is called to emit the necessary
  863.  *  number of "pnull" operations to receive the intermediate results.  This
  864.  *  amounts to a pnull for each operation.
  865.  */
  866. static novalue unopa(op,t)
  867. int op;
  868. nodeptr t;
  869.    {
  870.    switch (op) {
  871.       case NEQUIV:        /* unary ~ and three = operators */
  872.      emit("pnull");
  873.       case SNE:        /* unary ~ and two = operators */
  874.       case EQUIV:        /* three unary = operators */
  875.      emit("pnull");
  876.       case NMNE:        /* unary ~ and = operators */
  877.       case UNION:        /* two unary + operators */
  878.       case DIFF:        /* two unary - operators */
  879.       case SEQ:        /* two unary = operators */
  880.       case INTER:        /* two unary * operators */
  881.      emit("pnull");
  882.       case BACKSLASH:        /* unary \ operator */
  883.       case BANG:        /* unary ! operator */
  884.       case CARET:        /* unary ^ operator */
  885.       case PLUS:        /* unary + operator */
  886.       case TILDE:        /* unary ~ operator */
  887.       case MINUS:        /* unary - operator */
  888.       case NMEQ:        /* unary = operator */
  889.       case STAR:        /* unary * operator */
  890.       case QMARK:        /* unary ? operator */
  891.       case SLASH:        /* unary / operator */
  892.       case DOT:            /* unary . operator */
  893.          emit("pnull");
  894.          break;
  895.       default:
  896.      tsyserr("unopa: undefined unary operator");
  897.       }
  898.    }
  899.  
  900. /*
  901.  * unopb is the back-end code emitter for unary operators.  It emits
  902.  *  the operations represented by the token op.  For tokens representing
  903.  *  a single operator, the name of the operator is emitted.  For tokens
  904.  *  representing a sequence of operators, recursive calls are used.  In
  905.  *  such a case, the operator sequence is "scanned" from right to left
  906.  *  and unopb is called with the token for the appropriate operation.
  907.  *
  908.  * For example, consider the sequence of calls and code emission for "~===":
  909.  *    unopb(NEQUIV)        ~===
  910.  *        unopb(NMEQ)    =
  911.  *        emits "tabmat"
  912.  *        unopb(NMEQ)    =
  913.  *        emits "tabmat"
  914.  *        unopb(NMEQ)    =
  915.  *        emits "tabmat"
  916.  *        emits "compl"
  917.  */
  918. static novalue unopb(op)
  919. int op;
  920.    {
  921.    register char *name;
  922.  
  923.    switch (op) {
  924.  
  925.       case DOT:            /* unary . operator */
  926.      name = "value";
  927.      break;
  928.  
  929.       case BACKSLASH:        /* unary \ operator */
  930.      name = "nonnull";
  931.      break;
  932.  
  933.       case BANG:        /* unary ! operator */
  934.      name = "bang";
  935.      break;
  936.  
  937.       case CARET:        /* unary ^ operator */
  938.      name = "refresh";
  939.      break;
  940.  
  941.       case UNION:        /* two unary + operators */
  942.      unopb(PLUS);
  943.       case PLUS:        /* unary + operator */
  944.      name = "number";
  945.      break;
  946.  
  947.       case NEQUIV:        /* unary ~ and three = operators */
  948.      unopb(NMEQ);
  949.       case SNE:        /* unary ~ and two = operators */
  950.      unopb(NMEQ);
  951.       case NMNE:        /* unary ~ and = operators */
  952.      unopb(NMEQ);
  953.       case TILDE:        /* unary ~ operator (cset compl) */
  954.      name = "compl";
  955.      break;
  956.  
  957.       case DIFF:        /* two unary - operators */
  958.      unopb(MINUS);
  959.       case MINUS:        /* unary - operator */
  960.      name = "neg";
  961.      break;
  962.  
  963.       case EQUIV:        /* three unary = operators */
  964.      unopb(NMEQ);
  965.       case SEQ:        /* two unary = operators */
  966.      unopb(NMEQ);
  967.       case NMEQ:        /* unary = operator */
  968.      name = "tabmat";
  969.      break;
  970.  
  971.       case INTER:        /* two unary * operators */
  972.      unopb(STAR);
  973.       case STAR:        /* unary * operator */
  974.      name = "size";
  975.      break;
  976.  
  977.       case QMARK:        /* unary ? operator */
  978.      name = "random";
  979.      break;
  980.  
  981.       case SLASH:        /* unary / operator */
  982.      name = "null";
  983.      break;
  984.  
  985.       default:
  986.      emitn("?unop", op);
  987.      tsyserr("unopb: undefined unary operator");
  988.       }
  989.    emit(name);
  990.    }
  991.  
  992. /*
  993.  * setloc emits "filen" and "line" directives for the source location of
  994.  *  node n.  A directive is only emitted if the corresponding value
  995.  *  has changed since the last time setloc was called.  Note:  File(n)
  996.  *  reportedly occasionally points at uninitialized data, producing
  997.  *  bogus results (as well as reams of filen commands).
  998.  */
  999. static char *lastfiln = NULL;
  1000. static int lastline = 0;
  1001.  
  1002. static novalue setloc(n)
  1003. nodeptr n;
  1004.    {
  1005.    if ((n != NULL) &&
  1006.       (TType(n) != N_Empty) &&
  1007.       (File(n) != NULL) &&
  1008.       (lastfiln == NULL || strcmp(File(n), lastfiln) != 0)) {
  1009.          lastfiln = File(n);
  1010.          emits("filen", lastfiln);
  1011.          }
  1012.  
  1013. #ifdef SrcColumnInfo
  1014.    /*
  1015.     * if either line or column has changed, emit location information
  1016.     */
  1017.    if (((Col(n) << 16) + Line(n)) != lastline) {
  1018.       lastline = (Col(n) << 16) + Line(n);
  1019.       emitn("line",Line(n));
  1020.       emitn("colm",Col(n));
  1021.       }
  1022. #else                    /* SrcColumnInfo */
  1023.    /*
  1024.     * if line has changed, emit line information
  1025.     */
  1026.    if (Line(n) != lastline) {
  1027.       lastline = Line(n);
  1028.       emitn("line", lastline);
  1029.       }
  1030. #endif                    /* SrcColumnInfo */
  1031.  
  1032.  
  1033.    }
  1034.  
  1035. #ifdef MultipleRuns
  1036. /*
  1037.  * Reinitialize last file name and line number for repeated runs.
  1038.  */
  1039. novalue tcodeinit()
  1040.    {
  1041.    lastfiln = NULL;
  1042.  
  1043. #ifdef EventMon
  1044.    lastcol = 0;
  1045. #endif                    /* EventMon */
  1046.  
  1047.    }
  1048. #endif                    /* Multiple Runs */
  1049.  
  1050. /*
  1051.  * The emit* routines output ucode to codefile.  The various routines are:
  1052.  *
  1053.  *  emitlab(l) - emit "lab" instruction for label l.
  1054.  *  emit(s) - emit instruction s.
  1055.  *  emitl(s,a) - emit instruction s with reference to label a.
  1056.  *  emitn(s,n) - emit instruction s with numeric argument a.
  1057.  *  emits(s,a) - emit instruction s with string argument a.
  1058.  */
  1059. static novalue emitlab(l)
  1060. int l;
  1061.    {
  1062.    writecheck(fprintf(codefile, "lab L%d\n", l));
  1063.    }
  1064.  
  1065. static novalue emit(s)
  1066. char *s;
  1067.    {
  1068.    writecheck(fprintf(codefile, "\t%s\n", s));
  1069.    }
  1070.  
  1071. static novalue emitl(s, a)
  1072. char *s;
  1073. int a;
  1074.    {
  1075.    writecheck(fprintf(codefile, "\t%s\tL%d\n", s, a));
  1076.    }
  1077.  
  1078. static novalue emitn(s, a)
  1079. char *s;
  1080. int a;
  1081.    {
  1082.    writecheck(fprintf(codefile, "\t%s\t%d\n", s, a));
  1083.    }
  1084.  
  1085.  
  1086. static novalue emits(s, a)
  1087. char *s, *a;
  1088.    {
  1089.    writecheck(fprintf(codefile, "\t%s\t%s\n", s, a));
  1090.    }
  1091.  
  1092. /*
  1093.  * alclab allocates n labels and returns the first.  For the interpreter,
  1094.  *  labels are restarted at 1 for each procedure, while in the compiler,
  1095.  *  they start at 1 and increase throughout the entire compilation.
  1096.  */
  1097. static int alclab(n)
  1098. int n;
  1099.    {
  1100.    register int lab;
  1101.  
  1102.    lab = nextlab;
  1103.    nextlab += n;
  1104.    return lab;
  1105.    }
  1106.