diff --git a/src/runtime/save.c b/src/runtime/save.c index 83c8948cf..ffc814898 100644 --- a/src/runtime/save.c +++ b/src/runtime/save.c @@ -206,13 +206,10 @@ output_space(FILE *file, int id, lispobj *addr, lispobj *end, printf("writing %lu bytes from the %s space at %p\n", (long unsigned)bytes, names[id], addr); - /* FIXME: it sure would be nice to discover and document the behavior of this function - * with regard to aligning up the byte count as pertains to bytes spanned by a rounded - * up count that were not zeroized and would not have been written had we not rounded. - * That seems quite bogus to operate on bytes that the caller didn't promise were OK - * to be saved out (and didn't contain, say, a password and social security number) */ - data = write_bytes(file, (char *)addr, ALIGN_UP(bytes, os_vm_page_size), - file_offset, core_compression_level); + size_t aligned = ALIGN_UP(bytes, os_vm_page_size); + if (aligned > bytes) + memset((char*)addr + bytes, 0, aligned - bytes); + data = write_bytes(file, (char *)addr, aligned, file_offset, core_compression_level); write_lispobj(data, file); write_lispobj((uword_t)addr, file); diff --git a/tests/input-manifest.lisp-expr b/tests/input-manifest.lisp-expr index bc8cb814b..4ccab45cd 100644 --- a/tests/input-manifest.lisp-expr +++ b/tests/input-manifest.lisp-expr @@ -2,6 +2,7 @@ ;;; is binary its diff view. ;;; Or not. (("alien-struct-by-value.impure.lisp" "tests/alien-struct-by-value.so") + ("alien.impure.lisp" "tests/alien-128.so") ("aprof.impure.lisp" "src/code/aprof.lisp" "src/code/shaketree.lisp") @@ -44,7 +45,6 @@ ("elfcore.test.sh" "src/runtime/shrinkwrap-sbcl") ("exit-hang.impure.lisp" "tests/fcb-threads.so") ("fcb-threads.impure.lisp" "tests/fcb-threads.so") - ("alien.impure.lisp" "tests/alien-128.so") ("fifo-slow.impure.lisp" "contrib/sb-posix.fasl") ("filecompile.impure.lisp" "tests/data/wonky1.lisp" @@ -85,6 +85,8 @@ "../xperfecthash61.lisp-expr") ("redblack.pure.lisp" "tests/bbtree-test-util.lisp" "src/code/redblack.lisp") ("run-program.impure.lisp" "contrib/sb-posix.fasl") + ("save11.test.sh" + "src/code/repack-xref.lisp" "tools-for-build/corefile.lisp" "tools-for-build/editcore.lisp") ("sb-aclrepl.impure.lisp" "contrib/sb-aclrepl.fasl" "../contrib/sb-aclrepl/tests.lisp") ("sb-bsd-sockets.impure.lisp" "contrib/sb-bsd-sockets.fasl" "contrib/sb-posix.fasl" diff --git a/tests/save10.test.sh b/tests/save10.test.sh index 9ac524416..19c2cf4dc 100644 --- a/tests/save10.test.sh +++ b/tests/save10.test.sh @@ -1,6 +1,5 @@ . ./subr.sh -this_file=`pwd`/save10.test.sh use_test_subdirectory tmpcore=$TEST_FILESTEM.core diff --git a/tests/save11.test.sh b/tests/save11.test.sh new file mode 100644 index 000000000..9ec6d33ba --- /dev/null +++ b/tests/save11.test.sh @@ -0,0 +1,20 @@ +. ./subr.sh + +create_test_subdirectory + +tmpfasl=$TEST_DIRECTORY/$TEST_FILESTEM.fasl +tmpcore=$TEST_DIRECTORY/$TEST_FILESTEM.core +set -e + +run_sbcl < result 0) 1 $EXIT_TEST_WIN))) +EOF + +exit $? diff --git a/tools-for-build/editcore.lisp b/tools-for-build/editcore.lisp index 106832b26..1064e50ad 100644 --- a/tools-for-build/editcore.lisp +++ b/tools-for-build/editcore.lisp @@ -67,7 +67,7 @@ id addr data-page page-adjust nwords) (defmethod print-object ((self core-space) stream) (print-unreadable-object (self stream :type t) - (format stream "~d" (space-id self)))) + (format stream "~d @ #x~x" (space-id self) (space-addr self)))) (defun space-size (space) (* (space-nwords space) n-word-bytes)) (defun space-end (space) (+ (space-addr space) (space-size space))) (defun space-nbytes-aligned (space) @@ -2140,3 +2140,34 @@ (space-addr space) (space-nwords space))) (cdr spacemap)) core-header parsed-header spacemap output))))))) + +;;; A diagnostic function to discover whether final GC left junk that should not be visible +(defun scan-for-end-of-page-garbage (corefile-name) + (with-open-file (input corefile-name :element-type '(unsigned-byte 8)) + (let* ((core-header (make-array +backend-page-bytes+ :element-type '(unsigned-byte 8))) + (core-offset (read-core-header input core-header t)) + (parsed-header (parse-core-header input core-header core-offset)) + (parsed-spacelist (core-header-space-list parsed-header)) + (words-per-page (/ +backend-page-bytes+ n-word-bytes)) + (total-bad 0)) + (with-mapped-core (sap core-offset (core-header-total-npages parsed-header) input) + (let ((spacemap (cons sap (sort (copy-list parsed-spacelist) #'> :key #'space-addr)))) + (dolist (space parsed-spacelist) + (multiple-value-bind (npages deficit) (ceiling (space-nwords space) words-per-page) + (unless (zerop deficit) + ;; words on the last page above the end of the used range should be 0. + (let* ((mapped-addr (int-sap (translate-ptr (space-addr space) spacemap))) + (range-end (* npages +backend-page-bytes+)) + (range-begin (+ range-end (* deficit n-word-bytes))) ; deficit is negative + (this-space-bad 0)) + (loop for byte-offset from range-begin below range-end by n-word-bytes + when (/= (sap-ref-word mapped-addr byte-offset) 0) + do (incf this-space-bad) + (format t "~x = ~x~%" + (+ (space-addr space) byte-offset) + (sap-ref-word mapped-addr byte-offset))) + (incf total-bad this-space-bad) + (format t "~x is at ~x, ~D pages, remainder ~D, paddr ~X..~X, bad: ~D~%" + (space-addr space) mapped-addr npages deficit + range-begin range-end this-space-bad))))))) + total-bad)))