source: branches/ia32/level-0/X86/X8632/x8632-utils.lisp @ 8746

Last change on this file since 8746 was 8746, checked in by rme, 14 years ago

Heap-walking functions WALK-STATIC-AREA, %WALK-DYNAMIC-AREA,
and WALK-DYNAMIC-AREA.

File size: 10.7 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    (add ($ x8632::fulltag-misc) (% 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    (sub ($ x8632::fulltag-misc) (% obj))
113    (mov (% obj) (% imm0))
114    (andb ($ x8632::fulltagmask) (% imm0.b))
115    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
116    (je @32)
117    (mov (% obj) (% imm0))
118    (cmpb ($ x8632::max-32-bit-ivector-subtag) (% imm0.b))
119    (jle @32)
120    (cmpb ($ x8632::max-8-bit-ivector-subtag) (% imm0.b))
121    (jle @8)
122    (cmpb ($ x8632::max-16-bit-ivector-subtag) (% imm0.b))
123    (jle @16)
124    (cmpb ($ x8632::subtag-double-float-vector) (% imm0.b))
125    (je @double-float)
126    ;; if we get here, it's a bit vector
127    (shrl ($ x8632::num-subtag-bits) (% imm0))
128    (add ($ 7) (% imm0))
129    (shrl ($ 3) (% imm0))
130    (jmp @uvector-next)
131    @double-float
132    (shrl ($ x8632::num-subtag-bits) (% imm0))
133    (shll ($ 3) (% imm0))
134    (jmp @uvector-next)
135    @8
136    (shrl ($ x8632::num-subtag-bits) (% imm0))
137    (jmp @uvector-next)
138    @16
139    (shrl ($ x8632::num-subtag-bits) (% imm0))
140    (shll ($ 1) (% imm0))
141    (jmp @uvector-next)
142    @32
143    (shrl ($ x8632::num-subtag-bits) (% imm0))
144    (shll ($ 2) (% imm0))
145    ;; size of obj in bytes (without header or alignment padding)
146    ;; is in imm0
147    @uvector-next
148    (add ($ (+ x8632::node-size (1- x8632::dnode-size))) (% imm0))
149    (andb ($ (lognot (1- x8632::dnode-size))) (% imm0.b))
150    (add (% imm0) (% obj))
151    @test
152    (cmpl (@ limit (% ebp)) (% obj))
153    (jb @loop)
154    (movl ($ x8632::nil-value) (% arg_z))
155    (restore-simple-frame)
156    (single-value-return)))
157
158;;; This walks the active "dynamic" area.  Objects might be moving around
159;;; while we're doing this, so we have to be a lot more careful than we
160;;; are when walking a static area.
161;;; There are a couple of approaches to termination:
162;;;  a) Allocate a "sentinel" cons, and terminate when we run into it.
163;;;  b) Check the area limit (which is changing if we're consing) and
164;;;     terminate when we hit it.
165;;; (b) loses if the function conses.  (a) conses.  I can't think of anything
166;;; better than (a).
167;;; This, of course, assumes that any GC we're doing does in-place compaction
168;;; (or at least preserves the relative order of objects in the heap.)
169
170(defx8632lapfunction %walk-dynamic-area ((a arg_y) (f arg_z))
171  (let ((obj temp0)
172        (fun -4)
173        (sentinel -8))
174    (save-simple-frame)
175    (push (% f))
176    (subl ($ (- x8632::cons.size x8632::fulltag-cons))
177          (@ (% :rcontext) x8632::tcr.save-allocptr))
178    (movl (@ (% :rcontext) x8632::tcr.save-allocptr) (% allocptr)) ;aka temp0
179    (cmpl (@ (% :rcontext) x8632::tcr.save-allocbase) (% allocptr))
180    (jg @ok)
181    (uuo-alloc)
182    @ok
183    (andb ($ (lognot x8632::fulltagmask))
184          (@ (% :rcontext) x8632::tcr.save-allocptr))
185    (push (% allocptr))                 ;sentinel
186    (ref-global tenured-area a)
187    (movl (@ x8632::area.low (% a)) (% obj))
188    (jmp @test)
189    @loop
190    (movb (@ (% obj)) (% imm0.b))
191    (andb ($ x8632::fulltagmask) (% imm0.b))
192    (cmpb ($ x8632::fulltag-immheader) (% imm0.b))
193    (je @misc)
194    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
195    (je @misc)
196    ;; not a header, so must be a cons
197    (add ($ x8632::fulltag-cons) (% obj))
198    (mov (% obj) (% arg_z))
199    (set-nargs 1)
200    (push (% obj))
201    (:talign 5)
202    (call (@ fun (% ebp)))
203    (recover-fn)
204    (pop (% obj))
205    (add ($ (- x8632::cons.size x8632::fulltag-cons)) (% obj))
206    (jmp @test)
207    @misc
208    (add ($ x8632::fulltag-misc) (% obj))
209    (mov (% obj) (% arg_z))
210    (set-nargs 1)
211    (push (% obj))
212    (:talign 5)
213    (call (@ fun (% ebp)))
214    (recover-fn)
215    (pop (% obj))
216    (sub ($ x8632::fulltag-misc) (% obj))
217    (mov (% obj) (% imm0))
218    (andb ($ x8632::fulltagmask) (% imm0.b))
219    (cmpb ($ x8632::fulltag-nodeheader) (% imm0.b))
220    (je @32)
221    (mov (% obj) (% imm0))
222    (cmpb ($ x8632::max-32-bit-ivector-subtag) (% imm0.b))
223    (jle @32)
224    (cmpb ($ x8632::max-8-bit-ivector-subtag) (% imm0.b))
225    (jle @8)
226    (cmpb ($ x8632::max-16-bit-ivector-subtag) (% imm0.b))
227    (jle @16)
228    (cmpb ($ x8632::subtag-double-float-vector) (% imm0.b))
229    (je @double-float)
230    ;; if we get here, it's a bit vector
231    (shrl ($ x8632::num-subtag-bits) (% imm0))
232    (add ($ 7) (% imm0))
233    (shrl ($ 3) (% imm0))
234    (jmp @uvector-next)
235    @double-float
236    (shrl ($ x8632::num-subtag-bits) (% imm0))
237    (shll ($ 3) (% imm0))
238    (jmp @uvector-next)
239    @8
240    (shrl ($ x8632::num-subtag-bits) (% imm0))
241    (jmp @uvector-next)
242    @16
243    (shrl ($ x8632::num-subtag-bits) (% imm0))
244    (shll ($ 1) (% imm0))
245    (jmp @uvector-next)
246    @32
247    (shrl ($ x8632::num-subtag-bits) (% imm0))
248    (shll ($ 2) (% imm0))
249    ;; size of obj in bytes (without header or alignment padding)
250    ;; is in imm0
251    @uvector-next
252    (add ($ (+ x8632::node-size (1- x8632::dnode-size))) (% imm0))
253    (andb ($ (lognot (1- x8632::dnode-size))) (% imm0.b))
254    (add (% imm0) (% obj))
255    @test
256    (cmpl (@ sentinel (% ebp)) (% obj))
257    (jb @loop)
258    @done
259    (movl ($ x8632::nil-value) (% arg_z))
260    (restore-simple-frame)
261    (single-value-return)))
262
263;;; xxx duplicated in level-0/x86-utils.lisp
264(defun walk-dynamic-area (area func)
265  (with-other-threads-suspended
266      (%walk-dynamic-area area func)))
267
268(defx8632lapfunction use-lisp-heap-gc-threshold ()
269  "Try to grow or shrink lisp's heap space, so that the free space is (approximately) equal to the current heap threshold. Return NIL"
270  (check-nargs 0) 
271  (movl ($ arch::gc-trap-function-use-lisp-heap-threshold) (% imm0))
272  (uuo-gc-trap)
273  (movl ($ x8632::nil-value) (%l arg_z))
274  (single-value-return))
275
276;;; offset is a fixnum, one of the x8632::kernel-import-xxx constants.
277;;; Returns that kernel import, a fixnum.
278(defx8632lapfunction %kernel-import ((offset arg_z))
279  (unbox-fixnum arg_z imm0)
280  (addl (@ (+ x8632::nil-value (x8632::%kernel-global 'kernel-imports))) (% imm0))
281  (movl (@ (% imm0)) (% imm0))
282  (box-fixnum imm0 arg_z)
283  (single-value-return))
284
285(defx8632lapfunction %get-unboxed-ptr ((macptr arg_z))
286  (macptr-ptr arg_z imm0)
287  (movl (@ (% imm0)) (% arg_z))
288  (single-value-return))
289
290(defx8632lapfunction %revive-macptr ((p arg_z))
291  (movb ($ x8632::subtag-macptr) (@ x8632::misc-subtag-offset (% p)))
292  (single-value-return))
293
294(defx86lapfunction %macptr-type ((p arg_z))
295  (check-nargs 1)
296  (trap-unless-typecode= p x8632::subtag-macptr)
297  (svref p x8632::macptr.type-cell imm0)
298  (box-fixnum imm0 arg_z)
299  (single-value-return))
300 
301(defx86lapfunction %macptr-domain ((p arg_z))
302  (check-nargs 1)
303  (trap-unless-typecode= p x8632::subtag-macptr)
304  (svref p x8632::macptr.domain-cell imm0)
305  (box-fixnum imm0 arg_z)
306  (single-value-return))
307
308(defx8632lapfunction %set-macptr-type ((p arg_y) (new arg_z))
309  (check-nargs 2)
310  (trap-unless-typecode= p x8632::subtag-macptr)
311  (unbox-fixnum new imm0)
312  (svset p x8632::macptr.type-cell imm0)
313  (single-value-return))
314
315(defx8632lapfunction %set-macptr-domain ((p arg_y) (new arg_z))
316  (check-nargs 2)
317  (trap-unless-typecode= p x8632::subtag-macptr)
318  (unbox-fixnum new imm0)
319  (svset p x8632::macptr.domain-cell imm0)
320  (single-value-return))
321
322;;; N.B. nargs is the same register as imm0
323(defx8632lapfunction true ()
324  (subl ($ '2) (% imm0))
325  (leal (@ '2 (% esp) (% imm0)) (% imm0))
326  (cmoval (% imm0) (% esp))
327  (movl ($ x8632::t-value) (% arg_z))
328  (single-value-return))
329
330(defx8632lapfunction false ()
331  (subl ($ '2) (% imm0))
332  (leal (@ '2 (% esp) (% imm0)) (% imm0))
333  (cmoval (% imm0) (% esp))
334  (movl ($ x8632::nil-value) (% arg_z))
335  (single-value-return))
Note: See TracBrowser for help on using the repository browser.