home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / icont / tcode.c < prev    next >
C/C++ Source or Header  |  2002-03-27  |  25KB  |  1,115 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. static int    alclab        (int n);
  18. static void    binop        (int op);
  19. static void    emit        (char *s);
  20. static void    emitl        (char *s,int a);
  21. static void    emitlab        (int l);
  22. static void    emitn        (char *s,int a);
  23. static void    emits        (char *s,char *a);
  24. static void    emitfile    (nodeptr n);
  25. static void    emitline    (nodeptr n);
  26. static void    setloc        (nodeptr n);
  27. static int    traverse    (nodeptr t);
  28. static void    unopa        (int op, nodeptr t);
  29. static void    unopb        (int op);
  30.  
  31. extern int tfatals;
  32. extern int nocode;
  33.  
  34. /*
  35.  * Code generator parameters.
  36.  */
  37.  
  38. #define LoopDepth   20        /* max. depth of nested loops */
  39. #define CaseDepth   10        /* max. depth of nested case statements */
  40. #define CreatDepth  10        /* max. depth of nested create statements */
  41.  
  42. /*
  43.  * loopstk structures hold information about nested loops.
  44.  */
  45. struct loopstk {
  46.    int nextlab;            /* label for next exit */
  47.    int breaklab;        /* label for break exit */
  48.    int markcount;        /* number of marks */
  49.    int ltype;            /* loop type */
  50.    };
  51.  
  52. /*
  53.  * casestk structure hold information about case statements.
  54.  */
  55. struct casestk {
  56.    int endlab;            /* label for exit from case statement */
  57.    nodeptr deftree;        /* pointer to tree for default clause */
  58.    };
  59.  
  60. /*
  61.  * creatstk structures hold information about create statements.
  62.  */
  63. struct creatstk {
  64.    int nextlab;            /* previous value of nextlab */
  65.    int breaklab;        /* previous value of breaklab */
  66.    };
  67. static int nextlab;        /* next label allocated by alclab() */
  68.  
  69. /*
  70.  * codegen - traverse tree t, generating code.
  71.  */
  72.  
  73. void codegen(t)
  74. nodeptr t;
  75.    {
  76.    nextlab = 1;
  77.    traverse(t);
  78.    }
  79.  
  80. /*
  81.  * traverse - traverse tree rooted at t and generate code.  This is just
  82.  *  plug and chug code for each of the node types.
  83.  */
  84.  
  85. static int traverse(t)
  86. register nodeptr t;
  87.    {
  88.    register int lab, n, i;
  89.    struct loopstk loopsave;
  90.    static struct loopstk loopstk[LoopDepth];    /* loop stack */
  91.    static struct loopstk *loopsp;
  92.    static struct casestk casestk[CaseDepth];    /* case stack */
  93.    static struct casestk *casesp;
  94.    static struct creatstk creatstk[CreatDepth]; /* create stack */
  95.    static struct creatstk *creatsp;
  96.  
  97.    n = 1;
  98.    switch (TType(t)) {
  99.  
  100.       case N_Activat:            /* co-expression activation */
  101.      if (Val0(Tree0(t)) == AUGAT) {
  102.         emit("pnull");
  103.         }
  104.      traverse(Tree2(t));        /* evaluate result expression */
  105.      if (Val0(Tree0(t)) == AUGAT)
  106.         emit("sdup");
  107.      traverse(Tree1(t));        /* evaluate activate expression */
  108.      setloc(t);
  109.      emit("coact");
  110.      if (Val0(Tree0(t)) == AUGAT)
  111.         emit("asgn");
  112.          free(Tree0(t));
  113.      break;
  114.  
  115.       case N_Alt:            /* alternation */
  116.      lab = alclab(2);
  117.      emitl("mark", lab);
  118.      loopsp->markcount++;
  119.      traverse(Tree0(t));        /* evaluate first alternative */
  120.      loopsp->markcount--;
  121.  
  122. #ifdef EventMon
  123.          setloc(t);
  124. #endif                    /* EventMon */
  125.  
  126.      emit("esusp");                 /*  and suspend with its result */
  127.      emitl("goto", lab+1);
  128.      emitlab(lab);
  129.      traverse(Tree1(t));        /* evaluate second alternative */
  130.      emitlab(lab+1);
  131.      break;
  132.  
  133.       case N_Augop:            /* augmented assignment */
  134.       case N_Binop:            /*  or a binary operator */
  135.      emit("pnull");
  136.      traverse(Tree1(t));
  137.      if (TType(t) == N_Augop)
  138.         emit("dup");
  139.      traverse(Tree2(t));
  140.      setloc(t);
  141.      binop((int)Val0(Tree0(t)));
  142.      free(Tree0(t));
  143.      break;
  144.  
  145.       case N_Bar:            /* repeated alternation */
  146.      lab = alclab(1);
  147.      emitlab(lab);
  148.      emit("mark0");         /* fail if expr fails first time */
  149.      loopsp->markcount++;
  150.      traverse(Tree0(t));        /* evaluate first alternative */
  151.      loopsp->markcount--;
  152.      emitl("chfail", lab);          /* change to loop on failure */
  153.      emit("esusp");                 /* suspend result */
  154.      break;
  155.  
  156.       case N_Break:            /* break expression */
  157.      if (loopsp->breaklab <= 0)
  158.         nfatal(t, "invalid context for break", NULL);
  159.      else {
  160.         for (i = 0; i < loopsp->markcount; i++)
  161.            emit("unmark");
  162.         loopsave = *loopsp--;
  163.         traverse(Tree0(t));
  164.         *++loopsp = loopsave;
  165.         emitl("goto", loopsp->breaklab);
  166.         }
  167.      break;
  168.  
  169.       case N_Case:            /* case expression */
  170.      lab = alclab(1);
  171.      casesp++;
  172.      casesp->endlab = lab;
  173.      casesp->deftree = NULL;
  174.      emit("mark0");
  175.      loopsp->markcount++;
  176.      traverse(Tree0(t));        /* evaluate control expression */
  177.      loopsp->markcount--;
  178.      emit("eret");
  179.      traverse(Tree1(t));        /* do rest of case (CLIST) */
  180.      if (casesp->deftree != NULL) { /* evaluate default clause */
  181.         emit("pop");
  182.         traverse(casesp->deftree);
  183.         }
  184.      else
  185.         emit("efail");
  186.      emitlab(lab);            /* end label */
  187.      casesp--;
  188.      break;
  189.  
  190.       case N_Ccls:            /* case expression clause */
  191.      if (TType(Tree0(t)) == N_Res && /* default clause */
  192.          Val0(Tree0(t)) == DEFAULT) {
  193.         if (casesp->deftree != NULL)
  194.            nfatal(t, "more than one default clause", NULL);
  195.         else
  196.            casesp->deftree = Tree1(t);
  197.             free(Tree0(t));
  198.         }
  199.      else {                /* case clause */
  200.         lab = alclab(1);
  201.         emitl("mark", lab);
  202.         loopsp->markcount++;
  203.         emit("ccase");
  204.         traverse(Tree0(t));        /* evaluate selector */
  205.         setloc(t);
  206.         emit("eqv");
  207.         loopsp->markcount--;
  208.         emit("unmark");
  209.         emit("pop");
  210.         traverse(Tree1(t));        /* evaluate expression */
  211.         emitl("goto", casesp->endlab); /* goto end label */
  212.         emitlab(lab);        /* label for next clause */
  213.         }
  214.      break;
  215.  
  216.       case N_Clist:            /* list of case clauses */
  217.      traverse(Tree0(t));
  218.      traverse(Tree1(t));
  219.      break;
  220.  
  221.       case N_Conj:            /* conjunction */
  222.      if (Val0(Tree0(t)) == AUGAND) {
  223.         emit("pnull");
  224.         }
  225.      traverse(Tree1(t));
  226.      if (Val0(Tree0(t)) != AUGAND)
  227.         emit("pop");
  228.      traverse(Tree2(t));
  229.      if (Val0(Tree0(t)) == AUGAND) {
  230.         setloc(t);
  231.         emit("asgn");
  232.         }
  233.      free(Tree0(t));
  234.      break;
  235.  
  236.       case N_Create:            /* create expression */
  237.      creatsp++;
  238.      creatsp->nextlab = loopsp->nextlab;
  239.      creatsp->breaklab = loopsp->breaklab;
  240.      loopsp->nextlab = 0;        /* make break and next illegal */
  241.      loopsp->breaklab = 0;
  242.      lab = alclab(3);
  243.      emitl("goto", lab+2);          /* skip over code for co-expression */
  244.      emitlab(lab);            /* entry point */
  245.      emit("pop");                   /* pop the result from activation */
  246.      emitl("mark", lab+1);
  247.      loopsp->markcount++;
  248.      traverse(Tree0(t));        /* traverse code for co-expression */
  249.      loopsp->markcount--;
  250.      setloc(t);
  251.      emit("coret");                 /* return to activator */
  252.      emit("efail");                 /* drive co-expression */
  253.      emitlab(lab+1);        /* loop on exhaustion */
  254.      emit("cofail");                /* and fail each time */
  255.      emitl("goto", lab+1);
  256.      emitlab(lab+2);
  257.      emitl("create", lab);          /* create entry block */
  258.      loopsp->nextlab = creatsp->nextlab;   /* legalize break and next */
  259.      loopsp->breaklab = creatsp->breaklab;
  260.      creatsp--;
  261.      break;
  262.  
  263.       case N_Cset:            /* cset literal */
  264.      emitn("cset", (int)Val0(t));
  265.      break;
  266.  
  267.       case N_Elist:            /* expression list */
  268.      n = traverse(Tree0(t));
  269.      n += traverse(Tree1(t));
  270.      break;
  271.  
  272.       case N_Empty:            /* a missing expression */
  273.      emit("pnull");
  274.      break;
  275.  
  276.       case N_Field:            /* field reference */
  277.      emit("pnull");
  278.      traverse(Tree0(t));
  279.      setloc(t);
  280.      emits("field", Str0(Tree1(t)));
  281.      free(Tree1(t));
  282.      break;
  283.  
  284.       case N_Id:            /* identifier */
  285.      emitn("var", (int)Val0(t));
  286.      break;
  287.  
  288.       case N_If:            /* if expression */
  289.      if (TType(Tree2(t)) == N_Empty) {
  290.         lab = 0;
  291.         emit("mark0");
  292.         }
  293.      else {
  294.         lab = alclab(2);
  295.         emitl("mark", lab);
  296.         }
  297.      loopsp->markcount++;
  298.      traverse(Tree0(t));
  299.      loopsp->markcount--;
  300.      emit("unmark");
  301.      traverse(Tree1(t));
  302.      if (lab > 0) {
  303.         emitl("goto", lab+1);
  304.         emitlab(lab);
  305.         traverse(Tree2(t));
  306.         emitlab(lab+1);
  307.         }
  308.          else
  309.         free(Tree2(t));
  310.      break;
  311.  
  312.       case N_Int:            /* integer literal */
  313.      emitn("int", (int)Val0(t));
  314.      break;
  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.      writecheck(fprintf(codefile, "proc %s\n", Str0(Tree0(t))));
  526.      emitfile(t);
  527.      lout(codefile);
  528.      constout(codefile);
  529.      emit("declend");
  530.      emitline(t);
  531.  
  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 void 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 void 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 void 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.  * emitfile(n) emits "filen" directives for node n's source location.
  994.  * emitline(n) emits "line" and possibly "colm" directives.
  995.  * setloc(n) does both.
  996.  *  A directive is only emitted if the corresponding value
  997.  *  has changed since the previous call.
  998.  *
  999.  */
  1000. static char *lastfiln = NULL;
  1001. static int lastlin = 0;
  1002.  
  1003. static void setloc(n)
  1004. nodeptr n;
  1005.    {
  1006.    emitfile(n);
  1007.    emitline(n);
  1008.    }
  1009.  
  1010. static void emitfile(n)
  1011. nodeptr n;
  1012.    {
  1013.    if ((n != NULL) &&
  1014.       (TType(n) != N_Empty) &&
  1015.       (File(n) != NULL) &&
  1016.       (lastfiln == NULL || strcmp(File(n), lastfiln) != 0)) {
  1017.          lastfiln = File(n);
  1018.          emits("filen", lastfiln);
  1019.          }
  1020.    }
  1021.  
  1022. static void emitline(n)
  1023. nodeptr n;
  1024.    {
  1025. #ifdef SrcColumnInfo
  1026.    /*
  1027.     * if either line or column has changed, emit location information
  1028.     */
  1029.    if (((Col(n) << 16) + Line(n)) != lastlin) {
  1030.       lastlin = (Col(n) << 16) + Line(n);
  1031.       emitn("line",Line(n));
  1032.       emitn("colm",Col(n));
  1033.       }
  1034. #else                    /* SrcColumnInfo */
  1035.    /*
  1036.     * if line has changed, emit line information
  1037.     */
  1038.    if (Line(n) != lastlin) {
  1039.       lastlin = Line(n);
  1040.       emitn("line", lastlin);
  1041.       }
  1042. #endif                    /* SrcColumnInfo */
  1043.    }
  1044.  
  1045. #ifdef MultipleRuns
  1046. /*
  1047.  * Reinitialize last file name and line number for repeated runs.
  1048.  */
  1049. void tcodeinit()
  1050.    {
  1051.    lastfiln = NULL;
  1052.  
  1053.    #ifdef EventMon
  1054.       lastcol = 0;
  1055.    #endif                /* EventMon */
  1056.  
  1057.    }
  1058. #endif                    /* Multiple Runs */
  1059.  
  1060. /*
  1061.  * The emit* routines output ucode to codefile.  The various routines are:
  1062.  *
  1063.  *  emitlab(l) - emit "lab" instruction for label l.
  1064.  *  emit(s) - emit instruction s.
  1065.  *  emitl(s,a) - emit instruction s with reference to label a.
  1066.  *  emitn(s,n) - emit instruction s with numeric argument a.
  1067.  *  emits(s,a) - emit instruction s with string argument a.
  1068.  */
  1069. static void emitlab(l)
  1070. int l;
  1071.    {
  1072.    writecheck(fprintf(codefile, "lab L%d\n", l));
  1073.    }
  1074.  
  1075. static void emit(s)
  1076. char *s;
  1077.    {
  1078.    writecheck(fprintf(codefile, "\t%s\n", s));
  1079.    }
  1080.  
  1081. static void emitl(s, a)
  1082. char *s;
  1083. int a;
  1084.    {
  1085.    writecheck(fprintf(codefile, "\t%s\tL%d\n", s, a));
  1086.    }
  1087.  
  1088. static void emitn(s, a)
  1089. char *s;
  1090. int a;
  1091.    {
  1092.    writecheck(fprintf(codefile, "\t%s\t%d\n", s, a));
  1093.    }
  1094.  
  1095. static void emits(s, a)
  1096. char *s, *a;
  1097.    {
  1098.    writecheck(fprintf(codefile, "\t%s\t%s\n", s, a));
  1099.    }
  1100.  
  1101. /*
  1102.  * alclab allocates n labels and returns the first.  For the interpreter,
  1103.  *  labels are restarted at 1 for each procedure, while in the compiler,
  1104.  *  they start at 1 and increase throughout the entire compilation.
  1105.  */
  1106. static int alclab(n)
  1107. int n;
  1108.    {
  1109.    register int lab;
  1110.  
  1111.    lab = nextlab;
  1112.    nextlab += n;
  1113.    return lab;
  1114.    }
  1115.