source: branches/x8664-call/ccl/level-0/X86/x86-clos.lisp @ 6325

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

Tried to use shorter insns; losing battle.

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