source: trunk/ccl/level-0/X86/x86-clos.lisp @ 6477

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

New calling sequence. %rcx is %imm2 now, not %temp2, and no need
to be so careful with it.

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