X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Flow.lisp;h=0d06027aba7c5b1cb1d3e7fd07a9768ffccb0a2b;hb=54da325f13fb41669869aea688ae195426c0e231;hp=53c744dc19a019c224beae9916e451b391a24384;hpb=96aa790ea1d70810e862665c3c8be4ce405a964c;p=sbcl.git diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index 53c744d..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 ;;;; @@ -119,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 @@ -178,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).