source: branches/ia32/level-0/X86/X8632/x8632-pred.lisp @ 8905

Last change on this file since 8905 was 8905, checked in by rme, 11 years ago

EQL and EQUAL fixes.

File size: 5.2 KB
Line 
1(in-package "CCL")
2
3(eval-when (:compile-toplevel :execute)
4  (require "X86-LAPMACROS"))
5
6(defx8632lapfunction eql ((x arg_y) (y arg_z))
7  "Return T if OBJ1 and OBJ2 represent either the same object or
8numbers with the same type and value."
9  (check-nargs 2)
10  @top
11  @tail
12  (cmpl (% x) (% y))
13  (je @win)
14  (movl (% x) (% imm0))
15  (andb ($ x8632::fulltagmask) (% al))
16  (movb (% arg_z.b) (% ah))
17  (andb ($ x8632::fulltagmask) (% ah))
18  (cmpb (% al) (% ah))
19  (jnz @lose)
20  (cmpb ($ x8632::fulltag-misc) (% al))
21  (jnz @lose)
22  (cmpb ($ x8632::fulltag-misc) (% ah))
23  (jnz @lose)
24  ;; Objects are both of tag-misc.  Headers must match exactly;
25  ;; dispatch on subtag.
26  (getvheader x imm0)
27  ;;(getvheader y imm1)
28  (cmpb ($ x8632::subtag-macptr) (% imm0.b))
29  (je @macptr)                          ; will need to check subtag of %y
30  (cmp (% imm0) (@ x8632::misc-header-offset (% y)))
31  (jne @lose)
32  (cmpb ($ x8632::subtag-bignum) (% imm0.b))
33  (je @bignum)
34  (cmpb ($ x8632::subtag-single-float) (% imm0.b))
35  (je @one-unboxed-word)
36  (cmpb ($ x8632::subtag-double-float) (% imm0.b))
37  (je @double-float)
38  (cmpb ($ x8664::subtag-complex) (% imm0.b))
39  (je @complex)
40  (cmpb ($ x8664::subtag-ratio) (% imm0.b))
41  (je @ratio)
42  @lose
43  (movl ($ x8632::nil-value) (% arg_z))
44  (single-value-return)
45  @double-float
46  (movl (@ x8632::double-float.val-high (% x)) (% imm0))
47  (cmpl (% imm0) (@ x8632::double-float.val-high))
48  (jne @lose)
49  (movl (@ x8632::double-float.value (% x)) (% imm0))
50  (cmpl (% imm0) (@ x8632::double-float.value))
51  (jne @lose)
52  (movl ($ x8632::t-value) (% arg_z))
53  (single-value-return)
54  @macptr
55  (cmpb ($ x8632::subtag-macptr) (@ x8632::misc-subtag-offset (% y)))
56  (jne @lose)
57  @one-unboxed-word
58  (movl (@ x8632::misc-data-offset (% x)) (% imm0))
59  @test
60  (cmpl (% imm0) (@ x8632::misc-data-offset (% y)))
61  (movl ($ x8632::t-value) (%l imm0))
62  (lea (@ (- x8664::t-offset) (% imm0)) (% arg_z))
63  (cmovel (%l imm0) (%l arg_z))
64  (single-value-return)
65  @win
66  (movl ($ x8632::t-value) (% arg_z))
67  (single-value-return)
68  @ratio
69  @complex
70  ;; Have either a ratio or a complex.  In either case, corresponding
71  ;; elements of both objects must be EQL.  Recurse on the first
72  ;; elements.  If true, tail-call on the second, else fail.
73  (save-simple-frame)
74  (pushl (@ x8632::ratio.denom (% x)))  ; aka complex.imagpart
75  (pushl (@ x8632::ratio.denom (% y)))
76  (movl (@ x8632::ratio.numer (% x)) (% x))       ; aka complex.realpart
77  (movl (@ x8632::ratio.numer (% y)) (% y))       ; aka complex.realpart
78  (:talign 5)
79  (call @top)
80  (recover-fn)
81  (cmp-reg-to-nil arg_z)
82  (pop (% y))
83  (pop (% x))
84  (restore-simple-frame)
85  (jnz @tail)
86  ;; lose, again
87  (movl ($ x8632::nil-value) (% arg_z))
88  (single-value-return)
89  @bignum
90  ;; Way back when, we got x's header into imm0.  We know that y's
91  ;; header is identical.  Use the element-count from imm0 to control
92  ;; the loop.  There's no such thing as a 0-element bignum, so the
93  ;; loop must always execute at least once.
94  (header-length imm0 temp0)
95  (xor (% temp1) (% temp1))
96  @bignum-next
97  (movl (@ x8632::misc-data-offset (% x) (% temp1)) (% imm0))
98  (cmpl (@ x8632::misc-data-offset (% y) (% temp1)) (% imm0))
99  (jne @lose)
100  (addl ($ '1) (% temp1))
101  (sub ($ '1) (% temp0))
102  (jnz @bignum-next)
103  (movl ($ x8632::t-value) (% arg_z))
104  (single-value-return))
105
106(defx8632lapfunction equal ((x arg_y) (y arg_z))
107  "Return T if X and Y are EQL or if they are structured components
108  whose elements are EQUAL. Strings and bit-vectors are EQUAL if they
109  are the same length and have identical components. Other arrays must be
110  EQ to be EQUAL.  Pathnames are EQUAL if their components are."
111  (check-nargs 2)
112  @top
113  @tail
114  (cmp (% x) (% y))
115  (je @win)
116  (movl (% x) (% imm0))
117  (andb ($ x8632::fulltagmask) (% al))
118  (movb (% arg_z.b) (% ah))
119  (andb ($ x8632::fulltagmask) (% ah))
120  (cmpb (% al) (% ah))
121  (jnz @lose)
122  (cmpb ($ x8632::fulltag-cons) (% imm0.b))
123  (je @cons)
124  (cmpb ($ x8632::fulltag-misc) (% imm0.b))
125  (je @misc)
126  @lose
127  (movl ($ x8632::nil-value) (% arg_z))
128  (single-value-return)
129  @win
130  (movl ($ x8632::t-value) (% arg_z))
131  (single-value-return)
132  @cons
133  ;; Check to see if the CARs are EQ.  If so, we can avoid saving
134  ;; context, and can just tail call ourselves on the CDRs.
135  (%car x temp0)
136  (%car y temp1)
137  (cmpl (% temp0) (% temp1))
138  (jne @recurse)
139  (%cdr x x)
140  (%cdr y y)
141  (jmp @tail)
142  @recurse
143  (save-simple-frame)
144  (pushl (@ x8632::cons.cdr (% x)))
145  (pushl (@ x8632::cons.cdr (% y)))
146  (movl (% temp0) (% x))
147  (movl (% temp1) (% y))
148  (:talign 5)
149  (call @top)
150  (recover-fn)
151  (cmp-reg-to-nil arg_z)
152  (pop (% y))
153  (pop (% x))
154  (restore-simple-frame)         
155  (jnz @top)
156  (movl ($ x8632::nil-value) (% arg_z))
157  (single-value-return)
158  @misc
159  ;; Both objects are uvectors of some sort.  Try EQL; if that fails,
160  ;; call HAIRY-EQUAL.
161  (save-simple-frame)
162  (pushl (% x))
163  (pushl (% y))
164  (call-symbol eql 2)
165  (cmp-reg-to-nil arg_z)
166  (jne @won-with-eql)
167  (popl (% y))
168  (popl (% x))
169  (restore-simple-frame)
170  (jump-symbol hairy-equal 2)
171  @won-with-eql
172  (restore-simple-frame)                ; discards pushed args
173  (movl ($ x8632::t-value) (% arg_z))
174  (single-value-return))
175
176(defx8632lapfunction %lisp-lowbyte-ref ((thing arg_z))
177  (box-fixnum thing arg_z)
178  (andl ($ '#xff) (%l arg_z))
179  (single-value-return))
Note: See TracBrowser for help on using the repository browser.