X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdlisp.lisp;h=2639eb635639c32f61b64a411f8e88a017e9e8ac;hb=d40a76606c86722b0aef8179155f9f2840739b72;hp=0f69b49cef70eb9915fce1c2cb76898870ba519b;hpb=d5aafdd8ab6387e12bac187048ed322bc96fb79a;p=sbcl.git diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp index 0f69b49..2639eb6 100644 --- a/src/pcl/dlisp.lisp +++ b/src/pcl/dlisp.lisp @@ -23,11 +23,11 @@ (in-package "SB-PCL") -;;; This file is (almost) functionally equivalent to dlap.lisp, but easier to -;;; read. +;;; This file is (almost) functionally equivalent to dlap.lisp, but +;;; easier to read. -;;; Might generate faster code, too, depending on the compiler and whether an -;;; implementation-specific lap assembler was used. +;;; Might generate faster code, too, depending on the compiler and +;;; whether an implementation-specific lap assembler was used. (defun emit-one-class-reader (class-slot-p) (emit-reader/writer :reader 1 class-slot-p)) @@ -253,15 +253,15 @@ (defun emit-dlap (args metatypes hit miss value-reg &optional slot-regs) (let* ((index -1) - (wrapper-bindings (mapcan #'(lambda (arg mt) - (unless (eq mt t) - (incf index) - `((,(intern (format nil - "WRAPPER-~D" - index) - *pcl-package*) - ,(emit-fetch-wrapper mt arg 'miss - (pop slot-regs)))))) + (wrapper-bindings (mapcan (lambda (arg mt) + (unless (eq mt t) + (incf index) + `((,(intern (format nil + "WRAPPER-~D" + index) + *pcl-package*) + ,(emit-fetch-wrapper + mt arg 'miss (pop slot-regs)))))) args metatypes)) (wrappers (mapcar #'car wrapper-bindings))) (declare (fixnum index)) @@ -341,13 +341,15 @@ (let ((location primary) (next-location 0)) (declare (fixnum location next-location)) (block search - (loop (setq next-location (the fixnum (+ location ,cache-line-size))) + (loop (setq next-location + (the fixnum (+ location ,cache-line-size))) (when (and ,@(mapcar - #'(lambda (wrapper) - `(eq ,wrapper - (cache-vector-ref cache-vector - (setq location - (the fixnum (+ location 1)))))) + (lambda (wrapper) + `(eq ,wrapper + (cache-vector-ref + cache-vector + (setq location + (the fixnum (+ location 1)))))) wrappers)) ,@(when value `((setq location (the fixnum (+ location 1))) @@ -359,8 +361,9 @@ (when (= location primary) (dolist (entry overflow) (let ((entry-wrappers (car entry))) - (when (and ,@(mapcar #'(lambda (wrapper) - `(eq ,wrapper (pop entry-wrappers))) + (when (and ,@(mapcar (lambda (wrapper) + `(eq ,wrapper + (pop entry-wrappers))) wrappers)) ,@(when value `((setq ,value (cdr entry)))) @@ -383,19 +386,20 @@ `(progn ,@(let ((adds 0) (len (length wrappers))) (declare (fixnum adds len)) - (mapcar #'(lambda (wrapper) - `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref - ,wrapper field))) - (declare (fixnum wrapper-cache-no)) - (when (zerop wrapper-cache-no) (go ,miss-label)) - (setq primary (the fixnum (+ primary wrapper-cache-no))) - ,@(progn - (incf adds) - (when (or (zerop (mod adds wrapper-cache-number-adds-ok)) - (eql adds len)) - `((setq primary - ,(let ((form `(logand primary mask))) - `(the fixnum ,form)))))))) + (mapcar (lambda (wrapper) + `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref + ,wrapper field))) + (declare (fixnum wrapper-cache-no)) + (when (zerop wrapper-cache-no) (go ,miss-label)) + (setq primary (the fixnum (+ primary wrapper-cache-no))) + ,@(progn + (incf adds) + (when (or (zerop (mod adds + wrapper-cache-number-adds-ok)) + (eql adds len)) + `((setq primary + ,(let ((form `(logand primary mask))) + `(the fixnum ,form)))))))) wrappers)))) ;;; CMU17 (and SBCL) note: Since STD-INSTANCE-P is weakened in the CMU/SBCL