Index: /trunk/source/compiler/X86/X8632/x8632-vinsns.lisp =================================================================== --- /trunk/source/compiler/X86/X8632/x8632-vinsns.lisp (revision 15003) +++ /trunk/source/compiler/X86/X8632/x8632-vinsns.lisp (revision 15004) @@ -4217,12 +4217,11 @@ (movl (:@ (:% x8632::ebp)) (:% x8632::ebp))) -(define-x8632-vinsn (cjmp :branch) (((reg :lisp)) - ((reg :lisp) +(define-x8632-vinsn (cjmp :branch) (((reg :s32)) + ((reg :s32) (minval :s32const) (maxval :u32const) (default :label)) - ((temp :s32) - (rjmp :lisp))) - (testl (:$l x8664::fixnummask) (:%l reg)) + ((rjmp :lisp))) + (testl (:$l x8632::fixnummask) (:%l reg)) (jne default) ((:not (:pred zerop minval)) @@ -4230,7 +4229,6 @@ (cmpl (:$l maxval) (:%l reg)) (ja default) - (movl (:%l reg) (:%l temp)) - (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l temp)) (:%l temp)) - (leal (:@ (:%l x8632::fn) (:%l temp)) (:%l rjmp)) + (movl (:@ (:^ :jtab) (:%l x8632::fn) (:%l reg)) (:%l reg)) + (leal (:@ (:%l x8632::fn) (:%l reg)) (:%l rjmp)) (jmp (:%l rjmp)) (:uuo-section) Index: /trunk/source/compiler/X86/X8664/x8664-vinsns.lisp =================================================================== --- /trunk/source/compiler/X86/X8664/x8664-vinsns.lisp (revision 15003) +++ /trunk/source/compiler/X86/X8664/x8664-vinsns.lisp (revision 15004) @@ -4632,11 +4632,10 @@ (movq (:@ (:%q x8664::rbp)) (:%q x8664::rbp))) -(define-x8664-vinsn (cjmp :branch) (((reg :lisp)) - ((reg :lisp) +(define-x8664-vinsn (cjmp :branch) (((reg :s64)) + ((reg :s64) (minval :s32const) (maxval :u32const) (default :label)) - ((temp :s32) - (rjmp :lisp))) + ((rjmp :lisp))) (testl (:$l x8664::fixnummask) (:%l reg)) (jne default) @@ -4645,8 +4644,7 @@ (cmpq (:$l maxval) (:%q reg)) (ja default) - (movl (:%l reg) (:%l temp)) - (shrl (:%l temp)) - (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q temp)) (:%l temp)) - (leaq (:@ (:%q x8664::fn) (:%q temp)) (:%q rjmp)) + (shrl (:%l reg)) + (movl (:@ (:^ :jtab) (:%q x8664::fn) (:%q reg)) (:%l reg)) + (leaq (:@ (:%q x8664::fn) (:%q reg)) (:%q rjmp)) (jmp (:%q rjmp)) (:uuo-section) @@ -4654,6 +4652,5 @@ (:long (:apply 1+ (:apply ash maxval (- x8664::fixnumshift)))) :jtab) - - + (define-x8664-vinsn jtabentry (() Index: /trunk/source/compiler/X86/x86-disassemble.lisp =================================================================== --- /trunk/source/compiler/X86/x86-disassemble.lisp (revision 15003) +++ /trunk/source/compiler/X86/x86-disassemble.lisp (revision 15004) @@ -2481,10 +2481,27 @@ (let* ((jtab (is-jump-table-ref op0))) (if (and jtab (> jtab 0)) - (let* ((count (x86-ds-u32-ref ds (- jtab 4)))) + (let* ((count (x86-ds-u32-ref ds (- jtab 4))) + (block (make-x86-dis-block :start-address jtab + :end-address (+ jtab (* 4 count)))) + (instructions (x86-dis-block-instructions block)) + (labeled t)) + (setf (x86::x86-memory-operand-disp op0) + (parse-x86-lap-expression `(:^ ,jtab))) (dotimes (i count) - (push (+ (x86-ds-u32-ref ds jtab) - (x86-ds-entry-point ds)) - (x86-ds-pending-labels ds)) - (incf jtab 4))) + (let* ((target (+ (x86-ds-u32-ref ds jtab) + (x86-ds-entry-point ds))) + (start (+ jtab (x86-ds-entry-point ds))) + (instruction (make-x86-disassembled-instruction + :address jtab + :labeled labeled + :mnemonic ":long" + :op0 (parse-x86-lap-expression `(:^ ,target)) + :start start + :end (+ start 4)))) + (append-dll-node instruction instructions) + (setq labeled nil) + (push target (x86-ds-pending-labels ds)) + (incf jtab 4))) + (insert-x86-block block (x86-ds-blocks ds))) (unless (x86-ds-mode-64 ds) (when (and (is-fn op1) @@ -2719,4 +2736,8 @@ (format nil "L~d" (- addr entrypoint)))) +(defmethod unparse-x86-lap-operand ((op label-x86-lap-expression) + ds) + (unparse-x86-lap-expression op ds)) + (defmethod x86-lap-operand-constant-offset (op ds) @@ -2812,5 +2833,5 @@ (defvar *previous-source-note*) -(defun x86-print-di-lap (ds instruction &optional tab-stop) +(defun x86-print-di-lap (ds instruction tab-stop pc) (dolist (p (x86-di-prefixes instruction)) (when tab-stop @@ -2829,5 +2850,6 @@ (when op2 (write-x86-lap-operand t op2 ds))))) - (format t ")~%")) + (format t ")~vt;~8<[~D]~>" (+ 40 tab-stop) pc) + (format t "~%")) (defun x86-print-disassembled-instruction (ds instruction seq function) @@ -2847,5 +2869,5 @@ (format t "~&L~d~%" pc) (setq seq 0)) - (format t "~&~8<[~D]~>" pc) + (format t "~&") (let* ((istart (x86-di-start instruction)) (iend (x86-di-end instruction)) @@ -2859,5 +2881,5 @@ (incf byteidx)) (decf nbytes 4)) - (x86-print-di-lap ds instruction tab-stop) + (x86-print-di-lap ds instruction tab-stop pc) (when *disassemble-verbose* (while (plusp nbytes) Index: /trunk/source/compiler/X86/x862.lisp =================================================================== --- /trunk/source/compiler/X86/x862.lisp (revision 15003) +++ /trunk/source/compiler/X86/x862.lisp (revision 15004) @@ -7308,60 +7308,68 @@ (^))))) -(defparameter *x862-generate-casejump* nil) +(defparameter *x862-generate-casejump* t) (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))))))))))) + (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 (ash min *x862-target-fixnum-shift*) '(signed-byte 32)) + (typep (ash (- max min) *x862-target-fixnum-shift*) '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-imm0*))) + (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 (if (x862-mvpass-p xfer) + (logior $backend-mvpass-mask endlabel) + (x862-cd-merge xfer endlabel))) + (entry-stack (x862-encode-stack))) + (dolist (case (nreverse all)) + (let* ((lab (cadr case)) + (form (cddr case))) + (@= lab) + (multiple-value-setq (*x862-undo-count* + *x862-cstack* + *x862-vstack* + *x862-top-vstack-lcell*) + (x862-decode-stack entry-stack)) + (x862-undo-body seg vreg target form entry-stack))) + (@= defaultlabel) + (x862-form seg vreg target otherwise) + (@ endlabel) + (when (x862-mvpass-p xfer) + (let* ((*x862-returning-values* :pass)) + (^))) + t)))))))))) (defx862 x862-if if (seg vreg xfer testform true false &aux test-val)