Index: /trunk/source/compiler/X86/X8632/x8632-vinsns.lisp =================================================================== --- /trunk/source/compiler/X86/X8632/x8632-vinsns.lisp (revision 14997) +++ /trunk/source/compiler/X86/X8632/x8632-vinsns.lisp (revision 14998) @@ -4217,4 +4217,32 @@ (movl (:@ (:% x8632::ebp)) (:% x8632::ebp))) +(define-x8632-vinsn (cjmp :branch) (((reg :lisp)) + ((reg :lisp) + (minval :s32const) + (maxval :u32const) + (default :label)) + ((temp :s32) + (rjmp :lisp))) + (testl (:$l x8664::fixnummask) (:%l reg)) + (jne default) + ((:not (:pred zerop minval)) + (subl (:$l minval) (:%l reg))) + (cmpl (:$l maxval) (:%l reg)) + (ja default) + (movl (:%l reg) (:%l temp)) + (shrl (:%l temp)) + (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l temp)) (:%l temp)) + (leal (:@ (:%l x8632::fn) (:%l temp)) (:%l rjmp)) + (jmp (:%l rjmp)) + (:uuo-section) + (:align 2) + (:long (:apply 1+ (:apply ash maxval (- x8632::fixnumshift)))) + :jtab) + +(define-x8632-vinsn jtabentry (() + ((label :label))) + (:uuo-section) + (:long (:^ label))) + (queue-fixup (fixup-x86-vinsn-templates Index: /trunk/source/compiler/X86/x86-disassemble.lisp =================================================================== --- /trunk/source/compiler/X86/x86-disassemble.lisp (revision 14997) +++ /trunk/source/compiler/X86/x86-disassemble.lisp (revision 14998) @@ -139,4 +139,17 @@ (high (x86-ds-next-s32 ds))) (logior (ash high 32) low))) + +(defun x86-ds-u8-ref (ds idx) + (aref (x86-ds-code-vector ds) (+ idx (x86-ds-entry-point ds)))) + +(defun x86-ds-u16-ref (ds idx) + (logior (x86-ds-u8-ref ds idx) + (ash (x86-ds-u8-ref ds (1+ idx)) 8))) + +(defun x86-ds-u32-ref (ds idx) + (logior (x86-ds-u16-ref ds idx) + (ash (x86-ds-u16-ref ds (+ idx 2)) 16))) + + (defun used-rex (ds value) @@ -2411,4 +2424,12 @@ (let* ((disp (x86::x86-memory-operand-disp thing))) (and disp (early-x86-lap-expression-value disp))))) + (is-jump-table-ref (thing) + (and (typep thing 'x86::x86-memory-operand) + (is-fn (x86::x86-memory-operand-base thing)) + (x86::x86-memory-operand-index thing) + (let* ((scale (x86::x86-memory-operand-scale thing))) + (or (null scale) (eql 0 scale))) + (let* ((disp (x86::x86-memory-operand-disp thing))) + (and disp (early-x86-lap-expression-value disp))))) (is-ra0-ea (thing) (and (typep thing 'x86::x86-memory-operand) @@ -2433,5 +2454,5 @@ (let* ((disp )) (if (or (and (setq disp (is-fn-ea op0)) (> disp 0)) - (and (setq disp (is-ra0-ea op0)) (< disp 0) (is-fn op1))) + (and (setq disp (is-ra0-ea op0)) (< disp 0) (is-fn op1))) (let* ((label-ea (+ entry-ea (abs disp)))) (when (< label-ea (x86-ds-code-limit ds)) @@ -2458,14 +2479,22 @@ (subprimitive-info-name info))))))) (t - (unless (x86-ds-mode-64 ds) - (when (and (is-fn op1) - (typep op0 'x86::x86-immediate-operand) - ;; Not sure what else would have an - ;; immediate source and %fn as destination, - ;; but check for this. - (equal (x86-di-mnemonic instruction) "movl")) - (setf (x86-di-mnemonic instruction) "recover-fn" - (x86-di-op0 instruction) nil - (x86-di-op0 instruction) nil)))) + (let* ((jtab (is-jump-table-ref op0))) + (if (and jtab (> jtab 0)) + (let* ((count (x86-ds-u32-ref ds (- jtab 4)))) + (dotimes (i count) + (push (+ (x86-ds-u32-ref ds jtab) + (x86-ds-entry-point ds)) + (x86-ds-pending-labels ds)) + (incf jtab 4))) + (unless (x86-ds-mode-64 ds) + (when (and (is-fn op1) + (typep op0 'x86::x86-immediate-operand) + ;; Not sure what else would have an + ;; immediate source and %fn as destination, + ;; but check for this. + (equal (x86-di-mnemonic instruction) "movl")) + (setf (x86-di-mnemonic instruction) "recover-fn" + (x86-di-op0 instruction) nil + (x86-di-op0 instruction) nil)))))) ))) Index: /trunk/source/compiler/X86/x862.lisp =================================================================== --- /trunk/source/compiler/X86/x862.lisp (revision 14997) +++ /trunk/source/compiler/X86/x862.lisp (revision 14998) @@ -6141,5 +6141,5 @@ (:anchored-uuo (expand-form (cadr f)) - ;; add a trailing 0 byte after the uu0 + ;; add a trailing 0 byte after the uuo (frag-list-push-byte frag-list 0)) ((:uuo :uuo-section) @@ -7307,95 +7307,154 @@ (<- *x862-arg-z*) (^))))) - + +(defparameter *x862-generate-casejump* nil) + +(defun x862-generate-casejump (seg vreg xfer ranges trueforms var otherwise) + (declare (ignorable trueforms var otherwise)) + (when *x862-generate-casejump* + (with-x86-local-vinsn-macros (seg vreg xfer) + (unless (x862-mvpass-p xfer) + (when ranges + (let* ((min (caar ranges)) + (max min) + (count 0) + (all ())) + (declare (fixnum min max count)) + (when ; determine min,max, count; punt on duplicate keys + (dolist (range ranges t) + (let* ((info (cons (backend-get-next-label) (pop trueforms)))) + (unless (dolist (val range t) + (declare (fixnum val)) + (when (assoc val all) + (return nil)) + (push (cons val info) all) + (if (< val min) + (setq min val) + (if (> val max) + (setq max val))) + (incf count)) + (return nil)))) + (let* ((span (1+ (- max min)))) + (declare (fixnum span)) + (when (and (typep min '(signed-byte 32)) + (typep (- max min) 'unsigned-byte 32) + (> count 4) + (> count (the fixnum (- span (the fixnum (ash span -2)))))) + (let* ((defaultlabel (backend-get-next-label)) + (endlabel (backend-get-next-label)) + (reg ($ *x862-arg-z*))) + (x862-use-operator (%nx1-operator lexical-reference) + seg reg nil var) + (! cjmp reg (ash min *x862-target-fixnum-shift*) (ash (- max min) *x862-target-fixnum-shift*) (aref *backend-labels* defaultlabel)) + (do* ((val min (1+ val))) + ((> val max)) + (declare (fixnum val)) + (let* ((info (assoc val all))) + (! jtabentry (aref *backend-labels* (if info (cadr info) defaultlabel))))) + (let* ((target (x862-cd-merge xfer endlabel))) + (dolist (case (nreverse all)) + (let* ((lab (cadr case)) + (form (cddr case))) + (@= lab) + (x862-form seg vreg target form))) + (@= defaultlabel) + (x862-form seg vreg target otherwise) + (@ endlabel) + (when (x862-mvpass-p xfer) + (^)) + t))))))))))) (defx862 x862-if if (seg vreg xfer testform true false &aux test-val) (if (setq test-val (nx2-constant-form-value (acode-unwrapped-form-value testform))) (x862-form seg vreg xfer (if (nx-null test-val) false true)) - (let* ((cstack *x862-cstack*) - (vstack *x862-vstack*) - (top-lcell *x862-top-vstack-lcell*) - (entry-stack (x862-encode-stack)) - (true-stack nil) - (false-stack nil) - (true-cleanup-label nil) - (same-stack-effects nil) - (true-is-goto (x862-go-label true)) - (false-is-goto (and (not true-is-goto) (x862-go-label false))) - (endlabel (backend-get-next-label)) - (falselabel (backend-get-next-label)) - (need-else (unless false-is-goto (or (not (nx-null false)) (x862-for-value-p vreg)))) - (both-single-valued (and (not *x862-open-code-inline*) - (eq xfer $backend-return) - (x862-for-value-p vreg) - need-else - (x862-single-valued-form-p true) - (x862-single-valued-form-p false)))) - (if (eq 0 xfer) - (setq xfer nil)) - (if both-single-valued ; it's implied that we're returning - (let* ((result *x862-arg-z*)) - (let ((merge-else-branch-label (if (nx-null false) (x862-find-nilret-label)))) - (x862-conditional-form seg (x862-make-compound-cd 0 falselabel) testform) - (x862-form seg result endlabel true) - (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label))) - (backend-copy-label merge-else-branch-label falselabel) + (multiple-value-bind (ranges trueforms var otherwise) + (nx2-reconstruct-case testform true false) + (or (x862-generate-casejump seg vreg xfer ranges trueforms var otherwise) + (let* ((cstack *x862-cstack*) + (vstack *x862-vstack*) + (top-lcell *x862-top-vstack-lcell*) + (entry-stack (x862-encode-stack)) + (true-stack nil) + (false-stack nil) + (true-cleanup-label nil) + (same-stack-effects nil) + (true-is-goto (x862-go-label true)) + (false-is-goto (and (not true-is-goto) (x862-go-label false))) + (endlabel (backend-get-next-label)) + (falselabel (backend-get-next-label)) + (need-else (unless false-is-goto (or (not (nx-null false)) (x862-for-value-p vreg)))) + (both-single-valued (and (not *x862-open-code-inline*) + (eq xfer $backend-return) + (x862-for-value-p vreg) + need-else + (x862-single-valued-form-p true) + (x862-single-valued-form-p false)))) + (if (eq 0 xfer) + (setq xfer nil)) + (if both-single-valued ; it's implied that we're returning + (let* ((result *x862-arg-z*)) + (let ((merge-else-branch-label (if (nx-null false) (x862-find-nilret-label)))) + (x862-conditional-form seg (x862-make-compound-cd 0 falselabel) testform) + (x862-form seg result endlabel true) + (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label))) + (backend-copy-label merge-else-branch-label falselabel) + (progn + (@ falselabel) + (if (nx-null false) (@ (x862-record-nilret-label))) + (x862-form seg result nil false))) + (@ endlabel) + (<- result) + (^))) (progn - (@ falselabel) - (if (nx-null false) (@ (x862-record-nilret-label))) - (x862-form seg result nil false))) - (@ endlabel) - (<- result) - (^))) - (progn - (if (and need-else (x862-mvpass-p xfer)) - (setq true-cleanup-label (backend-get-next-label))) - (x862-conditional-form - seg - (x862-make-compound-cd - (or true-is-goto 0) - (or false-is-goto - (if need-else - (if true-is-goto 0 falselabel) - (if true-is-goto xfer (x862-cd-merge xfer falselabel))))) - testform) - (if true-is-goto - (x862-unreachable-store) - (if true-cleanup-label - (progn - (x862-open-undo $undomvexpect) - (x862-form seg vreg (logior $backend-mvpass-mask true-cleanup-label) true)) - (x862-form seg vreg (if need-else (x862-cd-merge xfer endlabel) xfer) true))) - (setq true-stack (x862-encode-stack)) - (setq *x862-cstack* cstack) - (x862-set-vstack vstack) - (setq *x862-top-vstack-lcell* top-lcell) - (if false-is-goto (x862-unreachable-store)) - (let ((merge-else-branch-label (if (and (nx-null false) (eq xfer $backend-return)) (x862-find-nilret-label)))) - (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label))) - (backend-copy-label merge-else-branch-label falselabel) - (progn - (@ falselabel) - (when need-else + (if (and need-else (x862-mvpass-p xfer)) + (setq true-cleanup-label (backend-get-next-label))) + (x862-conditional-form + seg + (x862-make-compound-cd + (or true-is-goto 0) + (or false-is-goto + (if need-else + (if true-is-goto 0 falselabel) + (if true-is-goto xfer (x862-cd-merge xfer falselabel))))) + testform) + (if true-is-goto + (x862-unreachable-store) (if true-cleanup-label - (x862-mvpass seg false) - (x862-form seg vreg xfer false)) - (setq false-stack (x862-encode-stack)))))) - (when true-cleanup-label - (if (setq same-stack-effects (x862-equal-encodings-p true-stack false-stack)) ; can share cleanup code - (@ true-cleanup-label)) - (let* ((*x862-returning-values* :pass)) - (x862-nlexit seg xfer 1) - (x862-branch seg (if (and xfer (neq xfer $backend-mvpass-mask)) xfer (if (not same-stack-effects) endlabel)))) - (unless same-stack-effects - (@ true-cleanup-label) - (multiple-value-setq (true *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*) - (x862-decode-stack true-stack)) - (let* ((*x862-returning-values* :pass)) - (x862-nlexit seg xfer 1) - (^))) - (x862-close-undo) - (multiple-value-setq (*x862-undo-count* *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*) - (x862-decode-stack entry-stack))) - (@ endlabel)))))) + (progn + (x862-open-undo $undomvexpect) + (x862-form seg vreg (logior $backend-mvpass-mask true-cleanup-label) true)) + (x862-form seg vreg (if need-else (x862-cd-merge xfer endlabel) xfer) true))) + (setq true-stack (x862-encode-stack)) + (setq *x862-cstack* cstack) + (x862-set-vstack vstack) + (setq *x862-top-vstack-lcell* top-lcell) + (if false-is-goto (x862-unreachable-store)) + (let ((merge-else-branch-label (if (and (nx-null false) (eq xfer $backend-return)) (x862-find-nilret-label)))) + (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label))) + (backend-copy-label merge-else-branch-label falselabel) + (progn + (@ falselabel) + (when need-else + (if true-cleanup-label + (x862-mvpass seg false) + (x862-form seg vreg xfer false)) + (setq false-stack (x862-encode-stack)))))) + (when true-cleanup-label + (if (setq same-stack-effects (x862-equal-encodings-p true-stack false-stack)) ; can share cleanup code + (@ true-cleanup-label)) + (let* ((*x862-returning-values* :pass)) + (x862-nlexit seg xfer 1) + (x862-branch seg (if (and xfer (neq xfer $backend-mvpass-mask)) xfer (if (not same-stack-effects) endlabel)))) + (unless same-stack-effects + (@ true-cleanup-label) + (multiple-value-setq (true *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*) + (x862-decode-stack true-stack)) + (let* ((*x862-returning-values* :pass)) + (x862-nlexit seg xfer 1) + (^))) + (x862-close-undo) + (multiple-value-setq (*x862-undo-count* *x862-cstack* *x862-vstack* *x862-top-vstack-lcell*) + (x862-decode-stack entry-stack))) + (@ endlabel)))))))) (defx862 x862-or or (seg vreg xfer forms)