From: William Harold Newman Date: Thu, 25 Apr 2002 19:26:54 +0000 (+0000) Subject: 0.7.3.1: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=86210c4e406c1b2ff10cc3bac0e71435867db48b;p=sbcl.git 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 --- 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 --- 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 --- 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 --- a/src/code/primordial-extensions.lisp +++ b/src/code/primordial-extensions.lisp @@ -133,6 +133,18 @@ ;;;; 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 --- a/src/compiler/assem.lisp +++ b/src/compiler/assem.lisp @@ -201,7 +201,7 @@ ;;;; 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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) (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 --- 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 --- 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"