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

Last change on this file since 7999 was 7999, checked in by rme, 12 years ago

New file.

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