The R Project SVN R

Rev

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

Rev 49591 Rev 50473
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 
 
107 
void R_CheckUserInterrupt(void)
 126 
void R_CheckUserInterrupt(void)
108 
{
 127 
{
109 
    R_CheckStack();
 128 
    R_CheckStack();
110 
 
 129 
 
111 
    /* Don't do any processing of interrupts, timing limits, or other
 130 
    /* Don't do any processing of interrupts, timing limits, or other
Line 886... Line 905...
886 
		break;
 905 
		break;
887 
	    }
 906 
	    }
888 
	    rho = CDR(rho);
 907 
	    rho = CDR(rho);
889 
	}
 908 
	}
890 
	if(strlen(domain)) {
 909 
	if(strlen(domain)) {
- 
 
 910 
	    R_CheckStackN(strlen(domain)+3);
891 
	    buf = (char *) alloca(strlen(domain)+3);
 911 
	    buf = (char *) alloca(strlen(domain)+3);
892 
	    R_CheckStack();
 - 
 
893 
	    sprintf(buf, "R-%s", domain);
 912 
	    sprintf(buf, "R-%s", domain);
894 
	    domain = buf;
 913 
	    domain = buf;
895 
	}
 914 
	}
896 
    } else if(isString(CAR(args)))
 915 
    } else if(isString(CAR(args)))
897 
	domain = translateChar(STRING_ELT(CAR(args),0));
 916 
	domain = translateChar(STRING_ELT(CAR(args),0));
Line 901... Line 920...
901 
	PROTECT(ans = allocVector(STRSXP, n));
 920 
	PROTECT(ans = allocVector(STRSXP, n));
902 
	for(i = 0; i < n; i++) {
 921 
	for(i = 0; i < n; i++) {
903 
	    int ihead = 0, itail = 0;
 922 
	    int ihead = 0, itail = 0;
904 
	    const char * This = translateChar(STRING_ELT(string, i));
 923 
	    const char * This = translateChar(STRING_ELT(string, i));
905 
	    char *tmp, *head = NULL, *tail = NULL, *p, *tr;
 924 
	    char *tmp, *head = NULL, *tail = NULL, *p, *tr;
- 
 
 925 
	    R_CheckStackN(strlen(This) + 1);
906 
	    tmp = (char *) alloca(strlen(This) + 1);
 926 
	    tmp = (char *) alloca(strlen(This) + 1);
907 
	    R_CheckStack();
 - 
 
908 
	    strcpy(tmp, This);
 927 
	    strcpy(tmp, This);
909 
	    /* strip leading and trailing white spaces and
 928 
	    /* strip leading and trailing white spaces and
910 
	       add back after translation */
 929 
	       add back after translation */
911 
	    for(p = tmp;
 930 
	    for(p = tmp;
912 
		*p && (*p == ' ' || *p == '\t' || *p == '\n');
 931 
		*p && (*p == ' ' || *p == '\t' || *p == '\n');
913 
		p++, ihead++) ;
 932 
		p++, ihead++) ;
914 
	    if(ihead > 0) {
 933 
	    if(ihead > 0) {
- 
 
 934 
		R_CheckStackN(ihead + 1);
915 
		head = (char *) alloca(ihead + 1);
 935 
		head = (char *) alloca(ihead + 1);
916 
		R_CheckStack();
 - 
 
917 
		strncpy(head, tmp, ihead);
 936 
		strncpy(head, tmp, ihead);
918 
		head[ihead] = '\0';
 937 
		head[ihead] = '\0';
919 
		tmp += ihead;
 938 
		tmp += ihead;
920 
		}
 939 
		}
921 
	    if(strlen(tmp))
 940 
	    if(strlen(tmp))
922 
		for(p = tmp+strlen(tmp)-1;
 941 
		for(p = tmp+strlen(tmp)-1;
923 
		    p >= tmp && (*p == ' ' || *p == '\t' || *p == '\n');
 942 
		    p >= tmp && (*p == ' ' || *p == '\t' || *p == '\n');
924 
		    p--, itail++) ;
 943 
		    p--, itail++) ;
925 
	    if(itail > 0) {
 944 
	    if(itail > 0) {
- 
 
 945 
		R_CheckStackN(itail + 1);
926 
		tail = (char *) alloca(itail + 1);
 946 
		tail = (char *) alloca(itail + 1);
927 
		R_CheckStack();
 - 
 
928 
		strcpy(tail, tmp+strlen(tmp)-itail);
 947 
		strcpy(tail, tmp+strlen(tmp)-itail);
929 
		tmp[strlen(tmp)-itail] = '\0';
 948 
		tmp[strlen(tmp)-itail] = '\0';
930 
		}
 949 
		}
931 
	    if(strlen(tmp)) {
 950 
	    if(strlen(tmp)) {
932 
#ifdef DEBUG_GETTEXT
 951 
#ifdef DEBUG_GETTEXT
933 
		REprintf("translating '%s' in domain '%s'\n", tmp, domain);
 952 
		REprintf("translating '%s' in domain '%s'\n", tmp, domain);
934 
#endif
 953 
#endif
935 
		tr = dgettext(domain, tmp);
 954 
		tr = dgettext(domain, tmp);
- 
 
 955 
		R_CheckStackN(strlen(tr) + ihead + itail + 1);
936 
		tmp = (char *) alloca(strlen(tr) + ihead + itail + 1);
 956 
		tmp = (char *) alloca(strlen(tr) + ihead + itail + 1);
937 
		R_CheckStack();
 - 
 
938 
		tmp[0] ='\0';
 957 
		tmp[0] ='\0';
939 
		if(ihead > 0) strcat(tmp, head);
 958 
		if(ihead > 0) strcat(tmp, head);
940 
		strcat(tmp, tr);
 959 
		strcat(tmp, tr);
941 
		if(itail > 0) strcat(tmp, tail);
 960 
		if(itail > 0) strcat(tmp, tail);
942 
		SET_STRING_ELT(ans, i, mkChar(tmp));
 961 
		SET_STRING_ELT(ans, i, mkChar(tmp));
Line 987... Line 1006...
987 
		break;
 1006 
		break;
988 
	    }
 1007 
	    }
989 
	    rho = CDR(rho);
 1008 
	    rho = CDR(rho);
990 
	}
 1009 
	}
991 
	if(strlen(domain)) {
 1010 
	if(strlen(domain)) {
- 
 
 1011 
	    R_CheckStackN(strlen(domain)+3);
992 
	    buf = (char *) alloca(strlen(domain)+3);
 1012 
	    buf = (char *) alloca(strlen(domain)+3);
993 
	    R_CheckStack();
 - 
 
994 
	    sprintf(buf, "R-%s", domain);
 1013 
	    sprintf(buf, "R-%s", domain);
995 
	    domain = buf;
 1014 
	    domain = buf;
996 
	}
 1015 
	}
997 
    } else if(isString(sdom))
 1016 
    } else if(isString(sdom))
998 
	domain = CHAR(STRING_ELT(sdom,0));
 1017 
	domain = CHAR(STRING_ELT(sdom,0));