X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fir1tran.lisp;h=bd62c93c0b2499317c8f81a9f120dd960cae99df;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=fdb8a02940bb8231730dffdcb3c8b4fe3505a308;hpb=985c2d805428e1bbc479524fc955da5028d3e66e;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index fdb8a02..bd62c93 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -42,32 +42,12 @@ (declaim (list *current-path*)) (defvar *current-path* nil) -;;; *CONVERTING-FOR-INTERPRETER* is true when we are creating IR1 to -;;; be interpreted rather than compiled. This inhibits source -;;; tranformations and stuff. -(defvar *converting-for-interpreter* nil) -;;; FIXME: Rename to *IR1-FOR-INTERPRETER-NOT-COMPILER-P*. - -;;; *COMPILE-TIME-DEFINE-MACROS* is true when we want DEFMACRO -;;; definitions to be installed in the compilation environment as -;;; interpreted functions. We set this to false when compiling some -;;; parts of the system. -(defvar *compile-time-define-macros* t) -;;; FIXME: I think this can go away with the new system. - -;;; FIXME: This nastiness was one of my original motivations to start -;;; hacking CMU CL. The non-ANSI behavior can be useful, but it should -;;; be made not the default, and perhaps should be controlled by -;;; DECLAIM instead of a variable like this. And whether or not this -;;; kind of checking is on, declarations should be assertions to the -;;; extent practical, and code which can't be compiled efficiently -;;; while adhering to that principle should give warnings. -(defvar *derive-function-types* t - #!+sb-doc - "(Caution: Soon, this might change its semantics somewhat, or even go away.) - If true, argument and result type information derived from compilation of - DEFUNs is used when compiling calls to that function. If false, only - information from FTYPE proclamations will be used.") +(defvar *derive-function-types* nil + "Should the compiler assume that function types will never change, + so that it can use type information inferred from current definitions + to optimize code which uses those definitions? Setting this true + gives non-ANSI, early-CMU-CL behavior. It can be useful for improving + the efficiency of stable code.") ;;;; namespace management utilities @@ -79,7 +59,13 @@ (setf (info :function :where-from name) :assumed)) (let ((where (info :function :where-from name))) - (when (eq where :assumed) + (when (and (eq where :assumed) + ;; In the ordinary target Lisp, it's silly to report + ;; undefinedness when the function is defined in the + ;; running Lisp. But at cross-compile time, the current + ;; definedness of a function is irrelevant to the + ;; definedness at runtime, which is what matters. + #-sb-xc-host (not (fboundp name))) (note-undefined-reference name :function)) (make-global-var :kind :global-function :name name @@ -100,7 +86,8 @@ (slot (find accessor (dd-slots info) :key #'sb!kernel:dsd-accessor)) (type (dd-name info)) (slot-type (dsd-type slot))) - (assert slot () "Can't find slot ~S." type) + (unless slot + (error "can't find slot ~S" type)) (make-slot-accessor :name name :type (specifier-type @@ -162,7 +149,7 @@ (let ((var (lexenv-find name functions :test #'equal))) (cond (var (unless (leaf-p var) - (assert (and (consp var) (eq (car var) 'macro))) + (aver (and (consp var) (eq (car var) 'macro))) (compiler-error "found macro name ~S ~A" name context)) var) (t @@ -204,7 +191,10 @@ ;;; processed with MAKE-LOAD-FORM. We have to be careful, because ;;; CONSTANT might be circular. We also check that the constant (and ;;; any subparts) are dumpable at all. -(defconstant list-to-hash-table-threshold 32) +(eval-when (:compile-toplevel :load-toplevel :execute) + ;; The EVAL-WHEN is necessary for #.(1+ LIST-TO-HASH-TABLE-THRESHOLD) + ;; below. -- AL 20010227 + (defconstant list-to-hash-table-threshold 32)) (defun maybe-emit-make-load-forms (constant) (let ((things-processed nil) (count 0)) @@ -280,7 +270,7 @@ #!-sb-fluid (declaim (inline prev-link)) (defun prev-link (node cont) (declare (type node node) (type continuation cont)) - (assert (not (continuation-next cont))) + (aver (not (continuation-next cont))) (setf (continuation-next cont) node) (setf (node-prev node) cont)) @@ -311,15 +301,15 @@ (declare (type node node) (type continuation cont) (inline member)) (let ((block (continuation-block cont)) (node-block (continuation-block (node-prev node)))) - (assert (eq (continuation-kind cont) :block-start)) - (assert (not (block-last node-block)) () "~S has already ended." - node-block) + (aver (eq (continuation-kind cont) :block-start)) + (when (block-last node-block) + (error "~S has already ended." node-block)) (setf (block-last node-block) node) - (assert (null (block-succ node-block)) () "~S already has successors." - node-block) + (when (block-succ node-block) + (error "~S already has successors." node-block)) (setf (block-succ node-block) (list block)) - (assert (not (member node-block (block-pred block) :test #'eq)) () - "~S is already a predecessor of ~S." node-block block) + (when (memq node-block (block-pred block)) + (error "~S is already a predecessor of ~S." node-block block)) (push node-block (block-pred block)) (add-continuation-use node cont) (unless (eq (continuation-asserted-type cont) *wild-type*) @@ -379,7 +369,7 @@ ;;; This function is called on freshly read forms to record the ;;; initial location of each form (and subform.) Form is the form to -;;; find the paths in, and TLF-Num is the top-level form number of the +;;; find the paths in, and TLF-NUM is the top-level form number of the ;;; truly top-level form. ;;; ;;; This gets a bit interesting when the source code is circular. This @@ -427,8 +417,8 @@ `(block ,skip (catch 'ir1-error-abort (let ((*compiler-error-bailout* - #'(lambda () - (throw 'ir1-error-abort nil)))) + (lambda () + (throw 'ir1-error-abort nil)))) ,@body (return-from ,skip nil))) (ir1-convert ,start ,cont ,proxy))))) @@ -469,8 +459,8 @@ (global-var (ir1-convert-srctran start cont lexical-def form)) (t - (assert (and (consp lexical-def) - (eq (car lexical-def) 'macro))) + (aver (and (consp lexical-def) + (eq (car lexical-def) 'macro))) (ir1-convert start cont (careful-expand-macro (cdr lexical-def) form)))))) @@ -484,7 +474,7 @@ (values)) ;; Generate a reference to a manifest constant, creating a new leaf - ;; if necessary. If we are producing a fasl-file, make sure that + ;; if necessary. If we are producing a fasl file, make sure that ;; MAKE-LOAD-FORM gets used on any parts of the constant that it ;; needs to be. (defun reference-constant (start cont value) @@ -545,7 +535,7 @@ (compiler-style-warning "reading an ignored variable: ~S" name)) (reference-leaf start cont var)) (cons - (assert (eq (car var) 'MACRO)) + (aver (eq (car var) 'MACRO)) (ir1-convert start cont (cdr var))) (heap-alien-info (ir1-convert start cont `(%heap-alien ',var))))) @@ -559,8 +549,9 @@ (translator (info :function :ir1-convert fun)) (cmacro (info :function :compiler-macro-function fun))) (cond (translator (funcall translator start cont form)) - ((and cmacro (not *converting-for-interpreter*) - (not (eq (info :function :inlinep fun) :notinline))) + ((and cmacro + (not (eq (info :function :inlinep fun) + :notinline))) (let ((res (careful-expand-macro cmacro form))) (if (eq res form) (ir1-convert-global-functoid-no-cmacro start cont form fun) @@ -589,7 +580,8 @@ (muffle-warning) (error "internal error -- no MUFFLE-WARNING restart")) -;;; Trap errors during the macroexpansion. +;;; Expand FORM using the macro whose MACRO-FUNCTION is FUN, trapping +;;; errors which occur during the macroexpansion. (defun careful-expand-macro (fun form) (handler-bind (;; When cross-compiling, we can get style warnings ;; about e.g. undefined functions. An unhandled @@ -705,32 +697,26 @@ ;;; Convert a call to a global function. If not :NOTINLINE, then we do ;;; source transforms and try out any inline expansion. If there is no -;;; expansion, but is :INLINE, then give an efficiency note (unless a known -;;; function which will quite possibly be open-coded.) Next, we go to -;;; ok-combination conversion. +;;; expansion, but is :INLINE, then give an efficiency note (unless a +;;; known function which will quite possibly be open-coded.) Next, we +;;; 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)))) - (cond - ((eq inlinep :notinline) - (ir1-convert-combination start cont form var)) - (*converting-for-interpreter* - (ir1-convert-combination-checking-type start cont form var)) - (t - (let ((transform (info :function :source-transform (leaf-name var)))) - (cond - (transform - (multiple-value-bind (result pass) (funcall transform form) - (if pass - (ir1-convert-maybe-predicate start cont form var) - (ir1-convert start cont result)))) - (t - (ir1-convert-maybe-predicate start cont form var)))))))) - -;;; If the function has the Predicate attribute, and the CONT's DEST isn't -;;; an IF, then we convert (IF