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