source: trunk/source/level-0/X86/X8632/x8632-utils.lisp @ 10959

Last change on this file since 10959 was 10959, checked in by gb, 13 years ago

Replace uses of target::nil-value with (CCL::TARGET-NIL-VALUE) and
target::t-value with (CCL::TARGET-T-VALUE).

This was very slightly hard to bootstrap (the new backend-lowmem-bias
had to be in effect and typically 0), so I'll start checking in images
in a minute.

File size: 14.3 KB
Line 
1(in-package "CCL")
2
3(defx8632lapfunction %address-of ((arg arg_z))
4  ;; %address-of a fixnum is a fixnum, just for spite.
5  ;; %address-of anything else is the address of that thing as an integer.
6  (testb ($ x8632::fixnummask) (%b arg))
7  (je @done)
8  (movl (% arg) (% imm0))
9  (jmp-subprim .SPmakeu32)
10  @done
11  (single-value-return))
12
13;;; "areas" are fixnum-tagged and, for the most part, so are their
14;;; contents.
15
16;;; The nilreg-relative global all-areas is a doubly-linked-list header
17;;; that describes nothing.  Its successor describes the current/active
18;;; dynamic heap.  Return a fixnum which "points to" that area, after
19;;; ensuring that the "active" pointers associated with the current thread's
20;;; stacks are correct.
21
22(defx8632lapfunction %normalize-areas ()
23  (let ((address temp0)
24        (temp temp1))
25
26    ; update active pointer for tsp area.
27    (movl (:rcontext x8632::tcr.ts-area) (% address))
28    (movl (:rcontext x8632::tcr.save-tsp) (% temp))
29    (movl (% temp) (@ x8632::area.active (% address)))
30   
31    ;; Update active pointer for vsp area.
32    (movl (:rcontext x8632::tcr.vs-area) (% address))
33    (movl (% esp) (@ x8632::area.active (% address)))
34
35    (ref-global all-areas arg_z)
36    (movl (@ x8632::area.succ (% arg_z)) (% arg_z))
37
38    (single-value-return)))
39
40(defx8632lapfunction %active-dynamic-area ()
41  (ref-global all-areas arg_z)
42  (movl (@ x8632::area.succ (% arg_z)) (% arg_z))
43  (single-value-return))
44
45(defx8632lapfunction %object-in-stack-area-p ((object arg_y) (area arg_z))
46  (rcmp (% object) (@ x8632::area.active (% area)))
47  (movl ($ nil) (% temp0))
48  (movl ($ t) (% imm0))
49  (jb @done)
50  (rcmp (% object) (@ x8632::area.high (% area)))
51  (cmovbl (% imm0) (% temp0))
52  @done
53  (movl (% temp0) (% arg_z))
54  (single-value-return))
55
56(defx8632lapfunction %object-in-heap-area-p ((object arg_y) (area arg_z))
57  (rcmp (% object) (@ x8632::area.low (% area)))
58  (movl ($ nil) (% temp0))
59  (movl ($ t) (% imm0))
60  (jb @done)
61  (rcmp (% object) (@ x8632::area.active (% area)))
62  (cmovbl (% imm0) (% temp0))
63  @done
64  (movl (% temp0) (% arg_z))
65  (single-value-return))
66
67;;; In these heap-walking functions, all other threads should be
68;;; suspended; the only consing that should happen is any consing
69;;; that the function (the "f" argument) does when we call it.
70;;;
71;;; We can therefore basically walk dnode-aligned addresses (but we
72;;; have to be careful, especially in the %WALK-DYNAMIC-AREA case,
73;;; to hold onto only tagged pointers when we call the funtion, since
74;;; consing by the called function could cause a gc).
75
76(defx8632lapfunction walk-static-area ((a arg_y) (f arg_z))
77  (let ((obj temp0)
78        (fun -4)
79        (limit -8))
80    (save-simple-frame)
81    (push (% f))
82    (pushl (@ x8632::area.active (% a)))
83    (movl (@ x8632::area.low (% a)) (% obj))
84    (jmp @test)
85    @loop
86    (movb (@ (% obj)) (% imm0.b))
87    (andb ($ x8632::fulltagmask) (% imm0.b))
88    (cmpb ($ x8632::fulltag-immheader) (% imm0.b))
89    (je @misc)
90    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
91    (je @misc)
92    ;; not a header, so must be a cons
93    (add ($ x8632::fulltag-cons) (% obj))
94    (mov (% obj) (% arg_z))
95    (set-nargs 1)
96    (push (% obj))
97    (:talign 5)
98    (call (@ fun (% ebp)))
99    (recover-fn)
100    (pop (% obj))
101    (add ($ (- x8632::cons.size x8632::fulltag-cons)) (% obj))
102    (jmp @test)
103    @misc
104    (lea (@ x8632::fulltag-misc (% obj)) (% obj))
105    (mov (% obj) (% arg_z))
106    (set-nargs 1)
107    (push (% obj))
108    (:talign 5)
109    (call (@ fun (% ebp)))
110    (recover-fn)
111    (pop (% obj))
112    (mov (@ (% obj)) (% imm0))
113    (andb ($ x8632::fulltagmask) (% imm0.b))
114    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
115    (mov (@ (% obj)) (% imm0))
116    (je @32)
117    (cmpb ($ x8632::max-32-bit-ivector-subtag) (% imm0.b))
118    (jle @32)
119    (cmpb ($ x8632::max-8-bit-ivector-subtag) (% imm0.b))
120    (jle @8)
121    (cmpb ($ x8632::max-16-bit-ivector-subtag) (% imm0.b))
122    (jle @16)
123    (cmpb ($ x8632::subtag-double-float-vector) (% imm0.b))
124    (je @double-float)
125    ;; if we get here, it's a bit vector
126    (shrl ($ x8632::num-subtag-bits) (% imm0))
127    (add ($ 7) (% imm0))
128    (shrl ($ 3) (% imm0))
129    (jmp @uvector-next)
130    @double-float
131    (shrl ($ x8632::num-subtag-bits) (% imm0))
132    (shll ($ 3) (% imm0))
133    (jmp @uvector-next)
134    @8
135    (shrl ($ x8632::num-subtag-bits) (% imm0))
136    (jmp @uvector-next)
137    @16
138    (shrl ($ x8632::num-subtag-bits) (% imm0))
139    (shll ($ 1) (% imm0))
140    (jmp @uvector-next)
141    @32
142    (shrl ($ x8632::num-subtag-bits) (% imm0))
143    (shll ($ 2) (% imm0))
144    ;; size of obj in bytes (without header or alignment padding)
145    ;; is in imm0
146    @uvector-next
147    (add ($ (+ x8632::node-size (1- x8632::dnode-size))) (% imm0))
148    (andb ($ (lognot (1- x8632::dnode-size))) (% imm0.b))
149    (add (% imm0) (% obj))
150    @test
151    (cmpl (@ limit (% ebp)) (% obj))
152    (jb @loop)
153    (movl ($ (target-nil-value)) (% arg_z))
154    (restore-simple-frame)
155    (single-value-return)))
156
157;;; This walks the active "dynamic" area.  Objects might be moving around
158;;; while we're doing this, so we have to be a lot more careful than we
159;;; are when walking a static area.
160;;; There are a couple of approaches to termination:
161;;;  a) Allocate a "sentinel" cons, and terminate when we run into it.
162;;;  b) Check the area limit (which is changing if we're consing) and
163;;;     terminate when we hit it.
164;;; (b) loses if the function conses.  (a) conses.  I can't think of anything
165;;; better than (a).
166;;; This, of course, assumes that any GC we're doing does in-place compaction
167;;; (or at least preserves the relative order of objects in the heap.)
168
169(defx8632lapfunction %walk-dynamic-area ((a arg_y) (f arg_z))
170  (let ((obj temp0)
171        (fun -4)
172        (sentinel -8))
173    (save-simple-frame)
174    (push (% f))
175    (subl ($ (- x8632::cons.size x8632::fulltag-cons))
176          (:rcontext x8632::tcr.save-allocptr))
177    (movl (:rcontext x8632::tcr.save-allocptr) (% allocptr)) ;aka temp0
178    (cmpl (:rcontext x8632::tcr.save-allocbase) (% allocptr))
179    (jg @ok)
180    (uuo-alloc)
181    @ok
182    (andb ($ (lognot x8632::fulltagmask))
183          (:rcontext x8632::tcr.save-allocptr))
184    (push (% allocptr))                 ;sentinel
185    (ref-global tenured-area a)
186    (movl (@ x8632::area.low (% a)) (% obj))
187    (jmp @test)
188    @loop
189    (movb (@ (% obj)) (% imm0.b))
190    (andb ($ x8632::fulltagmask) (% imm0.b))
191    (cmpb ($ x8632::fulltag-immheader) (% imm0.b))
192    (je @misc)
193    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
194    (je @misc)
195    ;; not a header, so must be a cons
196    (add ($ x8632::fulltag-cons) (% obj))
197    (mov (% obj) (% arg_z))
198    (set-nargs 1)
199    (push (% obj))
200    (:talign 5)
201    (call (@ fun (% ebp)))
202    (recover-fn)
203    (pop (% obj))
204    (add ($ (- x8632::cons.size x8632::fulltag-cons)) (% obj))
205    (jmp @test)
206    @misc
207    (add ($ x8632::fulltag-misc) (% obj))
208    (mov (% obj) (% arg_z))
209    (set-nargs 1)
210    (push (% obj))
211    (:talign 5)
212    (call (@ fun (% ebp)))
213    (recover-fn)
214    (pop (% obj))
215    (sub ($ x8632::fulltag-misc) (% obj))
216    (mov (@ (% obj)) (% imm0))
217    (andb ($ x8632::fulltagmask) (% imm0.b))
218    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
219    (mov (@ (% obj)) (% imm0))
220    (je @32)
221    (cmpb ($ x8632::max-32-bit-ivector-subtag) (% imm0.b))
222    (jle @32)
223    (cmpb ($ x8632::max-8-bit-ivector-subtag) (% imm0.b))
224    (jle @8)
225    (cmpb ($ x8632::max-16-bit-ivector-subtag) (% imm0.b))
226    (jle @16)
227    (cmpb ($ x8632::subtag-double-float-vector) (% imm0.b))
228    (je @double-float)
229    ;; if we get here, it's a bit vector
230    (shrl ($ x8632::num-subtag-bits) (% imm0))
231    (add ($ 7) (% imm0))
232    (shrl ($ 3) (% imm0))
233    (jmp @uvector-next)
234    @double-float
235    (shrl ($ x8632::num-subtag-bits) (% imm0))
236    (shll ($ 3) (% imm0))
237    (jmp @uvector-next)
238    @8
239    (shrl ($ x8632::num-subtag-bits) (% imm0))
240    (jmp @uvector-next)
241    @16
242    (shrl ($ x8632::num-subtag-bits) (% imm0))
243    (shll ($ 1) (% imm0))
244    (jmp @uvector-next)
245    @32
246    (shrl ($ x8632::num-subtag-bits) (% imm0))
247    (shll ($ 2) (% imm0))
248    ;; size of obj in bytes (without header or alignment padding)
249    ;; is in imm0
250    @uvector-next
251    (add ($ (+ x8632::node-size (1- x8632::dnode-size))) (% imm0))
252    (andb ($ (lognot (1- x8632::dnode-size))) (% imm0.b))
253    (add (% imm0) (% obj))
254    @test
255    (cmpl (@ sentinel (% ebp)) (% obj))
256    (jb @loop)
257    @done
258    (movl ($ (target-nil-value)) (% arg_z))
259    (restore-simple-frame)
260    (single-value-return)))
261
262;;; xxx duplicated in level-0/x86-utils.lisp
263(defun walk-dynamic-area (area func)
264  (with-other-threads-suspended
265      (%walk-dynamic-area area func)))
266
267(defx8632lapfunction %class-of-instance ((i arg_z))
268  (svref i instance.class-wrapper arg_z)
269  (svref arg_z %wrapper-class arg_z)
270  (single-value-return))
271
272(defx8632lapfunction class-of ((x arg_z))
273  (check-nargs 1)
274  (extract-fulltag x imm0)
275  (cmpb ($ x8632::fulltag-misc) (% imm0.b))
276  (movl (% arg_z) (% imm0))
277  (jne @have-tag)
278  (extract-subtag x imm0)
279  @have-tag
280  (movl (@ '*class-table* (% fn)) (% temp1))
281  (movl (@ x8632::symbol.vcell (% temp1)) (% temp1))
282  (movzbl (% imm0.b) (% imm0))
283  (movl (@ x8632::misc-data-offset (% temp1) (% imm0) 4) (% temp0))
284  (cmpl ($ (target-nil-value)) (% temp0))
285  (je @bad)
286  ;; functionp?
287  (extract-typecode temp0 imm0)
288  (cmpb ($ x8632::subtag-function) (% imm0.b))
289  (jne @ret)
290  ;; jump to the function
291  (set-nargs 1)
292  (jmp (% temp0))
293  @bad
294  (load-constant no-class-error fname)
295  (set-nargs 1)
296  (jmp (@ x8632::symbol.fcell (% fname)))
297  @ret
298  (movl (% temp0) (% arg_z))            ;return frob from table
299  (single-value-return))
300
301(defx8632lapfunction gc ()
302  (check-nargs 0)
303  (movl ($ arch::gc-trap-function-gc) (% imm0))
304  (uuo-gc-trap)
305  (movl ($ nil) (% arg_z))
306  (single-value-return))
307
308(defx8632lapfunction full-gccount ()
309  (ref-global tenured-area arg_z)
310  (test (% arg_z) (% arg_z))
311  (cmovel (@ (+ (target-nil-value) (x8632::%kernel-global 'gc-count))) (% arg_z))
312  (cmovnel (@ x8632::area.gc-count (% arg_z)) (% arg_z))
313  (single-value-return))
314
315(defx8632lapfunction egc ((arg arg_z))
316  "Enable the EGC if arg is non-nil, disables the EGC otherwise. Return
317the previous enabled status. Although this function is thread-safe (in
318the sense that calls to it are serialized), it doesn't make a whole lot
319of sense to be turning the EGC on and off from multiple threads ..."
320  (check-nargs 1)
321  (clrl imm0)
322  (cmp-reg-to-nil arg)
323  (setne (% imm0.b))
324  (movd (% imm0) (% mm0))
325  (movl ($ arch::gc-trap-function-egc-control) (% imm0))
326  (uuo-gc-trap)
327  (single-value-return))
328
329(defx8632lapfunction %configure-egc ((e0size 4)
330                                     #|(ra 0)|#
331                                     (e1size arg_y)
332                                     (e2size arg_z))
333  (check-nargs 3)
334  (movl (@ e0size (% esp)) (% temp0))
335  (movl ($ arch::gc-trap-function-configure-egc) (% imm0))
336  (uuo-gc-trap)
337  (single-value-return 3))
338
339(defx8632lapfunction purify ()
340  (check-nargs 0)
341  (movl ($ arch::gc-trap-function-purify) (% imm0))
342  (uuo-gc-trap)
343  (movl ($ nil) (% arg_z))
344  (single-value-return))
345
346(defx8632lapfunction impurify ()
347  (check-nargs 0)
348  (movl ($ arch::gc-trap-function-impurify) (% imm0))
349  (uuo-gc-trap)
350  (movl ($ nil) (% arg_z))
351  (single-value-return))
352
353(defx8632lapfunction lisp-heap-gc-threshold ()
354  "Return the value of the kernel variable that specifies the amount
355of free space to leave in the heap after full GC."
356  (check-nargs 0)
357  (movl ($ arch::gc-trap-function-get-lisp-heap-threshold) (% imm0))
358  (uuo-gc-trap)
359  (jmp-subprim .SPmakeu32))
360
361(defx8632lapfunction set-lisp-heap-gc-threshold ((new arg_z))
362  "Set the value of the kernel variable that specifies the amount of free
363space to leave in the heap after full GC to new-value, which should be a
364non-negative fixnum. Returns the value of that kernel variable (which may
365be somewhat larger than what was specified)."
366  (check-nargs 1)
367  (save-simple-frame)
368  (call-subprim .SPgetu32)
369  (movd (% imm0) (% mm0))
370  (movl ($ arch::gc-trap-function-set-lisp-heap-threshold) (% imm0))
371  (uuo-gc-trap)
372  (restore-simple-frame)
373  (jmp-subprim .SPmakeu32))
374
375(defx8632lapfunction use-lisp-heap-gc-threshold ()
376  "Try to grow or shrink lisp's heap space, so that the free space is (approximately) equal to the current heap threshold. Return NIL"
377  (check-nargs 0) 
378  (movl ($ arch::gc-trap-function-use-lisp-heap-threshold) (% imm0))
379  (uuo-gc-trap)
380  (movl ($ (target-nil-value)) (%l arg_z))
381  (single-value-return))
382
383(defx8632lapfunction freeze ()
384  "Do a full GC, then consider all heap-allocated objects which survive to be non-relocatable."
385  (movl ($ arch::gc-trap-function-freeze) (% imm0))
386  (uuo-gc-trap)
387  (jmp-subprim .SPmakeu32))
388
389;;; offset is a fixnum, one of the x8632::kernel-import-xxx constants.
390;;; Returns that kernel import, a fixnum.
391(defx8632lapfunction %kernel-import ((offset arg_z))
392  (unbox-fixnum arg_z imm0)
393  (addl (@ (+ (target-nil-value) (x8632::%kernel-global 'kernel-imports))) (% imm0))
394  (movl (@ (% imm0)) (% imm0))
395  (box-fixnum imm0 arg_z)
396  (single-value-return))
397
398(defx8632lapfunction %get-unboxed-ptr ((macptr arg_z))
399  (macptr-ptr arg_z imm0)
400  (movl (@ (% imm0)) (% arg_z))
401  (single-value-return))
402
403(defx8632lapfunction %revive-macptr ((p arg_z))
404  (movb ($ x8632::subtag-macptr) (@ x8632::misc-subtag-offset (% p)))
405  (single-value-return))
406
407(defx86lapfunction %macptr-type ((p arg_z))
408  (check-nargs 1)
409  (trap-unless-typecode= p x8632::subtag-macptr)
410  (svref p x8632::macptr.type-cell imm0)
411  (box-fixnum imm0 arg_z)
412  (single-value-return))
413 
414(defx86lapfunction %macptr-domain ((p arg_z))
415  (check-nargs 1)
416  (trap-unless-typecode= p x8632::subtag-macptr)
417  (svref p x8632::macptr.domain-cell imm0)
418  (box-fixnum imm0 arg_z)
419  (single-value-return))
420
421(defx8632lapfunction %set-macptr-type ((p arg_y) (new arg_z))
422  (check-nargs 2)
423  (trap-unless-typecode= p x8632::subtag-macptr)
424  (unbox-fixnum new imm0)
425  (svset p x8632::macptr.type-cell imm0)
426  (single-value-return))
427
428(defx8632lapfunction %set-macptr-domain ((p arg_y) (new arg_z))
429  (check-nargs 2)
430  (trap-unless-typecode= p x8632::subtag-macptr)
431  (unbox-fixnum new imm0)
432  (svset p x8632::macptr.domain-cell imm0)
433  (single-value-return))
434
435(defx8632lapfunction true ()
436  (pop (% temp0))
437  (subl ($ '2) (% nargs))
438  (leal (@ '2 (% esp) (% nargs)) (% imm0))
439  (cmoval (% imm0) (% esp))
440  (movl ($ (target-t-value)) (% arg_z))
441  (push (% temp0))
442  (single-value-return))
443
444(defx8632lapfunction false ()
445  (pop (% temp0))
446  (subl ($ '2) (% nargs))
447  (leal (@ '2 (% esp) (% nargs)) (% imm0))
448  (cmoval (% imm0) (% esp))
449  (movl ($ (target-nil-value)) (% arg_z))
450  (push (% temp0))
451  (single-value-return))
452
453(defx8632lapfunction int3 ()
454  (int ($ 3))
455  (single-value-return))
Note: See TracBrowser for help on using the repository browser.