diff --git a/code/describe.lisp b/code/describe.lisp
index 317f8a50c27c4e7db919a788b84aa31fdf89b187..d4b2cc16e0ffd8245af471d7228b0a466841b96e 100644
--- a/code/describe.lisp
+++ b/code/describe.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/code/describe.lisp,v 1.33 1998/06/05 02:53:54 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/describe.lisp,v 1.34 2000/08/10 10:55:22 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -386,6 +386,7 @@
 		(:special "special variable")
 		(:constant "constant")
 		(:global "undefined variable")
+		(:macro "symbol macro")
 		(:alien nil))))
     (cond
      ((eq kind :alien)
@@ -396,6 +397,9 @@
 		 (alien::heap-alien-info-type info)))
 	(format t "~@<It's current value is ~3I~:_~S.~:>"
 		(eval x))))
+     ((eq kind :macro)
+      (let ((expansion (info variable macro-expansion x)))
+	(format t "~&It is a ~A with expansion: ~S." wot expansion)))
      ((boundp x)
       (let ((value (symbol-value x)))
 	(format t "~&It is a ~A; its value is ~S." wot value)
diff --git a/code/eval.lisp b/code/eval.lisp
index 99bc401b466fff0bb33778ff2f68354605527ada..553daf452cd0278ad9c2eba28f6679fbdcee5377 100644
--- a/code/eval.lisp
+++ b/code/eval.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/code/eval.lisp,v 1.30 1999/03/04 12:32:45 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/eval.lisp,v 1.31 2000/08/10 10:55:23 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -167,7 +167,7 @@
 	  (values (info variable constant-value exp)))
 	 ((:special :global)
 	  (symbol-value exp))
-	 (:alien
+	 ((:alien :macro)
 	  (eval:internal-eval original-exp))))
       (list
        (let ((name (first exp))
@@ -402,10 +402,13 @@
 	((symbolp form)
 	 (let* ((venv (when env (c::lexenv-variables env)))
 		(local-def (cdr (assoc form venv))))
-	   (if (and (consp local-def)
-		    (eq (car local-def) 'macro))
-	       (values (cdr local-def) t)
-	       (values form nil))))
+	   (cond ((and (consp local-def)
+		       (eq (car local-def) 'macro))
+		  (values (cdr local-def) t))
+		 ((eq (info variable kind form) :macro)
+		  (values (info variable macro-expansion form) t))
+		 (t
+		  (values form nil)))))
 	(t
 	 (values form nil))))
 
diff --git a/code/exports.lisp b/code/exports.lisp
index 819134361c1221df7489639f1c4b2297920dd62a..8f4fd22e3116ef1f3b072633513114b01ff3a227 100644
--- a/code/exports.lisp
+++ b/code/exports.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/code/exports.lisp,v 1.172 2000/08/08 13:41:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.173 2000/08/10 10:55:23 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -370,7 +370,8 @@
              "COUNT-IF-NOT" "CTYPECASE" "DEBUG" "DECF" "DECLAIM"
              "DECLARATION" "DECLARE" "DECODE-FLOAT" "DECODE-UNIVERSAL-TIME"
              "DEFCONSTANT" "DEFINE-COMPILER-MACRO" "DEFINE-CONDITION"
-             "DEFINE-MODIFY-MACRO" "DEFINE-SETF-METHOD" "DEFMACRO" "DEFPACKAGE"
+             "DEFINE-MODIFY-MACRO" "DEFINE-SETF-METHOD" "DEFINE-SYMBOL-MACRO"
+	     "DEFMACRO" "DEFPACKAGE"
              "DEFPARAMETER" "DEFSETF" "DEFSTRUCT" "DEFTYPE" "DEFUN" "DEFVAR"
              "DELETE" "DELETE-DUPLICATES" "DELETE-FILE" "DELETE-IF"
              "DELETE-IF-NOT" "DELETE-PACKAGE"
diff --git a/code/macros.lisp b/code/macros.lisp
index e9cfc3a85cc184dde58e672892890351cfece25c..309bdfc8141e8cdcad802451f1b8ca9e20d1c911 100644
--- a/code/macros.lisp
+++ b/code/macros.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/code/macros.lisp,v 1.62 2000/07/06 18:36:38 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.63 2000/08/10 10:55:24 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -144,6 +144,34 @@
   name)
 
 
+
+;;;; DEFINE-SYMBOL-MACRO
+
+;;; define-symbol-macro  --  Public
+;;;
+(defmacro define-symbol-macro (name expansion)
+  `(eval-when (compile load eval)
+     (%define-symbol-macro ',name ',expansion)))
+;;;
+(defun %define-symbol-macro (name expansion)
+  (unless (symbolp name)
+    (error 'simple-type-error :datum name :expected-type 'symbol
+	   :format-control "Symbol macro name is not a symbol: ~S."
+	   :format-arguments (list name)))
+  (ecase (info variable kind name)
+    ((:macro :global nil)
+     (setf (info variable kind name) :macro)
+     (setf (info variable macro-expansion name) expansion))
+    (:special
+     (error 'simple-program-error
+	    :format-control "Symbol macro name already declared special: ~S."
+	    :format-arguments (list name)))
+    (:constant
+     (error 'simple-program-error
+	    :format-control "Symbol macro name already declared constant: ~S."
+	    :format-arguments (list name))))
+  name)
+    
 
 ;;; DEFTYPE is a lot like DEFMACRO.
 
diff --git a/compiler/globaldb.lisp b/compiler/globaldb.lisp
index 60a569a9c87a730970081aaf26e2199a372be102..f4f1bfa2f753117cb949271125ae445491706d59 100644
--- a/compiler/globaldb.lisp
+++ b/compiler/globaldb.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/globaldb.lisp,v 1.38 2000/07/07 09:33:01 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/globaldb.lisp,v 1.39 2000/08/10 10:55:35 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1070,7 +1070,8 @@
 (define-info-class variable)
 
 ;;; The kind of variable-like thing described.
-(define-info-type variable kind (member :special :constant :global :alien)
+(define-info-type variable kind (member :special :constant :global :alien
+					:macro)
   (if (or (eq (symbol-package name) (symbol-package :end))
 	  (member name '(t nil)))
       :constant
@@ -1091,6 +1092,8 @@
 
 (define-info-type variable alien-info (or heap-alien-info null) nil)
 
+(define-info-type variable macro-expansion t nil)
+
 (define-info-type variable documentation (or string null) nil)
 
 (define-info-class type)
diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index d5bebda93c0f2605ab8ba992c70960c7221769d0..719d82e9463881c1d83394638780519cf23502e2 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.117 2000/07/13 17:30:11 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.118 2000/08/10 10:55:35 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -241,7 +241,7 @@
 ;;; is unknown, then we emit a warning.
 ;;;
 (defun find-free-variable (name)
-  (declare (values (or leaf heap-alien-info)))
+  (declare (values (or leaf cons heap-alien-info)))
   (unless (symbolp name)
     (compiler-error "Variable name is not a symbol: ~S." name))
   (or (gethash name *free-variables*)
@@ -252,17 +252,22 @@
 	  (note-undefined-reference name :variable))
 
 	(setf (gethash name *free-variables*)
-	      (if (eq kind :alien)
-		  (info variable alien-info name)
-		  (multiple-value-bind
-		      (val valp)
-		      (info variable constant-value name)
-		    (if (and (eq kind :constant) valp)
-			(make-constant :value val  :name name
-				       :type (ctype-of val)
-				       :where-from where-from)
-			(make-global-var :kind kind  :name name  :type type
-					 :where-from where-from))))))))
+	      (cond ((eq kind :alien)
+		     (info variable alien-info name))
+		    ((eq kind :macro)
+		     (let ((expansion (info variable macro-expansion name))
+			   (type (type-specifier (info variable type name))))
+		       `(MACRO . (the ,type ,expansion))))
+		    (t
+		     (multiple-value-bind
+			   (val valp)
+			 (info variable constant-value name)
+		       (if (and (eq kind :constant) valp)
+			   (make-constant :value val  :name name
+					  :type (ctype-of val)
+					  :where-from where-from)
+			   (make-global-var :kind kind :name name :type type
+					    :where-from where-from)))))))))