The R Project SVN R

Rev

Rev 50473 | Rev 52103 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 50473 Rev 50479
Line 102... Line 102...
102 
	errorcall(R_NilValue, "C stack usage is too close to the limit");
 102 
	errorcall(R_NilValue, "C stack usage is too close to the limit");
103 
	/* Do not translate this, to save stack space */
 103 
	/* Do not translate this, to save stack space */
104 
    }
 104 
    }
105 
}
 105 
}
106 
 
 106 
 
107 
void R_CheckStackN(size_t n)
 - 
 
108 
{
 - 
 
109 
    int dummy;
 - 
 
110 
    intptr_t usage = R_CStackDir * (R_CStackStart - (uintptr_t)&dummy);
 - 
 
111 
 
 - 
 
112 
    if(R_CStackLimit != -1 && usage+n > 0.95 * R_CStackLimit) {
 - 
 
113 
	RCNTXT cntxt;
 - 
 
114 
	unsigned int stacklimit = R_CStackLimit;
 - 
 
115 
	R_CStackLimit += 0.05*R_CStackLimit;
 - 
 
116 
	begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_BaseEnv, R_BaseEnv,
 - 
 
117 
		     R_NilValue, R_NilValue);
 - 
 
118 
	cntxt.cend = &reset_stack_limit;
 - 
 
119 
	cntxt.cenddata = &stacklimit;
 - 
 
120 
 
 - 
 
121 
	errorcall(R_NilValue, "C stack usage is too close to the limit");
 - 
 
122 
	/* Do not translate this, to save stack space */
 - 
 
123 
    }
 - 
 
124 
}
 - 
 
125 
 
 - 
 
126 
void R_CheckUserInterrupt(void)
 107 
void R_CheckUserInterrupt(void)
127 
{
 108 
{
128 
    R_CheckStack();
 109 
    R_CheckStack();
129 
 
 110 
 
130 
    /* Don't do any processing of interrupts, timing limits, or other
 111 
    /* Don't do any processing of interrupts, timing limits, or other
Line 905... Line 886...
905 
		break;
 886 
		break;
906 
	    }
 887 
	    }
907 
	    rho = CDR(rho);
 888 
	    rho = CDR(rho);
908 
	}
 889 
	}
909 
	if(strlen(domain)) {
 890 
	if(strlen(domain)) {
910 
	    R_CheckStackN(strlen(domain)+3);
 - 
 
911 
	    buf = (char *) alloca(strlen(domain)+3);
 891 
	    buf = (char *) alloca(strlen(domain)+3);
- 
 
 892 
	    R_CheckStack();
912 
	    sprintf(buf, "R-%s", domain);
 893 
	    sprintf(buf, "R-%s", domain);
913 
	    domain = buf;
 894 
	    domain = buf;
914 
	}
 895 
	}
915 
    } else if(isString(CAR(args)))
 896 
    } else if(isString(CAR(args)))
916 
	domain = translateChar(STRING_ELT(CAR(args),0));
 897 
	domain = translateChar(STRING_ELT(CAR(args),0));
Line 920... Line 901...
920 
	PROTECT(ans = allocVector(STRSXP, n));
 901 
	PROTECT(ans = allocVector(STRSXP, n));
921 
	for(i = 0; i < n; i++) {
 902 
	for(i = 0; i < n; i++) {
922 
	    int ihead = 0, itail = 0;
 903 
	    int ihead = 0, itail = 0;
923 
	    const char * This = translateChar(STRING_ELT(string, i));
 904 
	    const char * This = translateChar(STRING_ELT(string, i));
924 
	    char *tmp, *head = NULL, *tail = NULL, *p, *tr;
 905 
	    char *tmp, *head = NULL, *tail = NULL, *p, *tr;
925 
	    R_CheckStackN(strlen(This) + 1);
 - 
 
926 
	    tmp = (char *) alloca(strlen(This) + 1);
 906 
	    tmp = (char *) alloca(strlen(This) + 1);
- 
 
 907 
	    R_CheckStack();
927 
	    strcpy(tmp, This);
 908 
	    strcpy(tmp, This);
928 
	    /* strip leading and trailing white spaces and
 909 
	    /* strip leading and trailing white spaces and
929 
	       add back after translation */
 910 
	       add back after translation */
930 
	    for(p = tmp;
 911 
	    for(p = tmp;
931 
		*p && (*p == ' ' || *p == '\t' || *p == '\n');
 912 
		*p && (*p == ' ' || *p == '\t' || *p == '\n');
932 
		p++, ihead++) ;
 913 
		p++, ihead++) ;
933 
	    if(ihead > 0) {
 914 
	    if(ihead > 0) {
934 
		R_CheckStackN(ihead + 1);
 - 
 
935 
		head = (char *) alloca(ihead + 1);
 915 
		head = (char *) alloca(ihead + 1);
- 
 
 916 
		R_CheckStack();
936 
		strncpy(head, tmp, ihead);
 917 
		strncpy(head, tmp, ihead);
937 
		head[ihead] = '\0';
 918 
		head[ihead] = '\0';
938 
		tmp += ihead;
 919 
		tmp += ihead;
939 
		}
 920 
		}
940 
	    if(strlen(tmp))
 921 
	    if(strlen(tmp))
941 
		for(p = tmp+strlen(tmp)-1;
 922 
		for(p = tmp+strlen(tmp)-1;
942 
		    p >= tmp && (*p == ' ' || *p == '\t' || *p == '\n');
 923 
		    p >= tmp && (*p == ' ' || *p == '\t' || *p == '\n');
943 
		    p--, itail++) ;
 924 
		    p--, itail++) ;
944 
	    if(itail > 0) {
 925 
	    if(itail > 0) {
945 
		R_CheckStackN(itail + 1);
 - 
 
946 
		tail = (char *) alloca(itail + 1);
 926 
		tail = (char *) alloca(itail + 1);
- 
 
 927 
		R_CheckStack();
947 
		strcpy(tail, tmp+strlen(tmp)-itail);
 928 
		strcpy(tail, tmp+strlen(tmp)-itail);
948 
		tmp[strlen(tmp)-itail] = '\0';
 929 
		tmp[strlen(tmp)-itail] = '\0';
949 
		}
 930 
		}
950 
	    if(strlen(tmp)) {
 931 
	    if(strlen(tmp)) {
951 
#ifdef DEBUG_GETTEXT
 932 
#ifdef DEBUG_GETTEXT
952 
		REprintf("translating '%s' in domain '%s'\n", tmp, domain);
 933 
		REprintf("translating '%s' in domain '%s'\n", tmp, domain);
953 
#endif
 934 
#endif
954 
		tr = dgettext(domain, tmp);
 935 
		tr = dgettext(domain, tmp);
955 
		R_CheckStackN(strlen(tr) + ihead + itail + 1);
 - 
 
956 
		tmp = (char *) alloca(strlen(tr) + ihead + itail + 1);
 936 
		tmp = (char *) alloca(strlen(tr) + ihead + itail + 1);
- 
 
 937 
		R_CheckStack();
957 
		tmp[0] ='\0';
 938 
		tmp[0] ='\0';
958 
		if(ihead > 0) strcat(tmp, head);
 939 
		if(ihead > 0) strcat(tmp, head);
959 
		strcat(tmp, tr);
 940 
		strcat(tmp, tr);
960 
		if(itail > 0) strcat(tmp, tail);
 941 
		if(itail > 0) strcat(tmp, tail);
961 
		SET_STRING_ELT(ans, i, mkChar(tmp));
 942 
		SET_STRING_ELT(ans, i, mkChar(tmp));
Line 1006... Line 987...
1006 
		break;
 987 
		break;
1007 
	    }
 988 
	    }
1008 
	    rho = CDR(rho);
 989 
	    rho = CDR(rho);
1009 
	}
 990 
	}
1010 
	if(strlen(domain)) {
 991 
	if(strlen(domain)) {
1011 
	    R_CheckStackN(strlen(domain)+3);
 - 
 
1012 
	    buf = (char *) alloca(strlen(domain)+3);
 992 
	    buf = (char *) alloca(strlen(domain)+3);
- 
 
 993 
	    R_CheckStack();
1013 
	    sprintf(buf, "R-%s", domain);
 994 
	    sprintf(buf, "R-%s", domain);
1014 
	    domain = buf;
 995 
	    domain = buf;
1015 
	}
 996 
	}
1016 
    } else if(isString(sdom))
 997 
    } else if(isString(sdom))
1017 
	domain = CHAR(STRING_ELT(sdom,0));
 998 
	domain = CHAR(STRING_ELT(sdom,0));