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

Last change on this file since 4421 was 4421, checked in by gb, 16 years ago

Change EQL doc string.

  • 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  (jne @lose)
63  @win
64  (movq ($ t) (% arg_z))
65  (single-value-return)
66  @ratio
67  @complex
68  (save-simple-frame)
69  (pushq (@ x8664::ratio.denom (% x)))  ; aka complex.imagpart
70  (pushq (@ x8664::ratio.denom (% y)))
71  (movq (@ x8664::ratio.numer (% x)) (% x))       ; aka complex.realpart
72  (movq (@ x8664::ratio.numer (% y)) (% y))       ; aka complex.realpart
73  (lea (@ (:^ @back) (% fn)) (% ra0))
74  (jmp @top)
75  (:tra @back)
76  (recover-fn-from-ra0 @back)
77  (cmp-reg-to-nil arg_z)
78  (pop (% y))
79  (pop (% x))
80  (restore-simple-frame)
81  (jnz @tail)
82  ;; lose, again
83  (movq ($ nil) (% 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  (xorq (% imm1) (% imm1))
92  @bignum-next
93  (movl (@ x8664::misc-data-offset (% x) (% imm1)) (% imm0.l))
94  (cmpl (@ x8664::misc-data-offset (% y) (% imm1)) (% imm0.l))
95  (jne @lose)
96  (addq ($ 4) (% imm1))
97  (sub ($ '1) (% temp0))
98  (jnz @bignum-next)
99  (movq ($ t) (% arg_z))
100  (single-value-return))
101 
102
103
104(defx86lapfunction equal ((x arg_y) (y arg_z))
105  "Return T if X and Y are EQL or if they are structured components
106  whose elements are EQUAL. Strings and bit-vectors are EQUAL if they
107  are the same length and have identical components. Other arrays must be
108  EQ to be EQUAL.  Pathnames are EQUAL if their components are."
109  (check-nargs 2)
110  @top
111  @tail
112  (cmpq (% x) (% y))
113  (je @win)
114  (extract-fulltag x imm0)
115  (extract-fulltag y imm1)
116  (cmpb (% imm0.b) (% imm1.b))
117  (jne @lose)
118  (cmpb ($ x8664::fulltag-cons) (% imm0.b))
119  (je @cons)
120  (cmpb ($ x8664::fulltag-misc) (% imm0.b))
121  (je @misc)
122  @lose
123  (movq ($ nil) (% arg_z))
124  (single-value-return)
125  @win
126  (movq ($ t) (% arg_z))
127  (single-value-return)
128  @cons
129  ;; Check to see if the CARs are EQ.  If so, we can avoid saving
130  ;; context, and can just tail call ourselves on the CDRs.
131  (%car x temp0)
132  (%car y temp1)
133  (cmpq (% temp0) (% temp1))
134  (jne @recurse)
135  (%cdr x x)
136  (%cdr y y)
137  (jmp @tail)
138  @recurse
139  (save-simple-frame)
140  (pushq (@ x8664::cons.cdr (% x)))
141  (pushq (@ x8664::cons.cdr (% y)))
142  (movq (% temp0) (% x))
143  (movq (% temp1) (% y))
144  (lea (@ (:^ @back) (% fn)) (% ra0))
145  (jmp @top)
146  (:tra @back)
147  (recover-fn-from-ra0 @back)
148  (cmp-reg-to-nil arg_z)
149  (pop (% y))
150  (pop (% x))
151  (restore-simple-frame)         
152  (jnz @top)
153  (movl ($ nil) (% arg_z.l))
154  (single-value-return)
155  @misc
156  ;; Both objects are uvectors of some sort.  Try EQL; if that fails,
157  ;; call HAIRY-EQUAL.
158  (save-simple-frame)
159  (pushq (% x))
160  (pushq (% y))
161  (call-symbol eql 2)
162  (cmp-reg-to-nil arg_z)
163  (jne @won-with-eql)
164  (popq (% y))
165  (popq (% x))
166  (restore-simple-frame)
167  (jump-symbol hairy-equal 2)
168  @won-with-eql
169  (restore-simple-frame)                ; discards pushed args
170  (movl ($ t) (% arg_z.l))
171  (single-value-return))
172
173(defx86lapfunction %lisp-lowbyte-ref ((thing arg_z))
174  (box-fixnum thing arg_z)
175  (andl ($ '#xff) (%l arg_z))
176  (single-value-return))
177
178
179     
180
181
182
183
184
185
186
Note: See TracBrowser for help on using the repository browser.