cleanup of leftover search list stuff..
..got rid of ENUMERATE-SEARCH-LIST
..renamed DEF!STRUCT SEARCH-LIST to LOGICAL-HOSTNAME, since
it's now used only to represent the stuff before the
colon in logical pathnames
;; symbol-hacking idioms
"KEYWORDICATE" "SYMBOLICATE"
- ;; search lists (FIXME: should go away)
- "ENUMERATE-SEARCH-LIST"
- "CLEAR-SEARCH-LIST"
- "SEARCH-LIST"
- "SEARCH-LIST-DEFINED-P"
-
;; certainly doesn't belong in public extensions
;; FIXME: maybe belongs in %KERNEL with other typesystem stuff?
"CONSTANT-ARGUMENT"
-;;;; Stuff to handle simple cases for generic arithmetic.
+;;;; stuff to handle simple cases for generic arithmetic
;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
(setf next-list (next-code-locations (first next-list))))
next-list)))
-;;; Returns a list of code-locations of the possible breakpoints of the
+;;; Return a list of code-locations of the possible breakpoints of the
;;; debug-function passed.
(defun possible-breakpoints (debug-function)
(let ((possible-breakpoints nil))
(push code-location possible-breakpoints))))))
(nreverse possible-breakpoints)))
-;;; Searches the info-list for the item passed (code-location,
+;;; Search the info-list for the item passed (code-location,
;;; debug-function, or breakpoint-info). If the item passed is a debug
;;; function then kind will be compared if it was specified. The kind
;;; if also compared if a breakpoint-info is passed since it's in the
#-sb-xc-host (defsetf symbol-plist %set-symbol-plist)
#-sb-xc-host (defsetf nth %setnth)
#-sb-xc-host (defsetf fill-pointer %set-fill-pointer)
-(defsetf search-list %set-search-list)
(defsetf sap-ref-8 %set-sap-ref-8)
(defsetf signed-sap-ref-8 %set-signed-sap-ref-8)
(defsetf sap-ref-16 %set-sap-ref-16)
;;; Unix namestrings have the following format:
;;;
;;; namestring := [ directory ] [ file [ type [ version ]]]
-;;; directory := [ "/" | search-list ] { file "/" }*
-;;; search-list := [^:/]*:
+;;; directory := [ "/" ] { file "/" }*
;;; file := [^/]*
;;; type := "." [^/.]*
;;; version := "." ([0-9]+ | "*")
;;;
-;;; FIXME: Search lists are no longer supported.
-;;;
;;; Note: this grammar is ambiguous. The string foo.bar.5 can be
;;; parsed as either just the file specified or as specifying the
;;; file, type, and version. Therefore, we use the following rules
(setf start (1+ slash))))
(values absolute (pieces)))))
-(defun maybe-extract-search-list (namestr start end)
+;;; the thing before a colon in a logical path
+(def!struct (logical-hostname (:make-load-form-fun
+ (lambda (x)
+ (values `(make-logical-hostname
+ ,(logical-hostname-name x))
+ nil)))
+ (:copier nil)
+ (:constructor make-logical-hostname (name)))
+ (name (required-argument) :type simple-string))
+
+(defun maybe-extract-logical-hostname (namestr start end)
(declare (type simple-base-string namestr)
(type index start end))
(let ((quoted nil))
(#\\
(setf quoted t))
(#\:
- (return (values (remove-backslashes namestr start index)
+ (return (values (make-logical-hostname
+ (remove-backslashes namestr start index))
(1+ index)))))))))
(defun parse-unix-namestring (namestr start end)
(declare (type simple-base-string namestr)
- (type index start end))
+ (type index start end))
(multiple-value-bind (absolute pieces) (split-at-slashes namestr start end)
- (let ((search-list (if absolute
- nil
- (let ((first (car pieces)))
- (multiple-value-bind (search-list new-start)
- (maybe-extract-search-list namestr
- (car first)
- (cdr first))
- (when search-list
- (setf absolute t)
- (setf (car first) new-start))
- search-list)))))
+ (let ((logical-hostname
+ (if absolute
+ nil
+ (let ((first (car pieces)))
+ (multiple-value-bind (logical-hostname new-start)
+ (maybe-extract-logical-hostname namestr
+ (car first)
+ (cdr first))
+ (when logical-hostname
+ (setf absolute t)
+ (setf (car first) new-start))
+ logical-hostname)))))
+ (declare (type (or null logical-hostname) logical-hostname))
(multiple-value-bind (name type version)
- (let* ((tail (car (last pieces)))
- (tail-start (car tail))
- (tail-end (cdr tail)))
- (unless (= tail-start tail-end)
- (setf pieces (butlast pieces))
- (extract-name-type-and-version namestr tail-start tail-end)))
- ;; PVE: make sure there are no illegal characters in
- ;; the name, illegal being (code-char 0) and #\/
- #!+high-security
- (when (and (stringp name)
- (find-if #'(lambda (x) (or (char= x (code-char 0))
- (char= x #\/)))
- name))
- (error 'parse-error))
-
- ;; Now we have everything we want. So return it.
- (values nil ; no host for unix namestrings.
- nil ; no devices for unix namestrings.
- (collect ((dirs))
- (when search-list
- (dirs (intern-search-list search-list)))
- (dolist (piece pieces)
- (let ((piece-start (car piece))
- (piece-end (cdr piece)))
- (unless (= piece-start piece-end)
- (cond ((string= namestr ".." :start1 piece-start
- :end1 piece-end)
- (dirs :up))
- ((string= namestr "**" :start1 piece-start
- :end1 piece-end)
- (dirs :wild-inferiors))
- (t
- (dirs (maybe-make-pattern namestr
- piece-start
- piece-end)))))))
- (cond (absolute
- (cons :absolute (dirs)))
- ((dirs)
- (cons :relative (dirs)))
- (t
- nil)))
- name
- type
- version)))))
+ (let* ((tail (car (last pieces)))
+ (tail-start (car tail))
+ (tail-end (cdr tail)))
+ (unless (= tail-start tail-end)
+ (setf pieces (butlast pieces))
+ (extract-name-type-and-version namestr tail-start tail-end)))
+
+ (when (stringp name)
+ (let ((position (position-if (lambda (char)
+ (or (char= char (code-char 0))
+ (char= char #\/)))
+ name)))
+ (when position
+ (error 'namestring-parse-error
+ :complaint "can't embed #\\Nul or #\\/ in Unix namestring"
+ :namestring namestr
+ :offset position))))
+
+ ;; Now we have everything we want. So return it.
+ (values nil ; no host for Unix namestrings
+ nil ; no device for Unix namestrings
+ (collect ((dirs))
+ (when logical-hostname
+ (dirs logical-hostname))
+ (dolist (piece pieces)
+ (let ((piece-start (car piece))
+ (piece-end (cdr piece)))
+ (unless (= piece-start piece-end)
+ (cond ((string= namestr ".."
+ :start1 piece-start
+ :end1 piece-end)
+ (dirs :up))
+ ((string= namestr "**"
+ :start1 piece-start
+ :end1 piece-end)
+ (dirs :wild-inferiors))
+ (t
+ (dirs (maybe-make-pattern namestr
+ piece-start
+ piece-end)))))))
+ (cond (absolute
+ (cons :absolute (dirs)))
+ ((dirs)
+ (cons :relative (dirs)))
+ (t
+ nil)))
+ name
+ type
+ version)))))
(/show0 "filesys.lisp 300")
(when directory
(ecase (pop directory)
(:absolute
- (cond ((search-list-p (car directory))
- (pieces (search-list-name (pop directory)))
+ (cond ((logical-hostname-p (car directory))
+ ;; FIXME: The old CMU CL "search list" extension is
+ ;; gone, but the old machinery is still being used
+ ;; clumsily here and elsewhere, to represent anything
+ ;; which belongs before a colon prefix in the ANSI
+ ;; pathname machinery. This should be cleaned up,
+ ;; using simpler machinery with more mnemonic names.
+ (pieces (logical-hostname-name (pop directory)))
(pieces ":"))
(t
(pieces "/"))))
))
;;; Convert PATHNAME into a string that can be used with UNIX system
-;;; calls, or return NIL if no match is found. Search-lists and
-;;; wild-cards are expanded.
+;;; calls, or return NIL if no match is found. Wild-cards are expanded.
(defun unix-namestring (pathname-spec &optional (for-input t))
;; The ordinary rules of converting Lispy paths to Unix paths break
;; down for the current working directory, which Lisp thinks of as
TRUENAMEing and the semantics of the Unix filesystem (symbolic links..)
means this function can sometimes return files which don't have the same
directory as PATHNAME."
- (let ((truenames nil))
- (enumerate-search-list
- (pathname (merge-pathnames pathname
- (make-pathname :name :wild
- :type :wild
- :version :wild)))
- (enumerate-matches (match pathname)
- (let ((*ignore-wildcards* t))
- (push (truename (if (eq (sb!unix:unix-file-kind match) :directory)
- (concatenate 'string match "/")
- match))
- truenames))))
+ (let ((truenames nil)
+ (merged-pathname (merge-pathnames pathname
+ (make-pathname :name :wild
+ :type :wild
+ :version :wild))))
+ (enumerate-matches (match merged-pathname)
+ (let ((*ignore-wildcards* t))
+ (push (truename (if (eq (sb!unix:unix-file-kind match) :directory)
+ (concatenate 'string match "/")
+ match))
+ truenames)))
;; FIXME: The DELETE-DUPLICATES here requires quadratic time,
;; which is unnecessarily slow. That might not be an issue,
;; though, since the time constant for doing TRUENAME on every
(error 'simple-file-error
:format-control "bad place for a wild pathname"
:pathname pathspec))
- (enumerate-search-list (pathname pathname)
- (let ((dir (pathname-directory pathname)))
- (loop for i from 1 upto (length dir)
- do (let ((newpath (make-pathname
- :host (pathname-host pathname)
- :device (pathname-device pathname)
- :directory (subseq dir 0 i))))
- (unless (probe-file newpath)
- (let ((namestring (namestring newpath)))
- (when verbose
- (format *standard-output*
- "~&creating directory: ~A~%"
- namestring))
- (sb!unix:unix-mkdir namestring mode)
- (unless (probe-file namestring)
- (error 'simple-file-error
- :pathname pathspec
- :format-control "can't create directory ~A"
- :format-arguments (list namestring)))
- (setf created-p t)))))
- ;; Only the first path in a search-list is considered.
- (return (values pathname created-p))))))
+ (let ((dir (pathname-directory pathname)))
+ (loop for i from 1 upto (length dir)
+ do (let ((newpath (make-pathname
+ :host (pathname-host pathname)
+ :device (pathname-device pathname)
+ :directory (subseq dir 0 i))))
+ (unless (probe-file newpath)
+ (let ((namestring (namestring newpath)))
+ (when verbose
+ (format *standard-output*
+ "~&creating directory: ~A~%"
+ namestring))
+ (sb!unix:unix-mkdir namestring mode)
+ (unless (probe-file namestring)
+ (error 'simple-file-error
+ :pathname pathspec
+ :format-control "can't create directory ~A"
+ :format-arguments (list namestring)))
+ (setf created-p t)))))
+ (values pathname created-p))))
(/show0 "filesys.lisp 1000")
name
type
version))))
-\f
-(defmacro-mundanely enumerate-search-list ((var pathname &optional result)
- &body body)
- #!+sb-doc
- "Execute BODY with VAR bound to each successive possible expansion for
- PATHNAME and then return RESULT. Note: if PATHNAME does not contain a
- search-list, then BODY is executed exactly once. Everything is wrapped
- in a block named NIL, so RETURN can be used to terminate early. Note:
- VAR is *not* bound inside of RESULT."
- (let ((body-name (gensym)))
- `(block nil
- (flet ((,body-name (,var)
- ,@body))
- (%enumerate-search-list ,pathname #',body-name)
- ,result))))
-
;; "path:" defined in sbcl-0.6.10. It would probably be
;; reasonable to restore Unix PATH searching in SBCL, e.g.
;; with a function FIND-EXECUTABLE-FILE-IN-POSIX-PATH.
- ;; (I don't want to do it with search lists the way
- ;; that CMU CL did, because those are a non-ANSI
- ;; extension which I'd like to get rid of. -- WHN)
+ ;; CMU CL did it with a "PATH:" search list, but CMU CL
+ ;; search lists are a non-ANSI extension that SBCL
+ ;; doesn't support. -- WHN)
(pfile (unix-namestring program t))
(cookie (list 0)))
(unless pfile
(defun getf (place indicator &optional (default ()))
#!+sb-doc
- "Searches the property list stored in Place for an indicator EQ to Indicator.
- If one is found, the corresponding value is returned, else the Default is
- returned."
+ "Search the property list stored in Place for an indicator EQ to INDICATOR.
+ If one is found, return the corresponding value, else return DEFAULT."
(do ((plist place (cddr plist)))
((null plist) default)
(cond ((atom (cdr plist))
(defun get-properties (place indicator-list)
#!+sb-doc
- "Like GETF, except that Indicator-List is a list of indicators which will
- be looked for in the property list stored in Place. Three values are
+ "Like GETF, except that INDICATOR-LIST is a list of indicators which will
+ be looked for in the property list stored in PLACE. Three values are
returned, see manual for details."
(do ((plist place (cddr plist)))
((null plist) (values nil nil nil))
(error nil))))
(if namestring
(format stream "#P~S" namestring)
- ;; FIXME: This code was rewritten and should be tested. (How does
- ;; control get to this case anyhow? Perhaps we could just punt it?)
(print-unreadable-object (pathname stream :type t)
(format stream
- "(with no namestring) :HOST ~S :DEVICE ~S :DIRECTORY ~S ~
- :NAME ~S :TYPE ~S :VERSION ~S"
+ "~@<(with no namestring) ~_:HOST ~S ~_:DEVICE ~S ~_:DIRECTORY ~S ~
+ ~_:NAME ~S ~_:TYPE ~S ~_:VERSION ~S~:>"
(%pathname-host pathname)
(%pathname-device pathname)
(%pathname-directory pathname)
((member :unspecific) '(:relative))
(list
(collect ((results))
- (ecase (pop directory)
- (:absolute
- (results :absolute)
- (when (search-list-p (car directory))
- (results (pop directory))))
- (:relative
- (results :relative)))
+ (results (pop directory))
(dolist (piece directory)
(cond ((member piece '(:wild :wild-inferiors :up :back))
(results piece))
(frob %pathname-type)
(frob %pathname-version))))))))
\f
-;;;; search lists
-
-(def!struct (search-list (:make-load-form-fun
- (lambda (s)
- (values `(intern-search-list
- ',(search-list-name s))
- nil))))
- ;; The name of this search-list. Always stored in lowercase.
- (name (required-argument) :type simple-string)
- ;; T if this search-list has been defined. Otherwise NIL.
- (defined nil :type (member t nil))
- ;; the list of expansions for this search-list. Each expansion is
- ;; the list of directory components to use in place of this
- ;; search-list.
- (expansions nil :type list))
-(def!method print-object ((sl search-list) stream)
- (print-unreadable-object (sl stream :type t)
- (write-string (search-list-name sl) stream)))
-
-;;; a hash table mapping search-list names to search-list structures
-(defvar *search-lists* (make-hash-table :test 'equal))
-
-;;; When search-lists are encountered in namestrings, they are
-;;; converted to search-list structures right then, instead of waiting
-;;; until the search list used. This allows us to verify ahead of time
-;;; that there are no circularities and makes expansion much quicker.
-(defun intern-search-list (name)
- (let ((name (string-downcase name)))
- (or (gethash name *search-lists*)
- (let ((new (make-search-list :name name)))
- (setf (gethash name *search-lists*) new)
- new))))
-
-;;; Clear the definition. Note: we can't remove it from the hash-table
-;;; because there may be pathnames still refering to it. So we just
-;;; clear out the expansions and ste defined to NIL.
-(defun clear-search-list (name)
- #!+sb-doc
- "Clear the current definition for the search-list NAME. Returns T if such
- a definition existed, and NIL if not."
- (let* ((name (string-downcase name))
- (search-list (gethash name *search-lists*)))
- (when (and search-list (search-list-defined search-list))
- (setf (search-list-defined search-list) nil)
- (setf (search-list-expansions search-list) nil)
- t)))
-
-;;; As in CLEAR-SEARCH-LIST, we can't actually remove the entries from
-;;; the hash-table, so we just mark them as being undefined.
-(defun clear-all-search-lists ()
- #!+sb-doc
- "Clear the definition for all search-lists. Only use this if you know
- what you are doing."
- (maphash #'(lambda (name search-list)
- (declare (ignore name))
- (setf (search-list-defined search-list) nil)
- (setf (search-list-expansions search-list) nil))
- *search-lists*)
- nil)
-
-;;; Extract the search-list from PATHNAME and return it. If PATHNAME
-;;; doesn't start with a search-list, then either error (if
-;;; FLAME-IF-NONE is true) or return NIL (if FLAME-IF-NONE is false).
-(defun extract-search-list (pathname flame-if-none)
- (with-pathname (pathname pathname)
- (let* ((directory (%pathname-directory pathname))
- (search-list (cadr directory)))
- (cond ((search-list-p search-list)
- search-list)
- (flame-if-none
- (error "~S doesn't start with a search-list." pathname))
- (t
- nil)))))
-
-;;; We have to convert the internal form of the search-list back into
-;;; a bunch of pathnames.
-(defun search-list (pathname)
- #!+sb-doc
- "Return the expansions for the search-list starting PATHNAME. If PATHNAME
- does not start with a search-list, then an error is signaled. If
- the search-list has not been defined yet, then an error is signaled.
- The expansion for a search-list can be set with SETF."
- (with-pathname (pathname pathname)
- (let ((search-list (extract-search-list pathname t))
- (host (pathname-host pathname)))
- (if (search-list-defined search-list)
- (mapcar #'(lambda (directory)
- (make-pathname :host host
- :directory (cons :absolute directory)))
- (search-list-expansions search-list))
- (error "Search list ~S has not been defined yet." pathname)))))
-
-(defun search-list-defined-p (pathname)
- #!+sb-doc
- "Returns T if the search-list starting PATHNAME is currently defined, and
- NIL otherwise. An error is signaled if PATHNAME does not start with a
- search-list."
- (with-pathname (pathname pathname)
- (search-list-defined (extract-search-list pathname t))))
-
-;;; Set the expansion for the search list in PATHNAME. If this would
-;;; result in any circularities, we flame out. If anything goes wrong,
-;;; we leave the old definition intact.
-(defun %set-search-list (pathname values)
- (let ((search-list (extract-search-list pathname t)))
- (labels
- ((check (target-list path)
- (when (eq search-list target-list)
- (error "That would result in a circularity:~% ~
- ~A~{ -> ~A~} -> ~A"
- (search-list-name search-list)
- (reverse path)
- (search-list-name target-list)))
- (when (search-list-p target-list)
- (push (search-list-name target-list) path)
- (dolist (expansion (search-list-expansions target-list))
- (check (car expansion) path))))
- (convert (pathname)
- (with-pathname (pathname pathname)
- (when (or (pathname-name pathname)
- (pathname-type pathname)
- (pathname-version pathname))
- (error "Search-lists cannot expand into pathnames that have ~
- a name, type, or ~%version specified:~% ~S"
- pathname))
- (let ((directory (pathname-directory pathname)))
- (let ((expansion
- (if directory
- (ecase (car directory)
- (:absolute (cdr directory))
- (:relative (cons (intern-search-list "default")
- (cdr directory))))
- (list (intern-search-list "default")))))
- (check (car expansion) nil)
- expansion)))))
- (setf (search-list-expansions search-list)
- (if (listp values)
- (mapcar #'convert values)
- (list (convert values)))))
- (setf (search-list-defined search-list) t))
- values)
-
-(defun %enumerate-search-list (pathname function)
- (let* ((pathname (physicalize-pathname pathname))
- (search-list (extract-search-list pathname nil)))
- (cond
- ((not search-list)
- (funcall function pathname))
- ((not (search-list-defined search-list))
- (error "undefined search list: ~A"
- (search-list-name search-list)))
- (t
- (let ((tail (cddr (pathname-directory pathname))))
- (dolist (expansion
- (search-list-expansions search-list))
- (%enumerate-search-list (make-pathname :defaults pathname
- :directory
- (cons :absolute
- (append expansion
- tail)))
- function)))))))
-\f
;;;; logical pathname support. ANSI 92-102 specification.
;;;;
;;;; As logical-pathname translations are loaded they are
;; block pointer. In the other cases nobody directly references the
;; unwind-block, so we leave this slot null.
(home nil :type (or tn null))
- ;; The saved control stack pointer.
+ ;; the saved control stack pointer
(save-sp (required-argument) :type tn)
- ;; The list of dynamic state save TNs.
+ ;; the list of dynamic state save TNs
(dynamic-state (list* (make-stack-pointer-tn)
(make-dynamic-state-tns))
:type list)
- ;; The target label for NLX entry.
+ ;; the target label for NLX entry
(target (gen-label) :type label))
(defprinter (ir2-nlx-info)
home
;;; operands to the operation.
(defstruct (vop (:constructor make-vop (block node info args results))
(:copier nil))
- ;; VOP-Info structure containing static info about the operation.
+ ;; VOP-Info structure containing static info about the operation
(info nil :type (or vop-info null))
- ;; The IR2-Block this VOP is in.
+ ;; the IR2-Block this VOP is in
(block (required-argument) :type ir2-block)
;; VOPs evaluated after and before this one. Null at the
;; beginning/end of the block, and temporarily during IR2
;; translation.
(next nil :type (or vop null))
(prev nil :type (or vop null))
- ;; Heads of the TN-Ref lists for operand TNs, linked using the
- ;; Across slot.
+ ;; heads of the TN-Ref lists for operand TNs, linked using the
+ ;; Across slot
(args nil :type (or tn-ref null))
(results nil :type (or tn-ref null))
- ;; Head of the list of write refs for each explicitly allocated
- ;; temporary, linked together using the Across slot.
+ ;; head of the list of write refs for each explicitly allocated
+ ;; temporary, linked together using the Across slot
(temps nil :type (or tn-ref null))
- ;; Head of the list of all TN-refs for references in this VOP,
+ ;; head of the list of all TN-refs for references in this VOP,
;; linked by the Next-Ref slot. There will be one entry for each
;; operand and two (a read and a write) for each temporary.
(refs nil :type (or tn-ref null))
- ;; Stuff that is passed uninterpreted from IR2 conversion to
+ ;; stuff that is passed uninterpreted from IR2 conversion to
;; codegen. The meaning of this slot is totally dependent on the VOP.
codegen-info
- ;; Node that generated this VOP, for keeping track of debug info.
+ ;; the node that generated this VOP, for keeping track of debug info
(node nil :type (or node null))
;; Local-TN bit vector representing the set of TNs live after args
;; are read and before results are written. This is only filled in
;; this VOP "does", i.e. the implementation strategy. This is for
;; use in efficiency notes.
(note nil :type (or string null))
- ;; The number of trailing arguments to VOP or %PRIMITIVE that we
+ ;; the number of trailing arguments to VOP or %PRIMITIVE that we
;; bundle into a list and pass into the emit function. This provides
;; a way to pass uninterpreted stuff directly to the code generator.
(info-arg-count 0 :type index)
;;; The SB structure represents the global information associated with
;;; a storage base.
(def!struct (sb (:make-load-form-fun just-dump-it-normally))
- ;; Name, for printing and reference.
+ ;; name, for printing and reference
(name nil :type symbol)
- ;; The kind of storage base (which determines the packing
- ;; algorithm).
+ ;; the kind of storage base (which determines the packing
+ ;; algorithm)
(kind :non-packed :type (member :finite :unbounded :non-packed))
- ;; The number of elements in the SB. If finite, this is the total
+ ;; the number of elements in the SB. If finite, this is the total
;; size. If unbounded, this is the size that the SB is initially
;; allocated at.
(size 0 :type index))
(defprinter (sb)
name)
-;;; The Finite-SB structure holds information needed by the packing
-;;; algorithm for finite SBs.
+;;; A FINITE-SB holds information needed by the packing algorithm for
+;;; finite SBs.
(def!struct (finite-sb (:include sb))
- ;; The number of locations currently allocated in this SB.
+ ;; the number of locations currently allocated in this SB
(current-size 0 :type index)
- ;; The last location packed in, used by pack to scatter TNs to
+ ;; the last location packed in, used by pack to scatter TNs to
;; prevent a few locations from getting all the TNs, and thus
;; getting overcrowded, reducing the possibilities for targeting.
(last-offset 0 :type index)
- ;; A vector containing, for each location in this SB, a vector
+ ;; a vector containing, for each location in this SB, a vector
;; indexed by IR2 block numbers, holding local conflict bit vectors.
;; A TN must not be packed in a given location within a particular
;; block if the LTN number for that TN in that block corresponds to
;; a set bit in the bit-vector.
(conflicts '#() :type simple-vector)
- ;; A vector containing, for each location in this SB, a bit-vector
+ ;; a vector containing, for each location in this SB, a bit-vector
;; indexed by IR2 block numbers. If the bit corresponding to a block
;; is set, then the location is in use somewhere in the block, and
;; thus has a conflict for always-live TNs.
(always-live '#() :type simple-vector)
- ;; A vector containing the TN currently live in each location in the
+ ;; a vector containing the TN currently live in each location in the
;; SB, or NIL if the location is unused. This is used during load-tn pack.
(live-tns '#() :type simple-vector)
- ;; The number of blocks for which the ALWAYS-LIVE and CONFLICTS
+ ;; the number of blocks for which the ALWAYS-LIVE and CONFLICTS
;; might not be virgin, and thus must be reinitialized when PACK
;; starts. Less then the length of those vectors when not all of the
;; length was used on the previously packed component.
:type (member :normal :environment :debug-environment
:save :save-once :specified-save :load :constant
:component :alias))
- ;; The primitive-type for this TN's value. Null in restricted or
+ ;; the primitive-type for this TN's value. Null in restricted or
;; wired TNs.
(primitive-type nil :type (or primitive-type null))
;; If this TN represents a variable or constant, then this is the
;; corresponding Leaf.
(leaf nil :type (or leaf null))
- ;; Thread that links TNs together so that we can find them.
+ ;; thread that links TNs together so that we can find them
(next nil :type (or tn null))
- ;; Head of TN-Ref lists for reads and writes of this TN.
+ ;; head of TN-Ref lists for reads and writes of this TN
(reads nil :type (or tn-ref null))
(writes nil :type (or tn-ref null))
- ;; A link we use when building various temporary TN lists.
+ ;; a link we use when building various temporary TN lists
(next* nil :type (or tn null))
- ;; Some block that contains a reference to this TN, or Nil if we
+ ;; some block that contains a reference to this TN, or Nil if we
;; haven't seen any reference yet. If the TN is local, then this is
;; the block it is local to.
(local nil :type (or ir2-block null))
;; number during the conflicts analysis of that block. If the TN has
;; no local number within the block, then this is Nil.
(local-number nil :type (or local-tn-number null))
- ;; If a local TN, a bit-vector with 1 for the local-number of every
- ;; TN that we conflict with.
+ ;; If this object is a local TN, this slot is a bit-vector with 1
+ ;; for the local-number of every TN that we conflict with.
(local-conflicts (make-array local-tn-limit :element-type 'bit
:initial-element 0)
:type local-tn-bit-vector)
- ;; Head of the list of Global-Conflicts structures for a global TN.
+ ;; head of the list of Global-Conflicts structures for a global TN.
;; This list is sorted by block number (i.e. reverse DFO), allowing
;; the intersection between the lifetimes for two global TNs to be
;; easily found. If null, then this TN is a local TN.
(global-conflicts nil :type (or global-conflicts null))
- ;; During lifetime analysis, this is used as a pointer into the
- ;; conflicts chain, for scanning through blocks in reverse DFO.
+ ;; during lifetime analysis, this is used as a pointer into the
+ ;; conflicts chain, for scanning through blocks in reverse DFO
(current-conflict nil)
;; In a :SAVE TN, this is the TN saved. In a :NORMAL or :ENVIRONMENT
;; TN, this is the associated save TN. In TNs with no save TN, this
;; After pack, the SC we packed into. Beforehand, the SC we want to
;; pack into, or null if we don't know.
(sc nil :type (or sc null))
- ;; The offset within the SB that this TN is packed into. This is what
- ;; indicates that the TN is packed.
+ ;; the offset within the SB that this TN is packed into. This is what
+ ;; indicates that the TN is packed
(offset nil :type (or index null))
- ;; Some kind of info about how important this TN is.
+ ;; some kind of info about how important this TN is
(cost 0 :type fixnum)
- ;; If a :ENVIRONMENT or :DEBUG-ENVIRONMENT TN, this is the environment that
- ;; the TN is live throughout.
+ ;; If a :ENVIRONMENT or :DEBUG-ENVIRONMENT TN, this is the
+ ;; environment that the TN is live throughout.
(environment nil :type (or environment null)))
(def!method print-object ((tn tn) stream)
(print-unreadable-object (tn stream :type t)
(defstruct (global-conflicts
(:constructor make-global-conflicts (kind tn block number))
(:copier nil))
- ;; The IR2-Block that this structure represents the conflicts for.
+ ;; the IR2-Block that this structure represents the conflicts for
(block (required-argument) :type ir2-block)
- ;; Thread running through all the Global-Conflict for Block. This
- ;; thread is sorted by TN number.
+ ;; thread running through all the Global-Conflict for Block. This
+ ;; thread is sorted by TN number
(next nil :type (or global-conflicts null))
- ;; The way that TN is used by Block:
+ ;; the way that TN is used by Block
;;
;; :READ
;; The TN is read before it is written. It starts the block live,
;; :LIVE
;; The TN is not referenced. It is live everywhere in the block.
(kind :read-only :type (member :read :write :read-only :live))
- ;; A local conflicts vector representing conflicts with TNs live in
+ ;; a local conflicts vector representing conflicts with TNs live in
;; Block. The index for the local TN number of each TN we conflict
;; with in this block is 1. To find the full conflict set, the :Live
;; TNs for Block must also be included. This slot is not meaningful
:element-type 'bit
:initial-element 0)
:type local-tn-bit-vector)
- ;; The TN we are recording conflicts for.
+ ;; the TN we are recording conflicts for.
(tn (required-argument) :type tn)
- ;; Thread through all the Global-Conflicts for TN.
+ ;; thread through all the Global-Conflicts for TN
(tn-next nil :type (or global-conflicts null))
;; TN's local TN number in Block. :Live TNs don't have local numbers.
(number nil :type (or local-tn-number null)))
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.25"
+"0.pre7.27"
projects / sbcl.git / commitdiff