From: William Harold Newman Date: Mon, 15 Oct 2001 22:18:43 +0000 (+0000) Subject: 0.pre7.65: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=913e06f191acb65c1d99d42234704bec38500ff4;p=sbcl.git 0.pre7.65: tweaked things (making %COMPILER-DEFSTRUCT responsible for setting inline expansions) so that whenever INFO :FUNCTION :ACCESSOR-FOR is set the inline expansion always exists too defined NTH-WITH-SANE-ARG-ORDER to support future generalization of new DEFSTRUCT code to :TYPE LIST s/defined-function/defined-fun/ The manual can be formatted into HTML with openjade now, at least on my system, and probably also on other systems which use the same absolute filename for docbook.dsl as OpenBSD 2.9 does. --- diff --git a/NEWS b/NEWS index 962c9d2..ae8fda0 100644 --- a/NEWS +++ b/NEWS @@ -869,6 +869,15 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13: advantage of the new EVAL-WHEN stuff and to clean them up in general, and they are now more ANSI-compliant in a number of ways. Martin Atzmueller is responsible for a lot of this. +?? Inlining can now be controlled the ANSI way, without + MAYBE-INLINE, since the idiom + (DECLAIM (INLINE FOO)) + (DEFUN FOO (..) ..) + (DECLAIM (NOTINLINE FOO)) + (DEFUN BAR (..) (FOO ..)) + (DEFUN BLETCH (..) (DECLARE (INLINE FOO)) (FOO ..)) + now does what ANSI says it should. The CMU-CL-style + SB-EXT:MAYBE-INLINE declaration is now deprecated and ignored. * A bug in LOOP operations on hash tables has been fixed, thanks to a bug report and patch from Alexey Dejneka. * PPRINT-LOGICAL-BLOCK now copies the *PRINT-LINES* value on entry diff --git a/doc/sbcl-html.dsl b/doc/sbcl-html.dsl index d2e10ac..52dd375 100644 --- a/doc/sbcl-html.dsl +++ b/doc/sbcl-html.dsl @@ -19,11 +19,16 @@ at Carnegie Mellon University and released into the public domain. The software is in the public domain and is provided with absolutely no warranty. See the COPYING and CREDITS files for more information. +KLUDGE: The ENTITY docbook.dsl command is hardwired to the appropriate +location for my OpenBSD 2.9 system. There's got to be a more flexible +way to do it, but I'm not enough of an SGML guru to begin to guess +what it would be. (WHN 2001-10-15) + -- []> diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index a2c15c0..12c4056 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -721,6 +721,7 @@ retained, possibly temporariliy, because it might be used internally." "CONSTANTLY-T" "CONSTANTLY-NIL" "CONSTANTLY-0" "PSXHASH" "%BREAK" + "NTH-BUT-WITH-SANE-ARG-ORDER" ;; ..and macros.. "COLLECT" diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 8934602..9d0dd52 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -99,8 +99,10 @@ ;; option was given with no argument, or 0 if no PRINT-OBJECT option ;; was given (print-object 0 :type (or cons symbol (member 0))) - ;; the index of the raw data vector and the number of words in it. - ;; NIL and 0 if not allocated yet. + ;; the index of the raw data vector and the number of words in it, + ;; or NIL and 0 if not allocated (either because this structure + ;; has no raw slots, or because we're still parsing it and haven't + ;; run across any raw slots yet) (raw-index nil :type (or index null)) (raw-length 0 :type index) ;; the value of the :PURE option, or :UNSPECIFIED. This is only @@ -665,29 +667,29 @@ (t (values nil nil nil)))) -;;; Allocate storage for a DSD in DEFSTRUCT. This is where we decide -;;; whether a slot is raw or not. If raw, and we haven't allocated a -;;; raw-index yet for the raw data vector, then do it. Raw objects are -;;; aligned on the unit of their size. -(defun allocate-1-slot (defstruct dsd) +;;; Allocate storage for a DSD in DD. This is where we decide whether +;;; a slot is raw or not. If raw, and we haven't allocated a raw-index +;;; yet for the raw data vector, then do it. Raw objects are aligned +;;; on the unit of their size. +(defun allocate-1-slot (dd dsd) (multiple-value-bind (raw? raw-type words) - (if (eq (dd-type defstruct) 'structure) + (if (eq (dd-type dd) 'structure) (structure-raw-slot-type-and-size (dsd-type dsd)) (values nil nil nil)) (/noshow "ALLOCATE-1-SLOT" dsd raw? raw-type words) (cond ((not raw?) - (setf (dsd-index dsd) (dd-length defstruct)) - (incf (dd-length defstruct))) + (setf (dsd-index dsd) (dd-length dd)) + (incf (dd-length dd))) (t - (unless (dd-raw-index defstruct) - (setf (dd-raw-index defstruct) (dd-length defstruct)) - (incf (dd-length defstruct))) - (let ((off (rem (dd-raw-length defstruct) words))) + (unless (dd-raw-index dd) + (setf (dd-raw-index dd) (dd-length dd)) + (incf (dd-length dd))) + (let ((off (rem (dd-raw-length dd) words))) (unless (zerop off) - (incf (dd-raw-length defstruct) (- words off)))) + (incf (dd-raw-length dd) (- words off)))) (setf (dsd-raw-type dsd) raw-type) - (setf (dsd-index dsd) (dd-raw-length defstruct)) - (incf (dd-raw-length defstruct) words)))) + (setf (dsd-index dsd) (dd-raw-length dd)) + (incf (dd-raw-length dd) words)))) (values)) (defun typed-structure-info-or-lose (name) @@ -828,6 +830,56 @@ (values)) +;;; Return a form describing the writable place used for this slot +;;; in the instance named INSTANCE-NAME. +(defun %accessor-place-form (dd dsd instance-name) + (let (;; the operator that we'll use to access a typed slot or, in + ;; the case of a raw slot, to read the vector of raw slots + (ref (ecase (dd-type dd) + (structure '%instance-ref) + (funcallable-structure '%funcallable-instance-info) + (list 'nth-but-with-sane-arg-order) + (vector 'aref))) + (raw-type (dsd-raw-type dsd))) + (if (eq raw-type t) ; if not raw slot + `(,ref ,instance-name ,(dsd-index dsd)) + (let (;; the operator that we'll use to access one value in + ;; the raw data vector + (rawref (ecase raw-type + ;; The compiler thinks that the raw data + ;; vector is a vector of unsigned bytes, so if + ;; the slot we want to access actually *is* an + ;; unsigned byte, it'll access the slot for + ;; us even if we don't lie to it at all. + (unsigned-byte 'aref) + ;; "A lie can travel halfway round the world while + ;; the truth is putting on its shoes." -- Mark Twain + (single-float '%raw-ref-single) + (double-float '%raw-ref-double) + #!+long-float (long-float '%raw-ref-long) + (complex-single-float '%raw-ref-complex-single) + (complex-double-float '%raw-ref-complex-double) + #!+long-float (complex-long-float + '%raw-ref-complex-long)))) + `(,rawref (,ref ,instance-name ,(dd-raw-index dd)) + ,(dsd-index dsd)))))) + +;;; Return inline expansion designators (i.e. values suitable for +;;; (INFO :FUNCTION :INLINE-EXPANSSION-DESIGNATOR ..)) for the reader +;;; and writer functions of the slot described by DSD. +(defun accessor-inline-expansion-designators (dd dsd) + ;; ordinary tagged non-raw slot case + (values (lambda () + `(lambda (instance) + (declare (type ,(dd-name dd) instance)) + (truly-the ,(dsd-type dsd) + ,(%accessor-place-form dd dsd 'instance)))) + (lambda () + `(lambda (new-value instance) + (declare (type ,(dsd-type dsd) new-value)) + (declare (type ,(dd-name dd) structure-object)) + (setf ,(%accessor-place-form dd dsd 'instance) new-value))))) + ;;; Do (COMPILE LOAD EVAL)-time actions for the defstruct described by DD. (defun %compiler-defstruct (dd inherits) (declare (type defstruct-description dd)) @@ -849,7 +901,7 @@ (undefine-structure class) (subs (class-proper-name class))) (when (subs) - (warn "Removing old subclasses of ~S:~% ~S" + (warn "removing old subclasses of ~S:~% ~S" (sb!xc:class-name class) (subs)))))) (t @@ -871,18 +923,40 @@ (when copier (proclaim `(ftype (function (,name) ,name) ,copier)))) - (dolist (slot (dd-slots dd)) - (let* ((fun (dsd-accessor-name slot)) - (setf-fun `(setf ,fun))) - (when (and fun (eq (dsd-raw-type slot) t)) - (proclaim-as-defstruct-fun-name fun) - (setf (info :function :accessor-for fun) class) - (unless (dsd-read-only slot) - (proclaim-as-defstruct-fun-name setf-fun) - (setf (info :function :accessor-for setf-fun) class))))) + (dolist (dsd (dd-slots dd)) + (let* ((accessor-name (dsd-accessor-name dsd))) + (when accessor-name + + ;; new implementation sbcl-0.pre7.64 + (multiple-value-bind (reader-designator writer-designator) + (accessor-inline-expansion-designators dd dsd) + (setf (info :function + :inline-expansion-designator + accessor-name) + reader-designator + (info :function :inlinep accessor-name) + :inline) + (unless (dsd-read-only dsd) + (let ((setf-accessor-name `(setf ,accessor-name))) + (setf (info :function + :inline-expansion-designator + setf-accessor-name) + writer-designator + (info :function :inlinep setf-accessor-name) + :inline)))) + + ;; old code from before sbcl-0.pre7.64, will hopefully + ;; fade away and/or merge into new code above + (when (eq (dsd-raw-type dsd) t) ; when not raw slot + (proclaim-as-defstruct-fun-name accessor-name) + (setf (info :function :accessor-for accessor-name) class) + (unless (dsd-read-only dsd) + (proclaim-as-defstruct-fun-name `(setf ,accessor-name)) + (setf (info :function :accessor-for `(setf ,accessor-name)) + class)))))) ;; FIXME: Couldn't this logic be merged into - ;; PROCLAIM-AS-DEFSTRUCT-FUNCTION? + ;; PROCLAIM-AS-DEFSTRUCT-FUN-NAME? (when (boundp 'sb!c:*free-functions*) ; when compiling (let ((free-functions sb!c:*free-functions*)) (dolist (slot (dd-slots dd)) @@ -1077,9 +1151,9 @@ ;;;; slot accessors for raw slots ;;; Return info about how to read/write a slot in the value stored in -;;; OBJECT. This is also used by constructors (we can't use the -;;; accessor function, since some slots are read-only.) If supplied, -;;; DATA is a variable holding the raw-data vector. +;;; OBJECT. This is also used by constructors (since we can't safely +;;; use the accessor function, since some slots are read-only). If +;;; supplied, DATA is a variable holding the raw-data vector. ;;; ;;; returned values: ;;; 1. accessor function name (SETFable) diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp index 439c382..7663514 100644 --- a/src/code/early-extensions.lisp +++ b/src/code/early-extensions.lisp @@ -289,6 +289,15 @@ (declaim (inline neq)) (defun neq (x y) (not (eq x y))) + +;;; not really an old-fashioned function, but what the calling +;;; convention should've been: like NTH, but with the same argument +;;; order as in all the other dereferencing functions, with the +;;; collection first and the index second +(declaim (inline nth-but-with-sane-arg-order)) +(declaim (ftype (function (list index) t) nth-but-with-sane-arg-order)) +(defun nth-but-with-sane-arg-order (list index) + (nth index list)) ;;;; miscellaneous iteration extensions diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp index 6fc65d7..65b6efb 100644 --- a/src/code/early-setf.lisp +++ b/src/code/early-setf.lisp @@ -49,7 +49,7 @@ (let ((name (car form))) (dolist (x (sb!c::lexenv-functions environment)) (when (and (eq (car x) name) - (not (sb!c::defined-function-p (cdr x)))) + (not (sb!c::defined-fun-p (cdr x)))) (return t))))) (expand-or-get-setf-inverse form environment)) ((setq temp (info :setf :inverse (car form))) diff --git a/src/compiler/info-functions.lisp b/src/compiler/info-functions.lisp index 8384932..52be034 100644 --- a/src/compiler/info-functions.lisp +++ b/src/compiler/info-functions.lisp @@ -180,8 +180,8 @@ (let ((found (and env (cdr (assoc name (sb!c::lexenv-functions env) :test #'equal))))) - (unless (eq (cond ((sb!c::defined-function-p found) - (sb!c::defined-function-inlinep found)) + (unless (eq (cond ((sb!c::defined-fun-p found) + (sb!c::defined-fun-inlinep found)) (found :notinline) (t (info :function :inlinep name))) diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp index 2eab275..c894154 100644 --- a/src/compiler/ir1final.lisp +++ b/src/compiler/ir1final.lisp @@ -64,7 +64,7 @@ (let* ((where (info :function :where-from name)) (*compiler-error-context* (lambda-bind (main-entry leaf))) (global-def (gethash name *free-functions*)) - (global-p (defined-function-p global-def))) + (global-p (defined-fun-p global-def))) (note-name-defined name :function) (when global-p (remhash name *free-functions*)) @@ -95,8 +95,8 @@ ;;; types. (defun note-assumed-types (component name var) (when (and (eq (leaf-where-from var) :assumed) - (not (and (defined-function-p var) - (eq (defined-function-inlinep var) :notinline))) + (not (and (defined-fun-p var) + (eq (defined-fun-inlinep var) :notinline))) (eq (info :function :where-from name) :assumed) (eq (info :function :kind name) :function)) (let ((atype (info :function :assumed-type name))) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 2fdd9d9..0f02302 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -767,7 +767,7 @@ ;;; wondering if something should be done to special-case the call. If ;;; CALL is a call to a global function, then see whether it defined ;;; or known: -;;; -- If a DEFINED-FUNCTION should be inline expanded, then convert +;;; -- If a DEFINED-FUN should be inline expanded, then convert ;;; the expansion and change the call to call it. Expansion is ;;; enabled if :INLINE or if SPACE=0. If the FUNCTIONAL slot is ;;; true, we never expand, since this function has already been @@ -788,8 +788,8 @@ (declare (type combination call)) (let* ((ref (continuation-use (basic-combination-fun call))) (leaf (when (ref-p ref) (ref-leaf ref))) - (inlinep (if (defined-function-p leaf) - (defined-function-inlinep leaf) + (inlinep (if (defined-fun-p leaf) + (defined-fun-inlinep leaf) :no-chance))) (cond ((eq inlinep :notinline) (values nil nil)) @@ -800,17 +800,17 @@ (:inline t) (:no-chance nil) ((nil :maybe-inline) (policy call (zerop space)))) - (defined-function-inline-expansion leaf) - (let ((fun (defined-function-functional leaf))) + (defined-fun-inline-expansion leaf) + (let ((fun (defined-fun-functional leaf))) (or (not fun) (and (eq inlinep :inline) (functional-kind fun)))) (inline-expansion-ok call)) (flet ((frob () (let ((res (ir1-convert-lambda-for-defun - (defined-function-inline-expansion leaf) + (defined-fun-inline-expansion leaf) leaf t #'ir1-convert-inline-lambda))) - (setf (defined-function-functional leaf) res) + (setf (defined-fun-functional leaf) res) (change-ref-leaf ref res)))) (if ir1-p (frob) @@ -1158,8 +1158,8 @@ ((or constant functional) t) (lambda-var (null (lambda-var-sets leaf))) - (defined-function - (not (eq (defined-function-inlinep leaf) :notinline))) + (defined-fun + (not (eq (defined-fun-inlinep leaf) :notinline))) (global-var (case (global-var-kind leaf) (:global-function t) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 7ee6bdd..b61c8af 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -123,13 +123,16 @@ (inlinep (info :function :inlinep name))) (setf (gethash name *free-functions*) (if (or expansion inlinep) - (make-defined-function + (make-defined-fun :name name :inline-expansion expansion :inlinep inlinep :where-from (info :function :where-from name) :type (info :function :type name)) (let ((info (info :function :accessor-for name))) + (when info + (error "no expansion for ~S even though :ACCESSOR-FOR" + name)) (etypecase info (null (find-free-really-function name)) @@ -507,10 +510,10 @@ ;;; functional instead. (defun reference-leaf (start cont leaf) (declare (type continuation start cont) (type leaf leaf)) - (let* ((leaf (or (and (defined-function-p leaf) - (not (eq (defined-function-inlinep leaf) + (let* ((leaf (or (and (defined-fun-p leaf) + (not (eq (defined-fun-inlinep leaf) :notinline)) - (let ((fun (defined-function-functional leaf))) + (let ((fun (defined-fun-functional leaf))) (when (and fun (not (functional-kind fun))) (maybe-reanalyze-function fun)))) leaf)) @@ -576,7 +579,11 @@ (careful-expand-macro (info :function :macro-function fun) form))) ((nil :function) - (ir1-convert-srctran start cont (find-free-function fun "Eh?") form)))) + (ir1-convert-srctran start + cont + (find-free-function fun + "shouldn't happen! (no-cmacro)") + form)))) (defun muffle-warning-or-die () (muffle-warning) @@ -704,8 +711,8 @@ ;;; go to ok-combination conversion. (defun ir1-convert-srctran (start cont var form) (declare (type continuation start cont) (type global-var var)) - (let ((inlinep (when (defined-function-p var) - (defined-function-inlinep var)))) + (let ((inlinep (when (defined-fun-p var) + (defined-fun-inlinep var)))) (if (eq inlinep :notinline) (ir1-convert-combination start cont form var) (let ((transform (info :function :source-transform (leaf-name var)))) @@ -893,19 +900,19 @@ (make-lexenv :default res :variables (new-venv)) res))) -;;; Return a DEFINED-FUNCTION which copies a global-var but for its inlinep. +;;; Return a DEFINED-FUN which copies a GLOBAL-VAR but for its INLINEP. (defun make-new-inlinep (var inlinep) (declare (type global-var var) (type inlinep inlinep)) - (let ((res (make-defined-function + (let ((res (make-defined-fun :name (leaf-name var) :where-from (leaf-where-from var) :type (leaf-type var) :inlinep inlinep))) - (when (defined-function-p var) - (setf (defined-function-inline-expansion res) - (defined-function-inline-expansion var)) - (setf (defined-function-functional res) - (defined-function-functional var))) + (when (defined-fun-p var) + (setf (defined-fun-inline-expansion res) + (defined-fun-inline-expansion var)) + (setf (defined-fun-functional res) + (defined-fun-functional var))) res)) ;;; Parse an inline/notinline declaration. If it's a local function we're @@ -1832,17 +1839,17 @@ :policy (lexenv-policy *lexenv*)))) (ir1-convert-lambda `(lambda ,@body) name)))) -;;; Get a DEFINED-FUNCTION object for a function we are about to +;;; Get a DEFINED-FUN object for a function we are about to ;;; define. If the function has been forward referenced, then ;;; substitute for the previous references. -(defun get-defined-function (name) +(defun get-defined-fun (name) (let* ((name (proclaim-as-fun-name name)) - (found (find-free-function name "Eh?"))) + (found (find-free-function name "shouldn't happen! (defined-fun)"))) (note-name-defined name :function) - (cond ((not (defined-function-p found)) + (cond ((not (defined-fun-p found)) (aver (not (info :function :inlinep name))) (let* ((where-from (leaf-where-from found)) - (res (make-defined-function + (res (make-defined-fun :name name :where-from (if (eq where-from :declared) :declared :defined) @@ -1851,9 +1858,9 @@ (setf (gethash name *free-functions*) res))) ;; If *FREE-FUNCTIONS* has a previously converted definition ;; for this name, then blow it away and try again. - ((defined-function-functional found) + ((defined-fun-functional found) (remhash name *free-functions*) - (get-defined-function name)) + (get-defined-fun name)) (t found)))) ;;; Check a new global function definition for consistency with @@ -1899,19 +1906,19 @@ ;;; expansion. This prevents recursive inline expansion of ;;; opportunistic pseudo-inlines. (defun ir1-convert-lambda-for-defun (lambda var expansion converter) - (declare (cons lambda) (function converter) (type defined-function var)) - (let ((var-expansion (defined-function-inline-expansion var))) - (unless (eq (defined-function-inlinep var) :inline) - (setf (defined-function-inline-expansion var) nil)) + (declare (cons lambda) (function converter) (type defined-fun var)) + (let ((var-expansion (defined-fun-inline-expansion var))) + (unless (eq (defined-fun-inlinep var) :inline) + (setf (defined-fun-inline-expansion var) nil)) (let* ((name (leaf-name var)) (fun (funcall converter lambda name)) (function-info (info :function :info name))) - (setf (functional-inlinep fun) (defined-function-inlinep var)) + (setf (functional-inlinep fun) (defined-fun-inlinep var)) (assert-new-definition var fun) - (setf (defined-function-inline-expansion var) var-expansion) + (setf (defined-fun-inline-expansion var) var-expansion) ;; If definitely not an interpreter stub, then substitute for any ;; old references. - (unless (or (eq (defined-function-inlinep var) :notinline) + (unless (or (eq (defined-fun-inlinep var) :notinline) (not *block-compile*) (and function-info (or (function-info-transforms function-info) @@ -1920,7 +1927,7 @@ (substitute-leaf fun var) ;; If in a simple environment, then we can allow backward ;; references to this function from following top-level forms. - (when expansion (setf (defined-function-functional var) fun))) + (when expansion (setf (defined-fun-functional var) fun))) fun))) ;;; the even-at-compile-time part of DEFUN @@ -1929,22 +1936,21 @@ ;;; no inline expansion. (defun %compiler-defun (name lambda-with-lexenv) - (let ((defined-function nil)) ; will be set below if we're in the compiler + (let ((defined-fun nil)) ; will be set below if we're in the compiler - ;; when in the compiler - (when (boundp '*lexenv*) + (when (boundp '*lexenv*) ; when in the compiler (when sb!xc:*compile-print* (compiler-mumble "~&; recognizing DEFUN ~S~%" name)) (remhash name *free-functions*) - (setf defined-function (get-defined-function name))) + (setf defined-fun (get-defined-fun name))) (become-defined-fun-name name) (cond (lambda-with-lexenv (setf (info :function :inline-expansion-designator name) lambda-with-lexenv) - (when defined-function - (setf (defined-function-inline-expansion defined-function) + (when defined-fun + (setf (defined-fun-inline-expansion defined-fun) lambda-with-lexenv))) (t (clear-info :function :inline-expansion-designator name))) @@ -1952,9 +1958,9 @@ ;; old CMU CL comment: ;; If there is a type from a previous definition, blast it, ;; since it is obsolete. - (when (and defined-function - (eq (leaf-where-from defined-function) :defined)) - (setf (leaf-type defined-function) + (when (and defined-fun + (eq (leaf-where-from defined-fun) :defined)) + (setf (leaf-type defined-fun) ;; FIXME: If this is a block compilation thing, shouldn't ;; we be setting the type to the full derived type for the ;; definition, instead of this most general function type? diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index cf49747..95c7f2f 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -1213,8 +1213,8 @@ (let ((leaf (ref-leaf use))) (if (and (global-var-p leaf) (eq (global-var-kind leaf) :global-function) - (or (not (defined-function-p leaf)) - (not (eq (defined-function-inlinep leaf) :notinline)) + (or (not (defined-fun-p leaf)) + (not (eq (defined-fun-inlinep leaf) :notinline)) notinline-ok)) (leaf-name leaf) nil)) diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 37b9ca6..0726e52 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -22,7 +22,7 @@ (functions variables blocks tags type-restrictions lambda cleanup policy options))) ;; an alist of (NAME . WHAT), where WHAT is either a FUNCTIONAL (a - ;; local function), a DEFINED-FUNCTION, representing an + ;; local function), a DEFINED-FUN, representing an ;; INLINE/NOTINLINE declaration, or a list (MACRO . ) (a ;; local macro, with the specifier expander). Note that NAME may be ;; a (SETF ) list, not necessarily a single symbol. diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index a882a25..9e8d992 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -652,24 +652,24 @@ for slot) -;;; The DEFINED-FUNCTION structure represents functions that are -;;; defined in the same compilation block, or that have inline -;;; expansions, or have a non-NIL INLINEP value. Whenever we change -;;; the INLINEP state (i.e. an inline proclamation) we copy the -;;; structure so that former INLINEP values are preserved. -(def!struct (defined-function (:include global-var - (where-from :defined) - (kind :global-function))) +;;; A DEFINED-FUN represents a function that is defined in the same +;;; compilation block, or that has an inline expansion, or that has a +;;; non-NIL INLINEP value. Whenever we change the INLINEP state (i.e. +;;; an inline proclamation) we copy the structure so that former +;;; INLINEP values are preserved. +(def!struct (defined-fun (:include global-var + (where-from :defined) + (kind :global-function))) ;; The values of INLINEP and INLINE-EXPANSION initialized from the ;; global environment. (inlinep nil :type inlinep) (inline-expansion nil :type (or cons null)) - ;; The block-local definition of this function (either because it - ;; was semi-inline, or because it was defined in this block.) If + ;; the block-local definition of this function (either because it + ;; was semi-inline, or because it was defined in this block). If ;; this function is not an entry point, then this may be deleted or - ;; let-converted. Null if we haven't converted the expansion yet. + ;; LET-converted. Null if we haven't converted the expansion yet. (functional nil :type (or functional null))) -(defprinter (defined-function :identity t) +(defprinter (defined-fun :identity t) name inlinep (functional :test functional)) @@ -682,8 +682,8 @@ (def!struct (functional (:include leaf (where-from :defined) (type (specifier-type 'function)))) - ;; Some information about how this function is used. These values are - ;; meaningful: + ;; some information about how this function is used. These values + ;; are meaningful: ;; ;; NIL ;; an ordinary function, callable using local call diff --git a/version.lisp-expr b/version.lisp-expr index caa3202..e776cb8 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.64" +"0.pre7.65"