From: Christophe Rhodes Date: Sat, 8 Jun 2002 15:01:49 +0000 (+0000) Subject: 0.7.4.21: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4e3b57699314dbd3883470d9b196287b178f3e6d;p=sbcl.git 0.7.4.21: Install slightly sanitized version of TYPE-SYSTEM-INITIALIZED (CSR sbcl-devel 2002-06-07) ... really fix LOAD this time. --- diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 305d842..1e5b578 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -131,6 +131,7 @@ ;; accessors.) ("src/code/type-class") + ("src/code/early-pcounter") ("src/code/pcounter" :not-host) ("src/code/ansi-stream" :not-host) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 8625031..6209ade 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1049,7 +1049,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "WIDETAG-OF" "HAIRY-DATA-VECTOR-REF" "HAIRY-DATA-VECTOR-SET" "HAIRY-TYPE" "HAIRY-TYPE-CHECK-TEMPLATE-NAME" "HAIRY-TYPE-SPECIFIER" - "HANDLE-CIRCULARITY" "IGNORE-IT" + "HANDLE-CIRCULARITY" "HOST" "IGNORE-IT" "ILL-BIN" "ILL-BOUT" "ILL-IN" "ILL-OUT" "INDEX-OR-MINUS-1" "INDEX-TOO-LARGE-ERROR" @@ -1077,6 +1077,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "ANSI-STREAM-OUT" "ANSI-STREAM-SOUT" "LIST-TO-SIMPLE-STRING*" "LIST-TO-BIT-VECTOR*" "LIST-TO-VECTOR*" + "LOGICAL-HOST" "LOGICAL-HOST-DESIGNATOR" "LONG-FLOAT-EXPONENT" "LONG-FLOAT-EXP-BITS" "LONG-FLOAT-HIGH-BITS" "LONG-FLOAT-LOW-BITS" "LONG-FLOAT-MID-BITS" "LONG-FLOAT-P" diff --git a/src/code/class.lisp b/src/code/class.lisp index cfa2a1b..0733b25 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -1231,7 +1231,7 @@ (if (eq name t) nil (mapcar #'sb!xc:find-class direct-superclasses))))) - (setf (info :type :kind name) :primitive + (setf (info :type :kind name) #+sb-xc-host :defined #-sb-xc-host :primitive (class-cell-class (find-class-cell name)) class) (unless trans-p (setf (info :type :builtin name) class)) diff --git a/src/code/early-pcounter.lisp b/src/code/early-pcounter.lisp new file mode 100644 index 0000000..a23f618 --- /dev/null +++ b/src/code/early-pcounter.lisp @@ -0,0 +1,21 @@ +;;;; PCOUNTERs +;;;; +;;;; a PCOUNTER is used to represent an unsigned integer quantity which +;;;; can grow bigger than a fixnum, but typically does so, if at all, +;;;; in many small steps, where we don't want to cons on every step. +;;;; Such quantities typically arise in profiling, e.g. +;;;; total system consing, time spent in a profiled function, and +;;;; bytes consed in a profiled function are all examples of such +;;;; quantities. The name is an abbreviation for "Profiling COUNTER". + +;;; This stuff is implemented in the SB!PROFILE package because the +;;; profiling code is currently the only code which wants to poke +;;; around in the implementation details. This needs to be done on the +;;; host for type information. + +(in-package "SB!PROFILE") + +(def!struct (pcounter (:copier nil)) + (integer 0 :type unsigned-byte) + (fixnum 0 :type (and fixnum unsigned-byte))) + diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 3f0a53d..63cc7c6 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -756,7 +756,17 @@ (let ((res (specifier-type spec))) (unless (unknown-type-p res) (setf (info :type :builtin spec) res) - (setf (info :type :kind spec) :primitive)))) + ;; KLUDGE: the three copies of this idiom in this file (and + ;; the one in class.lisp as at sbcl-0.7.4.1x) should be + ;; coalesced, or perhaps the error-detecting code that + ;; disallows redefinition of :PRIMITIVE types should be + ;; rewritten to use *TYPE-SYSTEM-FINALIZED* (rather than + ;; *TYPE-SYSTEM-INITIALIZED*). The effect of this is not to + ;; cause redefinition errors when precompute-types is called + ;; for a second time while building the target compiler using + ;; the cross-compiler. -- CSR, trying to explain why this + ;; isn't completely wrong, 2002-06-07 + (setf (info :type :kind spec) #+sb-xc-host :defined #-sb-xc-host :primitive)))) (values)) ;;;; general TYPE-UNION and TYPE-INTERSECTION operations @@ -908,7 +918,7 @@ (macrolet ((frob (name var) `(progn (setq ,var (make-named-type :name ',name)) - (setf (info :type :kind ',name) :primitive) + (setf (info :type :kind ',name) #+sb-xc-host :defined #-sb-xc-host :primitive) (setf (info :type :builtin ',name) ,var)))) ;; KLUDGE: In ANSI, * isn't really the name of a type, it's just a ;; special symbol which can be stuck in some places where an @@ -1412,7 +1422,7 @@ >= > t))))))) (!cold-init-forms - (setf (info :type :kind 'number) :primitive) + (setf (info :type :kind 'number) #+sb-xc-host :defined #-sb-xc-host :primitive) (setf (info :type :builtin 'number) (make-numeric-type :complexp nil))) diff --git a/src/code/pcounter.lisp b/src/code/pcounter.lisp index c250ecd..d2b6b5e 100644 --- a/src/code/pcounter.lisp +++ b/src/code/pcounter.lisp @@ -18,13 +18,7 @@ ;;;; basic PCOUNTER stuff -(/show0 "pcounter.lisp 16") - -(defstruct (pcounter (:copier nil)) - (integer 0 :type unsigned-byte) - (fixnum 0 :type (and fixnum unsigned-byte))) - -(/show0 "pcounter.lisp 22") +(/show0 "pcounter.lisp 21") (declaim (maybe-inline incf-pcounter)) (defun incf-pcounter (pcounter delta) @@ -37,7 +31,7 @@ (setf (pcounter-fixnum pcounter) 0)))) pcounter) -(/show0 "pcounter.lisp 36") +(/show0 "pcounter.lisp 34") ;;;(declaim (inline pcounter->integer)) ; FIXME: maybe inline when more stable (defun pcounter->integer (pcounter) @@ -50,7 +44,7 @@ ;;;; start with a FIXNUM counter and only create a PCOUNTER if the ;;;; FIXNUM overflows. -(/show0 "pcounter.lisp 50") +(/show0 "pcounter.lisp 47") (declaim (inline %incf-pcounter-or-fixnum)) (defun %incf-pcounter-or-fixnum (x delta) @@ -65,7 +59,7 @@ (define-modify-macro incf-pcounter-or-fixnum (delta) %incf-pcounter-or-fixnum) -(/show0 "pcounter.lisp 64") +(/show0 "pcounter.lisp 62") ;;; Trade off space for execution time by handling the common fast ;;; (TYPEP DELTA 'FIXNUM) case inline and only calling generic @@ -79,7 +73,7 @@ (incf-pcounter-or-fixnum ,x ,delta) (incf-pcounter-or-fixnum ,x ,delta))))) -(/show0 "pcounter.lisp 80") +(/show0 "pcounter.lisp 76") (declaim (maybe-inline pcounter-or-fixnum->integer)) (defun pcounter-or-fixnum->integer (x) diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 48a96c4..b36fefb 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -96,7 +96,7 @@ ;;; possible types are ".lisp" and ".cl", and both "foo.lisp" and ;;; "foo.cl" exist?) (defun try-default-type (pathname type) - (let ((pn (make-pathname :type type :defaults pathname))) + (let ((pn (translate-logical-pathname (make-pathname :type type :defaults pathname)))) (values pn (probe-file pn)))) ;;; a helper function for LOAD: Handle the case of INTERNAL-LOAD where @@ -183,29 +183,19 @@ '(unsigned-byte 8))) (load-as-fasl filespec verbose print) (load-as-source filespec verbose print)) - (let* (;; FIXME: MERGE-PATHNAMES doesn't work here for - ;; FILESPEC="TEST:Load-Test" and - ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST") - ;; = (("**;*.*.*" "/foo/bar/**/*.*")). - ;; Physicalizing the pathname before merging - ;; is a workaround, but the ANSI spec talks about - ;; MERGE-PATHNAMES accepting (and returning) - ;; logical pathnames, so a true fix would probably - ;; include fixing MERGE-PATHNAMES, then probably - ;; revisiting this code. - (ppn (physicalize-pathname (pathname filespec))) - (unix-name (unix-namestring ppn t))) - (if (or unix-name (pathname-type ppn)) - (internal-load ppn - unix-name + (let* ((pathname (pathname filespec)) + (physical-pathname (translate-logical-pathname pathname))) + (if (or (probe-file physical-pathname) (pathname-type physical-pathname)) + (internal-load physical-pathname + (truename physical-pathname) internal-if-does-not-exist verbose print) - (internal-load-default-type - ppn - internal-if-does-not-exist - verbose - print))))))) + + (internal-load-default-type pathname + internal-if-does-not-exist + verbose + print))))))) ;;; Load a code object. BOX-NUM objects are popped off the stack for ;;; the boxed storage section, then SIZE bytes of code are read in. diff --git a/src/code/type-init.lisp b/src/code/type-init.lisp index abb86cb..7c199e0 100644 --- a/src/code/type-init.lisp +++ b/src/code/type-init.lisp @@ -43,14 +43,6 @@ (/show0 "precomputing built-in symbol type specifiers") (precompute-types *!standard-type-names*) -;;; FIXME: It should be possible to do this in the cross-compiler, -;;; but currently the cross-compiler's type system is too dain-bramaged to -;;; handle it. (Various consistency checks are disabled when this flag -;;; is false, and the cross-compiler's type system can't pass these -;;; checks. Some of the problems are quite severe, e.g. mismatch between -;;; LAYOUTs generated by DEF!STRUCT and LAYOUTs generated by real -;;; DEFSTRUCT due to DEF!STRUCT not understanding raw slots -- it's -;;; actually somewhat remarkable that the system works..) -; #+sb-xc-host (setf *type-system-initialized* t) +#+sb-xc-host (setf *type-system-initialized* t) (/show0 "done with type-init.lisp") diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 7b433e3..4d78a8b 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -38,9 +38,9 @@ :derive-type (result-type-specifier-nth-arg 2)) (defknown list-to-simple-string* (list) simple-string) (defknown list-to-bit-vector* (list) bit-vector) -(defknown list-to-vector* (list type) vector) +(defknown list-to-vector* (list type-specifier) vector) (defknown list-to-simple-vector* (list) simple-vector) -(defknown vector-to-vector* (vector type) vector) +(defknown vector-to-vector* (vector type-specifier) vector) (defknown vector-to-simple-string* (vector) vector) (defknown type-of (t) t (foldable flushable)) diff --git a/src/compiler/generic/vm-fndb.lisp b/src/compiler/generic/vm-fndb.lisp index 2d50d2a..7746eae 100644 --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -179,19 +179,19 @@ ;;;; bignum operations -(defknown %allocate-bignum (bignum-index) bignum-widetag +(defknown %allocate-bignum (bignum-index) bignum-type (flushable)) -(defknown %bignum-length (bignum-widetag) bignum-index +(defknown %bignum-length (bignum-type) bignum-index (foldable flushable movable)) -(defknown %bignum-set-length (bignum-widetag bignum-index) bignum-widetag +(defknown %bignum-set-length (bignum-type bignum-index) bignum-type (unsafe)) -(defknown %bignum-ref (bignum-widetag bignum-index) bignum-element-type +(defknown %bignum-ref (bignum-type bignum-index) bignum-element-type (flushable)) -(defknown %bignum-set (bignum-widetag bignum-index bignum-element-type) +(defknown %bignum-set (bignum-type bignum-index bignum-element-type) bignum-element-type (unsafe)) diff --git a/version.lisp-expr b/version.lisp-expr index 534e9a8..0e1273b 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.4.20" +"0.7.4.21"