From: William Harold Newman Date: Thu, 10 Oct 2002 16:55:05 +0000 (+0000) Subject: 0.7.7.24: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=b062a0cffdc3e1706a67c487d2bc5e406c104893;p=sbcl.git 0.7.7.24: READ-VAR-INTEGER and READ-PACKED-BIT-VECTOR are external to SB!C, so don't need double colons in SB!C: prefixes. made (FORMAT "foo" "bar") fail earlier, at FILL-POINTER-OUTPUT-STREAM ctor time, instead of when the FILL-POINTER-OUTPUT-STREAM is first used for output got rid of *TOPLEVEL-LAMBDA-MAX* and *PENDING-TOPLEVEL-LAMBDAS* (and FORCE-P arg to SUB-COMPILE-TOPLEVEL-LAMBDAS and COMPILE-TOPLEVEL-LAMBDAS, and TOPLEVEL-CLOSURE in COMPILE-TOPLEVEL, and various now-redundant FORCE-P-only calls to COMPILE-TOPLEVEL-LAMBDAS) --- diff --git a/TODO b/TODO index 7de2072..1d77f65 100644 --- a/TODO +++ b/TODO @@ -65,9 +65,6 @@ for early 0.7.x: * Either get rid of or at least rework the fdefinition/encapsulation system so that (SYMBOL-FUNCTION 'FOO) is identically equal to (FDEFINITION 'FOO). -* building using CLISP (since building under OpenMCL works, this is - reduced to "it would be nice" rather than "as proof of concept") - ======================================================================= for 0.9: diff --git a/doc/sbcl.1 b/doc/sbcl.1 index 942f0f8..5ccfe15 100644 --- a/doc/sbcl.1 +++ b/doc/sbcl.1 @@ -522,8 +522,8 @@ executable program containing some low-level runtime support and a loader, used to read sbcl.core .TP .I sbcl.core -dumped memory image containing most of SBCL, to be loaded by the -'sbcl' executable +dumped memory image containing most of SBCL, to be loaded by +the 'sbcl' executable .TP .I sbclrc optional system-wide startup script (in an etc-ish system diff --git a/make-host-2.sh b/make-host-2.sh index 637914a..5d0fdf1 100644 --- a/make-host-2.sh +++ b/make-host-2.sh @@ -76,8 +76,6 @@ $SBCL_XC_HOST <<-'EOF' || exit 1 ;; redefine our functions anyway; and developers can ;; fend for themselves.) #!-sb-fluid (sb!ext:*derive-function-types* t) - ;; FIXME: *TOPLEVEL-LAMBDA-MAX* should go away altogether. - (sb!c::*toplevel-lambda-max* 1) ;; Let the target know that we're the cross-compiler. (*features* (cons :sb-xc *features*)) ;; We need to tweak the readtable.. diff --git a/src/code/alpha-vm.lisp b/src/code/alpha-vm.lisp index fe440d0..343e746 100644 --- a/src/code/alpha-vm.lisp +++ b/src/code/alpha-vm.lisp @@ -163,11 +163,11 @@ vector (* n-word-bits vector-data-offset) (* length n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (collect ((sc-offsets)) (loop (when (>= index length) (return)) - (sc-offsets (sb!c::read-var-integer vector index))) + (sc-offsets (sb!c:read-var-integer vector index))) (values error-number (sc-offsets))))))) diff --git a/src/code/debug-int.lisp b/src/code/debug-int.lisp index c0a1517..fb1af04 100644 --- a/src/code/debug-int.lisp +++ b/src/code/debug-int.lisp @@ -1513,19 +1513,18 @@ (list successors)) (dotimes (k (ldb sb!c::compiled-debug-block-nsucc-byte succ-and-flags)) - (push (sb!c::read-var-integer blocks i) successors)) + (push (sb!c:read-var-integer blocks i) successors)) (let* ((locations - (dotimes (k (sb!c::read-var-integer blocks i) + (dotimes (k (sb!c:read-var-integer blocks i) (result locations-buffer)) (let ((kind (svref sb!c::*compiled-code-location-kinds* (aref+ blocks i))) (pc (+ last-pc - (sb!c::read-var-integer blocks i))) + (sb!c:read-var-integer blocks i))) (tlf-offset (or tlf-number - (sb!c::read-var-integer blocks - i))) - (form-number (sb!c::read-var-integer blocks i)) - (live-set (sb!c::read-packed-bit-vector + (sb!c:read-var-integer blocks i))) + (form-number (sb!c:read-var-integer blocks i)) + (live-set (sb!c:read-packed-bit-vector live-set-len blocks i))) (vector-push-extend (make-known-code-location pc debug-fun tlf-offset diff --git a/src/code/hppa-vm.lisp b/src/code/hppa-vm.lisp index d692e8a..ebc0051 100644 --- a/src/code/hppa-vm.lisp +++ b/src/code/hppa-vm.lisp @@ -94,10 +94,10 @@ vector-data-offset) (* length n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (collect ((sc-offsets)) (loop (when (>= index length) (return)) - (sc-offsets (sb!c::read-var-integer vector index))) + (sc-offsets (sb!c:read-var-integer vector index))) (values error-number (sc-offsets))))))) diff --git a/src/code/mips-vm.lisp b/src/code/mips-vm.lisp index 365fbb9..558d293 100644 --- a/src/code/mips-vm.lisp +++ b/src/code/mips-vm.lisp @@ -123,7 +123,7 @@ vector-data-offset) (* length n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (/hexstr error-number) (collect ((sc-offsets)) (loop @@ -131,7 +131,7 @@ (/hexstr index) (when (>= index length) (return)) - (sc-offsets (sb!c::read-var-integer vector index))) + (sc-offsets (sb!c:read-var-integer vector index))) (values error-number (sc-offsets))))))) diff --git a/src/code/ppc-vm.lisp b/src/code/ppc-vm.lisp index 7b0e199..801192d 100644 --- a/src/code/ppc-vm.lisp +++ b/src/code/ppc-vm.lisp @@ -149,12 +149,12 @@ sb!vm:vector-data-offset) (* length sb!vm:n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (collect ((sc-offsets)) (loop (when (>= index length) (return)) - (sc-offsets (sb!c::read-var-integer vector index))) + (sc-offsets (sb!c:read-var-integer vector index))) (values error-number (sc-offsets)))))) diff --git a/src/code/sparc-vm.lisp b/src/code/sparc-vm.lisp index 5507d9f..3d214b5 100644 --- a/src/code/sparc-vm.lisp +++ b/src/code/sparc-vm.lisp @@ -147,12 +147,12 @@ vector-data-offset) (* length n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (collect ((sc-offsets)) (loop (when (>= index length) (return)) - (sc-offsets (sb!c::read-var-integer vector index))) + (sc-offsets (sb!c:read-var-integer vector index))) (values error-number (sc-offsets)))))) (defun args-for-tagged-add-inst (context bad-inst) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 5676b14..2b2cc12 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1190,10 +1190,15 @@ (out #'fill-pointer-ouch) (sout #'fill-pointer-sout) (misc #'fill-pointer-misc)) - (:constructor make-fill-pointer-output-stream (string)) + (:constructor %make-fill-pointer-output-stream (string)) (:copier nil)) - ;; the string we throw stuff in - string) + ;; a string with a fill pointer where we stuff the stuff we write + (string (error "missing argument") :type string :read-only t)) + +(defun make-fill-pointer-output-stream (string) + (declare (type string string)) + (fill-pointer string) ; called for side effect of checking has-fill-pointer + (%make-fill-pointer-output-stream string)) (defun fill-pointer-ouch (stream character) (let* ((buffer (fill-pointer-output-stream-string stream)) diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp index 21c2f47..833460c 100644 --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -285,7 +285,7 @@ vector (* n-word-bits vector-data-offset) (* length n-byte-bits)) (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (/hexstr error-number) (collect ((sc-offsets)) (loop @@ -293,7 +293,7 @@ (/hexstr index) (when (>= index length) (return)) - (let ((sc-offset (sb!c::read-var-integer vector index))) + (let ((sc-offset (sb!c:read-var-integer vector index))) (/show0 "SC-OFFSET=..") (/hexstr sc-offset) (sc-offsets sc-offset))) diff --git a/src/compiler/hppa/insts.lisp b/src/compiler/hppa/insts.lisp index 4e03d54..4fd72f6 100644 --- a/src/compiler/hppa/insts.lisp +++ b/src/compiler/hppa/insts.lisp @@ -398,13 +398,13 @@ (lengths)) (lengths 1) ; the length byte (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (lengths index) (loop (when (>= index length) (return)) (let ((old-index index)) - (sc-offsets (sb!c::read-var-integer vector index)) + (sc-offsets (sb!c:read-var-integer vector index)) (lengths (- index old-index)))) (values error-number (1+ length) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index af3cf93..e297258 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1183,68 +1183,29 @@ ;;;; COMPILE-FILE -;;; We build a list of top level lambdas, and then periodically smash -;;; them together into a single component and compile it. -(defvar *pending-toplevel-lambdas*) - -;;; The maximum number of top level lambdas we put in a single -;;; top level component. -;;; -;;; CMU CL 18b used this nontrivially by default (setting it to 10) -;;; but consequently suffered from the inability to execute some -;;; troublesome constructs correctly, e.g. inability to load a fasl -;;; file compiled from the source file -;;; (defpackage "FOO" (:use "CL")) -;;; (print 'foo::bar) -;;; because it would dump data-setup fops (including a FOP-PACKAGE for -;;; "FOO") for the second form before dumping the the code in the -;;; first form, or the fop to execute the code in the first form. By -;;; setting this value to 0 by default, we avoid this badness. This -;;; increases the number of toplevel form functions, and so increases -;;; the size of object files. -;;; -;;; The variable is still supported because when we are compiling the -;;; SBCL system itself, which is known not contain any troublesome -;;; constructs, we can set it to a nonzero value, which reduces the -;;; number of toplevel form objects, reducing the peak memory usage in -;;; GENESIS, which is desirable, since at least for SBCL version -;;; 0.6.7, this is the high water mark for memory usage during system -;;; construction. -(defparameter *toplevel-lambda-max* 0) - (defun object-call-toplevel-lambda (tll) (declare (type functional tll)) (let ((object *compile-object*)) (etypecase object - (fasl-output - (fasl-dump-toplevel-lambda-call tll object)) - (core-object - (core-call-toplevel-lambda tll object)) + (fasl-output (fasl-dump-toplevel-lambda-call tll object)) + (core-object (core-call-toplevel-lambda tll object)) (null)))) -;;; Add LAMBDAS to the pending lambdas. If this leaves more than -;;; *TOPLEVEL-LAMBDA-MAX* lambdas in the list, or if FORCE-P is true, -;;; then smash the lambdas into a single component, compile it, and -;;; call the resulting function. -(defun sub-compile-toplevel-lambdas (lambdas force-p) +;;; Smash LAMBDAS into a single component, compile it, and arrange for +;;; the resulting function to be called. +(defun sub-compile-toplevel-lambdas (lambdas) (declare (list lambdas)) - (setq *pending-toplevel-lambdas* - (append *pending-toplevel-lambdas* lambdas)) - (let ((pending *pending-toplevel-lambdas*)) - (when (and pending - (or (> (length pending) *toplevel-lambda-max*) - force-p)) - (multiple-value-bind (component tll) (merge-toplevel-lambdas pending) - (setq *pending-toplevel-lambdas* ()) - (compile-component component) - (clear-ir1-info component) - (object-call-toplevel-lambda tll)))) + (when lambdas + (multiple-value-bind (component tll) (merge-toplevel-lambdas lambdas) + (compile-component component) + (clear-ir1-info component) + (object-call-toplevel-lambda tll))) (values)) ;;; Compile top level code and call the top level lambdas. We pick off ;;; top level lambdas in non-top-level components here, calling ;;; SUB-c-t-l-l on each subsequence of normal top level lambdas. -(defun compile-toplevel-lambdas (lambdas force-p) +(defun compile-toplevel-lambdas (lambdas) (declare (list lambdas)) (let ((len (length lambdas))) (flet ((loser (start) @@ -1261,11 +1222,8 @@ len))) (do* ((start 0 (1+ loser)) (loser (loser start) (loser start))) - ((>= start len) - (when force-p - (sub-compile-toplevel-lambdas nil t))) - (sub-compile-toplevel-lambdas (subseq lambdas start loser) - (or force-p (/= loser len))) + ((>= start len)) + (sub-compile-toplevel-lambdas (subseq lambdas start loser)) (unless (= loser len) (object-call-toplevel-lambda (elt lambdas loser)))))) (values)) @@ -1284,20 +1242,17 @@ (maybe-mumble "IDFO ") (multiple-value-bind (components top-components hairy-top) (find-initial-dfo lambdas) - (let ((*all-components* (append components top-components)) - (toplevel-closure nil)) + (let ((*all-components* (append components top-components))) (when *check-consistency* (maybe-mumble "[check]~%") (check-ir1-consistency *all-components*)) (dolist (component (append hairy-top top-components)) - (when (pre-physenv-analyze-toplevel component) - (setq toplevel-closure t))) + (pre-physenv-analyze-toplevel component)) (dolist (component components) (compile-component component) - (when (replace-toplevel-xeps component) - (setq toplevel-closure t))) + (replace-toplevel-xeps component)) (when *check-consistency* (maybe-mumble "[check]~%") @@ -1305,7 +1260,7 @@ (if load-time-value-p (compile-load-time-value-lambda lambdas) - (compile-toplevel-lambdas lambdas toplevel-closure)) + (compile-toplevel-lambdas lambdas)) (mapc #'clear-ir1-info components) (clear-stuff))) @@ -1333,7 +1288,6 @@ (sb!xc:*compile-file-pathname* nil) (sb!xc:*compile-file-truename* nil) (*toplevel-lambdas* ()) - (*pending-toplevel-lambdas* ()) (*compiler-error-bailout* (lambda () (compiler-mumble "~2&; fatal error, aborting compilation~%") @@ -1360,7 +1314,6 @@ (sub-sub-compile-file info) (finish-block-compilation) - (compile-toplevel-lambdas () t) (let ((object *compile-object*)) (etypecase object (fasl-output (fasl-dump-source-info info object)) @@ -1637,7 +1590,6 @@ (:ignore-it nil) (t - (compile-toplevel-lambdas () t) (when (fasl-constant-already-dumped-p constant *compile-object*) (return-from emit-make-load-form nil)) (let* ((name (let ((*print-level* 1) (*print-length* 2)) diff --git a/src/compiler/mips/insts.lisp b/src/compiler/mips/insts.lisp index a5c90ca..686fb91 100644 --- a/src/compiler/mips/insts.lisp +++ b/src/compiler/mips/insts.lisp @@ -985,13 +985,13 @@ (lengths)) (lengths 1) ; the length byte (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (lengths index) (loop (when (>= index length) (return)) (let ((old-index index)) - (sc-offsets (sb!c::read-var-integer vector index)) + (sc-offsets (sb!c:read-var-integer vector index)) (lengths (- index old-index)))) (values error-number (1+ length) diff --git a/src/compiler/ppc/insts.lisp b/src/compiler/ppc/insts.lisp index 8ccf258..4d62f25 100644 --- a/src/compiler/ppc/insts.lisp +++ b/src/compiler/ppc/insts.lisp @@ -210,13 +210,13 @@ (lengths)) (lengths 1) ; the length byte (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (lengths index) (loop (when (>= index length) (return)) (let ((old-index index)) - (sc-offsets (sb!c::read-var-integer vector index)) + (sc-offsets (sb!c:read-var-integer vector index)) (lengths (- index old-index)))) (values error-number (1+ length) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index c12d7b4..660f804 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -90,13 +90,14 @@ ,(cond ((policy node (< safety 3)) ;; ANSI requires the length-related type check only ;; when the SAFETY quality is 3... in other cases, we - ;; skip it. + ;; skip it, because it could be expensive. bare) ((not constant-result-type-arg-p) `(sequence-of-checked-length-given-type ,bare result-type-arg)) (t - (let ((result-ctype (ir1-transform-specifier-type result-type))) + (let ((result-ctype (ir1-transform-specifier-type + result-type))) (if (array-type-p result-ctype) (let ((dims (array-type-dimensions result-ctype))) (unless (and (listp dims) (= (length dims) 1)) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 759a8fb..4b82210 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -1790,13 +1790,13 @@ (lengths)) (lengths 1) ; the length byte (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (lengths index) (loop (when (>= index length) (return)) (let ((old-index index)) - (sc-offsets (sb!c::read-var-integer vector index)) + (sc-offsets (sb!c:read-var-integer vector index)) (lengths (- index old-index)))) (values error-number (1+ length) diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp index 4e55b68..92dff11 100644 --- a/tests/seq.impure.lisp +++ b/tests/seq.impure.lisp @@ -261,13 +261,19 @@ (assert-type-error (concatenate '(string 6) "foo" " " "bar")) (assert (string= (concatenate '(string 6) "foo" #(#\b #\a #\r)) "foobar")) (assert-type-error (concatenate '(string 7) "foo" #(#\b #\a #\r)))) - ;; SIMPLE-ARRAY isn't allowed as a vector type specifier + ;; Non-VECTOR ARRAY types aren't allowed as vector type specifiers. (locally - (declare (optimize safety)) + (declare (optimize safety)) (assert-type-error (concatenate 'simple-array "foo" "bar")) (assert-type-error (map 'simple-array #'identity '(1 2 3))) + (assert (equalp #(11 13) + (map '(simple-array fixnum (*)) #'+ '(1 2 3) '(10 11)))) (assert-type-error (coerce '(1 2 3) 'simple-array)) (assert-type-error (merge 'simple-array '(1 3) '(2 4) '<)) + (assert (equalp #(3 2 1) (coerce '(3 2 1) '(vector fixnum)))) + (assert-type-error (map 'array #'identity '(1 2 3))) + (assert-type-error (map '(array fixnum) #'identity '(1 2 3))) + (assert (equalp #(1 2 3) (coerce '(1 2 3) '(vector fixnum)))) ;; but COERCE has an exemption clause: (assert (string= "foo" (coerce "foo" 'simple-array))) ;; ... though not in all cases. diff --git a/version.lisp-expr b/version.lisp-expr index 50dfb70..88c207a 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.8.23" +"0.7.8.24"