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

Last change on this file since 16347 was 16347, checked in by rme, 6 years ago

Remove the 128 bit flavors of %copy-ivector-to-ivector.

Simple timing tests showed no improvement over the 64-bit flavors.

Incidentally closes ticket:1262.

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