From: Christophe Rhodes Date: Mon, 9 Jun 2003 16:21:16 +0000 (+0000) Subject: 0.8.0.54: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2d4a0df3457bcd50916b33d374da592d8776db0a;p=sbcl.git 0.8.0.54: COMPILE-FILE and "static linking" ... we are allowed to consider references to functions defined in the same file as such. At present, we don't inline such references, but merely use previously-derived type information when compiling calls. ... also, since the consequences are undefined for multiple definitions in the same file, add a warning for that case (and fix the examples in the codebase itself :-) --- diff --git a/NEWS b/NEWS index e3cfa2c..4febc91 100644 --- a/NEWS +++ b/NEWS @@ -1776,6 +1776,10 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0: variables in the COMMON-LISP package, and will signal errors for most violations of these type constraints (where previously they were silently accepted). + * minor incompatible change: COMPILE-FILE now uses the freedom + afforded (ANSI 3.2.2.3) to use derived function types for + functions defined in the same file. This also permits the system + to warn on static type mismatches and function redefinition. * changes in type checking closed the following bugs: ** type checking of unused values (192b, 194d, 203); ** template selection based on unsafe type assertions (192c, 236); diff --git a/contrib/sb-simple-streams/cl.lisp b/contrib/sb-simple-streams/cl.lisp index c9b4603..0e00408 100644 --- a/contrib/sb-simple-streams/cl.lisp +++ b/contrib/sb-simple-streams/cl.lisp @@ -614,7 +614,7 @@ nil))) (defun (setf interactive-stream-p) (flag stream) - (etypecase stream + (typecase stream (simple-stream (if flag (add-stream-instance-flags stream :interactive) @@ -1058,18 +1058,6 @@ (progn (sb-impl::stream-must-be-associated-with-file stream) (funcall (sb-kernel:ansi-stream-misc stream) stream :file-length))))) -(defun line-length (&optional (stream *standard-output*)) - "Returns the number of characters that will fit on a line of output on the - given Stream, or Nil if that information is not available." - (let ((stream (sb-impl::out-synonym-of stream))) - (etypecase stream - (simple-stream - (%simple-stream-line-length stream)) - (ansi-stream - (funcall (sb-kernel:ansi-stream-misc stream) stream :line-length)) - (fundamental-stream - (sb-gray:stream-line-length stream))))) - (defun charpos (&optional (stream *standard-output*)) "Returns the number of characters on the current line of output of the given Stream, or Nil if that information is not availible." diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index 87d8939..2e41227 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -52,13 +52,7 @@ ;;; On any OS where we don't support foreign object file loading, any ;;; query of a foreign symbol value is answered with "no definition ;;; known", i.e. NIL. -;;; -;;; (On any OS which *does* support foreign object file loading, this -;;; placeholder implementation is overwritten by a subsequent real -;;; implementation.) -;;; -;;; You may want to use SB-SYS:FOREIGN-SYMBOL-ADDRESS instead of -;;; calling this directly; see code/target-load.lisp. +#-(or linux sunos FreeBSD OpenBSD) (defun get-dynamic-foreign-symbol-address (symbol) (declare (type simple-string symbol) (ignore symbol)) nil) diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp index 8802d7e..b4a1dbb 100644 --- a/src/compiler/ir1final.lisp +++ b/src/compiler/ir1final.lisp @@ -59,7 +59,8 @@ (let* ((leaf (functional-entry-fun fun)) (defined-ftype (definition-type leaf))) (setf (leaf-type leaf) defined-ftype) - (when (leaf-has-source-name-p leaf) + (when (and (leaf-has-source-name-p leaf) + (eq (leaf-source-name leaf) (functional-debug-name leaf))) (let ((source-name (leaf-source-name leaf))) (let* ((where (info :function :where-from source-name)) (*compiler-error-context* (lambda-bind (main-entry leaf))) @@ -86,7 +87,13 @@ (type-specifier declared-ftype) (type-specifier defined-ftype))))) (:defined - (setf (info :function :type source-name) defined-ftype))))))) + (setf (info :function :type source-name) defined-ftype))) + (when (fasl-output-p *compile-object*) + (if (member source-name *fun-names-in-this-file* :test #'equal) + (compiler-warn "~@" + source-name) + (push source-name *fun-names-in-this-file*))))))) (values)) ;;; Find all calls in COMPONENT to assumed functions and update the diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index ddca38e..fd5d1a2 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -49,6 +49,8 @@ gives non-ANSI, early-CMU-CL behavior. It can be useful for improving the efficiency of stable code.") +(defvar *fun-names-in-this-file* nil) + ;;; *ALLOW-DEBUG-CATCH-TAG* controls whether we should allow the ;;; insertion a (CATCH ...) around code to allow the debugger RETURN ;;; command to function. @@ -56,6 +58,13 @@ ;;;; namespace management utilities +(defun fun-lexically-notinline-p (name) + (let ((fun (lexenv-find name funs :test #'equal))) + ;; a declaration will trump a proclamation + (if (and fun (defined-fun-p fun)) + (eq (defined-fun-inlinep fun) :notinline) + (eq (info :function :inlinep name) :notinline)))) + ;;; Return a GLOBAL-VAR structure usable for referencing the global ;;; function NAME. (defun find-free-really-fun (name) @@ -72,13 +81,16 @@ ;; definedness at runtime, which is what matters. #-sb-xc-host (not (fboundp name))) (note-undefined-reference name :function)) - (make-global-var :kind :global-function - :%source-name name - :type (if (or *derive-function-types* - (eq where :declared)) - (info :function :type name) - (specifier-type 'function)) - :where-from where))) + (make-global-var + :kind :global-function + :%source-name name + :type (if (or *derive-function-types* + (eq where :declared) + (and (member name *fun-names-in-this-file* :test #'equal) + (not (fun-lexically-notinline-p name)))) + (info :function :type name) + (specifier-type 'function)) + :where-from where))) ;;; Has the *FREE-FUNS* entry FREE-FUN become invalid? ;;; @@ -154,7 +166,9 @@ :inline-expansion expansion :inlinep inlinep :where-from (info :function :where-from name) - :type (info :function :type name)) + :type (if (eq inlinep :notinline) + (specifier-type 'function) + (info :function :type name))) (find-free-really-fun name)))))))) ;;; Return the LEAF structure for the lexically apparent function @@ -996,13 +1010,16 @@ (make-lexenv :default res :vars (new-venv)) res))) -;;; Return a DEFINED-FUN which copies a GLOBAL-VAR but for its INLINEP. +;;; Return a DEFINED-FUN which copies a GLOBAL-VAR but for its INLINEP +;;; (and TYPE if notinline). (defun make-new-inlinep (var inlinep) (declare (type global-var var) (type inlinep inlinep)) (let ((res (make-defined-fun :%source-name (leaf-source-name var) :where-from (leaf-where-from var) - :type (leaf-type var) + :type (if (eq inlinep :notinline) + (specifier-type 'function) + (leaf-type var)) :inlinep inlinep))) (when (defined-fun-p var) (setf (defined-fun-inline-expansion res) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 77567cc..49d1b70 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -28,7 +28,7 @@ #!+sb-show *compiler-trace-output* *last-source-context* *last-original-source* *last-source-form* *last-format-string* *last-format-args* - *last-message-count* *lexenv*)) + *last-message-count* *lexenv* *fun-names-in-this-file*)) ;;; Whether call of a function which cannot be defined causes a full ;;; warning. @@ -139,9 +139,6 @@ (multiple-value-prog1 (funcall fn) (setf succeeded-p t)) (unless succeeded-p (incf *aborted-compilation-unit-count*))) - ;; FIXME: Now *COMPILER-FOO-COUNT* stuff is bound in more than - ;; one place. If we can get rid of the IR1 interpreter, this - ;; should be easier to clean up. (let ((*aborted-compilation-unit-count* 0) (*compiler-error-count* 0) (*compiler-warning-count* 0) @@ -1329,6 +1326,7 @@ (sb!xc:*compile-file-pathname* nil) (sb!xc:*compile-file-truename* nil) (*toplevel-lambdas* ()) + (*fun-names-in-this-file* ()) (*compiler-error-bailout* (lambda () (compiler-mumble "~2&; fatal error, aborting compilation~%") diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp index f4cab13..9a1f11e 100644 --- a/src/pcl/vector.lisp +++ b/src/pcl/vector.lisp @@ -1075,8 +1075,9 @@ req-args))) `(list* :fast-function - (named-lambda - ,(or (body-method-name body) '.method.) ; function name + (,(if (body-method-name body) 'named-lambda 'lambda) + ,@(when (body-method-name body) + (list (body-method-name body))) ; function name (.pv-cell. .next-method-call. ,@args+rest-arg) ; function args ;; body of the function (declare (ignorable .pv-cell. .next-method-call.)) diff --git a/tests/compiler.test.sh b/tests/compiler.test.sh new file mode 100644 index 0000000..409e0b9 --- /dev/null +++ b/tests/compiler.test.sh @@ -0,0 +1,174 @@ +#!/bin/sh + +# This software is part of the SBCL system. See the README file for +# more information. +# +# While most of SBCL is derived from the CMU CL system, the test +# files (like this one) were written from scratch after the fork +# from CMU CL. +# +# This software is in the public domain and is provided with +# absolutely no warranty. See the COPYING and CREDITS files for +# more information. + +# FIXME: the functions below should be in their own file, sourced by +# each of the *.test.sh scripts. + +# Check that compiling and loading the file $1 generates an error +# at load time; also that just loading it directly (into the +# interpreter) generates an error. +expect_load_error () +{ + # Test compiling and loading. + $SBCL < $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename < $tmpfilename <