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
|
Last modified: 1985-06-05
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 3457 |
|