0.7.3.2:

	(slightly dangerous, as WHN committed while I was building, but
		these fixes have been in my tree for a while, anyway)
	More clisp bootstrapping fixes:
	... define FASL-WRITE-STRING to write fasl headers, and use it
	... don't pass :start arguments that are greater than the length
		of the sequence
	... make set-functions to pass around for structure setters, rather
		than #'(setf slot)
	... move compiler/generic/vm-tran.lisp later in the build order

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index 8c77713..9ff03fd 100644 (file)
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -455,10 +455,6 @@
  ("src/compiler/ir1report")
  ("src/compiler/ir1opt")
 
- ;; Compiling this file requires the macros SB!ASSEM:EMIT-LABEL and
- ;; SB!ASSEM:EMIT-POST-IT, defined in assem.lisp.
- ("src/compiler/late-vmdef")
-
  ("src/compiler/ir1final")
  ("src/compiler/array-tran")
  ("src/compiler/seqtran")
@@ -482,6 +478,12 @@
  ("src/compiler/generic/utils")
  ("src/assembly/assemfile")
 
+ ;; Compiling this file requires the macros SB!ASSEM:EMIT-LABEL and
+ ;; SB!ASSEM:EMIT-POST-IT, defined in assem.lisp, and also possibly
+ ;; the definition of the LOCATION-INFO structure (if structures in
+ ;; the host lisp have setf expanders rather than setf functions).
+ ("src/compiler/late-vmdef")
+
  ("src/compiler/fixup") ; for DEFSTRUCT FIXUP, used by insts.lisp
 
  ("src/compiler/target/insts")

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 82469dd..094f646 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -246,6 +246,17 @@
 \f
 ;;;; opening and closing fasl files
 
+;;; A utility function to write strings to (unsigned-byte 8) streams.
+;;; We restrict this to ASCII (with the averrance) because of
+;;; ambiguity of higher bytes: Unicode, some ISO-8859-x, or what? This
+;;; could be revisited in the event of doing funky things with stream
+;;; encodings -- CSR, 2002-04-25
+(defun fasl-write-string (string stream)
+  (loop for char across string
+       do (let ((code (char-code char)))
+            (aver (<= 0 code 127))
+            (write-byte code stream))))
+
 ;;; Open a fasl file, write its header, and return a FASL-OUTPUT
 ;;; object for dumping to it. Some human-readable information about
 ;;; the source code is given by the string WHERE. If BYTE-P is true,
@@ -261,23 +272,25 @@
 
     ;; Begin the header with the constant machine-readable (and
     ;; semi-human-readable) string which is used to identify fasl files.
-    (write-string *fasl-header-string-start-string* stream)
+    (fasl-write-string *fasl-header-string-start-string* stream)
 
     ;; The constant string which begins the header is followed by
     ;; arbitrary human-readable text, terminated by a special
     ;; character code.
-    (with-standard-io-syntax
-     (format stream
-            "~%  ~
-            compiled from ~S~%  ~
-            at ~A~%  ~
-            on ~A~%  ~
-            using ~A version ~A~%"
-            where
-            (format-universal-time nil (get-universal-time))
-            (machine-instance)
-            (sb!xc:lisp-implementation-type)
-            (sb!xc:lisp-implementation-version)))
+    (fasl-write-string
+     (with-standard-io-syntax
+       (format nil
+              "~%  ~
+               compiled from ~S~%  ~
+               at ~A~%  ~
+               on ~A~%  ~
+               using ~A version ~A~%"
+               where
+               (format-universal-time nil (get-universal-time))
+               (machine-instance)
+               (sb!xc:lisp-implementation-type)
+               (sb!xc:lisp-implementation-version)))
+     stream)
     (dump-byte +fasl-header-string-stop-char-code+ res)
 
     ;; Finish the header by outputting fasl file implementation and

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index b5ad7f1..c44d601 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -1225,7 +1225,11 @@
                                          (node-component (lambda-bind x)))
                                         :toplevel)))
                              lambdas
-                             :start start)
+                             ;; this used to read ":start start", but
+                             ;; start can be greater than len, which
+                             ;; is an error according to ANSI - CSR,
+                             ;; 2002-04-25
+                             :start (min start len))
                 len)))
       (do* ((start 0 (1+ loser))
            (loser (loser start) (loser start)))

diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp
index e0b6a26..8ec5260 100644 (file)
--- a/src/compiler/tn.lisp
+++ b/src/compiler/tn.lisp
@@ -33,6 +33,24 @@
            ,result)
         ,@body))))
 \f
+(defun set-ir2-physenv-live-tns (value instance)
+  (setf (ir2-physenv-live-tns instance) value))
+
+(defun set-ir2-physenv-debug-live-tns (value instance)
+  (setf (ir2-physenv-debug-live-tns instance) value))
+
+(defun set-ir2-component-alias-tns (value instance)
+  (setf (ir2-component-alias-tns instance) value))
+
+(defun set-ir2-component-normal-tns (value instance)
+  (setf (ir2-component-normal-tns instance) value))
+
+(defun set-ir2-component-restricted-tns (value instance)
+  (setf (ir2-component-restricted-tns instance) value))
+
+(defun set-ir2-component-wired-tns (value instance)
+  (setf (ir2-component-wired-tns instance) value))
+
 ;;; Remove all TNs with no references from the lists of unpacked TNs.
 ;;; We null out the Offset so that nobody will mistake deleted wired
 ;;; TNs for properly packed TNs. We mark non-deleted alias TNs so that
@@ -65,26 +83,26 @@
                 (:environment
                  (clear-live tn
                              #'ir2-physenv-live-tns
-                             #'(setf ir2-physenv-live-tns)))
+                             #'set-ir2-physenv-live-tns))
                 (:debug-environment
                  (clear-live tn
                              #'ir2-physenv-debug-live-tns
-                             #'(setf ir2-physenv-debug-live-tns)))))
+                             #'set-ir2-physenv-debug-live-tns))))
             (clear-live (tn getter setter)
               (let ((env (physenv-info (tn-physenv tn))))
                 (funcall setter (delete tn (funcall getter env)) env))))
       (declare (inline used-p delete-some delete-1 clear-live))
       (delete-some #'ir2-component-alias-tns
-                  #'(setf ir2-component-alias-tns))
+                  #'set-ir2-component-alias-tns)
       (do ((tn (ir2-component-alias-tns 2comp) (tn-next tn)))
          ((null tn))
        (setf (sbit aliases (tn-number (tn-save-tn tn))) 1))
       (delete-some #'ir2-component-normal-tns
-                  #'(setf ir2-component-normal-tns))
+                  #'set-ir2-component-normal-tns)
       (delete-some #'ir2-component-restricted-tns
-                  #'(setf ir2-component-restricted-tns))
+                  #'set-ir2-component-restricted-tns)
       (delete-some #'ir2-component-wired-tns
-                  #'(setf ir2-component-wired-tns))))
+                  #'set-ir2-component-wired-tns)))
   (values))
 \f
 ;;;; TN creation

diff --git a/version.lisp-expr b/version.lisp-expr
index 3e931c3..349c76a 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.3.1"
+"0.7.3.2"