source: branches/working-0710/ccl/level-0/X86/x86-clos.lisp @ 7490

Last change on this file since 7490 was 7490, checked in by gb, 14 years ago

In %SMALL-MAP-SLOT-ID-LOOKUP, don't shift before the MOVQ at @have-table-index,
since that'll happen when the index is scaled in that MOVQ anyway.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.5 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2006, Clozure Associates and contributors
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;;; It's easier to keep this is LAP; we want to play around with its
20;;; constants.
21
22
23;;; This just maps a SLOT-ID to a SLOT-DEFINITION or NIL.
24;;; The map is a vector of (UNSIGNED-BYTE 8); this should
25;;; be used when there are fewer than 255 slots in the class.
26(defx86lapfunction %small-map-slot-id-lookup ((slot-id arg_z))
27  (movq (@ 'map (% fn)) (% temp1))
28  (svref slot-id slot-id.index arg_x)
29  (vector-length temp1 imm0)
30  (xorl (%l imm1) (%l imm1))
31  (rcmpq (% arg_x) (% imm0))
32  (movq (@ 'table (% fn)) (% temp0))
33  (ja @have-table-index)
34  (movq (% arg_x) (% imm1))
35  (shrq ($ x8664::word-shift) (% imm1))
36  (movzbl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
37  @have-table-index
38  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
39  (single-value-return))
40
41;;; The same idea, only the map is a vector of (UNSIGNED-BYTE 32).
42(defx86lapfunction %large-map-slot-id-lookup ((slot-id arg_z))
43  (movq (@ 'map (% fn)) (% temp1))
44  (svref slot-id slot-id.index arg_x)
45  (vector-length temp1 imm0)
46  (xorl (%l imm1) (%l imm1))
47  (rcmpq (% arg_x) (% imm0))
48  (movq (@ 'table (% fn)) (% temp0))
49  (ja @have-table-index)
50  (movq (% arg_x) (% imm1))
51  (shrq ($ 1) (% imm1))
52  (movl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
53  @have-table-index
54  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
55  (single-value-return))
56
57
58(defx86lapfunction %small-slot-id-value ((instance arg_y) (slot-id arg_z))
59  (movq (@ 'map (% fn)) (% temp1))
60  (svref slot-id slot-id.index arg_x)
61  (vector-length temp1 imm0)
62  (xorl (%l imm1) (%l imm1))
63  (rcmpq (% arg_x) (% imm0))
64  (movq (@ 'table (% fn)) (% temp0))
65  (ja @missing)
66  (movq (% arg_x) (% imm1))
67  (shrq ($ x8664::word-shift) (% imm1))
68  (movzbl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
69  (testl (%l imm1) (%l imm1))
70  (je @missing)
71  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
72  (movq (@ 'class (% fn)) (% arg_x))
73  (set-nargs 3)
74  (jmp (@ '%maybe-std-std-value-using-class (% fn)))
75  @missing                              ; (%slot-id-ref-missing instance id)
76  (set-nargs 2)
77  (jmp (@'%slot-id-ref-missing (% fn))))
78
79(defx86lapfunction %large-slot-id-value ((instance arg_y) (slot-id arg_z)) 
80  (movq (@ 'map (% fn)) (% temp1))
81  (svref slot-id slot-id.index arg_x)
82  (vector-length temp1 imm0)
83  (xorl (%l imm1) (%l imm1))
84  (rcmpq (% arg_x) (% imm0))
85  (movq (@ 'table (% fn)) (% temp0))
86  (ja @missing)
87  (movq (% arg_x) (% imm1))
88  (shrq ($ 1) (% imm1))
89  (movl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
90  (testl (%l imm1) (%l imm1))
91  (je @missing)
92  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
93  (movq (@ 'class (% fn)) (% arg_x))
94  (set-nargs 3)
95  (jmp (@ '%maybe-std-std-value-using-class (% fn)))
96  @missing                              ; (%slot-id-ref-missing instance id)
97  (set-nargs 2)
98  (jmp (@'%slot-id-ref-missing (% fn))))
99
100 
101(defx86lapfunction %small-set-slot-id-value ((instance arg_x)
102                                             (slot-id arg_y)
103                                             (new-value arg_z))
104  (movq (@ 'map (% fn)) (% temp1))
105  (svref slot-id slot-id.index imm1)
106  (vector-length temp1 imm0)
107  (rcmpq (% imm1) (% imm0))
108  (movq (@ 'table (% fn)) (% temp0))
109  (ja @missing)
110  (shrq ($ x8664::word-shift) (% rdx))
111  (movzbl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
112  (testl (%l imm1) (%l imm1))
113  (je @missing)
114  (popq (% ra0))
115  (pushq ($ 0))                         ; reserve frame
116  (pushq ($ 0))
117  (pushq (@ 'class (% fn)))
118  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_y))
119  (set-nargs 4)
120  (pushq (% ra0))
121  (jmp (@ '%maybe-std-setf-slot-value-using-class (% fn)))
122  @missing                              ; (%slot-id-set-missing instance id new-value)
123  (set-nargs 3)
124  (jmp (@ '%slot-id-set-missing (% fn))))
125
126
127(defx86lapfunction %large-set-slot-id-value ((instance arg_x)
128                                             (slot-id arg_y)
129                                             (new-value arg_z))
130  (movq (@ 'map (% fn)) (% temp1))
131  (svref slot-id slot-id.index imm1)
132  (vector-length temp1 imm0)
133  (rcmpq (% imm1) (% imm0))
134  (movq (@ 'table (% fn)) (% temp0))
135  (ja @missing)
136  (shrq ($ x8664::word-shift) (% rdx))
137  (movl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
138  (testl (%l imm1) (%l imm1))
139  (je @missing)
140  (popq (% ra0))
141  (pushq ($ 0))                         ; reserve frame
142  (pushq ($ 0))
143  (pushq (@ 'class (% fn)))
144  (pushq (% ra0))
145  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_y))
146  (set-nargs 4)
147  (jmp (@ '%maybe-std-setf-slot-value-using-class (% fn)))
148  @missing                              ; (%slot-id-set-missing instance id new-value)
149  (set-nargs 3)
150  (jmp (@'%slot-id-ref-missing (% fn))))
151
152
153;;; All of the generic function trampoline functions have to be
154;;; exactly the same size (x8664::gf-code-size) in words.  The
155;;; largest of these - the general-case *GF-PROTO* - is currently
156;;; "really" a little under 15 words, so X8664::GF-CODE-SIZE is
157;;; just a little bigger than that.
158(defparameter *gf-proto*
159  (nfunction
160   gag
161   (lambda (&lap &lexpr args)
162     (x86-lap-function 
163      gag 
164      ()
165      (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
166      (:code-size x8664::gf-code-size)
167      (movq (@ (% rsp)) (% ra0))
168      (save-frame-variable-arg-count)
169      (push-argregs)
170      (movzwl (% nargs) (%l nargs))
171      (pushq (%q nargs))
172      (movq (% rsp) (% arg_z))
173      (ref-global.l ret1valaddr imm0)
174      (cmpq (% ra0) (% imm0))
175      (je @multiple)
176      (ref-global.l lexpr-return1v ra0)
177      (jmp @call)
178      @multiple
179      (pushq (@ (+ x8664::nil-value (x8664::%kernel-global 'lexpr-return))))
180      (movq (% imm0) (% ra0))
181      @call
182      (push (% ra0))
183      (movq (@ 'dispatch-table (% fn)) (% arg_y))
184      (set-nargs 2)
185      (jmp (@ 'dcode (% fn)))  ; dcode function
186      ))))
187
188;;; is a winner - saves ~15%
189(defx86lapfunction gag-one-arg ((arg arg_z))
190  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
191  (:code-size x8664::gf-code-size)
192  (check-nargs 1)
193  (movq (@ 'dispatch-table (% fn)) (% arg_y))
194  (set-nargs 2)
195  (jmp (@ 'dcode (% fn))))
196
197(defx86lapfunction gag-two-arg ((arg0 arg_y) (arg1 arg_z))
198  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
199  (:code-size x8664::gf-code-size)
200  (check-nargs 2)
201  (movq (@ 'dispatch-table (% fn)) (% arg_x))
202  (set-nargs 3)
203  (jmp (@ 'dcode (% fn))))
204
205
206(defx86lapfunction funcallable-trampoline ()
207  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
208  (:code-size x8664::gf-code-size)
209  (jmp (@ 'dcode (% fn))))
210
211
212;;; This is in LAP so that it can reference itself in the error message.
213;;; (It needs to be cloned, so %fn will be unique to each copy.)
214;;; It can't work for this to reference any of its own constants.
215(defx86lapfunction unset-fin-trampoline ()
216  (:code-size x8664::gf-code-size)
217  (save-frame-variable-arg-count)
218  (call-subprim .SPheap-rest-arg)
219  (pop (% arg_z))
220  (movq ($ '#.$XNOFINFUNCTION) (% arg_x))
221  (movq (% fn) (% arg_y))
222  (set-nargs 3)
223  (call-subprim .SPksignalerr)
224  ;(movq ($ x8664::nil-value) (% arg_z))
225  (leave)
226  (single-value-return))
227
228
229
230(defparameter *cm-proto*
231  (nfunction
232   gag
233   (lambda (&lap &lexpr args)
234     (x86-lap-function 
235      gag 
236      ()
237      (:fixed-constants (thing dcode gf bits))
238      (movq (@ (% rsp)) (% ra0))
239      (save-frame-variable-arg-count)
240      (push-argregs)
241      (movzwl (% nargs) (%l nargs))
242      (pushq (%q nargs))
243      (movq (% rsp) (% arg_z))
244      (ref-global ret1valaddr imm0)
245      (cmpq (% ra0) (% imm0))
246      (je @multiple)
247      (ref-global lexpr-return1v ra0)
248      (jmp @call)
249      @multiple
250      (pushq (@ (+ x8664::nil-value (x8664::%kernel-global 'lexpr-return))))
251      (movq (% imm0) (% ra0))
252      @call
253      (push (% ra0))
254      (movq (@ 'thing (% fn)) (% arg_y))
255      (set-nargs 2)
256      (jmp (@ 'dcode (% fn)))))))
257
258
259
260
Note: See TracBrowser for help on using the repository browser.