The R Project SVN R

Rev

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

Rev 51781 Rev 51790
Line 635... Line 635...
635 
	for (i = 0; i < n; i++)
 635 
	for (i = 0; i < n; i++)
636 
	    INTEGER(ans)[i] = NA_INTEGER;
 636 
	    INTEGER(ans)[i] = NA_INTEGER;
637 
	return ans;
 637 
	return ans;
638 
	} */
 638 
	} */
639 
#ifdef R_MEMORY_PROFILING
 639 
#ifdef R_MEMORY_PROFILING
640 
    if (RTRACE(s1) || RTRACE(s2)){
 640 
    if (RTRACE(s1) || RTRACE(s2)) {
641 
       if (RTRACE(s1) && RTRACE(s2)){
 641 
       if (RTRACE(s1) && RTRACE(s2)) {
642 
	  if (n1>n2)
 642 
	  if (n1 > n2)
643 
	      memtrace_report(s1,ans);
 643 
	      memtrace_report(s1, ans);
644 
	  else
 644 
	  else
645 
	      memtrace_report(s2, ans);
 645 
	      memtrace_report(s2, ans);
646 
       } else if (RTRACE(s1))
 646 
       } else if (RTRACE(s1))
647 
	   memtrace_report(s1,ans);
 647 
	   memtrace_report(s1, ans);
648 
       else /* only s2 */
 648 
       else /* only s2 */
649 
	   memtrace_report(s2, ans);
 649 
	   memtrace_report(s2, ans);
650 
       SET_RTRACE(ans, 1);
 650 
       SET_RTRACE(ans, 1);
651 
    }
 651 
    }
652 
#endif
 652 
#endif
Line 791... Line 791...
791 
    if (n1 == 0 || n2 == 0) return(allocVector(REALSXP, 0));
 791 
    if (n1 == 0 || n2 == 0) return(allocVector(REALSXP, 0));
792 
 
 792 
 
793 
    n = (n1 > n2) ? n1 : n2;
 793 
    n = (n1 > n2) ? n1 : n2;
794 
    PROTECT(ans = allocVector(REALSXP, n));
 794 
    PROTECT(ans = allocVector(REALSXP, n));
795 
#ifdef R_MEMORY_PROFILING
 795 
#ifdef R_MEMORY_PROFILING
796 
    if (RTRACE(s1) || RTRACE(s2)){
 796 
    if (RTRACE(s1) || RTRACE(s2)) {
797 
       if (RTRACE(s1) && RTRACE(s2)){
 797 
       if (RTRACE(s1) && RTRACE(s2)) {
798 
	  if (n1>n2)
 798 
	  if (n1 > n2)
799 
	      memtrace_report(s1,ans);
 799 
	      memtrace_report(s1, ans);
800 
	  else
 800 
	  else
801 
	      memtrace_report(s2, ans);
 801 
	      memtrace_report(s2, ans);
802 
       } else if (RTRACE(s1))
 802 
       } else if (RTRACE(s1))
803 
	   memtrace_report(s1,ans);
 803 
	   memtrace_report(s1,ans);
804 
       else /* only s2 */
 804 
       else /* only s2 */
Line 1115... Line 1115...
1115 
#define SETUP_Math2				\
 1115 
#define SETUP_Math2				\
1116 
    na = LENGTH(sa);				\
 1116 
    na = LENGTH(sa);				\
1117 
    nb = LENGTH(sb);				\
 1117 
    nb = LENGTH(sb);				\
1118 
    if ((na == 0) || (nb == 0))	{		\
 1118 
    if ((na == 0) || (nb == 0))	{		\
1119 
	PROTECT(sy = allocVector(REALSXP, 0));	\
 1119 
	PROTECT(sy = allocVector(REALSXP, 0));	\
1120 
	if (na == 0) {				\
 - 
 
1121 
	    DUPLICATE_ATTRIB(sy, sa);\
 1120 
	if (na == 0) DUPLICATE_ATTRIB(sy, sa);	\
1122 
	}					\
 - 
 
1123 
	UNPROTECT(1);				\
 1121 
	UNPROTECT(1);				\
1124 
	return(sy);				\
 1122 
	return(sy);				\
1125 
    }						\
 1123 
    }						\
1126 
    n = (na < nb) ? nb : na;			\
 1124 
    n = (na < nb) ? nb : na;			\
1127 
    PROTECT(sa = coerceVector(sa, REALSXP));	\
 1125 
    PROTECT(sa = coerceVector(sa, REALSXP));	\
Line 1133... Line 1131...
1133 
    naflag = 0
 1131 
    naflag = 0
1134 
 
 1132 
 
1135 
    SETUP_Math2;
 1133 
    SETUP_Math2;
1136 
 
 1134 
 
1137 
#ifdef R_MEMORY_PROFILING
 1135 
#ifdef R_MEMORY_PROFILING
1138 
    if (RTRACE(sa) || RTRACE(sb)){
 1136 
    if (RTRACE(sa) || RTRACE(sb)) {
1139 
       if (RTRACE(sa) && RTRACE(sb)){
 1137 
       if (RTRACE(sa) && RTRACE(sb)){
1140 
	  if (na>nb)
 1138 
	  if (na > nb)
1141 
	      memtrace_report(sa, sy);
 1139 
	      memtrace_report(sa, sy);
1142 
	  else
 1140 
	  else
1143 
	      memtrace_report(sb, sy);
 1141 
	      memtrace_report(sb, sy);
1144 
       } else if (RTRACE(sa))
 1142 
       } else if (RTRACE(sa))
1145 
	   memtrace_report(sa, sy);
 1143 
	   memtrace_report(sa, sy);
Line 1160... Line 1158...
1160 
    }
 1158 
    }
1161 
 
 1159 
 
1162 
#define FINISH_Math2				\
 1160 
#define FINISH_Math2				\
1163 
    if(naflag)					\
 1161 
    if(naflag)					\
1164 
	warningcall(lcall, R_MSG_NA);		\
 1162 
	warningcall(lcall, R_MSG_NA);		\
1165 
						\
 - 
 
1166 
    if (n == na) {				\
 - 
 
1167 
	DUPLICATE_ATTRIB(sy, sa);	\
 1163 
    if (n == na)  DUPLICATE_ATTRIB(sy, sa);	\
1168 
    }						\
 - 
 
1169 
    else if (n == nb) {				\
 - 
 
1170 
	DUPLICATE_ATTRIB(sy, sb);	\
 1164 
    else if (n == nb) DUPLICATE_ATTRIB(sy, sb);	\
1171 
    }						\
 - 
 
1172 
    UNPROTECT(3)
 1165 
    UNPROTECT(3)
1173 
 
 1166 
 
1174 
    FINISH_Math2;
 1167 
    FINISH_Math2;
1175 
 
 1168 
 
1176 
    return sy;
 1169 
    return sy;
Line 1190... Line 1183...
1190 
 
 1183 
 
1191 
    SETUP_Math2;
 1184 
    SETUP_Math2;
1192 
    m_opt = asInteger(sI);
 1185 
    m_opt = asInteger(sI);
1193 
 
 1186 
 
1194 
#ifdef R_MEMORY_PROFILING
 1187 
#ifdef R_MEMORY_PROFILING
1195 
    if (RTRACE(sa) || RTRACE(sb)){
 1188 
    if (RTRACE(sa) || RTRACE(sb)) {
1196 
       if (RTRACE(sa) && RTRACE(sb)){
 1189 
       if (RTRACE(sa) && RTRACE(sb)) {
1197 
	  if (na>nb)
 1190 
	  if (na > nb)
1198 
	      memtrace_report(sa, sy);
 1191 
	      memtrace_report(sa, sy);
1199 
	  else
 1192 
	  else
1200 
	      memtrace_report(sb, sy);
 1193 
	      memtrace_report(sb, sy);
1201 
       } else if (RTRACE(sa))
 1194 
       } else if (RTRACE(sa))
1202 
	   memtrace_report(sa, sy);
 1195 
	   memtrace_report(sa, sy);
Line 1233... Line 1226...
1233 
    SETUP_Math2;
 1226 
    SETUP_Math2;
1234 
    i_1 = asInteger(sI1);
 1227 
    i_1 = asInteger(sI1);
1235 
    i_2 = asInteger(sI2);
 1228 
    i_2 = asInteger(sI2);
1236 
 
 1229 
 
1237 
#ifdef R_MEMORY_PROFILING
 1230 
#ifdef R_MEMORY_PROFILING
1238 
    if (RTRACE(sa) || RTRACE(sb)){
 1231 
    if (RTRACE(sa) || RTRACE(sb)) {
1239 
       if (RTRACE(sa) && RTRACE(sb)){
 1232 
       if (RTRACE(sa) && RTRACE(sb)) {
1240 
	  if (na>nb)
 1233 
	  if (na > nb)
1241 
	      memtrace_report(sa, sy);
 1234 
	      memtrace_report(sa, sy);
1242 
	  else
 1235 
	  else
1243 
	      memtrace_report(sb, sy);
 1236 
	      memtrace_report(sb, sy);
1244 
       } else if (RTRACE(sa))
 1237 
       } else if (RTRACE(sa))
1245 
	   memtrace_report(sa, sy);
 1238 
	   memtrace_report(sa, sy);
Line 1278... Line 1271...
1278 
    /* for 0-length a we want the attributes of a, not those of b
 1271 
    /* for 0-length a we want the attributes of a, not those of b
1279 
       as no recycling will occur */
 1272 
       as no recycling will occur */
1280 
    SETUP_Math2;
 1273 
    SETUP_Math2;
1281 
 
 1274 
 
1282 
#ifdef R_MEMORY_PROFILING
 1275 
#ifdef R_MEMORY_PROFILING
1283 
    if (RTRACE(sa) || RTRACE(sb)){
 1276 
    if (RTRACE(sa) || RTRACE(sb)) {
1284 
       if (RTRACE(sa) && RTRACE(sb)){
 1277 
       if (RTRACE(sa) && RTRACE(sb)) {
1285 
	  if (na>nb)
 1278 
	  if (na > nb)
1286 
	      memtrace_report(sa, sy);
 1279 
	      memtrace_report(sa, sy);
1287 
	  else
 1280 
	  else
1288 
	      memtrace_report(sb, sy);
 1281 
	      memtrace_report(sb, sy);
1289 
       } else if (RTRACE(sa))
 1282 
       } else if (RTRACE(sa))
1290 
	   memtrace_report(sa, sy);
 1283 
	   memtrace_report(sa, sy);
Line 1546... Line 1539...
1546 
 
 1539 
 
1547 
#define FINISH_Math3				\
 1540 
#define FINISH_Math3				\
1548 
    if(naflag)					\
 1541 
    if(naflag)					\
1549 
	warningcall(lcall, R_MSG_NA);		\
 1542 
	warningcall(lcall, R_MSG_NA);		\
1550 
						\
 1543 
						\
1551 
    if (n == na) {				\
 - 
 
1552 
	DUPLICATE_ATTRIB(sy, sa);	\
 1544 
    if (n == na) DUPLICATE_ATTRIB(sy, sa);	\
1553 
    }						\
 - 
 
1554 
    else if (n == nb) {				\
 - 
 
1555 
	DUPLICATE_ATTRIB(sy, sb);	\
 1545 
    else if (n == nb) DUPLICATE_ATTRIB(sy, sb);	\
1556 
    }						\
 - 
 
1557 
    else if (n == nc) {				\
 - 
 
1558 
	DUPLICATE_ATTRIB(sy, sc);	\
 1546 
    else if (n == nc) DUPLICATE_ATTRIB(sy, sc);	\
1559 
    }						\
 1547 
    UNPROTECT(4)
1560 
 
 1548 
 
1561 
static SEXP math3_1(SEXP sa, SEXP sb, SEXP sc, SEXP sI,
 1549 
static SEXP math3_1(SEXP sa, SEXP sb, SEXP sc, SEXP sI,
1562 
		    double (*f)(double, double, double, int), SEXP lcall)
 1550 
		    double (*f)(double, double, double, int), SEXP lcall)
1563 
{
 1551 
{
1564 
    SEXP sy;
 1552 
    SEXP sy;
Line 1569... Line 1557...
1569 
 
 1557 
 
1570 
    SETUP_Math3;
 1558 
    SETUP_Math3;
1571 
    i_1 = asInteger(sI);
 1559 
    i_1 = asInteger(sI);
1572 
 
 1560 
 
1573 
#ifdef R_MEMORY_PROFILING
 1561 
#ifdef R_MEMORY_PROFILING
1574 
    if (RTRACE(sa) || RTRACE(sb) || RTRACE(sc)){
 1562 
    if (RTRACE(sa) || RTRACE(sb) || RTRACE(sc)) {
1575 
       if (RTRACE(sa))
 1563 
       if (RTRACE(sa))
1576 
	  memtrace_report(sa,sy);
 1564 
	  memtrace_report(sa, sy);
1577 
       else if (RTRACE(sb))
 1565 
       else if (RTRACE(sb))
1578 
	  memtrace_report(sb, sy);
 1566 
	  memtrace_report(sb, sy);
1579 
       else if (RTRACE(sc))
 1567 
       else if (RTRACE(sc))
1580 
	  memtrace_report(sc,sy);
 1568 
	  memtrace_report(sc, sy);
1581 
       SET_RTRACE(sy, 1);
 1569 
       SET_RTRACE(sy, 1);
1582 
    }
 1570 
    }
1583 
#endif
 1571 
#endif
1584 
 
 1572 
 
1585 
    mod_iterate3 (na, nb, nc, ia, ib, ic) {
 1573 
    mod_iterate3 (na, nb, nc, ia, ib, ic) {
Line 1609... Line 1597...
1609 
    SETUP_Math3;
 1597 
    SETUP_Math3;
1610 
    i_1 = asInteger(sI);
 1598 
    i_1 = asInteger(sI);
1611 
    i_2 = asInteger(sJ);
 1599 
    i_2 = asInteger(sJ);
1612 
 
 1600 
 
1613 
#ifdef R_MEMORY_PROFILING
 1601 
#ifdef R_MEMORY_PROFILING
1614 
    if (RTRACE(sa) || RTRACE(sb) || RTRACE(sc)){
 1602 
    if (RTRACE(sa) || RTRACE(sb) || RTRACE(sc)) {
1615 
       if (RTRACE(sa))
 1603 
       if (RTRACE(sa))
1616 
	  memtrace_report(sa,sy);
 1604 
	  memtrace_report(sa, sy);
1617 
       else if (RTRACE(sb))
 1605 
       else if (RTRACE(sb))
1618 
	  memtrace_report(sb, sy);
 1606 
	  memtrace_report(sb, sy);
1619 
       else if (RTRACE(sc))
 1607 
       else if (RTRACE(sc))
1620 
	  memtrace_report(sc,sy);
 1608 
	  memtrace_report(sc, sy);
1621 
       SET_RTRACE(sy, 1);
 1609 
       SET_RTRACE(sy, 1);
1622 
    }
 1610 
    }
1623 
#endif
 1611 
#endif
1624 
 
 1612 
 
1625 
 
 1613 
 
Line 1649... Line 1637...
1649 
    long nw;
 1637 
    long nw;
1650 
 
 1638 
 
1651 
    SETUP_Math3;
 1639 
    SETUP_Math3;
1652 
 
 1640 
 
1653 
#ifdef R_MEMORY_PROFILING
 1641 
#ifdef R_MEMORY_PROFILING
1654 
    if (RTRACE(sa) || RTRACE(sb) || RTRACE(sc)){
 1642 
    if (RTRACE(sa) || RTRACE(sb) || RTRACE(sc)) {
1655 
       if (RTRACE(sa))
 1643 
       if (RTRACE(sa))
1656 
	  memtrace_report(sa,sy);
 1644 
	  memtrace_report(sa, sy);
1657 
       else if (RTRACE(sb))
 1645 
       else if (RTRACE(sb))
1658 
	  memtrace_report(sb, sy);
 1646 
	  memtrace_report(sb, sy);
1659 
       else if (RTRACE(sc))
 1647 
       else if (RTRACE(sc))
1660 
	  memtrace_report(sc,sy);
 1648 
	  memtrace_report(sc, sy);
1661 
       SET_RTRACE(sy, 1);
 1649 
       SET_RTRACE(sy, 1);
1662 
    }
 1650 
    }
1663 
#endif
 1651 
#endif
1664 
 
 1652 
 
1665 
    /* allocate work array for BesselI, BesselK large enough for all
 1653 
    /* allocate work array for BesselI, BesselK large enough for all
Line 1686... Line 1674...
1686 
    FINISH_Math3;
 1674 
    FINISH_Math3;
1687 
 
 1675 
 
1688 
    return sy;
 1676 
    return sy;
1689 
} /* math3B */
 1677 
} /* math3B */
1690 
 
 1678 
 
1691 
#define Math3(A, FUN)   math3  (CAR(A), CADR(A), CADDR(A), FUN, call);
 - 
 
1692 
#define Math3_1(A, FUN)	math3_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN, call);
 1679 
#define Math3_1(A, FUN)	math3_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN, call);
1693 
#define Math3_2(A, FUN) math3_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), FUN, call)
 1680 
#define Math3_2(A, FUN) math3_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), FUN, call)
1694 
#define Math3B(A, FUN)  math3B (CAR(A), CADR(A), CADDR(A), FUN, call);
 1681 
#define Math3B(A, FUN)  math3B (CAR(A), CADR(A), CADDR(A), FUN, call);
1695 
 
 1682 
 
1696 
SEXP attribute_hidden do_math3(SEXP call, SEXP op, SEXP args, SEXP env)
 1683 
SEXP attribute_hidden do_math3(SEXP call, SEXP op, SEXP args, SEXP env)
Line 1832... Line 1819...
1832 
 
 1819 
 
1833 
#define FINISH_Math4				\
 1820 
#define FINISH_Math4				\
1834 
    if(naflag)					\
 1821 
    if(naflag)					\
1835 
	warningcall(lcall, R_MSG_NA);		\
 1822 
	warningcall(lcall, R_MSG_NA);		\
1836 
						\
 1823 
						\
1837 
    if (n == na) {				\
 - 
 
1838 
	DUPLICATE_ATTRIB(sy, sa);	\
 1824 
    if (n == na) DUPLICATE_ATTRIB(sy, sa);	\
1839 
    }						\
 - 
 
1840 
    else if (n == nb) {				\
 - 
 
1841 
	DUPLICATE_ATTRIB(sy, sb);	\
 1825 
    else if (n == nb) DUPLICATE_ATTRIB(sy, sb);	\
1842 
    }						\
 - 
 
1843 
    else if (n == nc) {				\
 - 
 
1844 
	DUPLICATE_ATTRIB(sy, sc);	\
 1826 
    else if (n == nc) DUPLICATE_ATTRIB(sy, sc);	\
1845 
    }						\
 - 
 
1846 
    else if (n == nd) {				\
 - 
 
1847 
	DUPLICATE_ATTRIB(sy, sd);	\
 1827 
    else if (n == nd) DUPLICATE_ATTRIB(sy, sd);	\
1848 
    }						\
 - 
 
1849 
    UNPROTECT(5)
 1828 
    UNPROTECT(5)
1850 
 
 1829 
 
1851 
    FINISH_Math4;
 1830 
    FINISH_Math4;
1852 
 
 1831 
 
1853 
    return sy;
 1832 
    return sy;
Line 2026... Line 2005...
2026 
 
 2005 
 
2027 
#define FINISH_Math5				\
 2006 
#define FINISH_Math5				\
2028 
    if(naflag)					\
 2007 
    if(naflag)					\
2029 
	warningcall(lcall, R_MSG_NA);		\
 2008 
	warningcall(lcall, R_MSG_NA);		\
2030 
						\
 2009 
						\
2031 
    if (n == na) {				\
 - 
 
2032 
	DUPLICATE_ATTRIB(sy, sa);	\
 2010 
    if (n == na) DUPLICATE_ATTRIB(sy, sa);	\
2033 
    }						\
 - 
 
2034 
    else if (n == nb) {				\
 - 
 
2035 
	DUPLICATE_ATTRIB(sy, sb);	\
 2011 
    else if (n == nb) DUPLICATE_ATTRIB(sy, sb);	\
2036 
    }						\
 - 
 
2037 
    else if (n == nc) {				\
 - 
 
2038 
	DUPLICATE_ATTRIB(sy, sc);	\
 2012 
    else if (n == nc) DUPLICATE_ATTRIB(sy, sc);	\
2039 
    }						\
 - 
 
2040 
    else if (n == nd) {				\
 - 
 
2041 
	DUPLICATE_ATTRIB(sy, sd);	\
 2013 
    else if (n == nd) DUPLICATE_ATTRIB(sy, sd);	\
2042 
    }						\
 - 
 
2043 
    else if (n == ne) {				\
 - 
 
2044 
	DUPLICATE_ATTRIB(sy, se);	\
 2014 
    else if (n == ne) DUPLICATE_ATTRIB(sy, se);	\
2045 
    }						\
 - 
 
2046 
    UNPROTECT(6)
 2015 
    UNPROTECT(6)
2047 
 
 2016 
 
2048 
    FINISH_Math5;
 2017 
    FINISH_Math5;
2049 
 
 2018 
 
2050 
    return sy;
 2019 
    return sy;