diff --git a/src/cmp/cmpenv-api.lsp b/src/cmp/cmpenv-api.lsp index bc1fad6b2..8f4aed3fe 100644 --- a/src/cmp/cmpenv-api.lsp +++ b/src/cmp/cmpenv-api.lsp @@ -156,7 +156,15 @@ that are susceptible to be changed by PROCLAIM." (defun cmp-env-search-macro (name &optional (env *cmp-env*)) (let ((f (cmp-env-search-function name env))) - (if (functionp f) f nil))) + (if (functionp f) + f + nil))) + +;;; Like macro-function except it searches the lexical environment, +;;; to determine if the macro is shadowed by a function or a macro. +(defun cmp-macro-function (name) + (or (cmp-env-search-macro name) + (macro-function name))) (defun cmp-env-search-ftype (name &optional (env *cmp-env*)) (dolist (i env nil) diff --git a/src/cmp/cmpform.lsp b/src/cmp/cmpform.lsp index e299f116c..e5ede9ad0 100644 --- a/src/cmp/cmpform.lsp +++ b/src/cmp/cmpform.lsp @@ -204,7 +204,8 @@ (baboon :format-control "Attempted to move a form with side-effects")) ;; The following protocol is only valid for VAR references. (unless (eq (c1form-name dest) 'VAR) - (baboon :format-control "Cannot replace forms other than VARs:~%~4I~A" dest)) + (baboon :format-control "Cannot replace forms other than VARs:~%~4I~A" + :format-arguments (list dest))) ;; We have to relocate the children nodes of NEW-FIELDS in ;; the new branch. This implies rewriting the parents chain, ;; but only for non-location nodes (these are reused). The only diff --git a/src/cmp/cmpopt-type.lsp b/src/cmp/cmpopt-type.lsp index ca2904a6a..b81744971 100644 --- a/src/cmp/cmpopt-type.lsp +++ b/src/cmp/cmpopt-type.lsp @@ -32,7 +32,8 @@ ,@declarations) (si::while (< ,variable ,%limit) ,@body - (reckless (setq ,variable (1+ ,variable)))) + (locally (declare (optimize (safety 0))) + (setq ,variable (1+ ,variable)))) ,@output)) (t (let ((,variable 0)) diff --git a/src/cmp/cmppass2-top.lsp b/src/cmp/cmppass2-top.lsp index c724d2200..9af4d6535 100644 --- a/src/cmp/cmppass2-top.lsp +++ b/src/cmp/cmppass2-top.lsp @@ -304,7 +304,9 @@ (declare (type fun fun)) ;; Compiler note about compiling this function - (print-emitting fun) + (when *compile-print* + (ext:when-let ((name (or (fun-name fun) (fun-description fun)))) + (format t "~&;;; Emitting code for ~s.~%" name))) (let* ((lambda-expr (fun-lambda fun)) (*cmp-env* (c1form-env lambda-expr)) diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp index 97ce7b1cb..02d3fc2bd 100644 --- a/src/cmp/cmputil.lsp +++ b/src/cmp/cmputil.lsp @@ -121,12 +121,6 @@ (innermost-non-expanded-form *current-toplevel-form*)))) nil) -(defun print-emitting (f) - (when *compile-print* - (let* ((name (or (fun-name f) (fun-description f)))) - (when name - (format t "~&;;; Emitting code for ~s.~%" name))))) - (defun cmpprogress (&rest args) (when *compile-verbose* (apply #'format t args))) @@ -140,12 +134,6 @@ form c) nil))) -;;; Like macro-function except it searches the lexical environment, -;;; to determine if the macro is shadowed by a function or a macro. -(defun cmp-macro-function (name) - (or (cmp-env-search-macro name) - (macro-function name))) - (defun cmp-expand-macro (fd form &optional (env *cmp-env*)) (handler-case (let ((new-form (funcall *macroexpand-hook* fd form env))) @@ -518,10 +506,6 @@ comparing circular objects." *exit* (next-label))) -(defun maybe-wt-label (label) - (unless (eq label *exit*) - (wt-label label))) - (defmacro with-exit-label ((label) &body body) `(let* ((,label (next-label)) (*unwind-exit* (cons ,label *unwind-exit*))) @@ -532,7 +516,8 @@ comparing circular objects." `(let* ((,label (maybe-next-label)) (*unwind-exit* (adjoin ,label *unwind-exit*))) ,@body - (maybe-wt-label ,label))) + (unless (eq ,label *exit*) + (wt-label ,label)))) (defun next-lcl (&optional name) (list 'LCL (incf *lcl*) T @@ -559,6 +544,13 @@ comparing circular objects." (incf *env*) (setq *max-env* (max *env* *max-env*)))) -(defmacro reckless (&rest body) - `(locally (declare (optimize (safety 0))) - ,@body)) +(defun env-grows (possibily) + ;; if additional closure variables are introduced and this is not + ;; last form, we must use a new env. + (and possibily + (plusp *env*) + (dolist (exit *unwind-exit*) + (case exit + (RETURN (return NIL)) + (BDS-BIND) + (t (return T)))))) diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index fd049e4f3..40ca8d8de 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -14,17 +14,6 @@ (in-package #:compiler) -(defun env-grows (possibily) - ;; if additional closure variables are introduced and this is not - ;; last form, we must use a new env. - (and possibily - (plusp *env*) - (dolist (exit *unwind-exit*) - (case exit - (RETURN (return NIL)) - (BDS-BIND) - (t (return T)))))) - ;; should check whether a form before var causes a side-effect ;; exactly one occurrence of var is present in forms (defun replaceable (var form)