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

Last change on this file since 8077 was 8077, checked in by rme, 13 years ago

New file.

File size: 4.4 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
68
69
70(defx8632lapfunction use-lisp-heap-gc-threshold ()
71  "Try to grow or shrink lisp's heap space, so that the free space is (approximately) equal to the current heap threshold. Return NIL"
72  (check-nargs 0) 
73  (movl ($ arch::gc-trap-function-use-lisp-heap-threshold) (% imm0))
74  (uuo-gc-trap)
75  (movl ($ x8632::nil-value) (%l arg_z))
76  (single-value-return))
77
78;;; offset is a fixnum, one of the x8632::kernel-import-xxx constants.
79;;; Returns that kernel import, a fixnum.
80(defx8632lapfunction %kernel-import ((offset arg_z))
81  (mark-as-imm temp0)
82  (let ((imm1 temp0))
83    (ref-global kernel-imports imm1)
84    (unbox-fixnum arg_z imm0)
85    (movl (@ (% imm1) (% imm0)) (% imm0))
86    (box-fixnum imm0 arg_z))
87  (mark-as-node temp0)
88  (single-value-return))
89
90(defx8632lapfunction %get-unboxed-ptr ((macptr arg_z))
91  (macptr-ptr arg_z imm0)
92  (movl (@ (% imm0)) (% arg_z))
93  (single-value-return))
94
95(defx8632lapfunction %revive-macptr ((p arg_z))
96  (movb ($ x8632::subtag-macptr) (@ x8632::misc-subtag-offset (% p)))
97  (single-value-return))
98
99(defx86lapfunction %macptr-type ((p arg_z))
100  (check-nargs 1)
101  (trap-unless-typecode= p x8632::subtag-macptr)
102  (svref p x8632::macptr.type-cell imm0)
103  (box-fixnum imm0 arg_z)
104  (single-value-return))
105 
106(defx86lapfunction %macptr-domain ((p arg_z))
107  (check-nargs 1)
108  (trap-unless-typecode= p x8632::subtag-macptr)
109  (svref p x8632::macptr.domain-cell imm0)
110  (box-fixnum imm0 arg_z)
111  (single-value-return))
112
113(defx8632lapfunction %set-macptr-type ((p arg_y) (new arg_z))
114  (check-nargs 2)
115  (trap-unless-typecode= p x8632::subtag-macptr)
116  (unbox-fixnum new imm0)
117  (svset p x8632::macptr.type-cell imm0)
118  (single-value-return))
119
120(defx8632lapfunction %set-macptr-domain ((p arg_y) (new arg_z))
121  (check-nargs 2)
122  (trap-unless-typecode= p x8632::subtag-macptr)
123  (unbox-fixnum new imm0)
124  (svset p x8632::macptr.domain-cell imm0)
125  (single-value-return))
126
127;;; N.B. nargs is the same register as imm0
128(defx8632lapfunction true ()
129  (movzwl (% nargs) (% imm0))
130  (subl ($ '2) (% imm0))
131  (leal (@ '2 (% esp) (% imm0)) (% imm0))
132  (cmoval (% imm0) (% esp))
133  (movl ($ x8632::t-value) (% arg_z))
134  (single-value-return))
135
136(defx8632lapfunction false ()
137  (movzwl (% nargs) (% imm0))
138  (subl ($ '2) (% imm0))
139  (leal (@ '2 (% esp) (% imm0)) (% imm0))
140  (cmoval (% imm0) (% esp))
141  (movl ($ x8632::nil-value) (% arg_z))
142  (single-value-return))
Note: See TracBrowser for help on using the repository browser.