diff --git a/code/sharpm.lisp b/code/sharpm.lisp
index 65338fd9a021abc31fefcdca8d9d54a4e5808cf7..7a0746a3158aa33a33e5249c35e59a2a03bb3002 100644
--- a/code/sharpm.lisp
+++ b/code/sharpm.lisp
@@ -20,53 +20,21 @@
 
 (proclaim '(special *read-suppress* std-lisp-readtable *bq-vector-flag*))
 
-(defun sharp-backslash (stream backslash font)
+
+(defun sharp-backslash (stream backslash ignore)
+  (declare (ignore ignore))
   (unread-char backslash stream)
   (let* ((*readtable* std-lisp-readtable)
-	 (bitnames ())
 	 (charstring (read-extended-token stream)))
     (declare (simple-string charstring))
-    (when *read-suppress* (return-from sharp-backslash nil))
-    ;;find bit name prefixes
-    (do ((i (position #\- charstring) (position #\- charstring)))
-	((or (null i) (zerop (the fixnum i))))
-      (let ((bitname (string-upcase (subseq charstring 0 i))))
-	(setq charstring (subseq charstring (1+ (the fixnum i))))
-	;;* symbols in alist are a kludge to circumvent xc bogosity.
-	(let ((expansion (cdr (assoc bitname '(("C" . CONTROL)
-					       ("M" . META)
-					       ("H" . HYPER)
-					       ("S" . SUPER))
-				     :test #'equal))))
-	  (if expansion (setq bitname (symbol-name expansion)))
-	  (cond ((member bitname '("CONTROL" "META" "HYPER" "SUPER")
-			 :test #'EQUAL)
-		 (if (not (member bitname bitnames :test #'EQUAL))
-		     (push bitname bitnames)
-		     (error
-			     "Redundant bit name in character name: ~A"
-			     bitname)))
-		(t (error
-			   "Meaningless bit name in character name: ~A"
-			   bitname))))))
-    ;;build un-hyphenated char, add specified bits:
-    (let ((char (if (= (the fixnum (length charstring)) 1)
-		    (char charstring 0)
-		    (name-char charstring))))
-      (cond (char
-	     (if font
-		 (setq char (make-char char 0 font)))
-	     (if (member "CONTROL" bitnames :test #'EQUAL)
-		 (setq char (set-char-bit char :control t)))
-	     (if (member "META" bitnames :test #'EQUAL)
-		 (setq char (set-char-bit char :meta t)))
-	     (if (member "HYPER" bitnames :test #'EQUAL)
-		 (setq char (set-char-bit char :hyper t)))
-	     (if (member "SUPER" bitnames :test #'EQUAL)
-		 (setq char (set-char-bit char :super t)))
-	     char)
-	    (t (error "Meaningless character name ~A"
-		       charstring))))))
+    (cond (*read-suppress* nil)
+	  ((= (the fixnum (length charstring)) 1)
+	   (char charstring 0))
+	  ((name-char charstring))
+	  (t
+	   (error "Meaningless character name: ~S" charstring)))))
+
+
 
 (defun sharp-quote (stream ignore1 ignore2)
   (declare (ignore ignore1 ignore2))