source: branches/working-0711/ccl/level-0/X86/x86-clos.lisp @ 12950

Last change on this file since 12950 was 12950, checked in by gz, 10 years ago

fixes for slots with non-standard allocation (r12760,r12761,r12762,r12765, r12905)

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