diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index 44e27eb42110b7866c04e8e374aa2f2237239f57..474f623b23a54303ee4755aea9e83cc1b0ab3f13 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.125 2001/10/15 14:36:40 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.126 2001/10/28 14:35:57 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2489,6 +2489,8 @@
 	    (def (second spec)))
 	(unless (symbolp name)
 	  (compiler-error "Symbol macro name is not a symbol: ~S." name))
+        (when (eq (info variable kind name) :special)
+          (compiler-error "Attempt to bind a special variable with SYMBOL-MACROLET: ~S." name))
 	(when (assoc name (res) :test #'eq)
 	  (compiler-warning "Repeated name in SYMBOL-MACROLET: ~S." name))
 	(res `(,name . (MACRO . ,def)))))
diff --git a/compiler/new-assem.lisp b/compiler/new-assem.lisp
index 365f975103347c4b86dc23741d815a6608667fbb..3cebcacde7c30e0daf2d01a348a034368f63bda6 100644
--- a/compiler/new-assem.lisp
+++ b/compiler/new-assem.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.27 1998/03/21 08:07:00 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.28 2001/10/28 14:35:58 pw Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -49,7 +49,7 @@
 ;;;
 (defmacro def-assembler-params (&rest options)
   "Set up the assembler."
-  `(eval-when (compile load eval)
+  `(eval-when (:compile-toplevel :load-toplevel :execute)
      (setf (c:backend-assembler-params c:*target-backend*)
 	   (make-assem-params :backend c:*target-backend*
 			      ,@options))))
@@ -306,7 +306,7 @@
 
 ;;; WITHOUT-SCHEDULING -- interface.
 ;;;
-(defmacro without-scheduling ((&optional (segment '*current-segment*))
+(defmacro without-scheduling ((&optional (segment (%%current-segment%%)))
 			      &body body)
   "Execute BODY (as a progn) without scheduling any of the instructions
    generated inside it.  DO NOT throw or return-from out of it."
@@ -1304,29 +1304,29 @@
 
 ;;;; Interface to the rest of the compiler.
 
-;;; *CURRENT-SEGMENT* -- internal.
+;;; Macro %%CURRENT-SEGMENT%% -- internal.
 ;;;
-;;; The holds the current segment while assembling.  Use ASSEMBLE to change
-;;; it.
+;;; Returns the current segment while assembling. Use ASSEMBLE to
+;;; change it.
 ;;; 
-(defvar *current-segment*)
+;;; Using a macro to access the underlying special variable
+;;; *CURRENT-SEGMENT* allows us to play scoping tricks in
+;;; DEFINE-INSTRUCTION to detect calls to the INST macro which aren't
+;;; inside the scope of an ASSEMBLE. 
+;;; 
+(defvar *current-segment* nil)
+(defmacro %%current-segment%% () '*current-segment*)
 
-;;; *CURRENT-VOP* -- internal.
+;;; Macro %%CURRENT-VOP%% -- internal.
 ;;;
-;;; Just like *CURRENT-SEGMENT*, but holds the current vop.  Used only to keep
+;;; Just like %%CURRENT-SEGMENT%%, but holds the current vop.  Used only to keep
 ;;; track of which vops emit which insts.
 ;;; 
 (defvar *current-vop* nil)
+(defmacro %%current-vop%% () '*current-vop*)
 
 ;;; ASSEMBLE -- interface.
 ;;;
-;;; We also symbol-macrolet *current-segment* to a local holding the segment
-;;; so uses of *current-segment* inside the body don't have to keep
-;;; dereferencing the symbol.  Given that ASSEMBLE is the only interface to
-;;; *current-segment*, we don't have to worry about the special value becomming
-;;; out of sync with the lexical value.  Unless some bozo closes over it,
-;;; but nobody does anything like that...
-;;;
 (defmacro assemble ((&optional segment vop &key labels) &body body
 		    &environment env)
   "Execute BODY (as a progn) with SEGMENT as the current segment."
@@ -1348,18 +1348,14 @@
       (when (intersection labels inherited-labels)
 	(error "Duplicate nested labels: ~S"
 	       (intersection labels inherited-labels)))
-      `(let* ((,seg-var ,(or segment '*current-segment*))
-	      (,vop-var ,(or vop '*current-vop*))
-	      ,@(when segment
-		  `((*current-segment* ,seg-var)))
-	      ,@(when vop
-		  `((*current-vop* ,vop-var)))
+      `(let* ((,seg-var ,(or segment (%%current-segment%%)))
+              (,vop-var ,(or vop (%%current-vop%%)))
+              (*current-segment* ,seg-var)
+              (*current-vop* ,vop-var)
 	      ,@(mapcar #'(lambda (name)
 			    `(,name (gen-label)))
 			new-labels))
-	 (symbol-macrolet ((*current-segment* ,seg-var)
-			   (*current-vop* ,vop-var)
-			   ,@(when (or inherited-labels nested-labels)
+        (symbol-macrolet (,@(when (or inherited-labels nested-labels)
 			       `((..inherited-labels.. ,nested-labels))))
 	   ,@(mapcar #'(lambda (form)
 			 (if (label-name-p form)
@@ -1379,24 +1375,24 @@
 	  ((functionp inst)
 	   (funcall inst (cdr whole) env))
 	  (t
-	   `(,inst *current-segment* *current-vop* ,@args)))))
+	   `(,inst (%%current-segment%%) (%%current-vop%%) ,@args)))))
 
 ;;; EMIT-LABEL -- interface.
 ;;; 
 (defmacro emit-label (label)
   "Emit LABEL at this location in the current segment."
-  `(%emit-label *current-segment* *current-vop* ,label))
+  `(%emit-label (%%current-segment%%) (%%current-vop%%) ,label))
 
 ;;; EMIT-POSTIT -- interface.
 ;;;
 (defmacro emit-postit (function)
-  `(%emit-postit *current-segment* ,function))
+  `(%emit-postit (%%current-segment%%) ,function))
 
 ;;; ALIGN -- interface.
 ;;; 
 (defmacro align (bits &optional (fill-byte 0))
   "Emit an alignment restriction to the current segment."
-  `(emit-alignment *current-segment* *current-vop* ,bits ,fill-byte))
+  `(emit-alignment (%%current-segment%%) (%%current-vop%%) ,bits ,fill-byte))
 
 ;;; LABEL-POSITION -- interface.
 ;;; 
@@ -1808,15 +1804,11 @@
 	       `((declare ,@decls)))
 	   (let ((,postits (segment-postits ,segment-name)))
 	     (setf (segment-postits ,segment-name) nil)
-	     (symbol-macrolet
-		 ((*current-segment*
-		   (macrolet ((lose ()
-				(error "Can't use INST without an ASSEMBLE ~
-					inside emitters.")))
-		     (lose))))
+             (macrolet ((%%current-segment%% ()
+                          (error "Can't use INST without an ASSEMBLE inside emitters.")))
 	       ,@emitter))
 	   (ext:undefined-value))
-	 (eval-when (compile load eval)
+        (eval-when (:compile-toplevel :load-toplevel :execute)
 	   (%define-instruction ,sym-name ',defun-name))
 	 ,@(extract-nths 1 'progn pdefs)
 	 ,@(when pdefs
@@ -1824,6 +1816,7 @@
 		',name
 		(append ,@(extract-nths 0 'list pdefs)))))))))
 
+
 ;;; DEFINE-INSTRUCTION-MACRO -- interface.
 ;;;
 (defmacro define-instruction-macro (name lambda-list &body body)
@@ -1833,7 +1826,7 @@
 	(body local-defs)
 	(lisp::parse-defmacro lambda-list whole body name 'instruction-macro
 			      :environment env)
-      `(eval-when (compile load eval)
+      `(eval-when (:compile-toplevel :load-toplevel :execute)
 	 (%define-instruction ,(symbol-name name)
 			      #'(lambda (,whole ,env)
 				  ,@local-defs