The R Project SVN R

Rev

Rev 90261 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 90261 Rev 90309
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
 2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  Copyright (C) 2016--2025   The R Core Team
 3 
 *  Copyright (C) 2016--2026   The R Core Team
4 
 *
 4 
 *
5 
 *  This program is free software; you can redistribute it and/or modify
 5 
 *  This program is free software; you can redistribute it and/or modify
6 
 *  it under the terms of the GNU General Public License as published by
 6 
 *  it under the terms of the GNU General Public License as published by
7 
 *  the Free Software Foundation; either version 2 of the License, or
 7 
 *  the Free Software Foundation; either version 2 of the License, or
8 
 *  (at your option) any later version.
 8 
 *  (at your option) any later version.
Line 1430... Line 1430...
1430 
   of a potentially large object and/or meta data for the object. */
 1430 
   of a potentially large object and/or meta data for the object. */
1431 
 
 1431 
 
1432 
#define WRAPPER_WRAPPED(x) R_altrep_data1(x)
 1432 
#define WRAPPER_WRAPPED(x) R_altrep_data1(x)
1433 
#define WRAPPER_SET_WRAPPED(x, v) R_set_altrep_data1(x, v)
 1433 
#define WRAPPER_SET_WRAPPED(x, v) R_set_altrep_data1(x, v)
1434 
#define WRAPPER_METADATA(x) R_altrep_data2(x)
 1434 
#define WRAPPER_METADATA(x) R_altrep_data2(x)
1435 
#define WRAPPER_SET_METADATA(x, v) R_set_altrep_data2(x, v)
 - 
 
1436 
 
 1435 
 
1437 
#define WRAPPER_SORTED(x) INTEGER(WRAPPER_METADATA(x))[0]
 1436 
#define WRAPPER_SORTED(x) INTEGER(WRAPPER_METADATA(x))[0]
1438 
#define WRAPPER_NO_NA(x) INTEGER(WRAPPER_METADATA(x))[1]
 1437 
#define WRAPPER_NO_NA(x) INTEGER(WRAPPER_METADATA(x))[1]
1439 
 
 1438 
 
- 
 
 1439 
/* When a wrapper is created, e.g. using structure(), the data may
- 
 
 1440 
   initially be shared. Once it is modified to be modified or a
- 
 
 1441 
   DATAPTR is requested the data has to be remain unchanged and the
- 
 
 1442 
   wrapper should be the only reference. The metadata is marked to
- 
 
 1443 
   reflecth this. The data then has to be duplicated by the duplicate
- 
 
 1444 
   method to ensure that no new references are created. This ensures
- 
 
 1445 
   that a DATAPTR, once obtained, remains valid while the wrapper
- 
 
 1446 
   object is reachable.
- 
 
 1447
- 
 
 1448 
   For now the sxpinfo.gp field is used via PRSEEN for the lock.
- 
 
 1449 
 */
- 
 
 1450 
#define WRAPPER_DATA_IS_LOCKED(x) PRSEEN(WRAPPER_METADATA(x))
- 
 
 1451 
#define WRAPPER_LOCK_DATA(x) SET_PRSEEN(WRAPPER_METADATA(x), 1)
- 
 
 1452 
#define WRAPPER_UNLOCK_DATA(x) SET_PRSEEN(WRAPPER_METADATA(x), 0)
- 
 
 1453 
 
1440 
static R_INLINE SEXP WRAPPER_WRAPPED_RW(SEXP x)
 1454 
static R_INLINE SEXP WRAPPER_WRAPPED_RW(SEXP x)
1441 
{
 1455 
{
1442 
    /* If the data might be shared and is accessed for possible
 - 
 
1443 
       modification, then it needs to be duplicated now. */
 - 
 
1444 
    SEXP data = WRAPPER_WRAPPED(x);
 1456 
    SEXP data = WRAPPER_WRAPPED(x);
- 
 
 1457 
    if (WRAPPER_DATA_IS_LOCKED(x)) {
- 
 
 1458 
	/* Once data is locked it's reference cout should remain at one. */
- 
 
 1459 
	if (MAYBE_SHARED(data))
- 
 
 1460 
	    error("REFCNT on locked WRAPPER data increased to %d",
- 
 
 1461 
		  REFCNT(data));
- 
 
 1462 
    }
- 
 
 1463 
    else {
- 
 
 1464 
	/* If the data might be shared and is accessed for possible
- 
 
 1465 
	   modification, then it needs to be duplicated now. */
1445 
    if (MAYBE_SHARED(data)) {
 1466 
	if (MAYBE_SHARED(data)) {
1446 
	PROTECT(x);
 1467 
	    PROTECT(x);
1447 
	WRAPPER_SET_WRAPPED(x, shallow_duplicate(data));
 1468 
	    WRAPPER_SET_WRAPPED(x, shallow_duplicate(data));
1448 
	UNPROTECT(1);
 1469 
	    UNPROTECT(1);
- 
 
 1470 
	}
- 
 
 1471 
	WRAPPER_LOCK_DATA(x);
1449 
    }
 1472 
    }
1450 
 
 1473 
 
1451 
    /* The meta data also needs to be cleared as it may no longer be
 1474 
    /* The meta data also needs to be cleared as it may no longer be
1452 
       valid after a write. */
 1475 
       valid after a write. */
1453 
    SEXP meta = WRAPPER_METADATA(x);
 1476 
    SEXP meta = WRAPPER_METADATA(x);
Line 1490... Line 1513...
1490 
 
 1513 
 
1491 
    /* For a deep copy, duplicate the data. */
 1514 
    /* For a deep copy, duplicate the data. */
1492 
    /* For a shallow copy, mark as immutable in the NAMED world; with
 1515 
    /* For a shallow copy, mark as immutable in the NAMED world; with
1493 
       reference counting the reference count will be incremented when
 1516 
       reference counting the reference count will be incremented when
1494 
       the data is installed in the new wrapper object. */
 1517 
       the data is installed in the new wrapper object. */
1495 
    if (deep)
 1518 
    if (deep || WRAPPER_DATA_IS_LOCKED(x)) // **** shallow duplicate if only locked?
1496 
	data = duplicate(data);
 1519 
	data = duplicate(data);
1497 
#ifndef SWITCH_TO_REFCNT
 1520 
#ifndef SWITCH_TO_REFCNT
1498 
    else
 1521 
    else
1499 
	/* not needed with reference counting */
 1522 
	/* not needed with reference counting */
1500 
	MARK_NOT_MUTABLE(data);
 1523 
	MARK_NOT_MUTABLE(data);
Line 1513... Line 1536...
1513 
static Rboolean wrapper_Inspect(SEXP x, int pre, int deep, int pvec,
 1536 
static Rboolean wrapper_Inspect(SEXP x, int pre, int deep, int pvec,
1514 
				void (*inspect_subtree)(SEXP, int, int, int))
 1537 
				void (*inspect_subtree)(SEXP, int, int, int))
1515 
{
 1538 
{
1516 
    Rboolean srt = (Rboolean) WRAPPER_SORTED(x);
 1539 
    Rboolean srt = (Rboolean) WRAPPER_SORTED(x);
1517 
    Rboolean no_na = (Rboolean) WRAPPER_NO_NA(x);
 1540 
    Rboolean no_na = (Rboolean) WRAPPER_NO_NA(x);
- 
 
 1541 
    Rboolean lck = (Rboolean) WRAPPER_DATA_IS_LOCKED(x);
1518 
    Rprintf(" wrapper [srt=%d,no_na=%d]\n", srt, no_na);
 1542 
    Rprintf(" wrapper [srt=%d,no_na=%d,lck=%d]\n", srt, no_na, lck);
1519 
    inspect_subtree(WRAPPER_WRAPPED(x), pre, deep, pvec);
 1543 
    inspect_subtree(WRAPPER_WRAPPED(x), pre, deep, pvec);
1520 
    return TRUE;
 1544 
    return TRUE;
1521 
}
 1545 
}
1522 
 
 1546 
 
1523 
static R_xlen_t wrapper_Length(SEXP x)
 1547 
static R_xlen_t wrapper_Length(SEXP x)
Line 1948... Line 1972...
1948 
#ifndef SWITCH_TO_REFCNT
 1972 
#ifndef SWITCH_TO_REFCNT
1949 
    if (MAYBE_REFERENCED(x))
 1973 
    if (MAYBE_REFERENCED(x))
1950 
	/* make sure no mutation can happen through another reference */
 1974 
	/* make sure no mutation can happen through another reference */
1951 
	MARK_NOT_MUTABLE(x);
 1975 
	MARK_NOT_MUTABLE(x);
1952 
#endif
 1976 
#endif
1953
1977 
 
- 
 
 1978 
    WRAPPER_UNLOCK_DATA(ans);
1954 
    return ans;
 1979 
    return ans;
1955 
}
 1980 
}
1956 
 
 1981 
 
1957 
static R_INLINE int is_wrapper(SEXP x)
 1982 
static R_INLINE int is_wrapper(SEXP x)
1958 
{
 1983 
{