The R Project SVN – R – Diff – /branches/R-exp-API/src/main/context.c



 *	CTXT_TOPLEVEL	The toplevel context
 *	CTXT_BREAK	target for "break"
 *	CTXT_NEXT	target for "next"
 *	CTXT_LOOP	target for either "break" or "next"
 *	CTXT_RETURN	target for "return" (i.e. a closure)
 *	CTXT_BROWSER	target for "return" to exit from browser
 *	CTXT_CCODE	other functions that need clean up if an error occurs
 *	CTXT_RESTART	a function call to restart was made inside the
 *			closure.
 *
 *	Code (such as the sys.xxx) that looks for CTXT_RETURN must also
 *	look for a CTXT_RESTART and CTXT_GENERIC.
 *	The mechanism used by restart is to change
 *	the context type; error/errorcall then looks for a RESTART and does
 *	a long jump there if it finds one.
 *
 *  A context is created with a call to
 *
 *	void begincontext(RCNTXT *cptr, int flags,
 *			  SEXP syscall, SEXP env, SEXP
 *			  sysp, SEXP promargs)
 *
 *  which sets up the context pointed to by cptr in the appropriate way.
 *  When the context goes "out-of-scope" a call to
 *
 *	void endcontext(RCNTXT *cptr)

    }
    if(n == 0 && cptr->nextcontext == NULL)
	return R_GlobalEnv;
    else
	error("sys.frame: not that many enclosing functions");
    return R_NilValue;	   /* just for -Wall */
}
 
 
/* We need to find the environment that can be returned by sys.frame */
/* (so it needs to be on the cloenv pointer of a context) that matches */

	cptr = cptr->nextcontext;
    }
    if (n == 0 && cptr->nextcontext == NULL)
	return (duplicate(cptr->call));
    errorcall(R_GlobalContext->call, "not that many enclosing functions");
    return R_NilValue;	/* just for -Wall */
}
 
SEXP R_sysfunction(int n, RCNTXT *cptr)
{
    SEXP s, t;

	cptr = cptr->nextcontext;
    }
    if (n == 0 && cptr->nextcontext == NULL)
	return(findVar(CAR(cptr->call),cptr->sysparent));
    errorcall(R_GlobalContext->call, "not that many enclosing functions");
    return R_NilValue;	/* just for -Wall */
}
 
/* some real insanity to keep Duncan sane */
 
SEXP do_restart(SEXP call, SEXP op, SEXP args, SEXP rho)
{
    RCNTXT *cptr;
 
    checkArity(op, args);
 
    if( !asLogical(CAR(args)) )
	return(R_NilValue);
    for(cptr = R_GlobalContext->nextcontext; cptr!= R_ToplevelContext;
	    cptr = cptr->nextcontext) {
	if (cptr->callflag & CTXT_FUNCTION) {
		cptr->callflag = CTXT_RESTART;
		break;
	}
    }
    if( cptr == R_ToplevelContext )
	errorcall(call, "no function to restart");
    return(R_NilValue);
}
 
/* An implementation of S's frame access functions. They usually count */
/* up from the globalEnv while we like to count down from the currentEnv. */

The R Project SVN R

(root)/branches/R-exp-API/src/main/context.c @ 28362 – Rev 6188 → 6191

Rev 6188		Rev 6191
Line 51...		Line 51...
51	`* CTXT_TOPLEVEL The toplevel context`	51	`* CTXT_TOPLEVEL The toplevel context`
52	`* CTXT_BREAK target for "break"`	52	`* CTXT_BREAK target for "break"`
53	`* CTXT_NEXT target for "next"`	53	`* CTXT_NEXT target for "next"`
54	`* CTXT_LOOP target for either "break" or "next"`	54	`* CTXT_LOOP target for either "break" or "next"`
55	`* CTXT_RETURN target for "return" (i.e. a closure)`	55	`* CTXT_RETURN target for "return" (i.e. a closure)`
56	`* CTXT_BROWSER target for "return" to exit from browser`	56	`* CTXT_BROWSER target for "return" to exit from browser`
57	`* CTXT_CCODE other functions that need clean up if an error occurs`	57	`* CTXT_CCODE other functions that need clean up if an error occurs`
58	`* CTXT_RESTART a function call to restart was made inside the`	58	`* CTXT_RESTART a function call to restart was made inside the`
59	`* closure.`	59	`* closure.`
60	`*`	60	`*`
61	`* Code (such as the sys.xxx) that looks for CTXT_RETURN must also`	61	`* Code (such as the sys.xxx) that looks for CTXT_RETURN must also`
62	`* look for a CTXT_RESTART and CTXT_GENERIC.`	62	`* look for a CTXT_RESTART and CTXT_GENERIC.`
63	`* The mechanism used by restart is to change`	63	`* The mechanism used by restart is to change`
64	`* the context type; error/errorcall then looks for a RESTART and does`	64	`* the context type; error/errorcall then looks for a RESTART and does`
65	`* a long jump there if it finds one.`	65	`* a long jump there if it finds one.`
66	`*`	66	`*`
67	`* A context is created with a call to`	67	`* A context is created with a call to`
68	`*`	68	`*`
69	`* void begincontext(RCNTXT *cptr, int flags,`	69	`* void begincontext(RCNTXT *cptr, int flags,`
70	`* SEXP syscall, SEXP env, SEXP`	70	`* SEXP syscall, SEXP env, SEXP`
71	`* sysp, SEXP promargs)`	71	`* sysp, SEXP promargs)`
72	`*`	72	`*`
73	`* which sets up the context pointed to by cptr in the appropriate way.`	73	`* which sets up the context pointed to by cptr in the appropriate way.`
74	`* When the context goes "out-of-scope" a call to`	74	`* When the context goes "out-of-scope" a call to`
75	`*`	75	`*`
76	`* void endcontext(RCNTXT *cptr)`	76	`* void endcontext(RCNTXT *cptr)`
Line 200...		Line 200...
200	`}`	200	`}`
201	`if(n == 0 && cptr->nextcontext == NULL)`	201	`if(n == 0 && cptr->nextcontext == NULL)`
202	`return R_GlobalEnv;`	202	`return R_GlobalEnv;`
203	`else`	203	`else`
204	`error("sys.frame: not that many enclosing functions");`	204	`error("sys.frame: not that many enclosing functions");`
205	`return R_NilValue; /* just for -Wall */`	205	`return R_NilValue; /* just for -Wall */`
206	`}`	206	`}`
207		207
208		208
209	`/* We need to find the environment that can be returned by sys.frame */`	209	`/* We need to find the environment that can be returned by sys.frame */`
210	`/* (so it needs to be on the cloenv pointer of a context) that matches */`	210	`/* (so it needs to be on the cloenv pointer of a context) that matches */`
Line 276...		Line 276...
276	`cptr = cptr->nextcontext;`	276	`cptr = cptr->nextcontext;`
277	`}`	277	`}`
278	`if (n == 0 && cptr->nextcontext == NULL)`	278	`if (n == 0 && cptr->nextcontext == NULL)`
279	`return (duplicate(cptr->call));`	279	`return (duplicate(cptr->call));`
280	`errorcall(R_GlobalContext->call, "not that many enclosing functions");`	280	`errorcall(R_GlobalContext->call, "not that many enclosing functions");`
281	`return R_NilValue; /* just for -Wall */`	281	`return R_NilValue; /* just for -Wall */`
282	`}`	282	`}`
283		283
284	`SEXP R_sysfunction(int n, RCNTXT *cptr)`	284	`SEXP R_sysfunction(int n, RCNTXT *cptr)`
285	`{`	285	`{`
286	`SEXP s, t;`	286	`SEXP s, t;`
Line 308...		Line 308...
308	`cptr = cptr->nextcontext;`	308	`cptr = cptr->nextcontext;`
309	`}`	309	`}`
310	`if (n == 0 && cptr->nextcontext == NULL)`	310	`if (n == 0 && cptr->nextcontext == NULL)`
311	`return(findVar(CAR(cptr->call),cptr->sysparent));`	311	`return(findVar(CAR(cptr->call),cptr->sysparent));`
312	`errorcall(R_GlobalContext->call, "not that many enclosing functions");`	312	`errorcall(R_GlobalContext->call, "not that many enclosing functions");`
313	`return R_NilValue; /* just for -Wall */`	313	`return R_NilValue; /* just for -Wall */`
314	`}`	314	`}`
315		315
316	`/* some real insanity to keep Duncan sane */`	316	`/* some real insanity to keep Duncan sane */`
317		317
318	`SEXP do_restart(SEXP call, SEXP op, SEXP args, SEXP rho)`	318	`SEXP do_restart(SEXP call, SEXP op, SEXP args, SEXP rho)`
319	`{`	319	`{`
320	`RCNTXT *cptr;`	320	`RCNTXT *cptr;`
321		321
322	`checkArity(op, args);`	322	`checkArity(op, args);`
323		323
324	`if( !asLogical(CAR(args)) )`	324	`if( !asLogical(CAR(args)) )`
325	`return(R_NilValue);`	325	`return(R_NilValue);`
326	`for(cptr = R_GlobalContext->nextcontext; cptr!= R_ToplevelContext;`	326	`for(cptr = R_GlobalContext->nextcontext; cptr!= R_ToplevelContext;`
327	`cptr = cptr->nextcontext) {`	327	`cptr = cptr->nextcontext) {`
328	`if (cptr->callflag & CTXT_FUNCTION) {`	328	`if (cptr->callflag & CTXT_FUNCTION) {`
329	`cptr->callflag = CTXT_RESTART;`	329	`cptr->callflag = CTXT_RESTART;`
330	`break;`	330	`break;`
331	`}`	331	`}`
332	`}`	332	`}`
333	`if( cptr == R_ToplevelContext )`	333	`if( cptr == R_ToplevelContext )`
334	`errorcall(call, "no function to restart\n");`	334	`errorcall(call, "no function to restart");`
335	`return(R_NilValue);`	335	`return(R_NilValue);`
336	`}`	336	`}`
337		337
338	`/* An implementation of S's frame access functions. They usually count */`	338	`/* An implementation of S's frame access functions. They usually count */`
339	`/* up from the globalEnv while we like to count down from the currentEnv. */`	339	`/* up from the globalEnv while we like to count down from the currentEnv. */`