From: William Harold Newman Date: Fri, 31 Aug 2001 17:59:39 +0000 (+0000) Subject: 0.pre7.27: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7ef5ec93744c7cc1c7a0280e46f8b42b74353713;p=sbcl.git 0.pre7.27: 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 --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index b52a520..310b466 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -754,12 +754,6 @@ retained, possibly temporariliy, because it might be used internally." ;; 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" diff --git a/src/assembly/alpha/arith.lisp b/src/assembly/alpha/arith.lisp index efa883f..364e183 100644 --- a/src/assembly/alpha/arith.lisp +++ b/src/assembly/alpha/arith.lisp @@ -1,4 +1,4 @@ -;;;; 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. diff --git a/src/code/debug.lisp b/src/code/debug.lisp index a5fd549..54099e0 100644 --- a/src/code/debug.lisp +++ b/src/code/debug.lisp @@ -194,7 +194,7 @@ Function and macro commands: (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)) @@ -208,7 +208,7 @@ Function and macro commands: (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 diff --git a/src/code/defsetfs.lisp b/src/code/defsetfs.lisp index e5c1db2..13e2992 100644 --- a/src/code/defsetfs.lisp +++ b/src/code/defsetfs.lisp @@ -111,7 +111,6 @@ #-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) diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 145dae3..e596852 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -16,14 +16,11 @@ ;;; 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 @@ -218,7 +215,17 @@ (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)) @@ -231,69 +238,77 @@ (#\\ (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") @@ -353,8 +368,14 @@ (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 "/")))) @@ -727,8 +748,7 @@ )) ;;; 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 @@ -915,18 +935,17 @@ 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 @@ -1028,27 +1047,25 @@ (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") diff --git a/src/code/pathname.lisp b/src/code/pathname.lisp index 1b221ff..67b442a 100644 --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -118,19 +118,3 @@ name type version)))) - -(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)))) - diff --git a/src/code/run-program.lisp b/src/code/run-program.lisp index 1dad7f9..1539001 100644 --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -601,9 +601,9 @@ ;; "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 diff --git a/src/code/symbol.lisp b/src/code/symbol.lisp index 600c6ce..f2c1c0c 100644 --- a/src/code/symbol.lisp +++ b/src/code/symbol.lisp @@ -151,9 +151,8 @@ (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)) @@ -173,8 +172,8 @@ (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)) diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp index a63916f..f1dfb0e 100644 --- a/src/code/target-pathname.lisp +++ b/src/code/target-pathname.lisp @@ -25,12 +25,10 @@ (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) @@ -417,13 +415,7 @@ ((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)) @@ -1055,168 +1047,6 @@ a host-structure or string." (frob %pathname-type) (frob %pathname-version)))))))) -;;;; 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))))))) - ;;;; logical pathname support. ANSI 92-102 specification. ;;;; ;;;; As logical-pathname translations are loaded they are diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 6977301..a1fe842 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -400,13 +400,13 @@ ;; 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 @@ -419,30 +419,30 @@ ;;; 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 @@ -539,7 +539,7 @@ ;; 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) @@ -696,42 +696,42 @@ ;;; 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. @@ -873,20 +873,20 @@ :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)) @@ -895,18 +895,18 @@ ;; 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 @@ -915,13 +915,13 @@ ;; 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) @@ -938,12 +938,12 @@ (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, @@ -961,7 +961,7 @@ ;; :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 @@ -970,9 +970,9 @@ :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))) diff --git a/version.lisp-expr b/version.lisp-expr index a04549c..e7457d9 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.pre7.25" +"0.pre7.27"