[9f79f7]: src / compiler / x86-64 / values.lisp Maximize Restore History

Download this file

values.lisp    152 lines (136 with data), 5.0 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
;;;; unknown-values VOPs for the x86 VM
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.
(in-package "SB!VM")
(define-vop (reset-stack-pointer)
(:args (ptr :scs (any-reg)))
(:generator 1
(move rsp-tn ptr)))
(define-vop (%%nip-values)
(:args (last-nipped-ptr :scs (any-reg) :target rdi)
(last-preserved-ptr :scs (any-reg) :target rsi)
(moved-ptrs :scs (any-reg) :more t))
(:results (r-moved-ptrs :scs (any-reg) :more t)
;; same as MOVED-PTRS
)
(:temporary (:sc any-reg :offset rsi-offset) rsi)
(:temporary (:sc any-reg :offset rdi-offset) rdi)
(:ignore r-moved-ptrs)
(:generator 1
(move rdi last-nipped-ptr)
(move rsi last-preserved-ptr)
(inst sub rsi n-word-bytes)
(inst sub rdi n-word-bytes)
(inst cmp rsp-tn rsi)
(inst jmp :a done)
(inst std)
LOOP
(inst movs :qword)
(inst cmp rsp-tn rsi)
(inst jmp :be loop)
DONE
(inst lea rsp-tn (make-ea :qword :base rdi :disp n-word-bytes))
(inst sub rdi rsi)
(loop for moved = moved-ptrs then (tn-ref-across moved)
while moved
do (inst add (tn-ref-tn moved) rdi))))
;;; Push some values onto the stack, returning the start and number of values
;;; pushed as results. It is assumed that the Vals are wired to the standard
;;; argument locations. Nvals is the number of values to push.
;;;
;;; The generator cost is pseudo-random. We could get it right by defining a
;;; bogus SC that reflects the costs of the memory-to-memory moves for each
;;; operand, but this seems unworthwhile.
(define-vop (push-values)
(:args (vals :more t))
(:temporary (:sc unsigned-reg :to (:result 0) :target start) temp)
(:results (start) (count))
(:info nvals)
(:generator 20
(move temp rsp-tn) ; WARN pointing 1 below
(do ((val vals (tn-ref-across val)))
((null val))
(inst push (tn-ref-tn val)))
(move start temp)
(inst mov count (fixnumize nvals))))
;;; Push a list of values on the stack, returning Start and Count as used in
;;; unknown values continuations.
(define-vop (values-list)
(:args (arg :scs (descriptor-reg) :target list))
(:arg-types list)
(:policy :fast-safe)
(:results (start :scs (any-reg))
(count :scs (any-reg)))
(:temporary (:sc descriptor-reg :from (:argument 0) :to (:result 1)) list)
(:temporary (:sc descriptor-reg :to (:result 1)) nil-temp)
(:temporary (:sc unsigned-reg :offset rax-offset :to (:result 1)) rax)
(:vop-var vop)
(:save-p :compute-only)
(:generator 0
(move list arg)
(move start rsp-tn) ; WARN pointing 1 below
(inst mov nil-temp nil-value)
LOOP
(inst cmp list nil-temp)
(inst jmp :e done)
(pushw list cons-car-slot list-pointer-lowtag)
(loadw list list cons-cdr-slot list-pointer-lowtag)
(inst mov rax list)
(inst and al-tn lowtag-mask)
(inst cmp al-tn list-pointer-lowtag)
(inst jmp :e loop)
(error-call vop bogus-arg-to-values-list-error list)
DONE
(inst mov count start) ; start is high address
(inst sub count rsp-tn))) ; stackp is low address
;;; Copy the more arg block to the top of the stack so we can use them
;;; as function arguments.
;;;
;;; Accepts a context as produced by more-arg-context; points to the first
;;; value on the stack, not 4 bytes above as in other contexts.
;;;
;;; Return a context that is 4 bytes above the first value, suitable for
;;; defining a new stack frame.
(define-vop (%more-arg-values)
(:args (context :scs (descriptor-reg any-reg) :target src)
(skip :scs (any-reg immediate))
(num :scs (any-reg) :target count))
(:arg-types * positive-fixnum positive-fixnum)
(:temporary (:sc any-reg :offset rsi-offset :from (:argument 0)) src)
(:temporary (:sc descriptor-reg :offset rax-offset) temp)
(:temporary (:sc unsigned-reg :offset rcx-offset) temp1)
(:results (start :scs (any-reg))
(count :scs (any-reg)))
(:generator 20
(sc-case skip
(immediate
(cond ((zerop (tn-value skip))
(move src context)
(move count num))
(t
(inst lea src (make-ea :dword :base context
:disp (- (* (tn-value skip)
n-word-bytes))))
(move count num)
(inst sub count (* (tn-value skip) n-word-bytes)))))
(any-reg
(move src context)
(inst sub src skip)
(move count num)
(inst sub count skip)))
(move temp1 count)
(inst mov start rsp-tn)
(inst jecxz done) ; check for 0 count?
(inst shr temp1 word-shift) ; convert the fixnum to a count.
(inst std) ; move down the stack as more value are copied to the bottom.
LOOP
(inst lods temp)
(inst push temp)
(inst loop loop)
DONE))