X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=1ed66e784b0f3a8dbf34840f86b01e7e97ede3fb;hb=75b52379bdc2269961af6a1308eca63610f38ac3;hp=a70b2c2cbb8ed22b154042b70c61680225e671f5;hpb=c41cb4c87eae7b04f844dca5f7edb5086c5d2d68;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index a70b2c2..1ed66e7 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -104,13 +104,13 @@
 	   (,bind ,(nreverse r-inits)
 		  ,@decls
 		  (tagbody
-		   (go ,label-2)
-		   ,label-1
-		   ,@code
-		   (,step ,@(nreverse r-steps))
-		   ,label-2
-		   (unless ,(first endlist) (go ,label-1))
-		   (return-from ,block (progn ,@(rest endlist))))))))))
+                     (go ,label-2)
+                     ,label-1
+                     (tagbody ,@code)
+                     (,step ,@(nreverse r-steps))
+                     ,label-2
+                     (unless ,(first endlist) (go ,label-1))
+                     (return-from ,block (progn ,@(rest endlist))))))))))
 
 ;;; This is like DO, except it has no implicit NIL block. Each VAR is
 ;;; initialized in parallel to the value of the specified INIT form.
@@ -168,21 +168,27 @@
 (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?
+		  ;; Why isn't this just the value in the T branch?
 		  ;; Well, this is called early in cold-init, before
 		  ;; the type system is set up; however, now that we
 		  ;; 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-base-string (string (car things)))))
+				  (the simple-base-string
+				    (string (car things)))))
 		  (2 (concatenate 'string 
-				  (the simple-base-string (string (car things)))
-				  (the simple-base-string (string (cadr things)))))
+				  (the simple-base-string
+				    (string (car things)))
+				  (the simple-base-string
+				    (string (cadr things)))))
 		  (3 (concatenate 'string
-				  (the simple-base-string (string (car things)))
-				  (the simple-base-string (string (cadr things)))
-				  (the simple-base-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)))))
 
@@ -327,3 +333,19 @@
 					   0)
 				       (1- max))))
 	(t nil)))
+
+;;; Helpers for defining error-signalling NOP's for "not supported 
+;;; here" operations.
+(defmacro define-unsupported-fun (name &optional 
+                                  (doc "Unsupported on this platform.")
+                                  (control 
+                                   "~S is unsupported on this platform ~
+                                    (OS, CPU, whatever)."
+                                   controlp)
+                                  arguments)
+  `(defun ,name (&rest args)
+    ,doc
+    (declare (ignore args))
+    (error 'unsupported-operator 
+     :format-control ,control
+     :format-arguments (if ,controlp ',arguments (list ',name)))))