From d2054d96f0c8200decf8b6b8560d754d3c541cd7 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Tue, 16 Aug 2005 17:09:49 +0000 Subject: [PATCH] 0.9.3.60: * Bump +FASL-FILE-VERSION+. * Add a couple of useful restarts for ENSURE-DIRECTORIES-EXIST. (patch from sbcl-devel "Proposed patch to ensure-directories-exist" 2005-06-06 by Alan Shields) * Fix empty hash slot marker on 64-bit systems. (patch from sbcl-devel "Bug in hash tables on 64-bit systems and fix" 2005-08-11 by Lutz Euler) * Clear the signal mask in the child process after run-program has forked. (patch from sbcl-devel "Blocked signals and run-program" 2005-08-14 by Benedikt Schmidt). --- src/code/early-fasl.lisp | 3 ++- src/code/filesys.lisp | 14 ++++++++++---- src/code/hash-table.lisp | 14 ++++++++++++-- src/code/target-hash-table.lisp | 4 ---- src/compiler/generic/genesis.lisp | 9 +++++++++ src/runtime/gencgc.c | 3 ++- src/runtime/run-program.c | 6 ++++++ tests/hash.pure.lisp | 21 +++++++++++++++++++++ version.lisp-expr | 2 +- 9 files changed, 63 insertions(+), 13 deletions(-) create mode 100644 tests/hash.pure.lisp diff --git a/src/code/early-fasl.lisp b/src/code/early-fasl.lisp index a5aff3d..6d40380 100644 --- a/src/code/early-fasl.lisp +++ b/src/code/early-fasl.lisp @@ -76,7 +76,7 @@ ;;; versions which break binary compatibility. But it certainly should ;;; be incremented for release versions which break binary ;;; compatibility. -(def!constant +fasl-file-version+ 57) +(def!constant +fasl-file-version+ 58) ;;; (record of versions before 2003 deleted in 2003-04-26/0.pre8.107 or so) ;;; 38: (2003-01-05) changed names of internal SORT machinery ;;; 39: (2003-02-20) in 0.7.12.1 a slot was added to @@ -122,6 +122,7 @@ ;;; 56: (2005-05-22) Something between 0.9.0.1 and 0.9.0.14. My money is ;;; on 0.9.0.6 (MORE CASE CONSISTENCY). ;;; 57: (2005-06-12) Raw slot rearrangement in 0.9.1.38 +;;; 58: (2005-08-16) Multiple incompatible changes between 0.9.3 and 0.9.3.60 ;;; the conventional file extension for our fasl files (declaim (type simple-string *fasl-file-type*)) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index f00eace..f916cce 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -1049,10 +1049,16 @@ namestring)) (sb!unix:unix-mkdir namestring mode) (unless (probe-file namestring) - (error 'simple-file-error - :pathname pathspec - :format-control "can't create directory ~A" - :format-arguments (list namestring))) + (restart-case (error 'simple-file-error + :pathname pathspec + :format-control "can't create directory ~A" + :format-arguments (list namestring)) + (retry () + :report "Retry directory creation." + (ensure-directories-exist pathspec :verbose verbose :mode mode)) + (continue () + :report "Continue as if directory creation was successful." + nil))) (setf created-p t))))) (values pathname created-p)))) diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index d8f5e13..b17a17a 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -66,10 +66,20 @@ ;; This table parallels the KV table, and can be used to store the ;; hash associated with the key, saving recalculation. Could be ;; useful for EQL, and EQUAL hash tables. This table is not needed - ;; for EQ hash tables, and when present the value of #x80000000 - ;; represents EQ-based hashing on the respective key. + ;; for EQ hash tables, and when present the value of + ;; +MAGIC-HASH-VECTOR-VALUE+ represents EQ-based hashing on the + ;; respective key. (hash-vector nil :type (or null (simple-array (unsigned-byte #.sb!vm:n-word-bits) (*))))) + +;; as explained by pmai on openprojects #lisp IRC 2002-07-30: #x80000000 +;; is bigger than any possible nonEQ hash value, and thus indicates an +;; empty slot; and EQ hash tables don't use HASH-TABLE-HASH-VECTOR. +;; The previous sentence was written when SBCL was 32-bit only. The value +;; now depends on the word size. It is propagated to C in genesis because +;; the generational garbage collector needs to know it. +(defconstant +magic-hash-vector-value+ (ash 1 (1- sb!vm:n-word-bits))) + (defmacro-mundanely with-hash-table-iterator ((function hash-table) &body body) #!+sb-doc diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index 67ef677..138d39e 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -82,10 +82,6 @@ (defconstant +min-hash-table-size+ 16) (defconstant +min-hash-table-rehash-threshold+ (float 1/16 1.0)) -;; as explained by pmai on openprojects #lisp IRC 2002-07-30: #x80000000 -;; is bigger than any possible nonEQ hash value, and thus indicates an -;; empty slot; and EQ hash tables don't use HASH-TABLE-HASH-VECTOR -(defconstant +magic-hash-vector-value+ #x80000000) (defun make-hash-table (&key (test 'eql) (size +min-hash-table-size+) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index fa3c971..fc8fed2 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -2699,6 +2699,15 @@ core and return a descriptor to it." (symbol-value c) nil) constants)) + ;; One more symbol that doesn't fit into the code above. + (flet ((translate (name) + (delete #\+ (substitute #\_ #\- name)))) + (let ((c 'sb!impl::+magic-hash-vector-value+)) + (push (list (translate (symbol-name c)) + 9 + (symbol-value c) + nil) + constants))) (setf constants (sort constants diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index e6ed1e2..76d93aa 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -1864,7 +1864,8 @@ scav_vector(lispobj *where, lispobj object) #endif if ((old_index != new_index) && - ((!hash_vector) || (hash_vector[i] == 0x80000000)) && + ((!hash_vector) || + (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) && ((new_key != empty_symbol) || (kv_vector[2*i] != empty_symbol))) { diff --git a/src/runtime/run-program.c b/src/runtime/run-program.c index 7052fe5..64e4797 100644 --- a/src/runtime/run-program.c +++ b/src/runtime/run-program.c @@ -16,6 +16,7 @@ #include #include #include +#include #include #include #include @@ -54,6 +55,7 @@ int spawn(char *program, char *argv[], char *envp[], char *pty_name, { int pid = fork(); int fd; + sigset_t sset; if (pid != 0) return pid; @@ -67,6 +69,10 @@ int spawn(char *program, char *argv[], char *envp[], char *pty_name, setpgrp(0, getpid()); #endif + /* unblock signals */ + sigemptyset(&sset); + sigprocmask(SIG_SETMASK, &sset, NULL); + /* If we are supposed to be part of some other pty, go for it. */ if (pty_name) { #if !defined(hpux) && !defined(SVR4) diff --git a/tests/hash.pure.lisp b/tests/hash.pure.lisp new file mode 100644 index 0000000..afbf227 --- /dev/null +++ b/tests/hash.pure.lisp @@ -0,0 +1,21 @@ +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; While most of SBCL is derived from the CMU CL system, the test +;;;; files (like this one) were written from scratch after the fork +;;;; from CMU CL. +;;;; +;;;; This software is in the public domain and is provided with +;;;; absolutely no warranty. See the COPYING and CREDITS files for +;;;; more information. + +(in-package :cl-user) + +;;; +MAGIC-HASH-VECTOR-VALUE+ is used to mark empty entries in the slot +;;; HASH-VECTOR of hash tables. It must be a value outside of the range +;;; of SXHASH. The range of SXHASH is the non-negative fixnums. +(assert (not (typep sb-impl::+magic-hash-vector-value+ + '(and fixnum unsigned-byte)))) + +;;; success +(quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index f9a4a07..91d0194 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.3.59" +"0.9.3.60" -- 1.7.10.4