source: trunk/source/level-0/X86/X8632/x8632-clos.lisp @ 12788

Last change on this file since 12788 was 12788, checked in by rme, 10 years ago

r12760, but for x8632.

File size: 8.2 KB
Line 
1(in-package "CCL")
2
3;;; This just maps a SLOT-ID to a SLOT-DEFINITION or NIL.
4;;; The map is a vector of (UNSIGNED-BYTE 8); this should
5;;; be used when there are fewer than 255 slots in the class.
6(defx8632lapfunction %small-map-slot-id-lookup ((slot-id arg_z))
7  (movl (@ 'map (% fn)) (% temp1))
8  (svref slot-id slot-id.index arg_y)
9  (vector-length temp1 temp0)
10  (xorl (%l imm0) (%l imm0))
11  (rcmpl (% arg_y) (% temp0))
12  (ja @have-table-index)
13  (movl (% arg_y) (% imm0))
14  (shrl ($ x8632::word-shift) (% imm0))
15  (movzbl (@ x8632::misc-data-offset (% temp1) (% imm0)) (%l imm0))
16  ;(shll ($ x8632::word-shift) (% imm0))
17  @have-table-index
18  (movl (@ 'table (% fn)) (% temp0))
19  (movl (@ x8632::misc-data-offset (% temp0) (% imm0) 4) (% arg_z))
20  (single-value-return))
21
22;;; The same idea, only the map is a vector of (UNSIGNED-BYTE 32).
23(defx8632lapfunction %large-map-slot-id-lookup ((slot-id arg_z))
24  (movl (@ 'map (% fn)) (% temp1))
25  (svref slot-id slot-id.index arg_y)
26  (vector-length temp1 temp0)
27  (xorl (%l imm0) (%l imm0))
28  (rcmpl (% arg_y) (% temp0))
29  (ja @have-table-index)
30  (movl (% arg_y) (% imm0))
31  (movl (@ x8632::misc-data-offset (% temp1) (% imm0)) (%l imm0))
32  @have-table-index
33  (movl (@ 'table (% fn)) (% temp0))
34  (movl (@ x8632::misc-data-offset (% temp0) (% imm0) 4) (% arg_z))
35  (single-value-return))
36
37(defx8632lapfunction %small-slot-id-value ((instance arg_y) (slot-id arg_z))
38  (movl (@ 'map (% fn)) (% temp1))
39  (svref slot-id slot-id.index temp0)
40  (vector-length temp1 imm0)
41  (rcmpl (% temp0) (% imm0))
42  (movl ($ 0) (% imm0))                 ;don't disturb flags
43  (ja @missing)
44  (movl (% temp0) (% imm0))
45  (shrl ($ x8632::word-shift) (% imm0))
46  (movzbl (@ x8632::misc-data-offset (% temp1) (% imm0)) (% imm0))
47  (testl (% imm0) (% imm0))
48  (je @missing)
49  (movl (@ 'table (% fn)) (% temp0))
50  (movl (@ x8632::misc-data-offset (% temp0) (% imm0) 4) (% arg_z))
51  (popl (% ra0))
52  (pushl ($ x8632::reserved-frame-marker))
53  (pushl ($ x8632::reserved-frame-marker))
54  (pushl (@ 'class (% fn)))
55  (set-nargs 3)
56  (pushl (% ra0))
57  (jmp (@ '%maybe-std-slot-value-using-class (% fn)))
58  @missing                              ; (%slot-id-ref-missing instance id)
59  (set-nargs 2)
60  (jmp (@'%slot-id-ref-missing (% fn))))
61
62(defx8632lapfunction %large-slot-id-value ((instance arg_y) (slot-id arg_z)) 
63  (movl (@ 'map (% fn)) (% temp1))
64  (svref slot-id slot-id.index temp0)
65  (vector-length temp1 imm0)
66  (rcmp (% temp0) (% imm0))
67  (movl ($ 0) (% imm0))
68  (ja @missing)
69  (movl (% temp0) (% imm0))
70  (movl (@ x8632::misc-data-offset (% temp1) (% imm0)) (% imm0))
71  (test (% imm0) (% imm0))
72  (je @missing)
73  (movl (@ 'table (% fn)) (% temp0))
74  (movl (@ x8632::misc-data-offset (% temp0) (% imm0) 4) (% arg_z))
75  (popl (% ra0))
76  (pushl ($ x8632::reserved-frame-marker))
77  (pushl ($ x8632::reserved-frame-marker))
78  (pushl (@ 'class (% fn)))
79  (set-nargs 3)
80  (pushl (% ra0))
81  (jmp (@ '%maybe-std-slot-value-using-class (% fn)))
82  @missing                              ; (%slot-id-ref-missing instance id)
83  (set-nargs 2)
84  (jmp (@'%slot-id-ref-missing (% fn))))
85
86(defx86lapfunction %small-set-slot-id-value ((instance 4)
87                                             #|(ra 0)|#
88                                             (slot-id arg_y)
89                                             (new-value arg_z))
90  (movl (@ 'map (% fn)) (% temp1))
91  (svref slot-id slot-id.index imm0)
92  (vector-length temp1 temp0)
93  (rcmpl (% imm0) (% temp0))
94  (ja @missing)
95  (shrl ($ x8632::word-shift) (% imm0))
96  (movzbl (@ x8632::misc-data-offset (% temp1) (% imm0)) (% imm0))
97  (testl (% imm0) (% imm0))
98  (je @missing)
99  (movl (@ 'table (% fn)) (% temp0))
100  (movl (@ x8632::misc-data-offset (% temp0) (% imm0) 4) (% arg_y))
101  (popl (% temp0))                      ;return address
102  (popl (% temp1))                      ;instance
103  ;; use existing frame
104  (pushl (@ 'class (% fn)))
105  (pushl (% temp1))
106  (pushl (% temp0))
107  (set-nargs 4)
108  ;; (%maybe-std-setf-slot-value-using-class class instance slotd new)
109  (jmp (@ '%maybe-std-setf-slot-value-using-class (% fn)))
110  @missing
111  (set-nargs 3)
112  ;; (%slot-id-set-missing instance id new)
113  (jmp (@ '%slot-id-set-missing (% fn))))
114
115(defx8632lapfunction %large-set-slot-id-value ((instance 4)
116                                               #|(ra 0)|#
117                                               (slot-id arg_y)
118                                               (new-value arg_z))
119  (movl (@ 'map (% fn)) (% temp1))
120  (svref slot-id slot-id.index imm0)
121  (vector-length temp1 temp0)
122  (rcmpl (% imm0) (% temp0))
123  (ja @missing)
124  (movl (@ x8632::misc-data-offset (% temp1) (% imm0)) (%l imm0))
125  (testl (%l imm0) (%l imm0))
126  (je @missing)
127  (movl (@ 'table (% fn)) (% temp0))
128  (movl (@ x8632::misc-data-offset (% temp0) (% imm0) 4) (% arg_y))
129  (popl (% temp0))                      ;return addr
130  (popl (% temp1))                      ;instance
131  (pushl (@ 'class (% fn)))
132  (pushl (% temp1))
133  (pushl (% temp0))
134  (set-nargs 4)
135  (jmp (@ '%maybe-std-setf-slot-value-using-class (% fn)))
136  @missing                              ; (%slot-id-set-missing instance id new-value)
137  (set-nargs 3)
138  (jmp (@'%slot-id-ref-missing (% fn))))
139
140;;; All of the generic function trampoline functions have to be
141;;; exactly the same size (x8632::gf-code-size) in words.  The largest
142;;; of these - the general-case *GF-PROTO* - is currently about 27
143;;; words, so X8632::GF-CODE-SIZE is just a little bigger than that.
144;;; (Note that x8632::gf-code-size has to include space for the
145;;; self-reference table, which takes up another couple of words in
146;;; addition to the machine instructions.)
147(defparameter *gf-proto*
148  (nfunction
149   gag
150   (lambda (&lap &lexpr args)
151     (x86-lap-function 
152      gag 
153      ()
154      (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
155      (:code-size x8632::gf-code-size)
156      (movl (@ (% esp)) (% ra0))
157      (save-frame-variable-arg-count)
158      (push-argregs)
159      (pushl (%l nargs))
160      (movl (% esp) (% arg_z))
161      (ref-global.l ret1valaddr imm0)
162      (cmpl (% ra0) (% imm0))
163      (je @multiple)
164      (ref-global.l lexpr-return1v ra0)
165      (jmp @call)
166      @multiple
167      (pushl (@ (+ (target-nil-value) (x8632::%kernel-global 'lexpr-return))))
168      (movl (% imm0) (% ra0))
169      @call
170      (push (% ra0))
171      (movl (@ 'dispatch-table (% fn)) (% arg_y))
172      (set-nargs 2)
173      (jmp (@ 'dcode (% fn)))  ; dcode function
174      ))))
175
176(defx8632lapfunction gag-one-arg ((arg arg_z))
177  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
178  (:code-size x8632::gf-code-size)
179  (check-nargs 1)
180  (movl (@ 'dispatch-table (% fn)) (% arg_y))
181  (set-nargs 2)
182  (jmp (@ 'dcode (% fn))))
183
184(defx8632lapfunction gag-two-arg ((arg0 arg_y) (arg1 arg_z))
185  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
186  (:code-size x8632::gf-code-size)
187  (check-nargs 2)
188  (pop (% ra0))
189  (pushl ($ x8632::reserved-frame-marker))
190  (pushl ($ x8632::reserved-frame-marker))
191  (pushl (@ 'dispatch-table (% fn)))
192  (push (% ra0))
193  (set-nargs 3)
194  (jmp (@ 'dcode (% fn))))
195
196(defx8632lapfunction funcallable-trampoline ()
197  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
198  (:code-size x8632::gf-code-size)
199  (jmp (@ 'dcode (% fn))))
200
201;;; This is in LAP so that it can reference itself in the error message.
202;;; (It needs to be cloned, so %fn will be unique to each copy.)
203;;; It can't work for this to reference any of its own constants.
204(defx8632lapfunction unset-fin-trampoline ()
205  (:code-size x8632::gf-code-size)
206  (save-frame-variable-arg-count)
207  (call-subprim .SPheap-rest-arg)
208  (pop (% arg_z))
209  (pushl ($ x8632::reserved-frame-marker))
210  (pushl ($ x8632::reserved-frame-marker))
211  (pushl ($ '#.$XNOFINFUNCTION))
212  (movl (% fn) (% arg_y))
213  (set-nargs 3)
214  (call-subprim .SPksignalerr)
215  ;(movl ($ (target-nil-value)) (% arg_z))
216  (leave)
217  (single-value-return))
218
219(defparameter *cm-proto*
220  (nfunction
221   gag
222   (lambda (&lap &lexpr args)
223     (x86-lap-function 
224      gag 
225      ()
226      (:fixed-constants (thing dcode gf bits))
227      (movl (@ (% esp)) (% ra0))
228      (save-frame-variable-arg-count)
229      (push-argregs)
230      (pushl (% nargs))
231      (movl (% esp) (% arg_z))
232      (ref-global ret1valaddr imm0)
233      (cmpl (% ra0) (% imm0))
234      (je @multiple)
235      (ref-global lexpr-return1v ra0)
236      (jmp @call)
237      @multiple
238      (pushl (@ (+ (target-nil-value) (x8632::%kernel-global 'lexpr-return))))
239      (movl (% imm0) (% ra0))
240      @call
241      (push (% ra0))
242      (movl (@ 'thing (% fn)) (% arg_y))
243      (set-nargs 2)
244      (jmp (@ 'dcode (% fn)))))))
Note: See TracBrowser for help on using the repository browser.