path: root/src/runtime/interp.r

/*
 * File: interp.r
 *  The interpreter proper.
 */

#include "../h/opdefs.h"

extern fptr fncentry[];

word lastop;			/* Last operator evaluated */

/*
 * Istate variables.
 */
struct ef_marker *efp;		/* Expression frame pointer */
struct gf_marker *gfp;		/* Generator frame pointer */
inst ipc;			/* Interpreter program counter */
word *sp = NULL;		/* Stack pointer */

int ilevel;			/* Depth of recursion in interp() */
struct descrip value_tmp;	/* list argument to Op_Apply */
struct descrip eret_tmp;	/* eret value during unwinding */

int coexp_act;			/* last co-expression action */

dptr xargp;
word xnargs;

/*
 * Macros for use inside the main loop of the interpreter.
 */

/*
 * Setup_Op sets things up for a call to the C function for an operator.
 */
#begdef Setup_Op(nargs)
   rargp = (dptr)(rsp - 1) - nargs;
   xargp = rargp;
   ExInterp;
#enddef					/* Setup_Op */

/*
 * Setup_Arg sets things up for a call to the C function.
 *  It is the same as Setup_Op, except the latter is used only
 *  operators.
 */
#begdef Setup_Arg(nargs)
   rargp = (dptr)(rsp - 1) - nargs;
   xargp = rargp;
   ExInterp;
#enddef					/* Setup_Arg */

#begdef Call_Cond
   if ((*(optab[lastop]))(rargp) == A_Resume) {
     goto efail_noev;
   }
   rsp = (word *) rargp + 1;
   break;
#enddef					/* Call_Cond */

/*
 * Call_Gen - Call a generator. A C routine associated with the
 *  current opcode is called. When it when it terminates, control is
 *  passed to C_rtn_term to deal with the termination condition appropriately.
 */
#begdef Call_Gen
   signal = (*(optab[lastop]))(rargp);
   goto C_rtn_term;
#enddef					/* Call_Gen */

/*
 * GetWord fetches the next icode word.  PutWord(x) stores x at the current
 * icode word.
 */
#define GetWord (*ipc.opnd++)
#define PutWord(x) ipc.opnd[-1] = (x)
#define GetOp (word)(*ipc.op++)
#define PutOp(x) ipc.op[-1] = (x)

/*
 * DerefArg(n) dereferences the nth argument.
 */
#define DerefArg(n)   Deref(rargp[n])

/*
 * For the sake of efficiency, the stack pointer is kept in a register
 *  variable, rsp, in the interpreter loop.  Since this variable is
 *  only accessible inside the loop, and the global variable sp is used
 *  for the stack pointer elsewhere, rsp must be stored into sp when
 *  the context of the loop is left and conversely, rsp must be loaded
 *  from sp when the loop is reentered.  The macros ExInterp and EntInterp,
 *  respectively, handle these operations.  Currently, this register/global
 *  scheme is only used for the stack pointer, but it can be easily extended
 *  to other variables.
 */

#define ExInterp	sp = rsp;
#define EntInterp	rsp = sp;

/*
 * Inside the interpreter loop, PushDesc, PushNull, PushAVal, and
 *  PushVal use rsp instead of sp for efficiency.
 */
#undef PushDesc
#undef PushNull
#undef PushVal
#undef PushAVal
#define PushDesc(d)   PushDescSP(rsp,d)
#define PushNull      PushNullSP(rsp)
#define PushVal(v)    PushValSP(rsp,v)
#define PushAVal(a)   PushValSP(rsp,a)


/*
 * The main loop of the interpreter.
 */
int interp(fsig,cargp)
int fsig;
dptr cargp;
   {
   register word opnd;
   register word *rsp;
   register dptr rargp;
   register struct ef_marker *newefp;
   register struct gf_marker *newgfp;
   register word *wd;
   register word *firstwd, *lastwd;
   word *oldsp;
   int type, signal, args;
   extern int (*optab[])();
   extern int (*keytab[])();
   struct b_proc *bproc;

   /*
    * Make a stab at catching interpreter stack overflow.  This does
    * nothing for invocation in a co-expression other than &main.
    */
   if (BlkLoc(k_current) == BlkLoc(k_main) &&
      ((char *)sp + PerilDelta) > (char *)stackend)
         fatalerr(301, NULL);

#ifdef Polling
   if (!pollctr--) {
      pollctr = pollevent();
      if (pollctr == -1) fatalerr(141, NULL);
      }
#endif					/* Polling */

   ilevel++;

   EntInterp;

   if (fsig == G_Csusp) {

      oldsp = rsp;

      /*
       * Create the generator frame.
       */
      newgfp = (struct gf_marker *)(rsp + 1);
      newgfp->gf_gentype = fsig;
      newgfp->gf_gfp = gfp;
      newgfp->gf_efp = efp;
      newgfp->gf_ipc = ipc;
      rsp += Wsizeof(struct gf_smallmarker);

      /*
       * Region extends from first word after the marker for the generator
       *  or expression frame enclosing the call to the now-suspending
       *  routine to the first argument of the routine.
       */
      if (gfp != 0) {
	 if (gfp->gf_gentype == G_Psusp)
	    firstwd = (word *)gfp + Wsizeof(*gfp);
	 else
	    firstwd = (word *)gfp + Wsizeof(struct gf_smallmarker);
	 }
      else
	 firstwd = (word *)efp + Wsizeof(*efp);
      lastwd = (word *)cargp + 1;

      /*
       * Copy the portion of the stack with endpoints firstwd and lastwd
       *  (inclusive) to the top of the stack.
       */
      for (wd = firstwd; wd <= lastwd; wd++)
	 *++rsp = *wd;
      gfp = newgfp;
      }
/*
 * Top of the interpreter loop.
 */

   for (;;) {
      lastop = GetOp;		/* Instruction fetch */
      switch ((int)lastop) {		/*
				 * Switch on opcode.  The cases are
				 * organized roughly by functionality
				 * to make it easier to find things.
				 * For some C compilers, there may be
				 * an advantage to arranging them by
				 * likelihood of selection.
				 */

				/* ---Constant construction--- */

	 case Op_Cset:		/* cset */
	    PutOp(Op_Acset);
	    PushVal(D_Cset);
	    opnd = GetWord;
	    opnd += (word)ipc.opnd;
	    PutWord(opnd);
	    PushAVal(opnd);
	    break;

	 case Op_Acset:		/* cset, absolute address */
	    PushVal(D_Cset);
	    PushAVal(GetWord);
	    break;

	 case Op_Int:		/* integer */
	    PushVal(D_Integer);
	    PushVal(GetWord);
	    break;

	 case Op_Real:		/* real */
	    PutOp(Op_Areal);
	    PushVal(D_Real);
	    opnd = GetWord;
	    opnd += (word)ipc.opnd;
	    PushAVal(opnd);
	    PutWord(opnd);
	    break;

	 case Op_Areal:		/* real, absolute address */
	    PushVal(D_Real);
	    PushAVal(GetWord);
	    break;

	 case Op_Str:		/* string */
	    PutOp(Op_Astr);
	    PushVal(GetWord);
	    opnd = (word)strcons + GetWord;
	    PutWord(opnd);
	    PushAVal(opnd);
	    break;

	 case Op_Astr:		/* string, absolute address */
	    PushVal(GetWord);
	    PushAVal(GetWord);
	    break;

				/* ---Variable construction--- */

	 case Op_Arg:		/* argument */
	    PushVal(D_Var);
	    PushAVal(&glbl_argp[GetWord + 1]);
	    break;

	 case Op_Global:	/* global */
	    PutOp(Op_Aglobal);
	    PushVal(D_Var);
	    opnd = GetWord;
	    PushAVal(&globals[opnd]);
	    PutWord((word)&globals[opnd]);
	    break;

	 case Op_Aglobal:	/* global, absolute address */
	    PushVal(D_Var);
	    PushAVal(GetWord);
	    break;

	 case Op_Local:		/* local */
	    PushVal(D_Var);
	    PushAVal(&pfp->pf_locals[GetWord]);
	    break;

	 case Op_Static:	/* static */
	    PutOp(Op_Astatic);
	    PushVal(D_Var);
	    opnd = GetWord;
	    PushAVal(&statics[opnd]);
	    PutWord((word)&statics[opnd]);
	    break;

	 case Op_Astatic:	/* static, absolute address */
	    PushVal(D_Var);
	    PushAVal(GetWord);
	    break;


				/* ---Operators--- */

				/* Unary operators */

	 case Op_Compl:		/* ~e */
	 case Op_Neg:		/* -e */
	 case Op_Number:	/* +e */
	 case Op_Refresh:	/* ^e */
	 case Op_Size:		/* *e */
	    Setup_Op(1);
	    DerefArg(1);
	    Call_Cond;

	 case Op_Value:		/* .e */
            Setup_Op(1);
            DerefArg(1);
            Call_Cond;

	 case Op_Nonnull:	/* \e */
	 case Op_Null:		/* /e */
	    Setup_Op(1);
	    Call_Cond;

	 case Op_Random:	/* ?e */
	    PushNull;
	    Setup_Op(2)
	    Call_Cond

				/* Generative unary operators */

	 case Op_Tabmat:	/* =e */
	    Setup_Op(1);
	    DerefArg(1);
	    Call_Gen;

	 case Op_Bang:		/* !e */
	    PushNull;
	    Setup_Op(2);
	    Call_Gen;

				/* Binary operators */

	 case Op_Cat:		/* e1 || e2 */
	 case Op_Diff:		/* e1 -- e2 */
	 case Op_Div:		/* e1 / e2 */
	 case Op_Inter:		/* e1 ** e2 */
	 case Op_Lconcat:	/* e1 ||| e2 */
	 case Op_Minus:		/* e1 - e2 */
	 case Op_Mod:		/* e1 % e2 */
	 case Op_Mult:		/* e1 * e2 */
	 case Op_Power:		/* e1 ^ e2 */
	 case Op_Unions:	/* e1 ++ e2 */
	 case Op_Plus:		/* e1 + e2 */
	 case Op_Eqv:		/* e1 === e2 */
	 case Op_Lexeq:		/* e1 == e2 */
	 case Op_Lexge:		/* e1 >>= e2 */
	 case Op_Lexgt:		/* e1 >> e2 */
	 case Op_Lexle:		/* e1 <<= e2 */
	 case Op_Lexlt:		/* e1 << e2 */
	 case Op_Lexne:		/* e1 ~== e2 */
	 case Op_Neqv:		/* e1 ~=== e2 */
	 case Op_Numeq:		/* e1 = e2 */
	 case Op_Numge:		/* e1 >= e2 */
	 case Op_Numgt:		/* e1 > e2 */
	 case Op_Numle:		/* e1 <= e2 */
	 case Op_Numne:		/* e1 ~= e2 */
	 case Op_Numlt:		/* e1 < e2 */
	    Setup_Op(2);
	    DerefArg(1);
	    DerefArg(2);
	    Call_Cond;

	 case Op_Asgn:		/* e1 := e2 */
	    Setup_Op(2);
	    Call_Cond;

	 case Op_Swap:		/* e1 :=: e2 */
	    PushNull;
	    Setup_Op(3);
	    Call_Cond;

	 case Op_Subsc:		/* e1[e2] */
	    PushNull;
	    Setup_Op(3);
	    Call_Cond;
				/* Generative binary operators */

	 case Op_Rasgn:		/* e1 <- e2 */
	    Setup_Op(2);
	    Call_Gen;

	 case Op_Rswap:		/* e1 <-> e2 */
	    PushNull;
	    Setup_Op(3);
	    Call_Gen;

				/* Conditional ternary operators */

	 case Op_Sect:		/* e1[e2:e3] */
	    PushNull;
	    Setup_Op(4);
	    Call_Cond;
				/* Generative ternary operators */

	 case Op_Toby:		/* e1 to e2 by e3 */
	    Setup_Op(3);
	    DerefArg(1);
	    DerefArg(2);
	    DerefArg(3);
	    Call_Gen;

         case Op_Noop:		/* no-op */

#ifdef LineCodes
#ifdef Polling
            if (!pollctr--) {
	       ExInterp;
               pollctr = pollevent();
	       EntInterp;
	       if (pollctr == -1) fatalerr(141, NULL);
	       }
#endif					/* Polling */
#endif					/* LineCodes */

            break;

         case Op_Colm:		/* source column number */
            {
            break;
            }

         case Op_Line:		/* source line number */

#ifdef LineCodes
#ifdef Polling
            if (!pollctr--) {
	       ExInterp;
               pollctr = pollevent();
	       EntInterp;
	       if (pollctr == -1) fatalerr(141, NULL);
	       }
#endif					/* Polling */
#endif					/* LineCodes */
            break;

				/* ---String Scanning--- */

	 case Op_Bscan:		/* prepare for scanning */
	    PushDesc(k_subject);
	    PushVal(D_Integer);
	    PushVal(k_pos);
	    Setup_Arg(2);

	    signal = Obscan(2,rargp);

	    goto C_rtn_term;

	 case Op_Escan:		/* exit from scanning */
	    Setup_Arg(1);

	    signal = Oescan(1,rargp);

	    goto C_rtn_term;

				/* ---Other Language Operations--- */

         case Op_Apply: {	/* apply */
            union block *bp;
            int i, j;

            value_tmp = *(dptr)(rsp - 1);	/* argument */
            Deref(value_tmp);
            switch (Type(value_tmp)) {
               case T_List: {
                  rsp -= 2;				/* pop it off */
                  bp = BlkLoc(value_tmp);
                  args = (int)bp->list.size;

                 /*
                  * Make a stab at catching interpreter stack overflow.
                  * This does nothing for invocation in a co-expression other
                  * than &main.
                  */
                 if (BlkLoc(k_current) == BlkLoc(k_main) &&
                    ((char *)sp + args * sizeof(struct descrip) >
                       (char *)stackend))
                          fatalerr(301, NULL);

                  for (bp = bp->list.listhead;
		     bp != NULL;
                     bp = bp->lelem.listnext) {
                        for (i = 0; i < bp->lelem.nused; i++) {
                           j = bp->lelem.first + i;
                           if (j >= bp->lelem.nslots)
                              j -= bp->lelem.nslots;
                           PushDesc(bp->lelem.lslots[j]);
                           }
                        }
		  goto invokej;
		  }

               case T_Record: {
                  rsp -= 2;		/* pop it off */
                  bp = BlkLoc(value_tmp);
                  args = bp->record.recdesc->proc.nfields;
                  for (i = 0; i < args; i++) {
                     PushDesc(bp->record.fields[i]);
                     }
                  goto invokej;
                  }

               default: {		/* illegal type for invocation */

                  xargp = (dptr)(rsp - 3);
                  err_msg(126, &value_tmp);
                  goto efail;
                  }
               }
	    }

	 case Op_Invoke: {	/* invoke */
            args = (int)GetWord;
invokej:
	    {
            int nargs;
	    dptr carg;

	    ExInterp;
	    type = invoke(args, &carg, &nargs);
	    EntInterp;

	    if (type == I_Fail)
	       goto efail_noev;
	    if (type == I_Continue)
	       break;
	    else {

               rargp = carg;		/* valid only for Vararg or Builtin */

#ifdef Polling
	       /*
		* Do polling here
		*/
	       pollctr >>= 1;
               if (!pollctr) {
	          ExInterp;
                  pollctr = pollevent();
	          EntInterp;
	          if (pollctr == -1) fatalerr(141, NULL);
	          }
#endif					/* Polling */

	       bproc = (struct b_proc *)BlkLoc(*rargp);

	       /* ExInterp not needed since no change since last EntInterp */
	       if (type == I_Vararg) {
	          int (*bfunc)();
                  bfunc = bproc->entryp.ccode;
		  signal = (*bfunc)(nargs,rargp);
                  }
	       else
                  {
                  int (*bfunc)();
                  bfunc = bproc->entryp.ccode;
		  signal = (*bfunc)(rargp);
                  }
	       goto C_rtn_term;
	       }
	    }
	    }

	 case Op_Keywd:		/* keyword */

            PushNull;
            opnd = GetWord;
            Setup_Arg(0);

	    signal = (*(keytab[(int)opnd]))(rargp);
	    goto C_rtn_term;

	 case Op_Llist:		/* construct list */
	    opnd = GetWord;
	    Setup_Arg(opnd);
	    {
	    int i;
	    for (i=1;i<=opnd;i++)
               DerefArg(i);
	    }

	    signal = Ollist((int)opnd,rargp);

	    goto C_rtn_term;

				/* ---Marking and Unmarking--- */

	 case Op_Mark:		/* create expression frame marker */
	    PutOp(Op_Amark);
	    opnd = GetWord;
	    opnd += (word)ipc.opnd;
	    PutWord(opnd);
	    newefp = (struct ef_marker *)(rsp + 1);
	    newefp->ef_failure.opnd = (word *)opnd;
	    goto mark;

	 case Op_Amark:		/* mark with absolute fipc */
	    newefp = (struct ef_marker *)(rsp + 1);
	    newefp->ef_failure.opnd = (word *)GetWord;
mark:
	    newefp->ef_gfp = gfp;
	    newefp->ef_efp = efp;
	    newefp->ef_ilevel = ilevel;
	    rsp += Wsizeof(*efp);
	    efp = newefp;
	    gfp = 0;
	    break;

	 case Op_Mark0:		/* create expression frame with 0 ipl */
mark0:
	    newefp = (struct ef_marker *)(rsp + 1);
	    newefp->ef_failure.opnd = 0;
	    newefp->ef_gfp = gfp;
	    newefp->ef_efp = efp;
	    newefp->ef_ilevel = ilevel;
	    rsp += Wsizeof(*efp);
	    efp = newefp;
	    gfp = 0;
	    break;

	 case Op_Unmark:	/* remove expression frame */
	    gfp = efp->ef_gfp;
	    rsp = (word *)efp - 1;

	    /*
	     * Remove any suspended C generators.
	     */
Unmark_uw:
	    if (efp->ef_ilevel < ilevel) {
	       --ilevel;

	       ExInterp;
	       return A_Unmark_uw;
	       }

	    efp = efp->ef_efp;
	    break;

				/* ---Suspensions--- */

	 case Op_Esusp: {	/* suspend from expression */

	    /*
	     * Create the generator frame.
	     */
	    oldsp = rsp;
	    newgfp = (struct gf_marker *)(rsp + 1);
	    newgfp->gf_gentype = G_Esusp;
	    newgfp->gf_gfp = gfp;
	    newgfp->gf_efp = efp;
	    newgfp->gf_ipc = ipc;
	    gfp = newgfp;
	    rsp += Wsizeof(struct gf_smallmarker);

	    /*
	     * Region extends from first word after enclosing generator or
	     *	expression frame marker to marker for current expression frame.
	     */
	    if (efp->ef_gfp != 0) {
	       newgfp = (struct gf_marker *)(efp->ef_gfp);
	       if (newgfp->gf_gentype == G_Psusp)
		  firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp);
	       else
		  firstwd = (word *)efp->ef_gfp +
		     Wsizeof(struct gf_smallmarker);
		}
	    else
	       firstwd = (word *)efp->ef_efp + Wsizeof(*efp);
	    lastwd = (word *)efp - 1;
	    efp = efp->ef_efp;

	    /*
	     * Copy the portion of the stack with endpoints firstwd and lastwd
	     *	(inclusive) to the top of the stack.
	     */
	    for (wd = firstwd; wd <= lastwd; wd++)
	       *++rsp = *wd;
	    PushVal(oldsp[-1]);
	    PushVal(oldsp[0]);
	    break;
	    }

	 case Op_Lsusp: {	/* suspend from limitation */
	    struct descrip sval;

	    /*
	     * The limit counter is contained in the descriptor immediately
	     *	prior to the current expression frame.	lval is established
	     *	as a pointer to this descriptor.
	     */
	    dptr lval = (dptr)((word *)efp - 2);

	    /*
	     * Decrement the limit counter and check it.
	     */
	    if (--IntVal(*lval) > 0) {
	       /*
		* The limit has not been reached, set up stack.
		*/

	       sval = *(dptr)(rsp - 1);	/* save result */

	       /*
		* Region extends from first word after enclosing generator or
		*  expression frame marker to the limit counter just prior to
		*  to the current expression frame marker.
		*/
	       if (efp->ef_gfp != 0) {
		  newgfp = (struct gf_marker *)(efp->ef_gfp);
		  if (newgfp->gf_gentype == G_Psusp)
		     firstwd = (word *)efp->ef_gfp + Wsizeof(*gfp);
		  else
		     firstwd = (word *)efp->ef_gfp +
			Wsizeof(struct gf_smallmarker);
		  }
	       else
		  firstwd = (word *)efp->ef_efp + Wsizeof(*efp);
	       lastwd = (word *)efp - 3;
	       if (gfp == 0)
		  gfp = efp->ef_gfp;
	       efp = efp->ef_efp;

	       /*
		* Copy the portion of the stack with endpoints firstwd and lastwd
		*  (inclusive) to the top of the stack.
		*/
	       rsp -= 2;		/* overwrite result */
	       for (wd = firstwd; wd <= lastwd; wd++)
		  *++rsp = *wd;
	       PushDesc(sval);		/* push saved result */
	       }
	    else {
	       /*
		* Otherwise, the limit has been reached.  Instead of
		*  suspending, remove the current expression frame and
		*  replace the limit counter with the value on top of
		*  the stack (which would have been suspended had the
		*  limit not been reached).
		*/
	       *lval = *(dptr)(rsp - 1);
	       gfp = efp->ef_gfp;

	       /*
		* Since an expression frame is being removed, inactive
		*  C generators contained therein are deactivated.
		*/
Lsusp_uw:
	       if (efp->ef_ilevel < ilevel) {
		  --ilevel;
		  ExInterp;
		  return A_Lsusp_uw;
		  }
	       rsp = (word *)efp - 1;
	       efp = efp->ef_efp;
	       }
	    break;
	    }

	 case Op_Psusp: {	/* suspend from procedure */

	    /*
	     * An Icon procedure is suspending a value.  Determine if the
	     *	value being suspended should be dereferenced and if so,
	     *	dereference it. If tracing is on, strace is called
	     *  to generate a message.  Appropriate values are
	     *	restored from the procedure frame of the suspending procedure.
	     */

	    struct descrip tmp;
            dptr svalp;
	    struct b_proc *sproc;
	    svalp = (dptr)(rsp - 1);
	    if (Var(*svalp)) {
               ExInterp;
               retderef(svalp, (word *)glbl_argp, sp);
               EntInterp;
               }

	    /*
	     * Create the generator frame.
	     */
	    oldsp = rsp;
	    newgfp = (struct gf_marker *)(rsp + 1);
	    newgfp->gf_gentype = G_Psusp;
	    newgfp->gf_gfp = gfp;
	    newgfp->gf_efp = efp;
	    newgfp->gf_ipc = ipc;
	    newgfp->gf_argp = glbl_argp;
	    newgfp->gf_pfp = pfp;
	    gfp = newgfp;
	    rsp += Wsizeof(*gfp);

	    /*
	     * Region extends from first word after the marker for the
	     *	generator or expression frame enclosing the call to the
	     *	now-suspending procedure to Arg0 of the procedure.
	     */
	    if (pfp->pf_gfp != 0) {
	       newgfp = (struct gf_marker *)(pfp->pf_gfp);
	       if (newgfp->gf_gentype == G_Psusp)
		  firstwd = (word *)pfp->pf_gfp + Wsizeof(*gfp);
	       else
		  firstwd = (word *)pfp->pf_gfp +
		     Wsizeof(struct gf_smallmarker);
	       }
	    else
	       firstwd = (word *)pfp->pf_efp + Wsizeof(*efp);
	    lastwd = (word *)glbl_argp - 1;
	       efp = efp->ef_efp;

	    /*
	     * Copy the portion of the stack with endpoints firstwd and lastwd
	     *	(inclusive) to the top of the stack.
	     */
	    for (wd = firstwd; wd <= lastwd; wd++)
	       *++rsp = *wd;
	    PushVal(oldsp[-1]);
	    PushVal(oldsp[0]);
	    --k_level;
	    if (k_trace) {
               k_trace--;
	       sproc = (struct b_proc *)BlkLoc(*glbl_argp);
	       strace(&(sproc->pname), svalp);
	       }

	    /*
	     * If the scanning environment for this procedure call is in
	     *	a saved state, switch environments.
	     */
	    if (pfp->pf_scan != NULL) {
	       tmp = k_subject;
	       k_subject = *pfp->pf_scan;
	       *pfp->pf_scan = tmp;

	       tmp = *(pfp->pf_scan + 1);
	       IntVal(*(pfp->pf_scan + 1)) = k_pos;
	       k_pos = IntVal(tmp);
	       }

	    efp = pfp->pf_efp;
	    ipc = pfp->pf_ipc;
	    glbl_argp = pfp->pf_argp;
	    pfp = pfp->pf_pfp;
	    break;
	    }

				/* ---Returns--- */

	 case Op_Eret: {	/* return from expression */
	    /*
	     * Op_Eret removes the current expression frame, leaving the
	     *	original top of stack value on top.
	     */
	    /*
	     * Save current top of stack value in global temporary (no
	     *	danger of reentry).
	     */
	    eret_tmp = *(dptr)&rsp[-1];
	    gfp = efp->ef_gfp;
Eret_uw:
	    /*
	     * Since an expression frame is being removed, inactive
	     *	C generators contained therein are deactivated.
	     */
	    if (efp->ef_ilevel < ilevel) {
	       --ilevel;
	       ExInterp;
	       return A_Eret_uw;
	       }
	    rsp = (word *)efp - 1;
	    efp = efp->ef_efp;
	    PushDesc(eret_tmp);
	    break;
	    }


	 case Op_Pret: {	/* return from procedure */
	    /*
	     * An Icon procedure is returning a value.	Determine if the
	     *	value being returned should be dereferenced and if so,
	     *	dereference it.  If tracing is on, rtrace is called to
	     *	generate a message.  Inactive generators created after
	     *	the activation of the procedure are deactivated.  Appropriate
	     *	values are restored from the procedure frame.
	     */
	    struct b_proc *rproc;
	    rproc = (struct b_proc *)BlkLoc(*glbl_argp);
	    *glbl_argp = *(dptr)(rsp - 1);
	    if (Var(*glbl_argp)) {
               ExInterp;
               retderef(glbl_argp, (word *)glbl_argp, sp);
               EntInterp;
               }

	    --k_level;
	    if (k_trace) {
               k_trace--;
	       rtrace(&(rproc->pname), glbl_argp);
               }
Pret_uw:
	    if (pfp->pf_ilevel < ilevel) {
	       --ilevel;
	       ExInterp;
	       return A_Pret_uw;
	       }

	    rsp = (word *)glbl_argp + 1;
	    efp = pfp->pf_efp;
	    gfp = pfp->pf_gfp;
	    ipc = pfp->pf_ipc;
	    glbl_argp = pfp->pf_argp;
	    pfp = pfp->pf_pfp;

	    break;
	    }

				/* ---Failures--- */

	 case Op_Efail:
efail:
efail_noev:
	    /*
	     * Failure has occurred in the current expression frame.
	     */
	    if (gfp == 0) {
	       /*
		* There are no suspended generators to resume.
		*  Remove the current expression frame, restoring
		*  values.
		*
		* If the failure ipc is 0, propagate failure to the
		*  enclosing frame by branching back to efail.
		*  This happens, for example, in looping control
		*  structures that fail when complete.
		*/

	       ipc = efp->ef_failure;
	       gfp = efp->ef_gfp;
	       rsp = (word *)efp - 1;
	       efp = efp->ef_efp;

	       if (ipc.op == 0)
		  goto efail;
	       break;
	       }

	    else {
	       /*
		* There is a generator that can be resumed.  Make
		*  the stack adjustments and then switch on the
		*  type of the generator frame marker.
		*/
	       struct descrip tmp;
	       register struct gf_marker *resgfp = gfp;

	       type = (int)resgfp->gf_gentype;

	       if (type == G_Psusp) {
		  glbl_argp = resgfp->gf_argp;
		  if (k_trace) {	/* procedure tracing */
                     k_trace--;
		     ExInterp;
		     atrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname));
		     EntInterp;
		     }
		  }
	       ipc = resgfp->gf_ipc;
	       efp = resgfp->gf_efp;
	       gfp = resgfp->gf_gfp;
	       rsp = (word *)resgfp - 1;
	       if (type == G_Psusp) {
		  pfp = resgfp->gf_pfp;

		  /*
		   * If the scanning environment for this procedure call is
		   *  supposed to be in a saved state, switch environments.
		   */
		  if (pfp->pf_scan != NULL) {
		     tmp = k_subject;
		     k_subject = *pfp->pf_scan;
		     *pfp->pf_scan = tmp;

		     tmp = *(pfp->pf_scan + 1);
		     IntVal(*(pfp->pf_scan + 1)) = k_pos;
		     k_pos = IntVal(tmp);
		     }

		  ++k_level;		/* adjust procedure level */
		  }

	       switch (type) {

		  case G_Csusp:
		     --ilevel;
		     ExInterp;
		     return A_Resume;

		  case G_Esusp:
		     goto efail_noev;

		  case G_Psusp:		/* resuming a procedure */
		     break;
		  }

	       break;
	       }

	 case Op_Pfail: {	/* fail from procedure */
	    /*
	     * An Icon procedure is failing.  Generate tracing message if
	     *	tracing is on.	Deactivate inactive C generators created
	     *	after activation of the procedure.  Appropriate values
	     *	are restored from the procedure frame.
	     */

	    --k_level;
	    if (k_trace) {
               k_trace--;
	       failtrace(&(((struct b_proc *)BlkLoc(*glbl_argp))->pname));
               }
Pfail_uw:

	    if (pfp->pf_ilevel < ilevel) {
	       --ilevel;
	       ExInterp;
	       return A_Pfail_uw;
	       }
	    efp = pfp->pf_efp;
	    gfp = pfp->pf_gfp;
	    ipc = pfp->pf_ipc;
	    glbl_argp = pfp->pf_argp;
	    pfp = pfp->pf_pfp;
	    goto efail_noev;
	    }
				/* ---Odds and Ends--- */

	 case Op_Ccase:		/* case clause */
	    PushNull;
	    PushVal(((word *)efp)[-2]);
	    PushVal(((word *)efp)[-1]);
	    break;

	 case Op_Chfail:	/* change failure ipc */
	    opnd = GetWord;
	    opnd += (word)ipc.opnd;
	    efp->ef_failure.opnd = (word *)opnd;
	    break;

	 case Op_Dup:		/* duplicate descriptor */
	    PushNull;
	    rsp[1] = rsp[-3];
	    rsp[2] = rsp[-2];
	    rsp += 2;
	    break;

	 case Op_Field:		/* e1.e2 */
	    PushVal(D_Integer);
	    PushVal(GetWord);
	    Setup_Arg(2);

	    signal = Ofield(2,rargp);

	    goto C_rtn_term;

	 case Op_Goto:		/* goto */
	    PutOp(Op_Agoto);
	    opnd = GetWord;
	    opnd += (word)ipc.opnd;
	    PutWord(opnd);
	    ipc.opnd = (word *)opnd;
	    break;

	 case Op_Agoto:		/* goto absolute address */
	    opnd = GetWord;
	    ipc.opnd = (word *)opnd;
	    break;

	 case Op_Init:		/* initial */
	    *--ipc.op = Op_Goto;
	    opnd = sizeof(*ipc.op) + sizeof(*rsp);
	    opnd += (word)ipc.opnd;
	    ipc.opnd = (word *)opnd;
	    break;

	 case Op_Limit:		/* limit */
	    Setup_Arg(0);

	    if (Olimit(0,rargp) == A_Resume) {

	       /*
		* limit has failed here; could generate an event for it,
		*  but not an Ofail since limit is not an operator and
		*  no Ocall was ever generated for it.
		*/
	       goto efail_noev;
	       }
	    else {
	       /*
		* limit has returned here; could generate an event for it,
		*  but not an Oret since limit is not an operator and
		*  no Ocall was ever generated for it.
		*/
	       rsp = (word *) rargp + 1;
	       }
	    goto mark0;

	 case Op_Pnull:		/* push null descriptor */
	    PushNull;
	    break;

	 case Op_Pop:		/* pop descriptor */
	    rsp -= 2;
	    break;

	 case Op_Push1:		/* push integer 1 */
	    PushVal(D_Integer);
	    PushVal(1);
	    break;

	 case Op_Pushn1:	/* push integer -1 */
	    PushVal(D_Integer);
	    PushVal(-1);
	    break;

	 case Op_Sdup:		/* duplicate descriptor */
	    rsp += 2;
	    rsp[-1] = rsp[-3];
	    rsp[0] = rsp[-2];
	    break;

					/* ---Co-expressions--- */

	 case Op_Create:	/* create */
	    PushNull;
	    Setup_Arg(0);
	    opnd = GetWord;
	    opnd += (word)ipc.opnd;
	    signal = Ocreate((word *)opnd, rargp);
	    goto C_rtn_term;

	 case Op_Coact: {	/* @e */
            struct b_coexpr *ncp;
            dptr dp;

            ExInterp;
            dp = (dptr)(sp - 1);
            xargp = dp - 2;

            Deref(*dp);
            if (dp->dword != D_Coexpr) {
               err_msg(118, dp);
               goto efail;
               }

            ncp = (struct b_coexpr *)BlkLoc(*dp);

            signal = activate((dptr)(sp - 3), ncp, (dptr)(sp - 3));
            EntInterp;
            if (signal == A_Resume)
               goto efail_noev;
            else
               rsp -= 2;
            break;
	    }

	 case Op_Coret: {	/* return from co-expression */
            struct b_coexpr *ncp;

            ExInterp;
            ncp = popact((struct b_coexpr *)BlkLoc(k_current));

            ++BlkLoc(k_current)->coexpr.size;
            co_chng(ncp, (dptr)&sp[-1], NULL, A_Coret, 1);
            EntInterp;
            break;

	    }

	 case Op_Cofail: {	/* fail from co-expression */
            struct b_coexpr *ncp;

            ExInterp;
            ncp = popact((struct b_coexpr *)BlkLoc(k_current));

            co_chng(ncp, NULL, NULL, A_Cofail, 1);
            EntInterp;
            break;

	    }
         case Op_Quit:		/* quit */


	    goto interp_quit;


	 default: {
	    char buf[50];

	    sprintf(buf, "unimplemented opcode: %ld (0x%08lx)\n",
               (long)lastop, (long)lastop);
	    syserr(buf);
	    }
	 }
	 continue;

C_rtn_term:
	 EntInterp;

	 switch (signal) {

	    case A_Resume:
	       goto efail_noev;

	    case A_Unmark_uw:		/* unwind for unmark */
	       goto Unmark_uw;

	    case A_Lsusp_uw:		/* unwind for lsusp */
	       goto Lsusp_uw;

	    case A_Eret_uw:		/* unwind for eret */
	       goto Eret_uw;

	    case A_Pret_uw:		/* unwind for pret */
	       goto Pret_uw;

	    case A_Pfail_uw:		/* unwind for pfail */
	       goto Pfail_uw;
	    }

	 rsp = (word *)rargp + 1;	/* set rsp to result */
	 continue;
	 }

interp_quit:
   --ilevel;
   if (ilevel != 0)
      syserr("interp: termination with inactive generators.");
   /*NOTREACHED*/
   return 0;	/* avoid gcc warning */
   }