[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2012-12-18-g02f4566
Raymond Toy
rtoy at common-lisp.net
Wed Dec 26 18:23:27 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via 02f4566a61fa5857150f69398e9a0a9af2652e7f (commit)
via c26b49e619c393dfddc156258fe24efd1bcafc1e (commit)
from 8b625663a224043fc416f4c0c5f92b6a7b9d7232 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 02f4566a61fa5857150f69398e9a0a9af2652e7f
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Wed Dec 26 10:23:17 2012 -0800
Add :alien-callback to *faatures* for platforms that support it.
bootfiles/20d/boot-2012-12-1.lisp::
Add :alien-callback to *features*
bin/build.sh::
Change bootstrap directory to 20d.
code/lispinit.lisp::
* Register :alien-callback feature if enabled.
* Heap overflow checking depends on gencgc, so register that only if
both are enabled.
tools/comcom.lisp::
Compile c-callback only if :alien-callback is a feature.
tools/worldcom.lisp:
Compile alien-callback onlf if :alien-callback is a feature.
diff --git a/bin/build.sh b/bin/build.sh
index 0ac13c8..f451ac1 100755
--- a/bin/build.sh
+++ b/bin/build.sh
@@ -39,7 +39,7 @@ ENABLE2="yes"
ENABLE3="yes"
ENABLE4="yes"
-version=20c
+version=20d
SRCDIR=src
BINDIR=bin
TOOLDIR=$BINDIR
diff --git a/src/bootfiles/20d/boot-2012-12-1.lisp b/src/bootfiles/20d/boot-2012-12-1.lisp
new file mode 100644
index 0000000..58dc316
--- /dev/null
+++ b/src/bootfiles/20d/boot-2012-12-1.lisp
@@ -0,0 +1,6 @@
+;; Add :alien-callback to *features* to build callback support for
+;; platforms that support alien callbacks.
+
+#+(or x86 sparc ppc)
+(pushnew :alien-callback *features*)
+
diff --git a/src/code/lispinit.lisp b/src/code/lispinit.lisp
index f5548b2..81a6e20 100644
--- a/src/code/lispinit.lisp
+++ b/src/code/lispinit.lisp
@@ -39,12 +39,16 @@
#+stack-checking
(sys:register-lisp-runtime-feature :stack-checking)
-#+heap-overflow-check
+;; Currently, heap-overflow-check depends on gencgc.
+#+(and heap-overflow-check gencgc)
(sys:register-lisp-runtime-feature :heap-overflow-check)
#+double-double
(sys:register-lisp-feature :double-double)
+#+alien-callback
+(sys:register-lisp-feature :alien-callback)
+
;;; Make the error system enable interrupts.
(defconstant most-positive-fixnum #.vm:target-most-positive-fixnum
diff --git a/src/tools/comcom.lisp b/src/tools/comcom.lisp
index 0953dc0..2205e11 100644
--- a/src/tools/comcom.lisp
+++ b/src/tools/comcom.lisp
@@ -197,7 +197,8 @@
(vmdir "target:compiler/sse2-c-call")
(vmdir "target:compiler/x87-c-call"))
:byte-compile *byte-compile*))
-(comf (vmdir "target:compiler/c-callback"))
+(when (c:target-featurep :alien-callback)
+ (comf (vmdir "target:compiler/c-callback")))
(comf (vmdir "target:compiler/cell"))
(comf (vmdir "target:compiler/values") :byte-compile *byte-compile*)
(comf (vmdir "target:compiler/alloc"))
diff --git a/src/tools/worldcom.lisp b/src/tools/worldcom.lisp
index 9a74818..f8ac65a 100644
--- a/src/tools/worldcom.lisp
+++ b/src/tools/worldcom.lisp
@@ -138,7 +138,8 @@
(setf (fdefinition 'lisp::%deftype) *original-%deftype*)
(comf "target:code/alieneval")
-(comf "target:code/alien-callback")
+(when (c:target-featurep :alien-callback)
+ (comf "target:code/alien-callback"))
(comf "target:code/c-call")
(comf "target:code/sap")
commit c26b49e619c393dfddc156258fe24efd1bcafc1e
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Mon Dec 24 08:46:02 2012 -0800
Clean up: move byte-bash-copy near bit-bash-copy, and remove debugging
prints.
diff --git a/src/code/bit-bash.lisp b/src/code/bit-bash.lisp
index 8f94a97..a9bb688 100644
--- a/src/code/bit-bash.lisp
+++ b/src/code/bit-bash.lisp
@@ -466,33 +466,13 @@
(32bit-logical-andc2 orig mask)))))))))))))))
(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))))
+;;;; DO-UNARY-BYTE-BASH
-(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)))
+;;;; Like DO-UNARY-BIT-BASH, but we only handle objects that are at
+;;;; least byte in size. The offsets and lengths are byte offsets and
+;;;; lengths, instead of bits.
+(declaim (inline do-unary-byte-bash))
(defun do-unary-byte-bash (src src-offset dst dst-offset length
dst-ref-fn dst-set-fn src-ref-fn)
(declare (type offset src-offset dst-offset length)
@@ -507,17 +487,14 @@
(type byte-offset src-byte-offset))
(cond
((<= (+ 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 do it in. But we might be reading from multiple words, so take
;; care.
(cond
((zerop length)
- #+nil(format t "case 1a: 0 length~%")
;; Actually, we aren't even writing one word. This is real easy.
)
((= length unit-bytes)
- #+nil(format t "case 1b~%")
;; dst-byte-offset must be equal to zero, or we would be writing
;; multiple words. If src-byte-offset is also zero, then we
;; just transfer the single word. Otherwise we have to extract bits
@@ -533,7 +510,6 @@
(funcall src-ref-fn src (1+ src-word-offset))
(* vm:byte-bits (- src-byte-offset)))))))
(t
- #+nil(format t "case 1c~%")
;; 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
;; one or two source words.
@@ -572,7 +548,6 @@
(32bit-logical-and value mask)
(32bit-logical-andc2 orig mask)))))))
((= 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
;; anything. But we have to pick the direction of the loop
;; in case the source and dst are really the same thing.
@@ -583,10 +558,8 @@
(declare (type word-offset interior))
(cond
((<= dst-offset src-offset)
- #+nil(format t " case 2a: L-R~%")
;; We need to loop from left to right
(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
;; bits we want to preserve.
(let ((mask (end-mask (- dst-byte-offset)))
@@ -605,7 +578,6 @@
(incf src-word-offset)
(incf dst-word-offset))
(unless (zerop final-bytes)
- #+nil(format t " case 2a2: final-bytes = ~D~%" final-bytes)
;; We are only writing part of the last word.
(let ((mask (start-mask (* vm:byte-bits final-bytes)))
(orig (funcall dst-ref-fn dst dst-word-offset))
@@ -616,12 +588,10 @@
(32bit-logical-and value mask)
(32bit-logical-andc2 orig mask))))))
(t
- #+nil(format t " case 2b: R-L~%")
;; We need to loop from right to left.
(incf dst-word-offset words)
(incf src-word-offset words)
(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)))
(orig (funcall dst-ref-fn dst dst-word-offset))
(value (funcall src-ref-fn src src-word-offset)))
@@ -636,7 +606,6 @@
(funcall dst-set-fn dst dst-word-offset
(funcall src-ref-fn src src-word-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 dst-word-offset)
(let ((mask (end-mask (* vm:byte-bits (- dst-byte-offset))))
@@ -648,7 +617,6 @@
(32bit-logical-and value mask)
(32bit-logical-andc2 orig mask))))))))))
(t
- #+nil(format t "case 3, unaligned~%")
;; They aren't aligned.
(multiple-value-bind (words final-bytes)
(floor (+ dst-byte-offset length) unit-bytes)
@@ -659,7 +627,6 @@
(type word-offset interior))
(cond
((<= dst-offset src-offset)
- #+nil(format t "case 3a: L-R~%")
;; We need to loop from left to right
(let ((prev 0)
(next (funcall src-ref-fn src src-word-offset)))
@@ -708,7 +675,6 @@
(32bit-logical-and value mask)
(32bit-logical-andc2 orig mask))))))))
(t
- #+nil(format t "case 3b: L-R~%")
;; We need to loop from right to left.
(incf dst-word-offset words)
(incf src-word-offset
@@ -759,6 +725,33 @@
(32bit-logical-andc2 orig mask)))))))))))))))
(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)
(declare (type offset src-offset dst-offset length))
(locally
-----------------------------------------------------------------------
Summary of changes:
bin/build.sh | 2 +-
src/bootfiles/20d/boot-2012-12-1.lisp | 6 +++
src/code/bit-bash.lisp | 71 +++++++++++++++------------------
src/code/lispinit.lisp | 6 ++-
src/tools/comcom.lisp | 3 +-
src/tools/worldcom.lisp | 3 +-
6 files changed, 48 insertions(+), 43 deletions(-)
create mode 100644 src/bootfiles/20d/boot-2012-12-1.lisp
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list