;; accessors.)
("src/code/type-class")
+ ("src/code/early-pcounter")
("src/code/pcounter" :not-host)
("src/code/ansi-stream" :not-host)
"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"
"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"
(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))
--- /dev/null
+;;;; 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)))
+
(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))
\f
;;;; general TYPE-UNION and TYPE-INTERSECTION operations
(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
>= > 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)))
\f
;;;; 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)
(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)
;;;; 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)
(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
(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)
;;; 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
'(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)))))))
\f
;;; 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.
(/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")
: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))
\f
;;;; 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))
;;; 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"
projects / sbcl.git / commitdiff