Changeset 14998


Ignore:
Timestamp:
Sep 24, 2011, 8:36:16 AM (8 years ago)
Author:
gb
Message:

Conditionally (using *x862-generate-casejump*, which defaults to false
for now) enable code to do constant-time CASE for certain types/ranges
of keys via a jump table.

Make the X86 disassembler recognize references to labels referenced from
the jump table (though it doesn't yet do anything to show the jump table
itself.)

This is about as far along as the ARM backend has been for the last few
months; the mechanics of dispatching through the jump table seem to be
correct, but the code generated at each case label is only correct in
certain circumstances.

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

Legend:

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

    r14979 r14998  
    42174217  (movl (:@ (:% x8632::ebp)) (:% x8632::ebp)))
    42184218
     4219(define-x8632-vinsn (cjmp :branch) (((reg :lisp))
     4220                                    ((reg :lisp)
     4221                                     (minval :s32const)
     4222                                     (maxval :u32const)
     4223                                     (default :label))
     4224                                    ((temp :s32)
     4225                                    (rjmp :lisp)))
     4226  (testl (:$l x8664::fixnummask) (:%l reg))
     4227  (jne default)
     4228  ((:not (:pred zerop minval))
     4229   (subl (:$l minval) (:%l reg)))
     4230  (cmpl (:$l maxval) (:%l reg))
     4231  (ja default)
     4232  (movl (:%l reg) (:%l temp))
     4233  (shrl (:%l temp))
     4234  (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l temp)) (:%l temp))
     4235  (leal (:@ (:%l x8632::fn) (:%l temp)) (:%l rjmp))
     4236  (jmp (:%l rjmp))
     4237  (:uuo-section)
     4238  (:align 2)
     4239  (:long (:apply 1+ (:apply ash maxval (- x8632::fixnumshift))))
     4240  :jtab)
     4241
     4242(define-x8632-vinsn jtabentry (()
     4243                               ((label :label)))
     4244  (:uuo-section)
     4245  (:long (:^ label)))
     4246
    42194247(queue-fixup
    42204248 (fixup-x86-vinsn-templates
  • trunk/source/compiler/X86/x86-disassemble.lisp

    r14810 r14998  
    139139         (high (x86-ds-next-s32 ds)))
    140140    (logior (ash high 32) low)))
     141
     142(defun x86-ds-u8-ref (ds idx)
     143  (aref (x86-ds-code-vector ds) (+ idx (x86-ds-entry-point ds))))
     144
     145(defun x86-ds-u16-ref (ds idx)
     146  (logior (x86-ds-u8-ref ds idx)
     147          (ash (x86-ds-u8-ref ds (1+ idx)) 8)))
     148
     149(defun x86-ds-u32-ref (ds idx)
     150  (logior (x86-ds-u16-ref ds idx)
     151          (ash (x86-ds-u16-ref ds (+ idx 2)) 16)))
     152
     153
    141154
    142155(defun used-rex (ds value)
     
    24112424                    (let* ((disp (x86::x86-memory-operand-disp thing)))
    24122425                      (and disp (early-x86-lap-expression-value disp)))))
     2426             (is-jump-table-ref (thing)
     2427               (and (typep thing 'x86::x86-memory-operand)
     2428                    (is-fn (x86::x86-memory-operand-base thing))
     2429                    (x86::x86-memory-operand-index thing)
     2430                    (let* ((scale (x86::x86-memory-operand-scale thing)))
     2431                      (or (null scale) (eql 0 scale)))
     2432                    (let* ((disp (x86::x86-memory-operand-disp thing)))
     2433                      (and disp (early-x86-lap-expression-value disp)))))
    24132434             (is-ra0-ea (thing)
    24142435               (and (typep thing 'x86::x86-memory-operand)
     
    24332454           (let* ((disp ))
    24342455             (if (or (and (setq disp (is-fn-ea op0)) (> disp 0))
    2435                        (and (setq disp (is-ra0-ea op0)) (< disp 0) (is-fn op1)))
     2456                     (and (setq disp (is-ra0-ea op0)) (< disp 0) (is-fn op1)))
    24362457               (let* ((label-ea (+ entry-ea (abs disp))))
    24372458                 (when (< label-ea (x86-ds-code-limit ds))
     
    24582479                                  (subprimitive-info-name info)))))))
    24592480          (t
    2460            (unless (x86-ds-mode-64 ds)
    2461              (when (and (is-fn op1)
    2462                         (typep op0 'x86::x86-immediate-operand)
    2463                         ;; Not sure what else would have an
    2464                         ;; immediate source and %fn as destination,
    2465                         ;; but check for this.
    2466                         (equal (x86-di-mnemonic instruction) "movl"))
    2467                (setf (x86-di-mnemonic instruction) "recover-fn"
    2468                      (x86-di-op0 instruction) nil
    2469                      (x86-di-op0 instruction) nil))))
     2481           (let* ((jtab (is-jump-table-ref op0)))
     2482             (if (and jtab (> jtab 0))
     2483               (let* ((count (x86-ds-u32-ref ds (- jtab 4))))
     2484                 (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)))
     2489               (unless (x86-ds-mode-64 ds)
     2490                 (when (and (is-fn op1)
     2491                            (typep op0 'x86::x86-immediate-operand)
     2492                            ;; Not sure what else would have an
     2493                            ;; immediate source and %fn as destination,
     2494                            ;; but check for this.
     2495                            (equal (x86-di-mnemonic instruction) "movl"))
     2496                   (setf (x86-di-mnemonic instruction) "recover-fn"
     2497                         (x86-di-op0 instruction) nil
     2498                         (x86-di-op0 instruction) nil))))))
    24702499
    24712500          )))
  • trunk/source/compiler/X86/x862.lisp

    r14994 r14998  
    61416141                 (:anchored-uuo
    61426142                  (expand-form (cadr f))
    6143                   ;; add a trailing 0 byte after the uu0
     6143                  ;; add a trailing 0 byte after the uuo
    61446144                  (frag-list-push-byte frag-list 0))
    61456145                 ((:uuo :uuo-section)
     
    73077307        (<- *x862-arg-z*)
    73087308        (^)))))
    7309      
     7309
     7310(defparameter *x862-generate-casejump* nil)
     7311
     7312(defun x862-generate-casejump (seg vreg xfer ranges trueforms var otherwise)
     7313  (declare (ignorable trueforms var otherwise))
     7314  (when *x862-generate-casejump*
     7315    (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)))))))))))
    73107366
    73117367(defx862 x862-if if (seg vreg xfer testform true false &aux test-val)
    73127368  (if (setq test-val (nx2-constant-form-value (acode-unwrapped-form-value testform)))
    73137369    (x862-form seg vreg xfer (if (nx-null test-val) false true))
    7314     (let* ((cstack *x862-cstack*)
    7315            (vstack *x862-vstack*)
    7316            (top-lcell *x862-top-vstack-lcell*)
    7317            (entry-stack (x862-encode-stack))
    7318            (true-stack nil)
    7319            (false-stack nil)
    7320            (true-cleanup-label nil)
    7321            (same-stack-effects nil)
    7322            (true-is-goto (x862-go-label true))
    7323            (false-is-goto (and (not true-is-goto) (x862-go-label false)))
    7324            (endlabel (backend-get-next-label))
    7325            (falselabel (backend-get-next-label))
    7326            (need-else (unless false-is-goto (or (not (nx-null false)) (x862-for-value-p vreg))))
    7327            (both-single-valued (and (not *x862-open-code-inline*)
    7328                                     (eq xfer $backend-return)
    7329                                     (x862-for-value-p vreg)
    7330                                     need-else
    7331                                     (x862-single-valued-form-p true)
    7332                                     (x862-single-valued-form-p false))))
    7333       (if (eq 0 xfer)
    7334         (setq xfer nil))
    7335       (if both-single-valued            ; it's implied that we're returning
    7336         (let* ((result *x862-arg-z*))
    7337           (let ((merge-else-branch-label (if (nx-null false) (x862-find-nilret-label))))
    7338             (x862-conditional-form seg (x862-make-compound-cd 0 falselabel) testform)
    7339             (x862-form seg result endlabel true)
    7340             (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
    7341               (backend-copy-label merge-else-branch-label falselabel)
     7370    (multiple-value-bind (ranges trueforms var otherwise)
     7371        (nx2-reconstruct-case testform true false)
     7372      (or (x862-generate-casejump seg vreg xfer ranges trueforms var otherwise)
     7373          (let* ((cstack *x862-cstack*)
     7374                 (vstack *x862-vstack*)
     7375                 (top-lcell *x862-top-vstack-lcell*)
     7376                 (entry-stack (x862-encode-stack))
     7377                 (true-stack nil)
     7378                 (false-stack nil)
     7379                 (true-cleanup-label nil)
     7380                 (same-stack-effects nil)
     7381                 (true-is-goto (x862-go-label true))
     7382                 (false-is-goto (and (not true-is-goto) (x862-go-label false)))
     7383                 (endlabel (backend-get-next-label))
     7384                 (falselabel (backend-get-next-label))
     7385                 (need-else (unless false-is-goto (or (not (nx-null false)) (x862-for-value-p vreg))))
     7386                 (both-single-valued (and (not *x862-open-code-inline*)
     7387                                          (eq xfer $backend-return)
     7388                                          (x862-for-value-p vreg)
     7389                                          need-else
     7390                                          (x862-single-valued-form-p true)
     7391                                          (x862-single-valued-form-p false))))
     7392            (if (eq 0 xfer)
     7393              (setq xfer nil))
     7394            (if both-single-valued      ; it's implied that we're returning
     7395              (let* ((result *x862-arg-z*))
     7396                (let ((merge-else-branch-label (if (nx-null false) (x862-find-nilret-label))))
     7397                  (x862-conditional-form seg (x862-make-compound-cd 0 falselabel) testform)
     7398                  (x862-form seg result endlabel true)
     7399                  (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
     7400                    (backend-copy-label merge-else-branch-label falselabel)
     7401                    (progn
     7402                      (@ falselabel)
     7403                      (if (nx-null false) (@ (x862-record-nilret-label)))
     7404                      (x862-form seg result nil false)))
     7405                  (@ endlabel)
     7406                  (<- result)
     7407                  (^)))
    73427408              (progn
    7343                 (@ falselabel)
    7344                 (if (nx-null false) (@ (x862-record-nilret-label)))
    7345                 (x862-form seg result nil false)))
    7346             (@ endlabel)
    7347             (<- result)
    7348             (^)))
    7349         (progn
    7350           (if (and need-else (x862-mvpass-p xfer))
    7351             (setq true-cleanup-label (backend-get-next-label)))         
    7352           (x862-conditional-form
    7353            seg
    7354            (x862-make-compound-cd
    7355             (or true-is-goto 0)
    7356             (or false-is-goto
    7357                 (if need-else
    7358                   (if true-is-goto 0 falselabel)
    7359                   (if true-is-goto xfer (x862-cd-merge xfer falselabel)))))
    7360            testform) 
    7361           (if true-is-goto
    7362             (x862-unreachable-store)
    7363             (if true-cleanup-label
    7364               (progn
    7365                 (x862-open-undo $undomvexpect)
    7366                 (x862-form seg vreg (logior $backend-mvpass-mask true-cleanup-label) true))
    7367               (x862-form seg vreg (if need-else (x862-cd-merge xfer endlabel) xfer) true)))
    7368           (setq true-stack (x862-encode-stack))
    7369           (setq *x862-cstack* cstack)
    7370           (x862-set-vstack vstack)
    7371           (setq *x862-top-vstack-lcell* top-lcell)
    7372           (if false-is-goto (x862-unreachable-store))
    7373           (let ((merge-else-branch-label (if (and (nx-null false) (eq xfer $backend-return)) (x862-find-nilret-label))))
    7374             (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
    7375               (backend-copy-label merge-else-branch-label falselabel)
    7376               (progn
    7377                 (@ falselabel)
    7378                 (when need-else
     7409                (if (and need-else (x862-mvpass-p xfer))
     7410                  (setq true-cleanup-label (backend-get-next-label)))         
     7411                (x862-conditional-form
     7412                 seg
     7413                 (x862-make-compound-cd
     7414                  (or true-is-goto 0)
     7415                  (or false-is-goto
     7416                      (if need-else
     7417                        (if true-is-goto 0 falselabel)
     7418                        (if true-is-goto xfer (x862-cd-merge xfer falselabel)))))
     7419                 testform) 
     7420                (if true-is-goto
     7421                  (x862-unreachable-store)
    73797422                  (if true-cleanup-label
    7380                     (x862-mvpass seg false)
    7381                     (x862-form seg vreg xfer false))
    7382                   (setq false-stack (x862-encode-stack))))))
    7383           (when true-cleanup-label
    7384             (if (setq same-stack-effects (x862-equal-encodings-p true-stack false-stack)) ; can share cleanup code
    7385               (@ true-cleanup-label))
    7386             (let* ((*x862-returning-values* :pass))
    7387               (x862-nlexit seg xfer 1)
    7388               (x862-branch seg (if (and xfer (neq xfer $backend-mvpass-mask)) xfer (if (not same-stack-effects) endlabel))))
    7389             (unless same-stack-effects
    7390               (@ true-cleanup-label)
    7391               (multiple-value-setq (true *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*)
    7392                 (x862-decode-stack true-stack))
    7393               (let* ((*x862-returning-values* :pass))
    7394                 (x862-nlexit seg xfer 1)
    7395                 (^)))
    7396             (x862-close-undo)
    7397             (multiple-value-setq (*x862-undo-count* *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*)
    7398               (x862-decode-stack entry-stack)))
    7399           (@ endlabel))))))
     7423                    (progn
     7424                      (x862-open-undo $undomvexpect)
     7425                      (x862-form seg vreg (logior $backend-mvpass-mask true-cleanup-label) true))
     7426                    (x862-form seg vreg (if need-else (x862-cd-merge xfer endlabel) xfer) true)))
     7427                (setq true-stack (x862-encode-stack))
     7428                (setq *x862-cstack* cstack)
     7429                (x862-set-vstack vstack)
     7430                (setq *x862-top-vstack-lcell* top-lcell)
     7431                (if false-is-goto (x862-unreachable-store))
     7432                (let ((merge-else-branch-label (if (and (nx-null false) (eq xfer $backend-return)) (x862-find-nilret-label))))
     7433                  (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
     7434                    (backend-copy-label merge-else-branch-label falselabel)
     7435                    (progn
     7436                      (@ falselabel)
     7437                      (when need-else
     7438                        (if true-cleanup-label
     7439                          (x862-mvpass seg false)
     7440                          (x862-form seg vreg xfer false))
     7441                        (setq false-stack (x862-encode-stack))))))
     7442                (when true-cleanup-label
     7443                  (if (setq same-stack-effects (x862-equal-encodings-p true-stack false-stack)) ; can share cleanup code
     7444                    (@ true-cleanup-label))
     7445                  (let* ((*x862-returning-values* :pass))
     7446                    (x862-nlexit seg xfer 1)
     7447                    (x862-branch seg (if (and xfer (neq xfer $backend-mvpass-mask)) xfer (if (not same-stack-effects) endlabel))))
     7448                  (unless same-stack-effects
     7449                    (@ true-cleanup-label)
     7450                    (multiple-value-setq (true *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*)
     7451                      (x862-decode-stack true-stack))
     7452                    (let* ((*x862-returning-values* :pass))
     7453                      (x862-nlexit seg xfer 1)
     7454                      (^)))
     7455                  (x862-close-undo)
     7456                  (multiple-value-setq (*x862-undo-count* *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*)
     7457                    (x862-decode-stack entry-stack)))
     7458                (@ endlabel))))))))
    74007459
    74017460(defx862 x862-or or (seg vreg xfer forms)
Note: See TracChangeset for help on using the changeset viewer.