src/compiler/x86/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
  14 (file-comment
  15  "$Header$")
  16 \f
  17 ;;;; the branch VOP
  18
  19 ;;; The unconditional branch, emitted when we can't drop through to the desired
  20 ;;; destination. Dest is the continuation we transfer control to.
  21 (define-vop (branch)
  22   (:info dest)
  23   (:generator 5
  24     (inst jmp dest)))
  25
  26 \f
  27 ;;;; conditional VOPs
  28
  29 ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement,
  30 ;;; not immediate data.
  31 (define-vop (if-eq)
  32   (:args (x :scs (any-reg descriptor-reg control-stack constant)
  33             :load-if (not (and (sc-is x immediate)
  34                                (sc-is y any-reg descriptor-reg
  35                                       control-stack constant))))
  36          (y :scs (any-reg descriptor-reg immediate)
  37             :load-if (not (and (sc-is x any-reg descriptor-reg immediate)
  38                                (sc-is y control-stack constant)))))
  39   (:conditional)
  40   (:info target not-p)
  41   (:policy :fast-safe)
  42   (:translate eq)
  43   (:generator 3
  44     (cond
  45      ((sc-is y immediate)
  46       (let ((val (tn-value y)))
  47         (etypecase val
  48           (integer
  49            (if (and (zerop val) (sc-is x any-reg descriptor-reg))
  50                (inst test x x) ; smaller
  51              (inst cmp x (fixnumize val))))
  52           (symbol
  53            (inst cmp x (+ *nil-value* (static-symbol-offset val))))
  54           (character
  55            (inst cmp x (logior (ash (char-code val) type-bits)
  56                                base-char-type))))))
  57      ((sc-is x immediate) ; and y not immediate
  58       ;; Swap the order to fit the compare instruction.
  59       (let ((val (tn-value x)))
  60         (etypecase val
  61           (integer
  62            (if (and (zerop val) (sc-is y any-reg descriptor-reg))
  63                (inst test y y) ; smaller
  64              (inst cmp y (fixnumize val))))
  65           (symbol
  66            (inst cmp y (+ *nil-value* (static-symbol-offset val))))
  67           (character
  68            (inst cmp y (logior (ash (char-code val) type-bits)
  69                                base-char-type))))))
  70       (t
  71        (inst cmp x y)))
  72
  73     (inst jmp (if not-p :ne :e) target)))