Commit 1e9966d5 authored by Alexey Dejneka's avatar Alexey Dejneka
Browse files

0.8.4.15:

        * Change modularization of ASH
          ... add per-function cutter;
          ... s/ash-left-constant-modxx/ash-left-modxx/;
          ... put DEFKNOWN and modular function optimizer for
              ASH-LEFT-MODxx to src/compiler/generic/sm-tran.lisp;
          ... compile src/compiler/generic/vm-tran.lisp before
              src/compiler/target/arith.lisp (in fact, immediately
              after src/compiler/srctran.lisp);
        * strength reducer for * wraps LOGAND around the whole form.
parent d3c56c29
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
@@ -474,6 +474,7 @@
 ("src/compiler/float-tran")
 ("src/compiler/saptran")
 ("src/compiler/srctran")
 ("src/compiler/generic/vm-tran")
 ("src/compiler/locall")
 ("src/compiler/dfo")
 ("src/compiler/checkgen")
@@ -580,7 +581,6 @@

 ("src/compiler/copyprop")
 ("src/compiler/represent")
 ("src/compiler/generic/vm-tran")
 ("src/compiler/pack")
 ("src/compiler/codegen")
 ("src/compiler/debug")
+2 −2
Original line number Diff line number Diff line
@@ -146,8 +146,8 @@
  (values array start end 0))

#!-alpha
(defun sb!vm::ash-left-constant-mod32 (integer amount)
(defun sb!vm::ash-left-mod32 (integer amount)
  (ldb (byte 32 0) (ash integer amount)))
#!+alpha
(defun sb!vm::ash-left-constant-mod64 (integer amount)
(defun sb!vm::ash-left-mod64 (integer amount)
  (ldb (byte 64 0) (ash integer amount)))
+4 −5
Original line number Diff line number Diff line
@@ -1369,7 +1369,7 @@
                               collect `(prepare-argument ,arg)))))))
    (loop for infos being each hash-value of sb!c::*modular-funs*
          ;; FIXME: We need to process only "toplevel" functions
          unless (eq infos :good)
          when (listp infos)
          do (loop for info in infos
                   for name = (sb!c::modular-fun-info-name info)
                   and width = (sb!c::modular-fun-info-width info)
@@ -1383,16 +1383,15 @@
;;; shifts.  See also the comment in (LOGAND OPTIMIZER) for more
;;; discussion of this hack.  -- CSR, 2003-10-09
#!-alpha
(defun sb!vm::ash-left-constant-mod32 (integer amount)
(defun sb!vm::ash-left-mod32 (integer amount)
  (etypecase integer
    ((unsigned-byte 32) (ldb (byte 32 0) (ash integer amount)))
    (fixnum (ldb (byte 32 0) (ash (logand integer #xffffffff) amount)))
    (bignum (ldb (byte 32 0) (ash (logand integer #xffffffff) amount)))))
#!+alpha
(defun sb!vm::ash-left-constant-mod64 (integer amount)
(defun sb!vm::ash-left-mod64 (integer amount)
  (etypecase integer
    ((unsigned-byte 64) (ldb (byte 64 0) (ash integer amount)))
    (fixnum (ldb (byte 64 0) (ash (logand integer #xffffffffffffffff) amount)))
    (bignum (ldb (byte 64 0)
		 (ash (logand integer #xffffffffffffffff) amount)))))
    
+2 −4
Original line number Diff line number Diff line
@@ -364,11 +364,9 @@
  (:generator 1
    (inst not x res)))

(defknown ash-left-constant-mod64 (integer (integer 0)) (unsigned-byte 64)
  (foldable flushable movable))
(define-vop (fast-ash-left-constant-mod64/unsigned=>unsigned
(define-vop (fast-ash-left-mod64-c/unsigned=>unsigned
	     fast-ash-c/unsigned=>unsigned)
  (:translate ash-left-constant-mod64))
  (:translate ash-left-mod64))

(macrolet
    ((define-modular-backend (fun &optional constantp)
+25 −4
Original line number Diff line number Diff line
@@ -152,7 +152,9 @@

;;; Modular functions

;;; hash: name -> { ({(width . fun)}*) | :good }
;;; For a documentation, see CUT-TO-WIDTH.

;;; hash: name -> { :GOOD | optimizer | ({modular-fun-info}*)}
(defvar *modular-funs*
  (make-hash-table :test 'eq))

@@ -166,11 +168,11 @@

(defun find-modular-version (fun-name width)
  (let ((infos (gethash fun-name *modular-funs*)))
    (if (eq infos :good)
        :good
    (if (listp infos)
        (find-if (lambda (item-width) (>= item-width width))
                 infos
                 :key #'modular-fun-info-width))))
                 :key #'modular-fun-info-width)
        infos)))

(defun %define-modular-fun (name lambda-list prototype width)
  (let* ((infos (the list (gethash prototype *modular-funs*)))
@@ -216,3 +218,22 @@
(defmacro define-good-modular-fun (name)
  (check-type name symbol)
  `(%define-good-modular-fun ',name))

(defmacro define-modular-fun-optimizer
    (name ((&rest lambda-list) &key (width (gensym "WIDTH")))
     &body body)
  (check-type name symbol)
  (dolist (arg lambda-list)
    (when (member arg lambda-list-keywords)
      (error "Lambda list keyword ~S is not supported for ~
              modular function lambda lists." arg)))
  (with-unique-names (call args)
    `(setf (gethash ',name *modular-funs*)
           (lambda (,call ,width)
             (declare (type basic-combination ,call)
                      (type (integer 0) width))
             (let ((,args (basic-combination-args ,call)))
               (when (= (length ,args) ,(length lambda-list))
                 (destructuring-bind ,lambda-list ,args
                   (declare (type lvar ,@lambda-list))
                   ,@body)))))))
Loading