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