Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
85b80477
Commit
85b80477
authored
May 21, 2004
by
cwang
Browse files
amd64 assembly files
parent
e50e46c2
Changes
4
Hide whitespace changes
Inline
Side-by-side
assembly/amd64/arith.lisp
0 → 100644
View file @
85b80477
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/amd64/arith.lisp,v 1.1 2004/05/21 22:46:43 cwang Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; Stuff to handle simple cases for generic arithmetic.
;;;
;;; Written by William Lott.
;;; Debugged by Paul Werkowski -- Spring/Summer 1995.
;;;
(
in-package
:amd64
)
(
eval-when
(
compile
eval
)
;;;; Addition, Subtraction, and Multiplication
(
defmacro
define-generic-arith-routine
((
fun
cost
)
&body
body
)
`
(
define-assembly-routine
(
,
(
symbolicate
"GENERIC-"
fun
)
(
:cost
,
cost
)
(
:return-style
:full-call
)
(
:translate
,
fun
)
(
:policy
:safe
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
;; this seems wrong esi-offset
rdi-offset
)
(
:res
res
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
)
(
:temp
rbx
unsigned-reg
rbx-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
))
(
inst
test
x
3
)
; fixnum?
(
inst
jmp
:nz
DO-STATIC-FUN
)
; no - do generic
(
inst
test
y
3
)
; fixnum?
(
inst
jmp
:z
DO-BODY
)
; yes - doit here
DO-STATIC-FUN
(
inst
pop
rax
)
(
inst
push
rbp-tn
)
(
inst
lea
rbp-tn
(
make-ea
:qword
:base
rsp-tn
:disp
word-bytes
))
(
inst
sub
rsp-tn
(
*
2
word-bytes
))
(
inst
push
rax
)
; callers return addr
(
inst
mov
rcx
(
fixnumize
2
))
; arg count
(
inst
mov
rbx
(
+
nil-value
(
static-function-offset
',
(
symbolicate
"TWO-ARG-"
fun
))))
(
inst
jmp
(
make-ea
:qword
:base
rbx
))
DO-BODY
,@
body
))
)
; eval-when
(
define-generic-arith-routine
(
+
10
)
(
move
res
x
)
(
inst
add
res
y
)
(
inst
jmp
:no
OKAY
)
(
inst
rcr
res
1
)
; carry has correct sign
(
inst
sar
res
1
)
; remove type bits
(
move
rcx
res
)
(
with-fixed-allocation
(
res
bignum-type
(
1+
bignum-digits-offset
)
rax
)
(
storew
rcx
res
bignum-digits-offset
other-pointer-type
))
OKAY
)
(
define-generic-arith-routine
(
-
10
)
;;; I can't figure out the flags on subtract. Overflow never gets
;;; set and carry always does. (- 0 most-negative-fixnum) can't be
;;; easily detected so just let the upper level stuff do it.
(
inst
jmp
DO-STATIC-FUN
)
;; this is junk code. clean this up!!!
(
move
res
x
)
(
inst
sub
res
y
)
(
inst
jmp
:no
OKAY
)
(
inst
rcr
res
1
)
(
inst
sar
res
1
)
; remove type bits
(
move
rcx
res
)
(
with-fixed-allocation
(
res
bignum-type
(
1+
bignum-digits-offset
)
rax
)
(
storew
rcx
res
bignum-digits-offset
other-pointer-type
))
OKAY
)
(
define-generic-arith-routine
(
*
30
)
(
move
rax
x
)
; must use rax for 64-bit result
(
inst
sar
rax
2
)
; remove *4 fixnum bias
(
inst
imul
y
)
; result in rdx:eax
(
inst
jmp
:no
okay
)
; still fixnum
;; zzz jrd changed rdx to rbx in here, as rdx isn't listed as a temp, above
;; pfw says that loses big -- rdx is target for arg x and result res
;; note that 'rdx' is not defined -- using x
(
inst
shrd
rax
x
2
)
; high bits from rdx
(
inst
sar
x
2
)
; now shift rdx too
(
move
rcx
x
)
; save high bits from cdq
(
inst
cdq
)
; rdx:eax <- sign-extend of rax
(
inst
cmp
x
rcx
)
(
inst
jmp
:e
SINGLE-WORD-BIGNUM
)
(
with-fixed-allocation
(
res
bignum-type
(
+
bignum-digits-offset
2
)
rbx
)
(
storew
rax
res
bignum-digits-offset
other-pointer-type
)
(
storew
rcx
res
(
1+
bignum-digits-offset
)
other-pointer-type
))
(
inst
jmp
DONE
)
SINGLE-WORD-BIGNUM
(
with-fixed-allocation
(
res
bignum-type
(
1+
bignum-digits-offset
)
rbx
)
(
storew
rax
res
bignum-digits-offset
other-pointer-type
))
(
inst
jmp
DONE
)
OKAY
(
move
res
rax
)
DONE
)
(
define-assembly-routine
(
generic-negate
(
:cost
10
)
(
:return-style
:full-call
)
(
:policy
:safe
)
(
:translate
%negate
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:res
res
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
))
(
inst
test
x
3
)
(
inst
jmp
:z
FIXNUM
)
(
inst
pop
rax
)
(
inst
push
rbp-tn
)
(
inst
lea
rbp-tn
(
make-ea
:qword
:base
rsp-tn
:disp
word-bytes
))
(
inst
sub
rsp-tn
(
fixnumize
2
))
(
inst
push
rax
)
(
inst
mov
rcx
(
fixnumize
1
))
; arg count
(
inst
mov
rax
(
+
nil-value
(
static-function-offset
'%negate
)))
(
inst
jmp
(
make-ea
:qword
:base
rax
))
FIXNUM
(
move
res
x
)
(
inst
neg
res
)
; (- most-negative-fixnum) is BIGNUM
(
inst
jmp
:no
OKAY
)
(
inst
shr
res
2
)
; sign bit is data - remove type bits
(
move
rcx
res
)
(
with-fixed-allocation
(
res
bignum-type
(
1+
bignum-digits-offset
)
rax
)
(
storew
rcx
res
bignum-digits-offset
other-pointer-type
))
OKAY
)
;;;; Comparison routines.
(
eval-when
(
compile
eval
)
(
defmacro
define-cond-assem-rtn
(
name
translate
static-fn
test
)
`
(
define-assembly-routine
(
,
name
(
:cost
10
)
(
:return-style
:full-call
)
(
:policy
:safe
)
(
:translate
,
translate
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
rdi-offset
)
(
:res
res
descriptor-reg
rdx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
))
(
inst
test
x
3
)
(
inst
jmp
:nz
DO-STATIC-FN
)
(
inst
test
y
3
)
(
inst
jmp
:z
DO-COMPARE
)
DO-STATIC-FN
(
inst
pop
rax
)
(
inst
push
rbp-tn
)
(
inst
lea
rbp-tn
(
make-ea
:qword
:base
rsp-tn
:disp
word-bytes
))
(
inst
sub
rsp-tn
(
*
2
word-bytes
))
(
inst
push
rax
)
(
inst
mov
rcx
(
fixnumize
2
))
(
inst
mov
rax
(
+
nil-value
(
static-function-offset
',static-fn
)))
(
inst
jmp
(
make-ea
:qword
:base
rax
))
DO-COMPARE
(
inst
cmp
x
y
)
(
inst
jmp
,
test
TRUE
)
(
inst
mov
res
nil-value
)
(
inst
pop
rax
)
(
inst
add
rax
3
)
; single value return
(
inst
jmp
rax
)
TRUE
(
load-symbol
res
t
)))
)
; eval-when
(
define-cond-assem-rtn
generic-<
<
two-arg-<
:l
)
(
define-cond-assem-rtn
generic->
>
two-arg->
:g
)
(
define-assembly-routine
(
generic-eql
(
:cost
10
)
(
:return-style
:full-call
)
(
:policy
:safe
)
(
:translate
eql
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
rdi-offset
)
(
:res
res
descriptor-reg
rdx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
))
(
inst
cmp
x
y
)
(
inst
jmp
:e
RETURN-T
)
(
inst
test
x
3
)
(
inst
jmp
:z
RETURN-NIL
)
(
inst
test
y
3
)
(
inst
jmp
:nz
DO-STATIC-FN
)
RETURN-NIL
(
inst
mov
res
nil-value
)
(
inst
pop
rax
)
(
inst
add
rax
3
)
; single value return
(
inst
jmp
rax
)
DO-STATIC-FN
(
inst
pop
rax
)
(
inst
push
rbp-tn
)
(
inst
lea
rbp-tn
(
make-ea
:qword
:base
rsp-tn
:disp
word-bytes
))
(
inst
sub
rsp-tn
(
fixnumize
2
))
(
inst
push
rax
)
; return address
(
inst
mov
rcx
(
fixnumize
2
))
; number of arguments
(
inst
mov
rax
(
+
nil-value
(
static-function-offset
'eql
)))
(
inst
jmp
(
make-ea
:qword
:base
rax
))
RETURN-T
(
load-symbol
res
t
))
(
define-assembly-routine
(
generic-=
(
:cost
10
)
(
:return-style
:full-call
)
(
:policy
:safe
)
(
:translate
=
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
rdx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
rdi-offset
)
(
:res
res
descriptor-reg
rdx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
)
)
(
inst
test
x
3
)
; descriptor?
(
inst
jmp
:nz
DO-STATIC-FN
)
; yes do it here
(
inst
test
y
3
)
; descriptor?
(
inst
jmp
:nz
DO-STATIC-FN
)
(
inst
cmp
x
y
)
(
inst
jmp
:e
RETURN-T
)
; ok
(
inst
mov
res
nil-value
)
(
inst
pop
rax
)
(
inst
add
rax
3
)
(
inst
jmp
rax
)
DO-STATIC-FN
(
inst
pop
rax
)
(
inst
push
rbp-tn
)
(
inst
lea
rbp-tn
(
make-ea
:qword
:base
rsp-tn
:disp
word-bytes
))
(
inst
sub
rsp-tn
(
*
2
word-bytes
))
(
inst
push
rax
)
(
inst
mov
rcx
(
fixnumize
2
))
(
inst
mov
rax
(
+
nil-value
(
static-function-offset
'two-arg-=
)))
(
inst
jmp
(
make-ea
:qword
:base
rax
))
RETURN-T
(
load-symbol
res
t
))
;;; Support for the Mersenne Twister, MT19937, random number generator
;;; due to Matsumoto and Nishimura.
;;;
;;; Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
;;; 623-dimensionally equidistributed uniform pseudorandom number
;;; generator.", ACM Transactions on Modeling and Computer Simulation,
;;; 1997, to appear.
;;;
;;; State:
;;; 0-1: Constant matrix A. [0, #x9908b0df] (not used here)
;;; 2: Index; init. to 1.
;;; 3-626: State.
;;;
;;; This assembly routine is called from the inline VOP and updates
;;; the state vector with new random numbers. The state vector is
;;; passed in the rAX register.
;;;
#+
assembler
; we don't want a vop for this one.
(
define-assembly-routine
(
random-mt19937-update
)
((
:temp
state
unsigned-reg
rax-offset
)
(
:temp
k
unsigned-reg
rbx-offset
)
(
:temp
y
unsigned-reg
rcx-offset
)
(
:temp
tmp
unsigned-reg
rdx-offset
))
;; Save the temporary registers.
(
inst
push
k
)
(
inst
push
y
)
(
inst
push
tmp
)
;; Generate a new set of results.
(
inst
xor
k
k
)
LOOP1
(
inst
mov
y
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
mov
tmp
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
1
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
and
y
#x80000000
)
(
inst
and
tmp
#x7fffffff
)
(
inst
or
y
tmp
)
(
inst
shr
y
1
)
(
inst
jmp
:nc
skip1
)
(
inst
xor
y
#x9908b0df
)
SKIP1
(
inst
xor
y
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
397
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
mov
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
))
y
)
(
inst
inc
k
)
(
inst
cmp
k
(
-
624
397
))
(
inst
jmp
:b
loop1
)
LOOP2
(
inst
mov
y
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
mov
tmp
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
1
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
and
y
#x80000000
)
(
inst
and
tmp
#x7fffffff
)
(
inst
or
y
tmp
)
(
inst
shr
y
1
)
(
inst
jmp
:nc
skip2
)
(
inst
xor
y
#x9908b0df
)
SKIP2
(
inst
xor
y
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
(
-
397
624
)
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
mov
(
make-ea
:qword
:base
state
:index
k
:scale
4
:disp
(
-
(
*
(
+
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
))
y
)
(
inst
inc
k
)
(
inst
cmp
k
(
-
624
1
))
(
inst
jmp
:b
loop2
)
(
inst
mov
y
(
make-ea
:qword
:base
state
:disp
(
-
(
*
(
+
(
-
624
1
)
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
mov
tmp
(
make-ea
:qword
:base
state
:disp
(
-
(
*
(
+
0
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
and
y
#x80000000
)
(
inst
and
tmp
#x7fffffff
)
(
inst
or
y
tmp
)
(
inst
shr
y
1
)
(
inst
jmp
:nc
skip3
)
(
inst
xor
y
#x9908b0df
)
SKIP3
(
inst
xor
y
(
make-ea
:qword
:base
state
:disp
(
-
(
*
(
+
(
-
397
1
)
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
)))
(
inst
mov
(
make-ea
:qword
:base
state
:disp
(
-
(
*
(
+
(
-
624
1
)
3
vm:vector-data-offset
)
vm:word-bytes
)
vm:other-pointer-type
))
y
)
;; Restore the temporary registers and return.
(
inst
pop
tmp
)
(
inst
pop
y
)
(
inst
pop
k
)
(
inst
ret
))
assembly/amd64/array.lisp
0 → 100644
View file @
85b80477
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/amd64/array.lisp,v 1.1 2004/05/21 22:46:43 cwang Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; This file contains various array operations that are too expensive
;;; (in space) to do inline.
;;;
;;; Written by William Lott.
;;;
;;; Debugged by Paul F. Werkowski -- Spring 1995.
;;;
(
in-package
:amd64
)
;;;; Allocation
(
define-assembly-routine
(
allocate-vector
(
:policy
:fast-safe
)
(
:translate
allocate-vector
)
(
:arg-types
positive-fixnum
positive-fixnum
positive-fixnum
))
((
:arg
type
unsigned-reg
rax-offset
)
(
:arg
length
any-reg
rbx-offset
)
(
:arg
words
any-reg
rcx-offset
)
(
:temp
temp
any-reg
rdi-offset
)
(
:res
result
descriptor-reg
rdx-offset
))
;; compute the number of bytes
;; words is a fixnum
(
inst
lea
result
(
make-ea
:byte
:base
words
:index
words
:disp
(
+
15
(
*
vector-data-offset
word-bytes
))))
(
inst
and
result
(
lognot
15
))
; alignment
(
pseudo-atomic
(
allocation
result
result
temp
)
(
inst
lea
result
(
make-ea
:byte
:base
result
:disp
other-pointer-type
))
(
storew
type
result
0
other-pointer-type
)
(
storew
length
result
vector-length-slot
other-pointer-type
))
(
inst
ret
))
;;;; Hash primitives
(
define-assembly-routine
(
sxhash-simple-string
(
:translate
%sxhash-simple-string
)
(
:policy
:fast-safe
)
(
:result-types
positive-fixnum
))
((
:arg
string
descriptor-reg
rbx-offset
)
(
:res
result
any-reg
rdx-offset
)
(
:temp
length
any-reg
rdi-offset
)
(
:temp
rsi
unsigned-reg
rsi-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
))
(
declare
(
ignore
result
rsi
rcx
rax
))
(
loadw
length
string
vector-length-slot
other-pointer-type
)
(
inst
jmp
(
make-fixup
'sxhash-simple-substring
:assembly-routine
)))
(
define-assembly-routine
(
sxhash-simple-substring
(
:translate
%sxhash-simple-substring
)
(
:policy
:fast-safe
)
(
:arg-types
*
positive-fixnum
)
(
:result-types
positive-fixnum
))
((
:arg
string
descriptor-reg
rbx-offset
)
(
:arg
length
any-reg
rdi-offset
)
(
:res
result
any-reg
rdx-offset
)
(
:temp
rsi
unsigned-reg
rsi-offset
)
(
:temp
rcx
unsigned-reg
rcx-offset
)
(
:temp
rax
unsigned-reg
rax-offset
))
;; Compute a pointer to where we are going to be extracting the bits.
(
inst
lea
rsi
(
make-ea
:byte
:base
string
:disp
(
-
(
*
vector-data-offset
word-bytes
)
other-pointer-type
)))
;; Initialize the result.
(
inst
xor
result
result
)
;; Get the count. If it's zero, blow out.
(
inst
mov
rcx
length
)
(
inst
jecxz
done
)
; I'd probably change all jecxz to jrcxz
;; Convert it into count of the number of full words. If zero, then skip
;; to the part that handles the tail.
(
inst
shr
rcx
5
)
; 2 tag bits + 3
(
inst
jecxz
do-extra
)
;; Clear the direction flag, so we advance through memory.
(
inst
cld
)
LOOP
;; Merge each successive word with the result.
(
inst
lods
rax
)
; load 64-bits into rax and (+8 rsi)
(
inst
rol
result
5
)
(
inst
xor
result
rax
)
(
inst
loop
loop
)
DO-EXTRA
;; Now we have to take care of any bytes that don't make up a full word.
;; First, check to see how many of them there are. If zero, blow out of
;; here. Otherwise, multiply by 8.
(
inst
mov
rcx
length
)
(
inst
and
rcx
(
fixnumize
7
))
(
inst
jecxz
done
)
;; some bytes are left
(
inst
shl
rcx
1
)
;; Grab the last word.
(
inst
lods
rax
)
;; Convert the count into a mask. The count is multiplied by 8, so we just
;; shift -1 left, which shifts count*8 zeros into the low order end. We
;; then invert that, ending up with a mask of count*8 ones.
(
inst
mov
rsi
-1
)
(
inst
shl
rsi
:cl
)
(
inst
not
rsi
)
;; Use the mask to strip off the bits we arn't interested in, and merge
;; the remaining bits with the result.
(
inst
and
rax
rsi
)
(
inst
rol
result
5
)
(
inst
xor
result
rax
)
DONE
;; Force result to be a 32-bit positive fixnum because hash-vector is a
;; 32-bit vector. This hash function is not good. We need to use the
;; upper half of the word and change the hash-vector.
(
inst
and
result
#x7ffffffc
)
(
inst
ret
))
assembly/amd64/assem-rtns.lisp
0 → 100644
View file @
85b80477
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/amd64/assem-rtns.lisp,v 1.1 2004/05/21 22:46:43 cwang Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; This file contains the machine specific support routines needed by
;;; the file assembler.
;;;
;;; Written by William Lott
;;;
;;; Debugged by Paul F. Werkowski -- Spring/Summer 1995.
;;; Enhancements/debugging by Douglas T. Crosher 1997.
;;;
(
in-package
:amd64
)
;;;; Return-multiple
;;; For return-multiple, we have to move the results from the end of the
;;; frame for the function that is returning to the end of the frame for
;;; the function being returned to.
#+
assembler
;; we don't want a vop for this one.
(
define-assembly-routine
(
return-multiple
(
:return-style
:none
))
(
;; These four are really arguments.
(
:temp
rax
unsigned-reg
rax-offset
)
; the return-pc to finally jump to.
(
:temp
rbx
unsigned-reg
rbx-offset
)
; pointer to where to put the values.
(
:temp
rcx
unsigned-reg
rcx-offset
)
; number of values to find there.
(
:temp
rsi
unsigned-reg
rsi-offset
)
; pointer to where to find the values.
;; These we need as temporaries.
(
:temp
rdx
unsigned-reg
rdx-offset
)
(
:temp
rdi
unsigned-reg
rdi-offset
))
;; Pick off the cases where everything fits in register args.
(
inst
jecxz
zero-values
)
(
inst
cmp
rcx
(
fixnumize
1
))
(
inst
jmp
:e
one-value
)
(
inst
cmp
rcx
(
fixnumize
2
))
(
inst
jmp
:e
two-values
)
(
inst
cmp
rcx
(
fixnumize
3
))
(
inst
jmp
:e
three-values
)
;; Save the count, because the loop is going to destroy it.
(
inst
mov
rdx
rcx
)
;; Blit the values down the stack. Note: there might be overlap, so we have
;; to be careful not to clobber values before we've read them. Because the
;; stack builds down, we are copying to a larger address. Therefore, we need
;; to iterate from larger addresses to smaller addresses.
;; pfw-this says copy rcx words from rsi to rdi counting down.
(
inst
shr
rcx
2
)
; fixnum to raw word count
(
inst
std
)
; count down
(
inst
sub
rsi
8
)
; ?
(
inst
lea
rdi
(
make-ea
:qword
:base
rbx
:disp
(
-