0.7.3.1:

	finally getting to CLISP bootstrapping...
	...merged CSR patch "more controversial fixes" from "Re: CLISP
		compilation" sbcl-devel 2002-04-15 (which don't look
		very controversial except for the **CURRENT-SEGMENT**
		code, which is going to have to be fixed somehow and
		for which this fix looks plausible)
	...made comment fixes mostly related to CSR patch
	...fixed "#+"-should-be-"#!+" typos in parms.lisp

diff --git a/INSTALL b/INSTALL
index 67e0771..cce955d 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -94,9 +94,6 @@ To build the system binaries:
      per the CAUTION note above. (As of version 0.6.0, the most
      memory-intensive operation in make.sh is the second call to
      GENESIS, which makes the Lisp image grow to nearly 128 Mb RAM+swap.
-     This will probably be reduced somewhat in some later version
-     by allowing cold load of byte-compiled files, so that the cold
-     image can be smaller.)
   2. If the GNU make command is not available under the name "gmake",
      then define the environment variable GNUMAKE to a name where it can
      be found.

diff --git a/src/code/early-extensions.lisp b/src/code/early-extensions.lisp
index 67bfa89..26eb070 100644 (file)
--- a/src/code/early-extensions.lisp
+++ b/src/code/early-extensions.lisp
@@ -13,18 +13,6 @@
 
 (in-package "SB!IMPL")
 
-;;; Lots of code wants to get to the KEYWORD package or the
-;;; COMMON-LISP package without a lot of fuss, so we cache them in
-;;; variables. TO DO: How much does this actually buy us? It sounds
-;;; sensible, but I don't know for sure that it saves space or time..
-;;; -- WHN 19990521
-;;;
-;;; (The initialization forms here only matter on the cross-compilation
-;;; host; In the target SBCL, these variables are set in cold init.)
-(declaim (type package *cl-package* *keyword-package*))
-(defvar *cl-package*      (find-package "COMMON-LISP"))
-(defvar *keyword-package* (find-package "KEYWORD"))
-
 ;;; something not EQ to anything we might legitimately READ
 (defparameter *eof-object* (make-symbol "EOF-OBJECT"))
 

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index d241f61..647dc39 100644 (file)
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -115,7 +115,9 @@
                               ,@(mapcar (lambda (x)
                                           (if (atom x) x (car x)))
                                         slots)
-                              ,@include-args)))
+                              ,@include-args
+                              ;; KLUDGE
+                              &aux (alignment (or alignment (guess-alignment bits))))))
           ,@slots)))))
 
 (def!macro define-alien-type-method ((class method) lambda-list &rest body)
@@ -322,10 +324,11 @@
 
 (def!struct (alien-type
             (:make-load-form-fun sb!kernel:just-dump-it-normally)
-            (:constructor make-alien-type (&key class bits alignment)))
+            (:constructor make-alien-type (&key class bits alignment
+                                           &aux (alignment (or alignment (guess-alignment bits))))))
   (class 'root :type symbol)
   (bits nil :type (or null unsigned-byte))
-  (alignment (guess-alignment bits) :type (or null unsigned-byte)))
+  (alignment nil :type (or null unsigned-byte)))
 (def!method print-object ((type alien-type) stream)
   (print-unreadable-object (type stream :type t)
     (prin1 (unparse-alien-type type) stream)))
@@ -1137,14 +1140,15 @@
 (def!struct (local-alien-info
             (:make-load-form-fun sb!kernel:just-dump-it-normally)
             (:constructor make-local-alien-info
-                          (&key type force-to-memory-p)))
+                          (&key type force-to-memory-p
+                           &aux (force-to-memory-p (or force-to-memory-p
+                                                       (alien-array-type-p type)
+                                                       (alien-record-type-p type))))))
   ;; the type of the local alien
   (type (missing-arg) :type alien-type)
   ;; Must this local alien be forced into memory? Using the ADDR macro
   ;; on a local alien will set this.
-  (force-to-memory-p (or (alien-array-type-p type)
-                        (alien-record-type-p type))
-                    :type (member t nil)))
+  (force-to-memory-p nil :type (member t nil)))
 (def!method print-object ((info local-alien-info) stream)
   (print-unreadable-object (info stream :type t)
     (format stream

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index b496278..38aa063 100644 (file)
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -133,6 +133,18 @@
 \f
 ;;;; miscellany
 
+;;; Lots of code wants to get to the KEYWORD package or the
+;;; COMMON-LISP package without a lot of fuss, so we cache them in
+;;; variables. TO DO: How much does this actually buy us? It sounds
+;;; sensible, but I don't know for sure that it saves space or time..
+;;; -- WHN 19990521
+;;;
+;;; (The initialization forms here only matter on the cross-compilation
+;;; host; In the target SBCL, these variables are set in cold init.)
+(declaim (type package *cl-package* *keyword-package*))
+(defvar *cl-package*      (find-package "COMMON-LISP"))
+(defvar *keyword-package* (find-package "KEYWORD"))
+
 ;;; Concatenate together the names of some strings and symbols,
 ;;; producing a symbol in the current package.
 (eval-when (:compile-toplevel :load-toplevel :execute)

diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp
index 3033cb4..5373290 100644 (file)
--- a/src/compiler/assem.lisp
+++ b/src/compiler/assem.lisp
@@ -201,7 +201,7 @@
 \f
 ;;;; the scheduler itself
 
-(defmacro without-scheduling ((&optional (segment '**current-segment**))
+(defmacro without-scheduling ((&optional (segment '(%%current-segment%%)))
                              &body body)
   #!+sb-doc
   "Execute BODY (as a PROGN) without scheduling any of the instructions
@@ -1048,23 +1048,34 @@ p           ;; the branch has two dependents and one of them dpends on
 ;;; This holds the current segment while assembling. Use ASSEMBLE to
 ;;; change it.
 ;;;
-;;; The double asterisks in the name are intended to suggest that this
+;;; The double parens in the name are intended to suggest that this
 ;;; isn't just any old special variable, it's an extra-special
 ;;; variable, because sometimes MACROLET is used to bind it. So be
 ;;; careful out there..
+;;;
+;;; (This used to be called **CURRENT-SEGMENT** in SBCL until 0.7.3,
+;;; and just *CURRENT-SEGMENT* in CMU CL. In both cases, the rebinding
+;;; now done with MACROLET was done with SYMBOL-MACROLET instead. The
+;;; rename-with-double-asterisks was because the SYMBOL-MACROLET made
+;;; it an extra-special variable. The change over to
+;;; %%CURRENT-SEGMENT%% was because ANSI forbids the use of
+;;; SYMBOL-MACROLET on special variable names, and CLISP correctly
+;;; complains about this when being used as a bootstrap host.)
+(defmacro %%current-segment%% () '**current-segment**)
 (defvar **current-segment**)
 
-;;; Just like **CURRENT-SEGMENT**, except this holds the current vop.
+;;; Just like %%CURRENT-SEGMENT%%, except this holds the current vop.
 ;;; Used only to keep track of which vops emit which insts.
 ;;;
 ;;; The double asterisks in the name are intended to suggest that this
 ;;; isn't just any old special variable, it's an extra-special
 ;;; variable, because sometimes MACROLET is used to bind it. So be
 ;;; careful out there..
+(defmacro %%current-vop%% () '**current-vop**)
 (defvar **current-vop** nil)
 
-;;; We also SYMBOL-MACROLET **CURRENT-SEGMENT** to a local holding the
-;;; segment so uses of **CURRENT-SEGMENT** inside the body don't have
+;;; We also MACROLET %%CURRENT-SEGMENT%% to a local holding the
+;;; segment so uses of %%CURRENT-SEGMENT%% inside the body don't have
 ;;; to keep dereferencing the symbol. Given that ASSEMBLE is the only
 ;;; interface to **CURRENT-SEGMENT**, we don't have to worry about the
 ;;; special value becomming out of sync with the lexical value. Unless
@@ -1104,24 +1115,24 @@ p           ;; the branch has two dependents and one of them dpends on
       (when (intersection labels inherited-labels)
        (error "duplicate nested labels: ~S"
               (intersection labels inherited-labels)))
-      `(let* ((,seg-var ,(or segment '**current-segment**))
-             (,vop-var ,(or vop '**current-vop**))
-             ,@(when segment
-                 `((**current-segment** ,seg-var)))
-             ,@(when vop
-                 `((**current-vop** ,vop-var)))
+      `(let* ((,seg-var ,(or segment '(%%current-segment%%)))
+             (,vop-var ,(or vop '(%%current-vop%%)))
+              ,@(when segment
+                  `((**current-segment** ,seg-var)))
+              ,@(when vop
+                  `((**current-vop** ,vop-var)))
              ,@(mapcar (lambda (name)
                          `(,name (gen-label)))
                        new-labels))
-        (symbol-macrolet ((**current-segment** ,seg-var)
-                          (**current-vop** ,vop-var)
-                          ,@(when (or inherited-labels nested-labels)
+       (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))))))
+                    body)))))))
 #+sb-xc-host
 (sb!xc:defmacro assemble ((&optional segment vop &key labels)
                          &body body
@@ -1146,24 +1157,24 @@ p           ;; the branch has two dependents and one of them dpends on
       (when (intersection labels inherited-labels)
        (error "duplicate nested labels: ~S"
               (intersection labels inherited-labels)))
-      `(let* ((,seg-var ,(or segment '**current-segment**))
-             (,vop-var ,(or vop '**current-vop**))
-             ,@(when segment
-                 `((**current-segment** ,seg-var)))
-             ,@(when vop
-                 `((**current-vop** ,vop-var)))
+      `(let* ((,seg-var ,(or segment '(%%current-segment%%)))
+             (,vop-var ,(or vop '(%%current-vop%%)))
+              ,@(when segment
+                  `((**current-segment** ,seg-var)))
+              ,@(when vop
+                  `((**current-vop** ,vop-var)))
              ,@(mapcar (lambda (name)
                          `(,name (gen-label)))
                        new-labels))
-        (symbol-macrolet ((**current-segment** ,seg-var)
-                          (**current-vop** ,vop-var)
-                          ,@(when (or inherited-labels nested-labels)
+       (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))))))
+                    body)))))))
 
 (defmacro inst (&whole whole instruction &rest args &environment env)
   #!+sb-doc
@@ -1174,7 +1185,7 @@ p     ;; the branch has two dependents and one of them dpends on
          ((functionp inst)
           (funcall inst (cdr whole) env))
          (t
-          `(,inst **current-segment** **current-vop** ,@args)))))
+          `(,inst (%%current-segment%%) (%%current-vop%%) ,@args)))))
 
 ;;; Note: The need to capture SYMBOL-MACROLET bindings of
 ;;; **CURRENT-SEGMENT* and **CURRENT-VOP** prevents this from being an
@@ -1182,20 +1193,20 @@ p           ;; the branch has two dependents and one of them dpends on
 (defmacro emit-label (label)
   #!+sb-doc
   "Emit LABEL at this location in the current segment."
-  `(%emit-label **current-segment** **current-vop** ,label))
+  `(%emit-label (%%current-segment%%) (%%current-vop%%) ,label))
 
 ;;; Note: The need to capture SYMBOL-MACROLET bindings of
 ;;; **CURRENT-SEGMENT* prevents this from being an ordinary function.
 (defmacro emit-postit (function)
-  `(%emit-postit **current-segment** ,function))
+  `(%emit-postit (%%current-segment%%) ,function))
 
 ;;; Note: The need to capture SYMBOL-MACROLET bindings of
-;;; **CURRENT-SEGMENT* and **CURRENT-VOP** prevents this from being an
+;;; **CURRENT-SEGMENT* and (%%CURRENT-VOP%%) prevents this from being an
 ;;; ordinary function.
 (defmacro align (bits &optional (fill-byte 0))
   #!+sb-doc
   "Emit an alignment restriction to the current segment."
-  `(emit-alignment **current-segment** **current-vop** ,bits ,fill-byte))
+  `(emit-alignment (%%current-segment%%) (%%current-vop%%) ,bits ,fill-byte))
 ;;; FIXME: By analogy with EMIT-LABEL and EMIT-POSTIT, this should be
 ;;; called EMIT-ALIGNMENT, and the function that it calls should be
 ;;; called %EMIT-ALIGNMENT.
@@ -1586,22 +1597,9 @@ p            ;; the branch has two dependents and one of them dpends on
               `((declare ,@decls)))
           (let ((,postits (segment-postits ,segment-name)))
             (setf (segment-postits ,segment-name) nil)
-            (symbol-macrolet
-                (;; Apparently this binding is intended to keep
-                 ;; anyone from accidentally using
-                 ;; **CURRENT-SEGMENT** within the body of the
-                 ;; emitter. The error message sorta suggests that
-                 ;; this can happen accidentally by including one
-                 ;; emitter inside another. But I dunno.. -- WHN
-                 ;; 19990323
-                 (**current-segment**
-                  ;; FIXME: I can't see why we have to use
-                  ;;   (MACROLET ((LOSE () (ERROR ..))) (LOSE))
-                  ;; instead of just (ERROR "..") here.
-                  (macrolet ((lose ()
-                               (error "You can't use INST without an ~
-                                       ASSEMBLE inside emitters.")))
-                    (lose))))
+            (macrolet ((%%current-segment%% ()
+                         (error "You can't use INST without an ~
+                                 ASSEMBLE inside emitters.")))
               ,@emitter))
           (values))
         (eval-when (:compile-toplevel :load-toplevel :execute)

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 4e940e2..82469dd 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -565,7 +565,7 @@
 ;;; should be made more consistent.
 (defun dump-package (pkg file)
   (declare (type package pkg) (type fasl-output file))
-  (declare (values index))
+  #+nil (declare (values index))
   (declare (inline assoc))
   (cond ((cdr (assoc pkg (fasl-output-packages file) :test #'eq)))
        (t

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 8b24413..e28bc13 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -11,13 +11,6 @@
 
 (in-package "SB!C")
 
-;;; FIXME: It would be good to implement SB!XC:DEFCONSTANT, and use
-;;; use that here, so that the compiler is born knowing this value.
-;;; FIXME: Add a comment telling whether this holds for all vectors
-;;; or only for vectors based on simple arrays (non-adjustable, etc.).
-(defconstant vector-data-bit-offset
-  (* sb!vm:vector-data-offset sb!vm:n-word-bits))
-
 ;;; We need to define these predicates, since the TYPEP source
 ;;; transform picks whichever predicate was defined last when there
 ;;; are multiple predicates for equivalent types.

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index c571de3..f7185ea 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -126,7 +126,7 @@
 ;;; demanded a function.
 (defun find-free-fun (name context)
   (declare (string context))
-  (declare (values global-var))
+  #+nil (declare (values global-var))
   (or (let ((old-free-fun (gethash name *free-funs*)))
        (and (not (invalid-free-fun-p old-free-fun))
             old-free-fun))
@@ -172,7 +172,7 @@
 ;;; information from the global environment and enter it in
 ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning.
 (defun find-free-var (name)
-  (declare (values (or leaf cons heap-alien-info))) ; see FIXME comment
+  #+nil (declare (values (or leaf cons heap-alien-info))) ; see FIXME comment
   (unless (symbolp name)
     (compiler-error "Variable name is not a symbol: ~S." name))
   (or (gethash name *free-vars*)

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 2e5251d..b10fd2e 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -605,6 +605,15 @@
 ;;;; calls when all arguments are vectors with the same element type,
 ;;;; rather than restricting them to STRINGs only.
 
+;;; Moved here from generic/vm-tran.lisp to satisfy clisp
+;;;
+;;; FIXME: It would be good to implement SB!XC:DEFCONSTANT, and use
+;;; use that here, so that the compiler is born knowing this value.
+;;; FIXME: Add a comment telling whether this holds for all vectors
+;;; or only for vectors based on simple arrays (non-adjustable, etc.).
+(defconstant vector-data-bit-offset
+  (* sb!vm:vector-data-offset sb!vm:n-word-bits))
+
 ;;; FIXME: Shouldn't we be testing for legality of
 ;;;   * START1, START2, END1, and END2 indices?
 ;;;   * size of copied string relative to destination string?

diff --git a/src/compiler/trace-table.lisp b/src/compiler/trace-table.lisp
index 88fdb0f..6c77bd1 100644 (file)
--- a/src/compiler/trace-table.lisp
+++ b/src/compiler/trace-table.lisp
@@ -12,6 +12,7 @@
 (in-package "SB!C")
 
 (defun trace-table-entry (state)
+  (declare (special *trace-table-info*))
   (let ((label (gen-label)))
     (emit-label label)
     (push (cons label state) *trace-table-info*))

diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp
index 12cc5bf..e64d650 100644 (file)
--- a/src/compiler/x86/insts.lisp
+++ b/src/compiler/x86/insts.lisp
@@ -19,6 +19,8 @@
 (setf sb!disassem:*disassem-inst-alignment-bytes* 1)
 
 (deftype reg () '(unsigned-byte 3))
+
+(defconstant +default-operand-size+ :dword)
 \f
 (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
 
@@ -793,8 +795,6 @@
 
 (defconstant +operand-size-prefix-byte+ #b01100110)
 
-(defconstant +default-operand-size+ :dword)
-
 (defun maybe-emit-operand-size-prefix (segment size)
   (unless (or (eq size :byte) (eq size +default-operand-size+))
     (emit-byte segment +operand-size-prefix-byte+)))

diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp
index 7b88f3e..d698ff0 100644 (file)
--- a/src/compiler/x86/parms.lisp
+++ b/src/compiler/x86/parms.lisp
@@ -165,14 +165,14 @@
   (defconstant binding-stack-end     #x3ffff000)
 
   (defconstant control-stack-start
-    #+freebsd #x40000000
-    #+openbsd #x48000000)
+    #!+freebsd #x40000000
+    #!+openbsd #x48000000)
   (defconstant control-stack-end
-    #+freebsd #x47fff000
-    #+openbsd #x4ffff000)
+    #!+freebsd #x47fff000
+    #!+openbsd #x4ffff000)
   (defconstant dynamic-space-start
-    #+freebsd #x48000000
-    #+openbsd #x50000000)
+    #!+freebsd #x48000000
+    #!+openbsd #x50000000)
   (defconstant dynamic-space-end     #x88000000))
 
 ;;; Given that NIL is the first thing allocated in static space, we

diff --git a/version.lisp-expr b/version.lisp-expr
index f9d5c40..3e931c3 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"
+"0.7.3.1"