X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=19c2f8989602073d491e9cece39841107eebce9d;hb=4e3b57699314dbd3883470d9b196287b178f3e6d;hp=74832d6a943c06894f54b858d33679ecad878255;hpb=816248ab4fe04775879a7e5a5ce1b4c613afe9d5;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 74832d6..19c2f89 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -126,7 +126,7 @@ ;;; demanded a function. (defun find-free-fun (name context) (declare (string context)) - (declare (values global-var)) + #+nil (declare (values global-var)) (or (let ((old-free-fun (gethash name *free-funs*))) (and (not (invalid-free-fun-p old-free-fun)) old-free-fun)) @@ -172,7 +172,7 @@ ;;; information from the global environment and enter it in ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning. (defun find-free-var (name) - (declare (values (or leaf heap-alien-info))) + #+nil (declare (values (or leaf cons heap-alien-info))) ; see FIXME comment (unless (symbolp name) (compiler-error "Variable name is not a symbol: ~S." name)) (or (gethash name *free-vars*) @@ -185,6 +185,15 @@ (case kind (:alien (info :variable :alien-info name)) + ;; FIXME: The return value in this case should really be + ;; of type SB!C::LEAF. I don't feel too badly about it, + ;; because the MACRO idiom is scattered throughout this + ;; file, but it should be cleaned up so we're not + ;; throwing random conses around. --njf 2002-03-23 + (:macro + (let ((expansion (info :variable :macro-expansion name)) + (type (type-specifier (info :variable :type name)))) + `(MACRO . (the ,type ,expansion)))) (:constant (let ((value (info :variable :constant-value name))) (make-constant :value value @@ -204,7 +213,7 @@ (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)) + (def!constant list-to-hash-table-threshold 32)) (defun maybe-emit-make-load-forms (constant) (let ((things-processed nil) (count 0)) @@ -1178,7 +1187,6 @@ :where-from (leaf-where-from specvar) :specvar specvar))) (t - (note-lexical-binding name) (make-lambda-var :%source-name name))))) ;;; Make the default keyword for a &KEY arg, checking that the keyword @@ -1459,29 +1467,30 @@ (setf (node-lexenv bind) *lexenv*) (let ((cont1 (make-continuation)) - (cont2 (make-continuation))) + (cont2 (make-continuation)) + (revised-body (if (policy bind + (or (> safety + (max speed space)) + (= safety 3))) + ;; (Stuffing this in at IR1 level like + ;; this is pretty crude. And it's + ;; particularly inefficient to execute + ;; it on *every* LAMBDA, including + ;; LET-converted LAMBDAs. Improvements + ;; are welcome, but meanwhile, when + ;; SAFETY is high, it's still arguably + ;; an improvement over the old CMU CL + ;; approach of doing nothing (waiting + ;; for evolution to breed careful + ;; users:-). -- WHN) + `((%detect-stack-exhaustion) + ,@body) + body))) (continuation-starts-block cont1) (link-node-to-previous-continuation bind cont1) (use-continuation bind cont2) (ir1-convert-special-bindings cont2 result - (if (policy bind - (or (> safety - (max speed space)) - (= safety 3))) - ;; (Stuffing this in at IR1 level - ;; like this is pretty crude. And - ;; it's particularly inefficient - ;; to execute it on *every* LAMBDA, - ;; including LET-converted LAMBDAs. - ;; But when SAFETY is high, it's - ;; still arguably an improvement - ;; over the old CMU CL approach of - ;; doing nothing (proactively - ;; waiting for evolution to breed - ;; stronger programmers:-). -- WHN) - `((%detect-stack-exhaustion) - ,@body) - body) + revised-body aux-vars aux-vals (svars))) (let ((block (continuation-block result)))