The R Project SVN – R – Diff – /trunk/src/main/context.c

     else
 	n = -n;
     if(n < 0)
 	errorcall(R_GlobalContext->call,
-		  _("not that many enclosing environments"));
+		  _("not that many frames on the stack"));
     while (cptr->nextcontext != NULL) {
 	if (cptr->callflag & CTXT_FUNCTION ) {
 	    if (n == 0) {  /* we need to detach the enclosing env */
 		return cptr->cloenv;
 	cptr = cptr->nextcontext;
+    }
     if(n == 0 && cptr->nextcontext == NULL)
 	return R_GlobalEnv;
     else
+	errorcall(R_GlobalContext->call,
-	error(_("sys.frame: not that many enclosing functions"));
+		  _("not that many frames on the stack"));
     return R_NilValue;	   /* just for -Wall */
+}
 /* We need to find the environment that can be returned by sys.frame */
+{
     int j;
     SEXP s;
     if(n <= 0)
 	errorcall(R_ToplevelContext->call,
-		  _("only positive arguments are allowed"));
+		  _("only positive values of 'n' are allowed"));
     while (cptr->nextcontext != NULL && n > 1) {
 	if (cptr->callflag & CTXT_FUNCTION )
 	    n--;
 	cptr = cptr->nextcontext;
+    }
 SEXP R_syscall(int n, RCNTXT *cptr)
+{
     /* negative n counts back from the current frame */
     /* positive n counts up from the globalEnv */
     if (n > 0)
-	n = framedepth(cptr)-n;
+	n = framedepth(cptr) - n;
     else
 	n = - n;
-    if(n < 0 )
+    if(n < 0)
-	errorcall(R_GlobalContext->call, _("invalid frame number"));
+	errorcall(R_GlobalContext->call,
+		  _("not that many frames on the stack"));
     while (cptr->nextcontext != NULL) {
 	if (cptr->callflag & CTXT_FUNCTION ) {
 	    if (n == 0)
 		return (duplicate(cptr->call));
 	    else
+	}
 	cptr = cptr->nextcontext;
+    }
     if (n == 0 && cptr->nextcontext == NULL)
 	return (duplicate(cptr->call));
-    errorcall(R_GlobalContext->call, _("not that many enclosing functions"));
+    errorcall(R_GlobalContext->call, _("not that many frames on the stack"));
     return R_NilValue;	/* just for -Wall */
+}
 SEXP R_sysfunction(int n, RCNTXT *cptr)
+{
     if (n > 0)
 	n = framedepth(cptr) - n;
     else
 	n = - n;
-    if (n < 0 )
+    if (n < 0)
-	errorcall(R_GlobalContext->call, _("invalid frame number"));
+	errorcall(R_GlobalContext->call,
+		  _("not that many frames on the stack"));
     while (cptr->nextcontext != NULL) {
 	if (cptr->callflag & CTXT_FUNCTION ) {
 	    if (n == 0)
 		return duplicate(cptr->callfun);  /***** do we need to DUP? */
 	    else
+	}
 	cptr = cptr->nextcontext;
+    }
     if (n == 0 && cptr->nextcontext == NULL)
 	return duplicate(cptr->callfun);  /***** do we need to DUP? */
-    errorcall(R_GlobalContext->call, _("not that many enclosing functions"));
+    errorcall(R_GlobalContext->call, _("not that many frames on the stack"));
     return R_NilValue;	/* just for -Wall */
+}
 /* some real insanity to keep Duncan sane */
 	n = asInteger(t);
+    }
     else
 	n = - 1;
-    if(n == NA_INTEGER)
-	errorcall(call, _("invalid number of environment levels"));
     switch (PRIMVAL(op)) {
     case 1: /* parent */
+	if(n == NA_INTEGER)
+	    errorcall(call, _("invalid value for 'n'"));
 	nframe = framedepth(cptr);
 	rval = allocVector(INTSXP,1);
 	i = nframe;
 	/* This is a pretty awful kludge, but the alternative would be
 	   a major redesign of everything... -pd */
 	while (n-- > 0)
 	    i = R_sysparent(nframe - i + 1, cptr);
 	INTEGER(rval)[0] = i;
 	return rval;
     case 2: /* call */
+	if(n == NA_INTEGER)
+	    errorcall(call, _("invalid value for 'which'"));
 	return R_syscall(n, cptr);
     case 3: /* frame */
+	if(n == NA_INTEGER)
+	    errorcall(call, _("invalid value for 'which'"));
 	return R_sysframe(n, cptr);
     case 4: /* sys.nframe */
-	rval=allocVector(INTSXP,1);
+	rval = allocVector(INTSXP, 1);
-	INTEGER(rval)[0]=framedepth(cptr);
+	INTEGER(rval)[0] = framedepth(cptr);
 	return rval;
     case 5: /* sys.calls */
-	nframe=framedepth(cptr);
+	nframe = framedepth(cptr);
-	PROTECT(rval=allocList(nframe));
+	PROTECT(rval = allocList(nframe));
 	t=rval;
-	for(i=1 ; i<=nframe; i++, t=CDR(t))
+	for(i = 1; i <= nframe; i++, t = CDR(t))
-	    SETCAR(t, R_syscall(i,cptr));
+	    SETCAR(t, R_syscall(i, cptr));
 	UNPROTECT(1);
 	return rval;
     case 6: /* sys.frames */
-	nframe=framedepth(cptr);
+	nframe = framedepth(cptr);
-	PROTECT(rval=allocList(nframe));
+	PROTECT(rval = allocList(nframe));
-	t=rval;
+	t = rval;
-	for(i=1 ; i<=nframe ; i++, t=CDR(t))
+	for(i = 1; i <= nframe; i++, t = CDR(t))
-	    SETCAR(t, R_sysframe(i,cptr));
+	    SETCAR(t, R_sysframe(i, cptr));
 	UNPROTECT(1);
 	return rval;
     case 7: /* sys.on.exit */
-	if( R_GlobalContext->nextcontext != NULL )
+	if( R_GlobalContext->nextcontext != NULL)
 	    return R_GlobalContext->nextcontext->conexit;
 	else
 	    return R_NilValue;
     case 8: /* sys.parents */
-	nframe=framedepth(cptr);
+	nframe = framedepth(cptr);
-	rval=allocVector(INTSXP,nframe);
+	rval = allocVector(INTSXP, nframe);
-	for(i=0; i<nframe ; i++ )
+	for(i = 0; i < nframe; i++)
-	    INTEGER(rval)[i]= R_sysparent(nframe-i,cptr);
+	    INTEGER(rval)[i] = R_sysparent(nframe - i, cptr);
 	return rval;
     case 9: /* sys.function */
+	if(n == NA_INTEGER)
+	    errorcall(call, _("invalid value for 'which'"));
 	return(R_sysfunction(n, cptr));
     default:
-	error(_("internal error in do_sys"));
+	error(_("internal error in 'do_sys'"));
 	return R_NilValue;/* just for -Wall */
+    }
+}
 SEXP do_parentframe(SEXP call, SEXP op, SEXP args, SEXP rho)
     t = eval(CAR(args), rho);
     n = asInteger(t);
     if(n == NA_INTEGER || n < 1 )
-	errorcall(call, _("invalid number of environment levels"));
+	errorcall(call, _("invalid value for 'n'"));
     cptr = R_GlobalContext;
     t = cptr->sysparent;
     while (cptr->nextcontext != NULL){
 	if (cptr->callflag & CTXT_FUNCTION ) {

The R Project SVN R

(root)/trunk/src/main/context.c – Rev 33297 → 33531