1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 #ifndef lint 4 static char sccsid[] = "@(#)stat.c 1.14 02/08/84"; 5 #endif 6 7 #include "whoami.h" 8 #include "0.h" 9 #include "tree.h" 10 #include "objfmt.h" 11 #ifdef PC 12 # include "pcops.h" 13 # include "pc.h" 14 #endif PC 15 #include "tmps.h" 16 17 int cntstat; 18 short cnts = 3; 19 #include "opcode.h" 20 #include "tree_ty.h" 21 22 /* 23 * Statement list 24 */ 25 statlist(r) 26 struct tnode *r; 27 { 28 register struct tnode *sl; 29 30 for (sl=r; sl != TR_NIL; sl=sl->list_node.next) 31 statement(sl->list_node.list); 32 } 33 34 /* 35 * Statement 36 */ 37 statement(r) 38 struct tnode *r; 39 { 40 register struct tnode *tree_node; 41 register struct nl *snlp; 42 struct tmps soffset; 43 44 tree_node = r; 45 snlp = nlp; 46 soffset = sizes[cbn].curtmps; 47 top: 48 if (cntstat) { 49 cntstat = 0; 50 putcnt(); 51 } 52 if (tree_node == TR_NIL) 53 return; 54 line = tree_node->lined.line_no; 55 if (tree_node->tag == T_LABEL) { 56 labeled(tree_node->label_node.lbl_ptr); 57 tree_node = tree_node->label_node.stmnt; 58 noreach = FALSE; 59 cntstat = 1; 60 goto top; 61 } 62 if (noreach) { 63 noreach = FALSE; 64 warning(); 65 error("Unreachable statement"); 66 } 67 switch (tree_node->tag) { 68 case T_PCALL: 69 putline(); 70 # ifdef OBJ 71 proc(tree_node); 72 # endif OBJ 73 # ifdef PC 74 pcproc( tree_node ); 75 # endif PC 76 break; 77 case T_ASGN: 78 putline(); 79 asgnop(&(tree_node->asg_node)); 80 break; 81 case T_GOTO: 82 putline(); 83 gotoop(tree_node->goto_node.lbl_ptr); 84 noreach = TRUE; 85 cntstat = 1; 86 break; 87 default: 88 level++; 89 switch (tree_node->tag) { 90 default: 91 panic("stat"); 92 case T_IF: 93 case T_IFEL: 94 ifop(&(tree_node->if_node)); 95 break; 96 case T_WHILE: 97 whilop(&(tree_node->whi_cas)); 98 noreach = FALSE; 99 break; 100 case T_REPEAT: 101 repop(&(tree_node->repeat)); 102 break; 103 case T_FORU: 104 case T_FORD: 105 forop(tree_node); 106 noreach = FALSE; 107 break; 108 case T_BLOCK: 109 statlist(tree_node->stmnt_blck.stmnt_list); 110 break; 111 case T_CASE: 112 putline(); 113 # ifdef OBJ 114 caseop(&(tree_node->whi_cas)); 115 # endif OBJ 116 # ifdef PC 117 pccaseop(&(tree_node->whi_cas)); 118 # endif PC 119 break; 120 case T_WITH: 121 withop(&(tree_node->with_node)); 122 break; 123 } 124 --level; 125 if (gotos[cbn]) 126 ungoto(); 127 break; 128 } 129 /* 130 * Free the temporary name list entries defined in 131 * expressions, e.g. STRs, and WITHPTRs from withs. 132 */ 133 nlfree(snlp); 134 /* 135 * free any temporaries allocated for this statement 136 * these come from strings and sets. 137 */ 138 tmpfree(&soffset); 139 } 140 141 ungoto() 142 { 143 register struct nl *p; 144 145 for (p = gotos[cbn]; p != NLNIL; p = p->chain) 146 if ((p->nl_flags & NFORWD) != 0) { 147 if (p->value[NL_GOLEV] != NOTYET) 148 if (p->value[NL_GOLEV] > level) 149 p->value[NL_GOLEV] = level; 150 } else 151 if (p->value[NL_GOLEV] != DEAD) 152 if (p->value[NL_GOLEV] > level) 153 p->value[NL_GOLEV] = DEAD; 154 } 155 156 putcnt() 157 { 158 159 if (monflg == FALSE) { 160 return; 161 } 162 inccnt( getcnt() ); 163 } 164 165 int 166 getcnt() 167 { 168 169 return ++cnts; 170 } 171 172 inccnt( counter ) 173 int counter; 174 { 175 176 # ifdef OBJ 177 (void) put(2, O_COUNT, counter ); 178 # endif OBJ 179 # ifdef PC 180 putRV( PCPCOUNT , 0 , counter * sizeof (long) , NGLOBAL , P2INT ); 181 putleaf( P2ICON , 1 , 0 , P2INT , (char *) 0 ); 182 putop( P2ASG P2PLUS , P2INT ); 183 putdot( filename , line ); 184 # endif PC 185 } 186 187 putline() 188 { 189 190 # ifdef OBJ 191 if (opt('p') != 0) 192 (void) put(2, O_LINO, line); 193 194 /* 195 * put out line number information for pdx 196 */ 197 lineno(line); 198 199 # endif OBJ 200 # ifdef PC 201 static lastline; 202 203 if ( line != lastline ) { 204 stabline( line ); 205 lastline = line; 206 } 207 if ( opt( 'p' ) ) { 208 if ( opt('t') ) { 209 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 210 , "_LINO" ); 211 putop( P2UNARY P2CALL , P2INT ); 212 putdot( filename , line ); 213 } else { 214 putRV( STMTCOUNT , 0 , 0 , NGLOBAL , P2INT ); 215 putleaf( P2ICON , 1 , 0 , P2INT , (char *) 0 ); 216 putop( P2ASG P2PLUS , P2INT ); 217 putdot( filename , line ); 218 } 219 } 220 # endif PC 221 } 222 223 /* 224 * With varlist do stat 225 * 226 * With statement requires an extra word 227 * in automatic storage for each level of withing. 228 * These indirect pointers are initialized here, and 229 * the scoping effect of the with statement occurs 230 * because lookup examines the field names of the records 231 * associated with the WITHPTRs on the withlist. 232 */ 233 withop(s) 234 WITH_NODE *s; 235 { 236 register struct tnode *p; 237 register struct nl *r; 238 struct nl *tempnlp; 239 struct nl *swl; 240 241 putline(); 242 swl = withlist; 243 for (p = s->var_list; p != TR_NIL; p = p->list_node.next) { 244 tempnlp = tmpalloc((long) (sizeof(int *)), nl+TPTR, REGOK); 245 /* 246 * no one uses the allocated temporary namelist entry, 247 * since we have to use it before we know its type; 248 * but we use its runtime location for the with pointer. 249 */ 250 # ifdef OBJ 251 (void) put(2, O_LV | cbn <<8+INDX, tempnlp -> value[ NL_OFFS ] ); 252 # endif OBJ 253 # ifdef PC 254 putRV( (char *) 0 , cbn , tempnlp -> value[ NL_OFFS ] , 255 tempnlp -> extra_flags , P2PTR|P2STRTY ); 256 # endif PC 257 r = lvalue(p->list_node.list, MOD , LREQ ); 258 if (r == NLNIL) 259 continue; 260 if (r->class != RECORD) { 261 error("Variable in with statement refers to %s, not to a record", nameof(r)); 262 continue; 263 } 264 r = defnl((char *) 0, WITHPTR, r, tempnlp -> value[ NL_OFFS ] ); 265 # ifdef PC 266 r -> extra_flags |= tempnlp -> extra_flags; 267 # endif PC 268 r->nl_next = withlist; 269 withlist = r; 270 # ifdef OBJ 271 (void) put(1, PTR_AS); 272 # endif OBJ 273 # ifdef PC 274 putop( P2ASSIGN , P2PTR|P2STRTY ); 275 putdot( filename , line ); 276 # endif PC 277 } 278 statement(s->stmnt); 279 withlist = swl; 280 } 281 282 extern flagwas; 283 /* 284 * var := expr 285 */ 286 asgnop(r) 287 ASG_NODE *r; 288 { 289 register struct nl *p; 290 register struct tnode *av; 291 292 /* 293 * Asgnop's only function is 294 * to handle function variable 295 * assignments. All other assignment 296 * stuff is handled by asgnop1. 297 * the if below checks for unqualified lefthandside: 298 * necessary for fvars. 299 */ 300 av = r->lhs_var; 301 if (av != TR_NIL && av->tag == T_VAR && av->var_node.qual == TR_NIL) { 302 p = lookup1(av->var_node.cptr); 303 if (p != NLNIL) 304 p->nl_flags = flagwas; 305 if (p != NLNIL && p->class == FVAR) { 306 /* 307 * Give asgnop1 the func 308 * which is the chain of 309 * the FVAR. 310 */ 311 p->nl_flags |= NUSED|NMOD; 312 p = p->chain; 313 if (p == NLNIL) { 314 p = rvalue(r->rhs_expr, NLNIL , RREQ ); 315 return; 316 } 317 # ifdef OBJ 318 (void) put(2, O_LV | bn << 8+INDX, (int)p->value[NL_OFFS]); 319 if (isa(p->type, "i") && width(p->type) == 1) 320 (void) asgnop1(r, nl+T2INT); 321 else 322 (void) asgnop1(r, p->type); 323 # endif OBJ 324 # ifdef PC 325 /* 326 * this should be the lvalue of the fvar, 327 * but since the second pass knows to use 328 * the address of the left operand of an 329 * assignment, what i want here is an rvalue. 330 * see note in funchdr about fvar allocation. 331 */ 332 p = p -> ptr[ NL_FVAR ]; 333 putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 334 p -> extra_flags , p2type( p -> type ) ); 335 (void) asgnop1( r , p -> type ); 336 # endif PC 337 return; 338 } 339 } 340 (void) asgnop1(r, NLNIL); 341 } 342 343 /* 344 * Asgnop1 handles all assignments. 345 * If p is not nil then we are assigning 346 * to a function variable, otherwise 347 * we look the variable up ourselves. 348 */ 349 struct nl * 350 asgnop1(r, p) 351 ASG_NODE *r; 352 register struct nl *p; 353 { 354 register struct nl *p1; 355 #ifdef OBJ 356 int w; 357 #endif 358 359 if (p == NLNIL) { 360 # ifdef OBJ 361 p = lvalue(r->lhs_var, MOD|ASGN|NOUSE , LREQ ); 362 w = width(p); 363 # endif OBJ 364 # ifdef PC 365 /* check for conformant array type */ 366 codeoff(); 367 p = rvalue(r->lhs_var, MOD|ASGN|NOUSE, LREQ); 368 codeon(); 369 if ((classify(p) == TARY || classify(p) == TSTR) 370 && p->chain->class == CRANGE) { 371 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR) 372 , "_blkcpy" ); 373 /* find total size */ 374 /* upper bound */ 375 p1 = p->chain->nptr[1]; 376 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0], 377 p1->extra_flags, p2type( p1 ) ); 378 /* minus lower bound */ 379 p1 = p->chain->nptr[0]; 380 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0], 381 p1->extra_flags, p2type( p1 ) ); 382 putop( P2MINUS, P2INT ); 383 /* add one */ 384 putleaf(P2ICON, 1, 0, P2INT, 0); 385 putop( P2PLUS, P2INT ); 386 /* and multiply by the width */ 387 p1 = p->chain->nptr[2]; 388 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0], 389 p1->extra_flags, p2type( p1 ) ); 390 putop( P2MUL , P2INT ); 391 p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , RREQ ); 392 putop(P2LISTOP, P2INT); 393 } else { 394 /* 395 * since the second pass knows that it should reference 396 * the lefthandside of asignments, what i need here is 397 * an rvalue. 398 */ 399 p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , RREQ ); 400 } 401 # endif PC 402 if ( p == NLNIL ) { 403 (void) rvalue( r->rhs_expr , NLNIL , RREQ ); 404 return NLNIL; 405 } 406 } 407 # ifdef OBJ 408 /* 409 * assigning to the return value, which is at least 410 * of width two since it resides on the stack 411 */ 412 else { 413 w = width(p); 414 if (w < 2) 415 w = 2; 416 } 417 if ((classify(p) == TARY || classify(p) == TSTR) 418 && p->chain->class == CRANGE) { 419 p1 = lvalue(r->rhs_expr, p , LREQ ); 420 } else { 421 p1 = rvalue(r->rhs_expr, p , RREQ ); 422 } 423 # endif OBJ 424 # ifdef PC 425 /* 426 * if this is a scalar assignment, 427 * then i want to rvalue the righthandside. 428 * if this is a structure assignment, 429 * then i want an lvalue to the righthandside. 430 * that's what the intermediate form sez. 431 */ 432 switch ( classify( p ) ) { 433 case TINT: 434 case TCHAR: 435 case TBOOL: 436 case TSCAL: 437 precheck( p , "_RANG4" , "_RSNG4" ); 438 case TDOUBLE: 439 case TPTR: 440 p1 = rvalue( r->rhs_expr , p , RREQ ); 441 break; 442 default: 443 p1 = rvalue( r->rhs_expr , p , LREQ ); 444 break; 445 } 446 # endif PC 447 if (p1 == NLNIL) 448 return (NLNIL); 449 if (incompat(p1, p, r->rhs_expr)) { 450 cerror("Type of expression clashed with type of variable in assignment"); 451 return (NLNIL); 452 } 453 # ifdef OBJ 454 switch (classify(p)) { 455 case TINT: 456 case TBOOL: 457 case TCHAR: 458 case TSCAL: 459 rangechk(p, p1); 460 (void) gen(O_AS2, O_AS2, w, width(p1)); 461 break; 462 case TDOUBLE: 463 case TPTR: 464 (void) gen(O_AS2, O_AS2, w, width(p1)); 465 break; 466 case TARY: 467 case TSTR: 468 if (p->chain->class == CRANGE) { 469 /* conformant array assignment */ 470 p1 = p->chain; 471 w = width(p1->type); 472 putcbnds(p1, 1); 473 putcbnds(p1, 0); 474 gen(NIL, T_SUB, w, w); 475 put(2, w > 2? O_CON24: O_CON2, 1); 476 gen(NIL, T_ADD, w, w); 477 putcbnds(p1, 2); 478 gen(NIL, T_MULT, w, w); 479 put(1, O_VAS); 480 break; 481 } 482 /* else fall through */ 483 default: 484 (void) put(2, O_AS, w); 485 break; 486 } 487 # endif OBJ 488 # ifdef PC 489 switch (classify(p)) { 490 case TINT: 491 case TBOOL: 492 case TCHAR: 493 case TSCAL: 494 postcheck(p, p1); 495 sconv(p2type(p1), p2type(p)); 496 putop( P2ASSIGN , p2type( p ) ); 497 putdot( filename , line ); 498 break; 499 case TPTR: 500 putop( P2ASSIGN , p2type( p ) ); 501 putdot( filename , line ); 502 break; 503 case TDOUBLE: 504 sconv(p2type(p1), p2type(p)); 505 putop( P2ASSIGN , p2type( p ) ); 506 putdot( filename , line ); 507 break; 508 case TARY: 509 case TSTR: 510 /* handle conformant array assignment with 511 * library call. 512 */ 513 if (p->chain->class == CRANGE) { 514 putop(P2LISTOP, P2INT); 515 putop(P2CALL, P2INT); 516 putdot( filename , line); 517 break; 518 } 519 /* else fall through */ 520 default: 521 putstrop(P2STASG, ADDTYPE(p2type(p), P2PTR), 522 (int) lwidth(p), align(p)); 523 putdot( filename , line ); 524 break; 525 } 526 # endif PC 527 return (p); /* Used by for statement */ 528 } 529 530 /* 531 * if expr then stat [ else stat ] 532 */ 533 ifop(if_n) 534 IF_NODE *if_n; 535 { 536 register struct nl *p; 537 register l1, l2; /* l1 is start of else, l2 is end of else */ 538 int goc; 539 bool nr; 540 541 goc = gocnt; 542 putline(); 543 p = rvalue(if_n->cond_expr, NLNIL , RREQ ); 544 if (p == NIL) { 545 statement(if_n->then_stmnt); 546 noreach = FALSE; 547 statement(if_n->else_stmnt); 548 noreach = FALSE; 549 return; 550 } 551 if (isnta(p, "b")) { 552 error("Type of expression in if statement must be Boolean, not %s", nameof(p)); 553 statement(if_n->then_stmnt); 554 noreach = FALSE; 555 statement(if_n->else_stmnt); 556 noreach = FALSE; 557 return; 558 } 559 # ifdef OBJ 560 l1 = put(2, O_IF, getlab()); 561 # endif OBJ 562 # ifdef PC 563 l1 = (int) getlab(); 564 putleaf( P2ICON , l1 , 0 , P2INT , (char *) 0 ); 565 putop( P2CBRANCH , P2INT ); 566 putdot( filename , line ); 567 # endif PC 568 putcnt(); 569 statement(if_n->then_stmnt); 570 nr = noreach; 571 if (if_n->else_stmnt != TR_NIL) { 572 /* 573 * else stat 574 */ 575 --level; 576 ungoto(); 577 ++level; 578 # ifdef OBJ 579 l2 = put(2, O_TRA, getlab()); 580 # endif OBJ 581 # ifdef PC 582 l2 = (int) getlab(); 583 putjbr( (long) l2 ); 584 # endif PC 585 patch((PTR_DCL)l1); 586 noreach = FALSE; 587 statement(if_n->else_stmnt); 588 noreach = (noreach && nr)?TRUE:FALSE; 589 l1 = l2; 590 } else 591 noreach = FALSE; 592 patch((PTR_DCL)l1); 593 if (goc != gocnt) 594 putcnt(); 595 } 596 597 /* 598 * while expr do stat 599 */ 600 whilop(w_node) 601 WHI_CAS *w_node; 602 { 603 register struct nl *p; 604 register char *l1, *l2; 605 int goc; 606 607 goc = gocnt; 608 l1 = getlab(); 609 (void) putlab(l1); 610 putline(); 611 p = rvalue(w_node->expr, NLNIL , RREQ ); 612 if (p == NLNIL) { 613 statement(w_node->stmnt_list); 614 noreach = FALSE; 615 return; 616 } 617 if (isnta(p, "b")) { 618 error("Type of expression in while statement must be Boolean, not %s", nameof(p)); 619 statement(w_node->stmnt_list); 620 noreach = FALSE; 621 return; 622 } 623 l2 = getlab(); 624 # ifdef OBJ 625 (void) put(2, O_IF, l2); 626 # endif OBJ 627 # ifdef PC 628 putleaf( P2ICON , (int) l2 , 0 , P2INT , (char *) 0 ); 629 putop( P2CBRANCH , P2INT ); 630 putdot( filename , line ); 631 # endif PC 632 putcnt(); 633 statement(w_node->stmnt_list); 634 # ifdef OBJ 635 (void) put(2, O_TRA, l1); 636 # endif OBJ 637 # ifdef PC 638 putjbr( (long) l1 ); 639 # endif PC 640 patch((PTR_DCL) l2); 641 if (goc != gocnt) 642 putcnt(); 643 } 644 645 /* 646 * repeat stat* until expr 647 */ 648 repop(r) 649 REPEAT *r; 650 { 651 register struct nl *p; 652 register l; 653 int goc; 654 655 goc = gocnt; 656 l = (int) putlab(getlab()); 657 putcnt(); 658 statlist(r->stmnt_list); 659 line = r->line_no; 660 p = rvalue(r->term_expr, NLNIL , RREQ ); 661 if (p == NLNIL) 662 return; 663 if (isnta(p,"b")) { 664 error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p)); 665 return; 666 } 667 # ifdef OBJ 668 (void) put(2, O_IF, l); 669 # endif OBJ 670 # ifdef PC 671 putleaf( P2ICON , l , 0 , P2INT , (char *) 0 ); 672 putop( P2CBRANCH , P2INT ); 673 putdot( filename , line ); 674 # endif PC 675 if (goc != gocnt) 676 putcnt(); 677 } 678