home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / pascal / src / rval.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-16  |  31.6 KB  |  1,276 lines
  1. /*-
  2.  * Copyright (c) 1980 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * Redistribution and use in source and binary forms, with or without
  6.  * modification, are permitted provided that the following conditions
  7.  * are met:
  8.  * 1. Redistributions of source code must retain the above copyright
  9.  *    notice, this list of conditions and the following disclaimer.
  10.  * 2. Redistributions in binary form must reproduce the above copyright
  11.  *    notice, this list of conditions and the following disclaimer in the
  12.  *    documentation and/or other materials provided with the distribution.
  13.  * 3. All advertising materials mentioning features or use of this software
  14.  *    must display the following acknowledgement:
  15.  *    This product includes software developed by the University of
  16.  *    California, Berkeley and its contributors.
  17.  * 4. Neither the name of the University nor the names of its contributors
  18.  *    may be used to endorse or promote products derived from this software
  19.  *    without specific prior written permission.
  20.  *
  21.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  22.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  23.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  24.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  25.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  26.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  27.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  30.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  31.  * SUCH DAMAGE.
  32.  */
  33.  
  34. #ifndef lint
  35. static char sccsid[] = "@(#)rval.c    5.3 (Berkeley) 4/16/91";
  36. #endif /* not lint */
  37.  
  38. #include "whoami.h"
  39. #include "0.h"
  40. #include "tree.h"
  41. #include "opcode.h"
  42. #include "objfmt.h"
  43. #ifdef PC
  44. #   include    "pc.h"
  45. #   include <pcc.h>
  46. #endif PC
  47. #include "tmps.h"
  48. #include "tree_ty.h"
  49.  
  50. extern    char *opnames[];
  51.  
  52.     /* line number of the last record comparison warning */
  53. short reccompline = 0;
  54.     /* line number of the last non-standard set comparison */
  55. short nssetline = 0;
  56.  
  57. #ifdef PC
  58.     char    *relts[] =  {
  59.                 "_RELEQ" , "_RELNE" ,
  60.                 "_RELTLT" , "_RELTGT" ,
  61.                 "_RELTLE" , "_RELTGE"
  62.                 };
  63.     char    *relss[] =  {
  64.                 "_RELEQ" , "_RELNE" ,
  65.                 "_RELSLT" , "_RELSGT" ,
  66.                 "_RELSLE" , "_RELSGE"
  67.                 };
  68.     long    relops[] =  {    
  69.                 PCC_EQ , PCC_NE ,
  70.                 PCC_LT , PCC_GT ,
  71.                 PCC_LE , PCC_GE 
  72.                 };
  73.     long    mathop[] =  {    PCC_MUL , PCC_PLUS , PCC_MINUS };
  74.     char    *setop[] =  {    "_MULT" , "_ADDT" , "_SUBT" };
  75. #endif PC
  76. /*
  77.  * Rvalue - an expression.
  78.  *
  79.  * Contype is the type that the caller would prefer, nand is important
  80.  * if constant strings are involved, because of string padding.
  81.  * required is a flag whether an lvalue or an rvalue is required.
  82.  * only VARs and structured things can have gt their lvalue this way.
  83.  */
  84. /*ARGSUSED*/
  85. struct nl *
  86. rvalue(r, contype , required )
  87.     struct tnode *r;
  88.     struct nl *contype;
  89.     int    required;
  90. {
  91.     register struct nl *p, *p1;
  92.     register struct nl *q;
  93.     int c, c1, w;
  94. #ifdef OBJ
  95.     int g;
  96. #endif
  97.     struct tnode *rt;
  98.     char *cp, *cp1, *opname;
  99.     long l;
  100.     union
  101.     {
  102.         long plong[2];
  103.         double pdouble;
  104.     }f;
  105.     extern int    flagwas;
  106.     struct csetstr    csetd;
  107. #    ifdef PC
  108.         struct nl    *rettype;
  109.         long    ctype;
  110.         struct nl    *tempnlp;
  111. #    endif PC
  112.  
  113.     if (r == TR_NIL)
  114.         return (NLNIL);
  115.     if (nowexp(r))
  116.         return (NLNIL);
  117.     /*
  118.      * Pick up the name of the operation
  119.      * for future error messages.
  120.      */
  121.     if (r->tag <= T_IN)
  122.         opname = opnames[r->tag];
  123.  
  124.     /*
  125.      * The root of the tree tells us what sort of expression we have.
  126.      */
  127.     switch (r->tag) {
  128.  
  129.     /*
  130.      * The constant nil
  131.      */
  132.     case T_NIL:
  133. #        ifdef OBJ
  134.             (void) put(2, O_CON2, 0);
  135. #        endif OBJ
  136. #        ifdef PC
  137.             putleaf( PCC_ICON , 0 , 0 , PCCTM_PTR|PCCT_UNDEF , (char *) 0 );
  138. #        endif PC
  139.         return (nl+TNIL);
  140.  
  141.     /*
  142.      * Function call with arguments.
  143.      */
  144.     case T_FCALL:
  145. #        ifdef OBJ
  146.         return (funccod(r));
  147. #        endif OBJ
  148. #        ifdef PC
  149.         return (pcfunccod( r ));
  150. #        endif PC
  151.  
  152.     case T_VAR:
  153.         p = lookup(r->var_node.cptr);
  154.         if (p == NLNIL || p->class == BADUSE)
  155.             return (NLNIL);
  156.         switch (p->class) {
  157.             case VAR:
  158.                 /*
  159.                  * If a variable is
  160.                  * qualified then get
  161.                  * the rvalue by a
  162.                  * lvalue and an ind.
  163.                  */
  164.                 if (r->var_node.qual != TR_NIL)
  165.                     goto ind;
  166.                 q = p->type;
  167.                 if (q == NIL)
  168.                     return (NLNIL);
  169. #                ifdef OBJ
  170.                 w = width(q);
  171.                 switch (w) {
  172.                     case 8:
  173.                     (void) put(2, O_RV8 | bn << 8+INDX,
  174.                         (int)p->value[0]);
  175.                     break;
  176.                     case 4:
  177.                     (void) put(2, O_RV4 | bn << 8+INDX,
  178.                         (int)p->value[0]);
  179.                     break;
  180.                     case 2:
  181.                     (void) put(2, O_RV2 | bn << 8+INDX,
  182.                         (int)p->value[0]);
  183.                     break;
  184.                     case 1:
  185.                     (void) put(2, O_RV1 | bn << 8+INDX,
  186.                         (int)p->value[0]);
  187.                     break;
  188.                     default:
  189.                     (void) put(3, O_RV | bn << 8+INDX,
  190.                         (int)p->value[0], w);
  191.                 }
  192. #               endif OBJ
  193. #               ifdef PC
  194.                 if ( required == RREQ ) {
  195.                     putRV( p -> symbol , bn , p -> value[0] ,
  196.                         p -> extra_flags , p2type( q ) );
  197.                 } else {
  198.                     putLV( p -> symbol , bn , p -> value[0] ,
  199.                         p -> extra_flags , p2type( q ) );
  200.                 }
  201. #               endif PC
  202.                return (q);
  203.  
  204.             case WITHPTR:
  205.             case REF:
  206.                 /*
  207.                  * A lvalue for these
  208.                  * is actually what one
  209.                  * might consider a rvalue.
  210.                  */
  211. ind:
  212.                 q = lvalue(r, NOFLAGS , LREQ );
  213.                 if (q == NIL)
  214.                     return (NLNIL);
  215. #                ifdef OBJ
  216.                 w = width(q);
  217.                 switch (w) {
  218.                     case 8:
  219.                         (void) put(1, O_IND8);
  220.                         break;
  221.                     case 4:
  222.                         (void) put(1, O_IND4);
  223.                         break;
  224.                     case 2:
  225.                         (void) put(1, O_IND2);
  226.                         break;
  227.                     case 1:
  228.                         (void) put(1, O_IND1);
  229.                         break;
  230.                     default:
  231.                         (void) put(2, O_IND, w);
  232.                 }
  233. #                endif OBJ
  234. #                ifdef PC
  235.                 if ( required == RREQ ) {
  236.                     putop( PCCOM_UNARY PCC_MUL , p2type( q ) );
  237.                 }
  238. #                endif PC
  239.                 return (q);
  240.  
  241.             case CONST:
  242.                 if (r->var_node.qual != TR_NIL) {
  243.                 error("%s is a constant and cannot be qualified", r->var_node.cptr);
  244.                 return (NLNIL);
  245.                 }
  246.                 q = p->type;
  247.                 if (q == NLNIL)
  248.                     return (NLNIL);
  249.                 if (q == nl+TSTR) {
  250.                     /*
  251.                      * Find the size of the string
  252.                      * constant if needed.
  253.                      */
  254.                     cp = (char *) p->ptr[0];
  255. cstrng:
  256.                     cp1 = cp;
  257.                     for (c = 0; *cp++; c++)
  258.                         continue;
  259.                     w = c;
  260.                     if (contype != NIL && !opt('s')) {
  261.                         if (width(contype) < c && classify(contype) == TSTR) {
  262.                             error("Constant string too long");
  263.                             return (NLNIL);
  264.                         }
  265.                         w = width(contype);
  266.                     }
  267. #                    ifdef OBJ
  268.                     (void) put(2, O_CONG, w);
  269.                     putstr(cp1, w - c);
  270. #                    endif OBJ
  271. #                    ifdef PC
  272.                     putCONG( cp1 , w , required );
  273. #                    endif PC
  274.                     /*
  275.                      * Define the string temporarily
  276.                      * so later people can know its
  277.                      * width.
  278.                      * cleaned out by stat.
  279.                      */
  280.                     q = defnl((char *) 0, STR, NLNIL, w);
  281.                     q->type = q;
  282.                     return (q);
  283.                 }
  284.                 if (q == nl+T1CHAR) {
  285. #                    ifdef OBJ
  286.                     (void) put(2, O_CONC, (int)p->value[0]);
  287. #                    endif OBJ
  288. #                    ifdef PC
  289.                     putleaf( PCC_ICON , p -> value[0] , 0
  290.                         , PCCT_CHAR , (char *) 0 );
  291. #                    endif PC
  292.                     return (q);
  293.                 }
  294.                 /*
  295.                  * Every other kind of constant here
  296.                  */
  297.                 switch (width(q)) {
  298.                 case 8:
  299. #ifndef DEBUG
  300. #                    ifdef OBJ
  301.                     (void) put(2, O_CON8, p->real);
  302. #                    endif OBJ
  303. #                    ifdef PC
  304.                     putCON8( p -> real );
  305. #                    endif PC
  306. #else
  307.                     if (hp21mx) {
  308.                         f.pdouble = p->real;
  309.                         conv((int *) (&f.pdouble));
  310.                         l = f.plong[1];
  311.                         (void) put(2, O_CON4, l);
  312.                     } else
  313. #                        ifdef OBJ
  314.                         (void) put(2, O_CON8, p->real);
  315. #                        endif OBJ
  316. #                        ifdef PC
  317.                         putCON8( p -> real );
  318. #                        endif PC
  319. #endif
  320.                     break;
  321.                 case 4:
  322. #                    ifdef OBJ
  323.                     (void) put(2, O_CON4, p->range[0]);
  324. #                    endif OBJ
  325. #                    ifdef PC
  326.                     putleaf( PCC_ICON , (int) p->range[0] , 0
  327.                         , PCCT_INT , (char *) 0 );
  328. #                    endif PC
  329.                     break;
  330.                 case 2:
  331. #                    ifdef OBJ
  332.                     (void) put(2, O_CON2, (short)p->range[0]);
  333. #                    endif OBJ
  334. #                    ifdef PC
  335.                     putleaf( PCC_ICON , (short) p -> range[0]
  336.                         , 0 , PCCT_SHORT , (char *) 0 );
  337. #                    endif PC
  338.                     break;
  339.                 case 1:
  340. #                    ifdef OBJ
  341.                     (void) put(2, O_CON1, p->value[0]);
  342. #                    endif OBJ
  343. #                    ifdef PC
  344.                     putleaf( PCC_ICON , p -> value[0] , 0
  345.                         , PCCT_CHAR , (char *) 0 );
  346. #                    endif PC
  347.                     break;
  348.                 default:
  349.                     panic("rval");
  350.                 }
  351.                 return (q);
  352.  
  353.             case FUNC:
  354.             case FFUNC:
  355.                 /*
  356.                  * Function call with no arguments.
  357.                  */
  358.                 if (r->var_node.qual != TR_NIL) {
  359.                     error("Can't qualify a function result value");
  360.                     return (NLNIL);
  361.                 }
  362. #                ifdef OBJ
  363.                 return (funccod(r));
  364. #                endif OBJ
  365. #                ifdef PC
  366.                 return (pcfunccod( r ));
  367. #                endif PC
  368.  
  369.             case TYPE:
  370.                 error("Type names (e.g. %s) allowed only in declarations", p->symbol);
  371.                 return (NLNIL);
  372.  
  373.             case PROC:
  374.             case FPROC:
  375.                 error("Procedure %s found where expression required", p->symbol);
  376.                 return (NLNIL);
  377.             default:
  378.                 panic("rvid");
  379.         }
  380.     /*
  381.      * Constant sets
  382.      */
  383.     case T_CSET:
  384. #        ifdef OBJ
  385.             if ( precset( r , contype , &csetd ) ) {
  386.             if ( csetd.csettype == NIL ) {
  387.                 return (NLNIL);
  388.             }
  389.             postcset( r , &csetd );
  390.             } else {
  391.             (void) put( 2, O_PUSH, -lwidth(csetd.csettype));
  392.             postcset( r , &csetd );
  393.             setran( ( csetd.csettype ) -> type );
  394.             (void) put( 2, O_CON24, set.uprbp);
  395.             (void) put( 2, O_CON24, set.lwrb);
  396.             (void) put( 2, O_CTTOT,
  397.                 (int)(4 + csetd.singcnt + 2 * csetd.paircnt));
  398.             }
  399.             return csetd.csettype;
  400. #        endif OBJ
  401. #        ifdef PC
  402.             if ( precset( r , contype , &csetd ) ) {
  403.             if ( csetd.csettype == NIL ) {
  404.                 return (NLNIL);
  405.             }
  406.             postcset( r , &csetd );
  407.             } else {
  408.             putleaf( PCC_ICON , 0 , 0
  409.                 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
  410.                 , "_CTTOT" );
  411.             /*
  412.              *    allocate a temporary and use it
  413.              */
  414.             tempnlp = tmpalloc(lwidth(csetd.csettype),
  415.                 csetd.csettype, NOREG);
  416.             putLV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
  417.                 tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
  418.             setran( ( csetd.csettype ) -> type );
  419.             putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
  420.             putop( PCC_CM , PCCT_INT );
  421.             putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
  422.             putop( PCC_CM , PCCT_INT );
  423.             postcset( r , &csetd );
  424.             putop( PCC_CALL , PCCT_INT );
  425.             }
  426.             return csetd.csettype;
  427. #        endif PC
  428.  
  429.     /*
  430.      * Unary plus and minus
  431.      */
  432.     case T_PLUS:
  433.     case T_MINUS:
  434.         q = rvalue(r->un_expr.expr, NLNIL , RREQ );
  435.         if (q == NLNIL)
  436.             return (NLNIL);
  437.         if (isnta(q, "id")) {
  438.             error("Operand of %s must be integer or real, not %s", opname, nameof(q));
  439.             return (NLNIL);
  440.         }
  441.         if (r->tag == T_MINUS) {
  442. #            ifdef OBJ
  443.             (void) put(1, O_NEG2 + (width(q) >> 2));
  444.             return (isa(q, "d") ? q : nl+T4INT);
  445. #            endif OBJ
  446. #            ifdef PC
  447.             if (isa(q, "i")) {
  448.                 sconv(p2type(q), PCCT_INT);
  449.                 putop( PCCOM_UNARY PCC_MINUS, PCCT_INT);
  450.                 return nl+T4INT;
  451.             }
  452.             putop( PCCOM_UNARY PCC_MINUS, PCCT_DOUBLE);
  453.             return nl+TDOUBLE;
  454. #            endif PC
  455.         }
  456.         return (q);
  457.  
  458.     case T_NOT:
  459.         q = rvalue(r->un_expr.expr, NLNIL , RREQ );
  460.         if (q == NLNIL)
  461.             return (NLNIL);
  462.         if (isnta(q, "b")) {
  463.             error("not must operate on a Boolean, not %s", nameof(q));
  464.             return (NLNIL);
  465.         }
  466. #        ifdef OBJ
  467.             (void) put(1, O_NOT);
  468. #        endif OBJ
  469. #        ifdef PC
  470.             sconv(p2type(q), PCCT_INT);
  471.             putop( PCC_NOT , PCCT_INT);
  472.             sconv(PCCT_INT, p2type(q));
  473. #        endif PC
  474.         return (nl+T1BOOL);
  475.  
  476.     case T_AND:
  477.     case T_OR:
  478.         p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
  479. #        ifdef PC
  480.             sconv(p2type(p),PCCT_INT);
  481. #        endif PC
  482.         p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
  483. #        ifdef PC
  484.             sconv(p2type(p1),PCCT_INT);
  485. #        endif PC
  486.         if (p == NLNIL || p1 == NLNIL)
  487.             return (NLNIL);
  488.         if (isnta(p, "b")) {
  489.             error("Left operand of %s must be Boolean, not %s", opname, nameof(p));
  490.             return (NLNIL);
  491.         }
  492.         if (isnta(p1, "b")) {
  493.             error("Right operand of %s must be Boolean, not %s", opname, nameof(p1));
  494.             return (NLNIL);
  495.         }
  496. #        ifdef OBJ
  497.             (void) put(1, r->tag == T_AND ? O_AND : O_OR);
  498. #        endif OBJ
  499. #        ifdef PC
  500.             /*
  501.              * note the use of & and | rather than && and ||
  502.              * to force evaluation of all the expressions.
  503.              */
  504.             putop( r->tag == T_AND ? PCC_AND : PCC_OR , PCCT_INT );
  505.             sconv(PCCT_INT, p2type(p));
  506. #        endif PC
  507.         return (nl+T1BOOL);
  508.  
  509.     case T_DIVD:
  510. #        ifdef OBJ
  511.             p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
  512.             p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
  513. #        endif OBJ
  514. #        ifdef PC
  515.             /*
  516.              *    force these to be doubles for the divide
  517.              */
  518.             p = rvalue( r->expr_node.lhs , NLNIL , RREQ );
  519.             sconv(p2type(p), PCCT_DOUBLE);
  520.             p1 = rvalue( r->expr_node.rhs , NLNIL , RREQ );
  521.             sconv(p2type(p1), PCCT_DOUBLE);
  522. #        endif PC
  523.         if (p == NLNIL || p1 == NLNIL)
  524.             return (NLNIL);
  525.         if (isnta(p, "id")) {
  526.             error("Left operand of / must be integer or real, not %s", nameof(p));
  527.             return (NLNIL);
  528.         }
  529.         if (isnta(p1, "id")) {
  530.             error("Right operand of / must be integer or real, not %s", nameof(p1));
  531.             return (NLNIL);
  532.         }
  533. #        ifdef OBJ
  534.             return gen(NIL, r->tag, width(p), width(p1));
  535. #        endif OBJ
  536. #        ifdef PC
  537.             putop( PCC_DIV , PCCT_DOUBLE );
  538.             return nl + TDOUBLE;
  539. #        endif PC
  540.  
  541.     case T_MULT:
  542.     case T_ADD:
  543.     case T_SUB:
  544. #        ifdef OBJ
  545.             /*
  546.              * get the type of the right hand side.
  547.              * if it turns out to be a set,
  548.              * use that type when getting
  549.              * the type of the left hand side.
  550.              * and then use the type of the left hand side
  551.              * when generating code.
  552.              * this will correctly decide the type of any
  553.              * empty sets in the tree, since if the empty set 
  554.              * is on the left hand side it will inherit
  555.              * the type of the right hand side,
  556.              * and if it's on the right hand side, its type (intset)
  557.              * will be overridden by the type of the left hand side.
  558.              * this is an awful lot of tree traversing, 
  559.              * but it works.
  560.              */
  561.             codeoff();
  562.             p1 = rvalue( r->expr_node.rhs , NLNIL , RREQ );
  563.             codeon();
  564.             if ( p1 == NLNIL ) {
  565.             return NLNIL;
  566.             }
  567.             if (isa(p1, "t")) {
  568.             codeoff();
  569.             contype = rvalue(r->expr_node.lhs, p1, RREQ);
  570.             codeon();
  571.             if (contype == NLNIL) {
  572.                 return NLNIL;
  573.             }
  574.             }
  575.             p = rvalue( r->expr_node.lhs , contype , RREQ );
  576.             p1 = rvalue( r->expr_node.rhs , p , RREQ );
  577.             if ( p == NLNIL || p1 == NLNIL )
  578.                 return NLNIL;
  579.             if (isa(p, "id") && isa(p1, "id"))
  580.             return (gen(NIL, r->tag, width(p), width(p1)));
  581.             if (isa(p, "t") && isa(p1, "t")) {
  582.                 if (p != p1) {
  583.                     error("Set types of operands of %s must be identical", opname);
  584.                     return (NLNIL);
  585.                 }
  586.                 (void) gen(TSET, r->tag, width(p), 0);
  587.                 return (p);
  588.             }
  589. #        endif OBJ
  590. #        ifdef PC
  591.             /*
  592.              * the second pass can't do
  593.              *    long op double  or  double op long
  594.              * so we have to know the type of both operands.
  595.              * also, see the note for obj above on determining
  596.              * the type of empty sets.
  597.              */
  598.             codeoff();
  599.             p1 = rvalue(r->expr_node.rhs, NLNIL, RREQ);
  600.             codeon();
  601.             if ( isa( p1 , "id" ) ) {
  602.             p = rvalue( r->expr_node.lhs , contype , RREQ );
  603.             if ( ( p == NLNIL ) || ( p1 == NLNIL ) ) {
  604.                 return NLNIL;
  605.             }
  606.             tuac(p, p1, &rettype, (int *) (&ctype));
  607.             p1 = rvalue( r->expr_node.rhs , contype , RREQ );
  608.             tuac(p1, p, &rettype, (int *) (&ctype));
  609.             if ( isa( p , "id" ) ) {
  610.                 putop( (int) mathop[r->tag - T_MULT], (int) ctype);
  611.                 return rettype;
  612.             }
  613.             }
  614.             if ( isa( p1 , "t" ) ) {
  615.             putleaf( PCC_ICON , 0 , 0
  616.                 , PCCM_ADDTYPE( PCCM_ADDTYPE( PCCTM_PTR | PCCT_STRTY , PCCTM_FTN )
  617.                     , PCCTM_PTR )
  618.                 , setop[ r->tag - T_MULT ] );
  619.             codeoff();
  620.             contype = rvalue( r->expr_node.lhs, p1 , LREQ );
  621.             codeon();
  622.             if ( contype == NLNIL ) {
  623.                 return NLNIL;
  624.             }
  625.                 /*
  626.                  *    allocate a temporary and use it
  627.                  */
  628.             tempnlp = tmpalloc(lwidth(contype), contype, NOREG);
  629.             putLV((char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] ,
  630.                 tempnlp -> extra_flags , PCCTM_PTR|PCCT_STRTY );
  631.             p = rvalue( r->expr_node.lhs , contype , LREQ );
  632.             if ( isa( p , "t" ) ) {
  633.                 putop( PCC_CM , PCCT_INT );
  634.                 if ( p == NLNIL || p1 == NLNIL ) {
  635.                 return NLNIL;
  636.                 }
  637.                 p1 = rvalue( r->expr_node.rhs , p , LREQ );
  638.                 if ( p != p1 ) {
  639.                 error("Set types of operands of %s must be identical", opname);
  640.                 return NLNIL;
  641.                 }
  642.                 putop( PCC_CM , PCCT_INT );
  643.                 putleaf( PCC_ICON , (int) (lwidth(p1)) / sizeof( long ) , 0
  644.                     , PCCT_INT , (char *) 0 );
  645.                 putop( PCC_CM , PCCT_INT );
  646.                 putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );
  647.                 return p;
  648.             }
  649.             }
  650.             if ( isnta( p1 , "idt" ) ) {
  651.                 /*
  652.                  *    find type of left operand for error message.
  653.                  */
  654.             p = rvalue( r->expr_node.lhs , contype , RREQ );
  655.             }
  656.             /*
  657.              *    don't give spurious error messages.
  658.              */
  659.             if ( p == NLNIL || p1 == NLNIL ) {
  660.             return NLNIL;
  661.             }
  662. #        endif PC
  663.         if (isnta(p, "idt")) {
  664.             error("Left operand of %s must be integer, real or set, not %s", opname, nameof(p));
  665.             return (NLNIL);
  666.         }
  667.         if (isnta(p1, "idt")) {
  668.             error("Right operand of %s must be integer, real or set, not %s", opname, nameof(p1));
  669.             return (NLNIL);
  670.         }
  671.         error("Cannot mix sets with integers and reals as operands of %s", opname);
  672.         return (NLNIL);
  673.  
  674.     case T_MOD:
  675.     case T_DIV:
  676.         p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
  677. #        ifdef PC
  678.             sconv(p2type(p), PCCT_INT);
  679. #        ifdef tahoe
  680.             /* prepare for ediv workaround, see below. */
  681.             if (r->tag == T_MOD) {
  682.             (void) rvalue(r->expr_node.lhs, NLNIL, RREQ);
  683.             sconv(p2type(p), PCCT_INT);
  684.             }
  685. #        endif tahoe
  686. #        endif PC
  687.         p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
  688. #        ifdef PC
  689.             sconv(p2type(p1), PCCT_INT);
  690. #        endif PC
  691.         if (p == NLNIL || p1 == NLNIL)
  692.             return (NLNIL);
  693.         if (isnta(p, "i")) {
  694.             error("Left operand of %s must be integer, not %s", opname, nameof(p));
  695.             return (NLNIL);
  696.         }
  697.         if (isnta(p1, "i")) {
  698.             error("Right operand of %s must be integer, not %s", opname, nameof(p1));
  699.             return (NLNIL);
  700.         }
  701. #        ifdef OBJ
  702.             return (gen(NIL, r->tag, width(p), width(p1)));
  703. #        endif OBJ
  704. #        ifdef PC
  705. #        ifndef tahoe
  706.             putop( r->tag == T_DIV ? PCC_DIV : PCC_MOD , PCCT_INT );
  707.             return ( nl + T4INT );
  708. #        else tahoe
  709.             putop( PCC_DIV , PCCT_INT );
  710.             if (r->tag == T_MOD) {
  711.             /*
  712.              * avoid f1 bug: PCC_MOD would generate an 'ediv',
  713.              * which would reuire too many registers to evaluate
  714.              * things like
  715.              * var i:boolean;j:integer; i := (j+1) = (j mod 2);
  716.              * so, instead of
  717.              *                PCC_MOD
  718.              *                / \
  719.              *                   p   p1
  720.              * we put
  721.              *                  PCC_MINUS
  722.              *                    /   \
  723.              *             p   PCC_MUL               
  724.              *                  /   \
  725.              *              PCC_DIV  p1
  726.              *                      / \
  727.              *                     p  p1
  728.              *
  729.              * we already have put p, p, p1, PCC_DIV. and now...
  730.              */
  731.                 rvalue(r->expr_node.rhs, NLNIL , RREQ );
  732.                 sconv(p2type(p1), PCCT_INT);
  733.                 putop( PCC_MUL, PCCT_INT );
  734.                 putop( PCC_MINUS, PCCT_INT );
  735.             }
  736.             return ( nl + T4INT );
  737. #        endif tahoe
  738. #        endif PC
  739.  
  740.     case T_EQ:
  741.     case T_NE:
  742.     case T_LT:
  743.     case T_GT:
  744.     case T_LE:
  745.     case T_GE:
  746.         /*
  747.          * Since there can be no, a priori, knowledge
  748.          * of the context type should a constant string
  749.          * or set arise, we must poke around to find such
  750.          * a type if possible.  Since constant strings can
  751.          * always masquerade as identifiers, this is always
  752.          * necessary.
  753.          * see the note in the obj section of case T_MULT above
  754.          * for the determination of the base type of empty sets.
  755.          */
  756.         codeoff();
  757.         p1 = rvalue(r->expr_node.rhs, NLNIL , RREQ );
  758.         codeon();
  759.         if (p1 == NLNIL)
  760.             return (NLNIL);
  761.         contype = p1;
  762. #        ifdef OBJ
  763.             if (p1->class == STR) {
  764.                 /*
  765.                  * For constant strings we want
  766.                  * the longest type so as to be
  767.                  * able to do padding (more importantly
  768.                  * avoiding truncation). For clarity,
  769.                  * we get this length here.
  770.                  */
  771.                 codeoff();
  772.                 p = rvalue(r->expr_node.lhs, NLNIL , RREQ );
  773.                 codeon();
  774.                 if (p == NLNIL)
  775.                     return (NLNIL);
  776.                 if (width(p) > width(p1))
  777.                     contype = p;
  778.             }
  779.             if (isa(p1, "t")) {
  780.             codeoff();
  781.             contype = rvalue(r->expr_node.lhs, p1, RREQ);
  782.             codeon();
  783.             if (contype == NLNIL) {
  784.                 return NLNIL;
  785.             }
  786.             }
  787.             /*
  788.              * Now we generate code for
  789.              * the operands of the relational
  790.              * operation.
  791.              */
  792.             p = rvalue(r->expr_node.lhs, contype , RREQ );
  793.             if (p == NLNIL)
  794.                 return (NLNIL);
  795.             p1 = rvalue(r->expr_node.rhs, p , RREQ );
  796.             if (p1 == NLNIL)
  797.                 return (NLNIL);
  798. #        endif OBJ
  799. #        ifdef PC
  800.             c1 = classify( p1 );
  801.             if ( c1 == TSET || c1 == TSTR || c1 == TREC ) {
  802.             putleaf( PCC_ICON , 0 , 0
  803.                 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
  804.                 , c1 == TSET  ? relts[ r->tag - T_EQ ]
  805.                           : relss[ r->tag - T_EQ ] );
  806.                 /*
  807.                  *    for [] and strings, comparisons are done on
  808.                  *    the maximum width of the two sides.
  809.                  *    for other sets, we have to ask the left side
  810.                  *    what type it is based on the type of the right.
  811.                  *    (this matters for intsets).
  812.                  */
  813.             if ( c1 == TSTR ) {
  814.                 codeoff();
  815.                 p = rvalue( r->expr_node.lhs , NLNIL , LREQ );
  816.                 codeon();
  817.                 if ( p == NLNIL ) {
  818.                 return NLNIL;
  819.                 }
  820.                 if ( lwidth( p ) > lwidth( p1 ) ) {
  821.                 contype = p;
  822.                 }
  823.             } else if ( c1 == TSET ) {
  824.                 codeoff();
  825.                 contype = rvalue(r->expr_node.lhs, p1, LREQ);
  826.                 codeon();
  827.                 if (contype == NLNIL) {
  828.                 return NLNIL;
  829.                 }
  830.             } 
  831.                 /*
  832.                  *    put out the width of the comparison.
  833.                  */
  834.             putleaf(PCC_ICON, (int) lwidth(contype), 0, PCCT_INT, (char *) 0);
  835.                 /*
  836.                  *    and the left hand side,
  837.                  *    for sets, strings, records
  838.                  */
  839.             p = rvalue( r->expr_node.lhs , contype , LREQ );
  840.             if ( p == NLNIL ) {
  841.                 return NLNIL;
  842.             }
  843.             putop( PCC_CM , PCCT_INT );
  844.             p1 = rvalue( r->expr_node.rhs , p , LREQ );
  845.             if ( p1 == NLNIL ) {
  846.                 return NLNIL;
  847.             }
  848.             putop( PCC_CM , PCCT_INT );
  849.             putop( PCC_CALL , PCCT_INT );
  850.             } else {
  851.                 /*
  852.                  *    the easy (scalar or error) case
  853.                  */
  854.             p = rvalue( r->expr_node.lhs , contype , RREQ );
  855.             if ( p == NLNIL ) {
  856.                 return NLNIL;
  857.             }
  858.                 /*
  859.                  * since the second pass can't do
  860.                  *    long op double  or  double op long
  861.                  * we may have to do some coercing.
  862.                  */
  863.             tuac(p, p1, &rettype, (int *) (&ctype));
  864.             p1 = rvalue( r->expr_node.rhs , p , RREQ );
  865.             if ( p1 == NLNIL ) {
  866.                 return NLNIL;
  867.             }
  868.             tuac(p1, p, &rettype, (int *) (&ctype));
  869.             putop((int) relops[ r->tag - T_EQ ] , PCCT_INT );
  870.             sconv(PCCT_INT, PCCT_CHAR);
  871.             }
  872. #        endif PC
  873.         c = classify(p);
  874.         c1 = classify(p1);
  875.         if (nocomp(c) || nocomp(c1))
  876.             return (NLNIL);
  877. #        ifdef OBJ
  878.             g = NIL;
  879. #        endif
  880.         switch (c) {
  881.             case TBOOL:
  882.             case TCHAR:
  883.                 if (c != c1)
  884.                     goto clash;
  885.                 break;
  886.             case TINT:
  887.             case TDOUBLE:
  888.                 if (c1 != TINT && c1 != TDOUBLE)
  889.                     goto clash;
  890.                 break;
  891.             case TSCAL:
  892.                 if (c1 != TSCAL)
  893.                     goto clash;
  894.                 if (scalar(p) != scalar(p1))
  895.                     goto nonident;
  896.                 break;
  897.             case TSET:
  898.                 if (c1 != TSET)
  899.                     goto clash;
  900.                 if ( opt( 's' ) &&
  901.                     ( ( r->tag == T_LT) || (r->tag == T_GT) ) &&
  902.                     ( line != nssetline ) ) {
  903.                     nssetline = line;
  904.                     standard();
  905.                     error("%s comparison on sets is non-standard" , opname );
  906.                 }
  907.                 if (p != p1)
  908.                     goto nonident;
  909. #                ifdef OBJ
  910.                     g = TSET;
  911. #                endif
  912.                 break;
  913.             case TREC:
  914.                 if ( c1 != TREC ) {
  915.                     goto clash;
  916.                 }
  917.                 if ( p != p1 ) {
  918.                     goto nonident;
  919.                 }
  920.                 if (r->tag != T_EQ && r->tag != T_NE) {
  921.                     error("%s not allowed on records - only allow = and <>" , opname );
  922.                     return (NLNIL);
  923.                 }
  924. #                ifdef OBJ
  925.                     g = TREC;
  926. #                endif
  927.                 break;
  928.             case TPTR:
  929.             case TNIL:
  930.                 if (c1 != TPTR && c1 != TNIL)
  931.                     goto clash;
  932.                 if (r->tag != T_EQ && r->tag != T_NE) {
  933.                     error("%s not allowed on pointers - only allow = and <>" , opname );
  934.                     return (NLNIL);
  935.                 }
  936.                 if (p != nl+TNIL && p1 != nl+TNIL && p != p1)
  937.                     goto nonident;
  938.                 break;
  939.             case TSTR:
  940.                 if (c1 != TSTR)
  941.                     goto clash;
  942.                 if (width(p) != width(p1)) {
  943.                     error("Strings not same length in %s comparison", opname);
  944.                     return (NLNIL);
  945.                 }
  946. #                ifdef OBJ
  947.                     g = TSTR;
  948. #                endif OBJ
  949.                 break;
  950.             default:
  951.                 panic("rval2");
  952.         }
  953. #        ifdef OBJ
  954.             return (gen(g, r->tag, width(p), width(p1)));
  955. #        endif OBJ
  956. #        ifdef PC
  957.             return nl + TBOOL;
  958. #        endif PC
  959. clash:
  960.         error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname);
  961.         return (NLNIL);
  962. nonident:
  963.         error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname);
  964.         return (NLNIL);
  965.  
  966.     case T_IN:
  967.         rt = r->expr_node.rhs;
  968. #        ifdef OBJ
  969.         if (rt != TR_NIL && rt->tag == T_CSET) {
  970.             (void) precset( rt , NLNIL , &csetd );
  971.             p1 = csetd.csettype;
  972.             if (p1 == NLNIL)
  973.                 return NLNIL;
  974.             postcset( rt, &csetd);
  975.             } else {
  976.             p1 = stkrval(r->expr_node.rhs, NLNIL , (long) RREQ );
  977.             rt = TR_NIL;
  978.             }
  979. #        endif OBJ
  980. #        ifdef PC
  981.             if (rt != TR_NIL && rt->tag == T_CSET) {
  982.             if ( precset( rt , NLNIL , &csetd ) ) {
  983.                 putleaf( PCC_ICON , 0 , 0
  984.                     , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
  985.                     , "_IN" );
  986.             } else {
  987.                 putleaf( PCC_ICON , 0 , 0
  988.                     , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
  989.                     , "_INCT" );
  990.             }
  991.             p1 = csetd.csettype;
  992.             if (p1 == NIL)
  993.                 return NLNIL;
  994.             } else {
  995.             putleaf( PCC_ICON , 0 , 0
  996.                 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
  997.                 , "_IN" );
  998.             codeoff();
  999.             p1 = rvalue(r->expr_node.rhs, NLNIL , LREQ );
  1000.             codeon();
  1001.             }
  1002. #        endif PC
  1003.         p = stkrval(r->expr_node.lhs, NLNIL , (long) RREQ );
  1004.         if (p == NIL || p1 == NIL)
  1005.             return (NLNIL);
  1006.         if (p1->class != (char) SET) {
  1007.             error("Right operand of 'in' must be a set, not %s", nameof(p1));
  1008.             return (NLNIL);
  1009.         }
  1010.         if (incompat(p, p1->type, r->expr_node.lhs)) {
  1011.             cerror("Index type clashed with set component type for 'in'");
  1012.             return (NLNIL);
  1013.         }
  1014.         setran(p1->type);
  1015. #        ifdef OBJ
  1016.             if (rt == TR_NIL || csetd.comptime)
  1017.                 (void) put(4, O_IN, width(p1), set.lwrb, set.uprbp);
  1018.             else
  1019.                 (void) put(2, O_INCT,
  1020.                 (int)(3 + csetd.singcnt + 2*csetd.paircnt));
  1021. #        endif OBJ
  1022. #        ifdef PC
  1023.             if ( rt == TR_NIL || rt->tag != T_CSET ) {
  1024.             putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
  1025.             putop( PCC_CM , PCCT_INT );
  1026.             putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
  1027.             putop( PCC_CM , PCCT_INT );
  1028.             p1 = rvalue( r->expr_node.rhs , NLNIL , LREQ );
  1029.             if ( p1 == NLNIL ) {
  1030.                 return NLNIL;
  1031.             }
  1032.             putop( PCC_CM , PCCT_INT );
  1033.             } else if ( csetd.comptime ) {
  1034.             putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
  1035.             putop( PCC_CM , PCCT_INT );
  1036.             putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
  1037.             putop( PCC_CM , PCCT_INT );
  1038.             postcset( r->expr_node.rhs , &csetd );
  1039.             putop( PCC_CM , PCCT_INT );
  1040.             } else {
  1041.             postcset( r->expr_node.rhs , &csetd );
  1042.             }
  1043.             putop( PCC_CALL , PCCT_INT );
  1044.             sconv(PCCT_INT, PCCT_CHAR);
  1045. #        endif PC
  1046.         return (nl+T1BOOL);
  1047.     default:
  1048.         if (r->expr_node.lhs == TR_NIL)
  1049.             return (NLNIL);
  1050.         switch (r->tag) {
  1051.         default:
  1052.             panic("rval3");
  1053.  
  1054.  
  1055.         /*
  1056.          * An octal number
  1057.          */
  1058.         case T_BINT:
  1059.             f.pdouble = a8tol(r->const_node.cptr);
  1060.             goto conint;
  1061.     
  1062.         /*
  1063.          * A decimal number
  1064.          */
  1065.         case T_INT:
  1066.             f.pdouble = atof(r->const_node.cptr);
  1067. conint:
  1068.             if (f.pdouble > MAXINT || f.pdouble < MININT) {
  1069.                 error("Constant too large for this implementation");
  1070.                 return (NLNIL);
  1071.             }
  1072.             l = f.pdouble;
  1073. #            ifdef OBJ
  1074.                 if (bytes(l, l) <= 2) {
  1075.                     (void) put(2, O_CON2, ( short ) l);
  1076.                     return (nl+T2INT);
  1077.                 }
  1078.                 (void) put(2, O_CON4, l); 
  1079.                 return (nl+T4INT);
  1080. #            endif OBJ
  1081. #            ifdef PC
  1082.                 switch (bytes(l, l)) {
  1083.                 case 1:
  1084.                     putleaf(PCC_ICON, (int) l, 0, PCCT_CHAR, 
  1085.                         (char *) 0);
  1086.                     return nl+T1INT;
  1087.                 case 2:
  1088.                     putleaf(PCC_ICON, (int) l, 0, PCCT_SHORT, 
  1089.                         (char *) 0);
  1090.                     return nl+T2INT;
  1091.                 case 4:
  1092.                     putleaf(PCC_ICON, (int) l, 0, PCCT_INT,
  1093.                         (char *) 0);
  1094.                     return nl+T4INT;
  1095.                 }
  1096. #            endif PC
  1097.     
  1098.         /*
  1099.          * A floating point number
  1100.          */
  1101.         case T_FINT:
  1102. #            ifdef OBJ
  1103.                 (void) put(2, O_CON8, atof(r->const_node.cptr));
  1104. #            endif OBJ
  1105. #            ifdef PC
  1106.                 putCON8( atof( r->const_node.cptr ) );
  1107. #            endif PC
  1108.             return (nl+TDOUBLE);
  1109.     
  1110.         /*
  1111.          * Constant strings.  Note that constant characters
  1112.          * are constant strings of length one; there is
  1113.          * no constant string of length one.
  1114.          */
  1115.         case T_STRNG:
  1116.             cp = r->const_node.cptr;
  1117.             if (cp[1] == 0) {
  1118. #                ifdef OBJ
  1119.                     (void) put(2, O_CONC, cp[0]);
  1120. #                endif OBJ
  1121. #                ifdef PC
  1122.                     putleaf( PCC_ICON , cp[0] , 0 , PCCT_CHAR ,
  1123.                         (char *) 0 );
  1124. #                endif PC
  1125.                 return (nl+T1CHAR);
  1126.             }
  1127.             goto cstrng;
  1128.         }
  1129.     
  1130.     }
  1131. }
  1132.  
  1133. /*
  1134.  * Can a class appear
  1135.  * in a comparison ?
  1136.  */
  1137. nocomp(c)
  1138.     int c;
  1139. {
  1140.  
  1141.     switch (c) {
  1142.         case TREC:
  1143.             if ( line != reccompline ) {
  1144.                 reccompline = line;
  1145.                 warning();
  1146.                 if ( opt( 's' ) ) {
  1147.                 standard();
  1148.                 }
  1149.                 error("record comparison is non-standard");
  1150.             }
  1151.             break;
  1152.         case TFILE:
  1153.         case TARY:
  1154.             error("%ss may not participate in comparisons", clnames[c]);
  1155.             return (1);
  1156.     }
  1157.     return (NIL);
  1158. }
  1159.  
  1160.     /*
  1161.      *    this is sort of like gconst, except it works on expression trees
  1162.      *    rather than declaration trees, and doesn't give error messages for
  1163.      *    non-constant things.
  1164.      *    as a side effect this fills in the con structure that gconst uses.
  1165.      *    this returns TRUE or FALSE.
  1166.      */
  1167.  
  1168. bool 
  1169. constval(r)
  1170.     register struct tnode *r;
  1171. {
  1172.     register struct nl *np;
  1173.     register struct tnode *cn;
  1174.     char *cp;
  1175.     int negd, sgnd;
  1176.     long ci;
  1177.  
  1178.     con.ctype = NIL;
  1179.     cn = r;
  1180.     negd = sgnd = 0;
  1181. loop:
  1182.         /*
  1183.          *    cn[2] is nil if error recovery generated a T_STRNG
  1184.          */
  1185.     if (cn == TR_NIL || cn->expr_node.lhs == TR_NIL)
  1186.         return FALSE;
  1187.     switch (cn->tag) {
  1188.         default:
  1189.             return FALSE;
  1190.         case T_MINUS:
  1191.             negd = 1 - negd;
  1192.             /* and fall through */
  1193.         case T_PLUS:
  1194.             sgnd++;
  1195.             cn = cn->un_expr.expr;
  1196.             goto loop;
  1197.         case T_NIL:
  1198.             con.cpval = NIL;
  1199.             con.cival = 0;
  1200.             con.crval = con.cival;
  1201.             con.ctype = nl + TNIL;
  1202.             break;
  1203.         case T_VAR:
  1204.             np = lookup(cn->var_node.cptr);
  1205.             if (np == NLNIL || np->class != CONST) {
  1206.                 return FALSE;
  1207.             }
  1208.             if ( cn->var_node.qual != TR_NIL ) {
  1209.                 return FALSE;
  1210.             }
  1211.             con.ctype = np->type;
  1212.             switch (classify(np->type)) {
  1213.                 case TINT:
  1214.                     con.crval = np->range[0];
  1215.                     break;
  1216.                 case TDOUBLE:
  1217.                     con.crval = np->real;
  1218.                     break;
  1219.                 case TBOOL:
  1220.                 case TCHAR:
  1221.                 case TSCAL:
  1222.                     con.cival = np->value[0];
  1223.                     con.crval = con.cival;
  1224.                     break;
  1225.                 case TSTR:
  1226.                     con.cpval = (char *) np->ptr[0];
  1227.                     break;
  1228.                 default:
  1229.                     con.ctype = NIL;
  1230.                     return FALSE;
  1231.             }
  1232.             break;
  1233.         case T_BINT:
  1234.             con.crval = a8tol(cn->const_node.cptr);
  1235.             goto restcon;
  1236.         case T_INT:
  1237.             con.crval = atof(cn->const_node.cptr);
  1238.             if (con.crval > MAXINT || con.crval < MININT) {
  1239.                 derror("Constant too large for this implementation");
  1240.                 con.crval = 0;
  1241.             }
  1242. restcon:
  1243.             ci = con.crval;
  1244. #ifndef PI0
  1245.             if (bytes(ci, ci) <= 2)
  1246.                 con.ctype = nl+T2INT;
  1247.             else    
  1248. #endif
  1249.                 con.ctype = nl+T4INT;
  1250.             break;
  1251.         case T_FINT:
  1252.             con.ctype = nl+TDOUBLE;
  1253.             con.crval = atof(cn->const_node.cptr);
  1254.             break;
  1255.         case T_STRNG:
  1256.             cp = cn->const_node.cptr;
  1257.             if (cp[1] == 0) {
  1258.                 con.ctype = nl+T1CHAR;
  1259.                 con.cival = cp[0];
  1260.                 con.crval = con.cival;
  1261.                 break;
  1262.             }
  1263.             con.ctype = nl+TSTR;
  1264.             con.cpval = cp;
  1265.             break;
  1266.     }
  1267.     if (sgnd) {
  1268.         if (isnta(con.ctype, "id")) {
  1269.             derror("%s constants cannot be signed", nameof(con.ctype));
  1270.             return FALSE;
  1271.         } else if (negd)
  1272.             con.crval = -con.crval;
  1273.     }
  1274.     return TRUE;
  1275. }
  1276.