Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory usw-pr-cvs1:/tmp/cvs-serv9259/src/compiler

Modified Files:
	dump.lisp main.lisp tn.lisp 
Log Message:
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


Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -d -r1.31 -r1.32
*** dump.lisp	25 Apr 2002 19:26:55 -0000	1.31
--- dump.lisp	25 Apr 2002 20:59:44 -0000	1.32
***************
*** 247,250 ****
--- 247,261 ----
  ;;;; 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
***************
*** 262,282 ****
      ;; 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)
  
      ;; 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)))
      (dump-byte +fasl-header-string-stop-char-code+ res)
  
--- 273,295 ----
      ;; Begin the header with the constant machine-readable (and
      ;; semi-human-readable) string which is used to identify fasl files.
!     (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.
!     (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)
  

Index: main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v
retrieving revision 1.52
retrieving revision 1.53
diff -C2 -d -r1.52 -r1.53
*** main.lisp	9 Mar 2002 04:50:09 -0000	1.52
--- main.lisp	25 Apr 2002 20:59:44 -0000	1.53
***************
*** 1226,1230 ****
  					 :toplevel)))
  			      lambdas
! 			      :start start)
  		 len)))
        (do* ((start 0 (1+ loser))
--- 1226,1234 ----
  					 :toplevel)))
  			      lambdas
! 			      ;; 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))

Index: tn.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/tn.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** tn.lisp	7 Feb 2002 20:37:53 -0000	1.9
--- tn.lisp	25 Apr 2002 20:59:44 -0000	1.10
***************
*** 34,37 ****
--- 34,55 ----
  	 ,@body))))
  
+ (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
***************
*** 66,74 ****
  		  (clear-live tn
  			      #'ir2-physenv-live-tns
! 			      #'(setf ir2-physenv-live-tns)))
  		 (:debug-environment
  		  (clear-live tn
  			      #'ir2-physenv-debug-live-tns
! 			      #'(setf ir2-physenv-debug-live-tns)))))
  	     (clear-live (tn getter setter)
  	       (let ((env (physenv-info (tn-physenv tn))))
--- 84,92 ----
  		  (clear-live tn
  			      #'ir2-physenv-live-tns
! 			      #'set-ir2-physenv-live-tns))
  		 (:debug-environment
  		  (clear-live tn
  			      #'ir2-physenv-debug-live-tns
! 			      #'set-ir2-physenv-debug-live-tns))))
  	     (clear-live (tn getter setter)
  	       (let ((env (physenv-info (tn-physenv tn))))
***************
*** 76,89 ****
        (declare (inline used-p delete-some delete-1 clear-live))
        (delete-some #'ir2-component-alias-tns
! 		   #'(setf 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))
        (delete-some #'ir2-component-restricted-tns
! 		   #'(setf ir2-component-restricted-tns))
        (delete-some #'ir2-component-wired-tns
! 		   #'(setf ir2-component-wired-tns))))
    (values))
  
--- 94,107 ----
        (declare (inline used-p delete-some delete-1 clear-live))
        (delete-some #'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
! 		   #'set-ir2-component-normal-tns)
        (delete-some #'ir2-component-restricted-tns
! 		   #'set-ir2-component-restricted-tns)
        (delete-some #'ir2-component-wired-tns
! 		   #'set-ir2-component-wired-tns)))
    (values))
  

Update of /cvsroot/sbcl/sbcl
In directory usw-pr-cvs1:/tmp/cvs-serv9259

Modified Files:
	build-order.lisp-expr version.lisp-expr 
Log Message:
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


Index: build-order.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/build-order.lisp-expr,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** build-order.lisp-expr	12 Mar 2002 15:47:52 -0000	1.9
--- build-order.lisp-expr	25 Apr 2002 20:59:44 -0000	1.10
***************
*** 456,463 ****
   ("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")
--- 456,459 ----
***************
*** 482,485 ****
--- 478,487 ----
   ("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

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.395
retrieving revision 1.396
diff -C2 -d -r1.395 -r1.396
*** version.lisp-expr	25 Apr 2002 19:26:54 -0000	1.395
--- version.lisp-expr	25 Apr 2002 20:59:44 -0000	1.396
***************
*** 19,21 ****
  ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
  
! "0.7.3.1"
--- 19,21 ----
  ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
  
! "0.7.3.2"

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory usw-pr-cvs1:/tmp/cvs-serv1348/src/compiler

Modified Files:
	assem.lisp dump.lisp ir1tran.lisp seqtran.lisp 
	trace-table.lisp 
Log Message:
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


Index: assem.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/assem.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** assem.lisp	12 Jan 2002 19:33:14 -0000	1.13
--- assem.lisp	25 Apr 2002 19:26:55 -0000	1.14
***************
*** 202,206 ****
  ;;;; the scheduler itself
  
! (defmacro without-scheduling ((&optional (segment '**current-segment**))
  			      &body body)
    #!+sb-doc
--- 202,206 ----
  ;;;; the scheduler itself
  
! (defmacro without-scheduling ((&optional (segment '(%%current-segment%%)))
  			      &body body)
    #!+sb-doc
***************
*** 1049,1059 ****
  ;;; change it.
  ;;;
! ;;; 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..
  (defvar **current-segment**)
  
! ;;; Just like **CURRENT-SEGMENT**, except this holds the current vop.
  ;;; Used only to keep track of which vops emit which insts.
  ;;;
--- 1049,1069 ----
  ;;; change it.
  ;;;
! ;;; 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.
  ;;; Used only to keep track of which vops emit which insts.
  ;;;
***************
*** 1062,1069 ****
  ;;; variable, because sometimes MACROLET is used to bind it. So be
  ;;; careful out there..
  (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
  ;;; to keep dereferencing the symbol. Given that ASSEMBLE is the only
  ;;; interface to **CURRENT-SEGMENT**, we don't have to worry about the
--- 1072,1080 ----
  ;;; 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 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
***************
*** 1105,1120 ****
  	(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)))
  	      ,@(mapcar (lambda (name)
  			  `(,name (gen-label)))
  			new-labels))
! 	 (symbol-macrolet ((**current-segment** ,seg-var)
! 			   (**current-vop** ,vop-var)
! 			   ,@(when (or inherited-labels nested-labels)
  			       `((..inherited-labels.. ,nested-labels))))
  	   ,@(mapcar (lambda (form)
--- 1116,1131 ----
  	(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)))
  	      ,@(mapcar (lambda (name)
  			  `(,name (gen-label)))
  			new-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)
***************
*** 1122,1126 ****
  			   `(emit-label ,form)
  			   form))
! 		     body))))))
  #+sb-xc-host
  (sb!xc:defmacro assemble ((&optional segment vop &key labels)
--- 1133,1137 ----
  			   `(emit-label ,form)
  			   form))
! 		     body)))))))
  #+sb-xc-host
  (sb!xc:defmacro assemble ((&optional segment vop &key labels)
***************
*** 1147,1162 ****
  	(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)))
  	      ,@(mapcar (lambda (name)
  			  `(,name (gen-label)))
  			new-labels))
! 	 (symbol-macrolet ((**current-segment** ,seg-var)
! 			   (**current-vop** ,vop-var)
! 			   ,@(when (or inherited-labels nested-labels)
  			       `((..inherited-labels.. ,nested-labels))))
  	   ,@(mapcar (lambda (form)
--- 1158,1173 ----
  	(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)))
  	      ,@(mapcar (lambda (name)
  			  `(,name (gen-label)))
  			new-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)
***************
*** 1164,1168 ****
  			   `(emit-label ,form)
  			   form))
! 		     body))))))
  
  (defmacro inst (&whole whole instruction &rest args &environment env)
--- 1175,1179 ----
  			   `(emit-label ,form)
  			   form))
! 		     body)))))))
  
  (defmacro inst (&whole whole instruction &rest args &environment env)
***************
*** 1175,1179 ****
  	   (funcall inst (cdr whole) env))
  	  (t
! 	   `(,inst **current-segment** **current-vop** ,@args)))))
  
  ;;; Note: The need to capture SYMBOL-MACROLET bindings of
--- 1186,1190 ----
  	   (funcall inst (cdr whole) env))
  	  (t
! 	   `(,inst (%%current-segment%%) (%%current-vop%%) ,@args)))))
  
  ;;; Note: The need to capture SYMBOL-MACROLET bindings of
***************
*** 1183,1200 ****
    #!+sb-doc
    "Emit LABEL at this location in the current segment."
!   `(%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))
  
  ;;; Note: The need to capture SYMBOL-MACROLET bindings of
! ;;; **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))
  ;;; FIXME: By analogy with EMIT-LABEL and EMIT-POSTIT, this should be
  ;;; called EMIT-ALIGNMENT, and the function that it calls should be
--- 1194,1211 ----
    #!+sb-doc
    "Emit LABEL at this location in the current segment."
!   `(%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))
  
  ;;; Note: The need to capture SYMBOL-MACROLET bindings of
! ;;; **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))
  ;;; FIXME: By analogy with EMIT-LABEL and EMIT-POSTIT, this should be
  ;;; called EMIT-ALIGNMENT, and the function that it calls should be
***************
*** 1587,1606 ****
  	   (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))))
  	       ,@emitter))
  	   (values))
--- 1598,1604 ----
  	   (let ((,postits (segment-postits ,segment-name)))
  	     (setf (segment-postits ,segment-name) nil)
! 	     (macrolet ((%%current-segment%% ()
! 			  (error "You can't use INST without an ~
! 				  ASSEMBLE inside emitters.")))
  	       ,@emitter))
  	   (values))

Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** dump.lisp	15 Feb 2002 17:10:02 -0000	1.30
--- dump.lisp	25 Apr 2002 19:26:55 -0000	1.31
***************
*** 566,570 ****
  (defun dump-package (pkg file)
    (declare (type package pkg) (type fasl-output file))
!   (declare (values index))
    (declare (inline assoc))
    (cond ((cdr (assoc pkg (fasl-output-packages file) :test #'eq)))
--- 566,570 ----
  (defun dump-package (pkg file)
    (declare (type package pkg) (type fasl-output file))
!   #+nil (declare (values index))
    (declare (inline assoc))
    (cond ((cdr (assoc pkg (fasl-output-packages file) :test #'eq)))

Index: ir1tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v
retrieving revision 1.76
retrieving revision 1.77
diff -C2 -d -r1.76 -r1.77
*** ir1tran.lisp	1 Apr 2002 14:52:23 -0000	1.76
--- ir1tran.lisp	25 Apr 2002 19:26:55 -0000	1.77
***************
*** 127,131 ****
  (defun find-free-fun (name context)
    (declare (string context))
!   (declare (values global-var))
    (or (let ((old-free-fun (gethash name *free-funs*)))
  	(and (not (invalid-free-fun-p old-free-fun))
--- 127,131 ----
  (defun find-free-fun (name context)
    (declare (string context))
!   #+nil (declare (values global-var))
    (or (let ((old-free-fun (gethash name *free-funs*)))
  	(and (not (invalid-free-fun-p old-free-fun))
***************
*** 173,177 ****
  ;;; *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
    (unless (symbolp name)
      (compiler-error "Variable name is not a symbol: ~S." name))
--- 173,177 ----
  ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning.
  (defun find-free-var (name)
!   #+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))

Index: seqtran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/seqtran.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** seqtran.lisp	17 Apr 2002 02:19:38 -0000	1.25
--- seqtran.lisp	25 Apr 2002 19:26:55 -0000	1.26
***************
*** 606,609 ****
--- 606,618 ----
  ;;;; 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?

Index: trace-table.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/trace-table.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** trace-table.lisp	11 Oct 2001 14:05:25 -0000	1.6
--- trace-table.lisp	25 Apr 2002 19:26:55 -0000	1.7
***************
*** 13,16 ****
--- 13,17 ----
  
  (defun trace-table-entry (state)
+   (declare (special *trace-table-info*))
    (let ((label (gen-label)))
      (emit-label label)

Update of /cvsroot/sbcl/sbcl/src/compiler/generic
In directory usw-pr-cvs1:/tmp/cvs-serv1348/src/compiler/generic

Modified Files:
	vm-tran.lisp 
Log Message:
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


Index: vm-tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/vm-tran.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** vm-tran.lisp	17 Jan 2002 15:41:21 -0000	1.17
--- vm-tran.lisp	25 Apr 2002 19:26:55 -0000	1.18
***************
*** 12,22 ****
  (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
--- 12,15 ----

Update of /cvsroot/sbcl/sbcl/src/code
In directory usw-pr-cvs1:/tmp/cvs-serv1348/src/code

Modified Files:
	early-extensions.lisp host-alieneval.lisp 
	primordial-extensions.lisp 
Log Message:
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


Index: early-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v
retrieving revision 1.42
retrieving revision 1.43
diff -C2 -d -r1.42 -r1.43
*** early-extensions.lisp	15 Apr 2002 15:58:24 -0000	1.42
--- early-extensions.lisp	25 Apr 2002 19:26:54 -0000	1.43
***************
*** 14,29 ****
  (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"))
--- 14,17 ----

Index: host-alieneval.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/host-alieneval.lisp,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** host-alieneval.lisp	5 Mar 2002 03:53:05 -0000	1.22
--- host-alieneval.lisp	25 Apr 2002 19:26:55 -0000	1.23
***************
*** 116,120 ****
  					   (if (atom x) x (car x)))
  					 slots)
! 			       ,@include-args)))
  	   ,@slots)))))
  
--- 116,122 ----
  					   (if (atom x) x (car x)))
  					 slots)
! 			       ,@include-args
! 			       ;; KLUDGE
! 			       &aux (alignment (or alignment (guess-alignment bits))))))
  	   ,@slots)))))
  
***************
*** 323,330 ****
  (def!struct (alien-type
  	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
! 	     (:constructor make-alien-type (&key class bits alignment)))
    (class 'root :type symbol)
    (bits nil :type (or null unsigned-byte))
!   (alignment (guess-alignment bits) :type (or null unsigned-byte)))
  (def!method print-object ((type alien-type) stream)
    (print-unreadable-object (type stream :type t)
--- 325,333 ----
  (def!struct (alien-type
  	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
! 	     (: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 nil :type (or null unsigned-byte)))
  (def!method print-object ((type alien-type) stream)
    (print-unreadable-object (type stream :type t)
***************
*** 1138,1149 ****
  	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
  	     (:constructor make-local-alien-info
! 			   (&key type force-to-memory-p)))
    ;; 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)))
  (def!method print-object ((info local-alien-info) stream)
    (print-unreadable-object (info stream :type t)
--- 1141,1153 ----
  	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
  	     (:constructor make-local-alien-info
! 			   (&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 nil :type (member t nil)))
  (def!method print-object ((info local-alien-info) stream)
    (print-unreadable-object (info stream :type t)

Index: primordial-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/primordial-extensions.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** primordial-extensions.lisp	15 Jan 2002 23:53:51 -0000	1.18
--- primordial-extensions.lisp	25 Apr 2002 19:26:55 -0000	1.19
***************
*** 134,137 ****
--- 134,149 ----
  ;;;; 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.

Update of /cvsroot/sbcl/sbcl
In directory usw-pr-cvs1:/tmp/cvs-serv1348

Modified Files:
	INSTALL version.lisp-expr 
Log Message:
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


Index: INSTALL
===================================================================
RCS file: /cvsroot/sbcl/sbcl/INSTALL,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** INSTALL	1 Nov 2000 01:10:03 -0000	1.3
--- INSTALL	25 Apr 2002 19:26:54 -0000	1.4
***************
*** 95,101 ****
       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
--- 95,98 ----

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.394
retrieving revision 1.395
diff -C2 -d -r1.394 -r1.395
*** version.lisp-expr	24 Apr 2002 19:57:24 -0000	1.394
--- version.lisp-expr	25 Apr 2002 19:26:54 -0000	1.395
***************
*** 19,21 ****
  ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
  
! "0.7.3"
--- 19,21 ----
  ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
  
! "0.7.3.1"

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory usw-pr-cvs1:/tmp/cvs-serv1348/src/compiler/x86

Modified Files:
	insts.lisp parms.lisp 
Log Message:
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


Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/insts.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** insts.lisp	16 Jan 2002 15:40:15 -0000	1.17
--- insts.lisp	25 Apr 2002 19:26:55 -0000	1.18
***************
*** 20,23 ****
--- 20,25 ----
  
  (deftype reg () '(unsigned-byte 3))
+ 
+ (defconstant +default-operand-size+ :dword)
  
  (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
***************
*** 793,798 ****
  
  (defconstant +operand-size-prefix-byte+ #b01100110)
- 
- (defconstant +default-operand-size+ :dword)
  
  (defun maybe-emit-operand-size-prefix (segment size)
--- 795,798 ----

Index: parms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/parms.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -C2 -d -r1.25 -r1.26
*** parms.lisp	20 Jan 2002 18:31:24 -0000	1.25
--- parms.lisp	25 Apr 2002 19:26:55 -0000	1.26
***************
*** 166,177 ****
  
    (defconstant control-stack-start
!     #+freebsd #x40000000
!     #+openbsd #x48000000)
    (defconstant control-stack-end
!     #+freebsd #x47fff000
!     #+openbsd #x4ffff000)
    (defconstant dynamic-space-start
!     #+freebsd #x48000000
!     #+openbsd #x50000000)
    (defconstant dynamic-space-end     #x88000000))
  
--- 166,177 ----
  
    (defconstant control-stack-start
!     #!+freebsd #x40000000
!     #!+openbsd #x48000000)
    (defconstant control-stack-end
!     #!+freebsd #x47fff000
!     #!+openbsd #x4ffff000)
    (defconstant dynamic-space-start
!     #!+freebsd #x48000000
!     #!+openbsd #x50000000)
    (defconstant dynamic-space-end     #x88000000))