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 / iconc / ctree.c < prev    next >
C/C++ Source or Header  |  1996-03-22  |  18KB  |  778 lines

  1. /*
  2.  * ctree.c -- functions for constructing parse trees.
  3.  */
  4. #include "::h:gsupport.h"
  5. #include "::h:lexdef.h"
  6. #include "ctrans.h"
  7. #include "ctree.h"
  8. #include "csym.h"
  9. #include "ctoken.h"
  10. #include "ccode.h"
  11. #include "cproto.h"
  12.  
  13. /*
  14.  * prototypes for static functions.
  15.  */
  16. hidden nodeptr chk_empty Params((nodeptr n));
  17. hidden novalue put_elms  Params((nodeptr t, nodeptr args, int slot));
  18. hidden nodeptr subsc_nd  Params((nodeptr op, nodeptr arg1, nodeptr arg2));
  19.  
  20. /*
  21.  *  tree[1-6] construct parse tree nodes with specified values.
  22.  *   loc_model is a node containing the same line and column information
  23.  *   as is needed in this node, while parameters a through d are values to
  24.  *   be assigned to n_field[0-3]. Note that this could be done with a
  25.  *   single routine; a separate routine for each node size is used for
  26.  *   speed and simplicity.
  27.  */
  28.  
  29. nodeptr tree1(type)
  30. int type;
  31.    {
  32.    register nodeptr t;
  33.  
  34.    t = NewNode(0);
  35.    t->n_type = type;
  36.    t->n_file = NULL;
  37.    t->n_line = 0;
  38.    t->n_col = 0;
  39.    t->freetmp = NULL;
  40.    return t;
  41.    }
  42.  
  43. nodeptr tree2(type, loc_model)
  44. int type;
  45. nodeptr loc_model;
  46.    {
  47.    register nodeptr t;
  48.  
  49.    t = NewNode(0);
  50.    t->n_type = type;
  51.    t->n_file = loc_model->n_file;
  52.    t->n_line = loc_model->n_line;
  53.    t->n_col = loc_model->n_col;
  54.    t->freetmp = NULL;
  55.    return t;
  56.    }
  57.  
  58. nodeptr tree3(type, loc_model, a)
  59. int type;
  60. nodeptr loc_model;
  61. nodeptr a;
  62.    {
  63.    register nodeptr t;
  64.  
  65.    t = NewNode(1);
  66.    t->n_type = type;
  67.    t->n_file = loc_model->n_file;
  68.    t->n_line = loc_model->n_line;
  69.    t->n_col = loc_model->n_col;
  70.    t->freetmp = NULL;
  71.    t->n_field[0].n_ptr = a;
  72.    return t;
  73.    }
  74.  
  75. nodeptr tree4(type, loc_model, a, b)
  76. int type;
  77. nodeptr loc_model;
  78. nodeptr a, b;
  79.    {
  80.    register nodeptr t;
  81.  
  82.    t = NewNode(2);
  83.    t->n_type = type;
  84.    t->n_file = loc_model->n_file;
  85.    t->n_line = loc_model->n_line;
  86.    t->n_col = loc_model->n_col;
  87.    t->freetmp = NULL;
  88.    t->n_field[0].n_ptr = a;
  89.    t->n_field[1].n_ptr = b;
  90.    return t;
  91.    }
  92.  
  93. nodeptr tree5(type, loc_model, a, b, c)
  94. int type;
  95. nodeptr loc_model;
  96. nodeptr a, b, c;
  97.    {
  98.    register nodeptr t;
  99.  
  100.    t = NewNode(3);
  101.    t->n_type = type;
  102.    t->n_file = loc_model->n_file;
  103.    t->n_line = loc_model->n_line;
  104.    t->n_col = loc_model->n_col;
  105.    t->freetmp = NULL;
  106.    t->n_field[0].n_ptr = a;
  107.    t->n_field[1].n_ptr = b;
  108.    t->n_field[2].n_ptr = c;
  109.    return t;
  110.    }
  111.  
  112. nodeptr tree6(type, loc_model, a, b, c, d)
  113. int type;
  114. nodeptr loc_model;
  115. nodeptr a, b, c, d;
  116.    {
  117.    register nodeptr t;
  118.  
  119.    t = NewNode(4);
  120.    t->n_type = type;
  121.    t->n_file = loc_model->n_file;
  122.    t->n_line = loc_model->n_line;
  123.    t->n_col = loc_model->n_col;
  124.    t->freetmp = NULL;
  125.    t->n_field[0].n_ptr = a;
  126.    t->n_field[1].n_ptr = b;
  127.    t->n_field[2].n_ptr = c;
  128.    t->n_field[3].n_ptr = d;
  129.    return t;
  130.    }
  131.  
  132. nodeptr int_leaf(type, loc_model, a)
  133. int type;
  134. nodeptr loc_model;
  135. int a;
  136.    {
  137.    register nodeptr t;
  138.  
  139.    t = NewNode(1);
  140.    t->n_type = type;
  141.    t->n_file = loc_model->n_file;
  142.    t->n_line = loc_model->n_line;
  143.    t->n_col = loc_model->n_col;
  144.    t->freetmp = NULL;
  145.    t->n_field[0].n_val = a;
  146.    return t;
  147.    }
  148.  
  149. nodeptr c_str_leaf(type, loc_model, a)
  150. int type;
  151. nodeptr loc_model;
  152. char *a;
  153.    {
  154.    register nodeptr t;
  155.  
  156.    t = NewNode(1);
  157.    t->n_type = type;
  158.    t->n_file = loc_model->n_file;
  159.    t->n_line = loc_model->n_line;
  160.    t->n_col = loc_model->n_col;
  161.    t->freetmp = NULL;
  162.    t->n_field[0].n_str = a;
  163.    return t;
  164.    }
  165.  
  166. /*
  167.  * i_str_leaf - create a leaf node containing a string and length.
  168.  */
  169. nodeptr i_str_leaf(type, loc_model, a, b)
  170. int type;
  171. nodeptr loc_model;
  172. char *a;
  173. int b;
  174.    {
  175.    register nodeptr t;
  176.  
  177.    t = NewNode(2);
  178.    t->n_type = type;
  179.    t->n_file = loc_model->n_file;
  180.    t->n_line = loc_model->n_line;
  181.    t->n_col = loc_model->n_col;
  182.    t->freetmp = NULL;
  183.    t->n_field[0].n_str = a;
  184.    t->n_field[1].n_val = b;
  185.    return t;
  186.    }
  187.  
  188. /*
  189.  * key_leaf - create a leaf node for a keyword.
  190.  */
  191. nodeptr key_leaf(loc_model, keyname)
  192. nodeptr loc_model;
  193. char *keyname;
  194.    {
  195.    register nodeptr t;
  196.    struct implement *ip;
  197.    struct il_code *il;
  198.    char *s;
  199.    int typcd;
  200.  
  201.    /*
  202.     * Find the data base entry for the keyword, if it exists.
  203.     */
  204.    ip = db_ilkup(keyname, khash);
  205.  
  206.    if (ip == NULL)
  207.       tfatal("invalid keyword", keyname);
  208.    else if (ip->in_line == NULL)
  209.       tfatal("keyword not installed", keyname);
  210.    else {
  211.       il = ip->in_line;
  212.       s = il->u[1].s;
  213.       if (il->il_type == IL_Const) {
  214.         /*
  215.          * This is a constant keyword, treat it as a literal.
  216.          */
  217.         t = NewNode(1);
  218.         t->n_file = loc_model->n_file;
  219.         t->n_line = loc_model->n_line;
  220.         t->n_col = loc_model->n_col;
  221.         t->freetmp = NULL;
  222.         typcd = il->u[0].n;
  223.         if (typcd == cset_typ) {
  224.            t->n_type =  N_Cset;
  225.            CSym0(t) = putlit(&s[1], F_CsetLit, strlen(s) - 2);
  226.            }
  227.         else if (typcd == int_typ) {
  228.            t->n_type = N_Int;
  229.            CSym0(t) = putlit(s, F_IntLit, 0);
  230.            }
  231.         else if (typcd == real_typ) {
  232.            t->n_type = N_Real;
  233.            CSym0(t) = putlit(s, F_RealLit, 0);
  234.            }
  235.         else if (typcd == str_typ) {
  236.            t->n_type = N_Str;
  237.            CSym0(t) = putlit(&s[1], F_StrLit, strlen(s) - 2);
  238.            }
  239.         return t;
  240.         }
  241.      }
  242.  
  243.    t = NewNode(2);
  244.    t->n_type = N_InvOp;
  245.    t->n_file = loc_model->n_file;
  246.    t->n_line = loc_model->n_line;
  247.    t->n_col = loc_model->n_col;
  248.    t->freetmp = NULL;
  249.    t->n_field[0].n_val = 0;      /* number of arguments */
  250.    t->n_field[1].ip = ip;
  251.    return t;
  252.    }
  253.  
  254. /*
  255.  * list_nd - create a list creation node.
  256.  */
  257. nodeptr list_nd(loc_model, args)
  258. nodeptr loc_model;
  259. nodeptr args;
  260.    {
  261.    register nodeptr t;
  262.    struct implement *impl;
  263.    int nargs;
  264.  
  265.    /*
  266.     * Determine the number of arguments.
  267.     */
  268.    if (args->n_type == N_Empty)
  269.       nargs = 0;
  270.    else {
  271.       nargs = 1;
  272.       for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
  273.          ++nargs;
  274.       if (nargs > max_prm)
  275.          max_prm = nargs;
  276.       }
  277.  
  278.    impl = spec_op[ListOp];
  279.    if (impl == NULL)
  280.       nfatal(loc_model, "list creation not implemented", NULL);
  281.    else if (impl->in_line == NULL)
  282.       nfatal(loc_model, "list creation not installed", NULL);
  283.  
  284.    t = NewNode(nargs + 2);
  285.    t->n_type = N_InvOp;
  286.    t->n_file = loc_model->n_file;
  287.    t->n_line = loc_model->n_line;
  288.    t->n_col = loc_model->n_col;
  289.    t->freetmp = NULL;
  290.    t->n_field[0].n_val = nargs;
  291.    t->n_field[1].ip = impl;
  292.    if (nargs > 0)
  293.       put_elms(t, args, nargs + 1);
  294.    return t;
  295.    }
  296.  
  297. /*
  298.  * invk_nd - create a node for invocation.
  299.  */
  300. nodeptr invk_nd(loc_model, proc, args)
  301. nodeptr loc_model;
  302. nodeptr proc;
  303. nodeptr args;
  304.    {
  305.    register nodeptr t;
  306.    int nargs;
  307.  
  308.    /*
  309.     * Determine the number of arguments.
  310.     */
  311.    if (args->n_type == N_Empty)
  312.       nargs = 0;
  313.    else {
  314.       nargs = 1;
  315.       for (t = args; t->n_type == N_Elist; t = t->n_field[0].n_ptr)
  316.          ++nargs;
  317.       if (nargs > max_prm)
  318.          max_prm = nargs;
  319.       }
  320.  
  321.    t = NewNode(nargs + 2);
  322.    t->n_type = N_Invok;
  323.    t->n_file = loc_model->n_file;
  324.    t->n_line = loc_model->n_line;
  325.    t->n_col = loc_model->n_col;
  326.    t->freetmp = NULL;
  327.    t->n_field[0].n_val = nargs;
  328.    t->n_field[1].n_ptr = proc;
  329.    if (nargs > 0)
  330.       put_elms(t, args, nargs + 1);
  331.    return t;
  332.    }
  333.  
  334. /*
  335.  * put_elms - convert a linked list of arguments into an array of arguments
  336.  *  in a node.
  337.  */
  338. static novalue put_elms(t, args, slot)
  339. nodeptr t;
  340. nodeptr args;
  341. int slot;
  342.    {
  343.    if (args->n_type == N_Elist) {
  344.       /*
  345.        * The linked list is in reverse argument order.
  346.        */
  347.       t->n_field[slot].n_ptr = chk_empty(args->n_field[1].n_ptr);
  348.       put_elms(t, args->n_field[0].n_ptr, slot - 1);
  349.       free(args);
  350.       }
  351.    else
  352.       t->n_field[slot].n_ptr = chk_empty(args);
  353.    }
  354.  
  355. /*
  356.  * chk_empty - if an argument is empty, replace it with &null.
  357.  */
  358. static nodeptr chk_empty(n)
  359. nodeptr n;
  360.    {
  361.    if (n->n_type == N_Empty)
  362.       n = key_leaf(n, spec_str("null"));
  363.    return n;
  364.    }
  365.  
  366. /*
  367.  * case_nd - create a node for a case statement.
  368.  */
  369. nodeptr case_nd(loc_model, expr, cases)
  370. nodeptr loc_model;
  371. nodeptr expr;
  372. nodeptr cases;
  373.    {
  374.    register nodeptr t;
  375.    nodeptr reverse;
  376.    nodeptr nxt_cases;
  377.    nodeptr ccls;
  378.  
  379.    t = NewNode(3);
  380.    t->n_type = N_Case;
  381.    t->n_file = loc_model->n_file;
  382.    t->n_line = loc_model->n_line;
  383.    t->n_col = loc_model->n_col;
  384.    t->freetmp = NULL;
  385.    t->n_field[0].n_ptr = expr;
  386.    t->n_field[2].n_ptr = NULL;
  387.  
  388.    /*
  389.     * The list of cases is in reverse order. Walk the list reversing it,
  390.     *  and extract the default clause if one exists.
  391.     */
  392.    reverse = NULL;
  393.    while (cases->n_type != N_Ccls) {
  394.       nxt_cases = cases->n_field[0].n_ptr;
  395.       ccls = cases->n_field[1].n_ptr;
  396.       if (ccls->n_field[0].n_ptr->n_type == N_Res) {
  397.          /*
  398.           * default clause.
  399.           */
  400.          if (t->n_field[2].n_ptr == NULL)
  401.             t->n_field[2].n_ptr = ccls->n_field[1].n_ptr;
  402.          else
  403.             nfatal(ccls, "duplicate default clause", NULL);
  404.          }
  405.        else {
  406.           if (reverse == NULL) {
  407.              reverse = cases;
  408.              reverse->n_field[0].n_ptr = ccls;
  409.              }
  410.           else {
  411.              reverse->n_field[1].n_ptr = ccls;
  412.              cases->n_field[0].n_ptr = reverse;
  413.              reverse = cases;
  414.              }
  415.          }
  416.       cases = nxt_cases;
  417.       }
  418.  
  419.    /*
  420.     * Last element in list.
  421.     */
  422.    if (cases->n_field[0].n_ptr->n_type == N_Res) {
  423.       /*
  424.        * default clause.
  425.        */
  426.       if (t->n_field[2].n_ptr == NULL)
  427.          t->n_field[2].n_ptr = cases->n_field[1].n_ptr;
  428.       else
  429.          nfatal(ccls, "duplicate default clause", NULL);
  430.       if (reverse != NULL)
  431.          reverse = reverse->n_field[0].n_ptr;
  432.       }
  433.    else {
  434.       if (reverse == NULL)
  435.          reverse = cases;
  436.       else
  437.          reverse->n_field[1].n_ptr = cases;
  438.       }
  439.    t->n_field[1].n_ptr = reverse;
  440.    return t;
  441.    }
  442.  
  443. /*
  444.  * multiunary - construct nodes to implement a sequence of unary operators
  445.  *  that have been lexically analyzed as one operator.
  446.  */
  447. nodeptr multiunary(op, loc_model, oprnd)
  448. nodeptr loc_model;
  449. char *op;
  450. nodeptr oprnd;
  451.    {
  452.    int n;
  453.    nodeptr nd;
  454.  
  455.    if (*op == '\0')
  456.      return oprnd;
  457.    for (n = 0; optab[n].tok.t_word != NULL; ++n)
  458.       if ((optab[n].expected & Unary) & (*(optab[n].tok.t_word) == *op)) {
  459.          nd = OpNode(n);
  460.          nd->n_file = loc_model->n_file;
  461.          nd->n_line = loc_model->n_line;
  462.          nd->n_col = loc_model->n_col;
  463.          return unary_nd(nd,multiunary(++op,loc_model,oprnd));
  464.          }
  465.    fprintf(stderr, "compiler error: inconsistent parsing of unary operators");
  466.    exit(ErrorExit);
  467.    }
  468.  
  469. /*
  470.  * binary_nd - construct a node for a binary operator.
  471.  */
  472. nodeptr binary_nd(op, arg1, arg2)
  473. nodeptr op;
  474. nodeptr arg1;
  475. nodeptr arg2;
  476.    {
  477.    register nodeptr t;
  478.    struct implement *impl;
  479.  
  480.    /*
  481.     * Find the data base entry for the operator.
  482.     */
  483.    impl = optab[Val0(op)].binary;
  484.    if (impl == NULL)
  485.       nfatal(op, "binary operator not implemented", optab[Val0(op)].tok.t_word);
  486.    else if (impl->in_line == NULL)
  487.       nfatal(op, "binary operator not installed", optab[Val0(op)].tok.t_word);
  488.  
  489.    t = NewNode(4);
  490.    t->n_type = N_InvOp;
  491.    t->n_file = op->n_file;
  492.    t->n_line = op->n_line;
  493.    t->n_col = op->n_col;
  494.    t->freetmp = NULL;
  495.    t->n_field[0].n_val = 2;      /* number of arguments */
  496.    t->n_field[1].ip = impl;
  497.    t->n_field[2].n_ptr = arg1;
  498.    t->n_field[3].n_ptr = arg2;
  499.    return t;
  500.    }
  501.  
  502. /*
  503.  * unary_nd - construct a node for a unary operator.
  504.  */
  505. nodeptr unary_nd(op, arg)
  506. nodeptr op;
  507. nodeptr arg;
  508.    {
  509.    register nodeptr t;
  510.    struct implement *impl;
  511.  
  512.    /*
  513.     * Find the data base entry for the operator.
  514.     */
  515.    impl = optab[Val0(op)].unary;
  516.    if (impl == NULL)
  517.       nfatal(op, "unary operator not implemented", optab[Val0(op)].tok.t_word);
  518.    else if (impl->in_line == NULL)
  519.       nfatal(op, "unary operator not installed", optab[Val0(op)].tok.t_word);
  520.  
  521.    t = NewNode(3);
  522.    t->n_type = N_InvOp;
  523.    t->n_file = op->n_file;
  524.    t->n_line = op->n_line;
  525.    t->n_col = op->n_col;
  526.    t->freetmp = NULL;
  527.    t->n_field[0].n_val = 1;      /* number of arguments */
  528.    t->n_field[1].ip = impl;
  529.    t->n_field[2].n_ptr = arg;
  530.    return t;
  531.    }
  532.  
  533. /*
  534.  * buildarray - convert "multi-dimensional" subscripting into a sequence
  535.  *  of subsripting operations.
  536.  */
  537. nodeptr buildarray(a,lb,e)
  538. nodeptr a, lb, e;
  539.    {
  540.    register nodeptr t, t2;
  541.    if (e->n_type == N_Elist) {
  542.       t2 = int_leaf(lb->n_type, lb, lb->n_field[0].n_val);
  543.       t = subsc_nd(t2, buildarray(a,lb,e->n_field[0].n_ptr),
  544.          e->n_field[1].n_ptr);
  545.       free(e);
  546.       }
  547.    else
  548.       t = subsc_nd(lb, a, e);
  549.    return t;
  550.    }
  551.  
  552. /*
  553.  * subsc_nd - construct a node for subscripting.
  554.  */
  555. static nodeptr subsc_nd(op, arg1, arg2)
  556. nodeptr op;
  557. nodeptr arg1;
  558. nodeptr arg2;
  559.    {
  560.    register nodeptr t;
  561.    struct implement *impl;
  562.  
  563.    /*
  564.     * Find the data base entry for subscripting.
  565.     */
  566.    impl = spec_op[SubscOp];
  567.    if (impl == NULL)
  568.       nfatal(op, "subscripting not implemented", NULL);
  569.    else if (impl->in_line == NULL)
  570.       nfatal(op, "subscripting not installed", NULL);
  571.  
  572.    t = NewNode(4);
  573.    t->n_type = N_InvOp;
  574.    t->n_file = op->n_file;
  575.    t->n_line = op->n_line;
  576.    t->n_col = op->n_col;
  577.    t->freetmp = NULL;
  578.    t->n_field[0].n_val = 2;      /* number of arguments */
  579.    t->n_field[1].ip = impl;
  580.    t->n_field[2].n_ptr = arg1;
  581.    t->n_field[3].n_ptr = arg2;
  582.    return t;
  583.    }
  584.  
  585. /*
  586.  * to_nd - construct a node for binary to.
  587.  */
  588. nodeptr to_nd(op, arg1, arg2)
  589. nodeptr op;
  590. nodeptr arg1;
  591. nodeptr arg2;
  592.    {
  593.    register nodeptr t;
  594.    struct implement *impl;
  595.  
  596.    /*
  597.     * Find the data base entry for to.
  598.     */
  599.    impl = spec_op[ToOp];
  600.    if (impl == NULL)
  601.       nfatal(op, "'i to j' not implemented", NULL);
  602.    else if (impl->in_line == NULL)
  603.       nfatal(op, "'i to j' not installed", NULL);
  604.  
  605.    t = NewNode(4);
  606.    t->n_type = N_InvOp;
  607.    t->n_file = op->n_file;
  608.    t->n_line = op->n_line;
  609.    t->n_col = op->n_col;
  610.    t->freetmp = NULL;
  611.    t->n_field[0].n_val = 2;      /* number of arguments */
  612.    t->n_field[1].ip = impl;
  613.    t->n_field[2].n_ptr = arg1;
  614.    t->n_field[3].n_ptr = arg2;
  615.    return t;
  616.    }
  617.  
  618. /*
  619.  * toby_nd - construct a node for binary to-by.
  620.  */
  621. nodeptr toby_nd(op, arg1, arg2, arg3)
  622. nodeptr op;
  623. nodeptr arg1;
  624. nodeptr arg2;
  625. nodeptr arg3;
  626.    {
  627.    register nodeptr t;
  628.    struct implement *impl;
  629.  
  630.    /*
  631.     * Find the data base entry for to-by.
  632.     */
  633.    impl = spec_op[ToByOp];
  634.    if (impl == NULL)
  635.       nfatal(op, "'i to j by k' not implemented", NULL);
  636.    else if (impl->in_line == NULL)
  637.       nfatal(op, "'i to j by k' not installed", NULL);
  638.  
  639.    t = NewNode(5);
  640.    t->n_type = N_InvOp;
  641.    t->n_file = op->n_file;
  642.    t->n_line = op->n_line;
  643.    t->n_col = op->n_col;
  644.    t->freetmp = NULL;
  645.    t->n_field[0].n_val = 3;      /* number of arguments */
  646.    t->n_field[1].ip = impl;
  647.    t->n_field[2].n_ptr = arg1;
  648.    t->n_field[3].n_ptr = arg2;
  649.    t->n_field[4].n_ptr = arg3;
  650.    return t;
  651.    }
  652.  
  653. /*
  654.  * aug_nd - create a node for an augmented assignment.
  655.  */
  656. nodeptr aug_nd(op, arg1, arg2)
  657. nodeptr op;
  658. nodeptr arg1;
  659. nodeptr arg2;
  660.    {
  661.    register nodeptr t;
  662.    struct implement *impl;
  663.  
  664.    t = NewNode(5);
  665.    t->n_type = N_Augop;
  666.    t->n_file = op->n_file;
  667.    t->n_line = op->n_line;
  668.    t->n_col = op->n_col;
  669.    t->freetmp = NULL;
  670.  
  671.    /*
  672.     * Find the data base entry for assignment.
  673.     */
  674.    impl = optab[asgn_loc].binary;
  675.    if (impl == NULL)
  676.       nfatal(op, "assignment not implemented", NULL);
  677.    t->n_field[0].ip = impl;
  678.  
  679.    /*
  680.     * The operator table entry for the augmented assignment is
  681.     *  immediately after the entry for the operation.
  682.     */
  683.    impl = optab[Val0(op) - 1].binary;
  684.    if (impl == NULL)
  685.       nfatal(op, "binary operator not implemented",
  686.          optab[Val0(op) - 1].tok.t_word);
  687.    t->n_field[1].ip = impl;
  688.  
  689.    t->n_field[2].n_ptr = arg1;
  690.    t->n_field[3].n_ptr = arg2;
  691.    /* t->n_field[4].typ - type of intermediate result */
  692.    return t;
  693.    }
  694.  
  695. /*
  696.  * sect_nd - create a node for sectioning.
  697.  */
  698. nodeptr sect_nd(op, arg1, arg2, arg3)
  699. nodeptr op;
  700. nodeptr arg1;
  701. nodeptr arg2;
  702. nodeptr arg3;
  703.    {
  704.    register nodeptr t;
  705.    int tok;
  706.    struct implement *impl;
  707.    struct implement *impl1;
  708.  
  709.    t = NewNode(5);
  710.    t->n_file = op->n_file;
  711.    t->n_line = op->n_line;
  712.    t->n_col = op->n_col;
  713.    t->freetmp = NULL;
  714.  
  715.    /*
  716.     * Find the data base entry for sectioning.
  717.     */
  718.    impl = spec_op[SectOp];
  719.    if (impl == NULL)
  720.       nfatal(op, "sectioning not implemented", NULL);
  721.  
  722.    tok = optab[Val0(op)].tok.t_type;
  723.    if (tok == COLON) {
  724.       /*
  725.        * Simple sectioning, treat as a ternary operator.
  726.        */
  727.       t->n_type = N_InvOp;
  728.       t->n_field[0].n_val = 3;      /* number of arguments */
  729.       t->n_field[1].ip = impl;
  730.       }
  731.    else {
  732.       /*
  733.        * Find the data base entry for addition or subtraction.
  734.        */
  735.       if (tok == PCOLON) {
  736.          impl1 = optab[plus_loc].binary;
  737.          if (impl1 == NULL)
  738.             nfatal(op, "addition not implemented", NULL);
  739.          }
  740.       else { /* MCOLON */
  741.          impl1 = optab[minus_loc].binary;
  742.          if (impl1 == NULL)
  743.             nfatal(op, "subtraction not implemented", NULL);
  744.          }
  745.       t->n_type = N_Sect;
  746.       t->n_field[0].ip = impl;
  747.       t->n_field[1].ip = impl1;
  748.       }
  749.    t->n_field[2].n_ptr = arg1;
  750.    t->n_field[3].n_ptr = arg2;
  751.    t->n_field[4].n_ptr = arg3;
  752.    return t;
  753.    }
  754.  
  755. /*
  756.  * invk_main - produce an procedure invocation node with one argument for
  757.  *  use in the initial invocation to main() during type inference.
  758.  */
  759. nodeptr invk_main(main_proc)
  760. struct pentry *main_proc;
  761.    {
  762.    register nodeptr t;
  763.  
  764.    t = NewNode(3);
  765.    t->n_type = N_InvProc;
  766.    t->n_file = NULL; 
  767.    t->n_line = 0;
  768.    t->n_col = 0;
  769.    t->freetmp = NULL;
  770.    t->n_field[0].n_val = 1;               /* 1 argument */
  771.    t->n_field[1].proc = main_proc;
  772.    t->n_field[2].n_ptr = tree1(N_Empty);
  773.  
  774.    if (max_prm < 1)
  775.       max_prm = 1;
  776.    return t;
  777.    }
  778.