Skip to content

Commit a64a64b

Browse files
author
ripley
committed
hide rwarnc_ and rexitc_
git-svn-id: https://svn.r-project.org/R/trunk@87334 00db46b3-68df-0310-9c12-caf00c1e9a41
1 parent b8dd04d commit a64a64b

File tree

3 files changed

+495
-467
lines changed

3 files changed

+495
-467
lines changed

‎doc/manual/R-exts.c‎

Lines changed: 59 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
/*
22
C code of the .Call/.External examples in `Writing R extensions'
33
Compile with R CMD SHLIB R-exts.c
4-
The use the R code in R-exts.R
4+
Then use the R code in R-exts.R
55
*/
66

77

@@ -13,8 +13,8 @@
1313
/* second version */
1414
SEXP out(SEXP x, SEXP y)
1515
{
16-
int nx = length(x), ny = length(y);
17-
SEXP ans = PROTECT(allocMatrix(REALSXP, nx, ny));
16+
int nx = Rf_length(x), ny = Rf_length(y);
17+
SEXP ans = PROTECT(Rf_allocMatrix(REALSXP, nx, ny));
1818
double *rx = REAL(x), *ry = REAL(y), *rans = REAL(ans);
1919

2020
for(int i = 0; i < nx; i++) {
@@ -23,10 +23,10 @@ SEXP out(SEXP x, SEXP y)
2323
rans[i + nx*j] = tmp * ry[j];
2424
}
2525

26-
SEXP dimnames = PROTECT(allocVector(VECSXP, 2));
27-
SET_VECTOR_ELT(dimnames, 0, getAttrib(x, R_NamesSymbol));
28-
SET_VECTOR_ELT(dimnames, 1, getAttrib(y, R_NamesSymbol));
29-
setAttrib(ans, R_DimNamesSymbol, dimnames);
26+
SEXP dimnames = PROTECT(Rf_allocVector(VECSXP, 2));
27+
SET_VECTOR_ELT(dimnames, 0, Rf_getAttrib(x, R_NamesSymbol));
28+
SET_VECTOR_ELT(dimnames, 1, Rf_getAttrib(y, R_NamesSymbol));
29+
Rf_setAttrib(ans, R_DimNamesSymbol, dimnames);
3030
UNPROTECT(2);
3131
return ans;
3232
}
@@ -35,9 +35,9 @@ SEXP out(SEXP x, SEXP y)
3535

3636
SEXP getListElement(SEXP list, const char *str)
3737
{
38-
SEXP elmt = R_NilValue, names = getAttrib(list, R_NamesSymbol);
38+
SEXP elmt = R_NilValue, names = Rf_getAttrib(list, R_NamesSymbol);
3939

40-
for (int i = 0; i < length(list); i++)
40+
for (int i = 0; i < Rf_length(list); i++)
4141
if(strcmp(CHAR(STRING_ELT(names, i)), str) == 0) {
4242
elmt = VECTOR_ELT(list, i);
4343
break;
@@ -49,11 +49,11 @@ SEXP getvar(SEXP name, SEXP rho)
4949
{
5050
SEXP ans;
5151

52-
if(!isString(name) || length(name) != 1)
53-
error("name is not a single string");
54-
if(!isEnvironment(rho))
55-
error("rho should be an environment");
56-
ans = findVar(installChar(STRING_ELT(name, 0)), rho);
52+
if(!Rf_isString(name) || Rf_length(name) != 1)
53+
Rf_error("name is not a single string");
54+
if(!Rf_isEnvironment(rho))
55+
Rf_error("rho should be an environment");
56+
ans = Rf_findVar(Rf_installChar(STRING_ELT(name, 0)), rho);
5757
Rprintf("first value is %f\n", REAL(ans)[0]);
5858
return R_NilValue;
5959
}
@@ -67,10 +67,10 @@ SEXP convolve2(SEXP a, SEXP b)
6767
double *xa, *xb, *xab;
6868
SEXP ab;
6969

70-
a = PROTECT(coerceVector(a, REALSXP));
71-
b = PROTECT(coerceVector(b, REALSXP));
72-
na = length(a); nb = length(b); nab = na + nb - 1;
73-
ab = PROTECT(allocVector(REALSXP, nab));
70+
a = PROTECT(Rf_coerceVector(a, REALSXP));
71+
b = PROTECT(Rf_coerceVector(b, REALSXP));
72+
na = Rf_length(a); nb = Rf_length(b); nab = na + nb - 1;
73+
ab = PROTECT(Rf_allocVector(REALSXP, nab));
7474
xa = REAL(a); xb = REAL(b); xab = REAL(ab);
7575
for(int i = 0; i < nab; i++) xab[i] = 0.0;
7676
for(int i = 0; i < na; i++)
@@ -87,10 +87,10 @@ SEXP convolveE(SEXP args)
8787
double *xa, *xb, *xab;
8888
SEXP a, b, ab;
8989

90-
a = PROTECT(coerceVector(CADR(args), REALSXP));
91-
b = PROTECT(coerceVector(CADDR(args), REALSXP));
92-
na = length(a); nb = length(b); nab = na + nb - 1;
93-
ab = PROTECT(allocVector(REALSXP, nab));
90+
a = PROTECT(Rf_coerceVector(CADR(args), REALSXP));
91+
b = PROTECT(Rf_coerceVector(CADDR(args), REALSXP));
92+
na = Rf_length(a); nb = Rf_length(b); nab = na + nb - 1;
93+
ab = PROTECT(Rf_allocVector(REALSXP, nab));
9494
xa = REAL(a); xb = REAL(b); xab = REAL(ab);
9595
for(int i = 0; i < nab; i++) xab[i] = 0.0;
9696
for(int i = 0; i < na; i++)
@@ -106,9 +106,9 @@ SEXP showArgs(SEXP args)
106106
args = CDR(args); /* skip 'name' */
107107
for(int i = 0; args != R_NilValue; i++, args = CDR(args)) {
108108
const char *name =
109-
isNull(TAG(args)) ? "" : CHAR(PRINTNAME(TAG(args)));
109+
Rf_isNull(TAG(args)) ? "" : CHAR(PRINTNAME(TAG(args)));
110110
SEXP el = CAR(args);
111-
if (length(el) == 0) {
111+
if (Rf_length(el) == 0) {
112112
Rprintf("[%d] '%s' R type, length 0\n", i+1, name);
113113
continue;
114114
}
@@ -141,12 +141,12 @@ SEXP showArgs1(SEXP largs)
141141
{
142142
int i, nargs = LENGTH(largs);
143143
Rcomplex cpl;
144-
SEXP el, names = getAttrib(largs, R_NamesSymbol);
144+
SEXP el, names = Rf_getAttrib(largs, R_NamesSymbol);
145145
const char *name;
146146

147147
for(i = 0; i < nargs; i++) {
148148
el = VECTOR_ELT(largs, i);
149-
name = isNull(names) ? "" : CHAR(STRING_ELT(names, i));
149+
name = Rf_isNull(names) ? "" : CHAR(STRING_ELT(names, i));
150150
switch(TYPEOF(el)) {
151151
case REALSXP:
152152
Rprintf("[%d] '%s' %f\n", i+1, name, REAL(el)[0]);
@@ -174,36 +174,36 @@ SEXP showArgs1(SEXP largs)
174174

175175
SEXP lapply(SEXP list, SEXP expr, SEXP rho)
176176
{
177-
int n = length(list);
177+
int n = Rf_length(list);
178178
SEXP ans;
179179

180-
if(!isNewList(list)) error("'list' must be a list");
181-
if(!isEnvironment(rho)) error("'rho' should be an environment");
182-
ans = PROTECT(allocVector(VECSXP, n));
180+
if(!Rf_isNewList(list)) Rf_error("'list' must be a list");
181+
if(!Rf_isEnvironment(rho)) Rf_error("'rho' should be an environment");
182+
ans = PROTECT(Rf_allocVector(VECSXP, n));
183183
for(int i = 0; i < n; i++) {
184-
defineVar(install("x"), VECTOR_ELT(list, i), rho);
185-
SET_VECTOR_ELT(ans, i, eval(expr, rho));
184+
Rf_defineVar(Rf_install("x"), VECTOR_ELT(list, i), rho);
185+
SET_VECTOR_ELT(ans, i, Rf_eval(expr, rho));
186186
}
187-
setAttrib(ans, R_NamesSymbol, getAttrib(list, R_NamesSymbol));
187+
Rf_setAttrib(ans, R_NamesSymbol, Rf_getAttrib(list, R_NamesSymbol));
188188
UNPROTECT(1);
189189
return ans;
190190
}
191191

192192
SEXP lapply2(SEXP list, SEXP fn, SEXP rho)
193193
{
194-
int n = length(list);
194+
int n = Rf_length(list);
195195
SEXP R_fcall, ans;
196196

197-
if(!isNewList(list)) error("'list' must be a list");
198-
if(!isFunction(fn)) error("'fn' must be a function");
199-
if(!isEnvironment(rho)) error("'rho' should be an environment");
200-
R_fcall = PROTECT(lang2(fn, R_NilValue));
201-
ans = PROTECT(allocVector(VECSXP, n));
197+
if(!Rf_isNewList(list)) Rf_error("'list' must be a list");
198+
if(!Rf_isFunction(fn)) Rf_error("'fn' must be a function");
199+
if(!Rf_isEnvironment(rho)) Rf_error("'rho' should be an environment");
200+
R_fcall = PROTECT(Rf_lang2(fn, R_NilValue));
201+
ans = PROTECT(Rf_allocVector(VECSXP, n));
202202
for(int i = 0; i < n; i++) {
203203
SETCADR(R_fcall, VECTOR_ELT(list, i));
204-
SET_VECTOR_ELT(ans, i, eval(R_fcall, rho));
204+
SET_VECTOR_ELT(ans, i, Rf_eval(R_fcall, rho));
205205
}
206-
setAttrib(ans, R_NamesSymbol, getAttrib(list, R_NamesSymbol));
206+
Rf_setAttrib(ans, R_NamesSymbol, Rf_getAttrib(list, R_NamesSymbol));
207207
UNPROTECT(2);
208208
return ans;
209209
}
@@ -213,16 +213,16 @@ SEXP lapply2(SEXP list, SEXP fn, SEXP rho)
213213
SEXP mkans(double x)
214214
{
215215
SEXP ans;
216-
ans = PROTECT(allocVector(REALSXP, 1));
216+
ans = PROTECT(Rf_allocVector(REALSXP, 1));
217217
REAL(ans)[0] = x;
218218
UNPROTECT(1);
219219
return ans;
220220
}
221221

222222
double feval(double x, SEXP f, SEXP rho)
223223
{
224-
defineVar(install("x"), mkans(x), rho);
225-
return REAL(eval(f, rho))[0];
224+
Rf_defineVar(Rf_install("x"), mkans(x), rho);
225+
return REAL(Rf_eval(f, rho))[0];
226226
}
227227

228228
SEXP zero(SEXP f, SEXP guesses, SEXP stol, SEXP rho)
@@ -231,16 +231,16 @@ SEXP zero(SEXP f, SEXP guesses, SEXP stol, SEXP rho)
231231
tol = REAL(stol)[0];
232232
double f0, f1, fc, xc;
233233

234-
if(tol <= 0.0) error("non-positive tol value");
234+
if(tol <= 0.0) Rf_error("non-positive tol value");
235235
f0 = feval(x0, f, rho); f1 = feval(x1, f, rho);
236236
if(f0 == 0.0) return mkans(x0);
237237
if(f1 == 0.0) return mkans(x1);
238-
if(f0*f1 > 0.0) error("x[0] and x[1] have the same sign");
238+
if(f0*f1 > 0.0) Rf_error("x[0] and x[1] have the same sign");
239239
for(;;) {
240240
xc = 0.5*(x0+x1);
241-
if(fabs(x0-x1) < tol) return mkans(xc);
241+
if(fabs(x0-x1) < tol) return mkans(xc);
242242
fc = feval(xc, f, rho);
243-
if(fc == 0) return mkans(xc);
243+
if(fc == 0) return mkans(xc);
244244
if(f0*fc > 0.0) {
245245
x0 = xc; f0 = fc;
246246
} else {
@@ -263,32 +263,32 @@ SEXP numeric_deriv(SEXP args)
263263
int i, start;
264264

265265
expr = CADR(args);
266-
if(!isString(theta = CADDR(args)))
267-
error("theta should be of type character");
268-
if(!isEnvironment(rho = CADDDR(args)))
269-
error("rho should be an environment");
266+
if(!Rf_isString(theta = CADDR(args)))
267+
Rf_error("theta should be of type character");
268+
if(!Rf_isEnvironment(rho = CADDDR(args)))
269+
Rf_error("rho should be an environment");
270270

271-
ans = PROTECT(coerceVector(eval(expr, rho), REALSXP));
272-
gradient = PROTECT(allocMatrix(REALSXP, LENGTH(ans), LENGTH(theta)));
271+
ans = PROTECT(Rf_coerceVector(Rf_eval(expr, rho), REALSXP));
272+
gradient = PROTECT(Rf_allocMatrix(REALSXP, LENGTH(ans), LENGTH(theta)));
273273
rgr = REAL(gradient); rans = REAL(ans);
274274

275275
for(i = 0, start = 0; i < LENGTH(theta); i++, start += LENGTH(ans)) {
276-
PROTECT(par = findVar(installChar(STRING_ELT(theta, i)), rho));
276+
PROTECT(par = Rf_findVar(Rf_installChar(STRING_ELT(theta, i)), rho));
277277
tt = REAL(par)[0];
278278
xx = fabs(tt);
279279
delta = (xx < 1) ? eps : xx*eps;
280280
REAL(par)[0] += delta;
281-
ans1 = PROTECT(coerceVector(eval(expr, rho), REALSXP));
281+
ans1 = PROTECT(Rf_coerceVector(Rf_eval(expr, rho), REALSXP));
282282
for(int j = 0; j < LENGTH(ans); j++)
283283
rgr[j + start] = (REAL(ans1)[j] - rans[j])/delta;
284284
REAL(par)[0] = tt;
285285
UNPROTECT(2); /* par, ans1 */
286286
}
287287

288-
dimnames = PROTECT(allocVector(VECSXP, 2));
288+
dimnames = PROTECT(Rf_allocVector(VECSXP, 2));
289289
SET_VECTOR_ELT(dimnames, 1, theta);
290-
dimnamesgets(gradient, dimnames);
291-
setAttrib(ans, install("gradient"), gradient);
290+
Rf_dimnamesgets(gradient, dimnames);
291+
Rf_setAttrib(ans, Rf_install("gradient"), gradient);
292292
UNPROTECT(3); /* ans gradient dimnames */
293293
return ans;
294294
}

0 commit comments

Comments
 (0)