X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Flow.lisp;h=0d06027aba7c5b1cb1d3e7fd07a9768ffccb0a2b;hb=54da325f13fb41669869aea688ae195426c0e231;hp=2a333d0d68cf47d25edd1401a40f89002d8b467d;hpb=0223f43d5f199914ebceff12b6f4c60448369edd;p=sbcl.git diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 2a333d0..0d06027 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -39,7 +39,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *optimize-speed* - '(optimize (speed 3) (safety 0))) + '(optimize (speed 3) (safety 0) (sb-ext:inhibit-warnings 3))) ) ; EVAL-WHEN (defmacro dotimes-fixnum ((var count &optional (result nil)) &body body) @@ -51,22 +51,20 @@ (defun random-fixnum () (random (1+ most-positive-fixnum))) -(defconstant n-fixnum-bits #.(integer-length most-positive-fixnum)) - ;;; Lambda which executes its body (or not) randomly. Used to drop ;;; random cache entries. (defmacro randomly-punting-lambda (lambda-list &body body) (with-unique-names (drops drop-pos) `(let ((,drops (random-fixnum)) - (,drop-pos n-fixnum-bits)) + (,drop-pos sb-vm:n-fixnum-bits)) (declare (fixnum ,drops) - (type (integer 0 #.n-fixnum-bits) ,drop-pos)) + (type (integer 0 #.sb-vm:n-fixnum-bits) ,drop-pos)) (lambda ,lambda-list (when (logbitp (the unsigned-byte (decf ,drop-pos)) ,drops) (locally ,@body)) (when (zerop ,drop-pos) (setf ,drops (random-fixnum) - ,drop-pos n-fixnum-bits)))))) + ,drop-pos sb-vm:n-fixnum-bits)))))) ;;;; early definition of WRAPPER ;;;; @@ -92,8 +90,7 @@ (for-std-class-p t)) (:constructor make-wrapper-internal) (:copier nil)) - (instance-slots-layout nil :type list) - (class-slots nil :type list)) + (slots () :type list)) #-sb-fluid (declaim (sb-ext:freeze-type wrapper)) ;;;; PCL's view of funcallable instances @@ -120,8 +117,14 @@ (import 'sb-kernel:funcallable-instance-p) (defun set-funcallable-instance-function (fin new-value) - (declare (type function new-value)) - (aver (funcallable-instance-p fin)) + (declare (type function new-value) + ;; KLUDGE: it might be nice to restrict + ;; SB-MOP:SET-FUNCALLABLE-INSTANCE-FUNCTION to operate only + ;; on generalized instances of + ;; SB-MOP:FUNCALLABLE-STANDARD-OBJECT; at present, even + ;; PCL's internal use of SET-FUNCALLABLE-INSTANCE-FUNCTION + ;; doesn't obey this restriction. + (type funcallable-instance fin)) (setf (funcallable-instance-fun fin) new-value)) ;;; FIXME: these macros should just go away. It's not clear whether @@ -179,7 +182,7 @@ ;;; otherwise dealing with STANDARD-INSTANCE-ACCESS becomes harder ;;; -- and slower -- than it needs to be. (defconstant +slot-unbound+ '..slot-unbound.. - "SBCL specific extentions to MOP: if this value is read from an + "SBCL specific extensions to MOP: if this value is read from an instance using STANDARD-INSTANCE-ACCESS, the slot is unbound. Similarly, an :INSTANCE allocated slot can be made unbound by assigning this to it using (SETF STANDARD-INSTANCE-ACCESS).