# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/stkrval.c

##### Functions

    stackRV           X
    stkrval           X

       1: /*
       2:  * Copyright (c) 1980 Regents of the University of California.
       3:  * All rights reserved.  The Berkeley software License Agreement
       4:  * specifies the terms and conditions for redistribution.
       5:  */
       6:
       7: #ifndef lint
       8: static char sccsid[] = "@(#)stkrval.c	5.1 (Berkeley) 6/5/85";
       9: #endif not lint
      10:
      11: #include "whoami.h"
      12: #include "0.h"
      13: #include "tree.h"
      14: #include "opcode.h"
      15: #include "objfmt.h"
      16: #ifdef PC
      17: #   include <pcc.h>
      18: #endif PC
      19: #include "tree_ty.h"
      20:
      21: /*
      22:  * stkrval Rvalue - an expression, and coerce it to be a stack quantity.
      23:  *
      24:  * Contype is the type that the caller would prefer, nand is important
      25:  * if constant sets or constant strings are involved, the latter
      26:  * because of string padding.
      27:  */
      28: /*
      29:  * for the obj version, this is a copy of rvalue hacked to use fancy new
      30:  * push-onto-stack-and-convert opcodes.
      31:  * for the pc version, i just call rvalue and convert if i have to,
      32:  * based on the return type of rvalue.
      33:  */
      34: struct nl *
      35: stkrval(r, contype , required )
      36:     register struct tnode *r;
      37:     struct nl *contype;
      38:     long    required;
      39: {
      40:     register struct nl *p;
      41:     register struct nl *q;
      42:     register char *cp, *cp1;
      43:     register int c, w;
      44:     struct tnode *pt;
      45:     long l;
      46:     union
      47:     {
      48:         double pdouble;
      49:         long   plong[2];
      50:     }f;
      51:
      52:     if (r == TR_NIL)
      53:         return (NLNIL);
      54:     if (nowexp(r))
      55:         return (NLNIL);
      56:     /*
      57: 	 * The root of the tree tells us what sort of expression we have.
      58: 	 */
      59:     switch (r->tag) {
      60:
      61:     /*
      62: 	 * The constant nil
      63: 	 */
      64:     case T_NIL:
      65: #		ifdef OBJ
      66:             (void) put(2, O_CON14, 0);
      67: #		endif OBJ
      68: #		ifdef PC
      69:             putleaf( PCC_ICON , 0 , 0 , PCCT_INT , (char *) 0 );
      70: #		endif PC
      71:         return (nl+TNIL);
      72:
      73:     case T_FCALL:
      74:     case T_VAR:
      75:         p = lookup(r->var_node.cptr);
      76:         if (p == NLNIL || p->class == BADUSE)
      77:             return (NLNIL);
      78:         switch (p->class) {
      79:         case VAR:
      80:             /*
      81: 			 * if a variable is
      82: 			 * qualified then get
      83: 			 * the rvalue by a
      84: 			 * stklval and an ind.
      85: 			 */
      86:             if (r->var_node.qual != TR_NIL)
      87:                 goto ind;
      88:             q = p->type;
      89:             if (q == NLNIL)
      90:                 return (NLNIL);
      91:             if (classify(q) == TSTR)
      92:                 return(stklval(r, NOFLAGS));
      93: #			ifdef OBJ
      94:                 return (stackRV(p));
      95: #			endif OBJ
      96: #			ifdef PC
      97:                 q = rvalue( r , contype , (int) required );
      98:                 if (isa(q, "sbci")) {
      99:                 sconv(p2type(q),PCCT_INT);
     100:                 }
     101:                 return q;
     102: #			endif PC
     103:
     104:         case WITHPTR:
     105:         case REF:
     106:             /*
     107: 			 * A stklval for these
     108: 			 * is actually what one
     109: 			 * might consider a rvalue.
     110: 			 */
     111: ind:
     112:             q = stklval(r, NOFLAGS);
     113:             if (q == NLNIL)
     114:                 return (NLNIL);
     115:             if (classify(q) == TSTR)
     116:                 return(q);
     117: #			ifdef OBJ
     118:                 w = width(q);
     119:                 switch (w) {
     120:                     case 8:
     121:                         (void) put(1, O_IND8);
     122:                         return(q);
     123:                     case 4:
     124:                         (void) put(1, O_IND4);
     125:                         return(q);
     126:                     case 2:
     127:                         (void) put(1, O_IND24);
     128:                         return(q);
     129:                     case 1:
     130:                         (void) put(1, O_IND14);
     131:                         return(q);
     132:                     default:
     133:                         (void) put(2, O_IND, w);
     134:                         return(q);
     135:                 }
     136: #			endif OBJ
     137: #			ifdef PC
     138:                 if ( required == RREQ ) {
     139:                 putop( PCCOM_UNARY PCC_MUL , p2type( q ) );
     140:                 if (isa(q,"sbci")) {
     141:                     sconv(p2type(q),PCCT_INT);
     142:                 }
     143:                 }
     144:                 return q;
     145: #			endif PC
     146:
     147:         case CONST:
     148:             if (r->var_node.qual != TR_NIL) {
     149:                 error("%s is a constant and cannot be qualified", r->var_node.cptr);
     150:                 return (NLNIL);
     151:             }
     152:             q = p->type;
     153:             if (q == NLNIL)
     154:                 return (NLNIL);
     155:             if (q == nl+TSTR) {
     156:                 /*
     157: 				 * Find the size of the string
     158: 				 * constant if needed.
     159: 				 */
     160:                 cp = (char *) p->ptr[0];
     161: cstrng:
     162:                 cp1 = cp;
     163:                 for (c = 0; *cp++; c++)
     164:                     continue;
     165:                 w = c;
     166:                 if (contype != NIL && !opt('s')) {
     167:                     if (width(contype) < c && classify(contype) == TSTR) {
     168:                         error("Constant string too long");
     169:                         return (NLNIL);
     170:                     }
     171:                     w = width(contype);
     172:                 }
     173: #				ifdef OBJ
     174:                     (void) put(2, O_LVCON, lenstr(cp1, w - c));
     175:                     putstr(cp1, w - c);
     176: #				endif OBJ
     177: #				ifdef PC
     178:                     putCONG( cp1 , w , LREQ );
     179: #				endif PC
     180:                 /*
     181: 				 * Define the string temporarily
     182: 				 * so later people can know its
     183: 				 * width.
     184: 				 * cleaned out by stat.
     185: 				 */
     186:                 q = defnl((char *) 0, STR, NLNIL, w);
     187:                 q->type = q;
     188:                 return (q);
     189:             }
     190:             if (q == nl+T1CHAR) {
     191: #			    ifdef OBJ
     192:                 (void) put(2, O_CONC4, (int)p->value[0]);
     193: #			    endif OBJ
     194: #			    ifdef PC
     195:                 putleaf(PCC_ICON, p -> value[0], 0, PCCT_INT,
     196:                         (char *) 0);
     197: #			    endif PC
     198:                 return(q);
     199:             }
     200:             /*
     201: 			 * Every other kind of constant here
     202: 			 */
     203: #			ifdef OBJ
     204:                 switch (width(q)) {
     205:                 case 8:
     206: #ifndef DEBUG
     207:                     (void) put(2, O_CON8, p->real);
     208:                     return(q);
     209: #else
     210:                     if (hp21mx) {
     211:                         f.pdouble = p->real;
     212:                         conv((int *) (&f.pdouble));
     213:                         l = f.plong[1];
     214:                         (void) put(2, O_CON4, l);
     215:                     } else
     216:                         (void) put(2, O_CON8, p->real);
     217:                     return(q);
     218: #endif
     219:                 case 4:
     220:                     (void) put(2, O_CON4, p->range[0]);
     221:                     return(q);
     222:                 case 2:
     223:                     (void) put(2, O_CON24, (short)p->range[0]);
     224:                     return(q);
     225:                 case 1:
     226:                     (void) put(2, O_CON14, p->value[0]);
     227:                     return(q);
     228:                 default:
     229:                     panic("stkrval");
     230:                 }
     231: #			endif OBJ
     232: #			ifdef PC
     233:                 q = rvalue( r , contype , (int) required );
     234:                 if (isa(q,"sbci")) {
     235:                 sconv(p2type(q),PCCT_INT);
     236:                 }
     237:                 return q;
     238: #			endif PC
     239:
     240:         case FUNC:
     241:         case FFUNC:
     242:             /*
     243: 			 * Function call
     244: 			 */
     245:             pt = r->var_node.qual;
     246:             if (pt != TR_NIL) {
     247:                 switch (pt->list_node.list->tag) {
     248:                 case T_PTR:
     249:                 case T_ARGL:
     250:                 case T_ARY:
     251:                 case T_FIELD:
     252:                     error("Can't qualify a function result value");
     253:                     return (NLNIL);
     254:                 }
     255:             }
     256: #			ifdef OBJ
     257:                 q = p->type;
     258:                 if (classify(q) == TSTR) {
     259:                     c = width(q);
     260:                     (void) put(2, O_LVCON, even(c+1));
     261:                     putstr("", c);
     262:                     (void) put(1, PTR_DUP);
     263:                     p = funccod(r);
     264:                     (void) put(2, O_AS, c);
     265:                     return(p);
     266:                 }
     267:                 p = funccod(r);
     268:                 if (width(p) <= 2)
     269:                     (void) put(1, O_STOI);
     270: #			endif OBJ
     271: #			ifdef PC
     272:                 p = pcfunccod( r );
     273:                 if (isa(p,"sbci")) {
     274:                 sconv(p2type(p),PCCT_INT);
     275:                 }
     276: #			endif PC
     277:             return (p);
     278:
     279:         case TYPE:
     280:             error("Type names (e.g. %s) allowed only in declarations", p->symbol);
     281:             return (NLNIL);
     282:
     283:         case PROC:
     284:         case FPROC:
     285:             error("Procedure %s found where expression required", p->symbol);
     286:             return (NLNIL);
     287:         default:
     288:             panic("stkrvid");
     289:         }
     290:     case T_PLUS:
     291:     case T_MINUS:
     292:     case T_NOT:
     293:     case T_AND:
     294:     case T_OR:
     295:     case T_DIVD:
     296:     case T_MULT:
     297:     case T_SUB:
     298:     case T_ADD:
     299:     case T_MOD:
     300:     case T_DIV:
     301:     case T_EQ:
     302:     case T_NE:
     303:     case T_GE:
     304:     case T_LE:
     305:     case T_GT:
     306:     case T_LT:
     307:     case T_IN:
     308:         p = rvalue(r, contype , (int) required );
     309: #		ifdef OBJ
     310:             if (width(p) <= 2)
     311:                 (void) put(1, O_STOI);
     312: #		endif OBJ
     313: #		ifdef PC
     314:             if (isa(p,"sbci")) {
     315:             sconv(p2type(p),PCCT_INT);
     316:             }
     317: #		endif PC
     318:         return (p);
     319:     case T_CSET:
     320:         p = rvalue(r, contype , (int) required );
     321:         return (p);
     322:     default:
     323:         if (r->const_node.cptr == (char *) NIL)
     324:             return (NLNIL);
     325:         switch (r->tag) {
     326:         default:
     327:             panic("stkrval3");
     328:
     329:         /*
     330: 		 * An octal number
     331: 		 */
     332:         case T_BINT:
     333:             f.pdouble = a8tol(r->const_node.cptr);
     334:             goto conint;
     335:
     336:         /*
     337: 		 * A decimal number
     338: 		 */
     339:         case T_INT:
     340:             f.pdouble = atof(r->const_node.cptr);
     341: conint:
     342:             if (f.pdouble > MAXINT || f.pdouble < MININT) {
     343:                 error("Constant too large for this implementation");
     344:                 return (NLNIL);
     345:             }
     346:             l = f.pdouble;
     347:             if (bytes(l, l) <= 2) {
     348: #			    ifdef OBJ
     349:                 (void) put(2, O_CON24, (short)l);
     350: #			    endif OBJ
     351: #			    ifdef PC
     352:                 putleaf( PCC_ICON , (short) l , 0 , PCCT_INT ,
     353:                         (char *) 0 );
     354: #			    endif PC
     355:                 return(nl+T4INT);
     356:             }
     357: #			ifdef OBJ
     358:                 (void) put(2, O_CON4, l);
     359: #			endif OBJ
     360: #			ifdef PC
     361:                 putleaf( PCC_ICON , (int) l , 0 , PCCT_INT , (char *) 0 );
     362: #			endif PC
     363:             return (nl+T4INT);
     364:
     365:         /*
     366: 		 * A floating point number
     367: 		 */
     368:         case T_FINT:
     369: #		   	ifdef OBJ
     370:                 (void) put(2, O_CON8, atof(r->const_node.cptr));
     371: #			endif OBJ
     372: #			ifdef PC
     373:                 putCON8( atof( r->const_node.cptr ) );
     374: #			endif PC
     375:             return (nl+TDOUBLE);
     376:
     377:         /*
     378: 		 * Constant strings.  Note that constant characters
     379: 		 * are constant strings of length one; there is
     380: 		 * no constant string of length one.
     381: 		 */
     382:         case T_STRNG:
     383:             cp = r->const_node.cptr;
     384:             if (cp[1] == 0) {
     385: #				ifdef OBJ
     386:                     (void) put(2, O_CONC4, cp[0]);
     387: #				endif OBJ
     388: #				ifdef PC
     389:                     putleaf( PCC_ICON , cp[0] , 0 , PCCT_INT ,
     390:                         (char *) 0 );
     391: #				endif PC
     392:                 return(nl+T1CHAR);
     393:             }
     394:             goto cstrng;
     395:         }
     396:
     397:     }
     398: }
     399:
     400: #ifdef OBJ
     401: /*
     402:  * push a value onto the interpreter stack, longword aligned.
     403:  */
     404: struct nl
     405: *stackRV(p)
     406:     struct nl *p;
     407: {
     408:     struct nl *q;
     409:     int w, bn;
     410:
     411:     q = p->type;
     412:     if (q == NLNIL)
     413:         return (NLNIL);
     414:     bn = BLOCKNO(p->nl_block);
     415:     w = width(q);
     416:     switch (w) {
     417:     case 8:
     418:         (void) put(2, O_RV8 | bn << 8+INDX, (int)p->value[0]);
     419:         break;
     420:     case 4:
     421:         (void) put(2, O_RV4 | bn << 8+INDX, (int)p->value[0]);
     422:         break;
     423:     case 2:
     424:         (void) put(2, O_RV24 | bn << 8+INDX, (int)p->value[0]);
     425:         break;
     426:     case 1:
     427:         (void) put(2, O_RV14 | bn << 8+INDX, (int)p->value[0]);
     428:         break;
     429:     default:
     430:         (void) put(3, O_RV | bn << 8+INDX, (int)p->value[0], w);
     431:         break;
     432:     }
     433:     return (q);
     434: }
     435: #endif OBJ

#### Defined functions

stackRV defined in line 404; used 3 times

- in line 94
- in /usr/src/ucb/PORT/pascal/src/0.h line 752
- in /usr/src/ucb/PORT/pascal/src/forop.c line 335

stkrval defined in line 34; used 69 times

- in /usr/src/ucb/PORT/pascal/src/0.h line 747
- in /usr/src/ucb/PORT/pascal/src/call.c line 347, 355-360(2)
- in /usr/src/ucb/PORT/pascal/src/cset.c line 461-464(3)
- in /usr/src/ucb/PORT/pascal/src/func.c line 124
- in /usr/src/ucb/PORT/pascal/src/pcfunc.c line 151, 191, 202, 211, 222, 234, 242, 249, 281, 308, 317, 332, 348-351(2), 362
- in /usr/src/ucb/PORT/pascal/src/pcproc.c line 205, 281, 576, 582, 663, 679, 750, 774-778(2), 789, 819, 825, 924, 1199, 1288, 1335, 1364, 1382, 1410, 1473, 1484, 1521
- in /usr/src/ucb/PORT/pascal/src/proc.c line 186, 247, 387-390(2), 412, 419, 433, 439, 512, 539, 638, 679, 861, 872, 967, 990, 1008, 1018, 1029, 1074, 1084, 1169
- in /usr/src/ucb/PORT/pascal/src/rval.c line 911, 938

#### Defined variables

sccsid defined in line 8; never used

Last modified: 1985-06-05 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1311 |