source: trunk/source/level-0/X86/x86-misc.lisp @ 15036

Last change on this file since 15036 was 15036, checked in by gb, 8 years ago

Re-do %COPY-IVECTOR-TO-IVECTOR for x8664. Handle overlap correctly (old
version was too wimpy), copy aligned chunks 32/64/128 bits at a time.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 46.1 KB
Line 
1;;; -*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 2009 Clozure Associates
4;;;   Copyright (C) 1994-2001 Digitool, Inc
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18;;; level-0;x86;x86-misc.lisp
19
20
21(in-package "CCL")
22#+x8664-target
23(progn
24
25;;; Copy N bytes from pointer src, starting at byte offset src-offset,
26;;; to ivector dest, starting at offset dest-offset.
27;;; It's fine to leave this in lap.
28;;; Depending on alignment, it might make sense to move more than
29;;; a byte at a time.
30;;; Does no arg checking of any kind.  Really.
31
32(defx86lapfunction %copy-ptr-to-ivector ((src (* 2 x8664::node-size) )
33                                         (src-byte-offset (* 1 x8664::node-size))
34                                         #|(ra 0)|#
35                                         (dest arg_x)
36                                         (dest-byte-offset arg_y)
37                                         (nbytes arg_z))
38  (let ((rsrc temp0)
39        (rsrc-byte-offset temp1))
40    (testq (% nbytes) (% nbytes))
41    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))         ; boxed src-byte-offset
42    (movq (@ src (% rsp)) (% rsrc))     ; src macptr
43    (jmp @test)
44    @loop
45    (unbox-fixnum rsrc-byte-offset imm0)
46    (addq ($ '1) (% rsrc-byte-offset))
47    (addq (@ x8664::macptr.address (% rsrc)) (% imm0))
48    (movb (@ (% imm0)) (%b imm0))
49    (unbox-fixnum dest-byte-offset imm1)
50    (addq ($ '1) (% dest-byte-offset))
51    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
52    (subq ($ '1) (% nbytes))
53    @test
54    (jne @loop)
55    (movq (% dest) (% arg_z))
56    (single-value-return 4)))
57
58(defx86lapfunction %copy-ivector-to-ptr ((src (* 2 x8664::node-size))
59                                         (src-byte-offset (* 1 x8664::node-size))
60                                         #|(ra 0)|#
61                                         (dest arg_x)
62                                         (dest-byte-offset arg_y)
63                                         (nbytes arg_z))
64  (let ((rsrc temp0)
65        (rsrc-byte-offset imm0)
66        (rdest-byte-offset imm1)
67        (rdata imm2))
68    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))
69    (sarq ($ x8664::word-shift) (% rsrc-byte-offset))
70    (movq (% dest-byte-offset) (% rdest-byte-offset))
71    (sarq ($ x8664::word-shift) (% rdest-byte-offset))
72    (movq (@ src (% rsp)) (% rsrc))
73    (testq (% nbytes) (% nbytes))
74    (jmp @test)
75    @loop
76    (unbox-fixnum rsrc-byte-offset imm0)
77    (addq ($ '1) (% rsrc-byte-offset))
78    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
79    (unbox-fixnum dest-byte-offset imm1)
80    (addq ($ '1) (% dest-byte-offset))
81    (addq (@ x8664::macptr.address (%q dest)) (% imm1))
82    (movb (%b imm0) (@ (% imm1)))
83    (subq ($ '1) (% nbytes))
84    @test
85    (jne @loop)
86    (movq (% dest) (% arg_z))
87    (single-value-return 4)))
88
89
90(defun %copy-ivector-to-ivector (src src-byte-offset dest dest-byte-offset nbytes)
91  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
92  (if (or (not (eq src dest))
93          (< dest-byte-offset src-byte-offset)
94          (>= dest-byte-offset (the fixnum (+ src-byte-offset nbytes))))
95    (%copy-ivector-to-ivector-postincrement src src-byte-offset dest dest-byte-offset nbytes)
96    (if (and (eq src dest)
97             (eql src-byte-offset dest-byte-offset))
98      dest
99      (%copy-ivector-to-ivector-predecrement src
100                                             (the fixnum (+ src-byte-offset nbytes))
101                                             dest
102                                             (the fixnum (+ dest-byte-offset nbytes))
103                                             nbytes)))
104  dest)
105
106(defun %copy-ivector-to-ivector-postincrement (src src-byte-offset dest dest-byte-offset nbytes)
107  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
108 
109  (cond ((or (< nbytes 8)
110             (not (= (logand src-byte-offset 3)
111                     (logand dest-byte-offset 3))))
112         (%copy-ivector-to-ivector-postincrement-8bit src src-byte-offset dest dest-byte-offset nbytes))
113        ((and (>= nbytes 80)
114              (= (logand src-byte-offset 15)
115                 (logand dest-byte-offset 15)))
116         (let* ((prefix-size (- 16 (logand (the fixnum (+ src-byte-offset 8)) 15))))
117           (declare (fixnum prefix-size))
118           (unless (= 16 prefix-size)
119             (%copy-ivector-to-ivector-postincrement-8bit src src-byte-offset dest dest-byte-offset prefix-size)
120             (incf src-byte-offset prefix-size)
121             (incf dest-byte-offset prefix-size)
122             (decf nbytes prefix-size)))
123         (let* ((tail-size (logand nbytes 15))
124                (dqsize (- nbytes tail-size)))
125           (declare (fixnum tail-size dqsize))
126           (%copy-ivector-to-ivector-postincrement-128bit src src-byte-offset dest dest-byte-offset dqsize)
127           (unless (zerop tail-size)
128             (%copy-ivector-to-ivector-postincrement-8bit src (the fixnum (+ src-byte-offset dqsize)) dest (the fixnum (+ dest-byte-offset dqsize)) tail-size))))
129        ((= (logand src-byte-offset 7) (logand dest-byte-offset 7))
130         (let* ((prefix-size (- 8 (logand src-byte-offset 7))))
131           (declare (fixnum prefix-size))
132           (unless (= 8 prefix-size)
133             (%copy-ivector-to-ivector-postincrement-8bit src src-byte-offset dest dest-byte-offset prefix-size)
134             (incf src-byte-offset prefix-size)
135             (incf dest-byte-offset prefix-size)
136             (decf nbytes prefix-size)))
137         (let* ((tail-size (logand nbytes 7))
138                (fullword-size (- nbytes tail-size)))
139           (declare (fixnum tail-size fullword-size))
140           (unless (zerop fullword-size)
141             (%copy-ivector-to-ivector-postincrement-64bit src src-byte-offset dest dest-byte-offset fullword-size))
142           (unless (zerop tail-size)
143             (%copy-ivector-to-ivector-postincrement-8bit src (the fixnum (+ src-byte-offset fullword-size)) dest (the fixnum (+ dest-byte-offset fullword-size)) tail-size))))
144        (t
145         (let* ((prefix-size (- 4 (logand src-byte-offset 3))))
146           (declare (fixnum prefix-size))
147           (unless (= 4 prefix-size)
148             (%copy-ivector-to-ivector-postincrement-8bit src src-byte-offset dest dest-byte-offset prefix-size)
149             (incf src-byte-offset prefix-size)
150             (incf dest-byte-offset prefix-size)
151             (decf nbytes prefix-size)))
152         (let* ((tail-size (logand nbytes 3))
153                (fullword-size (- nbytes tail-size)))
154           (declare (fixnum tail-size fullword-size))
155           (unless (zerop fullword-size)
156             (%copy-ivector-to-ivector-postincrement-32bit src src-byte-offset dest dest-byte-offset fullword-size))
157           (unless (zerop tail-size)
158             (%copy-ivector-to-ivector-postincrement-8bit src (the fixnum (+ src-byte-offset fullword-size)) dest (the fixnum (+ dest-byte-offset fullword-size)) tail-size))))))
159
160(defun %copy-ivector-to-ivector-predecrement (src src-byte-offset dest dest-byte-offset nbytes)
161  (declare (fixnum src-byte-offset dest-byte-offset nbytes))
162  (cond ((or (< nbytes 8)
163             (not (= (logand src-byte-offset 3)
164                     (logand dest-byte-offset 3))))
165         (%copy-ivector-to-ivector-predecrement-8bit src src-byte-offset dest dest-byte-offset nbytes))
166        ((and (>= nbytes 80)
167              (= (logand src-byte-offset 15)
168                 (logand dest-byte-offset 15)))
169      (let* ((suffix-size (logand src-byte-offset 15)))
170        (declare (fixnum suffix-size))
171        (unless (zerop suffix-size)
172          (%copy-ivector-to-ivector-predecrement-8bit src src-byte-offset dest dest-byte-offset suffix-size)
173          (decf src-byte-offset suffix-size)
174          (decf dest-byte-offset suffix-size)
175          (decf nbytes suffix-size)))
176      (let* ((head-size (logand nbytes 15))
177             (fullword-size (- nbytes head-size)))
178        (declare (fixnum head-size fullword-size))
179        (unless (zerop fullword-size)
180          (%copy-ivector-to-ivector-predecrement-128bit src src-byte-offset dest dest-byte-offset fullword-size))
181        (unless (zerop head-size)
182          (%copy-ivector-to-ivector-predecrement-8bit src (the fixnum (- src-byte-offset fullword-size)) dest (the fixnum (- dest-byte-offset fullword-size)) head-size))))
183    ((= (logand src-byte-offset 7) (logand dest-byte-offset 7))
184      (let* ((suffix-size (logand src-byte-offset 7)))
185        (declare (fixnum suffix-size))
186        (unless (zerop suffix-size)
187          (%copy-ivector-to-ivector-predecrement-8bit src src-byte-offset dest dest-byte-offset suffix-size)
188          (decf src-byte-offset suffix-size)
189          (decf dest-byte-offset suffix-size)
190          (decf nbytes suffix-size)))
191      (let* ((head-size (logand nbytes 7))
192             (fullword-size (- nbytes head-size)))
193        (declare (fixnum head-size fullword-size))
194        (unless (zerop fullword-size)
195          (%copy-ivector-to-ivector-predecrement-64bit src src-byte-offset dest dest-byte-offset fullword-size))
196        (unless (zerop head-size)
197          (%copy-ivector-to-ivector-predecrement-8bit src (the fixnum (- src-byte-offset fullword-size)) dest (the fixnum (- dest-byte-offset fullword-size)) head-size))))
198    (t
199      (let* ((suffix-size (logand src-byte-offset 3)))
200        (declare (fixnum suffix-size))
201        (unless (zerop suffix-size)
202          (%copy-ivector-to-ivector-predecrement-8bit src src-byte-offset dest dest-byte-offset suffix-size)
203          (decf src-byte-offset suffix-size)
204          (decf dest-byte-offset suffix-size)
205          (decf nbytes suffix-size)))
206      (let* ((head-size (logand nbytes 3))
207             (fullword-size (- nbytes head-size)))
208        (declare (fixnum head-size fullword-size))
209        (unless (zerop fullword-size)
210          (%copy-ivector-to-ivector-predecrement-32bit src src-byte-offset dest dest-byte-offset fullword-size))
211        (unless (zerop head-size)
212          (%copy-ivector-to-ivector-predecrement-8bit src (the fixnum (- src-byte-offset fullword-size)) dest (the fixnum (- dest-byte-offset fullword-size)) head-size))))))
213
214(defx86lapfunction %copy-ivector-to-ivector-postincrement-8bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
215  (let ((rsrc temp0)
216        (srcidx imm0)
217        (destidx imm1)
218        (data imm2))
219    (movq (@ src (% rsp)) (% rsrc))
220    (movq (@ src-byte-offset (% rsp)) (% srcidx))
221    (sarq ($ target::fixnumshift) (% srcidx))
222    (movq (% dest-byte-offset) (% destidx))
223    (sarq ($ target::fixnumshift) (% destidx))
224    (jmp @test)
225    @loop
226    (movzbl (@ target::misc-data-offset (% rsrc) (% srcidx)) (%l data))
227    (movb (%b data) (@ target::misc-data-offset (% dest) (% destidx)))
228    (lea (@ 1 (% destidx)) (% destidx))
229    (lea (@ 1 (% srcidx)) (% srcidx))
230    @test
231    (subq ($ '1) (% nbytes))
232    (jge @loop)
233    (movq (% dest) (% arg_z))
234    (single-value-return 4)))
235
236
237
238(defx86lapfunction %copy-ivector-to-ivector-predecrement-8bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
239  (let ((rsrc temp0)
240        (srcidx imm0)
241        (destidx imm1)
242        (data imm2))
243    (movq (@ src (% rsp)) (% rsrc))
244    (movq (@ src-byte-offset (% rsp)) (% srcidx))
245    (sarq ($ target::fixnumshift) (% srcidx))
246    (movq (% dest-byte-offset) (% destidx))
247    (sarq ($ target::fixnumshift) (% destidx))
248    (jmp @test)
249    @loop
250    (lea (@ -1 (% destidx)) (% destidx))
251    (lea (@ -1 (% srcidx)) (% srcidx))
252    (movzbl (@ target::misc-data-offset (% rsrc) (% srcidx)) (%l data))
253    (movb (%b data) (@ target::misc-data-offset (% dest) (% destidx)))
254    @test
255    (subq ($ '1) (% nbytes))
256    (jge @loop)
257    (movq (% dest) (% arg_z))
258    (single-value-return 4)))
259
260
261(defx86lapfunction %copy-ivector-to-ivector-postincrement-32bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
262  (let ((rsrc temp0)
263        (srcidx imm0)
264        (destidx imm1)
265        (data imm2))
266    (movq (@ src (% rsp)) (% rsrc))
267    (movq (@ src-byte-offset (% rsp)) (% srcidx))
268    (sarq ($ target::fixnumshift) (% srcidx))
269    (movq (% dest-byte-offset) (% destidx))
270    (sarq ($ target::fixnumshift) (% destidx))
271    (jmp @test)
272    @loop
273    (movl (@ target::misc-data-offset (% rsrc) (% srcidx)) (%l data))
274    (movl (%l data) (@ target::misc-data-offset (% dest) (% destidx)))
275    (lea (@ 4 (% destidx)) (% destidx))
276    (lea (@ 4 (% srcidx)) (% srcidx))
277    @test
278    (subq ($ '4) (% nbytes))
279    (jge @loop)
280    (movq (% dest) (% arg_z))
281    (single-value-return 4)))
282
283(defx86lapfunction %copy-ivector-to-ivector-predecrement-32bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
284  (let ((rsrc temp0)
285        (srcidx imm0)
286        (destidx imm1)
287        (data imm2))
288    (movq (@ src (% rsp)) (% rsrc))
289    (movq (@ src-byte-offset (% rsp)) (% srcidx))
290    (sarq ($ target::fixnumshift) (% srcidx))
291    (movq (% dest-byte-offset) (% destidx))
292    (sarq ($ target::fixnumshift) (% destidx))
293    (jmp @test)
294    @loop
295    (lea (@ -4 (% destidx)) (% destidx))
296    (lea (@ -4 (% srcidx)) (% srcidx))
297    (movl (@ target::misc-data-offset (% rsrc) (% srcidx)) (%l data))
298    (movl (%l data) (@ target::misc-data-offset (% dest) (% destidx)))
299    @test
300    (subq ($ '4) (% nbytes))
301    (jge @loop)
302    (movq (% dest) (% arg_z))
303    (single-value-return 4)))
304
305(defx86lapfunction %copy-ivector-to-ivector-postincrement-64bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
306  (let ((rsrc temp0)
307        (srcidx temp1)
308        (destidx dest-byte-offset)
309        (data0 imm0)
310        (data1 imm1))
311    (movq (@ src (% rsp)) (% rsrc))
312    (movq (@ src-byte-offset (% rsp)) (% srcidx))
313    ;; srcidx and destidx are multiples of 8, so it's safe to right-shift
314    ;; them here (they remain fixnums).
315    (sarq ($ target::word-shift) (% srcidx))
316    (sarq ($ target::word-shift) (% destidx))
317    (testq ($ '8) (% nbytes))
318    (jz @test)
319    (movq (@ target::misc-data-offset (% rsrc) (% srcidx)) (% data0))
320    (movq (% data0) (@ target::misc-data-offset (% dest) (% destidx)))
321    (lea (@ 8 (% destidx)) (% destidx))
322    (lea (@ 8 (% srcidx)) (% srcidx))
323    (subq ($ '8) (% nbytes))   
324    (jmp @test)
325    @loop
326    (movq (@ target::misc-data-offset (% rsrc) (% srcidx)) (% data0))
327    (movq (@ (+ 8 target::misc-data-offset) (% rsrc) (% srcidx)) (% data1))
328    (movq (% data0) (@ target::misc-data-offset (% dest) (% destidx)))
329    (movq (% data1) (@ (+ 8 target::misc-data-offset) (% dest) (% destidx)))
330    (lea (@ 16 (% destidx)) (% destidx))
331    (lea (@ 16 (% srcidx)) (% srcidx))
332    @test
333    (subq ($ '16) (% nbytes))
334    (jge @loop)
335    (movq (% dest) (% arg_z))
336    (single-value-return 4)))
337
338(defx86lapfunction %copy-ivector-to-ivector-predecrement-64bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
339  (let ((rsrc temp0)
340        (srcidx temp1)
341        (destidx dest-byte-offset)
342        (data0 imm0)
343        (data1 imm1))
344    (movq (@ src (% rsp)) (% rsrc))
345    (movq (@ src-byte-offset (% rsp)) (% srcidx))
346    ;; srcidx and destidx are multiples of 8, so it's safe to right-shift
347    ;; them here (they remain fixnums).
348    (sarq ($ target::word-shift) (% srcidx))
349    (sarq ($ target::word-shift) (% destidx))
350    (testq ($ '8) (% nbytes))
351    (jz @test)
352    (lea (@ -8 (% destidx)) (% destidx))
353    (lea (@ -8 (% srcidx)) (% srcidx))
354    (movq (@ target::misc-data-offset (% rsrc) (% srcidx)) (% data0))
355    (movq (% data0) (@ target::misc-data-offset (% dest) (% destidx)))
356    (subq ($ '8) (% nbytes))   
357    (jmp @test)
358    @loop
359    (lea (@ -16 (% destidx)) (% destidx))
360    (lea (@ -16 (% srcidx)) (% srcidx))
361    (movq (@ target::misc-data-offset (% rsrc) (% srcidx)) (% data0))
362    (movq (@ (+ 8 target::misc-data-offset) (% rsrc) (% srcidx)) (% data1))
363    (movq (% data0) (@ target::misc-data-offset (% dest) (% destidx)))
364    (movq (% data1) (@ (+ 8 target::misc-data-offset) (% dest) (% destidx)))
365    @test
366    (subq ($ '16) (% nbytes))
367    (jge @loop)
368    (movq (% dest) (% arg_z))
369    (single-value-return 4)))
370
371(defx86lapfunction %copy-ivector-to-ivector-postincrement-128bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
372  (let ((rsrc temp0)
373        (srcidx imm0)
374        (destidx imm1))
375    (movq (@ src (% rsp)) (% rsrc))
376    (movq (@ src-byte-offset (% rsp)) (% srcidx))
377    (sarq ($ target::fixnumshift) (% srcidx))
378    (movq (% dest-byte-offset) (% destidx))
379    (sarq ($ target::fixnumshift) (% destidx))
380    (jmp @test)
381    @loop
382    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
383    (movdqa (@ (+ 16 target::misc-data-offset) (% rsrc) (% srcidx)) (% xmm1))
384    (movdqa (@ (+ 32 target::misc-data-offset) (% rsrc) (% srcidx)) (% xmm2))
385    (movdqa (@ (+ 48 target::misc-data-offset) (% rsrc) (% srcidx)) (% xmm3))
386    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
387    (movdqa (% xmm1) (@ (+ 16 target::misc-data-offset) (% dest) (% destidx)))
388    (movdqa (% xmm2) (@ (+ 32 target::misc-data-offset) (% dest) (% destidx)))
389    (movdqa (% xmm3) (@ (+ 48 target::misc-data-offset) (% dest) (% destidx)))
390    (lea (@ 64 (% destidx)) (% destidx))
391    (lea (@ 64 (% srcidx)) (% srcidx))
392    (subq ($ '64) (% nbytes))
393    @test
394    (cmpq ($ '64) (% nbytes))
395    (jge @loop)
396    (testq (% nbytes) (% nbytes))
397    (je @done)
398    (cmpq ($ '32) (% nbytes))
399    (je @two)
400    (jl @one)
401    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
402    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
403    (lea (@ 16 (% srcidx)) (% srcidx))
404    (lea (@ 16 (% destidx)) (% destidx))
405    @two
406    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
407    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
408    (lea (@ 16 (% srcidx)) (% srcidx))
409    (lea (@ 16 (% destidx)) (% destidx))
410    @one
411    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
412    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
413    @done
414    (movq (% dest) (% arg_z))
415    (single-value-return 4)))
416
417(defx86lapfunction %copy-ivector-to-ivector-predecrement-128bit ((src 16) (src-byte-offset 8) #||(ra 0)||# (dest arg_x) (dest-byte-offset arg_y) (nbytes arg_z))
418  (let ((rsrc temp0)
419        (srcidx imm0)
420        (destidx imm1))
421    (movq (@ src (% rsp)) (% rsrc))
422    (movq (@ src-byte-offset (% rsp)) (% srcidx))
423    (sarq ($ target::fixnumshift) (% srcidx))
424    (movq (% dest-byte-offset) (% destidx))
425    (sarq ($ target::fixnumshift) (% destidx))
426    (jmp @test)
427    @loop
428    (lea (@ -64 (% destidx)) (% destidx))
429    (lea (@ -64 (% srcidx)) (% srcidx))
430    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
431    (movdqa (@ (+ 16 target::misc-data-offset) (% rsrc) (% srcidx)) (% xmm1))
432    (movdqa (@ (+ 32 target::misc-data-offset) (% rsrc) (% srcidx)) (% xmm2))
433    (movdqa (@ (+ 48 target::misc-data-offset) (% rsrc) (% srcidx)) (% xmm3))
434    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
435    (movdqa (% xmm1) (@ (+ 16 target::misc-data-offset) (% dest) (% destidx)))
436    (movdqa (% xmm2) (@ (+ 32 target::misc-data-offset) (% dest) (% destidx)))
437    (movdqa (% xmm3) (@ (+ 48 target::misc-data-offset) (% dest) (% destidx)))
438    (subq ($ '64) (% nbytes))
439    @test
440    (cmpq ($ '64) (% nbytes))
441    (jge @loop)
442    (testq (% nbytes) (% nbytes))
443    (je @done)
444    (cmpq ($ '32) (% nbytes))
445    (je @two)
446    (jl @one)
447    (lea (@ -16 (% srcidx)) (% srcidx))
448    (lea (@ -16 (% destidx)) (% destidx))
449    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
450    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
451    @two
452    (lea (@ -16 (% srcidx)) (% srcidx))
453    (lea (@ -16 (% destidx)) (% destidx))
454    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
455    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
456    @one
457    (lea (@ -16 (% srcidx)) (% srcidx))
458    (lea (@ -16 (% destidx)) (% destidx))
459    (movdqa (@ target::misc-data-offset (% rsrc) (% srcidx)) (% xmm0))
460    (movdqa (% xmm0) (@ target::misc-data-offset (% dest) (% destidx)))
461    @done
462    (movq (% dest) (% arg_z))
463    (single-value-return 4)))
464
465
466(defx86lapfunction %copy-gvector-to-gvector ((src (* 2 x8664::node-size))
467                                             (src-element (* 1 x8664::node-size))
468                                             #|(ra 0)|#
469                                             (dest arg_x)
470                                             (dest-element arg_y)
471                                             (nelements arg_z))
472  (let ((rsrc temp0)
473        (rsrc-element imm1)
474        (val temp1))
475    (movq (@ src-element (% rsp)) (% rsrc-element))
476    (movq (@ src (% rsp)) (% rsrc))
477    (cmpq (% rsrc) (% dest))
478    (jne @front)
479    (rcmp (% rsrc-element) (% dest-element))
480    (jl @back)
481    @front
482    (testq (% nelements) (% nelements))
483    (jmp @front-test)
484    @front-loop
485    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
486    (addq ($ '1) (% rsrc-element))
487    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
488    (addq ($ '1) (% dest-element))
489    (subq ($ '1) (% nelements))
490    @front-test
491    (jne @front-loop)
492    (movq (% dest) (% arg_z))
493    (single-value-return 4)
494    @back
495    (addq (% nelements) (% rsrc-element))
496    (addq (% nelements) (% dest-element))
497    (testq (% nelements) (% nelements))
498    (jmp @back-test)
499    @back-loop
500    (subq ($ '1) (% rsrc-element))
501    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
502    (subq ($ '1) (% dest-element))
503    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
504    (subq ($ '1) (% nelements))
505    @back-test
506    (jne @back-loop)
507    (movq (% dest) (% arg_z))
508    (single-value-return 4)))
509
510(defx86lapfunction %heap-bytes-allocated ()
511  (movq (:rcontext x8664::tcr.save-allocptr) (% temp1))
512  (movq (:rcontext x8664::tcr.last-allocptr) (% temp0))
513  (cmpq ($ -16) (% temp1))
514  (movq (:rcontext x8664::tcr.total-bytes-allocated) (% imm0))
515  (jz @go)
516  (movq (% temp0) (% temp2))
517  (subq (% temp1) (% temp0))
518  (testq (% temp2) (% temp2))
519  (jz @go)
520  (add (% temp0) (% imm0))
521  @go
522  (jmp-subprim .SPmakeu64))
523
524
525(defx86lapfunction values ()
526  (:arglist (&rest values))
527  (save-frame-variable-arg-count)
528  (push-argregs)
529  (jmp-subprim .SPnvalret))
530
531(defx86lapfunction rdtsc ()
532  (:byte #x0f)                          ;two-byte rdtsc opcode
533  (:byte #x31)                          ;is #x0f #x31
534  (shlq ($ 32) (% rdx))
535  (orq (% rdx) (% rax))
536  (imul ($ (* 2 target::node-size)) (% rax) (% arg_z))
537  (shrq ($ 1) (% arg_z))
538  (single-value-return))
539
540;;; Return all 64 bits of the time-stamp counter as an unsigned integer.
541(defx86lapfunction rdtsc64 ()
542  (:byte #x0f)                          ;two-byte rdtsc opcode
543  (:byte #x31)                          ;is #x0f #x31
544  (shlq ($ 32) (% rdx))
545  (orq (% rdx) (% rax))
546  (jmp-subprim .SPmakeu64))
547
548;;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
549;;; ash::fixnumshift)) would do this inline.
550
551(defx86lapfunction %setf-macptr-to-object ((macptr arg_y) (object arg_z))
552  (check-nargs 2)
553  (trap-unless-typecode= macptr x8664::subtag-macptr)
554  (movq (% object) (@ x8664::macptr.address (% macptr)))
555  (single-value-return))
556
557(defx86lapfunction %fixnum-from-macptr ((macptr arg_z))
558  (check-nargs 1)
559  (trap-unless-typecode= arg_z x8664::subtag-macptr)
560  (movq (@ x8664::macptr.address (% arg_z)) (% imm0))
561  (trap-unless-lisptag= imm0 x8664::tag-fixnum imm1)
562  (movq (% imm0) (% arg_z))
563  (single-value-return))
564
565
566(defx86lapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
567  (trap-unless-typecode= ptr x8664::subtag-macptr)
568  (macptr-ptr ptr imm1)
569  (unbox-fixnum offset imm0)
570  (movq (@ (% imm1) (% imm0)) (% imm0))
571  (jmp-subprim .SPmakeu64))
572
573
574(defx86lapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
575  (trap-unless-typecode= ptr x8664::subtag-macptr)
576  (macptr-ptr ptr imm1)
577  (unbox-fixnum offset imm0)
578  (movq (@ (% imm1) (% imm0)) (% imm0))
579  (jmp-subprim .SPmakes64))
580
581
582
583
584(defx86lapfunction %%set-unsigned-longlong ((ptr arg_x)
585                                            (offset arg_y)
586                                            (val arg_z))
587  (save-simple-frame)
588  (trap-unless-typecode= ptr x8664::subtag-macptr)
589  (call-subprim .SPgetu64)
590  (macptr-ptr ptr imm2)
591  (unbox-fixnum offset imm1)
592  (movq (% imm0) (@ (% imm2) (% imm1)))
593  (restore-simple-frame)
594  (single-value-return))
595
596
597(defx86lapfunction %%set-signed-longlong ((ptr arg_x)
598                                          (offset arg_y)
599                                          (val arg_z))
600  (save-simple-frame)
601  (trap-unless-typecode= ptr x8664::subtag-macptr)
602  (call-subprim .SPgets64)
603  (macptr-ptr ptr imm2)
604  (unbox-fixnum offset imm1)
605  (movq (% imm0) (@ (% imm2) (% imm1)))
606  (restore-simple-frame)
607  (single-value-return))
608
609(defx86lapfunction interrupt-level ()
610  (movq (:rcontext x8664::tcr.tlb-pointer) (% imm1))
611  (movq (@ x8664::interrupt-level-binding-index (% imm1)) (% arg_z))
612  (single-value-return))
613
614(defx86lapfunction set-interrupt-level ((new arg_z))
615  (movq (:rcontext x8664::tcr.tlb-pointer) (% imm1))
616  (trap-unless-fixnum new)
617  (movq (% new) (@ x8664::interrupt-level-binding-index (% imm1)))
618  (single-value-return))
619
620(defx86lapfunction %current-tcr ()
621  (movq (:rcontext x8664::tcr.linear) (% arg_z))
622  (single-value-return))
623
624(defx86lapfunction %tcr-toplevel-function ((tcr arg_z))
625  (check-nargs 1)
626  (cmpq (% tcr) (:rcontext x8664::tcr.linear))
627  (movq (% rsp) (% imm0))
628  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
629  (movq (@ x8664::area.high (% temp0)) (% imm1))
630  (jz @room)
631  (movq (@ x8664::area.active (% temp0)) (% imm0))
632  @room
633  (cmpq (% imm1) (% imm0))
634  (movl ($ (target-nil-value)) (%l arg_z))
635  (cmovneq (@ (- x8664::node-size) (% imm1)) (% arg_z))
636  (single-value-return))
637
638(defx86lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
639  (check-nargs 2)
640  (cmpq (% tcr) (:rcontext x8664::tcr.linear))
641  (movq (% rsp) (% imm0))
642  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
643  (movq (@ x8664::area.high (% temp0)) (% imm1))
644  (jz @room)
645  (movq (@ x8664::area.active (% temp0)) (% imm0))
646  @room
647  (cmpq (% imm1) (% imm0))
648  (leaq (@ (- x8664::node-size) (% imm1)) (% imm1))
649  (movq ($ 0) (@ (% imm1)))
650  (jne @have-room)
651  (movq (% imm1) (@ x8664::area.active (% temp0)))
652  (movq (% imm1) (@ x8664::tcr.save-vsp (% tcr)))
653  @have-room
654  (movq (% fun) (@ (% imm1)))
655  (single-value-return))
656
657;;; This needs to be done out-of-line, to handle EGC memoization.
658(defx86lapfunction %store-node-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
659  (movq (@ offset (% rsp)) (% temp0))
660  (save-simple-frame)
661  (call-subprim .SPstore-node-conditional)
662  (restore-simple-frame)
663  (single-value-return 3))
664
665(defx86lapfunction %store-immediate-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
666  (movq (@ offset (% rsp)) (% temp0))
667  (unbox-fixnum temp0 imm1)
668  @again
669  (movq (@ (% object) (% imm1)) (% rax))
670  (cmpq (% rax) (% old))
671  (jne @lose)
672  (lock)
673  (cmpxchgq (% new) (@ (% object) (% imm1)))
674  (jne @again)
675  (movl ($ (target-t-value)) (%l arg_z))
676  (single-value-return 3)
677  @lose
678  (movl ($ (target-nil-value)) (%l arg_z))
679  (single-value-return 3))
680
681(defx86lapfunction set-%gcable-macptrs% ((ptr x8664::arg_z))
682  @again
683  (movq (@ (+ (target-nil-value) (x8664::kernel-global gcable-pointers)))
684        (% rax))
685  (movq (% rax) (@ x8664::xmacptr.link (% ptr)))
686  (lock)
687  (cmpxchgq (% ptr) (@ (+ (target-nil-value) (x8664::kernel-global gcable-pointers))))
688  (jne @again)
689  (single-value-return))
690
691;;; Atomically increment or decrement the gc-inhibit-count kernel-global
692;;; (It's decremented if it's currently negative, incremented otherwise.)
693(defx86lapfunction %lock-gc-lock ()
694  @again
695  (movq (@ (+ (target-nil-value) (x8664::kernel-global gc-inhibit-count))) (% rax))
696  (lea (@ '-1 (% rax)) (% temp0))
697  (lea (@ '1 (% rax)) (% arg_z))
698  (testq (% rax) (% rax))
699  (cmovsq (% temp0) (% arg_z))
700  (lock)
701  (cmpxchgq (% arg_z) (@ (+ (target-nil-value) (x8664::kernel-global gc-inhibit-count))))
702  (jnz @again)
703  (single-value-return))
704
705;;; Atomically decrement or increment the gc-inhibit-count kernel-global
706;;; (It's incremented if it's currently negative, incremented otherwise.)
707;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
708(defx86lapfunction %unlock-gc-lock ()
709  @again
710  (movq (@ (+ (target-nil-value) (x8664::kernel-global gc-inhibit-count)))
711        (% rax))
712  (lea (@ '1 (% rax)) (% arg_x))
713  (cmpq ($ -1) (% rax))
714  (lea (@ '-1 (% rax)) (% arg_z))
715  (cmovleq (% arg_x) (% arg_z))
716  (lock)
717  (cmpxchgq (% arg_z) (@ (+ (target-nil-value) (x8664::kernel-global gc-inhibit-count))))
718  (jne @again)
719  (cmpq ($ '-1) (% rax))
720  (jne @done)
721  ;; The GC tried to run while it was inhibited.  Unless something else
722  ;; has just inhibited it, it should be possible to GC now.
723  (mov ($ arch::gc-trap-function-immediate-gc) (% imm0))
724  (uuo-gc-trap)
725  @done
726  (single-value-return))
727
728;;; Return true iff we were able to increment a non-negative
729;;; lock._value
730
731
732
733
734(defx86lapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
735  (check-nargs 3)
736  (unbox-fixnum disp imm1)
737  @again
738  (movq (@ (% node) (% imm1)) (% rax))
739  (lea (@ (% rax) (% by)) (% arg_z))
740  (lock)
741  (cmpxchgq (% arg_z) (@ (% node) (% imm1)))
742  (jne @again)
743  (single-value-return))
744
745(defx86lapfunction %atomic-incf-ptr ((ptr arg_z))
746  (macptr-ptr ptr imm2)
747  @again
748  (movq (@ (% imm2)) (% rax))
749  (lea (@ 1 (% rax)) (% imm1))
750  (lock)
751  (cmpxchgq (% imm1) (@ (% imm2)))
752  (jne @again)
753  (box-fixnum imm1 arg_z)
754  (single-value-return))
755
756(defx86lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
757  (macptr-ptr ptr imm2)
758  @again
759  (movq (@ (% imm2)) (% rax))
760  (unbox-fixnum by imm1)
761  (add (% rax) (% imm1))
762  (lock)
763  (cmpxchgq (% imm1) (@ (% imm2)))
764  (jnz @again)
765  (box-fixnum imm1 arg_z)
766  (single-value-return))
767
768
769(defx86lapfunction %atomic-decf-ptr ((ptr arg_z))
770  (macptr-ptr ptr imm2)
771  @again
772  (movq (@ (% imm2)) (% rax))
773  (lea (@ -1 (% rax)) (% imm1))
774  (lock)
775  (cmpxchgq (% imm1) (@ (% imm2)))
776  (jnz @again)
777  (box-fixnum imm1 arg_z)
778  (single-value-return))
779
780(defx86lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
781  (macptr-ptr ptr imm2)
782  @again
783  (movq (@ (% imm2)) (% rax))
784  (testq (% rax) (% rax))
785  (lea (@ -1 (% rax)) (% imm1))
786  (jz @done)
787  (lock)
788  (cmpxchgq (% imm1) (@ (% imm2)))
789  (jnz @again)
790  @done
791  (box-fixnum imm1 arg_z)
792  (single-value-return))
793
794
795(defx86lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
796  (macptr-ptr arg_y imm1)
797  (unbox-fixnum newval imm0)
798  (lock)
799  (xchgq (% imm0) (@ (% imm1)))
800  (box-fixnum imm0 arg_z)
801  (single-value-return))
802
803;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
804;;; was equal to OLDVAL.  Return the old value
805(defx86lapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
806  (macptr-ptr ptr imm2)
807  @again
808  (movq (@ (% imm2)) (% imm0))
809  (box-fixnum imm0 temp0)
810  (cmpq (% temp0) (% expected-oldval))
811  (jne @done)
812  (unbox-fixnum newval imm1)
813  (lock)
814  (cmpxchgq (% imm1) (@ (% imm2)))
815  (jne @again)
816  @done
817  (movq (% temp0) (% arg_z))
818  (single-value-return))
819
820(defx86lapfunction %ptr-store-fixnum-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
821  (let ((address imm1))
822    (macptr-ptr ptr address)
823    @again
824    (movq (@ (% address)) (% imm0))
825    (cmpq (% imm0) (% expected-oldval))
826    (jne @done)
827    (lock)
828    (cmpxchgq (% newval) (@ (% address)))
829    (jne @again)
830    @done
831    (movq (% imm0) (% arg_z))
832    (single-value-return)))
833
834(defx86lapfunction xchgl ((newval arg_y) (ptr arg_z))
835  (unbox-fixnum newval imm0)
836  (macptr-ptr ptr imm1)
837  (lock)                                ; implicit ?
838  (xchgl (% imm0.l) (@ (% imm1)))
839  (box-fixnum imm0 arg_z)
840  (single-value-return))
841 
842                         
843
844
845(defx86lapfunction %macptr->dead-macptr ((macptr arg_z))
846  (check-nargs 1)
847  (movb ($ x8664::subtag-dead-macptr) (@ x8664::misc-subtag-offset (% macptr)))
848  (single-value-return))
849
850
851
852
853 
854(defx86lapfunction %%save-application ((flags arg_y) (fd arg_z))
855  (unbox-fixnum flags imm0)
856  (orq ($ arch::gc-trap-function-save-application) (% imm0))
857  (unbox-fixnum fd imm1)
858  (uuo-gc-trap)
859  (single-value-return))
860
861
862
863(defx86lapfunction %misc-address-fixnum ((misc-object arg_z))
864  (check-nargs 1)
865  (lea (@ x8664::misc-data-offset (% misc-object)) (% arg_z))
866  (single-value-return))
867
868
869(defx86lapfunction fudge-heap-pointer ((ptr arg_x) (subtype arg_y) (len arg_z))
870  (check-nargs 3)
871  (macptr-ptr ptr imm1) ; address in macptr
872  (lea (@ 17 (% imm1)) (% imm0))     ; 2 for delta + 15 for alignment
873  (andb ($ -16) (%b  imm0))   ; Clear low four bits to align
874  (subq (% imm0) (% imm1))  ; imm1 = -delta
875  (negw (%w imm1))
876  (movw (%w imm1) (@  -2 (% imm0)))     ; save delta halfword
877  (unbox-fixnum subtype imm1)  ; subtype at low end of imm1
878  (shlq ($ (- x8664::num-subtag-bits x8664::fixnum-shift)) (% len ))
879  (orq (% len) (% imm1))
880  (movq (% imm1) (@ (% imm0)))       ; store subtype & length
881  (lea (@ x8664::fulltag-misc (% imm0)) (% arg_z)) ; tag it, return it
882  (single-value-return))
883
884(defx86lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
885  (check-nargs 2)
886  (lea (@ (- x8664::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
887  (movzwq (@ -2 (% imm0)) (% imm1))     ; get delta
888  (subq (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
889  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
890  (single-value-return))
891
892
893(defx86lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
894  (lea (@ x8664::misc-data-offset (% vect)) (% imm0))
895  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
896  (single-value-return))
897
898(defx86lapfunction %ivector-from-macptr ((ptr arg_z))
899  (macptr-ptr ptr imm0)
900  (lea (@ (- target::fulltag-misc target::node-size) (% imm0)) (% arg_z))
901  (single-value-return))
902
903(defx86lapfunction get-saved-register-values ()
904  (movq (% rsp) (% temp0))
905  (push (% save0))
906  (push (% save1))
907  (push (% save2))
908  (push (% save3))                      ; this'd be the TCR on Win64.
909  (set-nargs 4)
910  (jmp-subprim .SPvalues))
911
912
913(defx86lapfunction %current-db-link ()
914  (movq (:rcontext x8664::tcr.db-link) (% arg_z))
915  (single-value-return))
916
917(defx86lapfunction %no-thread-local-binding-marker ()
918  (movq ($ x8664::subtag-no-thread-local-binding) (% arg_z))
919  (single-value-return))
920
921
922(defx86lapfunction pending-user-interrupt ()
923  (xorq (% imm0) (% imm0))
924  (ref-global x8664::intflag arg_z)
925  ;; If another signal happens now, it will get ignored, same as if it happened
926  ;; before whatever signal is in arg_z.  But then these are async signals, so
927  ;; who can be sure it didn't actually happen just before...
928  (set-global imm0 x8664::intflag)
929  (single-value-return))
930
931
932(defx86lapfunction debug-trap-with-string ((arg arg_z))
933  (check-nargs 1)
934  (uuo-error-debug-trap-with-string)
935  (single-value-return))
936
937(defx86lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
938  (check-nargs 2)
939  (save-simple-frame)
940  (macptr-ptr src imm0)
941  (leaq (@ (:^ done) (% fn)) (% ra0))
942  (movq (% imm0) (:rcontext x8664::tcr.safe-ref-address))
943  (movq (@ (% imm0)) (% imm0))
944  (jmp done)
945  (:tra done)
946  (recover-fn-from-rip)
947  (movq ($ 0) (:rcontext x8664::tcr.safe-ref-address))
948  (movq (% imm0) (@ x8664::macptr.address (% dest)))
949  (restore-simple-frame)
950  (single-value-return))
951
952;;; This was intentded to work around a bug in #_nanosleep in early
953;;; Leopard test releases.  It's probably not necessary any more; is
954;;; it still called ?
955
956(defx86lapfunction %check-deferred-gc ()
957  (btq ($ (+ arch::tcr-flag-bit-pending-suspend target::fixnumshift)) (:rcontext x8664::tcr.flags))
958  (movl ($ (target-nil-value)) (% arg_z.l))
959  (jae @done)
960  (ud2a)
961  (:byte 3)
962  (movl ($ (target-t-value)) (% arg_z.l))
963  @done
964  (single-value-return))
965
966(defx86lapfunction %%tcr-interrupt ((target arg_z))
967  (check-nargs 1)
968  (ud2a)
969  (:byte 4)
970  (box-fixnum imm0 arg_z)
971  (single-value-return))
972
973(defx86lapfunction %suspend-tcr ((target arg_z))
974  (check-nargs 1)
975  (ud2a)
976  (:byte 5)
977  (movzbl (%b imm0) (%l imm0))
978  (testl (%l imm0) (%l imm0))
979  (movl ($ (target-nil-value)) (%l arg_z))
980  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
981  (single-value-return))
982
983(defx86lapfunction %suspend-other-threads ()
984  (check-nargs 0)
985  (ud2a)
986  (:byte 6)
987  (movl ($ (target-nil-value)) (%l arg_z))
988  (single-value-return))
989
990(defx86lapfunction %resume-tcr ((target arg_z))
991  (check-nargs 1)
992  (ud2a)
993  (:byte 7)
994  (movzbl (%b imm0) (%l imm0))
995  (testl (%l imm0) (%l imm0))
996  (movl ($ (target-nil-value)) (%l arg_z))
997  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
998  (single-value-return))
999
1000(defx86lapfunction %resume-other-threads ()
1001  (check-nargs 0)
1002  (ud2a)
1003  (:byte 8)
1004  (movl ($ (target-nil-value)) (%l arg_z))
1005  (single-value-return))
1006
1007(defx86lapfunction %kill-tcr ((target arg_z))
1008  (check-nargs 1)
1009  (ud2a)
1010  (:byte 9)
1011  (testb (%b imm0) (%b imm0))
1012  (movl ($ (target-nil-value)) (%l arg_z))
1013  (cmovnel (@ (+ target::t-offset target::symbol.vcell) (% arg_z)) (%l arg_z))
1014  (single-value-return))
1015 
1016
1017(defx86lapfunction %get-spin-lock ((p arg_z))
1018  (check-nargs 1)
1019  (save-simple-frame)
1020  @again
1021  (macptr-ptr arg_z imm1)
1022  (movq (@ '*spin-lock-tries* (% fn)) (% temp0))
1023  (movq (@ '*spin-lock-timeouts* (% fn)) (% temp1))
1024  (movq (@ target::symbol.vcell (% temp0)) (% temp0))
1025  (movq (:rcontext x8664::tcr.linear) (% arg_y))
1026  @try-swap
1027  (xorq (% rax) (% rax))
1028  (lock)
1029  (cmpxchgq (% arg_y) (@ (% imm1)))
1030  (je @done)
1031  @spin
1032  (pause)
1033  (cmpq ($ 0) (@ (% imm1)))
1034  (je @try-swap)
1035  (subq ($ '1) (% temp0))
1036  (jne @spin)
1037  @wait
1038  (addq ($ x8664::fixnumone) (@ x8664::symbol.vcell (% temp1)))
1039  (pushq (% arg_z))
1040  (call-symbol yield 0)
1041  (popq (% arg_z))
1042  (jmp @again)
1043  @done
1044  (restore-simple-frame)
1045  (single-value-return))
1046
1047;;; This is a prototype; it can't easily keep its arguments on the stack,
1048;;; or in registers, because its job involves unwinding the stack and
1049;;; restoring registers.  Its parameters are thus kept in constants,
1050;;; and this protoype is cloned (with the right parameters).
1051
1052;;; For win64 (which doesn't really have a "save3" register), the code
1053;;; which instantiates this should always set save3-offset to 0.
1054(defx86lapfunction %%apply-in-frame-proto ()
1055  (:fixed-constants (target-frame target-catch target-db-link target-xcf target-tsp target-foreign-sp save0-offset save1-offset save2-offset save3-offset function args))
1056  (check-nargs 0)
1057  ;;(uuo-error-debug-trap)
1058  (movq (@ 'target-catch (% fn)) (% temp0))
1059  (xorl (%l imm0) (%l imm0))
1060  (cmpb ($ x8664::fulltag-nil) (%b temp0))
1061  (movq (:rcontext target::tcr.catch-top) (% arg_z))
1062  (jz @did-catch)
1063  @find-catch
1064  (testq (% arg_z) (% arg_z))
1065  (jz @did-catch)                       ; never found target catch
1066  (addq ($ '1)  (% imm0))
1067  (cmpq (% temp0) (% arg_z))
1068  (je @found-catch)
1069  (movq (@ target::catch-frame.link (% arg_z)) (% arg_z))
1070  (jmp @find-catch)
1071  @found-catch
1072  (set-nargs 0)                         ; redundant, but ...
1073  (lea (@ (:^ @back-from-nthrow) (% fn)) (% ra0))
1074  (:talign 4)
1075  (jmp-subprim .SPnthrowvalues)
1076  @back-from-nthrow
1077  (recover-fn-from-rip)
1078  @did-catch
1079  ;; Restore special bindings
1080  (movq (@ 'target-db-link (% fn)) (% imm0))
1081  (cmpb ($ x8664::fulltag-nil) (%b imm0))
1082  (jz @no-unbind)
1083  (call-subprim .SPunbind-to)
1084  @no-unbind
1085  ;; If there's at least one exception frame between the target
1086  ;; frame and the last catch (or the point of departure), restore
1087  ;; the NVRs and foreign sp from the oldest such frame
1088  (movq (@ 'target-xcf (% fn)) (% arg_z))
1089  (cmpb ($ x8664::fulltag-nil) (%b arg_z))
1090  (jz @no-xcf)
1091  (movq (@ target::xcf.xp (% arg_z)) (% arg_y))
1092  ;; arg_y points to a "portable" ucontext.  Find the platform-specifc
1093  ;; "gpr vector" in the uc_mcontext, load the NVRs and stack/frame
1094  ;; pointer from there.
1095  #+linuxx8664-target
1096  (progn
1097    (addq ($ gp-regs-offset) (% arg_y))
1098    (movq (@ (* #$REG_R15 8) (% arg_y)) (% r15))
1099    (movq (@ (* #$REG_R14 8) (% arg_y)) (% r14))
1100    (movq (@ (* #$REG_R12 8) (% arg_y)) (% r12))
1101    (movq (@ (* #$REG_R11 8) (% arg_y)) (% r11))
1102    (movq (@ (* #$REG_RBP 8) (% arg_y)) (% rbp))
1103    (movq (@ (* #$REG_RSP 8) (% arg_y)) (% rsp)))
1104  #+freebsdx8664-target
1105  (progn
1106    ;; If you think that this is ugly, just wait until you see the Darwin
1107    ;; version.
1108    (addq ($ gp-regs-offset) (% arg_y))
1109    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r15)) -3) (% arg_y)) (% r15))
1110    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r14)) -3) (% arg_y)) (% r14))
1111    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r12)) -3) (% arg_y)) (% r12))
1112    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_r11)) -3) (% arg_y)) (% r11))
1113    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_rbp)) -3) (% arg_y)) (% rbp))
1114    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__mcontext)) :mc_rsp)) -3) (% arg_y)) (% rsp)))
1115  #+darwinx8664-target
1116  (progn
1117    ;; Yes, this is ugly.
1118    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_ucontext)) :uc_mcontext)) -3) (% arg_y)) (% arg_y))
1119    (addq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_mcontext64)) :__ss)) -3)) (% arg_y))
1120    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r15)) -3) (% arg_y)) (% r15))
1121    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r14)) -3) (% arg_y)) (% r14))
1122    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r12)) -3) (% arg_y)) (% r12))
1123    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__r11)) -3) (% arg_y)) (% r11))
1124    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__rbp)) -3) (% arg_y)) (% rbp))
1125    (movq (@ (ash (foreign-record-field-offset (%find-foreign-record-type-field (parse-foreign-type '(:struct :__darwin_x86_thread_state64)) :__rsp)) -3) (% arg_y)) (% rsp)))
1126  ;; This is our best (possibly only) chance to get
1127  ;; the foreign sp right.
1128  (movq (@ target::xcf.prev-xframe (% arg_z)) (% temp0))
1129  (movq (@ target::xcf.foreign-sp (% arg_z)) (% imm0))
1130  (movq (% temp0) (:rcontext target::tcr.xframe))
1131  (movq (% imm0) (:rcontext target::tcr.foreign-sp))
1132  ;; All done processing the xcf.  NVRs may have been
1133  ;; saved between the last catch/last xcf and the
1134  ;; target frame.  The save-n-offset parameter/constants
1135  ;; are either 0 or negative offsets from the target frame
1136  ;; of the stack location where the corresponding GPR
1137  ;; was saved.
1138  @no-xcf
1139  (movq (@ 'target-tsp (% fn)) (% imm0))
1140  (cmpb ($ x8664::fulltag-nil) (%b imm0))
1141  (movq (@ 'target-foreign-sp (% fn)) (% temp0))
1142  (je @no-tsp)
1143  (movq (% imm0) (:rcontext target::tcr.save-tsp))
1144  (movq (% imm0) (:rcontext target::tcr.next-tsp))
1145  @no-tsp
1146  (cmpb ($ x8664::fulltag-nil) (%b temp0))
1147  (je @no-sp)
1148  (movq (% temp0) (:rcontext target::tcr.foreign-sp))
1149  @no-sp
1150  (movq (@ 'target-frame (% fn)) (% rbp))
1151  (movq (@ 'save0-offset (% fn)) (% arg_x))
1152  (movq (@ 'save1-offset (% fn)) (% arg_y))
1153  (movq (@ 'save2-offset (% fn)) (% arg_z))
1154  (movq (@ 'save3-offset (% fn)) (% temp0))
1155  (testq (% arg_x) (% arg_x))
1156  (cmovneq (@ (% rbp) (% arg_x)) (% save0))
1157  (testq (% arg_y) (% arg_y))
1158  (cmovneq (@ (% rbp) (% arg_x)) (% save1))
1159  (testq (% arg_z) (% arg_z))
1160  (cmovneq (@ (% rbp) (% arg_x)) (% save2))
1161  (testq (% temp0) (% temp0))
1162  (cmovneq (@ (% rbp) (% arg_x)) (% save3))
1163  (leave)
1164  (pop (% temp0))                       ; return address, not used by subprim
1165  (set-nargs 0)
1166  (movq (@ 'args (% fn)) (% arg_z))
1167  (lea (@ (:^ @back-from-spread) (% fn)) (% ra0))
1168  (:talign 4)
1169  (jmp-subprim .SPspreadargz)
1170  @back-from-spread
1171  (recover-fn-from-rip)                 ; .SPspreadargz preserves %fn, but ...
1172  (push (% temp0))                      ; return address
1173  (jmp (@ 'function (% fn))))
1174 
1175
1176(defx86lapfunction %atomic-pop-static-cons ()
1177  @again
1178  (movq (@ (+ (target-nil-value) (x8664::kernel-global static-conses))) (% rax))
1179  (cmpq ($ (target-nil-value)) (% rax))
1180  (jz @lose)
1181  (%cdr rax temp0)
1182  (lock)
1183  (cmpxchgq (% temp0) (@ (+ (target-nil-value) (x8664::kernel-global static-conses))))
1184  (jnz @again)
1185  (lock)
1186  (subq ($ x8664::fixnumone) (@ (+ (target-nil-value) (x8664::kernel-global free-static-conses))))
1187  @lose
1188  (movq (% rax) (% arg_z))
1189  (single-value-return))
1190
1191
1192 
1193(defx86lapfunction %staticp ((x arg_z))
1194  (check-nargs 1)
1195  (ref-global static-cons-area temp0)
1196  (movq (% x) (% imm0))
1197  (movl ($ (target-nil-value)) (% arg_z.l))
1198  (subq (@ target::area.low (% temp0)) (% imm0))
1199  (shrq ($ target::dnode-shift) (% imm0))
1200  (movq (@ target::area.ndnodes (% temp0)) (% imm1))
1201  (subq (% imm0) (% imm1))
1202  (lea (@ 128 (% imm1)) (% imm1))
1203  (leaq (@ (% imm1) target::fixnumone) (% imm1))
1204  (cmovaq (% imm1) (% arg_z))
1205  (single-value-return))
1206
1207(defx86lapfunction %static-inverse-cons ((n arg_z))
1208  (check-nargs 1)
1209  (testl ($ target::tagmask) (% arg_z.l))
1210  (jne @fail)
1211  (subq ($ '128) (% arg_z))
1212  (ref-global static-cons-area temp0)
1213  (movq (@ target::area.ndnodes (% temp0)) (% imm0))
1214  (box-fixnum imm0 arg_y)
1215  (rcmpq (% arg_z) (% arg_y))
1216  (ja @fail)
1217  (movq (@ target::area.high (% temp0)) (% imm0))
1218  (subq (% arg_z) (% imm0))
1219  (subq (% arg_z) (% imm0))
1220  (lea (@ x8664::fulltag-cons (% imm0)) (% arg_z))
1221  (cmpb ($ target::unbound-marker) (@ target::cons.car (% arg_z)))
1222  (je @fail)
1223  (single-value-return)
1224  @fail
1225  (movl ($ (target-nil-value)) (% arg_z.l))
1226  (single-value-return))
1227
1228
1229 
1230
1231;;; end of x86-misc.lisp
1232) ; #+x8664-target
Note: See TracBrowser for help on using the repository browser.