src/compiler/x86-64/pred.lisp

   1 ;;;; predicate VOPs for the x86 VM
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13 \f
  14 ;;;; the branch VOP
  15
  16 ;;; The unconditional branch, emitted when we can't drop through to the desired
  17 ;;; destination. Dest is the continuation we transfer control to.
  18 (define-vop (branch)
  19   (:info dest)
  20   (:generator 5
  21     (inst jmp dest)))
  22
  23 \f
  24 ;;;; Generic conditional VOPs
  25
  26 ;;; The generic conditional branch, emitted immediately after test
  27 ;;; VOPs that only set flags.
  28
  29 (define-vop (branch-if)
  30   (:info dest flags not-p)
  31   (:ignore dest flags not-p)
  32   (:generator 0
  33      (error "BRANCH-IF not yet implemented")))
  34
  35 (!def-vm-support-routine
  36     convert-conditional-move-p (node dst-tn x-tn y-tn)
  37   (declare (ignore node dst-tn x-tn y-tn))
  38   nil)
  39
  40 \f
  41 ;;;; conditional VOPs
  42
  43 ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement,
  44 ;;; not immediate data.
  45 (define-vop (if-eq)
  46   (:args (x :scs (any-reg descriptor-reg control-stack constant)
  47             :load-if (not (and (sc-is x immediate)
  48                                (sc-is y any-reg descriptor-reg
  49                                       control-stack constant))))
  50          (y :scs (any-reg descriptor-reg immediate)
  51             :load-if (not (and (sc-is x any-reg descriptor-reg immediate)
  52                                (sc-is y control-stack constant)))))
  53   (:temporary (:sc descriptor-reg) temp)
  54   (:conditional)
  55   (:info target not-p)
  56   (:policy :fast-safe)
  57   (:translate eq)
  58   (:generator 3
  59     (cond
  60      ((sc-is y immediate)
  61       (let ((val (tn-value y)))
  62         (etypecase val
  63           (integer
  64            (if (and (zerop val) (sc-is x any-reg descriptor-reg))
  65                (inst test x x) ; smaller
  66              (let ((fixnumized (fixnumize val)))
  67                (if (typep fixnumized
  68                           '(or (signed-byte 32) (unsigned-byte 31)))
  69                    (inst cmp x fixnumized)
  70                  (progn
  71                    (inst mov temp fixnumized)
  72                    (inst cmp x temp))))))
  73           (symbol
  74            (inst cmp x (+ nil-value (static-symbol-offset val))))
  75           (character
  76            (inst cmp x (logior (ash (char-code val) n-widetag-bits)
  77                                character-widetag))))))
  78      ((sc-is x immediate) ; and y not immediate
  79       ;; Swap the order to fit the compare instruction.
  80       (let ((val (tn-value x)))
  81         (etypecase val
  82           (integer
  83            (if (and (zerop val) (sc-is y any-reg descriptor-reg))
  84                (inst test y y) ; smaller
  85              (let ((fixnumized (fixnumize val)))
  86                (if (typep fixnumized
  87                           '(or (signed-byte 32) (unsigned-byte 31)))
  88                    (inst cmp y fixnumized)
  89                  (progn
  90                    (inst mov temp fixnumized)
  91                    (inst cmp y temp))))))
  92           (symbol
  93            (inst cmp y (+ nil-value (static-symbol-offset val))))
  94           (character
  95            (inst cmp y (logior (ash (char-code val) n-widetag-bits)
  96                                character-widetag))))))
  97       (t
  98        (inst cmp x y)))
  99
 100     (inst jmp (if not-p :ne :e) target)))