1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 #ifndef lint 4 static char sccsid[] = "@(#)stat.c 2.1 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 int clas; 356 #ifdef OBJ 357 int w; 358 #endif OBJ 359 360 #ifdef OBJ 361 if (p == NLNIL) { 362 p = lvalue(r->lhs_var, MOD|ASGN|NOUSE , LREQ ); 363 if ( p == NLNIL ) { 364 (void) rvalue( r->rhs_expr , NLNIL , RREQ ); 365 return NLNIL; 366 } 367 w = width(p); 368 } else { 369 /* 370 * assigning to the return value, which is at least 371 * of width two since it resides on the stack 372 */ 373 w = width(p); 374 if (w < 2) 375 w = 2; 376 } 377 clas = classify(p); 378 if ((clas == TARY || clas == TSTR) && p->chain->class == CRANGE) { 379 p1 = lvalue(r->rhs_expr, p , LREQ ); /* SHOULD THIS BE rvalue? */ 380 } else { 381 p1 = rvalue(r->rhs_expr, p , RREQ ); 382 } 383 # endif OBJ 384 # ifdef PC 385 if (p == NLNIL) { 386 /* check for conformant array type */ 387 codeoff(); 388 p = rvalue(r->lhs_var, MOD|ASGN|NOUSE, LREQ); 389 codeon(); 390 if (p == NLNIL) { 391 (void) rvalue(r->rhs_expr, NLNIL, RREQ); 392 return NLNIL; 393 } 394 clas = classify(p); 395 if ((clas == TARY || clas == TSTR) && p->chain->class == CRANGE) { 396 return pcasgconf(r, p); 397 } else { 398 /* 399 * since the second pass knows that it should reference 400 * the lefthandside of asignments, what i need here is 401 * an rvalue. 402 */ 403 p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , RREQ ); 404 } 405 if ( p == NLNIL ) { 406 (void) rvalue( r->rhs_expr , NLNIL , RREQ ); 407 return NLNIL; 408 } 409 } 410 /* 411 * if this is a scalar assignment, 412 * then i want to rvalue the righthandside. 413 * if this is a structure assignment, 414 * then i want an lvalue to the righthandside. 415 * that's what the intermediate form sez. 416 */ 417 switch ( classify( p ) ) { 418 case TINT: 419 case TCHAR: 420 case TBOOL: 421 case TSCAL: 422 precheck( p , "_RANG4" , "_RSNG4" ); 423 /* and fall through */ 424 case TDOUBLE: 425 case TPTR: 426 p1 = rvalue( r->rhs_expr , p , RREQ ); 427 break; 428 default: 429 p1 = rvalue( r->rhs_expr , p , LREQ ); 430 break; 431 } 432 # endif PC 433 if (p1 == NLNIL) 434 return (NLNIL); 435 if (incompat(p1, p, r->rhs_expr)) { 436 cerror("Type of expression clashed with type of variable in assignment"); 437 return (NLNIL); 438 } 439 # ifdef OBJ 440 switch (classify(p)) { 441 case TINT: 442 case TBOOL: 443 case TCHAR: 444 case TSCAL: 445 rangechk(p, p1); 446 (void) gen(O_AS2, O_AS2, w, width(p1)); 447 break; 448 case TDOUBLE: 449 case TPTR: 450 (void) gen(O_AS2, O_AS2, w, width(p1)); 451 break; 452 case TARY: 453 case TSTR: 454 if (p->chain->class == CRANGE) { 455 /* conformant array assignment */ 456 p1 = p->chain; 457 w = width(p1->type); 458 putcbnds(p1, 1); 459 putcbnds(p1, 0); 460 gen(NIL, T_SUB, w, w); 461 put(2, w > 2? O_CON24: O_CON2, 1); 462 gen(NIL, T_ADD, w, w); 463 putcbnds(p1, 2); 464 gen(NIL, T_MULT, w, w); 465 put(1, O_VAS); 466 break; 467 } 468 /* else fall through */ 469 default: 470 (void) put(2, O_AS, w); 471 break; 472 } 473 # endif OBJ 474 # ifdef PC 475 switch (classify(p)) { 476 case TINT: 477 case TBOOL: 478 case TCHAR: 479 case TSCAL: 480 postcheck(p, p1); 481 sconv(p2type(p1), p2type(p)); 482 putop( P2ASSIGN , p2type( p ) ); 483 putdot( filename , line ); 484 break; 485 case TPTR: 486 putop( P2ASSIGN , p2type( p ) ); 487 putdot( filename , line ); 488 break; 489 case TDOUBLE: 490 sconv(p2type(p1), p2type(p)); 491 putop( P2ASSIGN , p2type( p ) ); 492 putdot( filename , line ); 493 break; 494 default: 495 putstrop(P2STASG, ADDTYPE(p2type(p), P2PTR), 496 (int) lwidth(p), align(p)); 497 putdot( filename , line ); 498 break; 499 } 500 # endif PC 501 return (p); /* Used by for statement */ 502 } 503 504 #ifdef PC 505 /* 506 * assignment to conformant arrays. Since these are variable length, 507 * we use blkcpy() to perform the assignment. 508 * blkcpy(rhs, lhs, (upper - lower + 1) * width) 509 */ 510 struct nl * 511 pcasgconf(r, p) 512 register ASG_NODE *r; 513 struct nl *p; 514 { 515 struct nl *p1; 516 517 if (r == (ASG_NODE *) TR_NIL || p == NLNIL) 518 return NLNIL; 519 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR) , "_blkcpy" ); 520 p1 = rvalue( r->rhs_expr , p , LREQ ); 521 if (p1 == NLNIL) 522 return NLNIL; 523 p = lvalue( r->lhs_var , MOD|ASGN|NOUSE , LREQ ); 524 if (p == NLNIL) 525 return NLNIL; 526 putop(P2LISTOP, P2INT); 527 /* upper bound */ 528 p1 = p->chain->nptr[1]; 529 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0], 530 p1->extra_flags, p2type( p1 ) ); 531 /* minus lower bound */ 532 p1 = p->chain->nptr[0]; 533 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0], 534 p1->extra_flags, p2type( p1 ) ); 535 putop( P2MINUS, P2INT ); 536 /* add one */ 537 putleaf(P2ICON, 1, 0, P2INT, 0); 538 putop( P2PLUS, P2INT ); 539 /* and multiply by the width */ 540 p1 = p->chain->nptr[2]; 541 putRV(p1->symbol, (p1->nl_block & 037), p1->value[0], 542 p1->extra_flags, p2type( p1 ) ); 543 putop( P2MUL , P2INT ); 544 putop(P2LISTOP, P2INT); 545 putop(P2CALL, P2INT); 546 putdot( filename , line); 547 return p; 548 } 549 #endif PC 550 551 /* 552 * if expr then stat [ else stat ] 553 */ 554 ifop(if_n) 555 IF_NODE *if_n; 556 { 557 register struct nl *p; 558 register l1, l2; /* l1 is start of else, l2 is end of else */ 559 int goc; 560 bool nr; 561 562 goc = gocnt; 563 putline(); 564 p = rvalue(if_n->cond_expr, NLNIL , RREQ ); 565 if (p == NIL) { 566 statement(if_n->then_stmnt); 567 noreach = FALSE; 568 statement(if_n->else_stmnt); 569 noreach = FALSE; 570 return; 571 } 572 if (isnta(p, "b")) { 573 error("Type of expression in if statement must be Boolean, not %s", nameof(p)); 574 statement(if_n->then_stmnt); 575 noreach = FALSE; 576 statement(if_n->else_stmnt); 577 noreach = FALSE; 578 return; 579 } 580 # ifdef OBJ 581 l1 = put(2, O_IF, getlab()); 582 # endif OBJ 583 # ifdef PC 584 l1 = (int) getlab(); 585 putleaf( P2ICON , l1 , 0 , P2INT , (char *) 0 ); 586 putop( P2CBRANCH , P2INT ); 587 putdot( filename , line ); 588 # endif PC 589 putcnt(); 590 statement(if_n->then_stmnt); 591 nr = noreach; 592 if (if_n->else_stmnt != TR_NIL) { 593 /* 594 * else stat 595 */ 596 --level; 597 ungoto(); 598 ++level; 599 # ifdef OBJ 600 l2 = put(2, O_TRA, getlab()); 601 # endif OBJ 602 # ifdef PC 603 l2 = (int) getlab(); 604 putjbr( (long) l2 ); 605 # endif PC 606 patch((PTR_DCL)l1); 607 noreach = FALSE; 608 statement(if_n->else_stmnt); 609 noreach = (noreach && nr)?TRUE:FALSE; 610 l1 = l2; 611 } else 612 noreach = FALSE; 613 patch((PTR_DCL)l1); 614 if (goc != gocnt) 615 putcnt(); 616 } 617 618 /* 619 * while expr do stat 620 */ 621 whilop(w_node) 622 WHI_CAS *w_node; 623 { 624 register struct nl *p; 625 register char *l1, *l2; 626 int goc; 627 628 goc = gocnt; 629 l1 = getlab(); 630 (void) putlab(l1); 631 putline(); 632 p = rvalue(w_node->expr, NLNIL , RREQ ); 633 if (p == NLNIL) { 634 statement(w_node->stmnt_list); 635 noreach = FALSE; 636 return; 637 } 638 if (isnta(p, "b")) { 639 error("Type of expression in while statement must be Boolean, not %s", nameof(p)); 640 statement(w_node->stmnt_list); 641 noreach = FALSE; 642 return; 643 } 644 l2 = getlab(); 645 # ifdef OBJ 646 (void) put(2, O_IF, l2); 647 # endif OBJ 648 # ifdef PC 649 putleaf( P2ICON , (int) l2 , 0 , P2INT , (char *) 0 ); 650 putop( P2CBRANCH , P2INT ); 651 putdot( filename , line ); 652 # endif PC 653 putcnt(); 654 statement(w_node->stmnt_list); 655 # ifdef OBJ 656 (void) put(2, O_TRA, l1); 657 # endif OBJ 658 # ifdef PC 659 putjbr( (long) l1 ); 660 # endif PC 661 patch((PTR_DCL) l2); 662 if (goc != gocnt) 663 putcnt(); 664 } 665 666 /* 667 * repeat stat* until expr 668 */ 669 repop(r) 670 REPEAT *r; 671 { 672 register struct nl *p; 673 register l; 674 int goc; 675 676 goc = gocnt; 677 l = (int) putlab(getlab()); 678 putcnt(); 679 statlist(r->stmnt_list); 680 line = r->line_no; 681 p = rvalue(r->term_expr, NLNIL , RREQ ); 682 if (p == NLNIL) 683 return; 684 if (isnta(p,"b")) { 685 error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p)); 686 return; 687 } 688 # ifdef OBJ 689 (void) put(2, O_IF, l); 690 # endif OBJ 691 # ifdef PC 692 putleaf( P2ICON , l , 0 , P2INT , (char *) 0 ); 693 putop( P2CBRANCH , P2INT ); 694 putdot( filename , line ); 695 # endif PC 696 if (goc != gocnt) 697 putcnt(); 698 } 699