home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 25 / nopv25.iso / 040A / INTERCAL.ZIP / src / feh.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-06-22  |  24.0 KB  |  1,004 lines
  1. /****************************************************************************
  2.  
  3. NAME
  4.    feh.c -- code-generator back-end for ick parser
  5.  
  6. DESCRIPTION
  7.    This module provides storage manglement, code degeneration,
  8. and optimizations of dubious value for the INTERCAL compiler.
  9.  
  10. LICENSE TERMS
  11.     Copyright (C) 1996 Eric S. Raymond 
  12.  
  13.     This program is free software; you can redistribute it and/or modify
  14.     it under the terms of the GNU General Public License as published by
  15.     the Free Software Foundation; either version 2 of the License, or
  16.     (at your option) any later version.
  17.  
  18.     This program is distributed in the hope that it will be useful,
  19.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  20.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21.     GNU General Public License for more details.
  22.  
  23.     You should have received a copy of the GNU General Public License
  24.     along with this program; if not, write to the Free Software
  25.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  26.  
  27. ****************************************************************************/
  28. /*LINTLIBRARY */
  29. #include <stdio.h>
  30. #include <stdlib.h>
  31. #include <string.h>
  32. #include "sizes.h"
  33. #include "ick.h"
  34. #include "y.tab.h"
  35. #include "fiddle.h"
  36. #include "lose.h"
  37. #include "feh.h"
  38.  
  39. static int emitlineno;   /* line number for errors encountered during emit */
  40.  
  41. /*************************************************************************
  42.  *
  43.  * Node allocation functions.
  44.  *
  45.  * Nodes are used to represent expresion trees. The emit() function
  46.  * deallocates them.
  47.  *
  48.  **************************************************************************/
  49.  
  50. node *newnode(void)
  51. /* allocate and zero out a new expression node */
  52. {
  53.     return((node *)calloc(sizeof(node), 1));
  54. }
  55.  
  56. node *cons(int type, node *car, node *cdr)
  57. {
  58.     node *np = newnode();
  59.  
  60.     np->opcode = type;
  61.     np->lval = car;
  62.     np->rval = cdr;
  63.  
  64.     return(np);
  65. }
  66.  
  67. /*************************************************************************
  68.  *
  69.  * Variable-name mapping
  70.  *
  71.  * This permits us to optimize use of variable storage at runtime
  72.  *
  73.  **************************************************************************/
  74.  
  75. unsigned int intern(int type, int index)
  76. {
  77.     atom    *x;
  78.  
  79.     if (index < 1 || index > 65535)
  80.     lose(E200, yylineno, (char *)NULL);
  81.  
  82.     /* if it's already on the oblist, return its intindex */
  83.     for (x = oblist; x < obdex; x++)
  84.     if (x->type == type && x->extindex == index)
  85.         return(x->intindex);
  86.  
  87.     /* else we must intern a new symbol */
  88.     if (obdex >= oblist + MAXVARS)
  89.     lose(E333, yylineno, (char *)NULL);
  90.     obdex->type = type;
  91.     obdex->extindex = index;
  92.     if (type == ONESPOT)
  93.     obdex->intindex = nonespots++;
  94.     if (type == TWOSPOT)
  95.     obdex->intindex = ntwospots++;
  96.     if (type == TAIL)
  97.     obdex->intindex = ntails++;
  98.     if (type == HYBRID)
  99.     obdex->intindex = nhybrids++;
  100.     ++obdex;
  101.  
  102.     return(obdex[-1].intindex);
  103. }
  104.  
  105. /*************************************************************************
  106.  *
  107.  * This function insures a label is valid.
  108.  *
  109.  **************************************************************************/
  110.  
  111. void checklabel(int label)
  112. {
  113.     if (label < 1 || label > 65535)
  114.     lose(E197, yylineno, (char *)NULL);
  115. }
  116.  
  117. /*************************************************************************
  118.  *
  119.  * Tuple allocation functions.
  120.  *
  121.  **************************************************************************/
  122.  
  123. void treset(void)
  124. {
  125.     memset(tuples, '\0', sizeof(tuple) * MAXLINES);
  126.     nonespots = ntwospots = ntails = nhybrids = 0;
  127.     obdex = oblist;
  128.     lineno = 0;
  129. }
  130.  
  131. tuple *newtuple(void)
  132. /* allocate and zero out a new expression tuple */
  133. {
  134.     if (lineno >= MAXLINES)
  135.     {
  136.     lose(E666, yylineno, (char *)NULL);
  137.     return NULL;
  138.     }
  139.     else
  140.     return(tuples + lineno++);
  141. }
  142.  
  143. /*************************************************************************
  144.  *
  145.  * The typecaster
  146.  *
  147.  * The theory here is that we associate a type with each node in order to
  148.  * know what widths of unary-logical operator to use.
  149.  *
  150.  **************************************************************************/
  151.  
  152. void typecast(node *np)
  153. {
  154.     /* recurse so we typecast each node after all its subnodes */
  155.     if (np == (node *)NULL)
  156.     return;
  157.     else if (np->lval != (node *)NULL)
  158.     typecast(np->lval);
  159.     if (np->rval != (node *)NULL)
  160.     typecast(np->rval);
  161.  
  162.     /*
  163.      * This is an entire set of type-deducing machinery right here.
  164.      */
  165.     if (np->opcode == MESH || np->opcode == ONESPOT || np->opcode == TAIL)
  166.     np->width = 16;
  167.     else if (np->opcode == TWOSPOT || np->opcode == HYBRID
  168.         || np->opcode == MINGLE || np->opcode == MESH32)
  169.     np->width = 32;
  170.     else if (np->opcode == AND || np->opcode == OR || np->opcode == XOR ||
  171.          np->opcode == FIN ||
  172.          (np->opcode >= WHIRL && np->opcode <= WHIRL5))
  173.     np->width = np->rval->width;
  174.     else if (np->opcode == SELECT)
  175.     np->width = np->rval->width;    /* n-bit select has an n-bit result */
  176.     else if (np->opcode == SUB)
  177.     np->width = np->lval->width;    /* type of the array */
  178. }
  179.  
  180. /*************************************************************************
  181.  *
  182.  * The codechecker
  183.  *
  184.  * This checks for nasties like mismatched types in assignments that
  185.  * can be detected at compile time -- also for errors that could cause
  186.  * the compilation of the generated C to fail, like generated gotos to
  187.  * nonexistent labels or duplicate labels.
  188.  *
  189.  **************************************************************************/
  190.  
  191. void codecheck(void)
  192. {
  193.     tuple    *tp, *up;
  194.  
  195.     /* check for assignment type mismatches */
  196.     /* This check can't be done at compile time---RTFM.  [LHH] */
  197. /*
  198.     for (tp = tuples; tp < tuples + lineno; tp++)
  199.     if (tp->type == GETS)
  200.         if (tp->u.node->lval->width == 16 && tp->u.node->rval->width == 32)
  201.         lose(E275, tp - tuples + 1, (char *)NULL);
  202. */
  203.  
  204.     /* check for duplicate labels */
  205.     for (tp = tuples; tp < tuples + lineno; tp++)
  206.     if (tp->label)
  207.         for (up = tuples; up < tuples + lineno; up++)
  208.         if (tp != up && tp->label == up->label)
  209.             lose(E182, tp - tuples + 1, (char *)NULL);
  210.  
  211.     /*
  212.      * Check that every NEXT, ABSTAIN, REINSTATE and COME_FROM actually has a
  213.      * legitimate target label.
  214.      */
  215.     for (tp = tuples; tp < tuples + lineno; tp++)
  216.     if (tp->type == NEXT
  217.         || tp->type == ABSTAIN || tp->type == REINSTATE
  218.         || tp->type == COME_FROM)
  219.     {
  220.         bool    foundit = FALSE;
  221.  
  222.         for (up = tuples; up < tuples + lineno; up++)
  223.         if (tp->u.target == up->label)
  224.         {
  225.             foundit = TRUE;
  226.             break;
  227.         }
  228.  
  229.         if (!foundit)
  230.         {
  231.         if (tp->type == NEXT)
  232.             lose(E129, tp - tuples + 1, (char *)NULL);
  233.         else if (tp->type == COME_FROM)
  234.             lose(E444, tp - tuples + 1, (char *)NULL);
  235.         else
  236.             lose(E139, tp - tuples + 1, (char *)NULL);
  237.         }
  238.         /* tell the other tuple if it is a COME FROM target */
  239.         else if (tp->type == COME_FROM)
  240.         {
  241.             if (up->comefrom)
  242.             lose(E555, yylineno, (char *)NULL);
  243.         else
  244.             up->comefrom = tp - tuples + 1;
  245.         }
  246.         /* this substitutes line numbers for label numbers */
  247.         else if (tp->type != NEXT)
  248.         {
  249.         tp->u.target = up - tuples + 1;
  250.         }
  251.     }
  252. }
  253.  
  254. /*************************************************************************
  255.  *
  256.  * Optimizer code.
  257.  *
  258.  * It's not a very good optimizer, is it?
  259.  *
  260.  **************************************************************************/
  261.  
  262. #define ISCONSTANT(np, v)    ((np->opcode == MESH || np->opcode == MESH32) && np->constant == v)
  263.  
  264. static void rfree(node *np)
  265. /* recursively free the given node and all nodes underneath */
  266. {
  267.     if (np->lval != (node *)NULL)
  268.     rfree(np->lval);
  269.     if (np->rval != (node *)NULL)
  270.     rfree(np->rval);
  271.     free(np);    
  272. }
  273.  
  274. static int requal(node *mp, node *np)
  275. /* do two node trees represent the same expression? */
  276. {
  277.     if (mp == (node *)NULL && np == (node *)NULL)
  278.     return(TRUE);
  279.     else if (mp == (node *)NULL || np == (node *)NULL)
  280.     return(FALSE);
  281.     else if (mp->opcode != np->opcode || mp->constant != np->constant)
  282.     return(FALSE);
  283.     else if (!requal(mp->lval, np->lval) || !requal(mp->lval, np->lval))
  284.     return(FALSE);
  285.     else
  286.     return(TRUE);
  287. }
  288.  
  289. void optimize(node *np)
  290. {
  291.     node    *mingleop, *op;
  292.  
  293.     /* recurse so we simplify each node after all its subnodes */
  294.     if (np == (node *)NULL)
  295.     return;
  296.     else if (np->lval != (node *)NULL)
  297.     optimize(np->lval);
  298.     if (np->rval != (node *)NULL)
  299.     optimize(np->rval);
  300.  
  301.     /*
  302.      * OK, now do complete folding of constant expressions.
  303.      */
  304.  
  305.     /* fold MINGLE operations on constants */
  306.     if (np->opcode==MINGLE && (np->lval->opcode==MESH&&np->rval->opcode==MESH))
  307.     {
  308.     np->opcode = MESH32;
  309.     np->constant = mingle(np->lval->constant, np->rval->constant);
  310.     free(np->lval);
  311.     free(np->rval);
  312.     }
  313.  
  314.     /* fold SELECT operations on constants */
  315.     if (np->opcode == SELECT
  316.     && ((np->lval->opcode==MESH || np->lval->opcode==MESH32)
  317.         && (np->rval->opcode==MESH || np->rval->opcode==MESH32)))
  318.     {
  319.     np->opcode = np->rval->opcode;
  320.     np->constant = iselect(np->lval->constant, np->rval->constant);
  321.     free(np->lval);
  322.     free(np->rval);
  323.     }
  324.  
  325.     /* fold AND operations on 16-bit constants */
  326.     if (np->opcode == AND && np->rval->opcode == MESH)
  327.     {
  328.     np->opcode = MESH;
  329.     np->constant = and16(np->rval->constant);
  330.     free(np->rval);
  331.     }
  332.  
  333.     /* fold AND operations on 32-bit constants */
  334.     if (np->opcode == AND && np->rval->opcode == MESH32)
  335.     {
  336.     np->opcode = MESH32;
  337.     np->constant = and32(np->rval->constant);
  338.     free(np->rval);
  339.     }
  340.  
  341.     /* fold OR operations on 16-bit constants */
  342.     if (np->opcode == OR && np->rval->opcode == MESH)
  343.     {
  344.     np->opcode = MESH;
  345.     np->constant = or16(np->rval->constant);
  346.     free(np->rval);
  347.     }
  348.  
  349.     /* fold OR operations on 32-bit constants */
  350.     if (np->opcode == OR && np->rval->opcode == MESH32)
  351.     {
  352.     np->opcode = MESH32;
  353.     np->constant = or32(np->rval->constant);
  354.     free(np->rval);
  355.     }
  356.  
  357.     /* fold XOR operations on 16-bit constants */
  358.     if (np->opcode == XOR && np->rval->opcode == MESH)
  359.     {
  360.     np->opcode = MESH;
  361.     np->constant = xor16(np->rval->constant);
  362.     free(np->rval);
  363.     }
  364.  
  365.     /* fold XOR operations on 32-bit constants */
  366.     if (np->opcode == XOR && np->rval->opcode == MESH32)
  367.     {
  368.     np->opcode = MESH32;
  369.     np->constant = xor32(np->rval->constant);
  370.     free(np->rval);
  371.     }
  372.  
  373.     /*
  374.      * Less trivial stuff begins here
  375.      */
  376.  
  377.     /* equality test by XOR */
  378.     if (np->opcode == TESTNZ && np->rval->opcode == XOR)
  379.     {
  380.     node    *tp = np->rval;
  381.  
  382.     np->opcode = EQUALS;
  383.     np->lval = tp->lval;
  384.     np->rval = tp->rval;
  385.     free(np->rval);
  386.     }
  387.  
  388.     /* check for non-zeroness test */
  389.     if (np->opcode == SELECT && ISCONSTANT(np->rval, 1) && requal(np->lval->rval, np->lval->lval))
  390.     {
  391.     rfree(np->rval);
  392.     np->rval = np->lval->rval;
  393.     rfree(np->lval->lval);
  394.     np->lval = (node *)NULL;
  395.     np->opcode = TESTNZ;
  396.     np->width = 16;
  397.     }
  398.  
  399.     /* following optimizations only work in binary */
  400.     if (Base != 2)
  401.       return;
  402.  
  403.     /* recognize the idioms for various C binary logical operations */
  404.     if (np->opcode == SELECT
  405.     && np->rval->opcode == MESH32 && np->rval->constant == 0x55555555
  406.     && (op = np->lval) 
  407.         && (op->opcode == AND || op->opcode == OR || op->opcode == XOR)
  408.     && (mingleop = op->rval) && mingleop->opcode == MINGLE
  409.     && mingleop->rval->width == 16
  410.     && mingleop->lval->width == 16)
  411.     {
  412.     np->lval = mingleop->lval;
  413.     np->rval = mingleop->rval;
  414.  
  415.     switch(op->opcode)
  416.         {
  417.     case AND: np->opcode = C_AND; break;
  418.     case OR: np->opcode = C_OR; break;
  419.     case XOR: np->opcode = C_XOR; break;
  420.     default: lose(E778, yylineno, (char *)NULL);
  421.         }
  422.  
  423.     free(mingleop); free(op);
  424.     }
  425.  
  426.     /* recognize idioms for ~ */
  427.     if (np->opcode == XOR)
  428.     {
  429.     if (np->rval->width == 16
  430.         && np->lval->opcode == MESH &&np->lval->constant == 0xffff)
  431.     {
  432.         np->opcode = C_NOT;
  433.         free(np->lval);
  434.     }
  435.  
  436.     if (np->lval->width == 16
  437.         && np->rval->opcode == MESH && np->rval->constant == 0xffff)
  438.     {
  439.         np->opcode = C_NOT;
  440.         np->rval = np->lval;
  441.         free(np->rval);
  442.     }
  443.  
  444.     if (np->rval->width == 32
  445.         && np->lval->opcode == MESH32 && np->lval->constant == 0xffffffffL)
  446.     {
  447.         np->opcode = C_NOT;
  448.         free(np->lval);
  449.     }
  450.  
  451.     if (np->lval->width == 32
  452.         && np->rval->opcode == MESH32 && np->rval->constant == 0xffffffffL)
  453.     {
  454.         np->opcode = C_NOT;
  455.         np->rval = np->lval;
  456.         free(np->rval);
  457.     }
  458.     }
  459. }
  460.  
  461. /*************************************************************************
  462.  *
  463.  * Code degeneration
  464.  *
  465.  * The theory behind this crock is that we've been handed a pointer to
  466.  * a tuple representing a single INTERCAL statement, possibly with an
  467.  * expression tree hanging off it and twisting slowly, slowly in the wind.
  468.  *
  469.  * Our mission, should we choose to accept it, is to emit C code which,
  470.  * when linked to the INTERCAL run-time support, will do something
  471.  * resembling the right thing.
  472.  *
  473.  **************************************************************************/
  474.  
  475. /*
  476.  * If the order of statement-token defines in ick.y ever changes,
  477.  * this will need to be reordered.
  478.  */
  479. char *enablers[MAXTYPES] =
  480. {
  481.     "GETS",
  482.     "RESIZE",
  483.     "NEXT",
  484.     "FORGET",
  485.     "RESUME",
  486.     "STASH",
  487.     "RETRIEVE",
  488.     "IGNORE",
  489.     "REMEMBER",
  490.     "ABSTAIN",
  491.     "REINSTATE",
  492.     "DISABLE",
  493.     "ENABLE",
  494.     "GIVE_UP",
  495.     "READ_OUT",
  496.     "WRITE_IN",
  497.     "COME_FROM",
  498. };
  499.  
  500. assoc vartypes[] =
  501. {
  502.     { ONESPOT,    "ONESPOT" },
  503.     { TWOSPOT,    "TWOSPOT" },
  504.     { TAIL,    "TAIL" },
  505.     { HYBRID,    "HYBRID" },
  506.     { 0,    (char *)NULL }
  507. };
  508.  
  509. static assoc forgetbits[] =
  510. {
  511.     { ONESPOT,    "oneforget" },
  512.     { TWOSPOT,    "twoforget" },
  513.     { TAIL,    "tailforget" },
  514.     { HYBRID,    "hyforget" },
  515.     { 0,    (char *)NULL }
  516. };
  517.  
  518. static assoc varstores[] =
  519. {
  520.     { ONESPOT,    "onespots" },
  521.     { TWOSPOT,    "twospots" },
  522.     { TAIL,    "tails" },
  523.     { HYBRID,    "hybrids" },
  524.     { 0,    (char *)NULL }
  525. };
  526.  
  527. static assoc typedefs[] =
  528. {
  529.     { ONESPOT,    "type16" },
  530.     { TWOSPOT,    "type32" },
  531.     { TAIL,    "type16" },
  532.     { HYBRID,    "type32" },
  533.     { 0,    (char *)NULL }
  534. };
  535.  
  536. char *nameof(int value, assoc table[])
  537. /* return string corresponding to value in table */
  538. {
  539.     assoc    *ap;
  540.  
  541.     for (ap = table; ap->name; ap++)
  542.     if (ap->value == value)
  543.         return(ap->name);
  544.     return((char *)NULL);
  545. }
  546.  
  547. static void prexpr(node *np, FILE *fp);
  548.  
  549. static void prvar(node *np, FILE *fp)
  550. /* print out args to pass to storage manager for reference */
  551. {
  552.     node    *sp;
  553.     int        dim;
  554.  
  555.     switch (np->opcode)
  556.     {
  557.     case ONESPOT:
  558.     (void) fprintf(fp, "onespots[%lu]", np->constant);
  559.     break;
  560.  
  561.     case TWOSPOT:
  562.     (void) fprintf(fp, "twospots[%lu]", np->constant);
  563.     break;
  564.  
  565.     case TAIL:
  566.     (void) fprintf(fp, "TAIL, &tails[%lu]", np->constant);
  567.     break;
  568.  
  569.     case HYBRID:
  570.     (void) fprintf(fp, "HYBRID, &hybrids[%lu]", np->constant);
  571.     break;
  572.  
  573.     case SUB:
  574.     {
  575.       (void) fprintf(fp, "aref(");
  576.       prvar(np->lval, fp);
  577.  
  578.       dim = 0;
  579.       for (sp = np->rval ; sp ; sp = sp->rval)
  580.         dim++;
  581.       (void) fprintf(fp, ", %d", dim);
  582.  
  583.       for (sp = np->rval ; sp ; sp = sp->rval) {
  584.         (void) fprintf(fp, ", ");
  585.         prexpr(sp->lval, fp);
  586.       }
  587.       (void) fprintf(fp, ")");
  588.     }
  589.     break;
  590.     }
  591. }
  592.  
  593. static void prexpr(node *np, FILE *fp)
  594. /* print out C-function equivalent of an expression */
  595. {
  596.     switch (np->opcode)
  597.     {
  598.     case MINGLE:
  599.     (void) fprintf(fp, "mingle(");
  600.     prexpr(np->lval, fp);
  601.     (void) fprintf(fp, ", ");
  602.     prexpr(np->rval, fp);
  603.     (void) fprintf(fp, ")");
  604.     break;
  605.  
  606.     case SELECT:
  607.     (void) fprintf(fp, "iselect(");
  608.     prexpr(np->lval, fp);
  609.     (void) fprintf(fp, ", ");
  610.     prexpr(np->rval, fp);
  611.     (void) fprintf(fp, ")");
  612.     break;
  613.  
  614.     case AND:
  615.     (void) fprintf(fp, "and%d(", np->width);
  616.     prexpr(np->rval, fp);
  617.     (void) fprintf(fp, ")");
  618.     break;
  619.  
  620.     case OR:
  621.     (void) fprintf(fp, "or%d(", np->width);
  622.     prexpr(np->rval, fp);
  623.     (void) fprintf(fp, ")");
  624.     break;
  625.  
  626.     case XOR:
  627.     (void) fprintf(fp, "xor%d(", np->width);
  628.     prexpr(np->rval, fp);
  629.     (void) fprintf(fp, ")");
  630.     break;
  631.  
  632.     case EQUALS:
  633.     (void) fprintf(fp, "(");
  634.     prexpr(np->lval, fp);
  635.     (void) fprintf(fp, " == ");
  636.     prexpr(np->rval, fp);
  637.     (void) fprintf(fp, ")");
  638.     break;
  639.  
  640.     case FIN:
  641.     if (Base < 3)
  642.       lose(E997, emitlineno, (char *)NULL);
  643.     (void) fprintf(fp, "fin%d(", np->width);
  644.     prexpr(np->rval, fp);
  645.     (void) fprintf(fp, ")");
  646.     break;
  647.  
  648.     case WHIRL:
  649.     case WHIRL2:
  650.     case WHIRL3:
  651.     case WHIRL4:
  652.     case WHIRL5:
  653.     if (np->opcode - WHIRL + 3 > Base)
  654.       lose(E997, emitlineno, (char *)NULL);
  655.     (void) fprintf(fp, "whirl%d(%d, ", np->width, np->opcode - WHIRL + 1);
  656.     prexpr(np->rval, fp);
  657.     (void) fprintf(fp, ")");
  658.     break;
  659.  
  660.     case MESH:
  661.     (void) fprintf(fp, "0x%lx", np->constant);
  662.     break;
  663.  
  664.     case MESH32:
  665.     (void) fprintf(fp, "0x%lx", np->constant);
  666.     break;
  667.  
  668.     case ONESPOT:
  669.     case TWOSPOT:
  670.     prvar(np, fp);
  671.     break;
  672.  
  673.     case SUB:
  674.     (void) fprintf(fp, "*(%s*)", nameof(np->lval->opcode, typedefs));
  675.     prvar(np, fp);
  676.     break;
  677.  
  678.     /* cases from here down are generated by the optimizer */
  679.     case TESTNZ:
  680.     (void) fprintf(fp, "(");
  681.     prexpr(np->rval, fp);
  682.     (void) fprintf(fp, " != 0)");
  683.     break;
  684.  
  685.     case C_AND:
  686.     (void) fprintf(fp, "(");
  687.     prexpr(np->lval, fp);
  688.     (void) fprintf(fp, " & ");
  689.     prexpr(np->rval, fp);
  690.     (void) fprintf(fp, ")");
  691.     break;
  692.  
  693.     case C_OR:
  694.     (void) fprintf(fp, "(");
  695.     prexpr(np->lval, fp);
  696.     (void) fprintf(fp, " | ");
  697.     prexpr(np->rval, fp);
  698.     (void) fprintf(fp, ")");
  699.     break;
  700.  
  701.     case C_XOR:
  702.     (void) fprintf(fp, "(");
  703.     prexpr(np->lval, fp);
  704.     (void) fprintf(fp, " ^ ");
  705.     prexpr(np->rval, fp);
  706.     (void) fprintf(fp, ")");
  707.     break;
  708.  
  709.     case C_NOT:
  710.     (void) fprintf(fp, "(~");
  711.     prexpr(np->rval, fp);
  712.     (void) fprintf(fp, ")");
  713.     break;
  714.     }
  715.  
  716.     (void) free(np);
  717. }
  718.  
  719. static char *nice_text(char *texts[], int lines)
  720. {
  721. #define MAXNICEBUF    512
  722.   static char buf[MAXNICEBUF];
  723.   char *cp, *text;
  724.   int i;
  725.  
  726.   if (lines < 1)
  727.     lines = 1;
  728.   for (cp = buf, i = 0 ; i < lines ; ++i) {
  729.     if (i) {
  730.       (*cp++) = '\n';
  731.       (*cp++) = '\t';
  732.     }
  733.     for (text = texts[i] ; *text ; cp++, text++) {
  734.       if(*text == '"' || *text == '\\') {
  735.     (*cp++) = '\\';
  736.       }
  737.       *cp = *text;
  738.     }
  739.   }
  740.   *cp = '\0';
  741.   return buf;
  742. }
  743.  
  744. static void emit_guard(tuple *tn, FILE *fp)
  745. /* emit execution guard for giiven tuple (note the unbalanced trailing {!) */
  746. {
  747.     (void) fprintf(fp, "    if (");
  748.     if (tn->exechance < 100)
  749.     (void) fprintf(fp, "roll(%d) && ", tn->exechance);
  750.     (void) fprintf(fp, "!abstained[%d]) {\n", tn - tuples);
  751. }
  752.  
  753. void emit(tuple *tn, FILE *fp)
  754. /* emit code for the given tuple */
  755. {
  756.     node *np, *sp;
  757.     int    dim;
  758.  
  759.     /* grind out label and source dump */
  760.     if (yydebug || compile_only)
  761.     (void) fprintf(fp, "    /* line %03d */\n", tn->lineno);
  762.     if (tn->label)
  763.     (void) fprintf(fp, "L%d:", tn->label);
  764.     if (yydebug || compile_only)
  765.     (void) fprintf(fp, "\t/* %s */", textlines[tn->lineno]);
  766.     (void) fputc('\n', fp);
  767.  
  768.     /* set up the "next" lexical line number for error messages */
  769.     if (tn->type == NEXT) {
  770.     tuple *up;
  771.     for (up = tuples; up < tuples + lineno; up++)
  772.         if (tn->u.target == up->label) {
  773.         emitlineno = up->lineno;
  774.         break;
  775.         }
  776.     } else if (tn->comefrom)
  777.     emitlineno = tuples[tn->comefrom-1].lineno;
  778.     else if (tn < tuples + lineno - 1)
  779.     emitlineno = tn[1].lineno;
  780.     else
  781.     emitlineno = yylineno;
  782.     (void) fprintf(fp, "    lineno = %d;\n", emitlineno);
  783.  
  784.     /* emit random compiler bug */
  785.     if (!nocompilerbug)
  786.     {
  787. #ifdef USG
  788.     if ((lrand48() & 127) == 127)
  789. #else
  790.     if ((rand() & 127) == 127)
  791. #endif
  792.         (void) fprintf(fp, "    lose(E774, lineno, (char *)0);\n");
  793.     }
  794.  
  795.     /* emit conditional-execution prefixes */
  796.     if (tn->type != COME_FROM)
  797.     emit_guard(tn, fp);
  798.  
  799.     /* now emit the code for the statement body */
  800.     switch(tn->type)
  801.     {
  802.     case GETS:
  803.     np = tn->u.node;
  804.     if (np->lval->opcode != SUB) {
  805.       sp = np->lval;
  806.       (void) fprintf(fp,"\t(void) assign((char*)&");
  807.     }
  808.     else {
  809.       sp = np->lval->lval;
  810.       (void) fprintf(fp,"\t(void) assign(");
  811.     }
  812.     prvar(np->lval, fp);
  813.     (void) fprintf(fp,", %s", nameof(sp->opcode, vartypes));
  814.     (void) fprintf(fp,", %s[%lu], ", nameof(sp->opcode, forgetbits),
  815.                sp->constant);
  816.     prexpr(np->rval, fp);
  817.     (void) fprintf(fp,");\n");
  818.     break;
  819.  
  820.     case RESIZE:
  821.     np = tn->u.node;
  822.     dim = 0;
  823.     for (sp = np->rval; sp; sp = sp->rval)
  824.       dim++;
  825.     (void) fprintf(fp, "\tresize(");
  826.     prvar(np->lval, fp);
  827.     (void) fprintf(fp, ", %s[%lu]", nameof(np->lval->opcode, forgetbits),
  828.                np->lval->constant);
  829.     (void) fprintf(fp, ", %d", dim);
  830.     for (sp = np->rval; sp; sp = sp->rval) {
  831.       (void) fprintf(fp, ", ");
  832.       prexpr(sp->lval, fp);
  833.         }
  834.     (void) fprintf(fp, ");\n");
  835.     break;
  836.  
  837.     case NEXT:
  838.     (void) fprintf(fp,
  839.                "\tpushnext(%d); goto L%d; N%d:;\n",
  840.                tn - tuples + 1, tn->u.target, tn - tuples + 1);
  841.     break;
  842.  
  843.     case RESUME:
  844.     (void) fprintf(fp, "\tskipto = resume(");
  845.     prexpr(tn->u.node, fp);
  846.     (void) fprintf(fp, "); goto top;\n");
  847.     break;
  848.  
  849.     case FORGET:
  850.     (void) fprintf(fp, "\tpopnext(");
  851.     prexpr(tn->u.node, fp);
  852.     (void) fprintf(fp, ");\n");
  853.     break;
  854.  
  855.     case STASH:
  856.     for (np = tn->u.node; np; np = np->rval)
  857.         (void) fprintf(fp, "\tstash(%s, %lu, %s+%lu);\n",
  858.               nameof(np->opcode, vartypes),
  859.               np->constant,
  860.               nameof(np->opcode, varstores), np->constant);
  861.     break;
  862.  
  863.     case RETRIEVE:
  864.     for (np = tn->u.node; np; np = np->rval)
  865.         (void) fprintf(fp, "\tretrieve(%s+%lu, %s, %lu, %s[%lu]);\n",
  866.                nameof(np->opcode, varstores), np->constant,
  867.                nameof(np->opcode, vartypes),
  868.                np->constant,
  869.                nameof(np->opcode, forgetbits),
  870.                np->constant);
  871.     break;
  872.  
  873.     case IGNORE:
  874.     for (np = tn->u.node; np; np = np->rval)
  875.         (void) fprintf(fp,"\t%s[%lu] = TRUE;\n",
  876.                nameof(np->opcode, forgetbits),
  877.                np->constant);
  878.     break;
  879.  
  880.     case REMEMBER:
  881.     for (np = tn->u.node; np; np = np->rval)
  882.         (void) fprintf(fp,"\t%s[%lu] = FALSE;\n",
  883.                nameof(np->opcode, forgetbits),
  884.                np->constant);
  885.     break;
  886.  
  887.     case ABSTAIN:
  888.     (void) fprintf(fp, "\tabstained[%d] = TRUE;\n", tn->u.target - 1);
  889.     break;
  890.  
  891.     case REINSTATE:
  892.     (void) fprintf(fp, "\tabstained[%d] = FALSE;\n", tn->u.target - 1);
  893.     break;
  894.  
  895.     case ENABLE:
  896.     for (np = tn->u.node; np; np = np->rval)
  897.     {
  898.         (void) fprintf(fp,
  899.                "\tint i;\n\n\tfor (i = 0; i < (int)(sizeof(linetype)/sizeof(int)); i++)\n");
  900.         (void) fprintf(fp,
  901.                "\t    if (linetype[i] == %s)\n", enablers[np->constant-GETS]);
  902.         (void) fprintf(fp,
  903.                "\t\tabstained[i] = FALSE;\n");
  904.     }
  905.     break;
  906.  
  907.     case DISABLE:
  908.     for (np = tn->u.node; np; np = np->rval)
  909.     {
  910.         (void) fprintf(fp,
  911.                "\tint i;\n\n\tfor (i = 0; i < (int)(sizeof(linetype)/sizeof(int)); i++)\n");
  912.         (void) fprintf(fp,
  913.                "\t    if (linetype[i] == %s)\n", enablers[np->constant-GETS]);
  914.         (void) fprintf(fp,
  915.                "\t\tabstained[i] = TRUE;\n");
  916.     }
  917.     break;
  918.  
  919.     case GIVE_UP:
  920.     (void) fprintf(fp, "\treturn(0);\n");
  921.     break;
  922.  
  923.     case WRITE_IN:
  924.     for (np = tn->u.node; np; np = np->rval) {
  925.       if (np->lval->opcode == TAIL || np->lval->opcode == HYBRID) {
  926.         (void) fprintf(fp,"\tbinin(");
  927.         prvar(np->lval, fp);
  928.         (void) fprintf(fp, ", %s[%lu]",
  929.                nameof(np->lval->opcode, forgetbits),
  930.                np->lval->constant);
  931.         (void) fprintf(fp,");\n");
  932.       }
  933.       else {
  934.         if (np->lval->opcode != SUB) {
  935.           sp = np->lval;
  936.           (void) fprintf(fp,"\t(void) assign((char*)&");
  937.         }
  938.         else {
  939.           sp = np->lval->lval;
  940.           (void) fprintf(fp,"\t(void) assign(");
  941.         }
  942.         prvar(np->lval, fp);
  943.         (void) fprintf(fp,", %s", nameof(sp->opcode, vartypes));
  944.         (void) fprintf(fp,", %s[%lu]", nameof(sp->opcode, forgetbits),
  945.                sp->constant);
  946.         (void) fprintf(fp,", pin());\n");
  947.       }
  948.     }
  949.     break;
  950.  
  951.     case READ_OUT:
  952.     for (np = tn->u.node; np; np = np->rval)
  953.     {
  954.       if (np->lval->opcode == TAIL || np->lval->opcode == HYBRID) {
  955.         (void) fprintf(fp,"\tbinout(");
  956.         prvar(np->lval, fp);
  957.         (void) fprintf(fp,");\n");
  958.       }
  959.       else {
  960.         (void) fprintf(fp, "\tpout(");
  961.         prexpr(np->lval, fp);
  962.         (void) fprintf(fp, ");\n");
  963.       }
  964.     }
  965.     break;
  966.  
  967.     case SPLATTERED:
  968.     dim = emitlineno - tn->lineno;
  969.     if (tn->sharedline)
  970.         ++dim;
  971.     (void) fprintf(fp, "\tlose(E000, %d, \"%s\");\n",
  972.                emitlineno, nice_text(textlines + tn->lineno, dim));
  973.     break;
  974.  
  975.     case COME_FROM:
  976.     (void) fprintf(fp, "C%d:\n", tn->u.target);
  977.     break;
  978.  
  979.     default:
  980.     lose(E778, emitlineno, (char *)NULL);
  981.     break;
  982.     }
  983.  
  984.     if (tn->type != COME_FROM)
  985.     (void) fprintf(fp, "    }\n");
  986.  
  987.     /*
  988.      * If the statement that was just degenerated was a COME FROM target,
  989.      * emit the code for the jump to the COME FROM.
  990.      */
  991.     if (tn->comefrom) {
  992.     if (yydebug || compile_only)
  993.         (void) fprintf(fp,
  994.                "    /* line %03d is a suck point for the COME FROM at line %03d */\n",
  995.                tn->lineno, tuples[tn->comefrom-1].lineno);
  996.     emit_guard(tuples + tn->comefrom - 1, fp);
  997.     (void) fprintf(fp,
  998.                "\tgoto C%d;\n    }\n",
  999.                tuples[tn->comefrom-1].u.target);
  1000.     }
  1001. }
  1002.  
  1003. /* feh.c ends here */
  1004.