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@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@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
-
Raymond Toy