From ba8910dec886e02345448c01edfa728dbb7fbcae Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Sun, 10 Apr 2016 00:24:21 -0400 Subject: [PATCH] Fix genesis bug that manifested in scav_vector(). scav_vector(), when it scavenged a vector backing a hash-table, invoked scavenge() on a hash-table using an 'n_words' value computed from sizeof(hash_table), not the sizetab[] function on the table. This was a right only by accident. If the C struct was slightly different, the n_words computation might disagree with the number of words that instance scavenging actually scanned based on the instance header. This is because write-structure-object would omit a raw slot from C unless followed by a non-raw slot; and the compensation for dd-length worked only if no slots had been omitted. So by messing with slot order, you could violate the assertion at line 168 of gc-common that scavenging didn't go past the expected end pointer calculated from n_words. --- src/compiler/generic/genesis.lisp | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index 8e9c547ca..2c9ea4aca 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -3438,7 +3438,7 @@ core and return a descriptor to it." (c-name (string-downcase (string designator))))) (format t "#ifndef LANGUAGE_ASSEMBLY~2%") (format t "struct ~A {~%" (cstring (dd-name dd))) - (format t " lispobj header;~%") + (format t " lispobj header; // = word_0_~%") ;; "self layout" slots are named '_layout' instead of 'layout' so that ;; classoid's expressly declared layout isn't renamed as a special-case. (format t " lispobj _layout;~%") @@ -3456,17 +3456,18 @@ core and return a descriptor to it." (dotimes (n (dd-raw-length dd)) (format t " lispobj raw~D;~%" (- (dd-raw-length dd) n 1)))) #!+interleaved-raw-slots - (let ((index 1)) + (let ((names ; round dd-length to odd so that total + header is even + (coerce (loop for i from 1 below (logior (dd-length dd) 1) + collect (list (format nil "word_~D_" (1+ i)))) + 'vector))) (dolist (slot (dd-slots dd)) - (cond ((eq t (dsd-raw-type slot)) - (loop while (< index (dsd-index slot)) - do - (format t " lispobj raw_slot_padding~A;~%" index) - (incf index)) - (format t " lispobj ~A;~%" (cstring (dsd-name slot))) - (incf index)))) - (unless (oddp (dd-length dd)) - (format t " lispobj end_padding;~%"))) + (let ((cell (aref names (1- (dsd-index slot)))) + (name (cstring (dsd-name slot)))) + (if (eq (dsd-raw-type slot) t) + (rplaca cell name) + (rplacd cell name)))) + (loop for slot across names + do (format t " lispobj ~A;~@[ //~A~]~%" (car slot) (cdr slot)))) (format t "};~2%") (format t "#endif /* LANGUAGE_ASSEMBLY */~2%"))) -- 2.11.4.GIT