Menu
▾
▴
[Sbcl-commits] master: Checkpoint
|
From: Douglas K. <sn...@us...> - 2015-07-09 14:11:14
|
The branch "master" has been updated in SBCL:
via 9eb0f5b26d6e583a3ceb9a2ae02703677905da45 (commit)
from 0ece72612d60d34925929e9c8433bd6b4e575e7b (commit)
- Log -----------------------------------------------------------------
commit 9eb0f5b26d6e583a3ceb9a2ae02703677905da45
Author: Douglas Katzman <do...@go...>
Date: Wed Jul 8 22:40:21 2015 -0400
Checkpoint
---
build-order.lisp-expr | 7 +-
src/compiler/assem.lisp | 20 ------
src/compiler/early-assem.lisp | 20 ++++++
src/compiler/early-c.lisp | 17 +++++
src/compiler/info-functions.lisp | 5 --
src/compiler/node.lisp | 134 +++++++++++++++++++++++---------------
src/compiler/vop.lisp | 42 ------------
7 files changed, 122 insertions(+), 123 deletions(-)
diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 2a50fba..6ca2c12 100644
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -337,6 +337,10 @@
;; for e.g. BLOCK-ANNOTATION, needed by "compiler/vop"
("src/compiler/node")
+ ;; This has ASSEMBLY-UNIT-related stuff needed by core.lisp.
+ ;; and LABEL, needed by IR2-NLX-INFO
+ ("src/compiler/early-assem")
+
;; for e.g. PRIMITIVE-TYPE, needed by "vmdef"
("src/compiler/vop")
@@ -471,9 +475,6 @@
("src/compiler/bit-util")
- ;; This has ASSEMBLY-UNIT-related stuff needed by core.lisp.
- ("src/compiler/early-assem")
-
;; core.lisp contains DEFSTRUCT CORE-OBJECT, and "compiler/main.lisp"
;; does lots of (TYPEP FOO 'CORE-OBJECT), so it's nice to compile this
;; before "compiler/main.lisp" so that those can be coded efficiently
diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp
index 23354db..5856a24 100644
--- a/src/compiler/assem.lisp
+++ b/src/compiler/assem.lisp
@@ -679,26 +679,6 @@
;;;; structure used during output emission
-;;; common supertype for all the different kinds of annotations
-(def!struct (annotation (:constructor nil)
- (:copier nil))
- ;; Where in the raw output stream was this annotation emitted?
- (index 0 :type index)
- ;; What position does that correspond to?
- (posn nil :type (or index null)))
-
-(def!struct (label (:include annotation)
- (:constructor gen-label ())
- (:copier nil))
- ;; (doesn't need any additional information beyond what is in the
- ;; annotation structure)
- )
-(sb!int:def!method print-object ((label label) stream)
- (if (or *print-escape* *print-readably*)
- (print-unreadable-object (label stream :type t)
- (prin1 (sb!c:label-id label) stream))
- (format stream "L~D" (sb!c:label-id label))))
-
;;; a constraint on how the output stream must be aligned
(def!struct (alignment-note (:include annotation)
(:conc-name alignment-)
diff --git a/src/compiler/early-assem.lisp b/src/compiler/early-assem.lisp
index 317b100..f2bb43c 100644
--- a/src/compiler/early-assem.lisp
+++ b/src/compiler/early-assem.lisp
@@ -49,3 +49,23 @@
(def!type alignment ()
`(integer 0 ,max-alignment))
+
+;;; common supertype for all the different kinds of annotations
+(def!struct (annotation (:constructor nil)
+ (:copier nil))
+ ;; Where in the raw output stream was this annotation emitted?
+ (index 0 :type index)
+ ;; What position does that correspond to?
+ (posn nil :type (or index null)))
+
+(def!struct (label (:include annotation)
+ (:constructor gen-label ())
+ (:copier nil))
+ ;; (doesn't need any additional information beyond what is in the
+ ;; annotation structure)
+ )
+(sb!int:def!method print-object ((label label) stream)
+ (if (or *print-escape* *print-readably*)
+ (print-unreadable-object (label stream :type t)
+ (prin1 (sb!c:label-id label) stream))
+ (format stream "L~D" (sb!c:label-id label))))
diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
index f1b24d5..856a0e8 100644
--- a/src/compiler/early-c.lisp
+++ b/src/compiler/early-c.lisp
@@ -163,6 +163,23 @@ the stack without triggering overflow protection.")
(declaim (fixnum *type-cache-nonce*))
(!defglobal *type-cache-nonce* 0)
+(def!struct (undefined-warning
+ #-no-ansi-print-object
+ (:print-object (lambda (x s)
+ (print-unreadable-object (x s :type t)
+ (prin1 (undefined-warning-name x) s))))
+ (:copier nil))
+ ;; the name of the unknown thing
+ (name nil :type (or symbol list))
+ ;; the kind of reference to NAME
+ (kind (missing-arg) :type (member :function :type :variable))
+ ;; the number of times this thing was used
+ (count 0 :type unsigned-byte)
+ ;; a list of COMPILER-ERROR-CONTEXT structures describing places
+ ;; where this thing was used. Note that we only record the first
+ ;; *UNDEFINED-WARNING-LIMIT* calls.
+ (warnings () :type list))
+
;;; Delete any undefined warnings for NAME and KIND. This is for the
;;; benefit of the compiler, but it's sometimes called from stuff like
;;; type-defining code which isn't logically part of the compiler.
diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp
index 79cd2cb..7879a0a 100644
--- a/src/compiler/info-functions.lisp
+++ b/src/compiler/info-functions.lisp
@@ -190,11 +190,6 @@ only."
:name symbol))
fun-name)))
-(defun fun-locally-defined-p (name env)
- (and env
- (let ((fun (cdr (assoc name (lexenv-funs env) :test #'equal))))
- (and fun (not (global-var-p fun))))))
-
(defun sb!xc:compiler-macro-function (name &optional env)
#!+sb-doc
"If NAME names a compiler-macro in ENV, return the expansion function, else
diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index e946410..95a9604 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -192,6 +192,48 @@
(defattr block-type-asserted)
(defattr block-test-modified))
+(defstruct (cloop (:conc-name loop-)
+ (:predicate loop-p)
+ (:constructor make-loop)
+ (:copier copy-loop))
+ ;; The kind of loop that this is. These values are legal:
+ ;;
+ ;; :OUTER
+ ;; This is the outermost loop structure, and represents all the
+ ;; code in a component.
+ ;;
+ ;; :NATURAL
+ ;; A normal loop with only one entry.
+ ;;
+ ;; :STRANGE
+ ;; A segment of a "strange loop" in a non-reducible flow graph.
+ (kind (missing-arg) :type (member :outer :natural :strange))
+ ;; The first and last blocks in the loop. There may be more than one tail,
+ ;; since there may be multiple back branches to the same head.
+ (head nil :type (or cblock null))
+ (tail nil :type list)
+ ;; A list of all the blocks in this loop or its inferiors that have a
+ ;; successor outside of the loop.
+ (exits nil :type list)
+ ;; The loop that this loop is nested within. This is null in the outermost
+ ;; loop structure.
+ (superior nil :type (or cloop null))
+ ;; A list of the loops nested directly within this one.
+ (inferiors nil :type list)
+ (depth 0 :type fixnum)
+ ;; The head of the list of blocks directly within this loop. We must recurse
+ ;; on INFERIORS to find all the blocks.
+ (blocks nil :type (or null cblock))
+ ;; Backend saves the first emitted block of each loop here.
+ (info nil))
+
+(defprinter (cloop :conc-name loop-)
+ kind
+ head
+ tail
+ exits
+ depth)
+
;;; The CBLOCK structure represents a basic block. We include
;;; SSET-ELEMENT so that we can have sets of blocks. Initially the
;;; SSET-ELEMENT-NUMBER is null, DFO analysis numbers in reverse DFO.
@@ -418,25 +460,6 @@
;; IR1-FINALIZE hasn't happened yet?
(aver (not (eql (component-info component) :dead))))
-;;; Before sbcl-0.7.0, there were :TOPLEVEL things which were magical
-;;; in multiple ways. That's since been refactored into the orthogonal
-;;; properties "optimized for locall with no arguments" and "externally
-;;; visible/referenced (so don't delete it)". The code <0.7.0 did a lot
-;;; of tests a la (EQ KIND :TOP_LEVEL) in the "don't delete it?" sense;
-;;; this function is a sort of literal translation of those tests into
-;;; the new world.
-;;;
-;;; FIXME: After things settle down, bare :TOPLEVEL might go away, at
-;;; which time it might be possible to replace the COMPONENT-KIND
-;;; :TOPLEVEL mess with a flag COMPONENT-HAS-EXTERNAL-REFERENCES-P
-;;; along the lines of FUNCTIONAL-HAS-EXTERNAL-REFERENCES-P.
-(defun lambda-toplevelish-p (clambda)
- (or (eql (lambda-kind clambda) :toplevel)
- (lambda-has-external-references-p clambda)))
-(defun component-toplevelish-p (component)
- (member (component-kind component)
- '(:toplevel :complex-toplevel)))
-
;;; A CLEANUP structure represents some dynamic binding action. Blocks
;;; are annotated with the current CLEANUP so that dynamic bindings
;;; can be removed when control is transferred out of the binding
@@ -660,21 +683,6 @@
(defun leaf-source-name (leaf)
(aver (leaf-has-source-name-p leaf))
(leaf-%source-name leaf))
-(defun leaf-debug-name (leaf)
- (if (functional-p leaf)
- ;; FUNCTIONALs have additional %DEBUG-NAME behavior.
- (functional-debug-name leaf)
- ;; Other objects just use their source name.
- ;;
- ;; (As of sbcl-0.pre7.85, there are a few non-FUNCTIONAL
- ;; anonymous objects, (anonymous constants..) and those would
- ;; fail here if we ever tried to get debug names from them, but
- ;; it looks as though it's never interesting to get debug names
- ;; from them, so it's moot. -- WHN)
- (leaf-source-name leaf)))
-(defun leaf-%debug-name (leaf)
- (when (functional-p leaf)
- (functional-%debug-name leaf)))
;;; The CONSTANT structure is used to represent known constant values.
;;; Since the same constant leaf may be shared between named and anonymous
@@ -712,6 +720,10 @@
(defined-type :test (not (eq defined-type *universal-type*)))
(where-from :test (not (eq where-from :assumed)))
kind)
+(defun fun-locally-defined-p (name env)
+ (and env
+ (let ((fun (cdr (assoc name (lexenv-funs env) :test #'equal))))
+ (and fun (not (global-var-p fun))))))
;;; A DEFINED-FUN represents a function that is defined in the same
;;; compilation block, or that has an inline expansion, or that has a
@@ -895,6 +907,22 @@
%debug-name
#!+sb-show id)
+(defun leaf-debug-name (leaf)
+ (if (functional-p leaf)
+ ;; FUNCTIONALs have additional %DEBUG-NAME behavior.
+ (functional-debug-name leaf)
+ ;; Other objects just use their source name.
+ ;;
+ ;; (As of sbcl-0.pre7.85, there are a few non-FUNCTIONAL
+ ;; anonymous objects, (anonymous constants..) and those would
+ ;; fail here if we ever tried to get debug names from them, but
+ ;; it looks as though it's never interesting to get debug names
+ ;; from them, so it's moot. -- WHN)
+ (leaf-source-name leaf)))
+(defun leaf-%debug-name (leaf)
+ (when (functional-p leaf)
+ (functional-%debug-name leaf)))
+
;;; Is FUNCTIONAL LET-converted? (where we're indifferent to whether
;;; it returns one value or multiple values)
(defun functional-letlike-p (functional)
@@ -1003,6 +1031,25 @@
(where-from :test (not (eq where-from :assumed)))
(vars :prin1 (mapcar #'leaf-source-name vars)))
+;;; Before sbcl-0.7.0, there were :TOPLEVEL things which were magical
+;;; in multiple ways. That's since been refactored into the orthogonal
+;;; properties "optimized for locall with no arguments" and "externally
+;;; visible/referenced (so don't delete it)". The code <0.7.0 did a lot
+;;; of tests a la (EQ KIND :TOP_LEVEL) in the "don't delete it?" sense;
+;;; this function is a sort of literal translation of those tests into
+;;; the new world.
+;;;
+;;; FIXME: After things settle down, bare :TOPLEVEL might go away, at
+;;; which time it might be possible to replace the COMPONENT-KIND
+;;; :TOPLEVEL mess with a flag COMPONENT-HAS-EXTERNAL-REFERENCES-P
+;;; along the lines of FUNCTIONAL-HAS-EXTERNAL-REFERENCES-P.
+(defun lambda-toplevelish-p (clambda)
+ (or (eql (lambda-kind clambda) :toplevel)
+ (lambda-has-external-references-p clambda)))
+(defun component-toplevelish-p (component)
+ (member (component-kind component)
+ '(:toplevel :complex-toplevel)))
+
;;; The OPTIONAL-DISPATCH leaf is used to represent hairy lambdas. It
;;; is a FUNCTIONAL, like LAMBDA. Each legal number of arguments has a
;;; function which is called when that number of arguments is passed.
@@ -1409,25 +1456,6 @@
(entry :test entry)
(value :test value))
-;;;; miscellaneous IR1 structures
-
-(def!struct (undefined-warning
- #-no-ansi-print-object
- (:print-object (lambda (x s)
- (print-unreadable-object (x s :type t)
- (prin1 (undefined-warning-name x) s))))
- (:copier nil))
- ;; the name of the unknown thing
- (name nil :type (or symbol list))
- ;; the kind of reference to NAME
- (kind (missing-arg) :type (member :function :type :variable))
- ;; the number of times this thing was used
- (count 0 :type unsigned-byte)
- ;; a list of COMPILER-ERROR-CONTEXT structures describing places
- ;; where this thing was used. Note that we only record the first
- ;; *UNDEFINED-WARNING-LIMIT* calls.
- (warnings () :type list))
-
;;; a helper for the POLICY macro, defined late here so that the
;;; various type tests can be inlined
;;; You might think that NIL as a policy becomes *POLICY*,
diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index 64dc5ac..e86c63f 100644
--- a/src/compiler/vop.lisp
+++ b/src/compiler/vop.lisp
@@ -424,48 +424,6 @@
home
save-sp
dynamic-state)
-
-(defstruct (cloop (:conc-name loop-)
- (:predicate loop-p)
- (:constructor make-loop)
- (:copier copy-loop))
- ;; The kind of loop that this is. These values are legal:
- ;;
- ;; :OUTER
- ;; This is the outermost loop structure, and represents all the
- ;; code in a component.
- ;;
- ;; :NATURAL
- ;; A normal loop with only one entry.
- ;;
- ;; :STRANGE
- ;; A segment of a "strange loop" in a non-reducible flow graph.
- (kind (missing-arg) :type (member :outer :natural :strange))
- ;; The first and last blocks in the loop. There may be more than one tail,
- ;; since there may be multiple back branches to the same head.
- (head nil :type (or cblock null))
- (tail nil :type list)
- ;; A list of all the blocks in this loop or its inferiors that have a
- ;; successor outside of the loop.
- (exits nil :type list)
- ;; The loop that this loop is nested within. This is null in the outermost
- ;; loop structure.
- (superior nil :type (or cloop null))
- ;; A list of the loops nested directly within this one.
- (inferiors nil :type list)
- (depth 0 :type fixnum)
- ;; The head of the list of blocks directly within this loop. We must recurse
- ;; on INFERIORS to find all the blocks.
- (blocks nil :type (or null cblock))
- ;; Backend saves the first emitted block of each loop here.
- (info nil))
-
-(defprinter (cloop :conc-name loop-)
- kind
- head
- tail
- exits
- depth)
;;;; VOPs and templates
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
|