From 78a057624fecd10d0fb2ead4ef02ffc361b1ee22 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Fri, 8 Feb 2002 23:10:25 +0000 Subject: [PATCH] 0.7.1.16: merged the first of the two patches (the one that's supposed to work) from Dave McDonald's "patch for CLISP compilation" message (sbcl-devel 2002-02-03)... ...stopped use of keywords as slot names in DEFSTRUCT :INCLUDE overrides ...used portable boa-constructor &AUX lambda list hackery instead of non-standard structure member initializations in terms of other structure members ...wrapped changes to package "CL" in EXT:WITHOUT-PACKAGE-LOCK ...reworked RENAME-FILE-A-LA-UNIX ...used EVAL-WHEN to put the constant values of some DEFCONSTANT forms into the compilation environment tweaking so that the patched system will build... ...used COPIER-NAME instead of old (0.6.13) COPIER slot name in &AUX lambda list --- BUGS | 27 ++++++++++++++++++++++++++- CREDITS | 4 ++++ src/code/class.lisp | 2 +- src/code/defstruct.lisp | 12 ++++++++---- src/code/early-type.lisp | 2 +- src/code/host-alieneval.lisp | 12 ++++++------ src/code/pathname.lisp | 14 +++++++------- src/code/pprint.lisp | 6 +++--- src/code/stream.lisp | 2 +- src/cold/ansify.lisp | 9 +++++++-- src/cold/shared.lisp | 24 ++++++++++-------------- src/compiler/globaldb.lisp | 3 ++- src/compiler/meta-vmdef.lisp | 6 +++--- src/compiler/node.lisp | 2 +- src/compiler/x86/vm.lisp | 3 ++- version.lisp-expr | 2 +- 16 files changed, 83 insertions(+), 47 deletions(-) diff --git a/BUGS b/BUGS index a4ec52f..115b769 100644 --- a/BUGS +++ b/BUGS @@ -1272,8 +1272,33 @@ WORKAROUND: (defun bar (x) (typep x 'foo)) +150: + In sbcl-0.7.1.15, compiling this code + (let* () + (flet ((wufn () (glorp table1 4.9))) + (gleep *uustk* #'wufn "#1" (list))) + (if (eql (lo foomax 3.2)) + (values) + (error "not ~S" '(eql (lo foomax 3.2)))) + (values)) + causes a failure in SB-C::ADD-TEST-CONSTRAINTS: + The value NIL is not of type SB-C::CONTINUATION. + other notes: + * The problem appears to be tied to the way that EQL is given only + one argument, and goes away when we give EQL a second argument. + * CMU CL 18c has this problem too, exercised by + (compile nil + '(lambda () + (let* () + (flet ((wufn () (glorp table1 4.9))) + (gleep *uustk* #'wufn "#1" (list))) + (if (eql (lo foomax 3.2)) + (values) + (error "not ~S" '(eql (lo foomax 3.2)))) + (values)))) + DEFUNCT CATEGORIES OF BUGS IR1-#: - These numbers were used for bugs related to the old IR1 + These labels were used for bugs related to the old IR1 interpreter. The # values reached 6 before the category was closed down. \ No newline at end of file diff --git a/CREDITS b/CREDITS index 5629735..91fc72f 100644 --- a/CREDITS +++ b/CREDITS @@ -545,6 +545,10 @@ Robert MacLachlan: problems, has been invaluable to the CMU CL project and, by porting, invaluable to the SBCL project as well. +Dave McDonald: + He made a lot of progress toward getting SBCL to be bootstrappable + under CLISP. + William ("Bill") Newman: He continued to maintain SBCL after the fork, increasing ANSI compliance, fixing bugs, regularizing the internals of the diff --git a/src/code/class.lisp b/src/code/class.lisp index 20bfe11..913a541 100644 --- a/src/code/class.lisp +++ b/src/code/class.lisp @@ -29,7 +29,7 @@ #+sb-xc cl:class (:make-load-form-fun class-make-load-form-fun) (:include ctype - (:class-info (type-class-or-lose #-sb-xc 'sb!xc:class + (class-info (type-class-or-lose #-sb-xc 'sb!xc:class #+sb-xc 'cl:class))) (:constructor nil) #-no-ansi-print-object diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 67580b4..2a81fb3 100644 --- a/src/code/defstruct.lisp +++ b/src/code/defstruct.lisp @@ -50,21 +50,25 @@ (:conc-name dd-) (:make-load-form-fun just-dump-it-normally) #-sb-xc-host (:pure t) - (:constructor make-defstruct-description (name))) + (:constructor make-defstruct-description + (name &aux + (conc-name (symbolicate name "-")) + (copier-name (symbolicate "COPY-" name)) + (predicate-name (symbolicate name "-P"))))) ;; name of the structure (name (missing-arg) :type symbol :read-only t) ;; documentation on the structure (doc nil :type (or string null)) ;; prefix for slot names. If NIL, none. - (conc-name (symbolicate name "-") :type (or symbol null)) + (conc-name nil :type (or symbol null)) ;; the name of the primary standard keyword constructor, or NIL if none (default-constructor nil :type (or symbol null)) ;; all the explicit :CONSTRUCTOR specs, with name defaulted (constructors () :type list) ;; name of copying function - (copier-name (symbolicate "COPY-" name) :type (or symbol null)) + (copier-name nil :type (or symbol null)) ;; name of type predicate - (predicate-name (symbolicate name "-P") :type (or symbol null)) + (predicate-name nil :type (or symbol null)) ;; the arguments to the :INCLUDE option, or NIL if no included ;; structure (include nil :type list) diff --git a/src/code/early-type.lisp b/src/code/early-type.lisp index 84e4c1e..2a40aed 100644 --- a/src/code/early-type.lisp +++ b/src/code/early-type.lisp @@ -275,7 +275,7 @@ type)) ;;; A CONS-TYPE is used to represent a CONS type. -(defstruct (cons-type (:include ctype (:class-info (type-class-or-lose 'cons))) +(defstruct (cons-type (:include ctype (class-info (type-class-or-lose 'cons))) (:constructor ;; ANSI says that for CAR and CDR subtype ;; specifiers '* is equivalent to T. In order diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp index 380e2a4..0a263e1 100644 --- a/src/code/host-alieneval.lisp +++ b/src/code/host-alieneval.lisp @@ -107,7 +107,7 @@ (create-alien-type-class-if-necessary ',name ',(or include 'root))) (def!struct (,defstruct-name (:include ,include-defstruct - (:class ',name) + (class ',name) ,@overrides) (:constructor ,(symbolicate "MAKE-" defstruct-name) @@ -593,7 +593,7 @@ ;;;; the ENUM type -(define-alien-type-class (enum :include (integer (:bits 32)) +(define-alien-type-class (enum :include (integer (bits 32)) :include-args (signed)) name ; name of this enum (if any) from ; alist from keywords to integers. @@ -738,7 +738,7 @@ (declare (ignore type)) value) -(define-alien-type-class (single-float :include (float (:bits 32)) +(define-alien-type-class (single-float :include (float (bits 32)) :include-args (type))) (define-alien-type-translator single-float () @@ -748,7 +748,7 @@ (declare (ignore type)) `(sap-ref-single ,sap (/ ,offset sb!vm:n-byte-bits))) -(define-alien-type-class (double-float :include (float (:bits 64)) +(define-alien-type-class (double-float :include (float (bits 64)) :include-args (type))) (define-alien-type-translator double-float () @@ -759,7 +759,7 @@ `(sap-ref-double ,sap (/ ,offset sb!vm:n-byte-bits))) #!+long-float -(define-alien-type-class (long-float :include (float (:bits #!+x86 96 +(define-alien-type-class (long-float :include (float (bits #!+x86 96 #!+sparc 128)) :include-args (type))) @@ -774,7 +774,7 @@ ;;;; the POINTER type -(define-alien-type-class (pointer :include (alien-value (:bits +(define-alien-type-class (pointer :include (alien-value (bits #!-alpha sb!vm:n-word-bits #!+alpha 64))) diff --git a/src/code/pathname.lisp b/src/code/pathname.lisp index 644dbf1..4df7de6 100644 --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -31,15 +31,15 @@ (def!struct (logical-host (:make-load-form-fun make-logical-host-load-form-fun) (:include host - (:parse #'parse-logical-namestring) - (:unparse #'unparse-logical-namestring) - (:unparse-host + (parse #'parse-logical-namestring) + (unparse #'unparse-logical-namestring) + (unparse-host (lambda (x) (logical-host-name (%pathname-host x)))) - (:unparse-directory #'unparse-logical-directory) - (:unparse-file #'unparse-unix-file) - (:unparse-enough #'unparse-enough-namestring) - (:customary-case :upper))) + (unparse-directory #'unparse-logical-directory) + (unparse-file #'unparse-unix-file) + (unparse-enough #'unparse-enough-namestring) + (customary-case :upper))) (name "" :type simple-base-string) (translations nil :type list) (canon-transls nil :type list)) diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp index 0008579..6ad9b5d 100644 --- a/src/code/pprint.lisp +++ b/src/code/pprint.lisp @@ -29,9 +29,9 @@ (defconstant default-line-length 80) (defstruct (pretty-stream (:include sb!kernel:ansi-stream - (:out #'pretty-out) - (:sout #'pretty-sout) - (:misc #'pretty-misc)) + (out #'pretty-out) + (sout #'pretty-sout) + (misc #'pretty-misc)) (:constructor make-pretty-stream (target)) (:copier nil)) ;; Where the output is going to finally go. diff --git a/src/code/stream.lisp b/src/code/stream.lisp index e93c89c..5788195 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1359,7 +1359,7 @@ (defstruct (case-frob-stream (:include ansi-stream - (:misc #'case-frob-misc)) + (misc #'case-frob-misc)) (:constructor %make-case-frob-stream (target out sout)) (:copier nil)) (target (missing-arg) :type stream)) diff --git a/src/cold/ansify.lisp b/src/cold/ansify.lisp index 693c632..f11a6e1 100644 --- a/src/cold/ansify.lisp +++ b/src/cold/ansify.lisp @@ -96,13 +96,18 @@ (declare (ignore value)) (unless (gethash key standard-ht) (warn "removing non-ANSI export from package CL: ~S" key) - (unexport (intern key cl) cl))) + #+CLISP (ext:without-package-lock ("CL") + (unexport (intern key cl) cl)) + #-CLISP (unexport (intern key cl) cl))) host-ht) (maphash (lambda (key value) (declare (ignore value)) (unless (gethash key host-ht) (warn "adding required-by-ANSI export to package CL: ~S" key) - (export (intern key cl) cl)) + #+CLISP (ext:without-package-lock ("CL") + (export (intern key cl) cl)) + #-CLISP (export (intern key cl) cl)) + ;; FIXME: My righteous indignation below was misplaced. ANSI sez ;; (in 11.1.2.1, "The COMMON-LISP Package") that it's OK for ;; COMMON-LISP things to have their home packages elsewhere. diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp index 7fcb851..b2dc290 100644 --- a/src/cold/shared.lisp +++ b/src/cold/shared.lisp @@ -107,20 +107,16 @@ ;;; COMPILE-STEM function above. -- WHN 19990321 (defun rename-file-a-la-unix (x y) - ;; CLISP signals an error when the target file exists, which - ;; seems unjustified by the ANSI definition of RENAME-FILE. - ;; Work around it. - #+clisp (ignore-errors (delete-file y)) - - (rename-file x - ;; (Note that the TRUENAME expression here is lifted - ;; from an example in the ANSI spec for TRUENAME.) - (with-open-file (stream y :direction :output) - (close stream) - ;; From the ANSI spec: "In this case, the file is - ;; closed when the truename is tried, so the truename - ;; information is reliable." - (truename stream)))) + (let ((path ;; (Note that the TRUENAME expression here is lifted from an + ;; example in the ANSI spec for TRUENAME.) + (with-open-file (stream y :direction :output) + (close stream) + ;; From the ANSI spec: "In this case, the file is closed + ;; when the truename is tried, so the truename + ;; information is reliable." + (truename stream)))) + (delete-file path) + (rename-file x path))) (compile 'rename-file-a-la-unix) ;;; a wrapper for compilation/assembly, used mostly to centralize diff --git a/src/compiler/globaldb.lisp b/src/compiler/globaldb.lisp index c960c69..682cd9f 100644 --- a/src/compiler/globaldb.lisp +++ b/src/compiler/globaldb.lisp @@ -99,7 +99,8 @@ ;;; At run time, we represent the type of info that we want by a small ;;; non-negative integer. -(defconstant type-number-bits 6) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant type-number-bits 6)) (deftype type-number () `(unsigned-byte ,type-number-bits)) ;;; Why do we suppress the :COMPILE-TOPLEVEL situation here when we're diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 41bf2e0..51b9898 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -83,9 +83,9 @@ (/show0 "finished with DEFINE-STORAGE-BASE expansion") ',name))) -;;; Define a storage class Name that uses the named Storage-Base. Number is a -;;; small, non-negative integer that is used as an alias. The following -;;; keywords are defined: +;;; Define a storage class NAME that uses the named Storage-Base. +;;; NUMBER is a small, non-negative integer that is used as an alias. +;;; The following keywords are defined: ;;; ;;; :ELEMENT-SIZE Size ;;; The size of objects in this SC in whatever units the SB uses. diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index df3ddb4..44f0bfe 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -1132,7 +1132,7 @@ ;;; A REF represents a reference to a LEAF. REF-REOPTIMIZE is ;;; initially (and forever) NIL, since REFs don't receive any values ;;; and don't have any IR1 optimizer. -(defstruct (ref (:include node (:reoptimize nil)) +(defstruct (ref (:include node (reoptimize nil)) (:constructor make-ref (derived-type leaf)) (:copier nil)) ;; The leaf referenced. diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 57b90fa..8457029 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -163,7 +163,8 @@ ;;; ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess ;;; has my gratitude.) (FIXME: Maybe this should be me..) -(defconstant kludge-nondeterministic-catch-block-size 6) +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant kludge-nondeterministic-catch-block-size 6)) (define-storage-classes diff --git a/version.lisp-expr b/version.lisp-expr index 72adcb0..6f60f68 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.1.14" +"0.7.1.16" -- 1.7.10.4