Change HW to SW card marking on immobile layout pages

src/code/defstruct.lisp

@@ -215,6 +215,8 @@
           (values (raw-slot-data-reader-name it) (raw-slot-data-writer-name it)))
          ((eq (dd-type dd) 'funcallable-structure)
           (values '%funcallable-instance-info '%set-funcallable-instance-info))
+         ((eq (dd-name dd) 'layout)
+          (values '%instance-ref '%layout-slot-set))
          (t
           (values '%instance-ref '%instance-set))))
 

src/code/early-classoid.lisp

@@ -199,6 +199,9 @@
 
 ;;; 32-bit is not done yet. Three slots are still used, instead of two.
 
+;;; TODO: this should probably become a BUILTIN-CLASSOID for the same reason
+;;; PATHNAME is (see rev 816d286a), namely to prevent use of COPY-STRUCTURE,
+;;; MAKE-INSTANCE, and (SETF SLOT-VALUE).
 (sb-xc:defstruct (layout (:copier nil)
                          ;; Parsing DEFSTRUCT uses a temporary layout
                          (:constructor make-temporary-layout
@@ -277,6 +280,9 @@
   ;; access to slot-definitions and locations by name, etc.
   ;; See MAKE-SLOT-TABLE in pcl/slots-boot.lisp for further details.
   (slot-table #(1 nil) :type simple-vector)
+  ;; In lieu of card-marking, this should maintain a so-called intrusive
+  ;; linked list of layouts touched since last GC
+  ; (chain 0 :type sb-vm:word) ; not yet
   (id-word0 0 :type word)
   (id-word1 0 :type word)
   (id-word2 0 :type word)

src/code/target-defstruct.lisp

@@ -13,6 +13,32 @@
 
 ;;;; structure frobbing primitives
 
+(export '(%layout-slot-set %layout-slot-cas))
+(defun %layout-slot-set (layout index value)
+  #-immobile-space (%instance-set layout index value)
+  #+immobile-space
+  (sb-vm::with-pseudo-atomic-foreign-calls
+    ;; This is pseudo-atomic because if you mark first and then GC occurs before storing,
+    ;; then GC could (possibly) clear the mark, then you store, and now there's a violation
+    ;; of the marking invariant. If you mark after the store, then you run the risk of an
+    ;; abusive TERMINATE-THREAD causing a violation by aborting before setting the mark.
+    ;; Btw, 1 foreign call per slot assignment is really not a big deal. If you're altering
+    ;; layouts at runtime, slot setting is the least of your problems. Making the hundreds
+    ;; of CLOS metaobjects that go along with class lattice changes is worse by far.
+    (alien-funcall (extern-alien "layout_slot_set" (function void unsigned unsigned int))
+                   (get-lisp-obj-address layout) (get-lisp-obj-address value)
+                   (truly-the (mod 32) index)))
+  value)
+(defun %layout-slot-cas (layout index oldval newval)
+  #-immobile-space (%instance-cas layout index oldval newval)
+  #+immobile-space
+  (sb-vm::with-pseudo-atomic-foreign-calls
+    (%make-lisp-obj
+     (alien-funcall (extern-alien "layout_slot_cas"
+                                  (function unsigned unsigned unsigned unsigned int))
+                    (get-lisp-obj-address layout) (get-lisp-obj-address oldval)
+                    (get-lisp-obj-address newval) (truly-the (mod 32) index)))))
+
 ;;; For lack of any better to place to write up some detail surrounding
 ;;; layout creation for structure types, I'm putting here.
 ;;; When you issue a DEFSTRUCT at the REPL, there are *three* instances
@@ -667,7 +693,8 @@
                     ;; or else a compiled perfect-hash-based mapper. Either way, punt.
                     (funcall old symbol)
                     (let* ((new (make-second-stage-slot-mapper vector))
-                           (actual-old (cas (layout-slot-mapper layout) me new)))
+                           (actual-old
+                            (%layout-slot-cas layout (get-dsd-index layout slot-mapper) me new)))
                       (when (eq actual-old me)
                         (install-hash-based-slot-mapper
                          layout pairs unique-hashes `(slot-mapper ,(dd-name dd))))

src/runtime/immobile-space.c

@@ -769,6 +769,10 @@ scavenge_immobile_roots(generation_index_t min_gen, generation_index_t max_gen)
     scavenge_immobile_newspace();
 }
 
+static int should_mprotect(low_page_index_t page) {
+    return fixedobj_pages[page].attr.parts.obj_align == SYMBOL_SIZE
+        && fixedobj_page_wp(page);
+}
 void write_protect_immobile_space()
 {
     immobile_scav_queue_head = 0;
@@ -781,14 +785,14 @@ void write_protect_immobile_space()
     int i, start = -1, end = -1; // inclusive bounds on page indices
     low_page_index_t max_used_fixedobj_page = calc_max_used_fixedobj_page();
     for (i = max_used_fixedobj_page ; i >= 0 ; --i) {
-        if (fixedobj_page_wp(i)) {
+        if (should_mprotect(i)) {
             if (end < 0) end = i;
             start = i;
         }
-        if (end >= 0 && (!fixedobj_page_wp(i) || i == 0)) {
+        if (end >= 0 && (!should_mprotect(i) || i == 0)) {
             os_protect(fixedobj_page_address(start),
                        IMMOBILE_CARD_BYTES * (1 + end - start),
-                       OS_VM_PROT_READ|OS_VM_PROT_EXECUTE);
+                       OS_VM_PROT_READ);
             start = end = -1;
         }
     }
@@ -1274,6 +1278,11 @@ void deport_codeblob_offsets_from_heap()
     lispobj* vector_copy = malloc(nbytes);
     loaded_codeblob_offsets = memcpy(vector_copy, loaded_codeblob_offsets, nbytes);
     SYMBOL(IMMOBILE_CODEBLOB_VECTOR)->value = NIL;
+    int page = 0, limit = calc_max_used_fixedobj_page();
+    for (page = 0; page <= limit; ++page) {
+        if (fixedobj_pages[page].attr.parts.obj_align > SYMBOL_SIZE) // layout page
+            SET_WP_FLAG(page, WRITE_PROTECT_CLEARED);
+    }
 }
 
 // Change all objects to generation 0
@@ -1394,18 +1403,32 @@ void prepare_immobile_space_for_save(bool verbose)
 
 int immobile_space_handle_wp_violation(void* fault_addr)
 {
-    low_page_index_t fixedobj_page_index = find_fixedobj_page_index(fault_addr);
-    if (fixedobj_page_index < 0)
+    low_page_index_t page = find_fixedobj_page_index(fault_addr);
+    if (page < 0)
       return 0; // unhandled
 
+#if 0
+    if (fixedobj_pages[page].attr.parts.obj_align == SYMBOL_SIZE) { // good
+        // Should only experience sigsegv on symbols and not layouts
+        int byte_offset = (char*)fault_addr - (char*)PTR_ALIGN_DOWN(fault_addr, IMMOBILE_CARD_BYTES);
+        int object_offset = byte_offset / 48;
+        struct symbol*s = (void*)((object_offset * 48) +
+                                  (char*)PTR_ALIGN_DOWN(fault_addr, IMMOBILE_CARD_BYTES));
+        fprintf(stderr, "fault @ %p page %d object %p\n",
+                fault_addr, page, s /*, (char*)VECTOR(s->name)->data*/);
+    } else {
+        /* Needed for tracking down logic errors in software marking.
+         * To reach here you of course must use mprotect */
+        lose("Unexpected fault on fixedobj page @ %p. Dropping to ldb", fault_addr);
+    }
+#endif
     os_protect(PTR_ALIGN_DOWN(fault_addr, IMMOBILE_CARD_BYTES),
-               IMMOBILE_CARD_BYTES, OS_VM_PROT_ALL);
+               IMMOBILE_CARD_BYTES, OS_VM_PROT_READ|OS_VM_PROT_WRITE);
 
     // FIXME: the _CLEARED flag doesn't achieve much if anything.
-    if (!(fixedobj_pages[fixedobj_page_index].attr.parts.flags
-          & (WRITE_PROTECT|WRITE_PROTECT_CLEARED)))
+    if (!(fixedobj_pages[page].attr.parts.flags & (WRITE_PROTECT|WRITE_PROTECT_CLEARED)))
         return 0;
-    SET_WP_FLAG(fixedobj_page_index, WRITE_PROTECT_CLEARED);
+    SET_WP_FLAG(page, WRITE_PROTECT_CLEARED);
 
     return 1;
 }
@@ -2167,3 +2190,18 @@ void* expropriate_memory_from_tlsf(size_t amount)
 #endif
   return start;
 }
+
+void layout_slot_set(lispobj layout, lispobj newval, int slot)
+{
+    struct instance *i = INSTANCE(layout);
+    low_page_index_t page = find_fixedobj_page_index(i);
+    SET_WP_FLAG(page, WRITE_PROTECT_CLEARED);
+    i->slots[slot] = newval;
+}
+lispobj layout_slot_cas(lispobj layout, lispobj old, lispobj new, int slot)
+{
+    struct instance *i = INSTANCE(layout);
+    low_page_index_t page = find_fixedobj_page_index(i);
+    SET_WP_FLAG(page, WRITE_PROTECT_CLEARED);
+    return __sync_val_compare_and_swap(&i->slots[slot], old, new);
+}

tests/immobile-space.impure.lisp

@@ -12,7 +12,14 @@
 ;;; the second one was more likely to crash
 (dotimes (i 1000 (gc)) (alloc-layoutless-instances))
 
-(defstruct trythis a)
+;;; This test creates a TRYTHIS instance on a page of layouts. It is no longer legal
+;;; to set slots of instances of layout pages without going through the GC store barrier.
+;;; Therefore define a setter that calls %LAYOUT-SLOT-SET.
+;;; And honestly I don't know what this test is actually testing.
+(defstruct trythis (%a nil :read-only t))
+(defun trythis-a (instance) (trythis-%a instance))
+(defun (setf trythis-a) (newval instance)
+  (sb-kernel:%layout-slot-set (the trythis instance) 0 newval))
 
 ;;; Assign a bitmap that is not the special case for "all tagged"
 ;;; but does correctly indicate 1 tagged slot.