X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=2144cbda2d710fbd4704d4632224a94693c91869;hb=f3f677703e37f5a335b3be7fa64f7748ad969517;hp=5f3706625c114a1be6ce853ab1c7d1e3a2154882;hpb=dc4be57ff0baeee18d43fbee1bfc1af4af50e522;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 5f37066..2144cbd 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -50,6 +50,8 @@ the efficiency of stable code.") (defvar *fun-names-in-this-file* nil) + +(defvar *post-binding-variable-lexenv* nil) ;;;; namespace management utilities @@ -205,7 +207,7 @@ (:macro (let ((expansion (info :variable :macro-expansion name)) (type (type-specifier (info :variable :type name)))) - `(MACRO . (the ,type ,expansion)))) + `(macro . (the ,type ,expansion)))) (:constant (let ((value (info :variable :constant-value name))) (make-constant :value value @@ -286,7 +288,10 @@ #+sb-xc-host structure!object #-sb-xc-host instance (when (emit-make-load-form value) - (dotimes (i (%instance-length value)) + (dotimes (i (- (%instance-length value) + #+sb-xc-host 0 + #-sb-xc-host (layout-n-untagged-slots + (%instance-ref value 0)))) (grovel (%instance-ref value i))))) (t (compiler-error @@ -628,7 +633,7 @@ (warn "reading an ignored variable: ~S" name))) (reference-leaf start next result var)) (cons - (aver (eq (car var) 'MACRO)) + (aver (eq (car var) 'macro)) ;; FIXME: [Free] type declarations. -- APD, 2002-01-26 (ir1-convert start next result (cdr var))) (heap-alien-info @@ -961,8 +966,8 @@ (process-var it nil)))) (cons ;; FIXME: non-ANSI weirdness - (aver (eq (car var) 'MACRO)) - (new-vars `(,var-name . (MACRO . (the ,(first decl) + (aver (eq (car var) 'macro)) + (new-vars `(,var-name . (macro . (the ,(first decl) ,(cdr var)))))) (heap-alien-info (compiler-error @@ -1006,8 +1011,9 @@ ;;; Process a special declaration, returning a new LEXENV. A non-bound ;;; special declaration is instantiated by throwing a special variable -;;; into the variables. -(defun process-special-decl (spec res vars) +;;; into the variables if BINDING-FORM-P is NIL, or otherwise into +;;; *POST-BINDING-VARIABLE-LEXENV*. +(defun process-special-decl (spec res vars binding-form-p) (declare (list spec vars) (type lexenv res)) (collect ((new-venv nil cons)) (dolist (name (cdr spec)) @@ -1015,7 +1021,7 @@ (let ((var (find-in-bindings vars name))) (etypecase var (cons - (aver (eq (car var) 'MACRO)) + (aver (eq (car var) 'macro)) (compiler-error "~S is a symbol-macro and thus can't be declared special." name)) @@ -1029,11 +1035,16 @@ (setf (lambda-var-specvar var) (specvar-for-binding name))) (null - (unless (assoc name (new-venv) :test #'eq) + (unless (or (assoc name (new-venv) :test #'eq)) (new-venv (cons name (specvar-for-binding name)))))))) - (if (new-venv) - (make-lexenv :default res :vars (new-venv)) - res))) + (cond (binding-form-p + (setf *post-binding-variable-lexenv* + (append (new-venv) *post-binding-variable-lexenv*)) + res) + ((new-venv) + (make-lexenv :default res :vars (new-venv))) + (t + res)))) ;;; Return a DEFINED-FUN which copies a GLOBAL-VAR but for its INLINEP ;;; (and TYPE if notinline), plus type-restrictions from the lexenv. @@ -1181,14 +1192,14 @@ ;;; Process a single declaration spec, augmenting the specified LEXENV ;;; RES. Return RES and result type. VARS and FVARS are as described ;;; PROCESS-DECLS. -(defun process-1-decl (raw-spec res vars fvars) +(defun process-1-decl (raw-spec res vars fvars binding-form-p) (declare (type list raw-spec vars fvars)) (declare (type lexenv res)) (let ((spec (canonized-decl-spec raw-spec)) (result-type *wild-type*)) (values (case (first spec) - (special (process-special-decl spec res vars)) + (special (process-special-decl spec res vars binding-form-p)) (ftype (unless (cdr spec) (compiler-error "no type specified in FTYPE declaration: ~S" spec)) @@ -1242,45 +1253,56 @@ ;;; filling in slots in the leaf structures, we return a new LEXENV, ;;; which reflects pervasive special and function type declarations, ;;; (NOT)INLINE declarations and OPTIMIZE declarations, and type of -;;; VALUES declarations. +;;; VALUES declarations. If BINDING-FORM-P is true, the third return +;;; value is a list of VARs that should not apply to the lexenv of the +;;; initialization forms for the bindings, but should apply to the body. ;;; ;;; This is also called in main.lisp when PROCESS-FORM handles a use ;;; of LOCALLY. -(defun process-decls (decls vars fvars &optional (env *lexenv*)) +(defun process-decls (decls vars fvars &key (lexenv *lexenv*) + (binding-form-p nil)) (declare (list decls vars fvars)) - (let ((result-type *wild-type*)) + (let ((result-type *wild-type*) + (*post-binding-variable-lexenv* nil)) (dolist (decl decls) (dolist (spec (rest decl)) (unless (consp spec) (compiler-error "malformed declaration specifier ~S in ~S" spec decl)) (multiple-value-bind (new-env new-result-type) - (process-1-decl spec env vars fvars) - (setq env new-env) + (process-1-decl spec lexenv vars fvars binding-form-p) + (setq lexenv new-env) (unless (eq new-result-type *wild-type*) (setq result-type (values-type-intersection result-type new-result-type)))))) - (values env result-type))) + (values lexenv result-type *post-binding-variable-lexenv*))) -(defun %processing-decls (decls vars fvars ctran lvar fun) - (multiple-value-bind (*lexenv* result-type) - (process-decls decls vars fvars) +(defun %processing-decls (decls vars fvars ctran lvar binding-form-p fun) + (multiple-value-bind (*lexenv* result-type post-binding-lexenv) + (process-decls decls vars fvars :binding-form-p binding-form-p) (cond ((eq result-type *wild-type*) - (funcall fun ctran lvar)) + (funcall fun ctran lvar post-binding-lexenv)) (t (let ((value-ctran (make-ctran)) (value-lvar (make-lvar))) (multiple-value-prog1 - (funcall fun value-ctran value-lvar) + (funcall fun value-ctran value-lvar post-binding-lexenv) (let ((cast (make-cast value-lvar result-type (lexenv-policy *lexenv*)))) (link-node-to-previous-ctran cast value-ctran) (setf (lvar-dest value-lvar) cast) (use-continuation cast ctran lvar)))))))) -(defmacro processing-decls ((decls vars fvars ctran lvar) &body forms) +(defmacro processing-decls ((decls vars fvars ctran lvar + &optional post-binding-lexenv) + &body forms) (check-type ctran symbol) (check-type lvar symbol) - `(%processing-decls ,decls ,vars ,fvars ,ctran ,lvar - (lambda (,ctran ,lvar) ,@forms))) + (let ((post-binding-lexenv-p (not (null post-binding-lexenv))) + (post-binding-lexenv (or post-binding-lexenv (gensym)))) + `(%processing-decls ,decls ,vars ,fvars ,ctran ,lvar + ,post-binding-lexenv-p + (lambda (,ctran ,lvar ,post-binding-lexenv) + (declare (ignorable ,post-binding-lexenv)) + ,@forms)))) ;;; Return the SPECVAR for NAME to use when we see a local SPECIAL ;;; declaration. If there is a global variable of that name, then