Support S4 objects

AGENTS.md

@@ -52,7 +52,7 @@ All writers are count-then-write pairs: `mori_serialize_count`/`mori_serialize_i
 
 Declared in `mori.h`, C-level only (not `.Call`) — for packages embedding mori layouts under their own SHM management:
 
-- **Layout oracle + writer**: `mori_layout_size(x)` → region size, or 0 for what the writer must not take (non-mori ALTREP nodes — would materialize via `DATAPTR_RO`; S4 bits — don't survive the layouts). Vetoes ride the size recursion (`mori_layout_size_impl` with `ok != NULL`); the host path passes `NULL` and vetoes nothing. `mori_layout_write(base, x)` emits exactly `mori_layout_size` bytes and zeroes reserved header bytes [24-63] on every write (embedders may recycle regions).
+- **Layout oracle + writer**: `mori_layout_size(x)` → region size, or 0 for what the writer must not take (non-mori ALTREP nodes — would materialize via `DATAPTR_RO`). The S4 object bit rides the layouts: header flags word at offset 32 (`MORI_FLAG_S4`) for MORH/MORS/MORL roots and nested lists, bit 30 of the directory entry's `sexptype` (`MORI_ELEM_S4`) for vector/string leaves; applied with `Rf_asS4` after attributes land. Vetoes ride the size recursion (`mori_layout_size_impl` with `ok != NULL`); the host path passes `NULL` and vetoes nothing. `mori_layout_write(base, x)` emits exactly `mori_layout_size` bytes and zeroes reserved header bytes [24-63] on every write (embedders may recycle regions).
 - **Wrap constructors**: `mori_vec_wrap` / `mori_str_wrap` / `mori_list_wrap` build views over embedder memory, pinning `keeper` via the data1 extptr's protected slot; each takes a `release` once-hook (see Internal State). `mori_restore_attrs` reapplies trailing serialized attributes.
 - **Introspection + path walk**: `mori_view_check`, `mori_shm_name`, `mori_parse_id`, `mori_walk_path` (walks an index path over an open region; the caller's keeper flows into the result's chain).
 - **Wire hooks**: `mori_set_wire_hooks(emit, resolve)` — see Serialization Hooks.
@@ -92,7 +92,7 @@ int1       ::= [1-9][0-9]*       # 1-based, no leading zeros
 
 ## SHM Region Layouts
 
-Magic in the first 4 bytes (`MORI_MAGIC_*`): MORH `0x4D4F5248` vector, MORL `0x4D4F524C` list, MORS `0x4D4F5253` string. Every layout opens with a 64-byte header; bytes [24-63] are reserved (zeroed on every write — embedders may recycle regions) for embedder cross-process state. Tables are the canonical spec; `mori_nested_write` / `morh_write` / `mors_write` (with `mori_serialize_into` for fallbacks and attrs) are the implementations. Attributes are serialized R objects (pairlist on R < 4.6, named list otherwise); `mori_restore_attrs` reapplies them on the consumer.
+Magic in the first 4 bytes (`MORI_MAGIC_*`): MORH `0x4D4F5248` vector, MORL `0x4D4F524C` list, MORS `0x4D4F5253` string. Every layout opens with a 64-byte header; bytes [24-31] are reserved for embedder cross-process state, [32-35] hold a mori flags word (bit 0: S4 object bit), [36-63] are reserved (all zeroed on every write — embedders may recycle regions). Tables are the canonical spec; `mori_nested_write` / `morh_write` / `mors_write` (with `mori_serialize_into` for fallbacks and attrs) are the implementations. Attributes are serialized R objects (pairlist on R < 4.6, named list otherwise); `mori_restore_attrs` reapplies them on the consumer.
 
 **MORH — atomic vector.** Data at byte 64 (64-byte aligned for SIMD); trailing attrs after the data.
 
@@ -102,7 +102,9 @@ Magic in the first 4 bytes (`MORI_MAGIC_*`): MORH `0x4D4F5248` vector, MORL `0x4
 | 4 | 4 | sexptype |
 | 8 | 8 | length (int64) |
 | 16 | 8 | attrs_size (int64, 0 if none) |
-| 24 | 40 | reserved (zero) |
+| 24 | 8 | reserved (zero) — embedder cross-process state |
+| 32 | 4 | flags (bit 0: S4 object bit) |
+| 36 | 28 | reserved (zero) |
 | 64+ | | raw vector data |
 | 64 + length×elt_size | | serialized attributes (if `attrs_size` > 0) |
 
@@ -114,11 +116,13 @@ Magic in the first 4 bytes (`MORI_MAGIC_*`): MORH `0x4D4F5248` vector, MORL `0x4
 | 4 | 4 | n_elements (int32) |
 | 8 | 8 | attrs_offset (int64) |
 | 16 | 8 | attrs_size (int64) |
-| 24 | 40 | reserved (zero) |
+| 24 | 8 | reserved (zero) — embedder cross-process state |
+| 32 | 4 | flags (bit 0: S4 object bit) |
+| 36 | 28 | reserved (zero) |
 | 64 | 32×n | element directory |
 | varies | | element data (64-byte aligned), then serialized attributes |
 
-Directory entry (32 bytes): `data_offset(8) + data_size(8) + sexptype(4) + attrs_size(4) + length(8)`. `sexptype`: `0` → serialized bytes (serialize.c); `STRSXP` → offset table + packed strings at `data_offset`; `VECSXP` → nested MORL region inlined at `data_offset` of size `data_size` (child header/directory/elements/attrs all inline; parent's `attrs_size` always 0 for VECSXP children); other → raw zero-copy data. Non-VECSXP attrs sit at `data_offset + data_size - attrs_size`.
+Directory entry (32 bytes): `data_offset(8) + data_size(8) + sexptype(4) + attrs_size(4) + length(8)`. `sexptype`: `0` → serialized bytes (serialize.c); `STRSXP` → offset table + packed strings at `data_offset`; `VECSXP` → nested MORL region inlined at `data_offset` of size `data_size` (child header/directory/elements/attrs all inline; parent's `attrs_size` always 0 for VECSXP children); other → raw zero-copy data, with bit 30 of `sexptype` (`MORI_ELEM_S4`) flagging an S4 leaf (masked off at read). Non-VECSXP attrs sit at `data_offset + data_size - attrs_size`.
 
 **MORS — ALTSTRING.** Header + offset table + packed string bytes + optional trailing attrs.
 
@@ -128,7 +132,9 @@ Directory entry (32 bytes): `data_offset(8) + data_size(8) + sexptype(4) + attrs
 | 4 | 4 | attrs_size (int32, 0 if none) |
 | 8 | 8 | n_strings (int64) |
 | 16 | 8 | str_data_size (int64: offset-table start → end of packed strings, incl. padding) |
-| 24 | 40 | reserved (zero) |
+| 24 | 8 | reserved (zero) — embedder cross-process state |
+| 32 | 4 | flags (bit 0: S4 object bit) |
+| 36 | 28 | reserved (zero) |
 | 64 | 16×n | offset table |
 | 64 + align64(16×n) | | packed string bytes |
 | 64 + str_data_size | | serialized attributes (if `attrs_size` > 0) |

DESCRIPTION

@@ -23,6 +23,6 @@ Suggests:
     testthat (>= 3.0.0)
 Config/build/compilation-database: true
 Config/roxygen2/markdown: TRUE
-Config/roxygen2/version: 8.0.0
+Config/roxygen2/version: 8.1.0
 Config/testthat/edition: 3
 Encoding: UTF-8

NEWS.md

@@ -1,6 +1,7 @@
 # mori (development version)
 
 * Region layouts now open with a 64-byte header.
+* `share()` now supports S4 objects built on vectors or lists (previously the S4 object bit was silently dropped).
 * `share()` of attribute-heavy objects and nested lists is faster: the write pass no longer re-serializes each element just to measure its size.
 * Fixed type confusion on unserialize when a shared string's content resembled a shared memory identifier (e.g. a stored `shared_name()` value).
 * Fixed a forked child process (e.g. `parallel::mclapply`) unlinking the parent's live region when garbage-collecting an inherited shared object.

R/share.R

@@ -7,7 +7,7 @@
 #'
 #' @return For atomic vectors (including character vectors and those with
 #'   attributes such as names, dim, class, or levels) and lists or data
-#'   frames whose elements are such vectors, an ALTREP-backed object that
+#'   frames, an ALTREP-backed object that
 #'   reads directly from shared memory. For any other object (environments,
 #'   closures, language objects, `NULL`), the input is returned unchanged
 #'   with no shared memory region created.
@@ -20,6 +20,17 @@
 #' compactly by its shared memory name (~30 bytes) rather than by its
 #' contents.
 #'
+#' An S4 object whose data part is an atomic vector, a character vector,
+#' or a list stays an S4 object when it is shared. The class and the slots
+#' are preserved, and S4 method dispatch works on the shared object. The
+#' data part is shared without a copy. The slots are serialised and
+#' restored on the consumer side as copies.
+#'
+#' A shared list can hold elements of any type. An element that is not an
+#' atomic vector, a character vector, or a list is serialised and restored
+#' as a copy on access. This applies to environments, closures, and
+#' language objects.
+#'
 #' The shared memory region is managed automatically. It stays alive as long
 #' as the returned object (or any element extracted from it) is referenced
 #' in R, and is freed automatically when no references remain or the session

src/altrep.c

@@ -34,6 +34,10 @@ typedef struct {
   int64_t length;
 } mori_elem;
 
+/* S4 flag riding a directory entry's sexptype: SEXPTYPEs are small
+   positive values, so bit 30 is free. Set at write, masked off at read. */
+#define MORI_ELEM_S4 0x40000000
+
 /* ALTSTRING offset table entry (16 bytes per string).
    str_length < 0 sentinel means NA_STRING.
    str_encoding is a cetype_t. */
@@ -507,6 +511,8 @@ static SEXP mori_unwrap_element(unsigned char *base, int64_t region_size,
   int64_t data_offset = entry.data_offset, data_size = entry.data_size;
   int64_t length = entry.length;
   int32_t sexptype = entry.sexptype, attrs_size = entry.attrs_size;
+  int s4 = sexptype & MORI_ELEM_S4;
+  sexptype &= ~MORI_ELEM_S4;
 
   if (mori_oob(data_offset, data_size, region_size))
     Rf_error("mori: invalid element data");
@@ -547,6 +553,7 @@ static SEXP mori_unwrap_element(unsigned char *base, int64_t region_size,
     size_t attrs_off = (size_t)(data_offset + data_size - attrs_size);
     mori_restore_attrs(result, base + attrs_off, (size_t) attrs_size);
   }
+  if (s4) result = Rf_asS4(result, TRUE, 0);
 
   UNPROTECT(1);
   return result;
@@ -566,7 +573,9 @@ static SEXP mori_unwrap_element(unsigned char *base, int64_t region_size,
  *   Bytes 4-7:   int32_t  n_elements
  *   Bytes 8-15:  int64_t  attrs_offset
  *   Bytes 16-23: int64_t  attrs_size
- *   Bytes 24-63: reserved (zero) — embedder cross-process state
+ *   Bytes 24-31: reserved (zero) — embedder cross-process state
+ *   Bytes 32-35: uint32_t flags (bit 0: S4 object bit)
+ *   Bytes 36-63: reserved (zero)
  *   Byte 64+:    element directory (32 bytes per element)
  */
 
@@ -636,6 +645,7 @@ SEXP mori_list_wrap(unsigned char *base, int64_t region_size, int32_t index,
   if (attrs_size > 0)
     mori_restore_attrs(result, base + (size_t) attrs_offset,
                        (size_t) attrs_size);
+  result = mori_apply_s4(result, base);
 
   UNPROTECT(2);
   return result;
@@ -841,8 +851,7 @@ static size_t mori_nested_write(unsigned char *base, SEXP x);
    ok is NULL on the host path. When non-NULL (the embedder layout oracle),
    each node is vetted before sizing and the first rejection sets *ok = 0 and
    bails out with return 0: a non-mori ALTREP node would materialize through
-   DATAPTR_RO at write (a compact 1:1e8 becomes an 800 MB memcpy), and S4
-   bits do not survive the layouts. */
+   DATAPTR_RO at write (a compact 1:1e8 becomes an 800 MB memcpy). */
 static size_t mori_nested_size(SEXP x, int *ok) {
 
   R_xlen_t n = XLENGTH(x);
@@ -852,17 +861,13 @@ static size_t mori_nested_size(SEXP x, int *ok) {
     SEXP elt = VECTOR_ELT(x, i);
 
     if (ok != NULL) {
-      if (ALTREP(elt)) {
-        if (!mori_view_check(elt)) { *ok = 0; return 0; }
-      } else if (Rf_isS4(elt)) {
-        *ok = 0; return 0;
-      }
+      if (ALTREP(elt) && !mori_view_check(elt)) { *ok = 0; return 0; }
     }
 
     int type = TYPEOF(elt);
     size_t elt_size;
 
-    if (type == LISTSXP || type == VECSXP) {
+    if (type == VECSXP || (type == LISTSXP && !Rf_isS4(elt))) {
       SEXP coerced = (type == LISTSXP) ? Rf_coerceVector(elt, VECSXP) : elt;
       PROTECT(coerced);
       elt_size = mori_nested_size(coerced, ok);
@@ -906,14 +911,16 @@ static size_t mori_nested_write(unsigned char *base, SEXP x) {
   /* Reserved header bytes [24-63] are zeroed on every write: an embedder
      may recycle regions, so no stale field may survive a reuse. */
   memset(base + 24, 0, MORI_HEADER_SIZE - 24);
+  uint32_t flags = Rf_isS4(x) ? MORI_FLAG_S4 : 0u;
+  memcpy(base + MORI_FLAGS_OFF, &flags, 4);
 
   for (R_xlen_t i = 0; i < n; i++) {
     SEXP elt = VECTOR_ELT(x, i);
     int type = TYPEOF(elt);
     mori_elem entry;
     entry.data_offset = (int64_t) cur;
 
-    if (type == LISTSXP || type == VECSXP) {
+    if (type == VECSXP || (type == LISTSXP && !Rf_isS4(elt))) {
       SEXP coerced = (type == LISTSXP) ? Rf_coerceVector(elt, VECSXP) : elt;
       PROTECT(coerced);
       size_t written = mori_nested_write(base + cur, coerced);
@@ -936,7 +943,7 @@ static size_t mori_nested_write(unsigned char *base, SEXP x) {
       if (elt_attrs != R_NilValue)
         attrs_size = mori_serialize_into(base + cur + raw_size, elt_attrs);
 
-      entry.sexptype = type;
+      entry.sexptype = type | (Rf_isS4(elt) ? MORI_ELEM_S4 : 0);
       entry.attrs_size = (int32_t) attrs_size;
       entry.length = (int64_t) XLENGTH(elt);
       entry.data_size = (int64_t) (raw_size + attrs_size);
@@ -1033,10 +1040,12 @@ static void morh_write(unsigned char *base, SEXP x) {
   int32_t sexptype = (int32_t) type;
   int64_t length = (int64_t) n;
   int64_t as64 = (int64_t) attrs_size;
+  uint32_t flags = Rf_isS4(x) ? MORI_FLAG_S4 : 0u;
   memcpy(base, &magic, 4);
   memcpy(base + 4, &sexptype, 4);
   memcpy(base + 8, &length, 8);
   memcpy(base + 16, &as64, 8);
+  memcpy(base + MORI_FLAGS_OFF, &flags, 4);
 
   UNPROTECT(1);
 }
@@ -1069,10 +1078,12 @@ static void mors_write(unsigned char *base, SEXP x) {
   int32_t as32 = (int32_t) attrs_size;
   int64_t n64 = (int64_t) n;
   int64_t sd = (int64_t) str_size;
+  uint32_t flags = Rf_isS4(x) ? MORI_FLAG_S4 : 0u;
   memcpy(base, &magic, 4);
   memcpy(base + 4, &as32, 4);
   memcpy(base + 8, &n64, 8);
   memcpy(base + 16, &sd, 8);
+  memcpy(base + MORI_FLAGS_OFF, &flags, 4);
 
   UNPROTECT(1);
 }
@@ -1087,13 +1098,11 @@ static void mors_write(unsigned char *base, SEXP x) {
    header. */
 static size_t mori_layout_size_impl(SEXP x, int *ok) {
   if (ok != NULL) {
-    if (ALTREP(x)) {
-      if (!mori_view_check(x)) { *ok = 0; return 0; }
-    } else if (Rf_isS4(x)) {
-      *ok = 0; return 0;
-    }
+    if (ALTREP(x) && !mori_view_check(x)) { *ok = 0; return 0; }
   }
   int type = TYPEOF(x);
+  /* An S4 pairlist root passes through: VECSXP coercion drops the bit. */
+  if (type == LISTSXP && Rf_isS4(x)) return 0;
   if (type == VECSXP || type == LISTSXP) {
     if (type == LISTSXP) {
       x = PROTECT(Rf_coerceVector(x, VECSXP));
@@ -1196,6 +1205,7 @@ static SEXP mori_open_vector(SEXP shm_ptr) {
     mori_restore_attrs(result, base + MORI_HEADER_SIZE + data_bytes,
                        (size_t) attrs_size);
   }
+  result = mori_apply_s4(result, base);
 
   UNPROTECT(1);
   return result;
@@ -1227,6 +1237,7 @@ static SEXP mori_open_string(SEXP shm_ptr) {
   if (attrs_size > 0)
     mori_restore_attrs(result, base + MORI_HEADER_SIZE + (size_t) str_data_size,
                        (size_t) attrs_size);
+  result = mori_apply_s4(result, base);
 
   UNPROTECT(1);
   return result;
@@ -1468,7 +1479,7 @@ SEXP mori_walk_path(unsigned char *base, int64_t region_size,
     mori_elem entry;
     memcpy(&entry, dir, sizeof(mori_elem));
     int64_t data_offset = entry.data_offset, data_size = entry.data_size;
-    int32_t sexptype = entry.sexptype;
+    int32_t sexptype = entry.sexptype & ~MORI_ELEM_S4;
 
     if (sexptype != VECSXP)
       Rf_error("mori: path step is not a nested list");

src/mori.h

@@ -19,6 +19,13 @@
 #define MORI_TAG_HOST  "mori_host"
 #define MORI_TAG_OWNED "mori_owned"
 
+/* Region header flags word at byte offset 32 of the 64-byte header —
+   bytes [24-31] remain embedder cross-process state, [36-63] reserved.
+   Bit 0 records the S4 object bit, which the layouts otherwise cannot
+   carry. */
+#define MORI_FLAGS_OFF 32
+#define MORI_FLAG_S4 0x1u
+
 // Types -----------------------------------------------------------------------
 
 typedef struct mori_buf_s {
@@ -73,6 +80,18 @@ static inline size_t mori_sizeof_elt(int type) {
   }
 }
 
+/* Apply a region header's S4 flag to a freshly wrapped view — after
+   attributes land, so a read never consults a class definition
+   (Rf_asS4 with complete = 0 sets the bit in place on a fresh object).
+   Call on a validated region (>= MORI_HEADER_SIZE bytes); embedders
+   wrapping MORH / MORS roots through the raw constructors call this
+   last. */
+static inline SEXP mori_apply_s4(SEXP x, const unsigned char *base) {
+  uint32_t flags;
+  memcpy(&flags, base + MORI_FLAGS_OFF, 4);
+  return (flags & MORI_FLAG_S4) ? Rf_asS4(x, TRUE, 0) : x;
+}
+
 // altrep.c --------------------------------------------------------------------
 
 void mori_altrep_init(DllInfo *dll);
@@ -98,9 +117,9 @@ void mori_restore_attrs(SEXP result, unsigned char *buf, size_t size);
 
 /* Layout oracle and writer for embedder-managed regions: the size pass
    walks the tree and returns 0 for anything the layout writer must not
-   take (a non-mori ALTREP node would materialize through DATAPTR_RO; S4
-   bits do not survive the layouts). The write emits exactly
-   mori_layout_size bytes and zeroes header reserved bytes. */
+   take (a non-mori ALTREP node would materialize through DATAPTR_RO).
+   The write emits exactly mori_layout_size bytes and zeroes header
+   reserved bytes. */
 size_t mori_layout_size(SEXP x);
 void mori_layout_write(unsigned char *base, SEXP x);
 

tests/testthat/test-corruption.R

@@ -311,3 +311,30 @@ test_that("root string access errors on an out-of-bounds offset table entry", {
   s <- map_shared(name)
   expect_error(s[1], "invalid string data")
 })
+
+test_that("map_shared() errors on an unsupported vector sexptype", {
+  if (Sys.info()[["sysname"]] != "Linux") {
+    skip("requires file-backed /dev/shm (Linux only)")
+  }
+
+  # A MORH header claiming a sexptype with no element size passes the header
+  # checks (the size checks skip such types) but the wrap constructor
+  # rejects it.
+  name <- write_corrupt(morh_header(99L, length = 1))
+  expect_error(map_shared(name), "unsupported ALTREP type")
+})
+
+test_that("element access errors when string table alignment exceeds its data", {
+  if (Sys.info()[["sysname"]] != "Linux") {
+    skip("requires file-backed /dev/shm (Linux only)")
+  }
+
+  # n = 1: the 16-byte offset table fits the entry's 16-byte data claim, but
+  # the table's 64-byte alignment padding does not.
+  name <- write_corrupt(c(
+    morl_header(n = 1L),
+    morl_entry(data_offset = 96, data_size = 16, sexptype = STRSXP, length = 1),
+    raw(16L)
+  ))
+  expect_error(map_shared(name)[[1]], "invalid string data")
+})