Ignore:
Timestamp:
Sep 29, 2011, 9:52:16 AM (9 years ago)
Author:
gb
Message:

Do some cases of CASE (and similar constructs) in constant time by
using a jump table in the x86 backends. This -seems- to do the right
things (wrt stack discipline, multiple values, etc.) in all cases that
I've tried (including a handful of things in CCL itself); it can
currently be disabled by setting CCL::*X862-GENERATE-CASEJUMP* to NIL
before compiling.

Get the x86 disassembler to recognize and display jump tables.
Persuade it to print the instruction address in a comment after the
instruction. (We're a ways from being able to re-assemble disassembled
code on x86 for several other reasons, but I think that this makes the
disassembly a little easier to read.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r14998 r15004  
    73087308        (^)))))
    73097309
    7310 (defparameter *x862-generate-casejump* nil)
     7310(defparameter *x862-generate-casejump* t)
    73117311
    73127312(defun x862-generate-casejump (seg vreg xfer ranges trueforms var otherwise)
    7313   (declare (ignorable trueforms var otherwise))
    73147313  (when *x862-generate-casejump*
    73157314    (with-x86-local-vinsn-macros (seg vreg xfer)
    7316       (unless (x862-mvpass-p xfer)
    7317         (when ranges
    7318           (let* ((min (caar ranges))
    7319                  (max min)
    7320                  (count 0)
    7321                  (all ()))
    7322             (declare (fixnum min max count))
    7323             (when                       ; determine min,max, count; punt on duplicate keys
    7324                 (dolist (range ranges t)
    7325                   (let* ((info (cons (backend-get-next-label) (pop trueforms))))
    7326                     (unless (dolist (val range t)
    7327                               (declare (fixnum val))
    7328                               (when (assoc val all)
    7329                                 (return nil))
    7330                               (push (cons val info) all)
    7331                               (if (< val min)
    7332                                 (setq min val)
    7333                                 (if (> val max)
    7334                                   (setq max val)))
    7335                               (incf count))
    7336                       (return nil))))
    7337               (let* ((span (1+ (- max min))))
    7338                 (declare (fixnum span))
    7339                 (when (and (typep min '(signed-byte 32))
    7340                            (typep (- max min) 'unsigned-byte 32)
    7341                            (> count 4)
    7342                            (> count (the fixnum (- span (the fixnum (ash span -2))))))
    7343                   (let* ((defaultlabel (backend-get-next-label))
    7344                          (endlabel (backend-get-next-label))
    7345                          (reg ($ *x862-arg-z*)))
    7346                     (x862-use-operator (%nx1-operator lexical-reference)
    7347                                        seg reg nil var)
    7348                     (! cjmp reg (ash min *x862-target-fixnum-shift*) (ash (- max min) *x862-target-fixnum-shift*)  (aref *backend-labels* defaultlabel))
    7349                     (do* ((val min (1+ val)))
    7350                          ((> val max))
    7351                       (declare (fixnum val))
    7352                       (let* ((info (assoc val all)))
    7353                         (! jtabentry (aref *backend-labels* (if info (cadr info) defaultlabel)))))
    7354                     (let* ((target (x862-cd-merge xfer endlabel)))
    7355                       (dolist (case (nreverse all))
    7356                         (let* ((lab (cadr case))
    7357                                (form (cddr case)))
    7358                           (@= lab)
    7359                           (x862-form seg vreg target form)))
    7360                       (@= defaultlabel)
    7361                       (x862-form seg vreg target otherwise)
    7362                       (@ endlabel)
    7363                       (when (x862-mvpass-p xfer)
    7364                         (^))
    7365                       t)))))))))))
     7315      (when ranges
     7316        (let* ((min (caar ranges))
     7317               (max min)
     7318               (count 0)
     7319               (all ()))
     7320          (declare (fixnum min max count))
     7321          (when                         ; determine min,max, count; punt on duplicate keys
     7322              (dolist (range ranges t)
     7323                (let* ((info (cons (backend-get-next-label) (pop trueforms))))
     7324                  (unless (dolist (val range t)
     7325                            (declare (fixnum val))
     7326                            (when (assoc val all)
     7327                              (return nil))
     7328                            (push (cons val info) all)
     7329                            (if (< val min)
     7330                              (setq min val)
     7331                              (if (> val max)
     7332                                (setq max val)))
     7333                            (incf count))
     7334                    (return nil))))
     7335
     7336            (let* ((span (1+ (- max min))))
     7337              (declare (fixnum span))
     7338              (when (and (typep (ash min *x862-target-fixnum-shift*) '(signed-byte 32))
     7339                         (typep (ash (- max min) *x862-target-fixnum-shift*) 'unsigned-byte 32)
     7340                         (> count 4)
     7341                         (> count (the fixnum (- span (the fixnum (ash span -2))))))
     7342                (let* ((defaultlabel (backend-get-next-label))
     7343                       (endlabel (backend-get-next-label))
     7344                       (reg ($ *x862-imm0*)))
     7345                  (x862-use-operator (%nx1-operator lexical-reference)
     7346                                     seg reg nil var)
     7347                  (! cjmp reg (ash min *x862-target-fixnum-shift*) (ash (- max min) *x862-target-fixnum-shift*)  (aref *backend-labels* defaultlabel))
     7348                  (do* ((val min (1+ val)))
     7349                       ((> val max))
     7350                    (declare (fixnum val))
     7351                    (let* ((info (assoc val all)))
     7352                      (! jtabentry (aref *backend-labels* (if info (cadr info) defaultlabel)))))
     7353                  (let* ((target (if (x862-mvpass-p xfer)
     7354                                   (logior $backend-mvpass-mask endlabel)
     7355                                   (x862-cd-merge xfer endlabel)))
     7356                         (entry-stack (x862-encode-stack)))
     7357                    (dolist (case (nreverse all))
     7358                      (let* ((lab (cadr case))
     7359                             (form (cddr case)))
     7360                        (@= lab)
     7361                        (multiple-value-setq (*x862-undo-count*
     7362                                              *x862-cstack*
     7363                                              *x862-vstack*
     7364                                              *x862-top-vstack-lcell*)
     7365                          (x862-decode-stack entry-stack))
     7366                        (x862-undo-body seg vreg target form entry-stack)))
     7367                    (@= defaultlabel)
     7368                    (x862-form seg vreg target otherwise)
     7369                    (@ endlabel)
     7370                    (when (x862-mvpass-p xfer)
     7371                      (let* ((*x862-returning-values* :pass))
     7372                        (^)))
     7373                    t))))))))))
    73667374
    73677375(defx862 x862-if if (seg vreg xfer testform true false &aux test-val)
Note: See TracChangeset for help on using the changeset viewer.