X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=a70b2c2cbb8ed22b154042b70c61680225e671f5;hb=6cc71ab8ffad49f43895ad0a1df6885c81876687;hp=9edc6d944a3dcfde1cf1f4c98b1e3fc84f916178;hpb=670010e3f3dcd62efaf23f61abdc73950edb88c6;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 9edc6d9..a70b2c2 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -57,7 +57,7 @@
 
 ;;;; DO-related stuff which needs to be visible on the cross-compilation host
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun frob-do-body (varlist endlist decls-and-code bind step name block)
     (let* ((r-inits nil) ; accumulator for reversed list
 	   (r-steps nil) ; accumulator for reversed list
@@ -98,7 +98,8 @@
 			 (t (illegal-varlist)))))
 		(t (illegal-varlist)))))
       ;; Construct the new form.
-      (multiple-value-bind (code decls) (parse-body decls-and-code nil)
+      (multiple-value-bind (code decls)
+	  (parse-body decls-and-code :doc-string-allowed nil)
 	`(block ,block
 	   (,bind ,(nreverse r-inits)
 		  ,@decls
@@ -164,7 +165,7 @@
 
 ;;; Concatenate together the names of some strings and symbols,
 ;;; producing a symbol in the current package.
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
   (defun symbolicate (&rest things)
     (let ((name (case (length things)
 		  ;; why isn't this just the value in the T branch?
@@ -173,14 +174,15 @@
 		  ;; check for bad lengths, the type system is needed
 		  ;; for calls to CONCATENATE. So we need to make sure
 		  ;; that the calls are transformed away:
-		  (1 (concatenate 'string (the simple-string (string (car things)))))
+		  (1 (concatenate 'string
+				  (the simple-base-string (string (car things)))))
 		  (2 (concatenate 'string 
-				  (the simple-string (string (car things)))
-				  (the simple-string (string (cadr things)))))
+				  (the simple-base-string (string (car things)))
+				  (the simple-base-string (string (cadr things)))))
 		  (3 (concatenate 'string
-				  (the simple-string (string (car things)))
-				  (the simple-string (string (cadr things)))
-				  (the simple-string (string (caddr things)))))
+				  (the simple-base-string (string (car things)))
+				  (the simple-base-string (string (cadr things)))
+				  (the simple-base-string (string (caddr things)))))
 		  (t (apply #'concatenate 'string (mapcar #'string things))))))
     (values (intern name)))))