Update of /cvsroot/sbcl/sbcl/src/code
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv23904/src/code
Modified Files:
array.lisp defboot.lisp
Log Message:
1.0.28.33: minor post-DEFGLOBAL cleanups
* Call array-accessor dispatch tables %%foo%% instead of **foo** to
warn off the unwary.
* Set their size to (1+ widetag-mask) -- this should not really matter
since we check for other-pointer-lowtag before stripping the widetag,
as widetag are always immediate objects, so the low bit is zero.
...but this is more obviously correct, and costs us, what 4 words
of storage.
* Mark one FIXME/KLUDGE more, since people have been so busy getting
rid of them...
* Restore the imperative tone in DEFVAR docstring.
* Oops, left one FLUSHABLE too many in last commit.
Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/array.lisp,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -d -r1.87 -r1.88
--- array.lisp 8 May 2009 19:08:07 -0000 1.87
+++ array.lisp 9 May 2009 09:27:07 -0000 1.88
@@ -328,17 +328,17 @@
;;; vectors or not simple.
(macrolet ((def (name table-name)
`(progn
- (defglobal ,table-name (make-array ,sb!vm:widetag-mask))
+ (defglobal ,table-name (make-array ,(1+ sb!vm:widetag-mask)))
(defmacro ,name (array-var)
`(the function
(let ((tag 0))
(when (sb!vm::%other-pointer-p ,array-var)
(setf tag (%other-pointer-widetag ,array-var)))
(svref ,',table-name tag)))))))
- (def !find-data-vector-setter **data-vector-setters**)
- (def !find-data-vector-setter/check-bounds **data-vector-setters/check-bounds**)
- (def !find-data-vector-reffer **data-vector-reffers**)
- (def !find-data-vector-reffer/check-bounds **data-vector-reffers/check-bounds**))
+ (def !find-data-vector-setter %%data-vector-setters%%)
+ (def !find-data-vector-setter/check-bounds %%data-vector-setters/check-bounds%%)
+ (def !find-data-vector-reffer %%data-vector-reffers%%)
+ (def !find-data-vector-reffer/check-bounds %%data-vector-reffers/check-bounds%%))
(macrolet ((%ref (accessor-getter extra-params)
`(funcall (,accessor-getter array) array index ,@extra-params))
@@ -428,7 +428,10 @@
new-value)))
(define-reffers (symbol deffer check-form slow-path)
`(progn
- (setf ,symbol (make-array sb!vm::widetag-mask
+ ;; FIXME/KLUDGE: can't just FILL here, because genesis doesn't
+ ;; preserve the binding, so re-initiaize as NS doesn't have
+ ;; the energy to figure out to change that right now.
+ (setf ,symbol (make-array (1+ sb!vm::widetag-mask)
:initial-element #'hairy-ref-error))
,@(loop for widetag in '(sb!vm:complex-vector-widetag
sb!vm:complex-vector-nil-widetag
@@ -443,16 +446,16 @@
collect `(setf (svref ,symbol ,widetag)
(,deffer ,saetp ,check-form))))))
(defun !hairy-data-vector-reffer-init ()
- (define-reffers **data-vector-reffers** define-reffer
+ (define-reffers %%data-vector-reffers%% define-reffer
(progn)
#'slow-hairy-data-vector-ref)
- (define-reffers **data-vector-setters** define-setter
+ (define-reffers %%data-vector-setters%% define-setter
(progn)
#'slow-hairy-data-vector-set)
- (define-reffers **data-vector-reffers/check-bounds** define-reffer
+ (define-reffers %%data-vector-reffers/check-bounds%% define-reffer
(%check-bound vector (length vector))
#'slow-hairy-data-vector-ref/check-bounds)
- (define-reffers **data-vector-setters/check-bounds** define-setter
+ (define-reffers %%data-vector-setters/check-bounds%% define-setter
(%check-bound vector (length vector))
#'slow-hairy-data-vector-set/check-bounds)))
Index: defboot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defboot.lisp,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -d -r1.67 -r1.68
--- defboot.lisp 8 May 2009 19:08:07 -0000 1.67
+++ defboot.lisp 9 May 2009 09:27:07 -0000 1.68
@@ -249,7 +249,7 @@
(defmacro-mundanely defvar (var &optional (val nil valp) (doc nil docp))
#!+sb-doc
- "Defines a special variable at top level. Declare the variable
+ "Define a special variable at top level. Declare the variable
SPECIAL and, optionally, initialize it. If the variable already has a
value, the old value is not clobbered. The third argument is an optional
documentation string for the variable."
|