home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / rtt / rttinlin.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  67KB  |  1,974 lines
  1. /*
  2.  * rttinlin.c contains routines which produce the in-line version of an
  3.  *  operation and put it in the data base.
  4.  */
  5. #include "rtt.h"
  6.  
  7. /*
  8.  * prototypes for static functions. 
  9.  */
  10. hidden struct il_code *abstrcomp Params((struct node *n, int indx_stor,
  11.                                     int chng_stor, int escapes));
  12. hidden novalue         abstrsnty Params((struct token *t, int typcd,
  13.                                    int indx_stor, int chng_stor));
  14. hidden int             body_anlz Params((struct node *n, int *does_break,
  15.                                    int may_mod, int const_cast, int all));
  16. hidden struct il_code *body_fnc  Params((struct node *n));
  17. hidden novalue         chkrettyp Params((struct node *n));
  18. hidden novalue         chng_ploc Params((int typcd, struct node *src));
  19. hidden novalue         cnt_bufs  Params((struct node *cnv_typ));
  20. hidden struct il_code *il_walk   Params((struct node *n));
  21. hidden struct il_code *il_var    Params((struct node *n));
  22. hidden int             is_addr   Params((struct node *dcltor, int modifier));
  23. hidden novalue         lcl_tend  Params((struct node *n));
  24. hidden int             mrg_abstr Params((int sum, int typ));
  25. hidden int             strct_typ Params((struct node *typ, int *is_reg));
  26.  
  27. static int body_ret; /* RetInt, RetDbl, and/or RetOther for current body */
  28. static int ret_flag; /* DoesFail, DoesRet, and/or DoesSusp for current body */
  29. int fnc_ret;         /* RetInt, RetDbl, RetNoVal, or RetSig for current func */
  30.  
  31. #ifndef Rttx
  32.  
  33. /*
  34.  * body_prms is a list of symbol table entries for identifiers that must
  35.  *  be passed as parameters to the function implementing the current
  36.  *  body statement. The id_type of an identifier may be changed in the
  37.  *  symbol table while the body function is being produced; for example,
  38.  *  a tended descriptor is accessed through a parameter that is a pointer
  39.  *  to a descriptor, rather than being accessed as an element of a descriptor
  40.  *  array in a struct.
  41.  */
  42. struct var_lst {
  43.    struct sym_entry *sym;
  44.    int id_type;            /* saved value of id_type from sym */
  45.    struct var_lst *next;
  46.    };
  47. struct var_lst *body_prms;
  48. int n_bdy_prms;        /* number of entries in body_prms list */
  49. int rslt_loc;        /* flag: function passed addr of result descriptor */
  50.  
  51. char prfx3;        /* 3rd prefix char; used for unique body func names */
  52.  
  53. #if MVS
  54. extern char *src_file_nm;
  55. #endif                                  /* MVS */
  56.  
  57. /*
  58.  * in_line - place in the data base in-line code for an operation and
  59.  *   produce C functions for body statements.
  60.  */
  61. novalue in_line(n)
  62. struct node *n;
  63.    {
  64.    struct sym_entry *sym;
  65.    int i;
  66.    int nvars;
  67.    int ntend;
  68.  
  69.    prfx3 = ' '; /* reset 3rd prefix char for body functions */
  70.  
  71.    /*
  72.     * Set up the local symbol table in the data base for the in-line code.
  73.     *  This symbol table has an array of entries for the tended variables
  74.     *  in the declare statement, if there is one. Determine how large the
  75.     *  array must be and create it.
  76.     */
  77.    ntend = 0;
  78.    for (sym = dcl_stk->tended; sym != NULL; sym = sym->u.tnd_var.next)
  79.       ++ntend;
  80.    if (ntend == 0)
  81.       cur_impl->tnds = NULL;
  82.    else
  83.       cur_impl->tnds = (struct tend_var *)alloc((unsigned int)
  84.          (sizeof(struct tend_var) * ntend));
  85.    cur_impl->ntnds = ntend;
  86.    i = 0;
  87.  
  88.    /*
  89.     * Go back through the declarations and fill in the array for the 
  90.     *  tended part of the data base symbol table. Array entries contain
  91.     *  an indication of the type of tended declaration, the C code to
  92.     *  initialize the variable if there is any, and, for block pointer
  93.     *  declarations, the type of block. rtt's symbol table is updated to
  94.     *  contain the variable's offset into the data base's symbol table.
  95.     *  Note that parameters are considered part of the data base's symbol
  96.     *  table when computing the offset and il_indx initially contains
  97.     *  their number.
  98.     */
  99.    for (sym = dcl_stk->tended; sym != NULL; sym = sym->u.tnd_var.next) {
  100.       cur_impl->tnds[i].var_type = sym->id_type;
  101.       cur_impl->tnds[i].init = inlin_c(sym->u.tnd_var.init, 0);
  102.       cur_impl->tnds[i].blk_name = sym->u.tnd_var.blk_name;
  103.       sym->il_indx = il_indx++;
  104.       ++i;
  105.       }
  106.  
  107.    /*
  108.     * The data base's symbol table also has entries for non-tended
  109.     *  variables from the declare statement. Each entry has the
  110.     *  identifier for the variable and the declaration (redundantly
  111.     *  including the identifier). Once again the offset for the data
  112.     *  base symbol table is stored in rtt's symbol table.
  113.     */
  114.    nvars = -il_indx;  /* pre-subtract preceding number of entries */
  115.    for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next)
  116.       sym->il_indx = il_indx++;
  117.    nvars += il_indx;  /* compute number of entries in this part of table */
  118.    cur_impl->nvars = nvars;
  119.    if (nvars > 0) {
  120.       cur_impl->vars = (struct ord_var *)alloc((unsigned int)
  121.          (sizeof(struct ord_var) * nvars));
  122.       i = 0;
  123.       for (sym = decl_lst; sym != NULL; sym = sym->u.declare_var.next) {
  124.          cur_impl->vars[i].name = sym->image;
  125.          cur_impl->vars[i].dcl = ilc_dcl(sym->u.declare_var.tqual,
  126.             sym->u.declare_var.dcltor, sym->u.declare_var.init);
  127.          ++i;
  128.          }
  129.       }
  130.  
  131.    abs_ret = NoAbstr;           /* abstract clause not encountered yet */
  132.    cur_impl->in_line = il_walk(n); /* produce in-line code for operation */
  133.    }
  134.  
  135. /*
  136.  * il_walk - walk the syntax tree producing in-line code.
  137.  */
  138. static struct il_code *il_walk(n)
  139. struct node *n;
  140.    {
  141.    struct token *t;
  142.    struct node *n1;
  143.    struct node *n2;
  144.    struct il_code *il;
  145.    struct il_code *il1;
  146.    struct sym_entry *sym;
  147.    struct init_tend *tnd;
  148.    int dummy_int;
  149.    int ntend;
  150.    int typcd;
  151.  
  152.    if (n == NULL)
  153.       return NULL;
  154.  
  155.    t =  n->tok;
  156.  
  157.    switch (n->nd_id) {
  158.       case PrefxNd:
  159.          switch (t->tok_id) {
  160.             case '{':
  161.                /*
  162.                 * RTL code: { <actions> }
  163.                 */
  164.                il = il_walk(n->u[0].child);
  165.                break;
  166.             case '!':
  167.                /*
  168.                 * RTL type-checking and conversions: ! <simple-type-check>
  169.                 */
  170.                il = new_il(IL_Bang, 1);
  171.                il->u[0].fld = il_walk(n->u[0].child);
  172.                break;
  173.             case Body:
  174.                /*
  175.                 * RTL code: body { <c-code> }
  176.                 */
  177.                il = body_fnc(n);
  178.                break;
  179.             case Inline:
  180.                /*
  181.                 * RTL code: inline { <c-code> }
  182.                 *
  183.                 *  An in-line code "block" in the data base starts off
  184.                 *  with an indication of whether execution falls through
  185.                 *  the code and a list of tended descriptors needed by the
  186.                 *  in-line C code. The list indicates the kind of tended
  187.                 *  descriptor. The list is determined by walking to the
  188.                 *  syntax tree for the C code; tend_lst points to its
  189.                 *  beginning. The last item in the block is the C code itself.
  190.                 */
  191.                free_tend();
  192.                lcl_tend(n);
  193.                if (tend_lst == NULL)
  194.                   ntend = 0;
  195.                else
  196.                   ntend = tend_lst->t_indx + 1;
  197.                il = new_il(IL_Block, 3 + ntend);
  198.                /*
  199.                 * Only need "fall through" info from body_anlz().
  200.                 */
  201.                il->u[0].n = body_anlz(n->u[0].child, &dummy_int, 0, 0, 0);
  202.                il->u[1].n = ntend;
  203.                for (tnd = tend_lst; tnd != NULL; tnd = tnd->next)
  204.                   il->u[2 + tnd->t_indx].n = tnd->init_typ;
  205.                il->u[ntend + 2].c_cd = inlin_c(n->u[0].child, 0);
  206.                if (!il->u[0].n)
  207.                   clr_prmloc(); /* execution does not continue */
  208.                break;
  209.             }
  210.          break;
  211.       case BinryNd:
  212.          switch (t->tok_id) {
  213.             case Runerr:
  214.                /*
  215.                 * RTL code: runerr( <message-number> )
  216.                 *           runerr( <message-number>, <descriptor> )
  217.                 */
  218.                if (n->u[1].child == NULL)
  219.                   il = new_il(IL_Err1, 1);
  220.                else {
  221.                   il = new_il(IL_Err2, 2);
  222.                   il->u[1].fld = il_var(n->u[1].child);
  223.                   }
  224.                il->u[0].n = atol(n->u[0].child->tok->image);
  225.                /*
  226.                 * Execution cannot continue on this execution path.
  227.                 */
  228.                clr_prmloc();
  229.                break;
  230.             case And:
  231.                /*
  232.                 * RTL type-checking and conversions:
  233.                 *   <type-check> && <type_check>
  234.                 */
  235.                il = new_il(IL_And, 2);
  236.                il->u[0].fld = il_walk(n->u[0].child);
  237.                il->u[1].fld = il_walk(n->u[1].child);
  238.                break;
  239.             case Is:
  240.                /*
  241.                 * RTL type-checking and conversions:
  242.                 *   is: <icon-type> ( <variable> )
  243.                 */
  244.                il = new_il(IL_Is, 2);
  245.                il->u[0].n = icn_typ(n->u[0].child);
  246.                il->u[1].fld = il_var(n->u[1].child);
  247.                break;
  248.             }
  249.          break;
  250.       case ConCatNd:
  251.          /*
  252.           * "Glue" for two constructs.
  253.           */
  254.          il = new_il(IL_Lst, 2);
  255.          il->u[0].fld = il_walk(n->u[0].child);
  256.          il->u[1].fld = il_walk(n->u[1].child);
  257.          break;
  258.       case AbstrNd:
  259.          /*
  260.           * RTL code: abstract { <type-computations> }
  261.           *
  262.           *  Remember the return statement if there is one. It is used for
  263.           *  type checking when types are easily determined.
  264.           */
  265.          il = new_il(IL_Abstr, 2);
  266.          il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
  267.          il1 = abstrcomp(n->u[1].child, 0, 0, 1);
  268.          il->u[1].fld = il1;
  269.          if (il1 != NULL) {
  270.             if (abs_ret != NoAbstr)
  271.                errt1(t,"only one abstract return may be on any execution path");
  272.             if (il1->il_type == IL_IcnTyp || il1->il_type == IL_New)
  273.                abs_ret = il1->u[0].n;
  274.             else
  275.                abs_ret = SomeType;
  276.             }
  277.          break;
  278.       case TrnryNd:
  279.          switch (t->tok_id) {
  280.             case If: {
  281.                /*
  282.                 * RTL code for "if" statements:
  283.                 *  if <type-check> then <action>
  284.                 *  if <type-check> then <action> else <action>
  285.                 *
  286.                 *  <type-check> may include parameter conversions that create
  287.                 *  new scoping. It is necessary to keep track of parameter
  288.                 *  types and locations along success and failure paths of
  289.                 *  these conversions. The "then" and "else" actions may
  290.                 *  also establish new scopes (if a parameter is used within
  291.                 *  a overlapping scopes that conflict, it has already been
  292.                 *  detected).
  293.                 *
  294.                 *  The "then" and "else" actions may contain abstract return
  295.                 *  statements. The types of these must be "merged" in case
  296.                 *  type checking must be done on real return or suspend
  297.                 *  statements following the "if".
  298.                 */
  299.                struct parminfo *then_prms = NULL;
  300.                struct parminfo *else_prms;
  301.                struct node *cond;
  302.                struct node *else_nd;
  303.                int sav_absret;
  304.                int new_absret;
  305.  
  306.                /*
  307.                 * Save the current parameter locations. These are in
  308.                 *  effect on the failure path of any type conversions
  309.                 *  in the condition of the "if". Also remember any
  310.                 *  information from abstract returns.
  311.                 */
  312.                else_prms = new_prmloc();
  313.                sv_prmloc(else_prms);
  314.                sav_absret = new_absret = abs_ret;
  315.  
  316.                cond = n->u[0].child;
  317.                else_nd = n->u[2].child;
  318.  
  319.                if (else_nd == NULL)
  320.                   il = new_il(IL_If1, 2);
  321.                else
  322.                   il = new_il(IL_If2, 3);
  323.                il->u[0].fld = il_walk(cond);
  324.                /*
  325.                 * If the condition is negated, the failure path is to the "then"
  326.                 *  and the success path is to the "else".
  327.                 */
  328.                if (cond->nd_id == PrefxNd && cond->tok->tok_id == '!') {
  329.                   then_prms = else_prms;
  330.                   else_prms = new_prmloc();
  331.                   sv_prmloc(else_prms);
  332.                   ld_prmloc(then_prms);
  333.                   }
  334.                il->u[1].fld = il_walk(n->u[1].child);  /* then ... */
  335.                if (else_nd == NULL) {
  336.                   mrg_prmloc(else_prms);
  337.                   ld_prmloc(else_prms);
  338.                   }
  339.                else {
  340.                   if (then_prms == NULL)
  341.                      then_prms = new_prmloc();
  342.                   sv_prmloc(then_prms);
  343.                   ld_prmloc(else_prms);
  344.                   new_absret = mrg_abstr(new_absret, abs_ret);
  345.                   abs_ret = sav_absret;
  346.                   il->u[2].fld = il_walk(else_nd);
  347.                   mrg_prmloc(then_prms);
  348.                   ld_prmloc(then_prms);
  349.                   }
  350.                abs_ret = mrg_abstr(new_absret, abs_ret);
  351.                if (then_prms != NULL)
  352.                   free((char *)then_prms);
  353.                if (else_prms != NULL)
  354.                   free((char *)else_prms);
  355.                }
  356.                break;
  357.             case Len_case: {
  358.                /*
  359.                 * RTL code:
  360.                 *   len_case <variable> of {
  361.                 *      <integer>: <action>
  362.                 *        ...
  363.                 *      default: <action>
  364.                 *      }
  365.                 */
  366.                struct parminfo *strt_prms;
  367.                struct parminfo *end_prms;
  368.                int n_cases;
  369.                int indx;
  370.                int sav_absret;
  371.                int new_absret;
  372.  
  373.                /*
  374.                 * A case may contain parameter conversions that create new
  375.                 *  scopes. Remember the parameter locations at the start
  376.                 *  of the len_case statement. Also remember information
  377.                 *  about abstract type returns.
  378.                 */
  379.                strt_prms = new_prmloc();
  380.                sv_prmloc(strt_prms);
  381.                end_prms = new_prmloc();
  382.                sav_absret = new_absret = abs_ret;
  383.  
  384.                /*
  385.                 * Count the number of cases; there is at least one.
  386.                 */
  387.                n_cases = 1;
  388.                for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
  389.                    n1 = n1->u[0].child)
  390.                       ++n_cases;
  391.  
  392.                /*
  393.                 * The data base entry has one slot for the number of cases,
  394.                 *  one for the default clause, and two for each case. A
  395.                 *  case includes a selection integer and an action.
  396.                 */
  397.                il = new_il(IL_Lcase, 2 + 2 * n_cases);
  398.                il->u[0].n = n_cases;
  399.  
  400.                /*
  401.                 * Go through the cases, adding them to the data base entry.
  402.                 *  Merge resulting parameter locations and information
  403.                 *  about abstract type returns, then restore the starting
  404.                 *  information for the next case.
  405.                 */
  406.                indx = 2 * n_cases;
  407.                for (n1 = n->u[1].child; n1->nd_id == ConCatNd;
  408.                     n1 = n1->u[0].child) {
  409.                   il->u[indx--].fld = il_walk(n1->u[1].child->u[0].child);
  410.                   il->u[indx--].n = atol(n1->u[1].child->tok->image);
  411.                   mrg_prmloc(end_prms);
  412.                   ld_prmloc(strt_prms);
  413.                   new_absret = mrg_abstr(new_absret, abs_ret);
  414.                   abs_ret = sav_absret;
  415.                   }
  416.                /*
  417.                 * Last case.
  418.                 */
  419.                il->u[indx--].fld = il_walk(n1->u[0].child);
  420.                il->u[indx].n = atol(n1->tok->image);
  421.                mrg_prmloc(end_prms);
  422.                ld_prmloc(strt_prms);
  423.                new_absret = mrg_abstr(new_absret, abs_ret);
  424.                abs_ret = sav_absret;
  425.                /*
  426.                 * Default clause.
  427.                 */
  428.                il->u[1 + 2 * n_cases].fld = il_walk(n->u[2].child);
  429.                mrg_prmloc(end_prms);
  430.                ld_prmloc(end_prms);
  431.                abs_ret = mrg_abstr(new_absret, abs_ret);
  432.                if (strt_prms != NULL)
  433.                   free((char *)strt_prms);
  434.                if (end_prms != NULL)
  435.                   free((char *)end_prms);
  436.                }
  437.                break;
  438.             case Type_case: {
  439.                /*
  440.                 * RTL code:
  441.                 *   type_case <variable> of {
  442.                 *       <icon_type> : ... <icon_type> : <action>
  443.                 *          ...
  444.                 *       }
  445.                 *
  446.                 *   last clause may be: default: <action>
  447.                 */
  448.                struct node *sel;
  449.                struct parminfo *strt_prms;
  450.                struct parminfo *end_prms;
  451.                int *typ_vect;
  452.                int n_case;
  453.                int n_typ;
  454.                int n_fld;
  455.                int sav_absret;
  456.                int new_absret;
  457.  
  458.                /*
  459.                 * A case may contain parameter conversions that create new
  460.                 *  scopes. Remember the parameter locations at the start
  461.                 *  of the type_case statement. Also remember information
  462.                 *  about abstract type returns.
  463.                 */
  464.                strt_prms = new_prmloc();
  465.                sv_prmloc(strt_prms);
  466.                end_prms = new_prmloc();
  467.                sav_absret = new_absret = abs_ret;
  468.  
  469.                /*
  470.                 * Count the number of cases.
  471.                 */
  472.                n_case = 0;
  473.                for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child)
  474.                   ++n_case;
  475.  
  476.                /*
  477.                 * The data base entry has one slot for the variable whose
  478.                 *  type is being tested, one for the number cases, three
  479.                 *  for each case, and, if there is default clause, one
  480.                 *  for it. Each case includes the number of types selected
  481.                 *  by the case, a vectors of those types, and the action
  482.                 *  for the case.
  483.                 */
  484.                if (n->u[2].child == NULL) {
  485.                   il = new_il(IL_Tcase1, 3 * n_case + 2);
  486.                   il->u[0].fld = il_var(n->u[0].child);
  487.                   }
  488.                else {
  489.                   /*
  490.                    * There is a default clause.
  491.                    */
  492.                   il = new_il(IL_Tcase2, 3 * n_case + 3);
  493.                   il->u[0].fld = il_var(n->u[0].child);
  494.                   il->u[3 * n_case + 2].fld = il_walk(n->u[2].child);
  495.                   mrg_prmloc(end_prms);
  496.                   ld_prmloc(strt_prms);
  497.                   }
  498.                il->u[1].n = n_case;
  499.  
  500.                /*
  501.                 * Go through the cases, adding them to the data base entry.
  502.                 *  Merge resulting parameter locations and information
  503.                 *  about abstract type returns, then restore the starting
  504.                 *  information for the next case.
  505.                 */
  506.                n_fld = 2;
  507.                for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child) {
  508.                   /*
  509.                    * Determine the number types selected by the case and
  510.                    *  put the types in a vector.
  511.                    */
  512.                   sel = n1->u[1].child;
  513.                   n_typ = 0;
  514.                   for (n2 = sel->u[0].child; n2 != NULL; n2 = n2->u[0].child)
  515.                      n_typ++;
  516.                   il->u[n_fld++].n = n_typ;
  517.                   typ_vect = (int *)alloc((unsigned int)(sizeof(int) * n_typ));
  518.                   il->u[n_fld++].vect = typ_vect;
  519.                   n_typ = 0;
  520.                   for (n2 = sel->u[0].child; n2 != NULL; n2 = n2->u[0].child)
  521.                      typ_vect[n_typ++] = icn_typ(n2->u[1].child);
  522.                   /*
  523.                    * Add code for the case to the data  base entry.
  524.                    */
  525.                   new_absret = mrg_abstr(new_absret, abs_ret);
  526.                   abs_ret = sav_absret;
  527.                   il->u[n_fld++].fld = il_walk(sel->u[1].child);
  528.                   mrg_prmloc(end_prms);
  529.                   ld_prmloc(strt_prms);
  530.                   }
  531.                ld_prmloc(end_prms);
  532.                abs_ret = mrg_abstr(new_absret, abs_ret);
  533.                if (strt_prms != NULL)
  534.                   free((char *)strt_prms);
  535.                if (end_prms != NULL)
  536.                   free((char *)end_prms);
  537.                }
  538.                break;
  539.             case Cnv: {
  540.                /*
  541.                 * RTL code: cnv: <type> ( <source> )
  542.                 *           cnv: <type> ( <source> , <destination> )
  543.                 */
  544.                struct node *typ;
  545.                struct node *src;
  546.                struct node *dst;
  547.  
  548.                typ = n->u[0].child;
  549.                src = n->u[1].child;
  550.                dst = n->u[2].child;
  551.                typcd = icn_typ(typ);
  552.                if (src->nd_id == SymNd)
  553.                   sym = src->u[0].sym;
  554.                else if (src->nd_id == BinryNd)
  555.                   sym = src->u[0].child->u[0].sym; /* subscripted variable */
  556.                else
  557.                   errt2(src->tok, "undeclared identifier: ", src->tok->image);
  558.                if (sym->u.param_info.parm_mod) {
  559.                   fprintf(stderr, "%s: file %s, line %d, warning: ",
  560.                      progname, src->tok->fname, src->tok->line);
  561.                   fprintf(stderr, "%s may be modified\n", sym->image);
  562.                   fprintf(stderr,
  563.                   "\ticonc does not handle conversion of modified parameter\n");
  564.                   }
  565.  
  566.  
  567.                if (dst == NULL) {
  568.                   il = new_il(IL_Cnv1, 2);
  569.                   il->u[0].n = typcd;
  570.                   il->u[1].fld = il_var(src);
  571.                   /*
  572.                    * This "in-place" conversion may create a new scope for the
  573.                    *  source parameter.
  574.                    */
  575.                   chng_ploc(typcd, src);
  576.                   sym->u.param_info.parm_mod |= 1;
  577.                   }
  578.                else {
  579.                   il = new_il(IL_Cnv2, 3);
  580.                   il->u[0].n = typcd;
  581.                   il->u[1].fld = il_var(src);
  582.                   il->u[2].c_cd = inlin_c(dst, 1);
  583.                   }
  584.                }
  585.                break;
  586.             case Arith_case: {
  587.                /*
  588.                 * arith_case (<variable>, <variable>) of {
  589.                 *   C_integer: <statement>
  590.                 *   integer: <statement>
  591.                 *   C_double: <statement>
  592.                 *   }
  593.                 *
  594.                 * This construct does type conversions and provides
  595.                 *  alternate execution paths. It is necessary to keep
  596.                 *  track of parameter locations.
  597.                 */
  598.                struct node *var1;
  599.                struct node *var2;
  600.                struct parminfo *strt_prms;
  601.                struct parminfo *end_prms;
  602.                int sav_absret;
  603.                int new_absret;
  604.  
  605.                strt_prms = new_prmloc();
  606.                sv_prmloc(strt_prms);
  607.                end_prms = new_prmloc();
  608.                sav_absret = new_absret = abs_ret;
  609.  
  610.                var1 = n->u[0].child;
  611.                var2 = n->u[1].child;
  612.                n1 = n->u[2].child;   /* contains actions for the 3 cases */
  613.  
  614.                /*
  615.                 * The data base entry has a slot for each of the two variables
  616.                 *  and one for each of the three cases.
  617.                 */
  618.                il = new_il(IL_Acase, 5);
  619.                il->u[0].fld = il_var(var1);
  620.                il->u[1].fld = il_var(var2);
  621.  
  622.                /*
  623.                 * The "in-place" conversions to C_integer creates new scopes.
  624.                 */
  625.                chng_ploc(TypECInt, var1);
  626.                chng_ploc(TypECInt, var2);
  627.                il->u[2].fld = il_walk(n1->u[0].child);
  628.                mrg_prmloc(end_prms);
  629.                new_absret = mrg_abstr(new_absret, abs_ret);
  630.  
  631.  
  632.                /*
  633.                 * Conversion to integer (applicable to large integers only).
  634.                 */
  635.                ld_prmloc(strt_prms);
  636.                abs_ret = sav_absret;
  637.                il->u[3].fld  = il_walk(n1->u[1].child);
  638.                mrg_prmloc(end_prms);
  639.                new_absret = mrg_abstr(new_absret, abs_ret);
  640.  
  641.                /*
  642.                 * The "in-place" conversions to C_double creates new scopes.
  643.                 */
  644.                ld_prmloc(strt_prms);
  645.                abs_ret = sav_absret;
  646.                chng_ploc(TypCDbl, var1);
  647.                chng_ploc(TypCDbl, var2);
  648.                il->u[4].fld  = il_walk(n1->u[2].child);
  649.                mrg_prmloc(end_prms);
  650.  
  651.                ld_prmloc(end_prms);
  652.                abs_ret = mrg_abstr(new_absret, abs_ret);
  653.                free((char *)strt_prms);
  654.                free((char *)end_prms);
  655.                }
  656.                break;
  657.             }
  658.          break;
  659.       case QuadNd: {
  660.          /*
  661.           * RTL code: def: <type> ( <source> , <default>)
  662.           *           def: <type> ( <source> , <default> , <destination> )
  663.           */
  664.          struct node *typ;
  665.          struct node *src;
  666.          struct node *dflt;
  667.          struct node *dst;
  668.  
  669.          typ = n->u[0].child;
  670.          src = n->u[1].child;
  671.          dflt = n->u[2].child;
  672.          dst = n->u[3].child;
  673.          typcd = icn_typ(typ);
  674.          if (dst == NULL) {
  675.             il = new_il(IL_Def1, 3);
  676.             il->u[0].n = typcd;
  677.             il->u[1].fld = il_var(src);
  678.             il->u[2].c_cd = inlin_c(dflt, 0);
  679.             /*
  680.              * This "in-place" conversion may create a new scope for the
  681.              *  source parameter.
  682.              */
  683.             chng_ploc(typcd, src);
  684.             }
  685.          else {
  686.             il = new_il(IL_Def2, 4);
  687.             il->u[0].n = typcd;
  688.             il->u[1].fld = il_var(src);
  689.             il->u[2].c_cd = inlin_c(dflt, 0);
  690.             il->u[3].c_cd = inlin_c(dst, 1);
  691.             }
  692.          }
  693.          break;
  694.       }
  695.    return il;
  696.    }
  697.  
  698. /*
  699.  * il_var - produce in-line code in the data base for varibel references.
  700.  *   These include both simple identifiers and subscripted identifiers.
  701.  */
  702. static struct il_code *il_var(n)
  703. struct node *n;
  704.    {
  705.    struct il_code *il;
  706.  
  707.    if (n->nd_id == SymNd) {
  708.       il = new_il(IL_Var, 1);
  709.       il->u[0].n = n->u[0].sym->il_indx; /* offset into data base sym. tab. */
  710.       }
  711.    else if (n->nd_id == BinryNd) {
  712.       /*
  713.        * A subscripted variable.
  714.        */
  715.       il = new_il(IL_Subscr, 2);
  716.       il->u[0].n = n->u[0].child->u[0].sym->il_indx; /* sym. tab. offset */
  717.       il->u[1].n = atol(n->u[1].child->tok->image);  /* subscript */
  718.       }
  719.    else
  720.       errt2(n->tok, "undeclared identifier: ", n->tok->image);
  721.    return il;
  722.    }
  723.  
  724. /*
  725.  * abstrcomp - produce data base code for RTL abstract type computations.
  726.  *  In the process, do a few sanity checks where they are easy to do.
  727.  */
  728. static struct il_code *abstrcomp(n, indx_stor, chng_stor, escapes)
  729. struct node *n;
  730. int indx_stor;
  731. int chng_stor;
  732. int escapes;
  733.    {
  734.    struct token *t;
  735.    struct il_code *il;
  736.    int typcd;
  737.    int cmpntcd;
  738.  
  739.    if (n == NULL)
  740.       return NULL;
  741.  
  742.    t =  n->tok;
  743.  
  744.    switch (n->nd_id) {
  745.       case PrefxNd:
  746.          switch (t->tok_id) {
  747.             case Type:
  748.                /*
  749.                 * type( <variable> )
  750.                 */
  751.                il = new_il(IL_VarTyp, 1);
  752.                il->u[0].fld = il_var(n->u[0].child);
  753.                break; 
  754.             case Store:
  755.                /*
  756.                 * store[ <type> ]
  757.                 */
  758.                il = new_il(IL_Store, 1);
  759.                il->u[0].fld = abstrcomp(n->u[0].child, 1, 0, 0);
  760.                break; 
  761.             }
  762.          break;
  763.       case PstfxNd:
  764.          /*
  765.           * <type> . <attrb_name>
  766.           */
  767.          il = new_il(IL_Compnt, 2);
  768.          il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
  769.          switch (t->tok_id) {
  770.             case Component:
  771.                cmpntcd = sym_lkup(t->image)->u.typ_indx;
  772.                il->u[1].n = cmpntcd;
  773.                if (escapes && !typecompnt[cmpntcd].var)
  774.                   errt3(t, typecompnt[cmpntcd].id,
  775.                     " component is an internal reference type.\n",
  776.                     "\t\tuse store[<type>.<component>] to \"dereference\" it");
  777.                break; 
  778.             case All_fields:
  779.                il->u[1].n = CM_Fields;
  780.                break; 
  781.             }
  782.          break;
  783.       case IcnTypNd:
  784.          /*
  785.           * <icon-type>
  786.           */
  787.          il = new_il(IL_IcnTyp, 1);
  788.          typcd = icn_typ(n->u[0].child);
  789.          abstrsnty(t, typcd, indx_stor, chng_stor);
  790.          il->u[0].n = typcd;
  791.          break;
  792.       case BinryNd:
  793.          switch (t->tok_id) {
  794.             case '=':
  795.                /*
  796.                 * store[ <type> ] = <type>
  797.                 */
  798.                il = new_il(IL_TpAsgn, 2);
  799.                il->u[0].fld = abstrcomp(n->u[0].child, 1, 1, 0);
  800.                il->u[1].fld = abstrcomp(n->u[1].child, 0, 0, 1);
  801.                break;
  802.             case Incr: /* union */
  803.                /*
  804.                 * <type> ++ <type>
  805.                 */
  806.                il = new_il(IL_Union, 2);
  807.                il->u[0].fld = abstrcomp(n->u[0].child, indx_stor, chng_stor,
  808.                   escapes);
  809.                il->u[1].fld = abstrcomp(n->u[1].child, indx_stor, chng_stor,
  810.                   escapes);
  811.                break;
  812.             case Intersect:
  813.                /*
  814.                 * <type> ** <type>
  815.                 */
  816.                il = new_il(IL_Inter, 2);
  817.                il->u[0].fld = abstrcomp(n->u[0].child, indx_stor, chng_stor,
  818.                   escapes);
  819.                il->u[1].fld = abstrcomp(n->u[1].child, indx_stor, chng_stor,
  820.                   escapes);
  821.                break;
  822.             case New: {
  823.                /*
  824.                 * new <icon-type> ( <type> ,  ... )
  825.                 */
  826.                struct node *typ;
  827.                struct node *args;
  828.                int nargs;
  829.  
  830.                typ = n->u[0].child;
  831.                args = n->u[1].child;
  832.  
  833.                typcd = icn_typ(typ);
  834.                abstrsnty(typ->tok, typcd, indx_stor, chng_stor);
  835.  
  836.                /*
  837.                 * Determine the number of arguments expected for this
  838.                 *  structure type.
  839.                 */
  840.                if (typcd >= 0)
  841.                   nargs = icontypes[typcd].num_comps;
  842.                else
  843.                   nargs  = 0;
  844.                if (nargs == 0)
  845.                   errt2(typ->tok,typ->tok->image," is not an aggregate type.");
  846.  
  847.                /*
  848.                 * Create the "new" construct for the data base with its type
  849.                 *  code and arguments.
  850.                 */
  851.                il = new_il(IL_New, 2 + nargs); 
  852.                il->u[0].n = typcd;
  853.                il->u[1].n = nargs;
  854.                while (nargs > 1) {
  855.                   if (args->nd_id == CommaNd)
  856.                      il->u[1 + nargs].fld = abstrcomp(args->u[1].child, 0,0,1);
  857.                   else
  858.                      errt2(typ->tok, "too few arguments for new",
  859.                         typ->tok->image);
  860.                   args = args->u[0].child;
  861.                   --nargs;
  862.                   }
  863.                if (args->nd_id == CommaNd)
  864.                   errt2(typ->tok, "too many arguments for new",typ->tok->image);
  865.                il->u[2].fld = abstrcomp(args, 0, 0, 1);
  866.                }
  867.                break;
  868.             }
  869.          break;
  870.       case ConCatNd:
  871.          /*
  872.           * "Glue" for several side effects.
  873.           */
  874.          il = new_il(IL_Lst, 2);
  875.          il->u[0].fld = abstrcomp(n->u[0].child, 0, 0, 0);
  876.          il->u[1].fld = abstrcomp(n->u[1].child, 0, 0, 0);
  877.          break;
  878.       }
  879.    return il;
  880.    }
  881.  
  882. /*
  883.  * abstrsnty - do some sanity checks on how this type is being used in
  884.  *  an abstract type computation.
  885.  */
  886. static novalue abstrsnty(t, typcd, indx_stor, chng_stor)
  887. struct token *t;
  888. int typcd;
  889. int indx_stor;
  890. int chng_stor;
  891.    {
  892.    struct icon_type *itp;
  893.  
  894.    if ((typcd < 0) || (!indx_stor))
  895.       return;
  896.  
  897.    itp = &icontypes[typcd];
  898.  
  899.    /*
  900.     * This type is being used to index the store; make sure this it
  901.     *   is a variable.
  902.     */
  903.    if (itp->deref == DrfNone)
  904.       errt2(t, itp->id, " is not a variable type");
  905.  
  906.    if (chng_stor && itp->deref == DrfCnst)
  907.       errt2(t, itp->id, " has an associated type that may not be changed");
  908.    }
  909.  
  910. /*
  911.  * body_anlz - walk the syntax tree for the C code in a body statment,
  912.  *  analyzing the code to determine the interface needed by the C function 
  913.  *  which will implement it. Also determine how many buffers are needed.
  914.  *  The value returned indicates whether it is possible for execution
  915.  *  to fall through the the code.
  916.  */
  917. static int body_anlz(n, does_break, may_mod, const_cast, all)
  918. struct node *n;   /* subtree being analyzed */
  919. int *does_break;  /* output flag: subtree contains "break;" */
  920. int may_mod;      /* input flag: this subtree might be assigned to */
  921. int const_cast;   /* input flag: expression is cast to (const ...) */
  922. int all;          /* input flag: need all information about operation */
  923.    {
  924.    struct token *t;
  925.    struct node *n1, *n2, *n3;
  926.    struct sym_entry *sym;
  927.    struct var_lst *var_ref;
  928.    int break_chk = 0;
  929.    int fall_thru;
  930.    static int may_brnchto;
  931.  
  932.    if (n == NULL)
  933.       return 1; 
  934.  
  935.    t =  n->tok;
  936.  
  937.    switch (n->nd_id) {
  938.       case PrimryNd:
  939.          switch (t->tok_id) {
  940.             case Fail:
  941.                if (all)
  942.                   ret_flag |= DoesFail;
  943.                return 0;
  944.             case Errorfail:
  945.                if (all)
  946.                   ret_flag |= DoesEFail;
  947.                return 0;
  948.             case Break:
  949.                *does_break = 1;
  950.                return 0;
  951.             default: /* do nothing special */
  952.                return 1;
  953.             }
  954.       case PrefxNd:
  955.          switch (t->tok_id) {
  956.             case Return:
  957.                if (all) {
  958.                   ret_flag |= DoesRet;
  959.                   chkrettyp(n->u[0].child); /* check for returning of C value */
  960.                   }
  961.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  962.                return 0;
  963.             case Suspend:
  964.                if (all) {
  965.                   ret_flag |= DoesSusp;
  966.                   chkrettyp(n->u[0].child); /* check for returning of C value */
  967.                   }
  968.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  969.                return 1;
  970.             case '(':
  971.                /*
  972.                 * parenthesized expression: pass along may_mod and const_cast.
  973.                 */
  974.                return body_anlz(n->u[0].child, does_break, may_mod, const_cast,
  975.                   all);
  976.             case Incr: /* ++ */
  977.             case Decr: /* -- */
  978.                /*
  979.                 * Operand may be modified.
  980.                 */
  981.                body_anlz(n->u[0].child, does_break, 1, 0, all);
  982.                return 1;
  983.             case '&':
  984.                /*
  985.                 * Unless the address is cast to a const pointer, this
  986.                 *  might be a modifiying reference.
  987.                 */
  988.                if (const_cast)
  989.                   body_anlz(n->u[0].child, does_break, 0, 0, all);
  990.                else
  991.                   body_anlz(n->u[0].child, does_break, 1, 0, all);
  992.                return 1;
  993.             case Default:
  994.                fall_thru = body_anlz(n->u[0].child, does_break, 0, 0, all);
  995.                may_brnchto = 1;
  996.                return fall_thru;
  997.             case Goto:
  998.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  999.                return 0;
  1000.             default: /* unary operations the need nothing special */
  1001.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1002.                return 1;
  1003.             }
  1004.       case PstfxNd:
  1005.          if (t->tok_id == ';')
  1006.             return body_anlz(n->u[0].child, does_break, 0, 0, all);
  1007.          else {
  1008.             /*
  1009.              * C expressions: <expr> ++
  1010.              *                <expr> --
  1011.              *
  1012.              * modify operand
  1013.              */
  1014.             return body_anlz(n->u[0].child, does_break, 1, 0, all);
  1015.             }
  1016.       case PreSpcNd:
  1017.          body_anlz(n->u[0].child, does_break, 0, 0, all);
  1018.          return 1;
  1019.       case SymNd:
  1020.          /*
  1021.           * This is an identifier.
  1022.           */
  1023.          if (!all)
  1024.              return 1;
  1025.          sym = n->u[0].sym;
  1026.          if (sym->id_type == RsltLoc) {
  1027.             /*
  1028.              * Note that this body code explicitly references the result
  1029.              *  location of the operation.
  1030.              */
  1031.             rslt_loc = 1;
  1032.             }
  1033.          else if (sym->nest_lvl == 2) {
  1034.             /*
  1035.              * This variable is local to the operation, but declared outside
  1036.              *  the body. It must passed as a parameter to the function.
  1037.              *  See if it is in the parameter list yet.
  1038.              */
  1039.             if (!(sym->id_type & PrmMark)) {
  1040.                sym->id_type |= PrmMark;
  1041.                var_ref = NewStruct(var_lst);
  1042.                var_ref->sym = sym;
  1043.                var_ref->next = body_prms;
  1044.                body_prms = var_ref;
  1045.                ++n_bdy_prms;
  1046.                }
  1047.  
  1048.             /*
  1049.              *  Note if the variable might be assigned to.
  1050.              */
  1051.             sym->may_mod |= may_mod;
  1052.             }
  1053.          return 1;
  1054.       case BinryNd:
  1055.          switch (t->tok_id) {
  1056.             case '[': /* subscripting */
  1057.             case '.':
  1058.                /*
  1059.                 * Assignments will modify left operand.
  1060.                 */
  1061.                body_anlz(n->u[0].child, does_break, may_mod, 0, all);
  1062.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1063.                return 1;
  1064.             case '(':
  1065.                /*
  1066.                 * ( <type> ) expr
  1067.                 */
  1068.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1069.                /*
  1070.                 * See if the is a const cast.
  1071.                 */
  1072.                for (n1 = n->u[0].child; n1->nd_id == LstNd; n1 = n1->u[0].child)
  1073.                   ;
  1074.                if (n1->nd_id == PrimryNd && n1->tok->tok_id == Const)
  1075.                   body_anlz(n->u[1].child, does_break, 0, 1, all);
  1076.                else
  1077.                   body_anlz(n->u[1].child, does_break, 0, 0, all);
  1078.                return 1;
  1079.             case ')':
  1080.                /*
  1081.                 * function call or declaration: <expr> ( <expr-list> )
  1082.                 */
  1083.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1084.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1085.                return call_ret(n->u[0].child);
  1086.             case ':':
  1087.             case Case:
  1088.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1089.                fall_thru = body_anlz(n->u[1].child, does_break, 0, 0, all);
  1090.                may_brnchto = 1;
  1091.                return fall_thru;
  1092.             case Switch:
  1093.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1094.                fall_thru = body_anlz(n->u[1].child, &break_chk, 0, 0, all);
  1095.                return fall_thru | break_chk;
  1096.             case While: {
  1097.            struct node *n0 = n->u[0].child;
  1098.                body_anlz(n0, does_break, 0, 0, all);
  1099.                body_anlz(n->u[1].child, &break_chk, 0, 0, all);
  1100.            /*
  1101.         * check for an infinite loop, while (1) ... :
  1102.                 *  a condition consisting of an IntConst with image=="1"
  1103.                 *  and no breaks in the body.
  1104.         */
  1105.            if (n0->nd_id == PrimryNd && n0->tok->tok_id == IntConst &&
  1106.            !strcmp(n0->tok->image,"1") && !break_chk)
  1107.           return 0;
  1108.                return 1;
  1109.            }
  1110.             case Do:
  1111.                /*
  1112.                 * Any "break;" statements in the body do not effect
  1113.                 *  outer loops so pass along a new flag for does_break.
  1114.                 */
  1115.                body_anlz(n->u[0].child, &break_chk, 0, 0, all);
  1116.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1117.                return 1;
  1118.             case Runerr:
  1119.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1120.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1121.                if (all)
  1122.                   ret_flag |= DoesEFail;  /* possibler error failure */
  1123.                return 0;
  1124.             case '=':
  1125.             case MultAsgn:  /*  *=  */
  1126.             case DivAsgn:   /*  /=  */
  1127.             case ModAsgn:   /*  %=  */
  1128.             case PlusAsgn:  /*  +=  */
  1129.             case MinusAsgn: /*  -=  */
  1130.             case LShftAsgn: /* <<=  */
  1131.             case RShftAsgn: /* >>=  */
  1132.             case AndAsgn:   /*  &=  */
  1133.             case XorAsgn:   /*  ^=  */
  1134.             case OrAsgn:    /*  |=  */
  1135.                /*
  1136.                 * Left operand is modified.
  1137.                 */
  1138.                body_anlz(n->u[0].child, does_break, 1, 0, all);
  1139.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1140.                return 1;
  1141.             default: /* binary operations that need nothing special */
  1142.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1143.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1144.                return 1;
  1145.             }
  1146.       case LstNd:
  1147.       case StrDclNd:
  1148.          /*
  1149.           * Some declaration code.
  1150.           */
  1151.          body_anlz(n->u[0].child, does_break, 0, 0, all);
  1152.          body_anlz(n->u[1].child, does_break, 0, 0, all);
  1153.          return 1;
  1154.       case ConCatNd:
  1155.         /*
  1156.          * <some-code> <some-code>
  1157.          */
  1158.          if (body_anlz(n->u[0].child, does_break, 0, 0, all))
  1159.             return body_anlz(n->u[1].child, does_break, 0, 0, all);
  1160.          else {
  1161.             /*
  1162.              * Cannot directly reach the second piece of code, see if
  1163.              *  it is possible to branch into it.
  1164.              */
  1165.             may_brnchto = 0;
  1166.             fall_thru = body_anlz(n->u[1].child, does_break, 0, 0, all);
  1167.             return may_brnchto & fall_thru;
  1168.             }
  1169.       case CommaNd:
  1170.          /*
  1171.           * <expr> , <expr>
  1172.           */
  1173.          fall_thru = body_anlz(n->u[0].child, does_break, 0, 0, all);
  1174.          return fall_thru & body_anlz(n->u[1].child, does_break, 0, 0, all);
  1175.       case CompNd:
  1176.          /*
  1177.           * Compound statement, look only at executable code.
  1178.           *
  1179.           *  First traverse declaration list looking for initializers.
  1180.           */
  1181.          n1 = n->u[0].child;
  1182.          while (n1 != NULL) {
  1183.             if (n1->nd_id == LstNd) {
  1184.                n2 = n1->u[1].child;
  1185.                n1 = n1->u[0].child;
  1186.                }
  1187.             else {
  1188.                n2 = n1;
  1189.                n1 = NULL;
  1190.                }
  1191.  
  1192.             /*
  1193.              * Get declarator list from declaration and traverse it.
  1194.              */
  1195.             n2 = n2->u[1].child;
  1196.             while (n2 != NULL) {
  1197.                if (n2->nd_id == CommaNd) {
  1198.                   n3 = n2->u[1].child;
  1199.                   n2 = n2->u[0].child;
  1200.                   }
  1201.                else {
  1202.                   n3 = n2;
  1203.                   n2 = NULL;
  1204.                   }
  1205.                if (n3->nd_id == BinryNd && n3->tok->tok_id == '=')
  1206.                    body_anlz(n3->u[1].child, does_break, 0, 0, all);
  1207.                }
  1208.             }
  1209.  
  1210.          /*
  1211.           * Check initializers on tended declarations.
  1212.           */
  1213.          for (sym = n->u[1].sym; sym != NULL; sym = sym->u.tnd_var.next)
  1214.             body_anlz(sym->u.tnd_var.init, does_break, 0, 0, all);
  1215.  
  1216.          /*
  1217.           * Do the statement list.
  1218.           */
  1219.          return body_anlz(n->u[2].child, does_break, 0, 0, all);
  1220.       case TrnryNd:
  1221.          switch (t->tok_id) {
  1222.             case Cnv:
  1223.                /*
  1224.                 * extended C code: cnv: <type> ( <source> )
  1225.                 *                  cnv: <type> ( <source> , <destination> )
  1226.                 *
  1227.                 *  For some conversions, buffers may have to be allocated.
  1228.                 *  An explicit destination must be marked as modified.
  1229.                 */
  1230.                if (all)
  1231.                   cnt_bufs(n->u[0].child);
  1232.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1233.                body_anlz(n->u[2].child, does_break, 1, 0, all);
  1234.                return 1;
  1235.             case If:
  1236.                /*
  1237.                 * Execution falls through an if statement if it falls
  1238.                 *  through either branch. A null "else" branch always
  1239.                 *  falls through.
  1240.                 */
  1241.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1242.                return body_anlz(n->u[1].child, does_break, 0, 0, all) |
  1243.                   body_anlz(n->u[2].child, does_break, 0, 0, all);
  1244.             case Type_case:
  1245.                /*
  1246.                 * type_case <expr> of { <section-list> }
  1247.                 * type_case <expr> of { <section-list> <default-clause> }
  1248.                 */
  1249.  
  1250.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1251.                /*
  1252.                 * Loop through the case clauses.
  1253.                 */
  1254.                fall_thru = 0;
  1255.                for (n1 = n->u[1].child; n1 != NULL; n1 = n1->u[0].child) {
  1256.                   n2 = n1->u[1].child->u[1].child;
  1257.                   fall_thru |= body_anlz(n2, does_break, 0, 0, all);
  1258.                   }
  1259.                return fall_thru | body_anlz(n->u[2].child, does_break, 0, 0,
  1260.                   all);
  1261.             default: /* nothing special is needed for these ternary nodes */
  1262.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1263.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1264.                body_anlz(n->u[2].child, does_break, 0, 0, all);
  1265.                return 1;
  1266.                }
  1267.       case QuadNd:
  1268.          if (t->tok_id == Def) {
  1269.                /*
  1270.                 * extended C code:
  1271.                 *   def: <type> ( <source> , <default> )
  1272.                 *   def: <type> ( <source> , <default> , <destination> )
  1273.                 *
  1274.                 *  For some conversions, buffers may have to be allocated.
  1275.                 *  An explicit destination must be marked as modified.
  1276.                 */
  1277.                if (all)
  1278.                   cnt_bufs(n->u[0].child);
  1279.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1280.                body_anlz(n->u[2].child, does_break, 0, 0, all);
  1281.                body_anlz(n->u[3].child, does_break, 1, 0, all);
  1282.                return 1;
  1283.                }
  1284.           else {  /* for */
  1285.                /*
  1286.                 * Check for an infinite loop:  for (<expr>; ; <expr> ) ...
  1287.                 *
  1288.                 *  No ending condition and no breaks in the body.
  1289.                 */
  1290.                body_anlz(n->u[0].child, does_break, 0, 0, all);
  1291.                body_anlz(n->u[1].child, does_break, 0, 0, all);
  1292.                body_anlz(n->u[2].child, does_break, 0, 0, all);
  1293.                body_anlz(n->u[3].child, &break_chk, 0, 0, all);
  1294.                if (n->u[1].child == NULL && !break_chk)
  1295.                   return 0;
  1296.                else
  1297.                   return 1;
  1298.                }
  1299.       }
  1300.    err1("rtt internal error detected in function body_anlz()");
  1301.    /* NOTREACHED */
  1302.    }
  1303.  
  1304. /*
  1305.  *  lcl_tend  - allocate any tended variables needed in this body or inline
  1306.  *   statement.
  1307.  */
  1308. static novalue lcl_tend(n)
  1309. struct node *n;
  1310.    {
  1311.    struct sym_entry *sym;
  1312.  
  1313.    if (n == NULL)
  1314.       return; 
  1315.  
  1316.    /*
  1317.     * Walk the syntax tree until a block with declarations is found.
  1318.     */
  1319.    switch (n->nd_id) {
  1320.       case PrefxNd:
  1321.       case PstfxNd:
  1322.       case PreSpcNd:
  1323.         lcl_tend(n->u[0].child);
  1324.         break;
  1325.       case BinryNd:
  1326.       case LstNd:
  1327.       case ConCatNd:
  1328.       case CommaNd:
  1329.       case StrDclNd:
  1330.         lcl_tend(n->u[0].child);
  1331.         lcl_tend(n->u[1].child);
  1332.         break;
  1333.       case CompNd:
  1334.          /*
  1335.           * Allocate the tended variables in this block, noting that the
  1336.           *  level of nesting in this C function is one less than in the
  1337.           *  operation as a whole. Then mark the tended slots as free for
  1338.           *  use in the next block.
  1339.           */
  1340.          for (sym = n->u[1].sym; sym != NULL; sym = sym->u.tnd_var.next) {
  1341.             sym->t_indx = alloc_tnd(sym->id_type, sym->u.tnd_var.init,
  1342.                sym->nest_lvl - 1);
  1343.             }
  1344.          lcl_tend(n->u[2].child);
  1345.          sym = n->u[1].sym;
  1346.          if (sym != NULL)
  1347.             unuse(tend_lst, sym->nest_lvl - 1);
  1348.          break;
  1349.       case TrnryNd:
  1350.          lcl_tend(n->u[0].child);
  1351.          lcl_tend(n->u[1].child);
  1352.          lcl_tend(n->u[2].child);
  1353.          break;
  1354.       case QuadNd:
  1355.          lcl_tend(n->u[0].child);
  1356.          lcl_tend(n->u[1].child);
  1357.          lcl_tend(n->u[2].child);
  1358.          lcl_tend(n->u[3].child);
  1359.          break;
  1360.       }
  1361.    }
  1362.  
  1363. /*
  1364.  * chkrettyp - check type of return to see if it is a C integer or a
  1365.  *  C double and make note of what is found.
  1366.  */
  1367. static novalue chkrettyp(n)
  1368. struct node *n;
  1369.    {
  1370.    if (n->nd_id == PrefxNd && n->tok != NULL) {
  1371.       switch (n->tok->tok_id) {
  1372.          case C_Integer:
  1373.             body_ret |= RetInt;
  1374.             return;
  1375.          case C_Double:
  1376.             body_ret |= RetDbl;
  1377.             return;
  1378.          }
  1379.       }
  1380.    body_ret |= RetOther;
  1381.    }
  1382.  
  1383. /*
  1384.  * body_fnc - produce the function which implements a body statement.
  1385.  */
  1386. static struct il_code *body_fnc(n)
  1387. struct node *n;
  1388.    {
  1389.    struct node *compound;
  1390.    struct node *dcls;
  1391.    struct node *stmts;
  1392.    struct var_lst *var_ref;
  1393.    struct sym_entry *sym;
  1394.    struct il_code *il;
  1395.    int fall_thru;          /* flag: control can fall through end of body */
  1396.    int num_sigs;           /* number of different signals function may return */
  1397.    int bprm_indx;
  1398.    int first;
  1399.    int is_reg;
  1400.    int strct;
  1401.    int addr;
  1402.    int by_ref;
  1403.    int just_desc;
  1404.    int dummy_int;
  1405.    char buf1[6];
  1406.  
  1407.    char *cname;
  1408.  
  1409. #if MVS
  1410.    char buf1[MaxFileName];
  1411. #else
  1412.    char buf[MaxFileName];
  1413. #endif                    /* MVS */
  1414.  
  1415.    /*
  1416.     * Figure out the next character to use as the 3rd prefix for the
  1417.     *  name of this body function.
  1418.     */
  1419.    if (prfx3 == ' ')
  1420.       prfx3 = '0';
  1421.    else if (prfx3 == '9')
  1422.       prfx3 = 'a';
  1423.    else if (prfx3 == 'z')
  1424.       errt2(n->tok, "more than 26 body statements in", cur_impl->name);
  1425.    else
  1426.       ++prfx3;
  1427.  
  1428.    /*
  1429.     * Free any old body parameters and tended locations.
  1430.     */
  1431.    while (body_prms != NULL) {
  1432.       var_ref = body_prms;
  1433.       body_prms = body_prms->next;
  1434.       free((char *)var_ref);
  1435.       }
  1436.    free_tend();
  1437.  
  1438.    /*
  1439.     * Locate the outer declarations and statements from the body clause.
  1440.     */
  1441.    compound = n->u[0].child;
  1442.    dcls = compound->u[0].child;
  1443.    stmts = compound->u[2].child;
  1444.  
  1445.    /*
  1446.     * Analyze the body code to determine what the function's interface
  1447.     *  needs. body_anlz() does the work after the counters and flags
  1448.     *  are initialized.
  1449.     */
  1450.    n_tmp_str = 0;  /* number of temporary string buffers neeeded */
  1451.    n_tmp_cset = 0; /* number of temporary cset buffers needed */
  1452.    nxt_sbuf = 0;   /* next string buffer index; used in code generation */
  1453.    nxt_cbuf = 0;   /* next cset buffer index; used in code generation */
  1454.    n_bdy_prms = 0; /* number of variables needed as body function parameters */
  1455.    body_ret = 0;   /* flag: C values and/or non-C values returned */
  1456.    ret_flag = 0;   /* flag: return, suspend, fail, error fail */
  1457.    rslt_loc = 0;   /* flag: body code needs operations result location */
  1458.    fall_thru = body_anlz(compound, &dummy_int, 0, 0, 1);
  1459.    lcl_tend(n);    /* allocate tended descriptors needed */
  1460.  
  1461.  
  1462.    /*
  1463.     * Use the letter indicating operation type along with body function
  1464.     *  prefixes to construct the name of the file to hold the C code.
  1465.     */
  1466.  
  1467. #if MVS
  1468.    {
  1469.       struct fileparts *fp;
  1470.       fp = fparse(src_file_nm);
  1471.       if (*fp->member == '\0')
  1472.          sprintf(buf1, "%c#%c%c%c", lc_letter, prfx1, prfx2, prfx3);
  1473.       else
  1474.          sprintf(buf1, "%s%s.ro.c(%c#%c%c%c)", fp->dir, fp->name,
  1475.                  lc_letter, prfx1, prfx2, prfx3);
  1476.       }
  1477. #else                                   /* MVS */
  1478.    sprintf(buf1, "%c_%c%c%c", lc_letter, prfx1, prfx2, prfx3);
  1479. #endif                                  /* MVS */
  1480.  
  1481.    cname = salloc(makename(buf, SourceDir, buf1, CSuffix));
  1482.    if ((out_file = fopen(cname, "w")) == NULL)
  1483.       err2("cannot open output file ", cname);
  1484.    else
  1485.       addrmlst(cname);
  1486.       
  1487.    prologue(); /* output standard comments and preprocessor directives */
  1488.  
  1489.    /*
  1490.     * If the function produces a unique signal, the function need not actually
  1491.     *  return it, and we may be able to use the return value for something
  1492.     *  else. See if this is true.
  1493.     */
  1494.    num_sigs = 0;
  1495.    if (ret_flag & DoesRet)
  1496.       ++num_sigs;
  1497.    if (ret_flag & (DoesFail  | DoesEFail))
  1498.       ++num_sigs;
  1499.    if (ret_flag & DoesSusp)
  1500.       num_sigs += 2;    /* something > 1 (success cont. may return anything) */
  1501.    if (fall_thru) {
  1502.       ret_flag |= DoesFThru;
  1503.       ++num_sigs;
  1504.       }
  1505.  
  1506.    if (num_sigs > 1)
  1507.       fnc_ret = RetSig;  /* Function must return a signal */
  1508.    else {
  1509.       /*
  1510.        * If the body returns a C_integer or a C_double, we can make the
  1511.        *  function directly return the C value and the compiler can decide
  1512.        *  whether to construct a descriptor.
  1513.        */
  1514.       if (body_ret == RetInt || body_ret == RetDbl)
  1515.          fnc_ret = body_ret;
  1516.       else
  1517.          fnc_ret = RetNoVal; /* Function returns nothing directly */
  1518.       }
  1519.  
  1520.    /*
  1521.     * Decide whether the function needs to to be passed an explicit result
  1522.     *  location (the case where "result" is explicitly referenced is handled
  1523.     *  while analyzing the body). suspend always uses the result location.
  1524.     *  return uses the result location unless the function directly
  1525.     *  returns a C value.
  1526.     */
  1527.    if (ret_flag & DoesSusp)
  1528.       rslt_loc = 1;
  1529.    else if ((ret_flag & DoesRet) && (fnc_ret != RetInt && fnc_ret != RetDbl))
  1530.       rslt_loc = 1;
  1531.  
  1532.    /*
  1533.     * The data base entry for the call to the body function has 8 slots
  1534.     *  for standard interface information and 2 slots for each parameter.
  1535.     */
  1536.    il = new_il(IL_Call, 8 + 2 * n_bdy_prms);
  1537.    il->u[0].n = 0;         /* reserved for internal use by compiler */
  1538.    il->u[1].n = prfx3;
  1539.    il->u[2].n = fnc_ret;
  1540.    il->u[3].n = ret_flag;
  1541.    il->u[4].n = rslt_loc;
  1542.    il->u[5].n = 0;       /* number of string buffers to pass in: set below */
  1543.    il->u[6].n = 0;       /* number of cset buffers to pass in: set below */
  1544.    il->u[7].n = n_bdy_prms;
  1545.    bprm_indx = 8;
  1546.  
  1547.    /*
  1548.     * Write the C function header for the body function.
  1549.     */
  1550.    switch (fnc_ret) {
  1551.       case RetSig:
  1552.          fprintf(out_file, "int ");
  1553.          break;
  1554.       case RetInt:
  1555.          fprintf(out_file, "C_integer ");
  1556.          break;
  1557.       case RetDbl:
  1558.          fprintf(out_file, "double ");
  1559.          break;
  1560.       case RetNoVal:
  1561.          fprintf(out_file, "novalue ");
  1562.          break;
  1563.       }
  1564.    fprintf(out_file, " %c%c%c%c_%s(", uc_letter, prfx1, prfx2, prfx3,
  1565.         cur_impl->name);
  1566.    fname = cname;
  1567.    line = 7;
  1568.  
  1569.    /*
  1570.     * Write parameter list, first the parenthesized list of names. Start
  1571.     *  with names of RLT variables that must be passed in.
  1572.     */
  1573.    first = 1;
  1574.    for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
  1575.       sym = var_ref->sym;
  1576.       sym->id_type &= ~PrmMark;             /* unmark entry */
  1577.       if (first)
  1578.          first = 0;
  1579.       else
  1580.          prt_str(", ", IndentInc);
  1581.       prt_str(sym->image, IndentInc);
  1582.       }
  1583.  
  1584.    if (fall_thru) {
  1585.       /*
  1586.        * We cannot allocate string and cset buffers locally, so any
  1587.        *   that are needed must be parameters.
  1588.        */
  1589.       if (n_tmp_str > 0) {
  1590.          if (first)
  1591.             first = 0;
  1592.          else
  1593.             prt_str(", ", IndentInc);
  1594.          prt_str("r_sbuf", IndentInc);
  1595.          }
  1596.       if (n_tmp_cset > 0) {
  1597.          if (first)
  1598.             first = 0;
  1599.          else
  1600.             prt_str(", ", IndentInc);
  1601.          prt_str("r_cbuf", IndentInc);
  1602.          }
  1603.       }
  1604.  
  1605.    /*
  1606.     * If the result location is needed it is passed as the next parameter.
  1607.     */
  1608.    if (rslt_loc) {
  1609.       if (first)
  1610.          first = 0;
  1611.       else
  1612.          prt_str(", ", IndentInc);
  1613.       prt_str("r_rslt", IndentInc);
  1614.       }
  1615.  
  1616.    /*
  1617.     * If a success continuation is needed, it goes last.
  1618.     */
  1619.    if (ret_flag & DoesSusp) {
  1620.       if (!first)
  1621.          prt_str(", ", IndentInc);
  1622.       prt_str("r_s_cont", IndentInc);
  1623.       }
  1624.    prt_str(")", IndentInc);
  1625.    ForceNl();
  1626.  
  1627.    /*
  1628.     * Go through the parameters to this function writing out declarations
  1629.     *  and filling in rest of data base entry. Start with RLT variables.
  1630.     */
  1631.    for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
  1632.       /*
  1633.        * Each parameters has two slots in the data base entry. One
  1634.        *  is the declaration for use by iconc in producing function
  1635.        *  prototypes. The other is the argument that must be passed as
  1636.        *  part of the call generated by iconc.
  1637.        *
  1638.        * Determine whether the parameter is passed by reference or by
  1639.        *  value (flag by_ref). Tended variables that refer to just the
  1640.        *  vword of a descriptor require special handling. They must
  1641.        *  be passed to the body function as a pointer to the entire
  1642.        *  descriptor and not just the vword. Within the function the
  1643.        *  parameter is then accessed as x->vword... This is indicated
  1644.        *  by the parameter flag just_desc.
  1645.        */
  1646.       sym = var_ref->sym;
  1647.       var_ref->id_type = sym->id_type;      /* save old id_type */
  1648.       by_ref = 0;
  1649.       just_desc = 0;
  1650.       switch (sym->id_type) {
  1651.          case TndDesc:  /* tended struct descrip x */
  1652.             by_ref = 1;
  1653.             il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1654.             break;
  1655.          case TndStr:   /* tended char *x */
  1656.          case TndBlk:   /* tended struct b_??? *x or tended union block *x */
  1657.             by_ref = 1;
  1658.             just_desc = 1;
  1659.             il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1660.             break;
  1661.          case RtParm: /* undereferenced RTL parameter */
  1662.          case DrfPrm: /* dereferenced RTL parameter */
  1663.             switch (sym->u.param_info.cur_loc) {
  1664.                case PrmTend: /* plain parameter: descriptor */
  1665.                   by_ref = 1;
  1666.                   il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1667.                   break;
  1668.                case PrmCStr: /* parameter converted to a tended C string */
  1669.                   by_ref = 1;
  1670.                   just_desc = 1;
  1671.                   il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1672.                   break;
  1673.                case PrmInt:  /* parameter converted to a C integer */
  1674.                   sym->id_type = OtherDcl;
  1675.                   if (var_ref->sym->may_mod && fall_thru)
  1676.                      by_ref = 1;
  1677.                   il->u[bprm_indx++].c_cd = simpl_dcl("C_integer ", by_ref,
  1678.                      sym);
  1679.                   break;
  1680.                case PrmDbl: /* parameter converted to a C double */
  1681.                   sym->id_type = OtherDcl;
  1682.                   if (var_ref->sym->may_mod && fall_thru)
  1683.                      by_ref =  1;
  1684.                   il->u[bprm_indx++].c_cd = simpl_dcl("double ", by_ref, sym);
  1685.                   break;
  1686.                }
  1687.             break;
  1688.          case RtParm | VarPrm:
  1689.          case DrfPrm | VarPrm:
  1690.             /*
  1691.              * Variable part of RTL parameter list: already descriptor pointer.
  1692.              */
  1693.             sym->id_type = OtherDcl;
  1694.             il->u[bprm_indx++].c_cd = simpl_dcl("dptr ", 0, sym);
  1695.             break;
  1696.          case VArgLen:
  1697.             /*
  1698.              * Number of elements in variable part of RTL parameter list:
  1699.              *  integer but not a true variable.
  1700.              */
  1701.             sym->id_type = OtherDcl;
  1702.             il->u[bprm_indx++].c_cd = simpl_dcl("int ", 0, sym);
  1703.             break;
  1704.          case OtherDcl:
  1705.             is_reg = 0;
  1706.             /*
  1707.              * Pass by reference if it is a structure or union type (but
  1708.              *  not if it is a pointer to one) or if the variable is
  1709.              *  modified and it is possible to execute more code after the
  1710.              *  body. WARNING: crude assumptions are made for typedef
  1711.              *  types.
  1712.              */
  1713.             strct = strct_typ(sym->u.declare_var.tqual, &is_reg);
  1714.             addr = is_addr(sym->u.declare_var.dcltor, '\0');
  1715.             if ((strct && !addr) || (var_ref->sym->may_mod && fall_thru))
  1716.                   by_ref = 1;
  1717.             if (is_reg && by_ref)
  1718.               errt2(sym->u.declare_var.dcltor->u[1].child->tok, sym->image,
  1719.                  " may not be declared 'register'");
  1720.  
  1721.             il->u[bprm_indx++].c_cd = parm_dcl(by_ref, sym);
  1722.             break;
  1723.          }
  1724.  
  1725.       /*
  1726.        * Determine what the iconc generated argument in a function
  1727.        *  call should look like.
  1728.        */
  1729.       il->u[bprm_indx++].c_cd = bdy_prm(by_ref, just_desc, sym,
  1730.          var_ref->sym->may_mod);
  1731.  
  1732.       /*
  1733.        * If it a call-by-reference parameter, indicate that the level
  1734.        *  of indirection must be taken into account within the function
  1735.        *  body.
  1736.        */
  1737.       if (by_ref)
  1738.          sym->id_type |= ByRef;
  1739.       }
  1740.    
  1741.    if (fall_thru) {
  1742.       /*
  1743.        * Write declarations for any needed buffer parameters.
  1744.        */
  1745.       if (n_tmp_str > 0) {
  1746.          prt_str("char (*r_sbuf)[MaxCvtLen];", 0);
  1747.          ForceNl();
  1748.          }
  1749.       if (n_tmp_cset > 0) {
  1750.          prt_str("struct b_cset *r_cbuf;", 0);
  1751.          ForceNl();
  1752.          }
  1753.       /*
  1754.        * Indicate that buffers must be allocated by compiler and not
  1755.        *  within the function.
  1756.        */
  1757.       il->u[5].n = n_tmp_str;
  1758.       il->u[6].n = n_tmp_cset;
  1759.       n_tmp_str = 0;
  1760.       n_tmp_cset = 0;
  1761.       }
  1762.  
  1763.    /*
  1764.     * Write declarations for result location and success continuation
  1765.     *  parameters if they are needed.
  1766.     */
  1767.    if (rslt_loc) {
  1768.       prt_str("dptr r_rslt;", 0);
  1769.       ForceNl();
  1770.       }
  1771.    if (ret_flag & DoesSusp) {
  1772.       prt_str("continuation r_s_cont;", 0);
  1773.       ForceNl();
  1774.       }
  1775.  
  1776.    /*
  1777.     * Output the code for the function including ordinary declaration,
  1778.     *  special declarations, and executable code.
  1779.     */
  1780.    prt_str("{", IndentInc);
  1781.    ForceNl();
  1782.    c_walk(dcls, IndentInc, 0);
  1783.    spcl_dcls(NULL);
  1784.    c_walk(stmts, IndentInc, 0);
  1785.    ForceNl();
  1786.    /*
  1787.     * If it is possible for excution to fall through to the end of
  1788.     *  the body function, and it does so, return an A_FallThru signal.
  1789.     */
  1790.    if (fall_thru) {
  1791.       if (tend_lst != NULL) {
  1792.      prt_str("tend = tend->previous;", IndentInc);
  1793.      ForceNl();
  1794.          }
  1795.       if (fnc_ret == RetSig) {
  1796.          prt_str("return A_FallThru;", IndentInc);
  1797.          ForceNl();
  1798.          }
  1799.       }
  1800.    prt_str("}\n", IndentInc);
  1801.    if (fclose(out_file) != 0)
  1802.       err2("cannot close ", cname);
  1803.    put_c_fl(cname, 1);
  1804.  
  1805.    /*
  1806.     * Restore the symbol table to its previous state. Note any parameters
  1807.     *  that were modified by the body code.
  1808.     */
  1809.    for (var_ref = body_prms; var_ref != NULL; var_ref = var_ref->next) {
  1810.       sym = var_ref->sym;
  1811.       sym->id_type = var_ref->id_type;
  1812.       if (sym->id_type & DrfPrm)
  1813.          sym->u.param_info.parm_mod |= sym->may_mod;
  1814.       sym->may_mod = 0;
  1815.       }
  1816.  
  1817.    if (!fall_thru)
  1818.        clr_prmloc();
  1819.    return il;
  1820.    }
  1821.  
  1822. /*
  1823.  * strct_typ - determine if the declaration may be for a structured type
  1824.  *   and look for register declarations.
  1825.  */
  1826. static int strct_typ(typ, is_reg)
  1827. struct node *typ;
  1828. int *is_reg;
  1829.    {
  1830.    if (typ->nd_id == LstNd) {
  1831.       return strct_typ(typ->u[0].child, is_reg) |
  1832.          strct_typ(typ->u[1].child, is_reg);
  1833.       }
  1834.    else if (typ->nd_id == PrimryNd) {
  1835.       switch (typ->tok->tok_id) {
  1836.          case Typedef:
  1837.          case Extern:
  1838.             errt2(typ->tok, "declare {...} should not contain ",
  1839.                typ->tok->image);
  1840.          case Register:
  1841.             *is_reg = 1;
  1842.             return 0;
  1843.          case TypeDefName:
  1844.             if (strcmp(typ->tok->image, "word")  == 0 ||
  1845.                 strcmp(typ->tok->image, "uword") == 0 ||
  1846.                 strcmp(typ->tok->image, "dptr")  == 0)
  1847.                return 0;   /* assume non-structure type */
  1848.             else
  1849.                return 1;   /* might be a structure (is not C_integer) */
  1850.          default:
  1851.             return 0;
  1852.          }
  1853.       }
  1854.    else {
  1855.       /*
  1856.        * struct, union, or enum.
  1857.        */
  1858.       return 1;
  1859.       }
  1860.    }
  1861.  
  1862. /*
  1863.  * determine if the variable being declared evaluates to an address.
  1864.  */
  1865. static int is_addr(dcltor, modifier)
  1866. struct node *dcltor;
  1867. int modifier;
  1868.    {
  1869.    switch (dcltor->nd_id) {
  1870.       case ConCatNd:
  1871.          /*
  1872.           * pointer?
  1873.           */
  1874.          if (dcltor->u[0].child != NULL)
  1875.             modifier = '*';
  1876.          return is_addr(dcltor->u[1].child, modifier);
  1877.       case PrimryNd:
  1878.          /*
  1879.           * We have reached the name.
  1880.           */
  1881.          switch (modifier) {
  1882.             case '\0':
  1883.                return 0;
  1884.             case '*':
  1885.             case '[':
  1886.                return 1;
  1887.             case ')':
  1888.                errt1(dcltor->tok,
  1889.                   "declare {...} should not contain a prototype");
  1890.             }
  1891.       case PrefxNd:
  1892.          /*
  1893.           * (...)
  1894.           */
  1895.          return is_addr(dcltor->u[0].child, modifier);
  1896.       case BinryNd:
  1897.          /*
  1898.           * function or array.
  1899.           */
  1900.          return is_addr(dcltor->u[0].child, dcltor->tok->tok_id);
  1901.       }
  1902.    err1("rtt internal error detected in function is_addr()");
  1903.    /* NOTREACHED */
  1904.    }
  1905.  
  1906. /*
  1907.  * chgn_ploc - if this is an "in-place" conversion to a C value, change
  1908.  *  the "location" of the parameter being converted.
  1909.  */
  1910. static novalue chng_ploc(typcd, src)
  1911. int typcd;
  1912. struct node *src;
  1913.    {
  1914.    int loc;
  1915.  
  1916.    /*
  1917.     * Note, we know this is a valid conversion, because it got through
  1918.     *  pass 1.
  1919.     */
  1920.    loc = PrmTend;
  1921.    switch (typcd) {
  1922.       case TypCInt:
  1923.       case TypECInt:
  1924.          loc = PrmInt;
  1925.          break;
  1926.       case TypCDbl:
  1927.          loc = PrmDbl;
  1928.          break;
  1929.       case TypCStr:
  1930.          loc = PrmCStr;
  1931.          break;
  1932.       }
  1933.    if (loc != PrmTend)
  1934.       src->u[0].sym->u.param_info.cur_loc = loc;
  1935.    }
  1936.  
  1937. /*
  1938.  * cnt_bufs - See if we need to allocate a string or cset buffer for
  1939.  *  this conversion.
  1940.  */
  1941. static novalue cnt_bufs(cnv_typ)
  1942. struct node *cnv_typ;
  1943.    {
  1944.    if (cnv_typ->nd_id == PrimryNd)
  1945.       switch (cnv_typ->tok->tok_id) {
  1946.          case Tmp_string:
  1947.             ++n_tmp_str;
  1948.             break;
  1949.          case Tmp_cset:
  1950.             ++n_tmp_cset;
  1951.             break;
  1952.          }
  1953.    }
  1954.  
  1955. /*
  1956.  * mrg_abstr - merge (join) types of abstract returns on two execution paths.
  1957.  *   The type lattice has three levels: NoAbstr is bottom, SomeType is top,
  1958.  *   and individual types form the middle level.
  1959.  */
  1960. static int mrg_abstr(sum, typ)
  1961. int sum;
  1962. int typ;
  1963.    {
  1964.    if (sum == NoAbstr)
  1965.       return typ;
  1966.    else if (typ == NoAbstr)
  1967.       return sum;
  1968.    else if (sum == typ)
  1969.       return sum;
  1970.    else
  1971.       return SomeType;
  1972.    }
  1973. #endif                    /* Rttx */
  1974.