Menu
▾
▴
[Sbcl-commits] master: no more kludge-nondeterministic-catch-block-size
|
From: Christophe R. <cr...@us...> - 2014-05-28 08:14:11
|
The branch "master" has been updated in SBCL:
via e156d2e3fde15b6b2f58e42eea876ea315ebac4a (commit)
from 7dfdf1224921ab0696e95702c1cdf08203c1bf78 (commit)
- Log -----------------------------------------------------------------
commit e156d2e3fde15b6b2f58e42eea876ea315ebac4a
Author: Christophe Rhodes <cs...@ca...>
Date: Fri May 23 11:20:27 2014 +0100
no more kludge-nondeterministic-catch-block-size
It turns out that the only reason for delaying objdef so late in
the build was the need to inform the compiler's info database
about functions to access slots. To resolve the ordering issues,
delay all the forms relating to the slots to the same position in
the build (with a new late-objdef source file) but execute all the
forms relating to specials, constants and primitive objects
themselves early.
This is probably the longest-standing SBCL issue, being logged in
the code by WHN 1999-01-31. It's nice to fix it before we run out
of architectures to port to.
---
build-order.lisp-expr | 3 +-
src/compiler/alpha/vm.lisp | 5 +-
src/compiler/arm/vm.lisp | 103 ++++++++++++++++-----------------
src/compiler/generic/late-objdef.lisp | 23 +++++++
src/compiler/generic/objdef.lisp | 11 ----
src/compiler/generic/vm-macs.lisp | 6 ++-
src/compiler/hppa/vm.lisp | 5 +-
src/compiler/mips/vm.lisp | 4 +-
src/compiler/ppc/vm.lisp | 5 +-
src/compiler/sparc/vm.lisp | 9 +---
src/compiler/x86-64/vm.lisp | 23 +-------
src/compiler/x86/vm.lisp | 24 +-------
12 files changed, 87 insertions(+), 134 deletions(-)
diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 3905b83..a8133e8 100644
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -316,6 +316,7 @@
("src/compiler/macros")
("src/compiler/generic/vm-macs")
+ ("src/compiler/generic/objdef")
;; needed by "compiler/vop"
("src/compiler/sset")
@@ -460,7 +461,7 @@
("src/compiler/fndb")
("src/compiler/generic/vm-fndb")
- ("src/compiler/generic/objdef")
+ ("src/compiler/generic/late-objdef")
("src/compiler/generic/interr")
diff --git a/src/compiler/alpha/vm.lisp b/src/compiler/alpha/vm.lisp
index 0330eec..3a2de07 100644
--- a/src/compiler/alpha/vm.lisp
+++ b/src/compiler/alpha/vm.lisp
@@ -117,8 +117,6 @@
((null classes)
(nreverse forms))))
-(def!constant kludge-nondeterministic-catch-block-size 6)
-
(!define-storage-classes
;; non-immediate constants in the constant pool
@@ -243,8 +241,7 @@
:alternate-scs (complex-double-stack))
;; A catch or unwind block.
- (catch-block control-stack
- :element-size kludge-nondeterministic-catch-block-size))
+ (catch-block control-stack :element-size catch-block-size))
;;; Make some random tns for important registers.
(macrolet ((defregtn (name sc)
diff --git a/src/compiler/arm/vm.lisp b/src/compiler/arm/vm.lisp
index 4fd6040..5f12dcd 100644
--- a/src/compiler/arm/vm.lisp
+++ b/src/compiler/arm/vm.lisp
@@ -99,15 +99,13 @@
((null classes)
(nreverse forms))))
-(def!constant kludge-nondeterministic-catch-block-size 6)
-
(define-storage-classes
- ;; Non-immediate contstants in the constant pool
- (constant constant)
+ ;; Non-immediate contstants in the constant pool
+ (constant constant)
- ;; NULL is in a register.
- (null immediate-constant)
+ ;; NULL is in a register.
+ (null immediate-constant)
;; Anything else that can be an immediate.
(immediate immediate-constant)
@@ -134,17 +132,17 @@
;; Pointer descriptor objects. Must be seen by GC.
(descriptor-reg registers
- :locations #.descriptor-regs
- :constant-scs (constant null immediate)
- :save-p t
- :alternate-scs (control-stack))
+ :locations #.descriptor-regs
+ :constant-scs (constant null immediate)
+ :save-p t
+ :alternate-scs (control-stack))
;; The non-descriptor stacks.
- (signed-stack non-descriptor-stack) ; (signed-byte 32)
- (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
+ (signed-stack non-descriptor-stack) ; (signed-byte 32)
+ (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
(character-stack non-descriptor-stack) ; non-descriptor characters.
- (sap-stack non-descriptor-stack) ; System area pointers.
- (single-stack non-descriptor-stack) ; single-floats
+ (sap-stack non-descriptor-stack) ; System area pointers.
+ (single-stack non-descriptor-stack) ; single-floats
(double-stack non-descriptor-stack
:element-size 2 :alignment 2) ; double floats.
(complex-single-stack non-descriptor-stack :element-size 2)
@@ -154,72 +152,71 @@
;; Non-Descriptor characters
(character-reg registers
- :locations #.non-descriptor-regs
- :constant-scs (immediate)
- :save-p t
- :alternate-scs (character-stack))
+ :locations #.non-descriptor-regs
+ :constant-scs (immediate)
+ :save-p t
+ :alternate-scs (character-stack))
;; Non-Descriptor SAP's (arbitrary pointers into address space)
(sap-reg registers
- :locations #.non-descriptor-regs
- :constant-scs (immediate)
- :save-p t
- :alternate-scs (sap-stack))
+ :locations #.non-descriptor-regs
+ :constant-scs (immediate)
+ :save-p t
+ :alternate-scs (sap-stack))
;; Non-Descriptor (signed or unsigned) numbers.
(signed-reg registers
- :locations #.non-descriptor-regs
- :constant-scs (immediate)
- :save-p t
- :alternate-scs (signed-stack))
+ :locations #.non-descriptor-regs
+ :constant-scs (immediate)
+ :save-p t
+ :alternate-scs (signed-stack))
(unsigned-reg registers
- :locations #.non-descriptor-regs
- :constant-scs (immediate)
- :save-p t
- :alternate-scs (unsigned-stack))
+ :locations #.non-descriptor-regs
+ :constant-scs (immediate)
+ :save-p t
+ :alternate-scs (unsigned-stack))
;; Random objects that must not be seen by GC. Used only as temporaries.
(non-descriptor-reg registers
- :locations #.non-descriptor-regs)
+ :locations #.non-descriptor-regs)
;; Pointers to the interior of objects. Used only as a temporary.
(interior-reg registers
- :locations (#.lr-offset))
+ :locations (#.lr-offset))
;; **** Things that can go in the floating point registers.
;; Non-Descriptor single-floats.
(single-reg float-registers
- :locations #.(loop for i below 32 collect i)
- :constant-scs ()
- :save-p t
- :alternate-scs (single-stack))
+ :locations #.(loop for i below 32 collect i)
+ :constant-scs ()
+ :save-p t
+ :alternate-scs (single-stack))
;; Non-Descriptor double-floats.
(double-reg float-registers
- :locations #.(loop for i below 32 by 2 collect i)
- :element-size 2
- :constant-scs ()
- :save-p t
- :alternate-scs (double-stack))
+ :locations #.(loop for i below 32 by 2 collect i)
+ :element-size 2
+ :constant-scs ()
+ :save-p t
+ :alternate-scs (double-stack))
(complex-single-reg float-registers
- :locations #.(loop for i from 0 below 32 by 2 collect i)
- :element-size 2
- :constant-scs ()
- :save-p t
- :alternate-scs (complex-single-stack))
+ :locations #.(loop for i from 0 below 32 by 2 collect i)
+ :element-size 2
+ :constant-scs ()
+ :save-p t
+ :alternate-scs (complex-single-stack))
(complex-double-reg float-registers
- :locations #.(loop for i from 0 below 32 by 4 collect i)
- :element-size 4
- :constant-scs ()
- :save-p t
- :alternate-scs (complex-double-stack))
+ :locations #.(loop for i from 0 below 32 by 4 collect i)
+ :element-size 4
+ :constant-scs ()
+ :save-p t
+ :alternate-scs (complex-double-stack))
;; A catch or unwind block.
- (catch-block control-stack
- :element-size kludge-nondeterministic-catch-block-size))
+ (catch-block control-stack :element-size catch-block-size))
;;;; Make some random tns for important registers.
diff --git a/src/compiler/generic/late-objdef.lisp b/src/compiler/generic/late-objdef.lisp
new file mode 100644
index 0000000..2e91817
--- /dev/null
+++ b/src/compiler/generic/late-objdef.lisp
@@ -0,0 +1,23 @@
+;;;; late machine-independent aspects of the object representation
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!VM")
+
+(macrolet ((frob ()
+ `(progn ,@*!late-primitive-object-forms*)))
+ (frob))
+
+#!+sb-thread
+(dolist (slot (primitive-object-slots
+ (find 'thread *primitive-objects* :key #'primitive-object-name)))
+ (when (slot-special slot)
+ (setf (info :variable :wired-tls (slot-special slot))
+ (ash (slot-offset slot) word-shift))))
diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
index e28e077..0aa22a7 100644
--- a/src/compiler/generic/objdef.lisp
+++ b/src/compiler/generic/objdef.lisp
@@ -309,10 +309,6 @@
#!+(and win32 x86) seh-frame-handler
tag
(previous-catch :c-type #!-alpha "struct catch_block *" #!+alpha "u32"))
-
-;;; (For an explanation of this, see the comments at the definition of
-;;; KLUDGE-NONDETERMINISTIC-CATCH-BLOCK-SIZE.)
-(aver (= kludge-nondeterministic-catch-block-size catch-block-size))
;;;; symbols
@@ -483,10 +479,3 @@
#!+alpha
(padding)
(interrupt-contexts :c-type "os_context_t *" :rest-p t))
-
-#!+sb-thread
-(dolist (slot (primitive-object-slots
- (find 'thread *primitive-objects* :key #'primitive-object-name)))
- (when (slot-special slot)
- (setf (info :variable :wired-tls (slot-special slot))
- (ash (slot-offset slot) word-shift))))
diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp
index e6e227a..56a3432 100644
--- a/src/compiler/generic/vm-macs.lisp
+++ b/src/compiler/generic/vm-macs.lisp
@@ -64,6 +64,8 @@
:key #'primitive-object-name :test #'eq)))
name))
+(defvar *!late-primitive-object-forms* nil)
+
(defmacro define-primitive-object
((name &key lowtag widetag alloc-trans (type t))
&rest slot-specs)
@@ -137,7 +139,9 @@
:variable-length-p variable-length-p))
,@(constants)
,@(specials))
- ,@(forms)))))
+ (setf *!late-primitive-object-forms*
+ (append *!late-primitive-object-forms*
+ ',(forms)))))))
;;;; stuff for defining reffers and setters
diff --git a/src/compiler/hppa/vm.lisp b/src/compiler/hppa/vm.lisp
index 28f1db2..cf06b35 100644
--- a/src/compiler/hppa/vm.lisp
+++ b/src/compiler/hppa/vm.lisp
@@ -112,8 +112,6 @@
((null classes)
(nreverse forms))))
-(def!constant kludge-nondeterministic-catch-block-size 6)
-
(!define-storage-classes
;; Non-immediate constants in the constant pool
@@ -241,8 +239,7 @@
:alternate-scs (complex-double-stack))
;; A catch or unwind block.
- (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)
-
+ (catch-block control-stack :element-size catch-block-size)
;; floating point numbers temporarily stuck in integer registers for c-call
(single-int-carg-reg registers
diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp
index cf90976..9f77ec4 100644
--- a/src/compiler/mips/vm.lisp
+++ b/src/compiler/mips/vm.lisp
@@ -114,8 +114,6 @@
((null classes)
(nreverse forms))))
-(def!constant kludge-nondeterministic-catch-block-size 6)
-
(!define-storage-classes
;; Non-immediate constants in the constant pool
@@ -247,7 +245,7 @@
:alternate-scs (complex-double-stack))
;; A catch or unwind block.
- (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)
+ (catch-block control-stack :element-size catch-block-size)
;; floating point numbers temporarily stuck in integer registers for c-call
(single-int-carg-reg registers
diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp
index 673cef9..96ddb83 100644
--- a/src/compiler/ppc/vm.lisp
+++ b/src/compiler/ppc/vm.lisp
@@ -118,8 +118,6 @@
((null classes)
(nreverse forms))))
-(def!constant kludge-nondeterministic-catch-block-size 6)
-
(define-storage-classes
;; Non-immediate contstants in the constant pool
@@ -243,8 +241,7 @@
:alternate-scs (complex-double-stack))
;; A catch or unwind block.
- (catch-block control-stack
- :element-size kludge-nondeterministic-catch-block-size))
+ (catch-block control-stack :element-size catch-block-size))
;;;; Make some random tns for important registers.
diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp
index f50443b..babb5cc 100644
--- a/src/compiler/sparc/vm.lisp
+++ b/src/compiler/sparc/vm.lisp
@@ -124,13 +124,6 @@
((null classes)
(nreverse forms))))
-;;; see comment in ../x86/vm.lisp. The value of 7 was taken from
-;;; vm:catch-block-size in a cmucl that I happened to have around
-;;; and seems to be working so far -dan
-;;;
-;;; arbitrarily taken for alpha, too. - Christophe
-(def!constant kludge-nondeterministic-catch-block-size 6)
-
(!define-storage-classes
;; non-immediate constants in the constant pool
@@ -286,7 +279,7 @@
;; A catch or unwind block.
- (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size))
+ (catch-block control-stack :element-size catch-block-size))
;;;; Make some miscellaneous TNs for important registers.
(macrolet ((defregtn (name sc)
diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index 71fff66..a2a343b 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -210,27 +210,6 @@
`(progn
,@(forms))))
-;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size
-;;; of CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until
-;;; later in the build process, and the calculation is entangled with
-;;; code which has lots of predependencies, including dependencies on
-;;; the prior call of DEFINE-STORAGE-CLASS. The proper way to
-;;; unscramble this would be to untangle the code, so that the code
-;;; which calculates the size of CATCH-BLOCK can be separated from the
-;;; other lots-of-dependencies code, so that the code which calculates
-;;; the size of CATCH-BLOCK can be executed early, so that this value
-;;; is known properly at this point in compilation. However, that
-;;; would be a lot of editing of code that I (WHN 19990131) can't test
-;;; until the project is complete. So instead, I set the correct value
-;;; by hand here (a sort of nondeterministic guess of the right
-;;; answer:-) and add an assertion later, after the value is
-;;; calculated, that the original guess was correct.
-;;;
-;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
-;;; has my gratitude.) (FIXME: Maybe this should be me..)
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (def!constant kludge-nondeterministic-catch-block-size 5))
-
(!define-storage-classes
;; non-immediate constants in the constant pool
@@ -411,7 +390,7 @@
:alternate-scs (single-sse-stack))
;; a catch or unwind block
- (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
+ (catch-block stack :element-size catch-block-size))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *byte-sc-names*
diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp
index 7cc96e8..7fc839f 100644
--- a/src/compiler/x86/vm.lisp
+++ b/src/compiler/x86/vm.lisp
@@ -141,28 +141,6 @@
`(progn
,@(forms))))
-;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size
-;;; of CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until
-;;; later in the build process, and the calculation is entangled with
-;;; code which has lots of predependencies, including dependencies on
-;;; the prior call of DEFINE-STORAGE-CLASS. The proper way to
-;;; unscramble this would be to untangle the code, so that the code
-;;; which calculates the size of CATCH-BLOCK can be separated from the
-;;; other lots-of-dependencies code, so that the code which calculates
-;;; the size of CATCH-BLOCK can be executed early, so that this value
-;;; is known properly at this point in compilation. However, that
-;;; would be a lot of editing of code that I (WHN 19990131) can't test
-;;; until the project is complete. So instead, I set the correct value
-;;; by hand here (a sort of nondeterministic guess of the right
-;;; answer:-) and add an assertion later, after the value is
-;;; calculated, that the original guess was correct.
-;;;
-;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
-;;; has my gratitude.) (FIXME: Maybe this should be me..)
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (def!constant kludge-nondeterministic-catch-block-size
- #!-win32 5 #!+win32 7))
-
(!define-storage-classes
;; non-immediate constants in the constant pool
@@ -325,7 +303,7 @@
:alternate-scs (complex-long-stack))
;; a catch or unwind block
- (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
+ (catch-block stack :element-size catch-block-size))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *byte-sc-names*
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|