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

Last change on this file since 11069 was 11069, checked in by gz, 11 years ago

remove more unused files, bootstrap another backend change from the trunk that shouldn't affect anything here, plus some formatting changes, all to make diffs more managable

  • 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-std-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-std-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.