![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to interp.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx|
Return to interp.c CVS log | Up to [Research Unix] / researchv10dc / cmd / icon / src / iconx |
1.1 ! root 1: /* ! 2: * The intepreter proper. ! 3: */ ! 4: ! 5: /* ! 6: * Instrumentation selection is based on Instr_level, which is given ! 7: * as a product of prime numbers. ! 8: */ ! 9: #ifndef Instr ! 10: #define Instr 997 ! 11: #endif Instr ! 12: #ifndef Instr_level ! 13: #define Instr_level 2 ! 14: #endif Instr_level ! 15: ! 16: #include "../h/rt.h" ! 17: #include "gc.h" ! 18: #include "../h/opdef.h" ! 19: ! 20: /* ! 21: * Istate variables. ! 22: */ ! 23: struct pf_marker *pfp; /* Procedure frame pointer */ ! 24: struct ef_marker *efp; /* Expression frame pointer */ ! 25: struct gf_marker *gfp; /* Generator frame pointer */ ! 26: word *ipc; /* Interpreter program counter */ ! 27: struct descrip *argp; /* Pointer to argument zero */ ! 28: word *sp; /* Stack pointer */ ! 29: extern int mstksize; /* Size of main stack */ ! 30: int ilevel; /* Depth of recursion in interp() */ ! 31: ! 32: #if (Instr % Instr_level) == 0 ! 33: int maxilevel; /* Maximum ilevel */ ! 34: word *maxsp; /* Maximum interpreter sp */ ! 35: #endif Instr ! 36: ! 37: extern word *stack; /* Interpreter stack */ ! 38: word *stackend; /* End of main interpreter stack */ ! 39: ! 40: #ifdef MSDOS ! 41: #ifdef LPTR ! 42: static union { ! 43: char *stkadr; ! 44: word stkint; ! 45: } stkword; ! 46: #define PushAVal(v) {sp++; \ ! 47: stkword.stkadr = (char *)(v); \ ! 48: *sp = stkword.stkint;} ! 49: #else LPTR ! 50: #define PushAVal PushVal ! 51: #endif LPTR ! 52: #else MSDOS ! 53: #define PushAVal PushVal ! 54: #endif MSDOS ! 55: ! 56: /* ! 57: * Initial icode sequence. This is used to invoke the main procedure with one ! 58: * operand. If main returns, the Op_Quit is executed. ! 59: */ ! 60: word istart[3] = {Op_Invoke, 1, Op_Quit}; ! 61: word mterm = Op_Quit; ! 62: ! 63: /* ! 64: * The tended descriptors. ! 65: */ ! 66: struct descrip tended[6]; ! 67: ! 68: /* ! 69: * Descriptor to hold result for eret across potential interp unwinding. ! 70: */ ! 71: struct descrip eret_tmp; ! 72: /* ! 73: * Last co-expression action. ! 74: */ ! 75: int coexp_act; ! 76: struct descrip *xargp; ! 77: ! 78: main(argc, argv) ! 79: int argc; char **argv; ! 80: { ! 81: int i; ! 82: extern int tallyopt; ! 83: ! 84: #if (Instr % Instr_level) == 0 ! 85: maxilevel = 0; ! 86: maxsp = 0; ! 87: #endif Instr ! 88: ! 89: #ifdef VMS ! 90: redirect(&argc, argv, 0); ! 91: #endif VMS ! 92: ! 93: /* ! 94: * Set tallying flag if -T option given ! 95: */ ! 96: if (!strcmp(argv[1],"-T")) { ! 97: tallyopt = 1; ! 98: argc--; ! 99: argv++; ! 100: } ! 101: ! 102: ! 103: /* ! 104: * Call init with the name of the file to interpret. ! 105: */ ! 106: init(argv[1]); ! 107: ! 108: /* ! 109: * Point sp at word after b_coexpr block for &main, point ipc at initial ! 110: * icode segment, and clear the gfp. ! 111: */ ! 112: stackend = stack + mstksize/WordSize; ! 113: sp = stack + Wsizeof(struct b_coexpr); ! 114: ipc = istart; ! 115: gfp = 0; ! 116: ! 117: /* ! 118: * Set up expression frame marker to contain execution of the ! 119: * main procedure. If failure occurs in this context, control ! 120: * is transferred to mterm, the address of an Op_Quit. ! 121: */ ! 122: efp = (struct ef_marker *)(sp); ! 123: efp->ef_failure = &mterm; ! 124: efp->ef_gfp = 0; ! 125: efp->ef_efp = 0; ! 126: efp->ef_ilevel = 1; ! 127: sp += Wsizeof(*efp) - 1; ! 128: ! 129: /* ! 130: * The first global variable holds the value of "main". If it ! 131: * is not of type procedure, this is noted as run-time error 117. ! 132: * Otherwise, this value is pushed on the stack. ! 133: */ ! 134: if (globals[0].dword != D_Proc) ! 135: runerr(117, NULL); ! 136: PushDesc(globals[0]); ! 137: ! 138: /* ! 139: * Main is to be invoked with one argument, a list of the command ! 140: * line arguments. The command line arguments are pushed on the ! 141: * stack as a series of descriptors and llist is called to create ! 142: * the list. The null descriptor first pushed serves as Arg0 for ! 143: * llist and receives the result of the computation. ! 144: */ ! 145: PushNull; ! 146: argp = (struct descrip *)(sp - 1); ! 147: for (i = 2; i < argc; i++) { ! 148: PushVal(strlen(argv[i])); ! 149: PushAVal(argv[i]); ! 150: } ! 151: llist(argc - 2, argp); ! 152: sp = (word *)argp + 1; ! 153: argp = 0; ! 154: ! 155: /* ! 156: * Start things rolling by calling interp. This call to interp ! 157: * returns only if an Op_Quit is executed. If this happens, ! 158: * c_exit() is called to wrap things up. ! 159: */ ! 160: interp(0,NULL); ! 161: c_exit(NormalExit); ! 162: } ! 163: ! 164: /* ! 165: * Macros for use inside the main loop of the interpreter. ! 166: */ ! 167: ! 168: /* ! 169: * Setup_Op sets things up for a call to the C function for an operator. ! 170: */ ! 171: #define Setup_Op(nargs) \ ! 172: rargp = (struct descrip *) (rsp - 1) - nargs; \ ! 173: ExInterp; ! 174: ! 175: /* ! 176: * Call_Op(n) calls an unconditional operator. The C routine associated ! 177: * with the current opcode is called. After the routine performs the operation ! 178: * and returns, the stack pointer is reset to point to the result. ! 179: */ ! 180: #define Call_Op(n) (*(optab[op]))(rargp); \ ! 181: rsp = (word *) rargp + 1; ! 182: ! 183: /* ! 184: * Call_Cond(n) calls a conditional operator. The C routine associated ! 185: * with the current opcode is called. The routine returns a signal of ! 186: * success or failure. If the operation succeeds, the stack ! 187: * pointer is reset to point to the result. If the routine fails, control ! 188: * transfers to efail. ! 189: */ ! 190: #define Call_Cond(n) if ((*(optab[op]))(rargp) == A_Failure) \ ! 191: goto efail; \ ! 192: else \ ! 193: rsp = (word *) rargp + 1; ! 194: ! 195: /* ! 196: * Call_Gen(n) - Call a generator. A C routine associated with the ! 197: * current opcode is called. When it when it terminates, control is ! 198: * passed to C_rtn_term to deal with the termination condition appropriately. ! 199: */ ! 200: #define Call_Gen(n) signal = (*(optab[op]))(rargp); \ ! 201: goto C_rtn_term; ! 202: ! 203: /* ! 204: * GetWord fetches the next icode word. PutWord(x) stores x at the current ! 205: * icode word. ! 206: */ ! 207: #define GetWord (*ipc++) ! 208: #define PutWord(x) ipc[-1] = (x) ! 209: /* ! 210: * DerefArg(n) dereferences the n'th argument. ! 211: */ ! 212: #define DerefArg(n) DeRef(rargp[n]) ! 213: ! 214: /* ! 215: * For the sake of efficiency, the stack pointer is kept in a register ! 216: * variable, rsp, in the interpreter loop. Since this variable is ! 217: * only accessible inside the loop, and the global variable sp is used ! 218: * for the stack pointer elsewhere, rsp must be stored into sp when ! 219: * the context of the loop is left and conversely, rsp must be loaded ! 220: * from sp when the loop is reentered. The macros ExInterp and EntInterp, ! 221: * respectively, handle these operations. Currently, this register/global ! 222: * scheme is only used for the stack pointer, but it can be easily extended ! 223: * to other variables. ! 224: */ ! 225: ! 226: #define ExInterp sp = rsp; ! 227: #define EntInterp rsp = sp; ! 228: ! 229: /* ! 230: * Inside the interpreter loop, PushDesc, PushNull, and ! 231: * PushVal use rsp instead of sp for efficiency. ! 232: */ ! 233: ! 234: #undef PushDesc ! 235: #undef PushNull ! 236: #undef PushVal ! 237: #undef PushAVal ! 238: #define PushDesc(d) {rsp++;*rsp=((d).dword);rsp++;*rsp=((d).vword.integr);} ! 239: #define PushNull {rsp++; *rsp = D_Null; rsp++; *rsp = 0;} ! 240: #define PushVal(v) {rsp++; *rsp = (word)(v);} ! 241: #ifdef MSDOS ! 242: #ifdef LPTR ! 243: #define PushAVal(v) {rsp++; \ ! 244: stkword.stkadr = (char *)(v); \ ! 245: *rsp = stkword.stkint; \ ! 246: } ! 247: #else LPTR ! 248: #define PushAVal PushVal ! 249: #endif LPTR ! 250: #else MSDOS ! 251: #define PushAVal PushVal ! 252: #endif MSDOS ! 253: ! 254: /* ! 255: * The main loop of the interpreter. ! 256: */ ! 257: ! 258: interp(fsig,cargp) ! 259: int fsig; ! 260: struct descrip *cargp; ! 261: { ! 262: register word opnd, op; ! 263: register word *rsp; ! 264: register struct descrip *rargp; ! 265: register struct ef_marker *newefp; ! 266: register struct gf_marker *newgfp; ! 267: register word *wd; ! 268: register word *firstwd, *lastwd; ! 269: word *oldsp; ! 270: int type, signal; ! 271: extern int (*optab[])(); ! 272: extern char *ident; ! 273: extern word tallybin[]; ! 274: ! 275: ilevel++; ! 276: #if (Instr % Instr_level) == 0 ! 277: if (ilevel > maxilevel) ! 278: maxilevel = ilevel; ! 279: #endif Instr ! 280: EntInterp; ! 281: if (fsig == G_Csusp) { ! 282: oldsp = rsp; ! 283: ! 284: /* ! 285: * Create the generator frame. ! 286: */ ! 287: newgfp = (struct gf_marker *)(rsp + 1); ! 288: newgfp->gf_gentype = G_Csusp; ! 289: newgfp->gf_gfp = gfp; ! 290: newgfp->gf_efp = efp; ! 291: newgfp->gf_ipc = ipc; ! 292: newgfp->gf_line = line; ! 293: rsp += Wsizeof(struct gf_smallmarker); ! 294: ! 295: /* ! 296: * Region extends from first word after the marker for the generator ! 297: * or expression frame enclosing the call to the now-suspending ! 298: * routine to the first argument of the routine. ! 299: */ ! 300: if (gfp != 0) { ! 301: if (gfp->gf_gentype == G_Psusp) ! 302: firstwd = (word *)gfp + Wsizeof(*gfp); ! 303: else ! 304: firstwd = (word *)gfp + Wsizeof(struct gf_smallmarker); ! 305: } ! 306: else ! 307: firstwd = (word *)efp + Wsizeof(*efp); ! 308: lastwd = (word *)cargp + 1; ! 309: ! 310: /* ! 311: * Copy the portion of the stack with endpoints firstwd and lastwd ! 312: * (inclusive) to the top of the stack. ! 313: */ ! 314: for (wd = firstwd; wd <= lastwd; wd++) ! 315: *++rsp = *wd; ! 316: gfp = newgfp; ! 317: } ! 318: for (;;) { /* Top of the interpreter loop */ ! 319: #if (Instr % Instr_level) == 0 ! 320: if (sp > maxsp) ! 321: maxsp = sp; ! 322: #endif Instr ! 323: op = GetWord; /* Instruction fetch */ ! 324: ! 325: switch (op) { /* ! 326: * Switch on opcode. The cases are ! 327: * organized roughly by functionality ! 328: * to make it easier to find things. ! 329: * For some C compilers, there may be ! 330: * an advantage to arranging them by ! 331: * likelihood of selection. ! 332: */ ! 333: ! 334: /* ---Constant construction--- */ ! 335: ! 336: case Op_Cset: /* cset */ ! 337: PutWord(Op_Acset); ! 338: PushVal(D_Cset); ! 339: opnd = GetWord; ! 340: opnd += (word)ipc; ! 341: PutWord(opnd); ! 342: PushAVal(opnd); ! 343: break; ! 344: ! 345: case Op_Acset: /* cset, absolute address */ ! 346: PushVal(D_Cset); ! 347: PushAVal(GetWord); ! 348: break; ! 349: ! 350: ! 351: /* >int */ ! 352: case Op_Int: /* integer */ ! 353: PushVal(D_Integer); ! 354: PushVal(GetWord); ! 355: break; ! 356: /* <int */ ! 357: ! 358: #if IntSize == 16 ! 359: case Op_Long: /* long integer */ ! 360: PutWord(Op_Along); ! 361: PushVal(D_Longint); ! 362: opnd = GetWord; ! 363: opnd += (word)(ipc); ! 364: PutWord(opnd); ! 365: PushAVal(opnd); ! 366: break; ! 367: ! 368: case Op_Along: /* long integer, absolute address */ ! 369: PushVal(D_Longint); ! 370: PushAVal(GetWord); ! 371: break; ! 372: #endif IntSize == 16 ! 373: ! 374: case Op_Real: /* real */ ! 375: PutWord(Op_Areal); ! 376: PushVal(D_Real); ! 377: opnd = GetWord; ! 378: opnd += (word)ipc; ! 379: PushAVal(opnd); ! 380: PutWord(opnd); ! 381: break; ! 382: ! 383: case Op_Areal: /* real, absolute address */ ! 384: PushVal(D_Real); ! 385: PushAVal(GetWord); ! 386: break; ! 387: ! 388: case Op_Str: /* string */ ! 389: PutWord(Op_Astr); ! 390: PushVal(GetWord) ! 391: opnd = (word)ident + GetWord; ! 392: PutWord(opnd); ! 393: PushAVal(opnd); ! 394: break; ! 395: ! 396: case Op_Astr: /* string, absolute address */ ! 397: PushVal(GetWord); ! 398: PushAVal(GetWord); ! 399: break; ! 400: ! 401: /* ---Variable construction--- */ ! 402: ! 403: case Op_Arg: /* argument */ ! 404: PushVal(D_Var); ! 405: PushAVal(&argp[GetWord + 1]); ! 406: break; ! 407: ! 408: case Op_Global: /* global */ ! 409: PutWord(Op_Aglobal); ! 410: PushVal(D_Var); ! 411: opnd = GetWord; ! 412: PushAVal(&globals[opnd]); ! 413: PutWord((word)&globals[opnd]); ! 414: break; ! 415: ! 416: case Op_Aglobal: /* global, absolute address */ ! 417: PushVal(D_Var); ! 418: PushAVal(GetWord); ! 419: break; ! 420: ! 421: case Op_Local: /* local */ ! 422: PushVal(D_Var); ! 423: PushAVal(&pfp->pf_locals[GetWord]); ! 424: break; ! 425: ! 426: case Op_Static: /* static */ ! 427: PutWord(Op_Astatic); ! 428: PushVal(D_Var); ! 429: opnd = GetWord; ! 430: PushAVal(&statics[opnd]); ! 431: PutWord((word)&statics[opnd]); ! 432: break; ! 433: ! 434: case Op_Astatic: /* static, absolute address */ ! 435: PushVal(D_Var); ! 436: PushAVal(GetWord); ! 437: break; ! 438: ! 439: /* ---Operators--- */ ! 440: ! 441: /* Unconditional unary operators */ ! 442: ! 443: case Op_Compl: /* ~e */ ! 444: case Op_Neg: /* -e */ ! 445: case Op_Number: /* +e */ ! 446: case Op_Refresh: /* ^e */ ! 447: case Op_Size: /* *e */ ! 448: case Op_Value: /* .e */ ! 449: Setup_Op(1); ! 450: DerefArg(1); ! 451: Call_Op(1); ! 452: break; ! 453: /* Conditional unary operators */ ! 454: ! 455: case Op_Nonnull: /* \e */ ! 456: case Op_Null: /* /e */ ! 457: Setup_Op(1); ! 458: Call_Cond(1); ! 459: break; ! 460: ! 461: case Op_Random: /* ?e */ ! 462: PushNull; ! 463: Setup_Op(2) ! 464: Call_Cond(2) ! 465: break; ! 466: ! 467: /* Generative unary operators */ ! 468: ! 469: case Op_Tabmat: /* =e */ ! 470: Setup_Op(1); ! 471: DerefArg(1); ! 472: Call_Gen(1); ! 473: break; ! 474: ! 475: case Op_Bang: /* !e */ ! 476: PushNull; ! 477: Setup_Op(2); ! 478: Call_Gen(2); ! 479: break; ! 480: ! 481: /* Unconditional binary operators */ ! 482: ! 483: case Op_Cat: /* e1 || e2 */ ! 484: case Op_Diff: /* e1 -- e2 */ ! 485: case Op_Div: /* e1 / e2 */ ! 486: case Op_Inter: /* e1 ** e2 */ ! 487: case Op_Lconcat: /* e1 ||| e2 */ ! 488: case Op_Minus: /* e1 - e2 */ ! 489: case Op_Mod: /* e1 % e2 */ ! 490: case Op_Mult: /* e1 * e2 */ ! 491: case Op_Power: /* e1 ^ e2 */ ! 492: case Op_Unions: /* e1 ++ e2 */ ! 493: /* >plus */ ! 494: case Op_Plus: /* e1 + e2 */ ! 495: Setup_Op(2); ! 496: DerefArg(1); ! 497: DerefArg(2); ! 498: Call_Op(2); ! 499: break; ! 500: /* <plus */ ! 501: /* Conditional binary operators */ ! 502: ! 503: case Op_Eqv: /* e1 === e2 */ ! 504: case Op_Lexeq: /* e1 == e2 */ ! 505: case Op_Lexge: /* e1 >>= e2 */ ! 506: case Op_Lexgt: /* e1 >> e2 */ ! 507: case Op_Lexle: /* e1 <<= e2 */ ! 508: case Op_Lexlt: /* e1 << e2 */ ! 509: case Op_Lexne: /* e1 ~== e2 */ ! 510: case Op_Neqv: /* e1 ~=== e2 */ ! 511: case Op_Numeq: /* e1 = e2 */ ! 512: case Op_Numge: /* e1 >= e2 */ ! 513: case Op_Numgt: /* e1 > e2 */ ! 514: case Op_Numle: /* e1 <= e2 */ ! 515: case Op_Numne: /* e1 ~= e2 */ ! 516: /* >numlt */ ! 517: case Op_Numlt: /* e1 < e2 */ ! 518: Setup_Op(2); ! 519: DerefArg(1); ! 520: DerefArg(2); ! 521: Call_Cond(2); ! 522: break; ! 523: /* <numlt */ ! 524: ! 525: case Op_Asgn: /* e1 := e2 */ ! 526: Setup_Op(2); ! 527: DerefArg(2); ! 528: Call_Cond(2); ! 529: break; ! 530: ! 531: case Op_Swap: /* e1 :=: e2 */ ! 532: PushNull; ! 533: Setup_Op(3); ! 534: Call_Cond(3); ! 535: break; ! 536: ! 537: case Op_Subsc: /* e1[e2] */ ! 538: PushNull; ! 539: Setup_Op(3); ! 540: DerefArg(2); ! 541: Call_Cond(3); ! 542: break; ! 543: /* Generative binary operators */ ! 544: ! 545: case Op_Rasgn: /* e1 <- e2 */ ! 546: Setup_Op(2); ! 547: DerefArg(2); ! 548: Call_Gen(2); ! 549: break; ! 550: ! 551: case Op_Rswap: /* e1 <-> e2 */ ! 552: PushNull; ! 553: Setup_Op(3); ! 554: Call_Gen(3); ! 555: break; ! 556: ! 557: /* Conditional ternary operators */ ! 558: ! 559: case Op_Sect: /* e1[e2:e3] */ ! 560: PushNull; ! 561: Setup_Op(4); ! 562: DerefArg(2); ! 563: DerefArg(3); ! 564: Call_Cond(4); ! 565: break; ! 566: /* Generative ternary operators */ ! 567: ! 568: case Op_Toby: /* e1 to e2 by e3 */ ! 569: Setup_Op(3); ! 570: DerefArg(1); ! 571: DerefArg(2); ! 572: DerefArg(3); ! 573: Call_Gen(3); ! 574: break; ! 575: ! 576: /* ---String Scanning--- */ ! 577: ! 578: case Op_Bscan: /* prepare for scanning */ ! 579: PushDesc(k_subject); ! 580: PushVal(D_Integer); ! 581: PushVal(k_pos); ! 582: Setup_Op(0); ! 583: signal = bscan(0,rargp); ! 584: goto C_rtn_term; ! 585: ! 586: case Op_Escan: /* exit from scanning */ ! 587: Setup_Op(3); ! 588: signal = escan(3,rargp); ! 589: goto C_rtn_term; ! 590: ! 591: /* ---Other Language Operations--- */ ! 592: ! 593: case Op_Invoke: { /* invoke */ ! 594: ExInterp; ! 595: { int nargs; ! 596: struct descrip *carg; ! 597: ! 598: type = invoke((int)GetWord, &carg, &nargs); ! 599: rargp = carg; ! 600: EntInterp; ! 601: if (type == I_Goal_Fail) ! 602: goto efail; ! 603: if (type == I_Continue) ! 604: break; ! 605: else { ! 606: int (*bfunc)(); ! 607: struct b_proc *bproc; ! 608: ! 609: bproc = (struct b_proc *)BlkLoc(*rargp); ! 610: bfunc = bproc->entryp.ccode; ! 611: ! 612: /* ExInterp -- not needed since no change ! 613: since last EntInterp */ ! 614: if (type == I_Vararg) ! 615: signal = (*bfunc)(nargs,rargp); ! 616: else ! 617: signal = (*bfunc)(rargp); ! 618: goto C_rtn_term; ! 619: } ! 620: } ! 621: break; ! 622: } ! 623: ! 624: case Op_Keywd: /* keyword */ ! 625: PushVal(D_Integer); ! 626: PushVal(GetWord); ! 627: Setup_Op(0); ! 628: signal = keywd(0,rargp); ! 629: break; ! 630: ! 631: case Op_Llist: /* construct list */ ! 632: opnd = GetWord; ! 633: Setup_Op(opnd); ! 634: llist((int)opnd,rargp); ! 635: rsp = (word *) rargp + 1; ! 636: break; ! 637: ! 638: /* ---Marking and Unmarking--- */ ! 639: ! 640: case Op_Mark: /* create expression frame marker */ ! 641: PutWord(Op_Amark); ! 642: opnd = GetWord; ! 643: opnd += (word)ipc; ! 644: PutWord(opnd); ! 645: newefp = (struct ef_marker *)(rsp + 1); ! 646: newefp->ef_failure = (word *)opnd; ! 647: goto mark; ! 648: ! 649: case Op_Amark: /* mark with absolute fipc */ ! 650: newefp = (struct ef_marker *)(rsp + 1); ! 651: newefp->ef_failure = (word *)GetWord; ! 652: mark: ! 653: newefp->ef_gfp = gfp; ! 654: newefp->ef_efp = efp; ! 655: newefp->ef_ilevel = ilevel; ! 656: rsp += Wsizeof(*efp); ! 657: efp = newefp; ! 658: gfp = 0; ! 659: break; ! 660: ! 661: case Op_Mark0: /* create expression frame with 0 ipl */ ! 662: mark0: ! 663: newefp = (struct ef_marker *)(rsp + 1); ! 664: newefp->ef_failure = 0; ! 665: newefp->ef_gfp = gfp; ! 666: newefp->ef_efp = efp; ! 667: newefp->ef_ilevel = ilevel; ! 668: rsp += Wsizeof(*efp); ! 669: efp = newefp; ! 670: gfp = 0; ! 671: break; ! 672: ! 673: /* >unmark */ ! 674: case Op_Unmark: /* remove expression frame */ ! 675: gfp = efp->ef_gfp; ! 676: rsp = (word *)efp - 1; ! 677: ! 678: /* ! 679: * Remove any suspended C generators. ! 680: */ ! 681: Unmark_uw: ! 682: if (efp->ef_ilevel != ilevel) { ! 683: --ilevel; ! 684: ExInterp; ! 685: return A_Unmark_uw; ! 686: } ! 687: efp = efp->ef_efp; ! 688: break; ! 689: /* <unmark */ ! 690: ! 691: /* ---Suspensions--- */ ! 692: ! 693: case Op_Esusp: { /* suspend from expression */ ! 694: ! 695: /* ! 696: * Create the generator frame. ! 697: */ ! 698: oldsp = rsp; ! 699: newgfp = (struct gf_marker *)(rsp + 1); ! 700: newgfp->gf_gentype = G_Esusp; ! 701: newgfp->gf_gfp = gfp; ! 702: newgfp->gf_efp = efp; ! 703: newgfp->gf_ipc = ipc; ! 704: newgfp->gf_line = line; ! 705: gfp = newgfp; ! 706: rsp += Wsizeof(struct gf_smallmarker); ! 707: ! 708: /* ! 709: * Region extends from first word after enclosing generator or ! 710: * expression frame marker to marker for current expression frame. ! 711: */ ! 712: if (efp->ef_gfp != 0) { ! 713: newgfp = (struct gf_marker *)(efp->ef_gfp); ! 714: if (newgfp->gf_gentype == G_Psusp) ! 715: firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp); ! 716: else ! 717: firstwd = (word *)efp->ef_gfp + Wsizeof(struct gf_smallmarker); ! 718: } ! 719: else ! 720: firstwd = (word *)efp->ef_efp + Wsizeof(*efp); ! 721: lastwd = (word *)efp - 1; ! 722: efp = efp->ef_efp; ! 723: ! 724: /* ! 725: * Copy the portion of the stack with endpoints firstwd and lastwd ! 726: * (inclusive) to the top of the stack. ! 727: */ ! 728: for (wd = firstwd; wd <= lastwd; wd++) ! 729: *++rsp = *wd; ! 730: PushVal(oldsp[-1]); ! 731: PushVal(oldsp[0]); ! 732: break; ! 733: } ! 734: ! 735: case Op_Lsusp: { /* suspend from limitation */ ! 736: struct descrip sval; ! 737: ! 738: /* ! 739: * The limit counter is contained in the descriptor immediately ! 740: * prior to the current expression frame. lval is established ! 741: * as a pointer to this descriptor. ! 742: */ ! 743: struct descrip *lval = (struct descrip *)((word *)efp - 2); ! 744: ! 745: /* ! 746: * Decrement the limit counter and check it. ! 747: */ ! 748: if (--IntVal(*lval) != 0) { ! 749: /* ! 750: * The limit has not been reached, set up stack. ! 751: */ ! 752: ! 753: sval = *(struct descrip *)(rsp - 1); /* save result */ ! 754: ! 755: /* ! 756: * Region extends from first word after enclosing generator or ! 757: * expression frame marker to the limit counter just prior to ! 758: * to the current expression frame marker. ! 759: */ ! 760: if (efp->ef_gfp != 0) { ! 761: newgfp = (struct gf_marker *)(efp->ef_gfp); ! 762: if (newgfp->gf_gentype == G_Psusp) ! 763: firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp); ! 764: else ! 765: firstwd = (word *)efp->ef_gfp + Wsizeof(struct gf_smallmarker); ! 766: } ! 767: else ! 768: firstwd = (word *)efp->ef_efp + Wsizeof(*efp); ! 769: lastwd = (word *)efp - 3; ! 770: efp = efp->ef_efp; ! 771: ! 772: /* ! 773: * Copy the portion of the stack with endpoints firstwd and lastwd ! 774: * (inclusive) to the top of the stack. ! 775: */ ! 776: rsp -= 2; /* overwrite result */ ! 777: for (wd = firstwd; wd <= lastwd; wd++) ! 778: *++rsp = *wd; ! 779: PushDesc(sval); /* push saved result */ ! 780: } ! 781: else { ! 782: /* ! 783: * Otherwise, the limit has been reached. Instead of ! 784: * suspending, remove the current expression frame and ! 785: * replace the limit counter with the value on top of ! 786: * the stack (which would have been suspended had the ! 787: * limit not been reached). ! 788: */ ! 789: *lval = *(struct descrip *)(rsp - 1); ! 790: gfp = efp->ef_gfp; ! 791: ! 792: /* ! 793: * Since an expression frame is being removed, inactive ! 794: * C generators contained therein are deactivated. ! 795: */ ! 796: Lsusp_uw: ! 797: if (efp->ef_ilevel != ilevel) { ! 798: --ilevel; ! 799: ExInterp; ! 800: return A_Lsusp_uw; ! 801: } ! 802: rsp = (word *)efp - 1; ! 803: efp = efp->ef_efp; ! 804: } ! 805: break; ! 806: } ! 807: ! 808: case Op_Psusp: { /* suspend from procedure */ ! 809: /* ! 810: * An Icon procedure is suspending a value. Determine if the ! 811: * value being suspended should be dereferenced and if so, ! 812: * dereference it. If tracing is on, strace is called ! 813: * to generate a message. Appropriate values are ! 814: * restored from the procedure frame of the suspending procedure. ! 815: */ ! 816: ! 817: struct descrip sval, *svalp; ! 818: struct b_proc *sproc; ! 819: ! 820: svalp = (struct descrip *)(rsp - 1); ! 821: sval = *svalp; ! 822: if (Var(sval)) { ! 823: word *loc; ! 824: ! 825: if (Tvar(sval)) { ! 826: if (sval.dword == D_Tvsubs) { ! 827: struct b_tvsubs *tvb; ! 828: ! 829: tvb = (struct b_tvsubs *)BlkLoc(sval); ! 830: loc = (word *)BlkLoc(tvb->ssvar); ! 831: } ! 832: else ! 833: goto ps_noderef; ! 834: } ! 835: else ! 836: loc = (word *)BlkLoc(sval); ! 837: if (loc >= (word *)BlkLoc(current) && loc <= rsp) ! 838: deref(svalp); ! 839: } ! 840: ps_noderef: ! 841: ! 842: /* ! 843: * Create the generator frame. ! 844: */ ! 845: oldsp = rsp; ! 846: newgfp = (struct gf_marker *)(rsp + 1); ! 847: newgfp->gf_gentype = G_Psusp; ! 848: newgfp->gf_gfp = gfp; ! 849: newgfp->gf_efp = efp; ! 850: newgfp->gf_ipc = ipc; ! 851: newgfp->gf_line = line; ! 852: newgfp->gf_argp = argp; ! 853: newgfp->gf_pfp = pfp; ! 854: gfp = newgfp; ! 855: rsp += Wsizeof(*gfp); ! 856: ! 857: /* ! 858: * Region extends from first word after the marker for the generator ! 859: * or expression frame enclosing the call to the now-suspending ! 860: * procedure to Arg0 of the procedure. ! 861: */ ! 862: if (pfp->pf_gfp != 0) { ! 863: newgfp = (struct gf_marker *)(pfp->pf_gfp); ! 864: if (newgfp->gf_gentype == G_Psusp) ! 865: firstwd = (word *)pfp->pf_gfp + Wsizeof(*gfp); ! 866: else ! 867: firstwd = (word *)pfp->pf_gfp + Wsizeof(struct gf_smallmarker); ! 868: } ! 869: else ! 870: firstwd = (word *)pfp->pf_efp + Wsizeof(*efp); ! 871: lastwd = (word *)argp - 1; ! 872: efp = efp->ef_efp; ! 873: ! 874: /* ! 875: * Copy the portion of the stack with endpoints firstwd and lastwd ! 876: * (inclusive) to the top of the stack. ! 877: */ ! 878: for (wd = firstwd; wd <= lastwd; wd++) ! 879: *++rsp = *wd; ! 880: PushVal(oldsp[-1]); ! 881: PushVal(oldsp[0]); ! 882: --k_level; ! 883: if (k_trace) { ! 884: sproc = (struct b_proc *)BlkLoc(*argp); ! 885: strace(sproc, svalp); ! 886: } ! 887: line = pfp->pf_line; ! 888: efp = pfp->pf_efp; ! 889: ipc = pfp->pf_ipc; ! 890: argp = pfp->pf_argp; ! 891: pfp = pfp->pf_pfp; ! 892: break; ! 893: } ! 894: ! 895: /* ---Returns--- */ ! 896: ! 897: case Op_Eret: { /* return from expression */ ! 898: /* ! 899: * Op_Eret removes the current expression frame, leaving the ! 900: * original top of stack value on top. ! 901: */ ! 902: /* ! 903: * Save current top of stack value in global temporary (no ! 904: * danger of reentry). ! 905: */ ! 906: eret_tmp = *(struct descrip *)&rsp[-1]; ! 907: gfp = efp->ef_gfp; ! 908: Eret_uw: ! 909: /* ! 910: * Since an expression frame is being removed, inactive ! 911: * C generators contained therein are deactivated. ! 912: */ ! 913: if (efp->ef_ilevel != ilevel) { ! 914: --ilevel; ! 915: ExInterp; ! 916: return A_Eret_uw; ! 917: } ! 918: rsp = (word *)efp - 1; ! 919: efp = efp->ef_efp; ! 920: PushDesc(eret_tmp); ! 921: break; ! 922: } ! 923: ! 924: case Op_Pret: { /* return from procedure */ ! 925: /* ! 926: * An Icon procedure is returning a value. Determine if the ! 927: * value being returned should be dereferenced and if so, ! 928: * dereference it. If tracing is on, rtrace is called to ! 929: * generate a message. Inactive generators created after ! 930: * the activation of the procedure are deactivated. Appropriate ! 931: * values are restored from the procedure frame. ! 932: */ ! 933: struct descrip rval; ! 934: struct b_proc *rproc = (struct b_proc *)BlkLoc(*argp); ! 935: ! 936: *argp = *(struct descrip *)(rsp - 1); ! 937: rval = *argp; ! 938: if (Var(rval)) { ! 939: word *loc; ! 940: ! 941: if (Tvar(rval)) { ! 942: if (rval.dword == D_Tvsubs) { ! 943: struct b_tvsubs *tvb; ! 944: ! 945: tvb = (struct b_tvsubs *)BlkLoc(rval); ! 946: loc = (word *)BlkLoc(tvb->ssvar); ! 947: } ! 948: else ! 949: goto pr_noderef; ! 950: } ! 951: else ! 952: loc = (word *)BlkLoc(rval); ! 953: if (loc >= (word *)BlkLoc(current) && loc <= rsp) ! 954: deref(argp); ! 955: } ! 956: ! 957: pr_noderef: ! 958: --k_level; ! 959: if (k_trace) ! 960: rtrace(rproc, argp); ! 961: Pret_uw: ! 962: if (pfp->pf_ilevel != ilevel) { ! 963: --ilevel; ! 964: ExInterp; ! 965: return A_Pret_uw; ! 966: } ! 967: rsp = (word *)argp + 1; ! 968: line = pfp->pf_line; ! 969: efp = pfp->pf_efp; ! 970: gfp = pfp->pf_gfp; ! 971: ipc = pfp->pf_ipc; ! 972: argp = pfp->pf_argp; ! 973: pfp = pfp->pf_pfp; ! 974: break; ! 975: } ! 976: ! 977: /* ---Failures--- */ ! 978: ! 979: /* >efail1 */ ! 980: case Op_Efail: ! 981: efail: ! 982: /* ! 983: * Failure has occurred in the current expression frame. ! 984: */ ! 985: if (gfp == 0) { ! 986: /* ! 987: * There are no inactive generators to resume. Remove ! 988: * the current expression frame, restoring values. ! 989: * ! 990: * If the failure address is 0, propagate failure to the ! 991: * enclosing frame by branching back to efail. ! 992: */ ! 993: ipc = efp->ef_failure; ! 994: gfp = efp->ef_gfp; ! 995: rsp = (word *)efp - 1; ! 996: efp = efp->ef_efp; ! 997: if (ipc == 0) ! 998: goto efail; ! 999: break; ! 1000: } ! 1001: ! 1002: else { ! 1003: /* ! 1004: * There is a generator that can be resumed. Make ! 1005: * the stack adjustments and then switch on the ! 1006: * type of the generator frame marker. ! 1007: */ ! 1008: register struct gf_marker *resgfp = gfp; ! 1009: ! 1010: type = resgfp->gf_gentype; ! 1011: /* <efail1 */ ! 1012: if (type == G_Psusp) { ! 1013: argp = resgfp->gf_argp; ! 1014: if (k_trace) { /* procedure tracing */ ! 1015: ExInterp; ! 1016: atrace(BlkLoc(*argp)); ! 1017: EntInterp; ! 1018: } ! 1019: } ! 1020: /* >efail2 */ ! 1021: ipc = resgfp->gf_ipc; ! 1022: efp = resgfp->gf_efp; ! 1023: line = resgfp->gf_line; ! 1024: gfp = resgfp->gf_gfp; ! 1025: rsp = (word *)resgfp - 1; ! 1026: /* <efail2 */ ! 1027: if (type == G_Psusp) { ! 1028: pfp = resgfp->gf_pfp; ! 1029: ++k_level; /* adjust procedure level */ ! 1030: } ! 1031: ! 1032: /* >efail3 */ ! 1033: switch (type) { ! 1034: ! 1035: case G_Csusp: { ! 1036: --ilevel; ! 1037: ExInterp; ! 1038: return A_Resumption; ! 1039: break; ! 1040: } ! 1041: ! 1042: case G_Esusp: ! 1043: goto efail; ! 1044: ! 1045: case G_Psusp: ! 1046: break; ! 1047: } ! 1048: ! 1049: break; ! 1050: } ! 1051: /* <efail3 */ ! 1052: ! 1053: case Op_Pfail: /* fail from procedure */ ! 1054: /* ! 1055: * An Icon procedure is failing. Generate tracing message if ! 1056: * tracing is on. Deactivate inactive C generators created ! 1057: * after activation of the procedure. Appropriate values ! 1058: * are restored from the procedure frame. ! 1059: */ ! 1060: --k_level; ! 1061: if (k_trace) ! 1062: ftrace(BlkLoc(*argp)); ! 1063: Pfail_uw: ! 1064: if (pfp->pf_ilevel != ilevel) { ! 1065: --ilevel; ! 1066: ExInterp; ! 1067: return A_Pfail_uw; ! 1068: } ! 1069: line = pfp->pf_line; ! 1070: efp = pfp->pf_efp; ! 1071: gfp = pfp->pf_gfp; ! 1072: ipc = pfp->pf_ipc; ! 1073: argp = pfp->pf_argp; ! 1074: pfp = pfp->pf_pfp; ! 1075: goto efail; ! 1076: ! 1077: /* ---Odds and Ends--- */ ! 1078: ! 1079: case Op_Ccase: /* case clause */ ! 1080: PushNull; ! 1081: PushVal(((word *)efp)[-2]); ! 1082: PushVal(((word *)efp)[-1]); ! 1083: break; ! 1084: ! 1085: case Op_Chfail: /* change failure ipc */ ! 1086: opnd = GetWord; ! 1087: opnd += (word)ipc; ! 1088: efp->ef_failure = (word *)opnd; ! 1089: break; ! 1090: ! 1091: case Op_Dup: /* duplicate descriptor */ ! 1092: PushNull; ! 1093: rsp[1] = rsp[-3]; ! 1094: rsp[2] = rsp[-2]; ! 1095: rsp += 2; ! 1096: break; ! 1097: ! 1098: case Op_Field: /* e1.e2 */ ! 1099: PushVal(D_Integer); ! 1100: PushVal(GetWord); ! 1101: Setup_Op(2); ! 1102: signal = field(2,rargp); ! 1103: goto C_rtn_term; ! 1104: ! 1105: case Op_Goto: /* goto */ ! 1106: PutWord(Op_Agoto); ! 1107: opnd = GetWord; ! 1108: opnd += (word)ipc; ! 1109: PutWord(opnd); ! 1110: ipc = (word *)opnd; ! 1111: break; ! 1112: ! 1113: case Op_Agoto: /* goto absolute address */ ! 1114: opnd = GetWord; ! 1115: ipc = (word *)opnd; ! 1116: break; ! 1117: ! 1118: case Op_Init: /* initial */ ! 1119: *--ipc = Op_Goto; ! 1120: opnd = sizeof(*ipc) + sizeof(*rsp); ! 1121: opnd += (word)ipc; ! 1122: ipc = (word *)opnd; ! 1123: break; ! 1124: ! 1125: case Op_Limit: /* limit */ ! 1126: Setup_Op(0); ! 1127: if (limit(0,rargp) == A_Failure) ! 1128: goto efail; ! 1129: else ! 1130: rsp = (word *) rargp + 1; ! 1131: goto mark0; ! 1132: ! 1133: case Op_Line: /* line */ ! 1134: line = GetWord; ! 1135: break; ! 1136: ! 1137: case Op_Tally: /* tally */ ! 1138: tallybin[GetWord]++; ! 1139: break; ! 1140: ! 1141: case Op_Pnull: /* push null descriptor */ ! 1142: PushNull; ! 1143: break; ! 1144: ! 1145: case Op_Pop: /* pop descriptor */ ! 1146: rsp -= 2; ! 1147: break; ! 1148: ! 1149: case Op_Push1: /* push integer 1 */ ! 1150: PushVal(D_Integer); ! 1151: PushVal(1); ! 1152: break; ! 1153: ! 1154: case Op_Pushn1: /* push integer -1 */ ! 1155: PushVal(D_Integer); ! 1156: PushVal(-1); ! 1157: break; ! 1158: ! 1159: case Op_Sdup: /* duplicate descriptor */ ! 1160: rsp += 2; ! 1161: rsp[-1] = rsp[-3]; ! 1162: rsp[0] = rsp[-2]; ! 1163: break; ! 1164: ! 1165: /* ---Co-expressions--- */ ! 1166: ! 1167: case Op_Create: /* create */ ! 1168: PushNull; ! 1169: Setup_Op(0); ! 1170: opnd = GetWord; ! 1171: opnd += (word)ipc; ! 1172: signal = create((word *)opnd, rargp); ! 1173: goto C_rtn_term; ! 1174: ! 1175: ! 1176: case Op_Coact: { /* @e */ ! 1177: register struct b_coexpr *ccp, *ncp; ! 1178: struct descrip *dp, *tvalp; ! 1179: word first; ! 1180: ! 1181: ExInterp; ! 1182: dp = (struct descrip *)(sp - 1); ! 1183: DeRef(*dp); ! 1184: if (dp->dword != D_Coexpr) ! 1185: runerr(118, dp); ! 1186: ccp = (struct b_coexpr *)BlkLoc(current); ! 1187: ncp = (struct b_coexpr *)BlkLoc(*dp); ! 1188: if (ncp->tvalloc != NULL) /* Cannot activate co-expression */ ! 1189: runerr(214, NULL); /* that is already active */ ! 1190: /* ! 1191: * Save Istate of current co-expression. ! 1192: */ ! 1193: ccp->es_pfp = pfp; ! 1194: ccp->es_argp = argp; ! 1195: ccp->es_efp = efp; ! 1196: ccp->es_gfp = gfp; ! 1197: ccp->es_ipc = ipc; ! 1198: ccp->es_sp = sp; ! 1199: ccp->es_ilevel = ilevel; ! 1200: ccp->es_line = line; ! 1201: ccp->tvalloc = (struct descrip *)(sp - 3); ! 1202: /* ! 1203: * Establish Istate for new co-expression. ! 1204: */ ! 1205: pfp = ncp->es_pfp; ! 1206: argp = ncp->es_argp; ! 1207: efp = ncp->es_efp; ! 1208: gfp = ncp->es_gfp; ! 1209: ipc = ncp->es_ipc; ! 1210: sp = ncp->es_sp; ! 1211: ilevel = ncp->es_ilevel; ! 1212: line = ncp->es_line; ! 1213: ! 1214: if (tvalp = ncp->tvalloc) { ! 1215: ncp->tvalloc = NULL; ! 1216: *tvalp = *(struct descrip *)(&ccp->es_sp[-3]); ! 1217: if (Var(*tvalp)) { ! 1218: word *loc; ! 1219: ! 1220: if (Tvar(*tvalp)) { ! 1221: if (tvalp->dword == D_Tvsubs) { ! 1222: struct b_tvsubs *tvb; ! 1223: ! 1224: tvb = (struct b_tvsubs *)BlkLoc(*tvalp); ! 1225: loc = (word *)BlkLoc(tvb->ssvar); ! 1226: } ! 1227: else ! 1228: goto ca_noderef; ! 1229: } ! 1230: else ! 1231: loc = (word *)BlkLoc(*tvalp); ! 1232: if (loc >= (word *)ccp && loc <= ccp->es_sp) ! 1233: deref(tvalp); ! 1234: } ! 1235: } ! 1236: ca_noderef: ! 1237: /* ! 1238: * Set activator in new co-expression. ! 1239: */ ! 1240: if (ncp->activator.dword == D_Null) ! 1241: first = 0; ! 1242: else ! 1243: first = 1; ! 1244: ncp->activator.dword = D_Coexpr; ! 1245: BlkLoc(ncp->activator) = (union block *)ccp; ! 1246: BlkLoc(current) = (union block *)ncp; ! 1247: coexp_act = A_Coact; ! 1248: coswitch(ccp->cstate,ncp->cstate,first); ! 1249: EntInterp; ! 1250: if (coexp_act == A_Cofail) ! 1251: goto efail; ! 1252: else ! 1253: rsp -= 2; ! 1254: break; ! 1255: } ! 1256: ! 1257: case Op_Coret: { /* return from co-expression */ ! 1258: register struct b_coexpr *ccp, *ncp; ! 1259: struct descrip *rvalp; ! 1260: ! 1261: ExInterp; ! 1262: ccp = (struct b_coexpr *)BlkLoc(current); ! 1263: ccp->size++; ! 1264: ncp = (struct b_coexpr *)BlkLoc(ccp->activator); ! 1265: ncp->tvalloc = NULL; ! 1266: rvalp = (struct descrip *)(&ncp->es_sp[-3]); ! 1267: *rvalp = *(struct descrip *)&sp[-1]; ! 1268: if (Var(*rvalp)) { ! 1269: word *loc; ! 1270: ! 1271: if (Tvar(*rvalp)) { ! 1272: if (rvalp->dword == D_Tvsubs) { ! 1273: struct b_tvsubs *tvb; ! 1274: ! 1275: tvb = (struct b_tvsubs *)BlkLoc(*rvalp); ! 1276: loc = (word *)BlkLoc(tvb->ssvar); ! 1277: } ! 1278: else ! 1279: goto cr_noderef; ! 1280: } ! 1281: else ! 1282: loc = (word *)BlkLoc(*rvalp); ! 1283: if (loc >= (word *)ccp && loc <= sp) ! 1284: deref(rvalp); ! 1285: } ! 1286: cr_noderef: ! 1287: /* ! 1288: * Save Istate of current co-expression. ! 1289: */ ! 1290: ccp->es_pfp = pfp; ! 1291: ccp->es_argp = argp; ! 1292: ccp->es_efp = efp; ! 1293: ccp->es_gfp = gfp; ! 1294: ccp->es_ipc = ipc; ! 1295: ccp->es_sp = sp; ! 1296: ccp->es_ilevel = ilevel; ! 1297: ccp->es_line = line; ! 1298: /* ! 1299: * Establish Istate for new co-expression. ! 1300: */ ! 1301: pfp = ncp->es_pfp; ! 1302: argp = ncp->es_argp; ! 1303: efp = ncp->es_efp; ! 1304: gfp = ncp->es_gfp; ! 1305: ipc = ncp->es_ipc; ! 1306: sp = ncp->es_sp; ! 1307: ilevel = ncp->es_ilevel; ! 1308: line = ncp->es_line; ! 1309: BlkLoc(current) = (union block *)ncp; ! 1310: coexp_act = A_Coret; ! 1311: coswitch(ccp->cstate, ncp->cstate,(word)1); ! 1312: break; ! 1313: } ! 1314: ! 1315: case Op_Cofail: { /* fail from co-expression */ ! 1316: register struct b_coexpr *ccp, *ncp; ! 1317: ! 1318: ExInterp; ! 1319: ccp = (struct b_coexpr *)BlkLoc(current); ! 1320: ncp = (struct b_coexpr *)BlkLoc(ccp->activator); ! 1321: ncp->tvalloc = NULL; ! 1322: /* ! 1323: * Save Istate of current co-expression. ! 1324: */ ! 1325: ccp->es_pfp = pfp; ! 1326: ccp->es_argp = argp; ! 1327: ccp->es_efp = efp; ! 1328: ccp->es_gfp = gfp; ! 1329: ccp->es_ipc = ipc; ! 1330: ccp->es_sp = sp; ! 1331: ccp->es_ilevel = ilevel; ! 1332: ccp->es_line = line; ! 1333: /* ! 1334: * Establish Istate for new co-expression. ! 1335: */ ! 1336: pfp = ncp->es_pfp; ! 1337: argp = ncp->es_argp; ! 1338: efp = ncp->es_efp; ! 1339: gfp = ncp->es_gfp; ! 1340: ipc = ncp->es_ipc; ! 1341: sp = ncp->es_sp; ! 1342: ilevel = ncp->es_ilevel; ! 1343: line = ncp->es_line; ! 1344: BlkLoc(current) = (union block *)ncp; ! 1345: coexp_act = A_Cofail; ! 1346: coswitch(ccp->cstate, ncp->cstate,(word)1); ! 1347: break; ! 1348: } ! 1349: ! 1350: case Op_Quit: /* quit */ ! 1351: goto interp_quit; ! 1352: ! 1353: default: { ! 1354: char buf[50]; ! 1355: ! 1356: sprintf(buf, "unimplemented opcode: %ld\n",(long)op); ! 1357: syserr(buf); ! 1358: } ! 1359: } ! 1360: continue; ! 1361: ! 1362: /* >crtn */ ! 1363: C_rtn_term: ! 1364: EntInterp; ! 1365: switch (signal) { ! 1366: ! 1367: case A_Failure: ! 1368: goto efail; ! 1369: ! 1370: case A_Unmark_uw: /* unwind for unmark */ ! 1371: goto Unmark_uw; ! 1372: ! 1373: case A_Lsusp_uw: /* unwind for lsusp */ ! 1374: goto Lsusp_uw; ! 1375: ! 1376: case A_Eret_uw: /* unwind for eret */ ! 1377: goto Eret_uw; ! 1378: ! 1379: case A_Pret_uw: /* unwind for pret */ ! 1380: goto Pret_uw; ! 1381: ! 1382: case A_Pfail_uw: /* unwind for pfail */ ! 1383: goto Pfail_uw; ! 1384: } ! 1385: ! 1386: rsp = (word *) rargp + 1; /* set rsp to result */ ! 1387: continue; ! 1388: } ! 1389: /* <crtn */ ! 1390: ! 1391: interp_quit: ! 1392: --ilevel; ! 1393: #if (Instr % Instr_level) == 0 ! 1394: fprintf(stderr,"maximum ilevel = %d\n",maxilevel); ! 1395: fprintf(stderr,"maximum sp = %d\n",(long)maxsp - (long)stack); ! 1396: fflush(stderr); ! 1397: #endif Instr ! 1398: if (ilevel != 0) ! 1399: syserr("Interpreter termination with inactive generators!"); ! 1400: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.