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



    }
    FINISH_Math2;
    return sy;
} /* math2_2() */
 
/* This is only used directly by .Internal for Bessel functions,
   so managing R_alloc stack is only prudence */
static SEXP math2B(SEXP sa, SEXP sb, double (*f)(double, double, double *),
		   SEXP lcall)
{
    SEXP sy;
    R_xlen_t i, ia, ib, n, na, nb;

    amax = 0.0;
    for (i = 0; i < nb; i++) {
	double av = b[i] < 0 ? -b[i] : b[i];
	if (av > amax) amax = av;
    }
    const void *vmax = vmaxget();
    nw = 1 + (long)floor(amax);
    work = (double *) R_alloc((size_t) nw, sizeof(double));
 
    mod_iterate(na, nb, ia, ib) {
//	if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();

	    y[i] = f(ai, bi, work);
	    if (ISNAN(y[i])) naflag = 1;
	}
    }
 
 
    vmaxset(vmax);
    FINISH_Math2;
 
    return sy;
} /* math2B() */
 

 
    FINISH_Math3;
    return sy;
} /* math3_2 */
 
/* This is only used directly by .Internal for Bessel functions,
   so managing R_alloc stack is only prudence */
static SEXP math3B(SEXP sa, SEXP sb, SEXP sc,
		   double (*f)(double, double, double, double *), SEXP lcall)
{
    SEXP sy;
    R_xlen_t i, ia, ib, ic, n, na, nb, nc;

    amax = 0.0;
    for (i = 0; i < nb; i++) {
	double av = b[i] < 0 ? -b[i] : b[i];
	if (av > amax) amax = av;
    }
    const void *vmax = vmaxget();
    nw = 1 + (long)floor(amax);
    work = (double *) R_alloc((size_t) nw, sizeof(double));
 
    mod_iterate3 (na, nb, nc, ia, ib, ic) {
//	if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();

	    if (ISNAN(y[i])) naflag = 1;
	}
    }
 
    FINISH_Math3;
    vmaxset(vmax);
 
    return sy;
} /* math3B */
 
#define Math3_1(A, FUN)	math3_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN, call);

Rev 63102	Rev 63171
Line 1287...	Line 1287...
1287	`}`	1287	`}`
1288	`FINISH_Math2;`	1288	`FINISH_Math2;`
1289	`return sy;`	1289	`return sy;`
1290	`} /* math2_2() */`	1290	`} /* math2_2() */`
1291		1291
-		1292	`/* This is only used directly by .Internal for Bessel functions,`
-		1293	`so managing R_alloc stack is only prudence */`
1292	`static SEXP math2B(SEXP sa, SEXP sb, double (f)(double, double, double ),`	1294	`static SEXP math2B(SEXP sa, SEXP sb, double (f)(double, double, double ),`
1293	`SEXP lcall)`	1295	`SEXP lcall)`
1294	`{`	1296	`{`
1295	`SEXP sy;`	1297	`SEXP sy;`
1296	`R_xlen_t i, ia, ib, n, na, nb;`	1298	`R_xlen_t i, ia, ib, n, na, nb;`
Line 1311...	Line 1313...
1311	`amax = 0.0;`	1313	`amax = 0.0;`
1312	`for (i = 0; i < nb; i++) {`	1314	`for (i = 0; i < nb; i++) {`
1313	`double av = b[i] < 0 ? -b[i] : b[i];`	1315	`double av = b[i] < 0 ? -b[i] : b[i];`
1314	`if (av > amax) amax = av;`	1316	`if (av > amax) amax = av;`
1315	`}`	1317	`}`
-		1318	`const void *vmax = vmaxget();`
1316	`nw = 1 + (long)floor(amax);`	1319	`nw = 1 + (long)floor(amax);`
1317	`work = (double *) R_alloc((size_t) nw, sizeof(double));`	1320	`work = (double *) R_alloc((size_t) nw, sizeof(double));`
1318		1321
1319	`mod_iterate(na, nb, ia, ib) {`	1322	`mod_iterate(na, nb, ia, ib) {`
1320	`// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();`	1323	`// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();`
Line 1325...	Line 1328...
1325	`y[i] = f(ai, bi, work);`	1328	`y[i] = f(ai, bi, work);`
1326	`if (ISNAN(y[i])) naflag = 1;`	1329	`if (ISNAN(y[i])) naflag = 1;`
1327	`}`	1330	`}`
1328	`}`	1331	`}`
1329		1332
1330		-
-		1333	`vmaxset(vmax);`
1331	`FINISH_Math2;`	1334	`FINISH_Math2;`
1332		1335
1333	`return sy;`	1336	`return sy;`
1334	`} /* math2B() */`	1337	`} /* math2B() */`
1335		1338
Line 1626...	Line 1629...
1626		1629
1627	`FINISH_Math3;`	1630	`FINISH_Math3;`
1628	`return sy;`	1631	`return sy;`
1629	`} /* math3_2 */`	1632	`} /* math3_2 */`
1630		1633
-		1634	`/* This is only used directly by .Internal for Bessel functions,`
-		1635	`so managing R_alloc stack is only prudence */`
1631	`static SEXP math3B(SEXP sa, SEXP sb, SEXP sc,`	1636	`static SEXP math3B(SEXP sa, SEXP sb, SEXP sc,`
1632	`double (f)(double, double, double, double ), SEXP lcall)`	1637	`double (f)(double, double, double, double ), SEXP lcall)`
1633	`{`	1638	`{`
1634	`SEXP sy;`	1639	`SEXP sy;`
1635	`R_xlen_t i, ia, ib, ic, n, na, nb, nc;`	1640	`R_xlen_t i, ia, ib, ic, n, na, nb, nc;`
Line 1645...	Line 1650...
1645	`amax = 0.0;`	1650	`amax = 0.0;`
1646	`for (i = 0; i < nb; i++) {`	1651	`for (i = 0; i < nb; i++) {`
1647	`double av = b[i] < 0 ? -b[i] : b[i];`	1652	`double av = b[i] < 0 ? -b[i] : b[i];`
1648	`if (av > amax) amax = av;`	1653	`if (av > amax) amax = av;`
1649	`}`	1654	`}`
-		1655	`const void *vmax = vmaxget();`
1650	`nw = 1 + (long)floor(amax);`	1656	`nw = 1 + (long)floor(amax);`
1651	`work = (double *) R_alloc((size_t) nw, sizeof(double));`	1657	`work = (double *) R_alloc((size_t) nw, sizeof(double));`
1652		1658
1653	`mod_iterate3 (na, nb, nc, ia, ib, ic) {`	1659	`mod_iterate3 (na, nb, nc, ia, ib, ic) {`
1654	`// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();`	1660	`// if ((i+1) % NINTERRUPT == 0) R_CheckUserInterrupt();`
Line 1661...	Line 1667...
1661	`if (ISNAN(y[i])) naflag = 1;`	1667	`if (ISNAN(y[i])) naflag = 1;`
1662	`}`	1668	`}`
1663	`}`	1669	`}`
1664		1670
1665	`FINISH_Math3;`	1671	`FINISH_Math3;`
-		1672	`vmaxset(vmax);`
1666		1673
1667	`return sy;`	1674	`return sy;`
1668	`} /* math3B */`	1675	`} /* math3B */`
1669		1676
1670	`#define Math3_1(A, FUN) math3_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN, call);`	1677	`#define Math3_1(A, FUN) math3_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN, call);`

The R Project SVN R

(root)/trunk/src/main/arithmetic.c – Rev 63102 → 63171