0.pre7.14.flaky4.5:

	(Oops: In the previous version, I worked on "reimplemented
		ONCE-ONLY so it expands into a single LET, so that
		DECLAREs inside work as they should" enough that I
		put it into the commit notes, but then I realized
		that using an inline function is a nice way to solve
		the UNIX-FAST-SELECT problemm, so I undid the ONCE-ONLY
		changes, but forgot to clean up the commit notes.)
	(This version builds under sbcl-0.6.13 with :SB-SHOW, and
		without :SB-INTERPRETER, in target *FEATURES*. Now
		maybe I can use the result to figure out why it can't
		build itself.)
	Maybe we don't need the extra space in DISASSEM-BYTE-COMPONENT
		after all.
	added :IGNORE-FAILURE-P for src/cold/cold-init in order to
		build with :SB-SHOW
	got rid of various early /SHOWs (before the definition of
		UNWIND in assem-rtns.lisp is loaded) so that the system
		could cold init
	chopped make-target-2.sh *PRINT-LEVEL* back down to 5 so that
		/SHOW statements terminate before hell freezes over

make-target-2.sh

@@ -29,12 +29,14 @@ echo //doing warm init
 --core output/cold-sbcl.core \
 --sysinit /dev/null --userinit /dev/null <<-'EOF' || exit 1
 
-        (sb!int:/show "hello, world!")
+	;; Now that we use the byte compiler for macros,
+	;; interpreted /SHOW doesn't work until later in init.
+        #+sb-show (print "/hello, world!")
 
         ;; Do warm init.
 	(let ((*print-length* 10)
-	      (*print-level* 10))
-          (sb!int:/show "about to LOAD warm.lisp")
+	      (*print-level* 5))
+          #+sb-show (print "/about to LOAD warm.lisp")
 	  (load "src/cold/warm.lisp"))
 
         ;; Unintern no-longer-needed stuff before the possible PURIFY

package-data-list.lisp-expr

@@ -1,9 +1,16 @@
-;;;; the specifications of SBCL-specific packages, except..
+;;;; -*- Lisp -*-
+
+;;;; the specifications of target packages, except for a few things
+;;;; which are handled elsewhere by other mechanisms:
 ;;;;   * the creation of the trivial SB-SLOT-ACCESSOR-NAME package
 ;;;;   * any SHADOWing hackery
-;;;; The standard, non-SBCL-specific packages COMMON-LISP,
-;;;; COMMON-LISP-USER, and KEYWORD are also handled through other
-;;;; mechanisms.
+;;;;   * the standard, non-SBCL-specific packages COMMON-LISP,
+;;;;     COMMON-LISP-USER, and KEYWORD
+;;;;
+;;;; The packages are named SB!FOO here and elsewhere in
+;;;; cross-compilation, in order to avoid collision with corresponding
+;;;; SB-FOO packages in the cross-compilation host. They're renamed to
+;;;; SB-FOO later, after the danger of collision has passed.
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.

src/code/byte-interp.lisp

@@ -615,9 +615,9 @@
 	   (type pc pc))
   pc)
 
-;;; This is exactly like THROW, except that the tag is the last thing on
-;;; the stack instead of the first. This is used for RETURN-FROM (hence the
-;;; name).
+;;; This is exactly like THROW, except that the tag is the last thing
+;;; on the stack instead of the first. This is used for RETURN-FROM
+;;; (hence the name).
 (define-xop return-from (component old-pc pc fp)
   (declare (type code-component component)
 	   (type pc old-pc)

src/code/early-setf.lisp

@@ -524,7 +524,7 @@ GET-SETF-EXPANSION directly."
 (sb!xc:define-setf-expander ldb (bytespec place &environment env)
   #!+sb-doc
   "The first argument is a byte specifier. The second is any place form
-  acceptable to SETF. Replaces the specified byte of the number in this
+  acceptable to SETF. Replace the specified byte of the number in this
   place with bits from the low-order end of the new value."
   (declare (type sb!c::lexenv env))
   (multiple-value-bind (dummies vals newval setter getter)

src/code/target-alieneval.lisp

@@ -97,12 +97,16 @@
      :EXTERN
        No alien is allocated, but VAR is established as a local name for
        the external alien given by EXTERNAL-NAME."
+  (/show "entering WITH-ALIEN" bindings)
   (with-auxiliary-alien-types env
     (dolist (binding (reverse bindings))
+      (/show binding)
       (destructuring-bind
 	  (symbol type &optional (opt1 nil opt1p) (opt2 nil opt2p))
 	  binding
+	(/show symbol type opt1 opt2)
 	(let ((alien-type (parse-alien-type type env)))
+	  (/show alien-type)
 	  (multiple-value-bind (allocation initial-value)
 	      (if opt2p
 		  (values opt1 opt2)
@@ -113,6 +117,7 @@
 		     (values opt1 nil))
 		    (t
 		     (values :local opt1))))
+	    (/show allocation initial-value)
 	    (setf body
 		  (ecase allocation
 		    #+nil
@@ -128,6 +133,7 @@
 				`((setq ,symbol ,initial-value)))
 			    ,@body)))))
 		    (:extern
+		     (/show ":EXTERN case")
 		     (let ((info (make-heap-alien-info
 				  :type alien-type
 				  :sap-form `(foreign-symbol-address
@@ -136,9 +142,11 @@
 			  ((,symbol (%heap-alien ',info)))
 			  ,@body))))
 		    (:local
+		     (/show ":LOCAL case")
 		     (let ((var (gensym))
 			   (initval (if initial-value (gensym)))
 			   (info (make-local-alien-info :type alien-type)))
+		       (/show var initval info)
 		       `((let ((,var (make-local-alien ',info))
 			       ,@(when initial-value
 				   `((,initval ,initial-value))))
@@ -150,7 +158,9 @@
 				    `((setq ,symbol ,initval)))
 				,@body)
 			       (dispose-local-alien ',info ,var))))))))))))
+    (/show "revised" body)
     (verify-local-auxiliaries-okay)
+    (/show "back from VERIFY-LOCAL-AUXILIARIES-OK, returning")
     `(symbol-macrolet ((&auxiliary-type-definitions&
 			,(append *new-auxiliary-types*
 				 (auxiliary-type-definitions env))))

src/cold/warm.lisp

@@ -46,12 +46,16 @@
   ;; (Hopefully this will go away as we move the files above into cold load.)
   ;; -- WHN 19991214
   (let ((fullname (concatenate 'string stem ".lisp")))
-    (sb!int:/show "about to compile" fullname)
+    ;; (Now that we use the byte compiler for interpretation,
+    ;; /SHOW doesn't get compiled properly until the src/assembly
+    ;; files have been loaded.)
+    #+sb-show (print "/about to compile src/assembly file")
+    #+sb-show (print fullname)
     (multiple-value-bind
 	(compiled-truename compilation-warnings-p compilation-failure-p)
 	(compile-file fullname)
       (declare (ignore compilation-warnings-p))
-      (sb!int:/show "done compiling" fullname)
+      #+sb-show (print "/done compiling src/assembly file")
       (if compilation-failure-p
 	  (error "COMPILE-FILE of ~S failed." fullname)
 	  (unless (load compiled-truename)

src/compiler/array-tran.lisp

@@ -499,21 +499,24 @@
 				   (element-type '*)
 				   unsafe?
 				   fail-inline?)
+  (/show "in %WITH-ARRAY-DATA-MACRO, yes.." array start end)
   (let ((size (gensym "SIZE-"))
+	(defaulted-end (gensym "DEFAULTED-END-"))
 	(data (gensym "DATA-"))
 	(cumulative-offset (gensym "CUMULATIVE-OFFSET-")))
     `(let* ((,size (array-total-size ,array))
-	    (,end (cond (,end
-			 (unless (or ,unsafe? (<= ,end ,size))
-			   ,(if fail-inline?
-				`(error "End ~D is greater than total size ~D."
-					,end ,size)
-				`(failed-%with-array-data ,array ,start ,end)))
-			 ,end)
-			(t ,size))))
-       (unless (or ,unsafe? (<= ,start ,end))
+	    (,defaulted-end
+	      (cond (,end
+		     (unless (or ,unsafe? (<= ,end ,size))
+		       ,(if fail-inline?
+			    `(error "End ~D is greater than total size ~D."
+				    ,end ,size)
+			    `(failed-%with-array-data ,array ,start ,end)))
+		     ,end)
+		    (t ,size))))
+       (unless (or ,unsafe? (<= ,start ,defaulted-end))
 	 ,(if fail-inline?
-	      `(error "Start ~D is greater than end ~D." ,start ,end)
+	      `(error "Start ~D is greater than end ~D." ,start ,defaulted-end)
 	      `(failed-%with-array-data ,array ,start ,end)))
        (do ((,data ,array (%array-data-vector ,data))
 	    (,cumulative-offset 0
@@ -522,7 +525,7 @@
 	   ((not (array-header-p ,data))
 	    (values (the (simple-array ,element-type 1) ,data)
 		    (the index (+ ,cumulative-offset ,start))
-		    (the index (+ ,cumulative-offset ,end))
+		    (the index (+ ,cumulative-offset ,defaulted-end))
 		    (the index ,cumulative-offset)))
 	 (declare (type index ,cumulative-offset))))))
 
@@ -584,10 +587,10 @@
 		`(lambda (,',array ,@n-indices
 				   ,@',(when new-value (list new-value)))
 		   (let* (,@(let ((,index -1))
-			      (mapcar #'(lambda (name)
-					  `(,name (array-dimension
-						   ,',array
-						   ,(incf ,index))))
+			      (mapcar (lambda (name)
+					`(,name (array-dimension
+						 ,',array
+						 ,(incf ,index))))
 				      dims))
 			    (,',index
 			     ,(if (null dims)

src/compiler/ir1tran.lisp

@@ -585,7 +585,8 @@
   (muffle-warning)
   (error "internal error -- no MUFFLE-WARNING restart"))
 
-;;; Trap errors during the macroexpansion.
+;;; Expand FORM using the macro whose MACRO-FUNCTION is FUN, trapping
+;;; errors which occur during the macroexpansion.
 (defun careful-expand-macro (fun form)
   (handler-bind (;; When cross-compiling, we can get style warnings
 		 ;; about e.g. undefined functions. An unhandled
@@ -2831,6 +2832,8 @@
 	       (aver (proper-list-of-length-p qdef 2))
 	       (second qdef))))
 
+    (/show "doing IR1 translator for %DEFMACRO" name)
+
     (unless (symbolp name)
       (compiler-error "The macro name ~S is not a symbol." name))
 
@@ -2840,7 +2843,8 @@
        (remhash name *free-functions*)
        (undefine-function-name name)
        (compiler-warning
-	"~S is being redefined as a macro when it was previously ~(~A~) to be a function."
+	"~S is being redefined as a macro when it was ~
+         previously ~(~A~) to be a function."
 	name
 	(info :function :where-from name)))
       (:macro)

src/compiler/srctran.lisp

@@ -2706,7 +2706,7 @@
 
 (dolist (x '(= char= + * logior logand logxor))
   (%deftransform x '(function * *) #'commutative-arg-swap
-		 "place constant arg last."))
+		 "place constant arg last"))
 
 ;;; Handle the case of a constant BOOLE-CODE.
 (deftransform boole ((op x y) * * :when :both)
@@ -3439,8 +3439,6 @@
 (defoptimizer (coerce derive-type) ((value type))
   (let ((value-type (continuation-type value))
         (type-type (continuation-type type)))
-    #!+sb-show (format t "~&coerce-derive-type value-type ~A type-type ~A~%"
-                       value-type type-type)
     (labels
         ((good-cons-type-p (cons-type)
            ;; Make sure the cons-type we're looking at is something

src/compiler/target-byte-comp.lisp

@@ -114,19 +114,22 @@
 ;;; Disassemble byte code from a SAP and constants vector.
 (defun disassem-byte-sap (sap bytes constants eps)
   (declare (optimize (inhibit-warnings 3)))
+  (/show "entering DISASSEM-BYTE-SAP" bytes constants eps)
   (let ((index 0))
     (labels ((newline ()
 	       (format t "~&~4D:" index))
 	     (next-byte ()
 	       (let ((byte (sap-ref-8 sap index)))
-		 (format t " ~2,'0X " byte)
+		 (format t " ~2,'0X" byte)
 		 (incf index)
 		 byte))
 	     (extract-24-bits ()
+	       (/show "in EXTRACT-24-BITS")
 	       (logior (ash (next-byte) 16)
 		       (ash (next-byte) 8)
 		       (next-byte)))
 	     (extract-extended-op ()
+	       (/show "in EXTRACT-EXTENDED-OP")
 	       (let ((byte (next-byte)))
 		 (if (= byte 255)
 		     (extract-24-bits)
@@ -142,6 +145,7 @@
 		     :var
 		     3-bits)))
 	     (extract-branch-target (byte)
+	       (/show "in EXTRACT-BRANCH-TARGET")
 	       (if (logbitp 0 byte)
 		   (let ((disp (next-byte)))
 		     (if (logbitp 7 disp)
@@ -155,10 +159,12 @@
 		   (aref constants index)
 		   "<bogus index>")))
       (loop
+        (/show "at head of LOOP" index bytes)
 	(unless (< index bytes)
 	  (return))
 
 	(when (eql index (first eps))
+	  (/show "in EQL INDEX (FIRST EPS) case")
 	  (newline)
 	  (pop eps)
 	  (let ((frame-size
@@ -172,6 +178,7 @@
 
 	(newline)
 	(let ((byte (next-byte)))
+	  (/show "at head of DISPATCH" index byte)
 	  (macrolet ((dispatch (&rest clauses)
 		       `(cond ,@(mapcar #'(lambda (clause)
 					    `((= (logand byte ,(caar clause))
@@ -251,6 +258,7 @@
 	      ;; if-eq
 	      (note "if-eq ~D" (extract-branch-target byte)))
 	     ((#b11111000 #b11011000)
+	      (/show "in XOP case")
 	      ;; XOP
 	      (let* ((low-3-bits (extract-3-bit-op byte))
 		     (xop (nth (if (eq low-3-bits :var) (next-byte) low-3-bits)

stems-and-flags.lisp-expr

@@ -575,11 +575,13 @@
                                       ;   from "code/pathname"
  ("src/code/sharpm"            :not-host) ; uses stuff from "code/reader"
 
- ;; stuff for byte compilation. Note that although byte code is
+ ;; stuff for byte compilation
+ ;;
+ ;; This is mostly :NOT-HOST because even though byte code is
  ;; "portable", it'd be hard to make it work on the cross-compilation
  ;; host, because fundamental BYTE-FUNCTION-OR-CLOSURE types are
- ;; implemented as FUNCALLABLE-INSTANCEs, and it's not obvious
- ;; how to emulate those in a vanilla ANSI Common Lisp.
+ ;; implemented as FUNCALLABLE-INSTANCEs, and it's not obvious how to
+ ;; emulate those in a vanilla ANSI Common Lisp.
  ("src/code/byte-types" :not-host)
  ("src/compiler/byte-comp")
  ("src/compiler/target-byte-comp" :not-host)
@@ -609,7 +611,23 @@
  ;; FIXME: Does this really need stuff from compiler/dump.lisp?
  ("src/compiler/target-dump" :not-host) ; needs stuff from compiler/dump.lisp
 
- ("src/code/cold-init" :not-host) ; needs (SETF EXTERN-ALIEN) macroexpansion
+ ("src/code/cold-init" :not-host ; needs (SETF EXTERN-ALIEN) macroexpansion
+  ;; FIXME: When building sbcl-0.pre7.14.flaky4.5 under sbcl-0.6.12.1
+  ;; with :SB-SHOW on the target *FEATURES* list, cross-compilation of
+  ;; this file gives a WARNING in HEXSTR,
+  ;;   Lisp error during constant folding:
+  ;;   Argument X is not a REAL: NIL
+  ;; This seems to come from DEF!MACRO %WITH-ARRAY-DATA-MACRO code
+  ;; which looks like
+  ;;     (cond (,end
+  ;;            (unless (or ,unsafe? (<= ,end ,size))
+  ;;		  ..))
+  ;;           ..)
+  ;; where the system is trying to constant-fold the <= form when the
+  ;; ,END binding is known to be NIL at compile time. Since the <= form 
+  ;; is unreachable in that case, this shouldn't be signalling a WARNING;
+  ;; but as long as it is, we have to ignore it in order to go on.
+  :ignore-failure-p)
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; target macros and DECLAIMs installed at build-the-cross-compiler time