source: trunk/source/level-0/X86/X8632/x8632-misc.lisp @ 14619

Last change on this file since 14619 was 14619, checked in by rme, 9 years ago

Merge shrink-tcr branch. This enables the 32-bit Windows lisp to run
on 64-bit Windows.

On 32-bit x86 ports, we expect to use a segment register to point to a
block of thread-local data called the TCR (thread context record).
This has always been kind of a bother on 32-bit Windows: we have been
using a kludge that allows us to use the %es segment register
(conditionalized on WIN32_ES_HACK).

Unfortunately, 64-bit Windows doesn't support using an LDT. This is
why the 32-bit lisp wouldn't run on 64-bit Windows.

The new scheme is to use some of the TlsSlots? (part of the Windows
TEB) for the most important parts of the TCR, and to introduce an "aux
vector" for the remaining TCR slots. Since %fs points to the TEB, we
can make this work. We reserve the last 34 (of 64) slots for our use,
and will die if we don't get them.

Microsoft's documentation says not to access the TlsSlots? directly
(you're supposed to use TlsGetValue/TlsSetValue?), so we're treading on
undocumented ground. Frankly, we've done worse.

This change introduces some ugliness. In lisp kernel C files, there's
a TCR_AUX(tcr) macro that expands to "tcr->aux" on win32, and to "tcr"
elsewhere.

If lisp or lap code has a pointer to a TCR, it's necessary to subtract
off target::tcr-bias (which on Windows/x86 is #xe10, the offset from
%fs to the TlsSlots? in the Windows TEB). We also sometimes have to load
target::tcr.aux to get at data which has been moved there.

These changes should only affect Windows/x86. The story on the other
platforms is just the same as before.

File size: 26.1 KB
Line 
1;;; Copyright 2009 Clozure Associates
2;;; This file is part of Clozure CL. 
3;;;
4;;; Clozure CL is licensed under the terms of the Lisp Lesser GNU
5;;; Public License , known as the LLGPL and distributed with Clozure
6;;; CL as the file "LICENSE".  The LLGPL consists of a preamble and
7;;; the LGPL, which is distributed with Clozure CL as the file "LGPL".
8;;; Where these conflict, the preamble takes precedence.
9;;;
10;;; Clozure CL is referenced in the preamble as the "LIBRARY."
11;;;
12;;; The LLGPL is also available online at
13;;; http://opensource.franz.com/preamble.html
14
15(in-package "CCL")
16
17;;; Copy N bytes from pointer src, starting at byte offset src-offset,
18;;; to ivector dest, starting at offset dest-offset.
19;;; It's fine to leave this in lap.
20;;; Depending on alignment, it might make sense to move more than
21;;; a byte at a time.
22;;; Does no arg checking of any kind.  Really.
23
24;;; I went ahead and used the INC and DEC instructions here, since
25;;; they're shorter than the equivalent ADD/SUB.  Intel's optimization
26;;; manual advises avoiding INC and DEC because they might cause
27;;; dependencies on earlier instructions that set the flags.  So, if
28;;; these functions end up being hot, replacing the inc/dec insns
29;;; might be worth a try.
30
31(defx8632lapfunction %copy-ptr-to-ivector ((src 12)
32                                           (src-byte-offset 8)
33                                           (dest 4)
34                                           #|(ra 0)|#
35                                           (dest-byte-offset arg_y)
36                                           (nbytes arg_z))
37  (mark-as-imm temp0)
38  (mark-as-imm arg_y)
39  (let ((foreign-ptr temp0)             ;raw foreign pointer
40        (ivector temp1)                 ;destination ivector
41        (j arg_y))                      ;unboxed index into ivector
42    (movl (@ src (% esp)) (% temp1))
43    (macptr-ptr temp1 foreign-ptr)
44    (movl (@ src-byte-offset (% esp)) (% temp1))
45    (unbox-fixnum temp1 imm0)
46    (addl (% imm0) (% foreign-ptr))     ;point to starting byte in src
47    (movl (@ dest (% esp)) (% ivector))
48    (sarl ($ x8632::fixnumshift) (% j)) ;unbox dest-byte-offset
49    (testl (% nbytes) (% nbytes))
50    (jmp @test)
51    @loop
52    (movb (@ (% foreign-ptr)) (%b imm0))
53    (incl (% foreign-ptr))
54    (movb (%b imm0) (@ x8632::misc-data-offset (% ivector) (% j)))
55    (incl (% j))
56    (subl ($ '1) (% nbytes))
57    @test
58    (jne @loop)
59    (movl (% ivector) (% arg_z)))
60  (mark-as-node temp0)
61  (mark-as-node arg_y)
62  (single-value-return 5))
63
64(defx8632lapfunction %copy-ivector-to-ptr ((src 12)
65                                           (src-byte-offset 8)
66                                           (dest 4)
67                                           #|(ra 0)|#
68                                           (dest-byte-offset arg_y)
69                                           (nbytes arg_z))
70  (mark-as-imm temp0)
71  (mark-as-imm arg_y)
72  (let ((foreign-ptr temp0)             ;raw foreign pointer
73        (ivector temp1)                 ;source ivector
74        (j arg_y))                      ;unboxed index into ivector
75    (movl (@ dest (% esp)) (% temp1))
76    (macptr-ptr temp1 foreign-ptr)
77    (unbox-fixnum dest-byte-offset imm0)
78    (addl (% imm0) (% foreign-ptr))     ;point to starting byte in dest
79    (movl (@ src (% esp)) (% ivector))
80    (movl (@ src-byte-offset (% esp)) (% j))
81    (sarl ($ x8632::fixnumshift) (% j)) ;unbox src-byte-offset
82    (test (% nbytes) (% nbytes))
83    (jmp @test)
84    @loop
85    (movb (@ x8632::misc-data-offset (% ivector) (% j)) (%b imm0))
86    (incl (% j))
87    (movb (%b imm0) (@ (% foreign-ptr)))
88    (incl (% foreign-ptr))
89    (subl ($ '1) (% nbytes))
90    @test
91    (jne @loop)
92    (movl (@ dest (% esp)) (% arg_z)))
93  (mark-as-node temp0)
94  (mark-as-node arg_y)
95  (single-value-return 5))
96
97(defx8632lapfunction %copy-ivector-to-ivector ((src 12) 
98                                               (src-byte-offset 8)
99                                               (dest 4)
100                                               #|(ra 0)|#
101                                               (dest-byte-offset arg_y)
102                                               (nbytes arg_z))
103  (movl (@ src (% esp)) (% temp0))
104  (movl (@ src-byte-offset (% esp)) (% temp1))
105  (unbox-fixnum nbytes imm0)            ;will be used below
106  (push (% nbytes))                     ;put loop counter on stack
107  (movl (@ (+ 4 dest) (% esp)) (% arg_z))
108  (mark-as-imm temp1)
109  (mark-as-imm arg_y)
110  (sarl ($ x8632::fixnumshift) (% temp1)) ;unboxed src index
111  (sarl ($ x8632::fixnumshift) (% arg_y)) ;unboxed dest index
112  (let ((a temp0)
113        (i temp1)
114        (b arg_z)
115        (j arg_y))
116    ;; copy nbytes starting at a[i] to b[j]
117    (cmpl (% b) (% a))
118    (jne @front)
119    (cmpl (% i) (% j))
120    (jg @back)
121    @front
122    (testl (% imm0) (% imm0))           ;test nbytes
123    (jmp @front-test)
124    @front-loop
125    (movb (@ x8632::misc-data-offset (% a) (% i)) (%b imm0))
126    (movb (%b imm0) (@ x8632::misc-data-offset (% b) (% j)))
127    (incl (% i))
128    (incl (% j))
129    (subl ($ '1) (@ (% esp)))
130    @front-test
131    (jne @front-loop)
132    (jmp @done)
133    @back
134    ;; unboxed nbytes in imm0
135    (addl (% imm0) (% i))
136    (addl (% imm0) (% j))
137    (testl (% imm0) (% imm0))
138    (jmp @back-test)
139    @back-loop
140    (decl (% i))
141    (decl (% j))
142    (movb (@ x8632::misc-data-offset (% a) (% i)) (%b imm0))
143    (movb (%b imm0) (@ x8632::misc-data-offset (% b) (% j)))
144    (subl ($ '1) (@ (% esp)))
145    @back-test
146    (jne @back-loop)
147    @done
148    ;; dest already in arg_z
149    (addl ($ 4) (% esp))                ;pop nbytes
150    (mark-as-node temp1)
151    (mark-as-node arg_y)
152    (single-value-return 5)))
153
154(defx8632lapfunction %copy-gvector-to-gvector ((src 12)
155                                               (src-element 8)
156                                               (dest 4)
157                                               #|(ra 0)|#
158                                               (dest-element arg_y)
159                                               (nelements arg_z))
160  (let ((a temp0)
161        (i imm0)
162        (b arg_z)
163        (j arg_y)
164        (val temp1))
165    (movl (% nelements) (% val))     ;will be used below
166    (push (% nelements))             ;loop counter on stack (use ebp?)
167    (movl (@ (+ 4 src) (% esp)) (% a))
168    (movl (@ (+ 4 src-element) (% esp)) (% i))
169    (movl (@ (+ 4 dest) (% esp)) (% b))
170    ;; j/arg_y already set
171    (cmpl (% a) (% b))
172    (jne @front)
173    (rcmp (% i) (% j))
174    (jl @back)
175    @front
176    (testl (% val) (% val))             ;test nelements
177    (jmp @front-test)
178    @front-loop
179    (movl (@ x8632::misc-data-offset (% a) (% i)) (% val))
180    (movl (% val) (@ x8632::misc-data-offset (% b) (% j)))
181    (addl ($ '1) (% i))
182    (addl ($ '1) (% j))
183    (subl ($ '1) (@ (% esp)))
184    @front-test
185    (jne @front-loop)
186    (jmp @done)
187    @back
188    ;; nelements in val (from above)
189    (addl (% val) (% i))
190    (addl (% val) (% j))
191    (testl (% val) (% val))
192    (jmp @back-test)
193    @back-loop
194    (subl ($ '1) (% i))
195    (subl ($ '1) (% j))
196    (movl (@ x8632::misc-data-offset (% a) (% i)) (% val))
197    (movl (% val) (@ x8632::misc-data-offset (% b) (% j)))
198    (subl ($ '1) (@ (% esp)))
199    @back-test
200    (jne @back-loop)
201    @done
202    ;; dest already in arg_z
203    (addl ($ 4) (% esp))                ;pop loop counter
204    (single-value-return 5)))
205
206(defx8632lapfunction %heap-bytes-allocated ()
207  (movl (@ (% :rcontext) x8632::tcr.save-allocptr) (% temp1))
208  (movl (@ (% :rcontext) x8632::tcr.last-allocptr) (% temp0))
209  (cmpl ($ -8) (% temp1))               ;void_allocptr
210  (jz @go)
211  #+windows-target
212  (progn
213    (movl (:rcontext x8632::tcr.aux) (% imm0))
214    (movq (@ x8632::tcr-aux.total-bytes-allocated-low (% imm0)) (% mm0)))
215  #-windows-target
216  (movq (@ (% :rcontext) x8632::tcr.total-bytes-allocated-low) (% mm0))
217  (movl (% temp0) (% arg_y))
218  (subl (% temp1) (% temp0))
219  (testl (% arg_y) (% arg_y))
220  (jz @go)
221  (movd (% temp0) (% mm1))
222  (paddq (% mm1) (% mm0))
223  @go
224  (jmp-subprim .SPmakeu64))
225
226(defx8632lapfunction values ()
227  (:arglist (&rest values))
228  (save-frame-variable-arg-count)
229  (push-argregs)
230  (jmp-subprim .SPnvalret))
231
232(defx8632lapfunction rdtsc ()
233  (mark-as-imm temp1)                   ;aka edx
234  (:byte #x0f)                          ;two-byte rdtsc opcode
235  (:byte #x31)                          ;is #x0f #x31
236  (box-fixnum imm0 arg_z)
237  (mark-as-node temp1)
238  (single-value-return))
239
240;;; Return all 64 bits of the time-stamp counter as an unsigned integer.
241(defx8632lapfunction rdtsc64 ()
242  (mark-as-imm temp1)                   ;aka edx
243  (:byte #x0f)                          ;two-byte rdtsc opcode
244  (:byte #x31)                          ;is #x0f #x31
245  (movd (% eax) (% mm0))
246  (movd (% edx) (% mm1))
247  (psllq ($ 32) (% mm1))
248  (por (% mm1) (% mm0))
249  (mark-as-node temp1)
250  (jmp-subprim .SPmakeu64))
251
252;;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
253;;; ash::fixnumshift)) would do this inline.
254
255(defx8632lapfunction %setf-macptr-to-object ((macptr arg_y) (object arg_z))
256  (check-nargs 2)
257  (trap-unless-typecode= macptr x8632::subtag-macptr)
258  (movl (% object) (@ x8632::macptr.address (% macptr)))
259  (single-value-return))
260
261(defx8632lapfunction %fixnum-from-macptr ((macptr arg_z))
262  (check-nargs 1)
263  (trap-unless-typecode= arg_z x8632::subtag-macptr)
264  (movl (@ x8632::macptr.address (% arg_z)) (% imm0))
265  (mark-as-imm temp0)
266  (let ((imm1 temp0))
267    (trap-unless-lisptag= imm0 x8632::tag-fixnum imm1))
268  (mark-as-node temp0)
269  (movl (% imm0) (% arg_z))
270  (single-value-return))
271
272(defx8632lapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
273  (trap-unless-typecode= ptr x8632::subtag-macptr)
274  (mark-as-imm temp0)
275  (let ((imm1 temp0))
276    (macptr-ptr ptr imm1)
277    (unbox-fixnum offset imm0)
278    (movq (@ (% imm1) (% imm0)) (% mm0)))
279  (mark-as-node temp0)
280  (jmp-subprim .SPmakeu64))
281
282(defx8632lapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
283  (trap-unless-typecode= ptr x8632::subtag-macptr)
284  (mark-as-imm temp0)
285  (let ((imm1 temp0))
286    (macptr-ptr ptr imm1)
287    (unbox-fixnum offset imm0)
288    (movq (@ (% imm1) (% imm0)) (% mm0)))
289  (mark-as-node temp0)
290  (jmp-subprim .SPmakes64))
291
292(defx8632lapfunction %%set-unsigned-longlong ((ptr 4)
293                                              #|(ra 0)|#
294                                              (offset arg_y)
295                                              (val arg_z))
296  (let ((rptr temp0)
297        (imm1 temp1)
298        (ptr-in-frame -4))
299    (save-stackargs-frame 1)
300    (movl (@ ptr-in-frame (% ebp)) (% rptr))
301    (trap-unless-typecode= rptr x8632::subtag-macptr)
302    (call-subprim .SPgetu64)
303    (macptr-ptr rptr imm0)
304    (mark-as-imm temp1)
305    (unbox-fixnum offset imm1)
306    (movq (% mm0) (@ (% imm0) (% imm1)))
307    (mark-as-node temp1)
308    (restore-simple-frame)
309    (single-value-return)))
310
311(defx8632lapfunction %%set-signed-longlong ((ptr 4)
312                                            #|(ra 0)|#
313                                            (offset arg_y)
314                                            (val arg_z))
315  (let ((rptr temp0)
316        (imm1 temp1)
317        (ptr-in-frame -4))
318    (save-stackargs-frame 1)
319    (movl (@ ptr-in-frame (% ebp)) (% rptr))
320    (trap-unless-typecode= rptr x8632::subtag-macptr)
321    (call-subprim .SPgets64)
322    (macptr-ptr rptr imm0)
323    (mark-as-imm temp1)
324    (unbox-fixnum offset imm1)
325    (movq (% mm0) (@ (% imm0) (% imm1)))
326    (mark-as-node temp1)
327    (restore-simple-frame)
328    (single-value-return)))
329
330(defx8632lapfunction interrupt-level ()
331  (movl (@ (% :rcontext) x8632::tcr.tlb-pointer) (% imm0))
332  (movl (@ x8632::interrupt-level-binding-index (% imm0)) (% arg_z))
333  (single-value-return))
334
335(defx8632lapfunction set-interrupt-level ((new arg_z))
336  (movl (@ (% :rcontext) x8632::tcr.tlb-pointer) (% imm0))
337  (trap-unless-fixnum new)
338  (movl (% new) (@ x8632::interrupt-level-binding-index (% imm0)))
339  (single-value-return))
340
341(defx8632lapfunction %current-tcr ()
342  (movl (@ (% :rcontext) x8632::tcr.linear) (% arg_z))
343  (single-value-return))
344
345(defx8632lapfunction %tcr-toplevel-function ((tcr arg_z))
346  (check-nargs 1)
347  (movl (@ (- x8632::tcr.vs-area x8632::tcr-bias) (% tcr)) (% temp0))
348  (movl (@ x8632::area.high (% temp0)) (% imm0)) ;bottom of vstack
349  (cmpl (% tcr) (@ (% :rcontext) x8632::tcr.linear))
350  (jz @myself)
351  (cmpl (% imm0) (@ x8632::area.active (% temp0)))
352  (jmp @finish)
353  @myself
354  (cmpl (% imm0) (% esp))
355  @finish
356  (movl ($ (target-nil-value)) (% arg_z))
357  (cmovnel (@ (- x8632::node-size) (% imm0)) (% arg_z))
358  (single-value-return))
359 
360(defx8632lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
361  (check-nargs 2)
362  (movl (@ (- x8632::tcr.vs-area x8632::tcr-bias) (% tcr)) (% temp0))
363  (movl (@ x8632::area.high (% temp0)) (% imm0))
364  (cmpl (% tcr) (@ (% :rcontext) x8632::tcr.linear))
365  (jz @myself)
366  (cmpl (% imm0) (@ x8632::area.active (% temp0))) ;vstack empty?
367  (jmp @room)
368  @myself
369  (cmpl (% imm0) (% esp))
370  @room
371  (leal (@ (- x8632::node-size) (% imm0)) (% imm0))
372  (movl ($ 0) (@ (% imm0)))
373  (jne @have-room)
374  (movl (% imm0) (@ x8632::area.active (% temp0)))
375  (movl (% imm0) (@ (- x8632::tcr.save-vsp x8632::tcr-bias) (% tcr)))
376  (jmp @have-room)
377  @have-room
378  (movl (% fun) (@ (% imm0)))
379  (single-value-return))
380
381;;; This needs to be done out-of-line, to handle EGC memoization.
382(defx8632lapfunction %store-node-conditional ((offset 8)
383                                              (object 4)
384                                              #|(ra 0)|#
385                                              (old arg_y)
386                                              (new arg_z))
387  (movl (@ offset (% esp)) (% temp0))
388  (movl (@ object (% esp)) (% temp1))
389  (save-simple-frame)
390  (call-subprim .SPstore-node-conditional)
391  (restore-simple-frame)
392  (single-value-return 4))
393
394(defx8632lapfunction %store-immediate-conditional ((offset 8)
395                                                   (object 4)
396                                                   #|(ra 0)|#
397                                                   (old arg_y)
398                                                   (new arg_z))
399  (mark-as-imm temp0)
400  (let ((imm1 temp0)
401        (robject temp1))
402    (movl (@ offset (% esp)) (% imm1))
403    (sarl ($ x8632::fixnumshift) (% imm1))
404    (movl (@ object (% esp)) (% robject))
405    @again
406    (movl (@ (% robject) (% imm1)) (% eax))
407    (cmpl (% eax) (% old))
408    (jne @lose)
409    (lock)
410    (cmpxchgl (% new) (@ (% robject) (% imm1)))
411    (jne @again)
412    (movl ($ (target-t-value)) (% arg_z))
413    (mark-as-node temp0)
414    (single-value-return 4)
415    @lose
416    (movl ($ (target-nil-value)) (% arg_z))
417    (mark-as-node temp0)
418    (single-value-return 4)))
419
420(defx8632lapfunction set-%gcable-macptrs% ((ptr arg_z))
421  @again
422  (movl (@ (+ (target-nil-value) (x8632::kernel-global gcable-pointers))) (% eax))
423  (movl (% eax) (@ x8632::xmacptr.link (% ptr)))
424  (lock)
425  (cmpxchgl (% ptr) (@ (+ (target-nil-value) (x8632::kernel-global gcable-pointers))))
426  (jne @again)
427  (single-value-return))
428
429;;; Atomically increment or decrement the gc-inhibit-count kernel-global
430;;; (It's decremented if it's currently negative, incremented otherwise.)
431(defx8632lapfunction %lock-gc-lock ()
432  @again
433  (movl (@ (+ (target-nil-value) (x8632::kernel-global gc-inhibit-count))) (% eax))
434  (lea (@ '-1 (% eax)) (% temp0))
435  (lea (@ '1 (% eax)) (% arg_z))
436  (test (% eax) (% eax))
437  (cmovsl (% temp0) (% arg_z))
438  (lock)
439  (cmpxchgl (% arg_z) (@ (+ (target-nil-value) (x8632::kernel-global gc-inhibit-count))))
440  (jnz @again)
441  (single-value-return))
442
443;;; Atomically decrement or increment the gc-inhibit-count kernel-global
444;;; (It's incremented if it's currently negative, incremented otherwise.)
445;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
446(defx8632lapfunction %unlock-gc-lock ()
447  @again
448  (movl (@ (+ (target-nil-value) (x8632::kernel-global gc-inhibit-count)))
449        (% eax))
450  (lea (@ '1 (% eax)) (% temp0))
451  (cmpl ($ -1) (% eax))
452  (lea (@ '-1 (% eax)) (% arg_z))
453  (cmovlel (% temp0) (% arg_z))
454  (lock)
455  (cmpxchgl (% arg_z) (@ (+ (target-nil-value) (x8632::kernel-global gc-inhibit-count))))
456  (jne @again)
457  (cmpl ($ '-1) (% eax))
458  (jne @done)
459  ;; The GC tried to run while it was inhibited.  Unless something else
460  ;; has just inhibited it, it should be possible to GC now.
461  (mov ($ arch::gc-trap-function-immediate-gc) (% imm0))
462  (uuo-gc-trap)
463  @done
464  (single-value-return))
465
466(defx8632lapfunction %atomic-incf-node ((by 4) #|(ra 0)|# (node arg_y) (disp arg_z))
467  (check-nargs 3)
468  (mark-as-imm temp0)
469  (let ((imm1 temp0)
470        (rby temp1))
471    (movl (@ by (% esp)) (% rby))
472    (unbox-fixnum disp imm1)
473    @again
474    (movl (@ (% node) (% imm1)) (% eax))
475    (lea (@ (% eax) (% rby)) (% arg_z))
476    (lock)
477    (cmpxchgl (% arg_z) (@ (% node) (% imm1)))
478    (jne @again))
479  (mark-as-node temp0)
480  (single-value-return 3))
481
482(defx8632lapfunction %atomic-incf-ptr ((ptr arg_z))
483  (mark-as-imm temp0)
484  (mark-as-imm temp1)
485  (let ((imm1 temp0)
486        (imm2 temp1))
487    (macptr-ptr ptr imm2)
488    @again
489    (movl (@ (% imm2)) (% eax))
490    (lea (@ 1 (% eax)) (% imm1))
491    (lock)
492    (cmpxchgl (% imm1) (@ (% imm2)))
493    (jne @again)
494    (box-fixnum imm1 arg_z))
495  (mark-as-node temp0)
496  (mark-as-node temp1)
497  (single-value-return))
498
499(defx8632lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
500  (mark-as-imm temp0)
501  (mark-as-imm temp1)
502  (let ((imm1 temp0)
503        (imm2 temp1))
504    (macptr-ptr ptr imm2)
505    @again
506    (movl (@ (% imm2)) (% eax))
507    (unbox-fixnum by imm1)
508    (add (% eax) (% imm1))
509    (lock)
510    (cmpxchgl (% imm1) (@ (% imm2)))
511    (jnz @again)
512    (box-fixnum imm1 arg_z))
513  (mark-as-node temp0)
514  (mark-as-node temp1)
515  (single-value-return))
516
517(defx8632lapfunction %atomic-decf-ptr ((ptr arg_z))
518  (mark-as-imm temp0)
519  (mark-as-imm temp1)
520  (let ((imm1 temp0)
521        (imm2 temp1))
522    (macptr-ptr ptr imm2)
523    @again
524    (movl (@ (% imm2)) (% eax))
525    (lea (@ -1 (% eax)) (% imm1))
526    (lock)
527    (cmpxchgl (% imm1) (@ (% imm2)))
528    (jne @again)
529    (box-fixnum imm1 arg_z))
530  (mark-as-node temp0)
531  (mark-as-node temp1)
532  (single-value-return))
533
534(defx8632lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
535  (mark-as-imm temp0)
536  (mark-as-imm temp1)
537  (let ((imm1 temp0)
538        (imm2 temp1))
539    (macptr-ptr ptr imm2)
540    @again
541    (movl (@ (% imm2)) (% eax))
542    (testl (% eax) (% eax))
543    (lea (@ -1 (% eax)) (% imm1))
544    (jz @done)
545    (lock)
546    (cmpxchgl (% imm1) (@ (% imm2)))
547    (jnz @again)
548    @done
549    (box-fixnum imm1 arg_z))
550  (mark-as-node temp0)
551  (mark-as-node temp1)
552  (single-value-return))
553
554(defx8632lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
555  (mark-as-imm temp0)
556  (let ((imm1 temp0))
557    (macptr-ptr arg_y imm1)
558    (unbox-fixnum newval imm0)
559    (lock)
560    (xchgl (% imm0) (@ (% imm1)))
561    (box-fixnum imm0 arg_z))
562  (mark-as-node temp0)
563  (single-value-return))
564
565;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
566;;; was equal to OLDVAL.  Return the old value
567(defx8632lapfunction %ptr-store-conditional ((ptr 4) #|(ra 0)|# (expected-oldval arg_y) (newval arg_z))
568  (mark-as-imm temp1)
569  (let ((imm2 temp1))
570    (movl (@ ptr (% esp)) (% temp0))
571    (macptr-ptr temp0 imm2)
572    (mark-as-imm temp0)
573    (let ((imm1 temp0))
574      @again
575      (movl (@ (% imm2)) (% imm0))
576      (box-fixnum imm0 imm0)
577      (cmpl (% imm0) (% expected-oldval))
578      (jne @done)
579      (unbox-fixnum newval imm1)
580      (lock)
581      (cmpxchgl (% imm1) (@ (% imm2)))
582      (jne @again)
583      @done
584      (movl (% imm0) (% arg_z)))
585    (mark-as-node temp0))
586  (mark-as-node temp1)
587  (single-value-return 3))
588
589(defx8632lapfunction %ptr-store-fixnum-conditional ((ptr 4) #|(ra 0)|# (expected-oldval arg_y) (newval arg_z))
590  (mark-as-imm temp0)
591  (let ((address temp0))
592    (movl (@ ptr (% esp)) (% temp1))
593    (macptr-ptr temp1 address)
594    @again
595    (movl (@ (% address)) (% imm0))
596    (cmpl (% imm0) (% expected-oldval))
597    (jne @done)
598    (lock)
599    (cmpxchgl (% newval) (@ (% address)))
600    (jne @again)
601    @done
602    (movl (% imm0) (% arg_z)))
603  (mark-as-node temp0)
604  (single-value-return 3))
605
606(defx8632lapfunction xchgl ((newval arg_y) (ptr arg_z))
607  (unbox-fixnum newval imm0)
608  (macptr-ptr ptr arg_y)                ;better be aligned
609  (xchgl (% imm0) (@ (% arg_y)))
610  (box-fixnum imm0 arg_z)
611  (single-value-return))
612
613(defx8632lapfunction %macptr->dead-macptr ((macptr arg_z))
614  (check-nargs 1)
615  (movb ($ x8632::subtag-dead-macptr) (@ x8632::misc-subtag-offset (% macptr)))
616  (single-value-return))
617
618;;; %%apply-in-frame
619
620(defx8632lapfunction %%save-application ((flags arg_y) (fd arg_z))
621  (unbox-fixnum fd imm0)
622  (movd (% imm0) (% mm0))
623  (unbox-fixnum flags imm0)
624  (orl ($ arch::gc-trap-function-save-application) (% imm0))
625  (uuo-gc-trap)
626  (single-value-return))
627
628(defx8632lapfunction %misc-address-fixnum ((misc-object arg_z))
629  (check-nargs 1)
630  (lea (@ x8632::misc-data-offset (% misc-object)) (% arg_z))
631  (single-value-return))
632
633(defx8632lapfunction fudge-heap-pointer ((ptr 4) #|(ra 0)|# (subtype arg_y) (len arg_z))
634  (check-nargs 3)
635  (mark-as-imm temp0)
636  (let ((imm1 temp0))
637    (movl (@ ptr (% esp)) (% temp1))
638    (macptr-ptr temp1 imm1)           ; address in macptr
639    (lea (@ 9 (% imm1)) (% imm0))     ; 2 for delta + 7 for alignment
640    (andb ($ -8) (%b  imm0))          ; Clear low three bits to align
641    (subl (% imm0) (% imm1))          ; imm1 = -delta
642    (negw (%w imm1))
643    (movw (%w imm1) (@  -2 (% imm0)))   ; save delta halfword
644    (unbox-fixnum subtype imm1)         ; subtype at low end of imm1
645    (shll ($ (- x8632::num-subtag-bits x8632::fixnum-shift)) (% len))
646    (orl (% len) (% imm1))
647    (movl (% imm1) (@ (% imm0)))        ; store subtype & length
648    (lea (@ x8632::fulltag-misc (% imm0)) (% arg_z))) ; tag it, return it
649  (mark-as-node temp0)
650  (single-value-return 3))
651
652(defx8632lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
653  (check-nargs 2)
654  (mark-as-imm temp0)
655  (let ((imm1 temp0))
656    (lea (@ (- x8632::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
657    (movzwl (@ -2 (% imm0)) (% imm1))     ; get delta
658    (subl (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
659    (movl (% imm0) (@ x8632::macptr.address (% ptr))))
660  (mark-as-node temp0)
661  (single-value-return))
662
663(defx8632lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
664  (lea (@ x8632::misc-data-offset (% vect)) (% imm0))
665  (movl (% imm0) (@ x8632::macptr.address (% ptr)))
666  (single-value-return))
667
668;;; Sadly, we have no NVRs on x8632.
669(defun get-saved-register-values ()
670  (values))
671
672(defx8632lapfunction %current-db-link ()
673  (movl (@ (% :rcontext) x8632::tcr.db-link) (% arg_z))
674  (single-value-return))
675
676(defx8632lapfunction %no-thread-local-binding-marker ()
677  (movl ($ x8632::subtag-no-thread-local-binding) (% arg_z))
678  (single-value-return))
679
680(defx8632lapfunction pending-user-interrupt ()
681  (xorl (% temp0) (% temp0))
682  (ref-global x8632::intflag arg_z)
683  ;; If another signal happens now, it will get ignored, same as if it happened
684  ;; before whatever signal is in arg_z.  But then these are async signals, so
685  ;; who can be sure it didn't actually happen just before...
686  (set-global temp0 x8632::intflag)
687  (single-value-return))
688
689(defx8632lapfunction debug-trap-with-string ((arg arg_z))
690  (check-nargs 1)
691  (uuo-error-debug-trap-with-string)
692  (single-value-return))
693
694(defx8632lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
695  (check-nargs 2)
696  (save-simple-frame)
697  (macptr-ptr src imm0)
698  (leal (@ (:^ done) (% fn)) (% ra0))
699  (movl (% imm0) (@ (% :rcontext) x8632::tcr.safe-ref-address))
700  (movl (@ (% imm0)) (% imm0))
701  (jmp done)
702  (:tra done)
703  (recover-fn)
704  (movl ($ 0) (@ (% :rcontext) x8632::tcr.safe-ref-address))
705  (movl (% imm0) (@ x8632::macptr.address (% dest)))
706  (restore-simple-frame)
707  (single-value-return))
708
709(defx8632lapfunction %%tcr-interrupt ((target arg_z))
710  (check-nargs 1)
711  (ud2a)
712  (:byte 4)
713  (box-fixnum imm0 arg_z)
714  (single-value-return))
715
716(defx8632lapfunction %suspend-tcr ((target arg_z))
717  (check-nargs 1)
718  (ud2a)
719  (:byte 5)
720  (movzbl (%b imm0) (%l imm0))
721  (testl (%l imm0) (%l imm0))
722  (movl ($ (target-nil-value)) (%l arg_z))
723  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
724  (single-value-return))
725
726(defx8632lapfunction %suspend-other-threads ()
727  (check-nargs 0)
728  (ud2a)
729  (:byte 6)
730  (movl ($ (target-nil-value)) (%l arg_z))
731  (single-value-return))
732
733(defx8632lapfunction %resume-tcr ((target arg_z))
734  (check-nargs 1)
735  (ud2a)
736  (:byte 7)
737  (movzbl (%b imm0) (%l imm0))
738  (testl (%l imm0) (%l imm0))
739  (movl ($ (target-nil-value)) (%l arg_z))
740  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
741  (single-value-return))
742
743(defx8632lapfunction %resume-other-threads ()
744  (check-nargs 0)
745  (ud2a)
746  (:byte 8)
747  (movl ($ (target-nil-value)) (%l arg_z))
748  (single-value-return))
749
750
751(defx8632lapfunction %kill-tcr ((target arg_z))
752  (check-nargs 1)
753  (ud2a)
754  (:byte 9)
755  (testb (%b imm0) (%b imm0))
756  (movl ($ (target-nil-value)) (%l arg_z))
757  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
758  (single-value-return))
759
760(defx8632lapfunction %get-spin-lock ((p arg_z))
761  (check-nargs 1)
762  (save-simple-frame)
763  (push (% arg_z))
764  @again
765  (mark-as-imm temp1)
766  (movl (@ -4 (% ebp)) (% arg_z))
767  (macptr-ptr arg_z temp1)
768  (movl (@ '*spin-lock-tries* (% fn)) (% arg_y))
769  (movl (@ '*spin-lock-timeouts* (% fn)) (% arg_z))
770  (movl (@ target::symbol.vcell (% arg_y)) (% arg_y))
771  (movl (@ (% :rcontext) x8632::tcr.linear) (% temp0))
772  @try-swap
773  (xorl (% eax) (% eax))
774  (lock)
775  (cmpxchgl (% temp0) (@ (% temp1)))
776  (je @done)
777  @spin
778  (pause)
779  (cmpl ($ 0) (@ (% temp1)))
780  (je @try-swap)
781  (subl ($ '1) (% arg_y))
782  (jne @spin)
783  @wait
784  (addl ($ x8632::fixnumone) (@ x8632::symbol.vcell (% arg_z)))
785  (mark-as-node temp1)
786  (call-symbol yield 0)
787  (jmp @again)
788  @done
789  (mark-as-node temp1)
790  (movl (@ -4 (% ebp)) (% arg_z))
791  (restore-simple-frame)
792  (single-value-return))
793
794;; tbd
795(defx8632lapfunction %%apply-in-frame-proto ()
796  (hlt))
797
798(defx8632lapfunction %atomic-pop-static-cons ()
799  @again
800  (movl (@ (+ (target-nil-value) (x8632::kernel-global static-conses))) (% eax))
801  (cmpl ($ (target-nil-value)) (% eax))
802  (jz @lose)
803  (%cdr eax temp0)
804  (lock)
805  (cmpxchgl (% temp0) (@ (+ (target-nil-value) (x8632::kernel-global static-conses))))
806  (jnz @again)
807  (lock)
808  (subl ($ '1) (@ (+ (target-nil-value) (x8632::kernel-global free-static-conses))))
809  @lose
810  (movl (% eax) (% arg_z))
811  (single-value-return))
812
813
814
815(defx8632lapfunction %staticp ((x arg_z))
816  (check-nargs 1)
817  (ref-global static-cons-area temp0)
818  (movl (% x) (% imm0))
819  (movl ($ (target-nil-value)) (% arg_z))
820  (subl (@ target::area.low (% temp0)) (% imm0))
821  (shrl ($ target::dnode-shift) (% imm0))
822  (mark-as-imm temp1)
823  (movl (@ target::area.ndnodes (% temp0)) (% temp1))
824  (subl (% imm0) (% temp1))
825  (lea (@ 128 (% temp1)) (% temp1))
826  (leal (@ (% temp1) target::fixnumone) (% temp1))
827  (cmoval (% temp1) (% arg_z))
828  (mark-as-node temp1)
829  (single-value-return))
830
831(defx8632lapfunction %static-inverse-cons ((n arg_z))
832  (check-nargs 1)
833  (testl ($ target::tagmask) (% arg_z))
834  (jne @fail)
835  (subl ($ '128) (% arg_z))
836  (ref-global static-cons-area temp0)
837  (movl (@ target::area.ndnodes (% temp0)) (% imm0))
838  (box-fixnum imm0 arg_y)
839  (rcmpl (% arg_z) (% arg_y))
840  (ja @fail)
841  (movl (@ target::area.high (% temp0)) (% imm0))
842  (subl (% arg_z) (% imm0))
843  (subl (% arg_z) (% imm0))
844  (lea (@ x8632::fulltag-cons (% imm0)) (% arg_z))
845  (cmpl ($ x8632::subtag-unbound)  (@ x8632::cons.car (% arg_z)))
846  (je @fail)
847  (single-value-return)
848  @fail
849  (movl ($ (target-nil-value)) (% arg_z))
850  (single-value-return))
851
852;;; Get the thread-specific value of %fs.
853(defx8632lapfunction %get-fs-register ()
854  (xorl (% imm0) (% imm0))
855  (:byte #x66)                          ;movw %fs,%ax
856  (:byte #x8c)
857  (:byte #xe0)
858  (box-fixnum imm0 arg_z)
859  (single-value-return))
860
861(defx8632lapfunction %get-gs-register ()
862  (xorl (% imm0) (% imm0))
863  (:byte #x66)                          ;movw %gs,%ax
864  (:byte #x8c)
865  (:byte #xe8)
866  (box-fixnum imm0 arg_z)
867  (single-value-return))
868 
Note: See TracBrowser for help on using the repository browser.