1.0.1.4:
[sbcl.git] / 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 ;;;; conditional VOPs
25
26 ;;; Note: a constant-tn is allowed in CMP; it uses an EA displacement,
27 ;;; not immediate data.
28 (define-vop (if-eq)
29   (:args (x :scs (any-reg descriptor-reg control-stack constant)
30             :load-if (not (and (sc-is x immediate)
31                                (sc-is y any-reg descriptor-reg
32                                       control-stack constant))))
33          (y :scs (any-reg descriptor-reg immediate)
34             :load-if (not (and (sc-is x any-reg descriptor-reg immediate)
35                                (sc-is y control-stack constant)))))
36   (:temporary (:sc descriptor-reg) temp)
37   (:conditional)
38   (:info target not-p)
39   (:policy :fast-safe)
40   (:translate eq)
41   (:generator 3
42     (cond
43      ((sc-is y immediate)
44       (let ((val (tn-value y)))
45         (etypecase val
46           (integer
47            (if (and (zerop val) (sc-is x any-reg descriptor-reg))
48                (inst test x x) ; smaller
49              (let ((fixnumized (fixnumize val)))
50                (if (typep fixnumized
51                           '(or (signed-byte 32) (unsigned-byte 31)))
52                    (inst cmp x fixnumized)
53                  (progn
54                    (inst mov temp fixnumized)
55                    (inst cmp x temp))))))
56           (symbol
57            (inst cmp x (+ nil-value (static-symbol-offset val))))
58           (character
59            (inst cmp x (logior (ash (char-code val) n-widetag-bits)
60                                character-widetag))))))
61      ((sc-is x immediate) ; and y not immediate
62       ;; Swap the order to fit the compare instruction.
63       (let ((val (tn-value x)))
64         (etypecase val
65           (integer
66            (if (and (zerop val) (sc-is y any-reg descriptor-reg))
67                (inst test y y) ; smaller
68              (let ((fixnumized (fixnumize val)))
69                (if (typep fixnumized
70                           '(or (signed-byte 32) (unsigned-byte 31)))
71                    (inst cmp y fixnumized)
72                  (progn
73                    (inst mov temp fixnumized)
74                    (inst cmp y temp))))))
75           (symbol
76            (inst cmp y (+ nil-value (static-symbol-offset val))))
77           (character
78            (inst cmp y (logior (ash (char-code val) n-widetag-bits)
79                                character-widetag))))))
80       (t
81        (inst cmp x y)))
82
83     (inst jmp (if not-p :ne :e) target)))