1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)stat.c 1.1 08/27/80"; 4 5 #include "whoami.h" 6 #include "0.h" 7 #include "tree.h" 8 #include "objfmt.h" 9 #ifdef PC 10 # include "pcops.h" 11 # include "pc.h" 12 #endif PC 13 14 int cntstat; 15 short cnts = 3; 16 #include "opcode.h" 17 18 /* 19 * Statement list 20 */ 21 statlist(r) 22 int *r; 23 { 24 register *sl; 25 26 for (sl=r; sl != NIL; sl=sl[2]) 27 statement(sl[1]); 28 } 29 30 /* 31 * Statement 32 */ 33 statement(r) 34 int *r; 35 { 36 register *s; 37 register struct nl *snlp; 38 long soffset; 39 40 s = r; 41 snlp = nlp; 42 soffset = sizes[ cbn ].om_off; 43 top: 44 if (cntstat) { 45 cntstat = 0; 46 putcnt(); 47 } 48 if (s == NIL) 49 return; 50 line = s[1]; 51 if (s[0] == T_LABEL) { 52 labeled(s[2]); 53 s = s[3]; 54 noreach = 0; 55 cntstat = 1; 56 goto top; 57 } 58 if (noreach) { 59 noreach = 0; 60 warning(); 61 error("Unreachable statement"); 62 } 63 switch (s[0]) { 64 case T_PCALL: 65 putline(); 66 # ifdef OBJ 67 proc(s); 68 # endif OBJ 69 # ifdef PC 70 pcproc( s ); 71 # endif PC 72 break; 73 case T_ASGN: 74 putline(); 75 asgnop(s); 76 break; 77 case T_GOTO: 78 putline(); 79 gotoop(s[2]); 80 noreach = 1; 81 cntstat = 1; 82 break; 83 default: 84 level++; 85 switch (s[0]) { 86 default: 87 panic("stat"); 88 case T_IF: 89 case T_IFEL: 90 ifop(s); 91 break; 92 case T_WHILE: 93 whilop(s); 94 noreach = 0; 95 break; 96 case T_REPEAT: 97 repop(s); 98 break; 99 case T_FORU: 100 case T_FORD: 101 # ifdef OBJ 102 forop(s); 103 # endif OBJ 104 # ifdef PC 105 pcforop( s ); 106 # endif PC 107 noreach = 0; 108 break; 109 case T_BLOCK: 110 statlist(s[2]); 111 break; 112 case T_CASE: 113 putline(); 114 # ifdef OBJ 115 caseop(s); 116 # endif OBJ 117 # ifdef PC 118 pccaseop( s ); 119 # endif PC 120 break; 121 case T_WITH: 122 withop(s); 123 break; 124 case T_ASRT: 125 putline(); 126 asrtop(s); 127 break; 128 } 129 --level; 130 if (gotos[cbn]) 131 ungoto(); 132 break; 133 } 134 /* 135 * Free the temporary name list entries defined in 136 * expressions, e.g. STRs, and WITHPTRs from withs. 137 */ 138 nlfree(snlp); 139 /* 140 * free any temporaries allocated for this statement 141 * these come from strings and sets. 142 */ 143 if ( soffset != sizes[ cbn ].om_off ) { 144 sizes[ cbn ].om_off = soffset; 145 # ifdef PC 146 putlbracket( ftnno , -sizes[cbn].om_off ); 147 # endif PC 148 } 149 } 150 151 ungoto() 152 { 153 register struct nl *p; 154 155 for (p = gotos[cbn]; p != NIL; p = p->chain) 156 if ((p->nl_flags & NFORWD) != 0) { 157 if (p->value[NL_GOLEV] != NOTYET) 158 if (p->value[NL_GOLEV] > level) 159 p->value[NL_GOLEV] = level; 160 } else 161 if (p->value[NL_GOLEV] != DEAD) 162 if (p->value[NL_GOLEV] > level) 163 p->value[NL_GOLEV] = DEAD; 164 } 165 166 putcnt() 167 { 168 169 if (monflg == 0) { 170 return; 171 } 172 inccnt( getcnt() ); 173 } 174 175 int 176 getcnt() 177 { 178 179 return ++cnts; 180 } 181 182 inccnt( counter ) 183 int counter; 184 { 185 186 # ifdef OBJ 187 put2(O_COUNT, counter ); 188 # endif OBJ 189 # ifdef PC 190 putRV( PCPCOUNT , 0 , counter * sizeof (long) , P2INT ); 191 putleaf( P2ICON , 1 , 0 , P2INT , 0 ); 192 putop( P2ASG P2PLUS , P2INT ); 193 putdot( filename , line ); 194 # endif PC 195 } 196 197 putline() 198 { 199 200 # ifdef OBJ 201 if (opt('p') != 0) 202 put2(O_LINO, line); 203 # endif OBJ 204 # ifdef PC 205 static lastline; 206 207 if ( line != lastline ) { 208 stabline( line ); 209 lastline = line; 210 } 211 if ( opt( 'p' ) ) { 212 if ( opt('t') ) { 213 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 214 , "_LINO" ); 215 putop( P2UNARY P2CALL , P2INT ); 216 putdot( filename , line ); 217 } else { 218 putRV( STMTCOUNT , 0 , 0 , P2INT ); 219 putleaf( P2ICON , 1 , 0 , P2INT , 0 ); 220 putop( P2ASG P2PLUS , P2INT ); 221 putdot( filename , line ); 222 } 223 } 224 # endif PC 225 } 226 227 /* 228 * With varlist do stat 229 * 230 * With statement requires an extra word 231 * in automatic storage for each level of withing. 232 * These indirect pointers are initialized here, and 233 * the scoping effect of the with statement occurs 234 * because lookup examines the field names of the records 235 * associated with the WITHPTRs on the withlist. 236 */ 237 withop(s) 238 int *s; 239 { 240 register *p; 241 register struct nl *r; 242 int i; 243 int *swl; 244 long soffset; 245 246 putline(); 247 swl = withlist; 248 soffset = sizes[cbn].om_off; 249 for (p = s[2]; p != NIL; p = p[2]) { 250 i = sizes[cbn].om_off -= sizeof ( int * ); 251 if (sizes[cbn].om_off < sizes[cbn].om_max) 252 sizes[cbn].om_max = sizes[cbn].om_off; 253 # ifdef OBJ 254 put2(O_LV | cbn <<8+INDX, i ); 255 # endif OBJ 256 # ifdef PC 257 putlbracket( ftnno , -sizes[cbn].om_off ); 258 putRV( 0 , cbn , i , P2PTR|P2STRTY ); 259 # endif PC 260 r = lvalue(p[1], MOD , LREQ ); 261 if (r == NIL) 262 continue; 263 if (r->class != RECORD) { 264 error("Variable in with statement refers to %s, not to a record", nameof(r)); 265 continue; 266 } 267 r = defnl(0, WITHPTR, r, i); 268 r->nl_next = withlist; 269 withlist = r; 270 # ifdef OBJ 271 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[3]); 279 sizes[cbn].om_off = soffset; 280 # ifdef PC 281 putlbracket( ftnno , -sizes[cbn].om_off ); 282 # endif PC 283 withlist = swl; 284 } 285 286 extern flagwas; 287 /* 288 * var := expr 289 */ 290 asgnop(r) 291 int *r; 292 { 293 register struct nl *p; 294 register *av; 295 296 if (r == NIL) 297 return (NIL); 298 /* 299 * Asgnop's only function is 300 * to handle function variable 301 * assignments. All other assignment 302 * stuff is handled by asgnop1. 303 * the if below checks for unqualified lefthandside: 304 * necessary for fvars. 305 */ 306 av = r[2]; 307 if (av != NIL && av[0] == T_VAR && av[3] == NIL) { 308 p = lookup1(av[2]); 309 if (p != NIL) 310 p->nl_flags = flagwas; 311 if (p != NIL && p->class == FVAR) { 312 /* 313 * Give asgnop1 the func 314 * which is the chain of 315 * the FVAR. 316 */ 317 p->nl_flags |= NUSED|NMOD; 318 p = p->chain; 319 if (p == NIL) { 320 rvalue(r[3], NIL , RREQ ); 321 return; 322 } 323 # ifdef OBJ 324 put2(O_LV | bn << 8+INDX, p->value[NL_OFFS]); 325 if (isa(p->type, "i") && width(p->type) == 1) 326 asgnop1(r, nl+T2INT); 327 else 328 asgnop1(r, p->type); 329 # endif OBJ 330 # ifdef PC 331 /* 332 * this should be the lvalue of the fvar, 333 * but since the second pass knows to use 334 * the address of the left operand of an 335 * assignment, what i want here is an rvalue. 336 * see note in funchdr about fvar allocation. 337 */ 338 p = p -> ptr[ NL_FVAR ]; 339 putRV( p -> symbol , bn , p -> value[ NL_OFFS ] 340 , p2type( p -> type ) ); 341 asgnop1( r , p -> type ); 342 # endif PC 343 return; 344 } 345 } 346 asgnop1(r, NIL); 347 } 348 349 /* 350 * Asgnop1 handles all assignments. 351 * If p is not nil then we are assigning 352 * to a function variable, otherwise 353 * we look the variable up ourselves. 354 */ 355 struct nl * 356 asgnop1(r, p) 357 int *r; 358 register struct nl *p; 359 { 360 register struct nl *p1; 361 362 if (r == NIL) 363 return (NIL); 364 if (p == NIL) { 365 # ifdef OBJ 366 p = lvalue(r[2], MOD|ASGN|NOUSE , LREQ ); 367 # endif OBJ 368 # ifdef PC 369 /* 370 * since the second pass knows that it should reference 371 * the lefthandside of asignments, what i need here is 372 * an rvalue. 373 */ 374 p = lvalue( r[2] , MOD|ASGN|NOUSE , RREQ ); 375 # endif PC 376 if ( p == NIL ) { 377 rvalue( r[3] , NIL , RREQ ); 378 return NIL; 379 } 380 } 381 # ifdef OBJ 382 p1 = rvalue(r[3], p , RREQ ); 383 # endif OBJ 384 # ifdef PC 385 /* 386 * if this is a scalar assignment, 387 * then i want to rvalue the righthandside. 388 * if this is a structure assignment, 389 * then i want an lvalue to the righthandside. 390 * that's what the intermediate form sez. 391 */ 392 switch ( classify( p ) ) { 393 case TINT: 394 case TCHAR: 395 case TBOOL: 396 case TSCAL: 397 precheck( p , "_RANG4" , "_RSNG4" ); 398 case TDOUBLE: 399 case TPTR: 400 p1 = rvalue( r[3] , p , RREQ ); 401 break; 402 default: 403 p1 = rvalue( r[3] , p , LREQ ); 404 break; 405 } 406 # endif PC 407 if (p1 == NIL) 408 return (NIL); 409 if (incompat(p1, p, r[3])) { 410 cerror("Type of expression clashed with type of variable in assignment"); 411 return (NIL); 412 } 413 switch (classify(p)) { 414 case TINT: 415 case TBOOL: 416 case TCHAR: 417 case TSCAL: 418 # ifdef OBJ 419 rangechk(p, p1); 420 # endif OBJ 421 # ifdef PC 422 postcheck( p ); 423 # endif PC 424 case TDOUBLE: 425 case TPTR: 426 # ifdef OBJ 427 gen(O_AS2, O_AS2, width(p), width(p1)); 428 # endif OBJ 429 # ifdef PC 430 putop( P2ASSIGN , p2type( p ) ); 431 putdot( filename , line ); 432 # endif PC 433 break; 434 default: 435 # ifdef OBJ 436 put2(O_AS, width(p)); 437 # endif OBJ 438 # ifdef PC 439 putstrop( P2STASG , p2type( p ) 440 , lwidth( p ) , align( p ) ); 441 putdot( filename , line ); 442 # endif PC 443 } 444 return (p); /* Used by for statement */ 445 } 446 447 #ifdef OBJ 448 /* 449 * for var := expr [down]to expr do stat 450 */ 451 forop(r) 452 int *r; 453 { 454 register struct nl *t1, *t2; 455 int l1, l2, l3; 456 long soffset; 457 register op; 458 struct nl *p; 459 int *rr, goc, i; 460 461 p = NIL; 462 goc = gocnt; 463 if (r == NIL) 464 goto aloha; 465 putline(); 466 /* 467 * Start with assignment 468 * of initial value to for variable 469 */ 470 t1 = asgnop1(r[2], NIL); 471 if (t1 == NIL) { 472 rvalue(r[3], NIL , RREQ ); 473 statement(r[4]); 474 goto aloha; 475 } 476 rr = r[2]; /* Assignment */ 477 rr = rr[2]; /* Lhs variable */ 478 if (rr[3] != NIL) { 479 error("For variable must be unqualified"); 480 rvalue(r[3], NIL , RREQ ); 481 statement(r[4]); 482 goto aloha; 483 } 484 p = lookup(rr[2]); 485 p->value[NL_FORV] = 1; 486 if (isnta(t1, "bcis")) { 487 error("For variables cannot be %ss", nameof(t1)); 488 statement(r[4]); 489 goto aloha; 490 } 491 /* 492 * Allocate automatic 493 * space for limit variable 494 */ 495 sizes[cbn].om_off -= 4; 496 if (sizes[cbn].om_off < sizes[cbn].om_max) 497 sizes[cbn].om_max = sizes[cbn].om_off; 498 i = sizes[cbn].om_off; 499 /* 500 * Initialize the limit variable 501 */ 502 put2(O_LV | cbn<<8+INDX, i); 503 t2 = rvalue(r[3], NIL , RREQ ); 504 if (incompat(t2, t1, r[3])) { 505 cerror("Limit type clashed with index type in 'for' statement"); 506 statement(r[4]); 507 goto aloha; 508 } 509 put1(width(t2) <= 2 ? O_AS24 : O_AS4); 510 /* 511 * See if we can skip the loop altogether 512 */ 513 rr = r[2]; 514 if (rr != NIL) 515 rvalue(rr[2], NIL , RREQ ); 516 put2(O_RV4 | cbn<<8+INDX, i); 517 gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4); 518 /* 519 * L1 will be patched to skip the body of the loop. 520 * L2 marks the top of the loop when we go around. 521 */ 522 put2(O_IF, (l1 = getlab())); 523 putlab(l2 = getlab()); 524 putcnt(); 525 statement(r[4]); 526 /* 527 * now we see if we get to go again 528 */ 529 if (opt('t') == 0) { 530 /* 531 * Easy if we dont have to test 532 */ 533 put2(O_RV4 | cbn<<8+INDX, i); 534 if (rr != NIL) 535 lvalue(rr[2], MOD , RREQ ); 536 put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2); 537 } else { 538 line = r[1]; 539 putline(); 540 if (rr != NIL) 541 rvalue(rr[2], NIL , RREQ ); 542 put2(O_RV4 | cbn << 8+INDX, i); 543 gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4); 544 l3 = put2(O_IF, getlab()); 545 lvalue((int *) rr[2], MOD , RREQ ); 546 rvalue(rr[2], NIL , RREQ ); 547 put2(O_CON2, 1); 548 t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2); 549 rangechk(t1, t2); /* The point of all this */ 550 gen(O_AS2, O_AS2, width(t1), width(t2)); 551 put2(O_TRA, l2); 552 patch(l3); 553 } 554 sizes[cbn].om_off += 4; 555 patch(l1); 556 aloha: 557 noreach = 0; 558 if (p != NIL) 559 p->value[NL_FORV] = 0; 560 if (goc != gocnt) 561 putcnt(); 562 } 563 #endif OBJ 564 565 /* 566 * if expr then stat [ else stat ] 567 */ 568 ifop(r) 569 int *r; 570 { 571 register struct nl *p; 572 register l1, l2; /* l1 is start of else, l2 is end of else */ 573 int nr, goc; 574 575 goc = gocnt; 576 if (r == NIL) 577 return; 578 putline(); 579 p = rvalue(r[2], NIL , RREQ ); 580 if (p == NIL) { 581 statement(r[3]); 582 noreach = 0; 583 statement(r[4]); 584 noreach = 0; 585 return; 586 } 587 if (isnta(p, "b")) { 588 error("Type of expression in if statement must be Boolean, not %s", nameof(p)); 589 statement(r[3]); 590 noreach = 0; 591 statement(r[4]); 592 noreach = 0; 593 return; 594 } 595 # ifdef OBJ 596 l1 = put2(O_IF, getlab()); 597 # endif OBJ 598 # ifdef PC 599 l1 = getlab(); 600 putleaf( P2ICON , l1 , 0 , P2INT , 0 ); 601 putop( P2CBRANCH , P2INT ); 602 putdot( filename , line ); 603 # endif PC 604 putcnt(); 605 statement(r[3]); 606 nr = noreach; 607 if (r[4] != NIL) { 608 /* 609 * else stat 610 */ 611 --level; 612 ungoto(); 613 ++level; 614 # ifdef OBJ 615 l2 = put2(O_TRA, getlab()); 616 # endif OBJ 617 # ifdef PC 618 l2 = getlab(); 619 putjbr( l2 ); 620 # endif PC 621 patch(l1); 622 noreach = 0; 623 statement(r[4]); 624 noreach &= nr; 625 l1 = l2; 626 } else 627 noreach = 0; 628 patch(l1); 629 if (goc != gocnt) 630 putcnt(); 631 } 632 633 /* 634 * while expr do stat 635 */ 636 whilop(r) 637 int *r; 638 { 639 register struct nl *p; 640 register l1, l2; 641 int goc; 642 643 goc = gocnt; 644 if (r == NIL) 645 return; 646 putlab(l1 = getlab()); 647 putline(); 648 p = rvalue(r[2], NIL , RREQ ); 649 if (p == NIL) { 650 statement(r[3]); 651 noreach = 0; 652 return; 653 } 654 if (isnta(p, "b")) { 655 error("Type of expression in while statement must be Boolean, not %s", nameof(p)); 656 statement(r[3]); 657 noreach = 0; 658 return; 659 } 660 l2 = getlab(); 661 # ifdef OBJ 662 put2(O_IF, l2); 663 # endif OBJ 664 # ifdef PC 665 putleaf( P2ICON , l2 , 0 , P2INT , 0 ); 666 putop( P2CBRANCH , P2INT ); 667 putdot( filename , line ); 668 # endif PC 669 putcnt(); 670 statement(r[3]); 671 # ifdef OBJ 672 put2(O_TRA, l1); 673 # endif OBJ 674 # ifdef PC 675 putjbr( l1 ); 676 # endif PC 677 patch(l2); 678 if (goc != gocnt) 679 putcnt(); 680 } 681 682 /* 683 * repeat stat* until expr 684 */ 685 repop(r) 686 int *r; 687 { 688 register struct nl *p; 689 register l; 690 int goc; 691 692 goc = gocnt; 693 if (r == NIL) 694 return; 695 l = putlab(getlab()); 696 putcnt(); 697 statlist(r[2]); 698 line = r[1]; 699 p = rvalue(r[3], NIL , RREQ ); 700 if (p == NIL) 701 return; 702 if (isnta(p,"b")) { 703 error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p)); 704 return; 705 } 706 # ifdef OBJ 707 put2(O_IF, l); 708 # endif OBJ 709 # ifdef PC 710 putleaf( P2ICON , l , 0 , P2INT , 0 ); 711 putop( P2CBRANCH , P2INT ); 712 putdot( filename , line ); 713 # endif PC 714 if (goc != gocnt) 715 putcnt(); 716 } 717 718 /* 719 * assert expr 720 */ 721 asrtop(r) 722 register int *r; 723 { 724 register struct nl *q; 725 726 if (opt('s')) { 727 standard(); 728 error("Assert statement is non-standard"); 729 } 730 if (!opt('t')) 731 return; 732 r = r[2]; 733 # ifdef OBJ 734 q = rvalue((int *) r, NLNIL , RREQ ); 735 # endif OBJ 736 # ifdef PC 737 putleaf( P2ICON , 0 , 0 738 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_ASRT" ); 739 q = stkrval( r , NLNIL , RREQ ); 740 # endif PC 741 if (q == NIL) 742 return; 743 if (isnta(q, "b")) 744 error("Assert expression must be Boolean, not %ss", nameof(q)); 745 # ifdef OBJ 746 put1(O_ASRT); 747 # endif OBJ 748 # ifdef PC 749 putop( P2CALL , P2INT ); 750 putdot( filename , line ); 751 # endif PC 752 } 753