Changeset 15004


Ignore:
Timestamp:
Sep 29, 2011, 9:52:16 AM (8 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.)

Location:
trunk/source/compiler/X86
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/X8632/x8632-vinsns.lisp

    r14999 r15004  
    42174217  (movl (:@ (:% x8632::ebp)) (:% x8632::ebp)))
    42184218
    4219 (define-x8632-vinsn (cjmp :branch) (((reg :lisp))
    4220                                     ((reg :lisp)
     4219(define-x8632-vinsn (cjmp :branch) (((reg :s32))
     4220                                    ((reg :s32)
    42214221                                     (minval :s32const)
    42224222                                     (maxval :u32const)
    42234223                                     (default :label))
    4224                                     ((temp :s32)
    4225                                     (rjmp :lisp)))
    4226   (testl (:$l x8664::fixnummask) (:%l reg))
     4224                                    ((rjmp :lisp)))
     4225  (testl (:$l x8632::fixnummask) (:%l reg))
    42274226  (jne default)
    42284227  ((:not (:pred zerop minval))
     
    42304229  (cmpl (:$l maxval) (:%l reg))
    42314230  (ja default)
    4232   (movl (:%l reg) (:%l temp))
    4233   (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l temp)) (:%l temp))
    4234   (leal (:@ (:%l x8632::fn) (:%l temp)) (:%l rjmp))
     4231  (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l reg)) (:%l reg))
     4232  (leal (:@ (:%l x8632::fn) (:%l reg)) (:%l rjmp))
    42354233  (jmp (:%l rjmp))
    42364234  (:uuo-section)
  • trunk/source/compiler/X86/X8664/x8664-vinsns.lisp

    r14999 r15004  
    46324632  (movq (:@ (:%q x8664::rbp)) (:%q x8664::rbp)))
    46334633
    4634 (define-x8664-vinsn (cjmp :branch) (((reg :lisp))
    4635                                     ((reg :lisp)
     4634(define-x8664-vinsn (cjmp :branch) (((reg :s64))
     4635                                    ((reg :s64)
    46364636                                     (minval :s32const)
    46374637                                     (maxval :u32const)
    46384638                                     (default :label))
    4639                                     ((temp :s32)
    4640                                     (rjmp :lisp)))
     4639                                    ((rjmp :lisp)))
    46414640  (testl (:$l x8664::fixnummask) (:%l reg))
    46424641  (jne default)
     
    46454644  (cmpq (:$l maxval) (:%q reg))
    46464645  (ja default)
    4647   (movl (:%l reg) (:%l temp))
    4648   (shrl (:%l temp))
    4649   (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q temp)) (:%l temp))
    4650   (leaq (:@ (:%q x8664::fn) (:%q temp)) (:%q rjmp))
     4646  (shrl (:%l reg))
     4647  (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q reg)) (:%l reg))
     4648  (leaq (:@ (:%q x8664::fn) (:%q reg)) (:%q rjmp))
    46514649  (jmp (:%q rjmp))
    46524650  (:uuo-section)
     
    46544652  (:long (:apply 1+ (:apply ash maxval (- x8664::fixnumshift))))
    46554653  :jtab)
    4656 
    4657 
     4654 
    46584655
    46594656(define-x8664-vinsn jtabentry (()
  • trunk/source/compiler/X86/x86-disassemble.lisp

    r14998 r15004  
    24812481           (let* ((jtab (is-jump-table-ref op0)))
    24822482             (if (and jtab (> jtab 0))
    2483                (let* ((count (x86-ds-u32-ref ds (- jtab 4))))
     2483               (let* ((count (x86-ds-u32-ref ds (- jtab 4)))
     2484                      (block (make-x86-dis-block :start-address jtab
     2485                                                 :end-address (+ jtab (* 4 count))))
     2486                      (instructions (x86-dis-block-instructions block))
     2487                      (labeled t))
     2488                 (setf (x86::x86-memory-operand-disp op0)
     2489                       (parse-x86-lap-expression `(:^ ,jtab)))
    24842490                 (dotimes (i count)
    2485                    (push (+ (x86-ds-u32-ref ds jtab)
    2486                             (x86-ds-entry-point ds))
    2487                          (x86-ds-pending-labels ds))
    2488                    (incf jtab 4)))
     2491                   (let* ((target (+ (x86-ds-u32-ref ds jtab)
     2492                                     (x86-ds-entry-point ds)))
     2493                          (start (+ jtab (x86-ds-entry-point ds)))
     2494                          (instruction (make-x86-disassembled-instruction
     2495                                        :address jtab
     2496                                        :labeled labeled
     2497                                        :mnemonic ":long"
     2498                                        :op0 (parse-x86-lap-expression `(:^ ,target))
     2499                                        :start start
     2500                                        :end (+ start 4))))
     2501                     (append-dll-node instruction instructions)
     2502                     (setq labeled nil)
     2503                     (push target (x86-ds-pending-labels ds))
     2504                     (incf jtab 4)))
     2505                 (insert-x86-block block (x86-ds-blocks ds)))
    24892506               (unless (x86-ds-mode-64 ds)
    24902507                 (when (and (is-fn op1)
     
    27192736    (format nil "L~d" (- addr entrypoint))))
    27202737
     2738(defmethod unparse-x86-lap-operand ((op label-x86-lap-expression)
     2739                                    ds)
     2740  (unparse-x86-lap-expression op ds))
     2741
    27212742
    27222743(defmethod x86-lap-operand-constant-offset (op ds)
     
    28122833(defvar *previous-source-note*)
    28132834
    2814 (defun x86-print-di-lap (ds instruction &optional tab-stop)
     2835(defun x86-print-di-lap (ds instruction tab-stop pc)
    28152836  (dolist (p (x86-di-prefixes instruction))
    28162837    (when tab-stop
     
    28292850        (when op2
    28302851          (write-x86-lap-operand t op2 ds)))))
    2831   (format t ")~%"))
     2852  (format t ")~vt;~8<[~D]~>" (+ 40 tab-stop) pc) 
     2853  (format t "~%"))
    28322854
    28332855(defun x86-print-disassembled-instruction (ds instruction seq function)
     
    28472869      (format t "~&L~d~%" pc)
    28482870      (setq seq 0))
    2849     (format t "~&~8<[~D]~>" pc)
     2871    (format t "~&")
    28502872    (let* ((istart (x86-di-start instruction))
    28512873           (iend (x86-di-end instruction))
     
    28592881          (incf byteidx))
    28602882        (decf nbytes 4))
    2861       (x86-print-di-lap ds instruction tab-stop)
     2883      (x86-print-di-lap ds instruction tab-stop pc)
    28622884      (when *disassemble-verbose*
    28632885        (while (plusp nbytes)
  • 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.