Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl-copy
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
Richard M Kreuter
cmucl-copy
Commits
c26b49e6
Commit
c26b49e6
authored
12 years ago
by
Raymond Toy
Browse files
Options
Downloads
Patches
Plain Diff
Clean up: move byte-bash-copy near bit-bash-copy, and remove debugging
prints.
parent
8b625663
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/code/bit-bash.lisp
+32
-39
32 additions, 39 deletions
src/code/bit-bash.lisp
with
32 additions
and
39 deletions
src/code/bit-bash.lisp
+
32
−
39
View file @
c26b49e6
...
@@ -466,33 +466,13 @@
...
@@ -466,33 +466,13 @@
(
32bit-logical-andc2
orig
mask
)))))))))))))))
(
32bit-logical-andc2
orig
mask
)))))))))))))))
(
undefined-value
))
(
undefined-value
))
;;;; DO-UNARY-BYTE-BASH
;;;; The actual bashers.
(
defun
bit-bash-fill
(
value
dst
dst-offset
length
)
(
declare
(
type
unit
value
)
(
type
offset
dst-offset
length
))
(
locally
(
declare
(
optimize
(
speed
3
)
(
safety
0
)))
(
do-constant-bit-bash
dst
dst-offset
length
value
#'
%raw-bits
#'
%set-raw-bits
)))
(
defun
system-area-fill
(
value
dst
dst-offset
length
)
(
declare
(
type
unit
value
)
(
type
offset
dst-offset
length
))
(
locally
(
declare
(
optimize
(
speed
3
)
(
safety
0
)))
(
multiple-value-bind
(
dst
dst-offset
)
(
fix-sap-and-offset
dst
dst-offset
)
(
do-constant-bit-bash
dst
dst-offset
length
value
#'
word-sap-ref
#'
%set-word-sap-ref
))))
(
defun
bit-bash-copy
(
src
src-offset
dst
dst-offset
length
)
;;;; Like DO-UNARY-BIT-BASH, but we only handle objects that are at
(
declare
(
type
offset
src-offset
dst-offset
length
))
;;;; least byte in size. The offsets and lengths are byte offsets and
(
locally
;;;; lengths, instead of bits.
(
declare
(
optimize
(
speed
3
)
(
safety
0
))
(
inline
do-unary-bit-bash
))
(
do-unary-bit-bash
src
src-offset
dst
dst-offset
length
#'
%raw-bits
#'
%set-raw-bits
#'
%raw-bits
)))
(
declaim
(
inline
do-unary-byte-bash
))
(
defun
do-unary-byte-bash
(
src
src-offset
dst
dst-offset
length
(
defun
do-unary-byte-bash
(
src
src-offset
dst
dst-offset
length
dst-ref-fn
dst-set-fn
src-ref-fn
)
dst-ref-fn
dst-set-fn
src-ref-fn
)
(
declare
(
type
offset
src-offset
dst-offset
length
)
(
declare
(
type
offset
src-offset
dst-offset
length
)
...
@@ -507,17 +487,14 @@
...
@@ -507,17 +487,14 @@
(
type
byte-offset
src-byte-offset
))
(
type
byte-offset
src-byte-offset
))
(
cond
(
cond
((
<=
(
+
dst-byte-offset
length
)
unit-bytes
)
((
<=
(
+
dst-byte-offset
length
)
unit-bytes
)
#+
nil
(
format
t
"case 1, one word~%"
)
;; We are only writing one word, so it doesn't matter what order
;; We are only writing one word, so it doesn't matter what order
;; we do it in. But we might be reading from multiple words, so take
;; we do it in. But we might be reading from multiple words, so take
;; care.
;; care.
(
cond
(
cond
((
zerop
length
)
((
zerop
length
)
#+
nil
(
format
t
"case 1a: 0 length~%"
)
;; Actually, we aren't even writing one word. This is real easy.
;; Actually, we aren't even writing one word. This is real easy.
)
)
((
=
length
unit-bytes
)
((
=
length
unit-bytes
)
#+
nil
(
format
t
"case 1b~%"
)
;; dst-byte-offset must be equal to zero, or we would be writing
;; dst-byte-offset must be equal to zero, or we would be writing
;; multiple words. If src-byte-offset is also zero, then we
;; multiple words. If src-byte-offset is also zero, then we
;; just transfer the single word. Otherwise we have to extract bits
;; just transfer the single word. Otherwise we have to extract bits
...
@@ -533,7 +510,6 @@
...
@@ -533,7 +510,6 @@
(
funcall
src-ref-fn
src
(
1+
src-word-offset
))
(
funcall
src-ref-fn
src
(
1+
src-word-offset
))
(
*
vm:byte-bits
(
-
src-byte-offset
)))))))
(
*
vm:byte-bits
(
-
src-byte-offset
)))))))
(
t
(
t
#+
nil
(
format
t
"case 1c~%"
)
;; We are only writing some portion of the dst word, so we need to
;; We are only writing some portion of the dst word, so we need to
;; preserve the extra bits. Also, we still don't know if we need
;; preserve the extra bits. Also, we still don't know if we need
;; one or two source words.
;; one or two source words.
...
@@ -572,7 +548,6 @@
...
@@ -572,7 +548,6 @@
(
32bit-logical-and
value
mask
)
(
32bit-logical-and
value
mask
)
(
32bit-logical-andc2
orig
mask
)))))))
(
32bit-logical-andc2
orig
mask
)))))))
((
=
src-byte-offset
dst-byte-offset
)
((
=
src-byte-offset
dst-byte-offset
)
#+
nil
(
format
t
"case 2, aligned~%"
)
;; The source and dst are aligned, so we don't need to shift
;; The source and dst are aligned, so we don't need to shift
;; anything. But we have to pick the direction of the loop
;; anything. But we have to pick the direction of the loop
;; in case the source and dst are really the same thing.
;; in case the source and dst are really the same thing.
...
@@ -583,10 +558,8 @@
...
@@ -583,10 +558,8 @@
(
declare
(
type
word-offset
interior
))
(
declare
(
type
word-offset
interior
))
(
cond
(
cond
((
<=
dst-offset
src-offset
)
((
<=
dst-offset
src-offset
)
#+
nil
(
format
t
" case 2a: L-R~%"
)
;; We need to loop from left to right
;; We need to loop from left to right
(
unless
(
zerop
dst-byte-offset
)
(
unless
(
zerop
dst-byte-offset
)
#+
nil
(
format
t
" case 2a1: dst-byte-offset = ~D~%"
dst-byte-offset
)
;; We are only writing part of the first word, so mask off the
;; We are only writing part of the first word, so mask off the
;; bits we want to preserve.
;; bits we want to preserve.
(
let
((
mask
(
end-mask
(
-
dst-byte-offset
)))
(
let
((
mask
(
end-mask
(
-
dst-byte-offset
)))
...
@@ -605,7 +578,6 @@
...
@@ -605,7 +578,6 @@
(
incf
src-word-offset
)
(
incf
src-word-offset
)
(
incf
dst-word-offset
))
(
incf
dst-word-offset
))
(
unless
(
zerop
final-bytes
)
(
unless
(
zerop
final-bytes
)
#+
nil
(
format
t
" case 2a2: final-bytes = ~D~%"
final-bytes
)
;; We are only writing part of the last word.
;; We are only writing part of the last word.
(
let
((
mask
(
start-mask
(
*
vm:byte-bits
final-bytes
)))
(
let
((
mask
(
start-mask
(
*
vm:byte-bits
final-bytes
)))
(
orig
(
funcall
dst-ref-fn
dst
dst-word-offset
))
(
orig
(
funcall
dst-ref-fn
dst
dst-word-offset
))
...
@@ -616,12 +588,10 @@
...
@@ -616,12 +588,10 @@
(
32bit-logical-and
value
mask
)
(
32bit-logical-and
value
mask
)
(
32bit-logical-andc2
orig
mask
))))))
(
32bit-logical-andc2
orig
mask
))))))
(
t
(
t
#+
nil
(
format
t
" case 2b: R-L~%"
)
;; We need to loop from right to left.
;; We need to loop from right to left.
(
incf
dst-word-offset
words
)
(
incf
dst-word-offset
words
)
(
incf
src-word-offset
words
)
(
incf
src-word-offset
words
)
(
unless
(
zerop
final-bytes
)
(
unless
(
zerop
final-bytes
)
#+
nil
(
format
t
" case 2b1: R-L final-bytes = ~D~%"
final-bytes
)
(
let
((
mask
(
start-mask
(
*
vm:byte-bits
final-bytes
)))
(
let
((
mask
(
start-mask
(
*
vm:byte-bits
final-bytes
)))
(
orig
(
funcall
dst-ref-fn
dst
dst-word-offset
))
(
orig
(
funcall
dst-ref-fn
dst
dst-word-offset
))
(
value
(
funcall
src-ref-fn
src
src-word-offset
)))
(
value
(
funcall
src-ref-fn
src
src-word-offset
)))
...
@@ -636,7 +606,6 @@
...
@@ -636,7 +606,6 @@
(
funcall
dst-set-fn
dst
dst-word-offset
(
funcall
dst-set-fn
dst
dst-word-offset
(
funcall
src-ref-fn
src
src-word-offset
)))
(
funcall
src-ref-fn
src
src-word-offset
)))
(
unless
(
zerop
dst-byte-offset
)
(
unless
(
zerop
dst-byte-offset
)
#+
nil
(
format
t
" case 2b2: R-L dst-byte-offset = ~D~%"
dst-byte-offset
)
(
decf
src-word-offset
)
(
decf
src-word-offset
)
(
decf
dst-word-offset
)
(
decf
dst-word-offset
)
(
let
((
mask
(
end-mask
(
*
vm:byte-bits
(
-
dst-byte-offset
))))
(
let
((
mask
(
end-mask
(
*
vm:byte-bits
(
-
dst-byte-offset
))))
...
@@ -648,7 +617,6 @@
...
@@ -648,7 +617,6 @@
(
32bit-logical-and
value
mask
)
(
32bit-logical-and
value
mask
)
(
32bit-logical-andc2
orig
mask
))))))))))
(
32bit-logical-andc2
orig
mask
))))))))))
(
t
(
t
#+
nil
(
format
t
"case 3, unaligned~%"
)
;; They aren't aligned.
;; They aren't aligned.
(
multiple-value-bind
(
words
final-bytes
)
(
multiple-value-bind
(
words
final-bytes
)
(
floor
(
+
dst-byte-offset
length
)
unit-bytes
)
(
floor
(
+
dst-byte-offset
length
)
unit-bytes
)
...
@@ -659,7 +627,6 @@
...
@@ -659,7 +627,6 @@
(
type
word-offset
interior
))
(
type
word-offset
interior
))
(
cond
(
cond
((
<=
dst-offset
src-offset
)
((
<=
dst-offset
src-offset
)
#+
nil
(
format
t
"case 3a: L-R~%"
)
;; We need to loop from left to right
;; We need to loop from left to right
(
let
((
prev
0
)
(
let
((
prev
0
)
(
next
(
funcall
src-ref-fn
src
src-word-offset
)))
(
next
(
funcall
src-ref-fn
src
src-word-offset
)))
...
@@ -708,7 +675,6 @@
...
@@ -708,7 +675,6 @@
(
32bit-logical-and
value
mask
)
(
32bit-logical-and
value
mask
)
(
32bit-logical-andc2
orig
mask
))))))))
(
32bit-logical-andc2
orig
mask
))))))))
(
t
(
t
#+
nil
(
format
t
"case 3b: L-R~%"
)
;; We need to loop from right to left.
;; We need to loop from right to left.
(
incf
dst-word-offset
words
)
(
incf
dst-word-offset
words
)
(
incf
src-word-offset
(
incf
src-word-offset
...
@@ -759,6 +725,33 @@
...
@@ -759,6 +725,33 @@
(
32bit-logical-andc2
orig
mask
)))))))))))))))
(
32bit-logical-andc2
orig
mask
)))))))))))))))
(
undefined-value
))
(
undefined-value
))
;;;; The actual bashers.
(
defun
bit-bash-fill
(
value
dst
dst-offset
length
)
(
declare
(
type
unit
value
)
(
type
offset
dst-offset
length
))
(
locally
(
declare
(
optimize
(
speed
3
)
(
safety
0
)))
(
do-constant-bit-bash
dst
dst-offset
length
value
#'
%raw-bits
#'
%set-raw-bits
)))
(
defun
system-area-fill
(
value
dst
dst-offset
length
)
(
declare
(
type
unit
value
)
(
type
offset
dst-offset
length
))
(
locally
(
declare
(
optimize
(
speed
3
)
(
safety
0
)))
(
multiple-value-bind
(
dst
dst-offset
)
(
fix-sap-and-offset
dst
dst-offset
)
(
do-constant-bit-bash
dst
dst-offset
length
value
#'
word-sap-ref
#'
%set-word-sap-ref
))))
(
defun
bit-bash-copy
(
src
src-offset
dst
dst-offset
length
)
(
declare
(
type
offset
src-offset
dst-offset
length
))
(
locally
(
declare
(
optimize
(
speed
3
)
(
safety
0
))
(
inline
do-unary-bit-bash
))
(
do-unary-bit-bash
src
src-offset
dst
dst-offset
length
#'
%raw-bits
#'
%set-raw-bits
#'
%raw-bits
)))
(
defun
byte-bash-copy
(
src
src-offset
dst
dst-offset
length
)
(
defun
byte-bash-copy
(
src
src-offset
dst
dst-offset
length
)
(
declare
(
type
offset
src-offset
dst-offset
length
))
(
declare
(
type
offset
src-offset
dst-offset
length
))
(
locally
(
locally
...
...
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