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
5ced0fdf
Commit
5ced0fdf
authored
Jan 21, 1997
by
ram
Browse files
source kit 1.03.7
parent
c0c98ded
Changes
39
Expand all
Hide whitespace changes
Inline
Side-by-side
assembly/x86/alloc.lisp
0 → 100644
View file @
5ced0fdf
;;; -*- 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/x86/alloc.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; Stuff to handle allocating simple objects.
;;;
;;; Written by William Lott.
;;;
;;; Debugged by Paul F. Werkowski -- Spring 1995.
;;;
(
in-package
:x86
)
;;;; From from signed/unsigned
#+
assembler
; we don't want a vop for this one.
(
define-assembly-routine
(
move-from-signed
)
((
:temp
eax
dword-reg
eax-offset
)
(
:temp
ebx
dword-reg
ebx-offset
)
(
:temp
ecx
dword-reg
ecx-offset
))
(
inst
mov
ebx
eax
)
(
inst
shl
ebx
1
)
(
inst
jmp
:o
bignum
)
(
inst
shl
ebx
1
)
(
inst
jmp
:o
bignum
)
(
inst
ret
)
BIGNUM
(
with-fixed-allocation
(
ebx
ecx
bignum-type
(
+
bignum-digits-offset
1
))
(
storew
eax
ebx
bignum-digits-offset
other-pointer-type
))
(
inst
ret
))
#+
assembler
; we don't want a vop for this one either.
(
define-assembly-routine
(
move-from-unsigned
)
((
:temp
eax
dword-reg
eax-offset
)
(
:temp
ebx
dword-reg
ebx-offset
)
(
:temp
ecx
dword-reg
ecx-offset
))
(
inst
test
eax
#xe0000000
)
(
inst
jmp
:nz
bignum
)
;; Fixnum
(
inst
mov
ebx
eax
)
(
inst
shl
ebx
2
)
(
inst
ret
)
BIGNUM
(
inst
jmp
:ns
one-word-bignum
)
(
inst
mov
ebx
eax
)
;; Two word bignum
(
with-fixed-allocation
(
ebx
ecx
bignum-type
(
+
bignum-digits-offset
2
))
(
storew
eax
ebx
bignum-digits-offset
other-pointer-type
))
(
inst
ret
)
ONE-WORD-BIGNUM
(
with-fixed-allocation
(
ebx
ecx
bignum-type
(
+
bignum-digits-offset
1
))
(
storew
eax
ebx
bignum-digits-offset
other-pointer-type
))
(
inst
ret
))
assembly/x86/arith.lisp
0 → 100644
View file @
5ced0fdf
;;; -*- 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/x86/arith.lisp,v 1.1 1997/01/21 00:30:28 ram Exp $"
)
;;;
;;; **********************************************************************
;;;
;;; Stuff to handle simple cases for generic arithmetic.
;;;
;;; Written by William Lott.
;;; Debugged by Paul Werkowski -- Spring/Summer 1995.
;;;
(
in-package
:x86
)
(
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
)
edx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
;; this seems wrong esi-offset
edi-offset
)
(
:res
res
(
descriptor-reg
any-reg
)
edx-offset
)
(
:temp
eax
dword-reg
eax-offset
)
(
:temp
ebx
dword-reg
ebx-offset
)
(
:temp
ecx
dword-reg
ecx-offset
))
;; for now, pass this off
;; (inst jmp DO-STATIC-FUN)
;; ebx ; ignorable
(
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
eax
)
(
inst
push
ebp-tn
)
(
inst
lea
ebp-tn
(
make-ea
:dword
:base
esp-tn
:disp
word-bytes
))
(
inst
sub
esp-tn
(
fixnum
3
))
; pw -- was 2
(
inst
push
eax
)
; callers return addr
(
inst
mov
ecx
(
fixnum
2
))
; arg count
(
inst
mov
ebx
(
make-ea
:dword
:disp
(
+
nil-value
(
static-function-offset
',
(
symbolicate
"TWO-ARG-"
fun
)))))
(
inst
jmp
ebx
)
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
ecx
res
)
(
with-fixed-allocation
(
res
ebx
bignum-type
(
1+
bignum-digits-offset
))
(
storew
ecx
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
)
(
move
res
x
)
(
inst
sub
res
y
)
(
inst
jmp
:no
OKAY
)
(
inst
rcr
res
1
)
(
inst
sar
res
1
)
; remove type bits
(
move
ecx
res
)
(
with-fixed-allocation
(
res
ebx
bignum-type
(
1+
bignum-digits-offset
))
(
storew
ecx
res
bignum-digits-offset
other-pointer-type
))
OKAY
)
(
define-generic-arith-routine
(
*
30
)
(
move
eax
x
)
; must use eax for 64-bit result
(
inst
sar
eax
2
)
; remove *4 fixnum bias
(
inst
imul
y
)
; result in edx:eax
(
inst
jmp
:no
okay
)
; still fixnum
;; zzz jrd changed edx to ebx in here, as edx isn't listed as a temp, above
;; pfw says that loses big -- edx is target for arg x and result res
;; note that 'edx' is not defined -- using x
(
inst
shrd
eax
x
2
)
; high bits from edx
(
inst
sar
x
2
)
; now shift edx too
(
move
ecx
x
)
; save high bits from cdq
(
inst
cdq
)
; edx:eax <- sign-extend of eax
(
inst
cmp
x
ecx
)
(
inst
jmp
:e
SINGLE-WORD-BIGNUM
)
(
with-fixed-allocation
(
res
ebx
bignum-type
(
+
bignum-digits-offset
2
))
(
storew
eax
res
bignum-digits-offset
other-pointer-type
)
(
storew
ecx
res
(
1+
bignum-digits-offset
)
other-pointer-type
))
(
inst
jmp
DONE
)
SINGLE-WORD-BIGNUM
(
with-fixed-allocation
(
res
ebx
bignum-type
(
1+
bignum-digits-offset
))
(
storew
eax
res
bignum-digits-offset
other-pointer-type
))
(
inst
jmp
DONE
)
OKAY
(
move
res
eax
)
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
)
edx-offset
)
(
:res
res
(
descriptor-reg
any-reg
)
edx-offset
)
(
:temp
eax
dword-reg
eax-offset
)
(
:temp
ecx
dword-reg
ecx-offset
))
(
inst
test
x
3
)
(
inst
jmp
:z
FIXNUM
)
(
inst
pop
eax
)
(
inst
push
ebp-tn
)
(
inst
lea
ebp-tn
(
make-ea
:dword
:base
esp-tn
:disp
word-bytes
))
(
inst
sub
esp-tn
(
fixnum
3
))
; pw -- was 2
(
inst
push
eax
)
(
inst
mov
ecx
(
fixnum
1
))
; arg count
(
inst
mov
eax
(
make-ea
:dword
:disp
(
+
nil-value
(
static-function-offset
'%negate
))))
(
inst
jmp
eax
)
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
ecx
res
)
(
with-fixed-allocation
(
res
eax
bignum-type
(
1+
bignum-digits-offset
))
(
storew
ecx
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
)
edx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
#+
nil
esi-offset
edi-offset
)
(
:res
res
descriptor-reg
edx-offset
)
(
:temp
eax
dword-reg
eax-offset
)
(
:temp
ecx
dword-reg
ecx-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
eax
)
(
inst
push
ebp-tn
)
(
inst
lea
ebp-tn
(
make-ea
:dword
:base
esp-tn
:disp
word-bytes
))
(
inst
sub
esp-tn
(
fixnum
3
))
; pw -- was 2
(
inst
push
eax
)
(
inst
mov
ecx
(
fixnum
2
))
(
inst
mov
eax
(
make-ea
:dword
:disp
(
+
nil-value
(
static-function-offset
',static-fn
))))
(
inst
jmp
eax
)
DO-COMPARE
(
inst
cmp
x
y
)
(
inst
jmp
,
test
TRUE
)
(
inst
mov
res
nil-value
)
(
inst
pop
eax
)
(
inst
add
eax
2
)
(
inst
jmp
eax
)
TRUE
(
inst
mov
res
t-value
)))
)
; eval-when
(
define-cond-assem-rtn
generic-<
<
two-arg-<
:l
)
(
define-cond-assem-rtn
generic->
>
two-arg->
:g
)
#+
pfw-obsolete????
(
define-assembly-routine
(
generic-eql
(
:cost
10
)
(
:return-style
:full-call
)
(
:policy
:safe
)
(
:translate
eql
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
edx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
esi-offset
)
(
:res
res
descriptor-reg
edx-offset
)
(
:temp
eax
dword-reg
eax-offset
)
; zzz added by jrd
(
:temp
ecx
dword-reg
ecx-offset
)
; zzz added by jrd
)
(
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
eax
)
(
inst
add
eax
2
)
(
inst
jmp
eax
)
DO-STATIC-FN
(
inst
pop
eax
)
(
inst
push
ebp-tn
)
(
inst
lea
ebp-tn
(
make-ea
:dword
:base
esp-tn
:disp
word-bytes
))
(
inst
sub
esp-tn
(
fixnum
3
))
; pw -- was 2
(
inst
push
eax
)
(
inst
mov
ecx
(
fixnum
2
))
(
inst
mov
eax
(
make-ea
:dword
:disp
(
+
nil-value
(
static-function-offset
'two-arg-eql
))))
(
inst
jmp
eax
)
RETURN-T
(
inst
mov
res
t-value
))
(
define-assembly-routine
(
generic-=
(
:cost
10
)
(
:return-style
:full-call
)
(
:policy
:safe
)
(
:translate
=
)
(
:save-p
t
))
((
:arg
x
(
descriptor-reg
any-reg
)
edx-offset
)
(
:arg
y
(
descriptor-reg
any-reg
)
#+
nil
esi-offset
edi-offset
)
(
:res
res
descriptor-reg
edx-offset
)
(
:temp
eax
dword-reg
eax-offset
)
(
:temp
ecx
dword-reg
ecx-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
eax
)
(
inst
add
eax
2
)
(
inst
jmp
eax
)
DO-STATIC-FN
(
inst
pop
eax
)
(
inst
push
ebp-tn
)
(
inst
lea
ebp-tn
(
make-ea
:dword
:base
esp-tn
:disp
word-bytes
))
(
inst
sub
esp-tn
(
fixnum
3
))
; pw -- was 2
(
inst
push
eax
)
(
inst
mov
ecx
(
fixnum
2
))
(
inst
mov
eax
(
make-ea
:dword
:disp
(
+
nil-value
(
static-function-offset
'two-arg-=
))))
(
inst
jmp
eax
)
RETURN-T
(
load-symbol
res
t
))
assembly/x86/array.lisp
0 → 100644
View file @
5ced0fdf
;;; -*- 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/x86/array.lisp,v 1.1 1997/01/21 00:30:28 ram 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
:x86
)
;;;; Allocation
(
define-assembly-routine
(
allocate-vector
(
:policy
:fast-safe
)
(
:translate
allocate-vector
)
(
:arg-types
positive-fixnum
positive-fixnum
positive-fixnum
))
((
:arg
type
unsigned-reg
eax-offset
)
(
:arg
length
any-reg
ebx-offset
)
(
:arg
words
any-reg
ecx-offset
)
(
:res
result
descriptor-reg
edx-offset
)
(
:temp
alloc
dword-reg
edi-offset
))
#-
cgc
(
with-allocation
(
alloc
)
(
inst
lea
result
(
make-ea
:byte
:base
alloc
:disp
other-pointer-type
))
(
inst
add
alloc
(
+
(
1-
(
ash
1
lowtag-bits
))
(
*
vector-data-offset
word-bytes
)))
(
inst
add
alloc
words
)
(
inst
and
alloc
(
lognot
vm:lowtag-mask
)))
#+
cgc
(
progn
(
inst
mov
alloc
(
+
(
1-
(
ash
1
lowtag-bits
))
(
*
vector-data-offset
word-bytes
)))
(
inst
add
alloc
words
)
(
inst
and
alloc
(
lognot
vm:lowtag-mask
))
(
with-cgc-allocation
(
alloc
alloc
)
(
inst
lea
result
(
make-ea
:byte
:base
alloc
: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
ebx-offset
)
(
:res
result
any-reg
edx-offset
)
(
:temp
length
any-reg
edi-offset
)
(
:temp
esi
dword-reg
esi-offset
)
(
:temp
ecx
dword-reg
ecx-offset
)
(
:temp
eax
dword-reg
eax-offset
))
(
declare
(
ignore
result
esi
ecx
eax
))
(
loadw
length
string
vector-length-slot
other-pointer-type
)
;; zzzzz this appears to be busted
;; (inst jmp nil (make-fixup 'sxhash-simple-substring :assembly-routine))
;; just fall through???
)
(
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
ebx-offset
)
(
:arg
length
any-reg
edi-offset
)
(
:res
result
any-reg
edx-offset
)
(
:temp
esi
dword-reg
esi-offset
)
(
:temp
ecx
dword-reg
ecx-offset
)
(
:temp
eax
dword-reg
eax-offset
))
;; Compute a pointer to where we are going to be extracting the bits.
(
inst
lea
esi
(
make-ea
:byte
:base
string
:disp
(
-
(
*
vector-data-offset
word-bytes
)
other-pointer-type
)))
;; Initialize the result.
(
inst
mov
result
0
)
;; Get the count. If it's zero, blow out.
(
inst
mov
ecx
length
)
(
inst
jecxz
done
)
;; Convert it into count of the number of full words. If zero, then skip
;; to the part that handles the tail.
(
inst
shr
ecx
4
)
(
inst
jecxz
do-extra
)
;; Clear the direction flag, so we advance through memory.
(
inst
cld
)
LOOP
;; Merge each successive word with the result.
;; ZZZZZ undef inst???
(
inst
lods
eax
)
; load 32-bits into eax and (+4 esi)
(
inst
rol
result
5
)
(
inst
xor
result
eax
)
(
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
ecx
length
)
(
inst
and
ecx
(
fixnum
3
))
(
inst
jecxz
done
)
(
inst
shl
ecx
1
)
;; Grab the last word.
;; ZZZZZ undef isnt?
(
inst
lods
eax
)
;; 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
esi
-1
)
(
inst
shl
esi
:cl
)
(
inst
not
esi
)
;; Use the mask to strip off the bits we arn't interested in, and merge
;; the remaining bits with the result.
(
inst
and
eax
esi
)
(
inst
rol
result
5
)
(
inst
xor
result
eax
)
DONE
;; Force result to be a positive fixnum.
(
inst
and
result
#x7ffffffc
)
(
inst
ret
))
assembly/x86/assem-rtns.lisp
0 → 100644
View file @
5ced0fdf
;;; -*- 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/x86/assem-rtns.lisp,v 1.1 1997/01/21 00:30:28 ram 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.
;;;
(
in-package
:x86
)
;;;; 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
eax
dword-reg
eax-offset
)
(
:temp
ebx
dword-reg
ebx-offset
)
(
:temp
ecx
dword-reg
ecx-offset
)
(
:temp
esi
dword-reg
esi-offset
)
;; These we need as temporaries.
(
:temp
edx
dword-reg
edx-offset
)
(
:temp
edi
dword-reg
edi-offset
))
;; Pick off the cases where everything fits in register args.
(
inst
jecxz
zero-values
)
(
inst
cmp
ecx
(
fixnum
1
))
(
inst
jmp
:e
one-value
)
(
inst
cmp
ecx
(
fixnum
2
))
(
inst
jmp
:e
two-values
)
(
inst
cmp
ecx
(
fixnum
3
))
(
inst
jmp
:e
three-values
)
;; Save the count, because the loop is going to destroy it.
(
inst
mov
edx
ecx
)
;; 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 coping to a larger address. Therefore, we need
;; to iterate from larger addresses to smaller addresses.
;; pfw-this says copy ecx words from esi to edi counting down.
(
inst
shr
ecx
2
)
; fixnum to raw word count
(
inst
std
)
; count down
(
inst
sub
esi
4
)
; ?
(
inst
lea
edi
(
make-ea
:dword
:base
ebx
:disp
(
-
word-bytes
)))
(
inst
rep
)
(
inst
movs
:dword
)
;; Restore the count.
(
inst
mov
ecx
edx
)
;; Set the stack top to the last result.
(
inst
lea
esp-tn
(
make-ea
:dword
:base
edi
:disp
word-bytes
))
;; Load the register args.
(
loadw
edx
ebx
-1
)
(
loadw
edi
ebx
-2
)
(
loadw
esi
ebx
-3
)
;; And back we go.
(
inst
jmp
eax
)