Changeset 15006


Ignore:
Timestamp:
Sep 30, 2011, 11:38:15 AM (8 years ago)
Author:
gb
Message:

Short version: D'oh!

Longer version:

Enable *x862-generate-casejump* again.

In NX2-RECONSTRUCT-CASE, actually recognize the acode for (OR (EQ var
v1) (EQ var v2) ...), allowing cases where multiple keys select the
same clause.

In X862-GENERATE-CASEJUMP, generate code for each labeled clause once
and only once (not once for each key value that selects that clause.)
Process the OTHERWISE form with the same model of the stack as was
current on entry (not with whatever was in effect at the end of the
last clause.)

Split the CJMP vinsn into two parts; one of which checks that the key
is a fixnum in range and returns an unboxed and unsined index and the
second of which does the indexed jump. If there's a single
(non-OTHERWISE) clause and the keys which select it cover their range,
don't generate a jump table.

Let the x86 addressing hardware scale that unboxed index. Convince
the x86 disassembler that it shouldn't care whether or not scaling is
used when recognizing the code sequence that references a jump table.
Get the address of the jump table right in the disassembler.

Location:
trunk/source/compiler
Files:
5 edited

Legend:

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

    r15004 r15006  
    42174217  (movl (:@ (:% x8632::ebp)) (:% x8632::ebp)))
    42184218
    4219 (define-x8632-vinsn (cjmp :branch) (((reg :s32))
    4220                                     ((reg :s32)
    4221                                      (minval :s32const)
    4222                                      (maxval :u32const)
    4223                                      (default :label))
    4224                                     ((rjmp :lisp)))
     4219(define-x8632-vinsn (skip-unless-fixnum-in-range :branch)
     4220    (((idx :u32))
     4221     ((reg :imm)
     4222      (minval :s32const)
     4223      (maxval :u32const)
     4224      (default :label)))
    42254225  (testl (:$l x8632::fixnummask) (:%l reg))
    42264226  (jne default)
     4227  (movl (:%l reg) (:%l idx))
     4228  (sarl (:$ub x8632::fixnumshift) (:%l idx))
    42274229  ((:not (:pred zerop minval))
    4228    (subl (:$l minval) (:%l reg)))
    4229   (cmpl (:$l maxval) (:%l reg))
    4230   (ja default)
    4231   (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l reg)) (:%l reg))
     4230   ((:and (:pred < minval 128) (:pred >= minval -128))
     4231    (subl (:$b minval) (:%l idx)))
     4232   ((:not (:and (:pred < minval 128) (:pred >= minval -128)))
     4233    (subl (:$l minval) (:%l idx))))
     4234  ((:pred < maxval 128)
     4235   (cmpl (:$b maxval) (:%l idx)))
     4236  ((:pred >= maxval 128)
     4237   (cmpl (:$l maxval) (:%l idx)))
     4238  (jae default))
     4239
     4240(define-x8632-vinsn (ijmp :branch) (((reg :u32))
     4241                                    ((reg :u32)
     4242                                     (count :s32const))
     4243                                    ((rjmp :lisp)))
     4244  (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l reg) 4) (:%l reg))
    42324245  (leal (:@ (:%l x8632::fn) (:%l reg)) (:%l rjmp))
    42334246  (jmp (:%l rjmp))
    42344247  (:uuo-section)
    42354248  (:align 2)
    4236   (:long (:apply 1+ (:apply ash maxval (- x8632::fixnumshift))))
     4249  (:long count)
    42374250  :jtab)
    42384251
  • trunk/source/compiler/X86/X8664/x8664-vinsns.lisp

    r15004 r15006  
    46324632  (movq (:@ (:%q x8664::rbp)) (:%q x8664::rbp)))
    46334633
    4634 (define-x8664-vinsn (cjmp :branch) (((reg :s64))
    4635                                     ((reg :s64)
    4636                                      (minval :s32const)
    4637                                      (maxval :u32const)
    4638                                      (default :label))
    4639                                     ((rjmp :lisp)))
     4634(define-x8664-vinsn (skip-unless-fixnum-in-range :branch)
     4635    (((idx :u32))
     4636     ((reg :imm)
     4637      (minval :s32const)
     4638      (maxval :u32const)
     4639      (default :label)))
    46404640  (testl (:$l x8664::fixnummask) (:%l reg))
    46414641  (jne default)
     4642  (movq (:%q reg) (:%q idx))
     4643  (sarq (:$ub x8664::fixnumshift) (:%q idx))
    46424644  ((:not (:pred zerop minval))
    4643    (subq (:$l minval) (:%q reg)))
    4644   (cmpq (:$l maxval) (:%q reg))
    4645   (ja default)
    4646   (shrl (:%l reg))
    4647   (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q reg)) (:%l reg))
    4648   (leaq (:@ (:%q x8664::fn) (:%q reg)) (:%q rjmp))
     4645   ((:and (:pred < minval 128) (:pred >= minval -128))
     4646    (subq (:$b minval) (:%q idx)))
     4647   ((:not (:and (:pred < minval 128) (:pred >= minval -128)))
     4648    (subq (:$l minval) (:%q idx))))
     4649  ((:pred < maxval 128)
     4650   (cmpq (:$b maxval) (:%q idx)))
     4651  ((:pred >= maxval 128)
     4652   (cmpq (:$l maxval) (:%q idx)))
     4653  (jae default))
     4654
     4655(define-x8664-vinsn (ijmp :branch) (((idx :u32))
     4656                                    ((idx :u32)
     4657                                     (count :u32const))
     4658                                    ((rjmp :lisp)))
     4659  (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q idx) 4) (:%l idx))
     4660  (leaq (:@ (:%q x8664::fn) (:%q idx)) (:%q rjmp))
    46494661  (jmp (:%q rjmp))
    46504662  (:uuo-section)
    46514663  (:align 2)
    4652   (:long (:apply 1+ (:apply ash maxval (- x8664::fixnumshift))))
     4664  (:long count)
    46534665  :jtab)
    46544666 
  • trunk/source/compiler/X86/x86-disassemble.lisp

    r15004 r15006  
    24282428                    (is-fn (x86::x86-memory-operand-base thing))
    24292429                    (x86::x86-memory-operand-index thing)
    2430                     (let* ((scale (x86::x86-memory-operand-scale thing)))
    2431                       (or (null scale) (eql 0 scale)))
    24322430                    (let* ((disp (x86::x86-memory-operand-disp thing)))
    24332431                      (and disp (early-x86-lap-expression-value disp)))))
     
    24822480             (if (and jtab (> jtab 0))
    24832481               (let* ((count (x86-ds-u32-ref ds (- jtab 4)))
    2484                       (block (make-x86-dis-block :start-address jtab
    2485                                                  :end-address (+ jtab (* 4 count))))
     2482                      (block (make-x86-dis-block :start-address (+ jtab (x86-ds-entry-point ds))
     2483                                                 :end-address (+ jtab (x86-ds-entry-point ds) (* 4 count))))
    24862484                      (instructions (x86-dis-block-instructions block))
    24872485                      (labeled t))
     
    24932491                          (start (+ jtab (x86-ds-entry-point ds)))
    24942492                          (instruction (make-x86-disassembled-instruction
    2495                                         :address jtab
     2493                                        :address start
    24962494                                        :labeled labeled
    24972495                                        :mnemonic ":long"
  • trunk/source/compiler/X86/x862.lisp

    r15005 r15006  
    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)
     
    73177317               (max min)
    73187318               (count 0)
    7319                (all ()))
     7319               (all ())
     7320               (labeled-trueforms ()))
    73207321          (declare (fixnum min max count))
    73217322          (when                         ; determine min,max, count; punt on duplicate keys
    73227323              (dolist (range ranges t)
    73237324                (let* ((info (cons (backend-get-next-label) (pop trueforms))))
     7325                  (push info labeled-trueforms)
    73247326                  (unless (dolist (val range t)
    73257327                            (declare (fixnum val))
     
    73357337
    73367338            (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)
     7339              (when (and (typep min '(signed-byte 32))
     7340                         (typep span '(unsigned-byte 31)) ;sic
    73407341                         (> count 4)
    7341                          (> count (the fixnum (- span (the fixnum (ash span -2))))))
     7342                         (>= count (the fixnum (- span (the fixnum (ash span -2))))))
    73427343                (let* ((defaultlabel (backend-get-next-label))
    73437344                       (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)))))
     7345                       (single-clause (and (eql count span)
     7346                                           (eql (length labeled-trueforms) 1))))
     7347                  (let* ((reg (x862-one-untargeted-reg-form seg (make-acode (%nx1-operator lexical-reference) var) *x862-arg-z*)))
     7348                    (with-imm-target () (idx :u32)
     7349                      (! skip-unless-fixnum-in-range idx reg min span  (aref *backend-labels* defaultlabel))
     7350                      (unless single-clause
     7351                        (! ijmp idx span)
     7352                        (do* ((val min (1+ val)))
     7353                             ((> val max))
     7354                          (declare (fixnum val))
     7355                          (let* ((info (assoc val all)))
     7356                            (! jtabentry (aref *backend-labels* (if info (cadr info) defaultlabel))))))))
    73537357                  (let* ((target (if (x862-mvpass-p xfer)
    73547358                                   (logior $backend-mvpass-mask endlabel)
    73557359                                   (x862-cd-merge xfer endlabel)))
    73567360                         (entry-stack (x862-encode-stack)))
    7357                     (dolist (case (nreverse all))
    7358                       (let* ((lab (cadr case))
    7359                              (form (cddr case)))
    7360                         (@= lab)
     7361                    (dolist (case (nreverse labeled-trueforms))
     7362                      (let* ((lab (car case))
     7363                             (form (cdr case)))
     7364                        (unless single-clause (@= lab))
    73617365                        (multiple-value-setq (*x862-undo-count*
    73627366                                              *x862-cstack*
     
    73657369                          (x862-decode-stack entry-stack))
    73667370                        (x862-undo-body seg vreg target form entry-stack)))
    7367                     (@= defaultlabel)
    7368                     (x862-form seg vreg target otherwise)
     7371                    (if single-clause
     7372                      (@ defaultlabel)
     7373                      (@= defaultlabel))
     7374                    (multiple-value-setq (*x862-undo-count*
     7375                                          *x862-cstack*
     7376                                          *x862-vstack*
     7377                                          *x862-top-vstack-lcell*)
     7378                      (x862-decode-stack entry-stack))
     7379                    (x862-undo-body seg vreg target otherwise entry-stack)
    73697380                    (@ endlabel)
    73707381                    (when (x862-mvpass-p xfer)
  • trunk/source/compiler/nx2.lisp

    r14983 r15006  
    818818        (if (and (acode-p form) (eql (acode-operator form) (%nx1-operator or)))
    819819          (collect ((vals))
    820             (if (multiple-value-setq (var val) (is-simple-comparison-of-var-to-fixnum (cadr form)))
    821               (progn
    822                 (vals val)
    823                 (dolist (clause (cddr form) (values var (vals)))
    824                   (multiple-value-bind (var1 val1)
    825                       (is-simple-comparison-of-var-to-fixnum clause)
    826                     (unless (eq var var1)
    827                       (return (values nil nil)))
    828                     (vals val1))))
    829               (values nil nil))))))))
     820            (let* ((clauselist (cadr form)))
     821              (if (multiple-value-setq (var val) (is-simple-comparison-of-var-to-fixnum (car clauselist)))
     822                (progn
     823                  (vals val)
     824                  (dolist (clause (cdr clauselist) (values var (vals)))
     825                    (multiple-value-bind (var1 val1)
     826                        (is-simple-comparison-of-var-to-fixnum clause)
     827                      (unless (eq var var1)
     828                        (return (values nil nil)))
     829                      (vals val1))))
     830                (values nil nil)))))))))
    830831           
    831832
Note: See TracChangeset for help on using the changeset viewer.