Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
824b7e1e
Commit
824b7e1e
authored
28 years ago
by
pw
Browse files
Options
Downloads
Patches
Plain Diff
initial post 1.3.7 merge
parent
5ced0fdf
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
compiler/x86/arith.lisp
+7
-5
7 additions, 5 deletions
compiler/x86/arith.lisp
compiler/x86/array.lisp
+175
-50
175 additions, 50 deletions
compiler/x86/array.lisp
with
182 additions
and
55 deletions
compiler/x86/arith.lisp
+
7
−
5
View file @
824b7e1e
...
@@ -7,7 +7,7 @@
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
;;;
(
ext:file-comment
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.
1
1997/0
1/18 14:31:24 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/arith.lisp,v 1.
2
1997/0
2/05 15:34:11 pw
Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -779,18 +779,20 @@
...
@@ -779,18 +779,20 @@
(
def-source-transform
32bit-logical-andc2
(
x
y
)
(
def-source-transform
32bit-logical-andc2
(
x
y
)
`
(
32bit-logical-and
,
x
(
32bit-logical-not
,
y
)))
`
(
32bit-logical-and
,
x
(
32bit-logical-not
,
y
)))
;;; Only the lower 5 bits of the shift amount are significant.
(
define-vop
(
shift-towards-someplace
)
(
define-vop
(
shift-towards-someplace
)
(
:policy
:fast-safe
)
(
:policy
:fast-safe
)
(
:args
(
num
:scs
(
unsigned-reg
)
:target
r
)
(
:args
(
num
:scs
(
unsigned-reg
)
:target
r
)
(
amount
:scs
(
unsigned-reg
signed-reg
)
:target
ecx
))
(
amount
:scs
(
signed-reg
)
:target
ecx
))
(
:arg-types
unsigned-num
positive-fix
num
)
(
:arg-types
unsigned-num
tagged-
num
)
(
:temporary
(
:sc
dword-reg
:offset
ecx-offset
:from
(
:argument
1
))
ecx
)
(
:temporary
(
:sc
dword-reg
:offset
ecx-offset
:from
(
:argument
1
))
ecx
)
(
:results
(
r
:scs
(
unsigned-reg
)))
(
:results
(
r
:scs
(
unsigned-reg
)
:from
(
:argument
0
)
))
(
:result-types
unsigned-num
))
(
:result-types
unsigned-num
))
(
define-vop
(
shift-towards-start
shift-towards-someplace
)
(
define-vop
(
shift-towards-start
shift-towards-someplace
)
(
:translate
shift-towards-start
)
(
:translate
shift-towards-start
)
(
:note
"SHIFT-TOWARDS-START"
)
(
:generator
1
(
:generator
1
(
move
r
num
)
(
move
r
num
)
(
move
ecx
amount
)
(
move
ecx
amount
)
...
@@ -798,12 +800,12 @@
...
@@ -798,12 +800,12 @@
(
define-vop
(
shift-towards-end
shift-towards-someplace
)
(
define-vop
(
shift-towards-end
shift-towards-someplace
)
(
:translate
shift-towards-end
)
(
:translate
shift-towards-end
)
(
:note
"SHIFT-TOWARDS-END"
)
(
:generator
1
(
:generator
1
(
move
r
num
)
(
move
r
num
)
(
move
ecx
amount
)
(
move
ecx
amount
)
(
inst
shl
r
:cl
)))
(
inst
shl
r
:cl
)))
;;;; Bignum stuff.
;;;; Bignum stuff.
...
...
This diff is collapsed.
Click to expand it.
compiler/x86/array.lisp
+
175
−
50
View file @
824b7e1e
...
@@ -7,7 +7,7 @@
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
;;;
(
ext:file-comment
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.
1
1997/0
1/18 14:31:24 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.
2
1997/0
2/05 15:34:13 pw
Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -16,6 +16,7 @@
...
@@ -16,6 +16,7 @@
;;; Written by William Lott
;;; Written by William Lott
;;;
;;;
;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
;;; Enhancements/debugging by Douglas T. Crosher 1996,1997.
;;;
;;;
(
in-package
:x86
)
(
in-package
:x86
)
...
@@ -296,6 +297,22 @@
...
@@ -296,6 +297,22 @@
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
vm:other-pointer-type
))))))
vm:other-pointer-type
))))))
(
define-vop
(
data-vector-ref-c/simple-array-single-float
)
(
:note
"inline array access"
)
(
:translate
data-vector-ref
)
(
:policy
:fast-safe
)
(
:args
(
object
:scs
(
descriptor-reg
)))
(
:info
index
)
(
:arg-types
simple-array-single-float
(
:constant
(
signed-byte
30
)))
(
:results
(
value
:scs
(
single-reg
)))
(
:result-types
single-float
)
(
:generator
4
(
with-empty-tn@fp-top
(
value
)
(
inst
fld
(
make-ea
:dword
:base
object
:disp
(
-
(
+
(
*
vm:vector-data-offset
vm:word-bytes
)
(
*
4
index
))
vm:other-pointer-type
))))))
(
define-vop
(
data-vector-set/simple-array-single-float
)
(
define-vop
(
data-vector-set/simple-array-single-float
)
(
:note
"inline array store"
)
(
:note
"inline array store"
)
(
:translate
data-vector-set
)
(
:translate
data-vector-set
)
...
@@ -307,29 +324,67 @@
...
@@ -307,29 +324,67 @@
(
:results
(
result
:scs
(
single-reg
)))
(
:results
(
result
:scs
(
single-reg
)))
(
:result-types
single-float
)
(
:result-types
single-float
)
(
:generator
5
(
:generator
5
(
if
(
zerop
(
tn-offset
value
))
(
cond
((
zerop
(
tn-offset
value
))
(
progn
;; Value is in ST0
;; Value is in ST0
(
inst
fst
(
make-ea
:dword
:base
object
:index
index
:scale
1
(
inst
fst
(
make-ea
:dword
:base
object
:index
index
:scale
1
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
vm:other-pointer-type
)))
vm:other-pointer-type
)))
(
unless
(
zerop
(
tn-offset
result
))
(
unless
(
zerop
(
tn-offset
result
))
;; Value is in ST0 but not result.
;; Value is in ST0 but not result.
(
inst
fst
result
)))
(
inst
fst
result
)))
(
t
(
progn
;; Value is not in ST0.
;; Value is not in ST0.
(
inst
fxch
value
)
(
inst
fxch
value
)
(
inst
fst
(
make-ea
:dword
:base
object
:index
index
:scale
1
(
inst
fst
(
make-ea
:dword
:base
object
:index
index
:scale
1
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
vm:other-pointer-type
)))
vm:other-pointer-type
)))
(
cond
((
zerop
(
tn-offset
result
))
(
if
(
zerop
(
tn-offset
result
))
;; The result is in ST0.
;; The result is in ST0.
(
inst
fst
value
))
(
inst
fst
value
)
(
t
(
progn
;; Neither value or result are in ST0
;; Neither value or result are in ST0
(
unless
(
location=
value
result
)
(
unless
(
location=
value
result
)
(
inst
fst
result
))
(
inst
fst
result
))
(
inst
fxch
value
)))))))
(
inst
fxch
value
)))))))
(
define-vop
(
data-vector-set-c/simple-array-single-float
)
(
:note
"inline array store"
)
(
:translate
data-vector-set
)
(
:policy
:fast-safe
)
(
:args
(
object
:scs
(
descriptor-reg
))
(
value
:scs
(
single-reg
)
:target
result
))
(
:info
index
)
(
:arg-types
simple-array-single-float
(
:constant
(
signed-byte
30
))
single-float
)
(
:results
(
result
:scs
(
single-reg
)))
(
:result-types
single-float
)
(
:generator
4
(
cond
((
zerop
(
tn-offset
value
))
;; Value is in ST0
(
inst
fst
(
make-ea
:dword
:base
object
:disp
(
-
(
+
(
*
vm:vector-data-offset
vm:word-bytes
)
(
*
4
index
))
vm:other-pointer-type
)))
(
unless
(
zerop
(
tn-offset
result
))
;; Value is in ST0 but not result.
(
inst
fst
result
)))
(
t
;; Value is not in ST0.
(
inst
fxch
value
)
(
inst
fst
(
make-ea
:dword
:base
object
:disp
(
-
(
+
(
*
vm:vector-data-offset
vm:word-bytes
)
(
*
4
index
))
vm:other-pointer-type
)))
(
cond
((
zerop
(
tn-offset
result
))
;; The result is in ST0.
(
inst
fst
value
))
(
t
;; Neither value or result are in ST0
(
unless
(
location=
value
result
)
(
inst
fst
result
))
(
inst
fxch
value
)))))))
(
define-vop
(
data-vector-ref/simple-array-double-float
)
(
define-vop
(
data-vector-ref/simple-array-double-float
)
(
:note
"inline array access"
)
(
:note
"inline array access"
)
...
@@ -346,6 +401,22 @@
...
@@ -346,6 +401,22 @@
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
vm:other-pointer-type
))))))
vm:other-pointer-type
))))))
(
define-vop
(
data-vector-ref-c/simple-array-double-float
)
(
:note
"inline array access"
)
(
:translate
data-vector-ref
)
(
:policy
:fast-safe
)
(
:args
(
object
:scs
(
descriptor-reg
)))
(
:info
index
)
(
:arg-types
simple-array-double-float
(
:constant
(
signed-byte
30
)))
(
:results
(
value
:scs
(
double-reg
)))
(
:result-types
double-float
)
(
:generator
6
(
with-empty-tn@fp-top
(
value
)
(
inst
fldd
(
make-ea
:dword
:base
object
:disp
(
-
(
+
(
*
vm:vector-data-offset
vm:word-bytes
)
(
*
8
index
))
vm:other-pointer-type
))))))
(
define-vop
(
data-vector-set/simple-array-double-float
)
(
define-vop
(
data-vector-set/simple-array-double-float
)
(
:note
"inline array store"
)
(
:note
"inline array store"
)
(
:translate
data-vector-set
)
(
:translate
data-vector-set
)
...
@@ -357,49 +428,102 @@
...
@@ -357,49 +428,102 @@
(
:results
(
result
:scs
(
double-reg
)))
(
:results
(
result
:scs
(
double-reg
)))
(
:result-types
double-float
)
(
:result-types
double-float
)
(
:generator
20
(
:generator
20
(
if
(
zerop
(
tn-offset
value
))
(
cond
((
zerop
(
tn-offset
value
))
(
progn
;; Value is in ST0
;; Value is in ST0
(
inst
fstd
(
make-ea
:dword
:base
object
:index
index
:scale
2
(
inst
fstd
(
make-ea
:dword
:base
object
:index
index
:scale
2
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
vm:other-pointer-type
)))
vm:other-pointer-type
)))
(
unless
(
zerop
(
tn-offset
result
))
(
unless
(
zerop
(
tn-offset
result
))
;; Value is in ST0 but not result.
;; Value is in ST0 but not result.
(
inst
fstd
result
)))
(
inst
fstd
result
)))
(
t
(
progn
;; Value is not in ST0.
;; Value is not in ST0.
(
inst
fxch
value
)
(
inst
fxch
value
)
(
inst
fstd
(
make-ea
:dword
:base
object
:index
index
:scale
2
(
inst
fstd
(
make-ea
:dword
:base
object
:index
index
:scale
2
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
:disp
(
-
(
*
vm:vector-data-offset
vm:word-bytes
)
vm:other-pointer-type
)))
vm:other-pointer-type
)))
(
cond
((
zerop
(
tn-offset
result
))
(
if
(
zerop
(
tn-offset
result
))
;; The result is in ST0.
;; The result is in ST0.
(
inst
fstd
value
))
(
inst
fstd
value
)
(
t
(
progn
;; Neither value or result are in ST0
;; Neither value or result are in ST0
(
unless
(
location=
value
result
)
(
unless
(
location=
value
result
)
(
inst
fstd
result
))
(
inst
fstd
result
))
(
inst
fxch
value
)))))))
(
inst
fxch
value
)))))))
(
define-vop
(
data-vector-set-c/simple-array-double-float
)
(
:note
"inline array store"
)
(
:translate
data-vector-set
)
(
:policy
:fast-safe
)
(
:args
(
object
:scs
(
descriptor-reg
))
(
value
:scs
(
double-reg
)
:target
result
))
(
:info
index
)
(
:arg-types
simple-array-double-float
(
:constant
(
signed-byte
30
))
double-float
)
(
:results
(
result
:scs
(
double-reg
)))
(
:result-types
double-float
)
(
:generator
19
(
cond
((
zerop
(
tn-offset
value
))
;; Value is in ST0
(
inst
fstd
(
make-ea
:dword
:base
object
:disp
(
-
(
+
(
*
vm:vector-data-offset
vm:word-bytes
)
(
*
8
index
))
vm:other-pointer-type
)))
(
unless
(
zerop
(
tn-offset
result
))
;; Value is in ST0 but not result.
(
inst
fstd
result
)))
(
t
;; Value is not in ST0.
(
inst
fxch
value
)
(
inst
fstd
(
make-ea
:dword
:base
object
:disp
(
-
(
+
(
*
vm:vector-data-offset
vm:word-bytes
)
(
*
8
index
))
vm:other-pointer-type
)))
(
cond
((
zerop
(
tn-offset
result
))
;; The result is in ST0.
(
inst
fstd
value
))
(
t
;; Neither value or result are in ST0
(
unless
(
location=
value
result
)
(
inst
fstd
result
))
(
inst
fxch
value
)))))))
;;; These VOPs are used for implementing float slots in structures (whose raw
;;; These VOPs are used for implementing float slots in structures (whose raw
;;; data is an unsigned-32 vector.
;;; data is an unsigned-32 vector.
;;; pfw-copied from hppa
;;;
(
define-vop
(
raw-ref-single
data-vector-ref/simple-array-single-float
)
(
define-vop
(
raw-ref-single
data-vector-ref/simple-array-single-float
)
(
:translate
%raw-ref-single
)
(
:translate
%raw-ref-single
)
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
))
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
))
(
define-vop
(
raw-ref-single-c
data-vector-ref-c/simple-array-single-float
)
(
:translate
%raw-ref-single
)
(
:arg-types
simple-array-unsigned-byte-32
(
:constant
(
signed-byte
30
))))
;;;
;;;
(
define-vop
(
raw-set-single
data-vector-set/simple-array-single-float
)
(
define-vop
(
raw-set-single
data-vector-set/simple-array-single-float
)
(
:translate
%raw-set-single
)
(
:translate
%raw-set-single
)
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
single-float
))
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
single-float
))
(
define-vop
(
raw-set-single-c
data-vector-set-c/simple-array-single-float
)
(
:translate
%raw-set-single
)
(
:arg-types
simple-array-unsigned-byte-32
(
:constant
(
signed-byte
30
))
single-float
))
;;;
;;;
(
define-vop
(
raw-ref-double
data-vector-ref/simple-array-double-float
)
(
define-vop
(
raw-ref-double
data-vector-ref/simple-array-double-float
)
(
:translate
%raw-ref-double
)
(
:translate
%raw-ref-double
)
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
))
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
))
(
define-vop
(
raw-ref-double-c
data-vector-ref-c/simple-array-double-float
)
(
:translate
%raw-ref-double
)
(
:arg-types
simple-array-unsigned-byte-32
(
:constant
(
signed-byte
30
))))
;;;
;;;
(
define-vop
(
raw-set-double
data-vector-set/simple-array-double-float
)
(
define-vop
(
raw-set-double
data-vector-set/simple-array-double-float
)
(
:translate
%raw-set-double
)
(
:translate
%raw-set-double
)
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
double-float
))
(
:arg-types
simple-array-unsigned-byte-32
positive-fixnum
double-float
))
(
define-vop
(
raw-set-double-c
data-vector-set-c/simple-array-double-float
)
(
:translate
%raw-set-double
)
(
:arg-types
simple-array-unsigned-byte-32
(
:constant
(
signed-byte
30
))
double-float
))
;;; These vops are useful for accessing the bits of a vector irrespective of
;;; These vops are useful for accessing the bits of a vector irrespective of
...
@@ -483,7 +607,8 @@
...
@@ -483,7 +607,8 @@
(
value
:scs
(
unsigned-reg
unsigned-stack
signed-reg
signed-stack
)
(
value
:scs
(
unsigned-reg
unsigned-stack
signed-reg
signed-stack
)
:target
eax
))
:target
eax
))
(
:info
index
)
(
:info
index
)
(
:arg-types
simple-array-unsigned-byte-8
(
:constant
(
signed-byte
30
))
positive-fixnum
)
(
:arg-types
simple-array-unsigned-byte-8
(
:constant
(
signed-byte
30
))
positive-fixnum
)
(
:temporary
(
:sc
dword-reg
:offset
eax-offset
:target
result
(
:temporary
(
:sc
dword-reg
:offset
eax-offset
:target
result
:from
(
:argument
1
)
:to
(
:result
0
))
:from
(
:argument
1
)
:to
(
:result
0
))
eax
)
eax
)
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment