source: trunk/ccl/level-0/X86/x86-pred.lisp @ 6482

Last change on this file since 6482 was 6482, checked in by gb, 15 years ago

New calling sequence. Use a CMOV in EQL.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.9 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel :execute)
20  (require "X86-LAPMACROS"))
21
22
23(defx86lapfunction eql ((x arg_y) (y arg_z))
24  "Return T if OBJ1 and OBJ2 represent either the same object or
25numbers with the same type and value."
26  (check-nargs 2)
27  @top
28  @tail
29  (cmpq (% x) (% y))
30  (je @win)
31  (extract-fulltag x imm0)
32  (extract-fulltag y imm1)
33  (cmpb (% imm0.b) (% imm1.b))
34  (jnz @lose)
35  (cmpb ($ x8664::fulltag-misc) (% imm0.b))
36  (jnz @lose)
37  (getvheader x imm0)
38  (getvheader y imm1)
39  (cmpb ($ x8664::subtag-macptr) (% imm0.b))
40  (je @macptr)                          ; will need to check %imm1.b
41  (cmpq (% imm0) (% imm1))
42  (jne @lose)
43  (cmpb ($ x8664::subtag-bignum) (% imm0.b))
44  (je @bignum)
45  (cmpb ($ x8664::subtag-double-float) (% imm0.b))
46  (je @double-float)
47  (cmpb ($ x8664::subtag-complex) (% imm0.b))
48  (je @complex)
49  (cmpb ($ x8664::subtag-ratio) (% imm0.b))
50  (je @ratio)
51  @lose
52  (movq ($ nil) (% arg_z))
53  (single-value-return)
54  @macptr
55  (cmpb ($ x8664::subtag-macptr) (% imm1.b))
56  (jne @lose)
57  @double-float
58  (movq  (@ x8664::misc-data-offset (% x)) (% imm0))
59  (movq  (@ x8664::misc-data-offset (% y)) (% imm1))
60  @test
61  (cmpq (% imm0) (% imm1))
62  (movl ($ x8664::t-value) (%l imm0))
63  (lea (@ (- x8664::t-offset) (% imm0)) (% arg_z))
64  (cmovel (%l imm0) (%l arg_z))
65  (single-value-return)
66  @win
67  (movq ($ t) (% arg_z))
68  (single-value-return)
69  @ratio
70  @complex
71  (save-simple-frame)
72  (pushq (@ x8664::ratio.denom (% x)))  ; aka complex.imagpart
73  (pushq (@ x8664::ratio.denom (% y)))
74  (movq (@ x8664::ratio.numer (% x)) (% x))       ; aka complex.realpart
75  (movq (@ x8664::ratio.numer (% y)) (% y))       ; aka complex.realpart
76  (:talign 3)
77  (call @top)
78  (recover-fn-from-rip)
79  (cmp-reg-to-nil arg_z)
80  (pop (% y))
81  (pop (% x))
82  (restore-simple-frame)
83  (jnz @tail)
84  ;; lose, again
85  (movq ($ nil) (% arg_z))
86  (single-value-return)
87  @bignum
88  ;; Way back when, we got x's header into imm0.  We know that y's
89  ;; header is identical.  Use the element-count from imm0 to control
90  ;; the loop.  There's no such thing as a 0-element bignum, so the
91  ;; loop must always execute at least once.
92  (header-length imm0 temp0)
93  (xorq (% imm1) (% imm1))
94  @bignum-next
95  (movl (@ x8664::misc-data-offset (% x) (% imm1)) (% imm0.l))
96  (cmpl (@ x8664::misc-data-offset (% y) (% imm1)) (% imm0.l))
97  (jne @lose)
98  (addq ($ 4) (% imm1))
99  (sub ($ '1) (% temp0))
100  (jnz @bignum-next)
101  (movq ($ t) (% arg_z))
102  (single-value-return))
103 
104
105
106(defx86lapfunction 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  (cmpq (% x) (% y))
115  (je @win)
116  (extract-fulltag x imm0)
117  (extract-fulltag y imm1)
118  (cmpb (% imm0.b) (% imm1.b))
119  (jne @lose)
120  (cmpb ($ x8664::fulltag-cons) (% imm0.b))
121  (je @cons)
122  (cmpb ($ x8664::fulltag-misc) (% imm0.b))
123  (je @misc)
124  @lose
125  (movq ($ nil) (% arg_z))
126  (single-value-return)
127  @win
128  (movq ($ t) (% arg_z))
129  (single-value-return)
130  @cons
131  ;; Check to see if the CARs are EQ.  If so, we can avoid saving
132  ;; context, and can just tail call ourselves on the CDRs.
133  (%car x temp0)
134  (%car y temp1)
135  (cmpq (% temp0) (% temp1))
136  (jne @recurse)
137  (%cdr x x)
138  (%cdr y y)
139  (jmp @tail)
140  @recurse
141  (save-simple-frame)
142  (pushq (@ x8664::cons.cdr (% x)))
143  (pushq (@ x8664::cons.cdr (% y)))
144  (movq (% temp0) (% x))
145  (movq (% temp1) (% y))
146  (:talign 4)
147  (call @top)
148  (recover-fn-from-rip)
149  (cmp-reg-to-nil arg_z)
150  (pop (% y))
151  (pop (% x))
152  (restore-simple-frame)         
153  (jnz @top)
154  (movl ($ nil) (% arg_z.l))
155  (single-value-return)
156  @misc
157  ;; Both objects are uvectors of some sort.  Try EQL; if that fails,
158  ;; call HAIRY-EQUAL.
159  (save-simple-frame)
160  (pushq (% x))
161  (pushq (% y))
162  (call-symbol eql 2)
163  (cmp-reg-to-nil arg_z)
164  (jne @won-with-eql)
165  (popq (% y))
166  (popq (% x))
167  (restore-simple-frame)
168  (jump-symbol hairy-equal 2)
169  @won-with-eql
170  (restore-simple-frame)                ; discards pushed args
171  (movl ($ t) (% arg_z.l))
172  (single-value-return))
173
174(defx86lapfunction %lisp-lowbyte-ref ((thing arg_z))
175  (box-fixnum thing arg_z)
176  (andl ($ '#xff) (%l arg_z))
177  (single-value-return))
178
179
180     
181
182
183
184
185
186
187
Note: See TracBrowser for help on using the repository browser.