X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1util.lisp;h=fd32077d92b1b21eb020b1d71d3f0667d3b3fb8e;hb=c713eb2b521b048ff2c927ec52b861787d289f85;hp=4328b58883f2c9e46f8a3c3ee2734f27be40a41e;hpb=1bfc464c657a8f4ad24ef612f76a38d8f6f1bbad;p=sbcl.git

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 4328b58..fd32077 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -36,7 +36,7 @@
   (declare (type cblock block1 block2) (type node node)
 	   (type (or cleanup null) cleanup))
   (setf (component-reanalyze (block-component block1)) t)
-  (with-ir1-environment node
+  (with-ir1-environment-from-node node
     (let* ((start (make-continuation))
 	   (block (continuation-starts-block start))
 	   (cont (make-continuation))
@@ -247,6 +247,9 @@
 (defun node-block (node)
   (declare (type node node))
   (the cblock (continuation-block (node-prev node))))
+(defun node-component (node)
+  (declare (type node node))
+  (block-component (node-block node)))
 (defun node-physenv (node)
   (declare (type node node))
   (the physenv (lambda-physenv (node-home-lambda node))))
@@ -372,7 +375,7 @@
 	((continuation-block cont)
 	 (block-home-lambda-or-null (continuation-block cont)))
 	(t
-	 (error "internal error: confused about home lambda for ~S"))))
+	 (bug "confused about home lambda for ~S"))))
 
 ;;; Return the LAMBDA that is CONT's home.
 (defun continuation-home-lambda (cont)
@@ -383,8 +386,7 @@
 ;;; slot values. Values for the alist slots are NCONCed to the
 ;;; beginning of the current value, rather than replacing it entirely.
 (defun make-lexenv (&key (default *lexenv*)
-			 functions variables blocks tags type-restrictions
-			 options
+			 funs vars blocks tags type-restrictions options
 			 (lambda (lexenv-lambda default))
 			 (cleanup (lexenv-cleanup default))
 			 (policy (lexenv-policy default)))
@@ -394,8 +396,8 @@
 		      (nconc ,var old)
 		      old))))
     (internal-make-lexenv
-     (frob functions lexenv-functions)
-     (frob variables lexenv-variables)
+     (frob funs lexenv-funs)
+     (frob vars lexenv-vars)
      (frob blocks lexenv-blocks)
      (frob tags lexenv-tags)
      (frob type-restrictions lexenv-type-restrictions)
@@ -945,8 +947,8 @@
 	(unless (policy *compiler-error-context* (= inhibit-warnings 3))
 	  ;; ANSI section "3.2.5 Exceptional Situations in the Compiler"
 	  ;; requires this to be no more than a STYLE-WARNING.
-	  (compiler-style-warning "The variable ~S is defined but never used."
-				  (leaf-debug-name var)))
+	  (compiler-style-warn "The variable ~S is defined but never used."
+			       (leaf-debug-name var)))
 	(setf (leaf-ever-used var) t)))) ; to avoid repeated warnings? -- WHN
   (values))
 
@@ -1009,8 +1011,8 @@
 				    (not (eq pkg (symbol-package :end))))))
 			 (not (member first *deletion-ignored-objects*))
 			 (not (typep first '(or fixnum character)))
-			 (every #'(lambda (x)
-				    (present-in-form first x 0))
+			 (every (lambda (x)
+				  (present-in-form first x 0))
 				(source-path-forms path))
 			 (present-in-form first (find-original-source path)
 					  0)))
@@ -1072,11 +1074,11 @@
 	     (aver (and succ (null (cdr succ))))
 	     (cond
 	      ((member block succ)
-	       (with-ir1-environment node
+	       (with-ir1-environment-from-node node
 		 (let ((exit (make-exit))
 		       (dummy (make-continuation)))
 		   (setf (continuation-next prev) nil)
-		   (prev-link exit prev)
+		   (link-node-to-previous-continuation exit prev)
 		   (add-continuation-use exit dummy)
 		   (setf (block-last block) exit)))
 	       (setf (node-prev node) nil)
@@ -1108,7 +1110,7 @@
 		     (not (block-delete-p block))))))))
 
 ;;; Delete all the blocks and functions in COMPONENT. We scan first
-;;; marking the blocks as delete-p to prevent weird stuff from being
+;;; marking the blocks as DELETE-P to prevent weird stuff from being
 ;;; triggered by deletion.
 (defun delete-component (component)
   (declare (type component component))
@@ -1135,7 +1137,7 @@
 ;;; of arguments changes, the transform must be prepared to return a
 ;;; lambda with a new lambda-list with the correct number of
 ;;; arguments.
-(defun extract-function-args (cont fun num-args)
+(defun extract-fun-args (cont fun num-args)
   #!+sb-doc
   "If CONT is a call to FUN with NUM-ARGS args, change those arguments
    to feed directly to the continuation-dest of CONT, which must be
@@ -1164,7 +1166,7 @@
 	  (setf (combination-args outside)
 		(append before-args inside-args after-args))
 	  (change-ref-leaf (continuation-use inside-fun)
-			   (find-free-function 'list "???"))
+			   (find-free-fun 'list "???"))
 	  (setf (combination-kind inside) :full)
 	  (setf (node-derived-type inside) *wild-type*)
 	  (flush-dest cont)
@@ -1194,8 +1196,8 @@
     (change-ref-leaf ref new-leaf))
   (values))
 
-;;; Like SUBSITUTE-LEAF, only there is a predicate on the REF to tell
-;;; whether to substitute.
+;;; like SUBSITUTE-LEAF, only there is a predicate on the REF to tell
+;;; whether to substitute
 (defun substitute-leaf-if (test new-leaf old-leaf)
   (declare (type leaf new-leaf old-leaf) (type function test))
   (dolist (ref (leaf-refs old-leaf))
@@ -1261,9 +1263,10 @@
 	     (t
 	      (return nil)))))))
 
-;;; Return true if function is an XEP. This is true of normal XEPs
-;;; (:EXTERNAL kind) and top level lambdas (:TOPLEVEL kind.)
-(defun external-entry-point-p (fun)
+;;; Return true if function is an external entry point. This is true
+;;; of normal XEPs (:EXTERNAL kind) and also of top level lambdas
+;;; (:TOPLEVEL kind.)
+(defun xep-p (fun)
   (declare (type functional fun))
   (not (null (member (functional-kind fun) '(:external :toplevel)))))
 
@@ -1353,7 +1356,7 @@
     (handler-case (apply function args)
       (error (condition)
 	(let ((*compiler-error-context* node))
-	  (compiler-warning "Lisp error during ~A:~%~A" context condition)
+	  (compiler-warn "Lisp error during ~A:~%~A" context condition)
 	  (return-from careful-call (values nil nil))))))
    t))