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

Last change on this file since 14710 was 14710, checked in by gb, 9 years ago

%IVECTOR-FROM-MACPTR for X86{32,64}

File size: 26.5 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(defx8632lapfunction %ivector-from-macptr ((ptr arg_z))
669  (macptr-ptr ptr imm0)
670  (mark-as-imm temp0)
671  (let ((imm1 temp0))
672    (movl (% imm0) (% imm1))
673    (andl ($ target::node-size) (% imm1))
674    (xorl ($ target::node-size) (% imm1))
675    (addl ($ (- target::fulltag-misc target::node-size)) (% imm0))
676    (subl (% imm1) (% imm0))
677    (mark-as-node imm1))
678  (movl (% imm0) (% arg_z))
679  (single-value-return))
680
681;;; Sadly, we have no NVRs on x8632.
682(defun get-saved-register-values ()
683  (values))
684
685(defx8632lapfunction %current-db-link ()
686  (movl (@ (% :rcontext) x8632::tcr.db-link) (% arg_z))
687  (single-value-return))
688
689(defx8632lapfunction %no-thread-local-binding-marker ()
690  (movl ($ x8632::subtag-no-thread-local-binding) (% arg_z))
691  (single-value-return))
692
693(defx8632lapfunction pending-user-interrupt ()
694  (xorl (% temp0) (% temp0))
695  (ref-global x8632::intflag arg_z)
696  ;; If another signal happens now, it will get ignored, same as if it happened
697  ;; before whatever signal is in arg_z.  But then these are async signals, so
698  ;; who can be sure it didn't actually happen just before...
699  (set-global temp0 x8632::intflag)
700  (single-value-return))
701
702(defx8632lapfunction debug-trap-with-string ((arg arg_z))
703  (check-nargs 1)
704  (uuo-error-debug-trap-with-string)
705  (single-value-return))
706
707(defx8632lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
708  (check-nargs 2)
709  (save-simple-frame)
710  (macptr-ptr src imm0)
711  (leal (@ (:^ done) (% fn)) (% ra0))
712  (movl (% imm0) (@ (% :rcontext) x8632::tcr.safe-ref-address))
713  (movl (@ (% imm0)) (% imm0))
714  (jmp done)
715  (:tra done)
716  (recover-fn)
717  (movl ($ 0) (@ (% :rcontext) x8632::tcr.safe-ref-address))
718  (movl (% imm0) (@ x8632::macptr.address (% dest)))
719  (restore-simple-frame)
720  (single-value-return))
721
722(defx8632lapfunction %%tcr-interrupt ((target arg_z))
723  (check-nargs 1)
724  (ud2a)
725  (:byte 4)
726  (box-fixnum imm0 arg_z)
727  (single-value-return))
728
729(defx8632lapfunction %suspend-tcr ((target arg_z))
730  (check-nargs 1)
731  (ud2a)
732  (:byte 5)
733  (movzbl (%b imm0) (%l imm0))
734  (testl (%l imm0) (%l imm0))
735  (movl ($ (target-nil-value)) (%l arg_z))
736  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
737  (single-value-return))
738
739(defx8632lapfunction %suspend-other-threads ()
740  (check-nargs 0)
741  (ud2a)
742  (:byte 6)
743  (movl ($ (target-nil-value)) (%l arg_z))
744  (single-value-return))
745
746(defx8632lapfunction %resume-tcr ((target arg_z))
747  (check-nargs 1)
748  (ud2a)
749  (:byte 7)
750  (movzbl (%b imm0) (%l imm0))
751  (testl (%l imm0) (%l imm0))
752  (movl ($ (target-nil-value)) (%l arg_z))
753  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
754  (single-value-return))
755
756(defx8632lapfunction %resume-other-threads ()
757  (check-nargs 0)
758  (ud2a)
759  (:byte 8)
760  (movl ($ (target-nil-value)) (%l arg_z))
761  (single-value-return))
762
763
764(defx8632lapfunction %kill-tcr ((target arg_z))
765  (check-nargs 1)
766  (ud2a)
767  (:byte 9)
768  (testb (%b imm0) (%b imm0))
769  (movl ($ (target-nil-value)) (%l arg_z))
770  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
771  (single-value-return))
772
773(defx8632lapfunction %get-spin-lock ((p arg_z))
774  (check-nargs 1)
775  (save-simple-frame)
776  (push (% arg_z))
777  @again
778  (mark-as-imm temp1)
779  (movl (@ -4 (% ebp)) (% arg_z))
780  (macptr-ptr arg_z temp1)
781  (movl (@ '*spin-lock-tries* (% fn)) (% arg_y))
782  (movl (@ '*spin-lock-timeouts* (% fn)) (% arg_z))
783  (movl (@ target::symbol.vcell (% arg_y)) (% arg_y))
784  (movl (@ (% :rcontext) x8632::tcr.linear) (% temp0))
785  @try-swap
786  (xorl (% eax) (% eax))
787  (lock)
788  (cmpxchgl (% temp0) (@ (% temp1)))
789  (je @done)
790  @spin
791  (pause)
792  (cmpl ($ 0) (@ (% temp1)))
793  (je @try-swap)
794  (subl ($ '1) (% arg_y))
795  (jne @spin)
796  @wait
797  (addl ($ x8632::fixnumone) (@ x8632::symbol.vcell (% arg_z)))
798  (mark-as-node temp1)
799  (call-symbol yield 0)
800  (jmp @again)
801  @done
802  (mark-as-node temp1)
803  (movl (@ -4 (% ebp)) (% arg_z))
804  (restore-simple-frame)
805  (single-value-return))
806
807;; tbd
808(defx8632lapfunction %%apply-in-frame-proto ()
809  (hlt))
810
811(defx8632lapfunction %atomic-pop-static-cons ()
812  @again
813  (movl (@ (+ (target-nil-value) (x8632::kernel-global static-conses))) (% eax))
814  (cmpl ($ (target-nil-value)) (% eax))
815  (jz @lose)
816  (%cdr eax temp0)
817  (lock)
818  (cmpxchgl (% temp0) (@ (+ (target-nil-value) (x8632::kernel-global static-conses))))
819  (jnz @again)
820  (lock)
821  (subl ($ '1) (@ (+ (target-nil-value) (x8632::kernel-global free-static-conses))))
822  @lose
823  (movl (% eax) (% arg_z))
824  (single-value-return))
825
826
827
828(defx8632lapfunction %staticp ((x arg_z))
829  (check-nargs 1)
830  (ref-global static-cons-area temp0)
831  (movl (% x) (% imm0))
832  (movl ($ (target-nil-value)) (% arg_z))
833  (subl (@ target::area.low (% temp0)) (% imm0))
834  (shrl ($ target::dnode-shift) (% imm0))
835  (mark-as-imm temp1)
836  (movl (@ target::area.ndnodes (% temp0)) (% temp1))
837  (subl (% imm0) (% temp1))
838  (lea (@ 128 (% temp1)) (% temp1))
839  (leal (@ (% temp1) target::fixnumone) (% temp1))
840  (cmoval (% temp1) (% arg_z))
841  (mark-as-node temp1)
842  (single-value-return))
843
844(defx8632lapfunction %static-inverse-cons ((n arg_z))
845  (check-nargs 1)
846  (testl ($ target::tagmask) (% arg_z))
847  (jne @fail)
848  (subl ($ '128) (% arg_z))
849  (ref-global static-cons-area temp0)
850  (movl (@ target::area.ndnodes (% temp0)) (% imm0))
851  (box-fixnum imm0 arg_y)
852  (rcmpl (% arg_z) (% arg_y))
853  (ja @fail)
854  (movl (@ target::area.high (% temp0)) (% imm0))
855  (subl (% arg_z) (% imm0))
856  (subl (% arg_z) (% imm0))
857  (lea (@ x8632::fulltag-cons (% imm0)) (% arg_z))
858  (cmpl ($ x8632::subtag-unbound)  (@ x8632::cons.car (% arg_z)))
859  (je @fail)
860  (single-value-return)
861  @fail
862  (movl ($ (target-nil-value)) (% arg_z))
863  (single-value-return))
864
865;;; Get the thread-specific value of %fs.
866(defx8632lapfunction %get-fs-register ()
867  (xorl (% imm0) (% imm0))
868  (:byte #x66)                          ;movw %fs,%ax
869  (:byte #x8c)
870  (:byte #xe0)
871  (box-fixnum imm0 arg_z)
872  (single-value-return))
873
874(defx8632lapfunction %get-gs-register ()
875  (xorl (% imm0) (% imm0))
876  (:byte #x66)                          ;movw %gs,%ax
877  (:byte #x8c)
878  (:byte #xe8)
879  (box-fixnum imm0 arg_z)
880  (single-value-return))
881 
Note: See TracBrowser for help on using the repository browser.