X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fassem.lisp;h=3a9e45343f1712c74f48a1fab92a8cec7ea65a89;hb=dde834ef75cb12b8cdda23472b3365de72d9422a;hp=778eb41fdac6972dd1a6965cf46b616c57b1e6c3;hpb=670010e3f3dcd62efaf23f61abdc73950edb88c6;p=sbcl.git

diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp
index 778eb41..3a9e453 100644
--- a/src/compiler/assem.lisp
+++ b/src/compiler/assem.lisp
@@ -473,7 +473,7 @@
 	    ;; nothing to do, then emit a nop. ### Note: despite the
 	    ;; fact that this is a loop, it really won't work for
 	    ;; repetitions other then zero and one. For example, if
-p	    ;; the branch has two dependents and one of them dpends on
+	    ;; the branch has two dependents and one of them dpends on
 	    ;; the other, then the stuff that grabs a dependent could
 	    ;; easily grab the wrong one. But I don't feel like fixing
 	    ;; this because it doesn't matter for any of the
@@ -768,7 +768,7 @@ p	    ;; the branch has two dependents and one of them dpends on
   (declare (type segment segment)
 	   (type annotation note))
   (when (annotation-posn note)
-    (error "attempt to emit ~S a second time"))
+    (error "attempt to emit ~S a second time" note))
   (setf (annotation-posn note) (segment-current-posn segment))
   (setf (annotation-index note) (segment-current-index segment))
   (let ((last (segment-last-annotation segment))
@@ -1163,16 +1163,24 @@ p	    ;; the branch has two dependents and one of them dpends on
 	      ,@(mapcar (lambda (name)
 			  `(,name (gen-label)))
 			new-labels))
-	(declare (ignorable ,vop-var ,seg-var))
+	(declare (ignorable ,vop-var ,seg-var)
+	         ;; Must be done so that contribs and user code doing
+	         ;; low-level stuff don't need to worry about this.
+	         (disable-package-locks %%current-segment%% %%current-vop%%))
 	(macrolet ((%%current-segment%% () '**current-segment**)
 		   (%%current-vop%% () '**current-vop**))
-	 (symbol-macrolet (,@(when (or inherited-labels nested-labels)
-			       `((..inherited-labels.. ,nested-labels))))
-	   ,@(mapcar (lambda (form)
-		       (if (label-name-p form)
-			   `(emit-label ,form)
-			   form))
-		     body)))))))
+          ;; KLUDGE: Some host lisps (CMUCL 18e Sparc at least)
+          ;; can't deal with this declaration, so disable it on host.
+          ;; Ditto for later ENABLE-PACKAGE-LOCKS %%C-S%% declaration.
+          #-sb-xc-host
+	  (declare (enable-package-locks %%current-segment%% %%current-vop%%))
+	  (symbol-macrolet (,@(when (or inherited-labels nested-labels)
+				    `((..inherited-labels.. ,nested-labels))))
+	      ,@(mapcar (lambda (form)
+			  (if (label-name-p form)
+			      `(emit-label ,form)
+			      form))
+			body)))))))
 #+sb-xc-host
 (sb!xc:defmacro assemble ((&optional segment vop &key labels)
 			  &body body
@@ -1209,13 +1217,13 @@ p	    ;; the branch has two dependents and one of them dpends on
 	(declare (ignorable ,vop-var ,seg-var))
 	(macrolet ((%%current-segment%% () '**current-segment**)
 		   (%%current-vop%% () '**current-vop**))
-	 (symbol-macrolet (,@(when (or inherited-labels nested-labels)
-			       `((..inherited-labels.. ,nested-labels))))
-	   ,@(mapcar (lambda (form)
-		       (if (label-name-p form)
-			   `(emit-label ,form)
-			   form))
-		     body)))))))
+	  (symbol-macrolet (,@(when (or inherited-labels nested-labels)
+				    `((..inherited-labels.. ,nested-labels))))
+	      ,@(mapcar (lambda (form)
+			  (if (label-name-p form)
+			      `(emit-label ,form)
+			      form))
+			body)))))))
 
 (defmacro inst (&whole whole instruction &rest args &environment env)
   #!+sb-doc
@@ -1270,8 +1278,7 @@ p	    ;; the branch has two dependents and one of them dpends on
     (setf (segment-postits segment) (segment-postits other-segment))
     (dolist (postit postits)
       (emit-back-patch segment 0 postit)))
-  #!-x86 (emit-alignment segment nil max-alignment)
-  #!+x86 (emit-alignment segment nil max-alignment #x90)
+  (emit-alignment segment nil max-alignment #!+(or x86-64 x86) #x90)
   (let ((segment-current-index-0 (segment-current-index segment))
 	(segment-current-posn-0  (segment-current-posn  segment)))
     (incf (segment-current-index segment)
@@ -1637,10 +1644,19 @@ p	    ;; the branch has two dependents and one of them dpends on
 	   ,@(when decls
 	       `((declare ,@decls)))
 	   (let ((,postits (segment-postits ,segment-name)))
+	     ;; Must be done so that contribs and user code doing
+	     ;; low-level stuff don't need to worry about this.
+	     (declare (disable-package-locks %%current-segment%%))
 	     (setf (segment-postits ,segment-name) nil)
 	     (macrolet ((%%current-segment%% ()
 			  (error "You can't use INST without an ~
 				  ASSEMBLE inside emitters.")))
+               ;; KLUDGE: Some host lisps (CMUCL 18e Sparc at least)
+               ;; can't deal with this declaration, so disable it on host
+               ;; Ditto for earlier ENABLE-PACKAGE-LOCKS %%C-S%% %%C-V%%
+               ;; declaration.
+               #-sb-xc-host
+	       (declare (enable-package-locks %%current-segment%%))
 	       ,@emitter))
 	   (values))
 	 (eval-when (:compile-toplevel :load-toplevel :execute)