From c53ec09694206092fd3aa933adade5e5d5b343d2 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sat, 9 Feb 2002 17:20:53 +0000 Subject: [PATCH] 0.7.1.17: merged the second of the two patches (the one that's not supposed to work) from Dave McDonald's "patch for CLISP compilation" message (sbcl-devel 2002-02-03)... ...made reader macro functions BACKQUOTE-MACRO and COMMA-MACRO return single values, as described by ANSI and enforced by CLISP ...used SLOT-VALUE instead of DEFSTRUCT-generated slot setters. (ANSI allows structure slot setters to be implemented either as SETF functions or as SETF expanders. Some SBCL code in vm-macs.lisp assumes they're functions, and forward references them, which doesn't work in CLISP, which uses SETF expanders.) ...coerced float-tran.lisp float literals to DOUBLE-FLOAT (since CLISP was defaulting them to LONG-FLOAT and then getting confused) ...added :ADJUSTABLE T for some MAKE-ARRAYs (where the old code had unportably relied on :FILL-POINTER T causing adjustableness to happen) tweaking the patch... ...went back to using DEFSTRUCT-generated slot setters (since (1) under ANSI, SLOT-VALUE's behavior for STRUCTURE-OBJECTs is explicitly unspecified by ANSI, and (2) in SBCL, SLOT-VALUE is defined in terms of PCL machinery, and so isn't available in cold init) and solved the forward reference problem by rearranging build order instead --- build-order.lisp-expr | 3 +++ src/code/backq.lisp | 34 +++++++++++++++---------------- src/code/late-type.lisp | 1 + src/cold/ansify.lisp | 17 +++++++++------- src/compiler/float-tran.lisp | 10 ++++++--- src/compiler/fun-info-funs.lisp | 36 +++++++++++++++++++++++++++++++++ src/compiler/generic/vm-ir2tran.lisp | 2 ++ src/compiler/generic/vm-macs.lisp | 37 ++++++---------------------------- version.lisp-expr | 2 +- 9 files changed, 82 insertions(+), 60 deletions(-) create mode 100644 src/compiler/fun-info-funs.lisp diff --git a/build-order.lisp-expr b/build-order.lisp-expr index a53bf78..d3a121e 100644 --- a/build-order.lisp-expr +++ b/build-order.lisp-expr @@ -337,6 +337,9 @@ ;; defines IR1-ATTRIBUTES macro, needed by proclaim.lisp ("src/compiler/knownfun") + ;; needs FUN-INFO structure slot setters, defined in knownfun.lisp + ("src/compiler/fun-info-funs") + ;; stuff needed by "code/defstruct" ("src/code/cross-type" :not-target) ("src/compiler/generic/vm-type") diff --git a/src/code/backq.lisp b/src/code/backq.lisp index 1a30b5d..32cbdcf 100644 --- a/src/code/backq.lisp +++ b/src/code/backq.lisp @@ -55,11 +55,11 @@ (let ((*backquote-count* (1+ *backquote-count*))) (multiple-value-bind (flag thing) (backquotify stream (read stream t nil t)) - (if (eq flag *bq-at-flag*) - (%reader-error stream ",@ after backquote in ~S" thing)) - (if (eq flag *bq-dot-flag*) - (%reader-error stream ",. after backquote in ~S" thing)) - (values (backquotify-1 flag thing) 'list)))) + (when (eq flag *bq-at-flag*) + (%reader-error stream ",@ after backquote in ~S" thing)) + (when (eq flag *bq-dot-flag*) + (%reader-error stream ",. after backquote in ~S" thing)) + (backquotify-1 flag thing)))) (/show0 "backq.lisp 64") @@ -71,14 +71,12 @@ (%reader-error stream "comma not inside a backquote")) (let ((c (read-char stream)) (*backquote-count* (1- *backquote-count*))) - (values - (cond ((char= c #\@) - (cons *bq-at-flag* (read stream t nil t))) - ((char= c #\.) - (cons *bq-dot-flag* (read stream t nil t))) - (t (unread-char c stream) - (cons *bq-comma-flag* (read stream t nil t)))) - 'list))) + (cond ((char= c #\@) + (cons *bq-at-flag* (read stream t nil t))) + ((char= c #\.) + (cons *bq-dot-flag* (read stream t nil t))) + (t (unread-char c stream) + (cons *bq-comma-flag* (read stream t nil t)))))) (/show0 "backq.lisp 83") @@ -108,11 +106,11 @@ (values 'vector (backquotify-1 dflag d)))) (t (multiple-value-bind (aflag a) (backquotify stream (car code)) (multiple-value-bind (dflag d) (backquotify stream (cdr code)) - (if (eq dflag *bq-at-flag*) - ;; Get the errors later. - (%reader-error stream ",@ after dot in ~S" code)) - (if (eq dflag *bq-dot-flag*) - (%reader-error stream ",. after dot in ~S" code)) + (when (eq dflag *bq-at-flag*) + ;; Get the errors later. + (%reader-error stream ",@ after dot in ~S" code)) + (when (eq dflag *bq-dot-flag*) + (%reader-error stream ",. after dot in ~S" code)) (cond ((eq aflag *bq-at-flag*) (if (null dflag) diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp index 6808309..c909e8d 100644 --- a/src/code/late-type.lisp +++ b/src/code/late-type.lisp @@ -800,6 +800,7 @@ (defun simplified-compound-types (input-types %compound-type-p simplify2) (let ((simplified-types (make-array (length input-types) :fill-pointer 0 + :adjustable t :element-type 'ctype ;; (This INITIAL-ELEMENT shouldn't ;; matter, but helps avoid type diff --git a/src/cold/ansify.lisp b/src/cold/ansify.lisp index f11a6e1..50023dc 100644 --- a/src/cold/ansify.lisp +++ b/src/cold/ansify.lisp @@ -1,4 +1,4 @@ -;;;; patches to hide some implementation idiosyncrasies in our +;;;; patches to work around implementation idiosyncrasies in our ;;;; cross-compilation host ;;;; This software is part of the SBCL system. See the README file for @@ -80,6 +80,11 @@ (in-package :sb-cold) +(defmacro munging-cl-package (&body body) + #-clisp `(progn ,@body) + #+clisp `(ext:without-package-lock ("CL") + ,@body)) + ;;; Do the exports of COMMON-LISP conform to the standard? If not, try ;;; to make them conform. (Of course, ANSI says that bashing symbols ;;; in the COMMON-LISP package like this is undefined, but then if the @@ -96,17 +101,15 @@ (declare (ignore value)) (unless (gethash key standard-ht) (warn "removing non-ANSI export from package CL: ~S" key) - #+CLISP (ext:without-package-lock ("CL") - (unexport (intern key cl) cl)) - #-CLISP (unexport (intern key cl) cl))) + (munging-cl-package + (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) - #+CLISP (ext:without-package-lock ("CL") - (export (intern key cl) cl)) - #-CLISP (export (intern key cl) cl)) + (munging-cl-package + (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 diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 8279727..8ceae40 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -347,11 +347,13 @@ (movable foldable flushable)) (defknown (%asin %atan) - (double-float) (double-float #.(- (/ pi 2)) #.(/ pi 2)) + (double-float) + (double-float #.(coerce (- (/ pi 2)) 'double-float) + #.(coerce (/ pi 2) 'double-float)) (movable foldable flushable)) (defknown (%acos) - (double-float) (double-float 0.0d0 #.pi) + (double-float) (double-float 0.0d0 #.(coerce pi 'double-float)) (movable foldable flushable)) (defknown (%cosh) @@ -375,7 +377,9 @@ (movable foldable flushable)) (defknown (%atan2) - (double-float double-float) (double-float #.(- pi) #.pi) + (double-float double-float) + (double-float #.(coerce (- pi) 'double-float) + #.(coerce pi 'double-float)) (movable foldable flushable)) (defknown (%scalb) diff --git a/src/compiler/fun-info-funs.lisp b/src/compiler/fun-info-funs.lisp new file mode 100644 index 0000000..bf996e1 --- /dev/null +++ b/src/compiler/fun-info-funs.lisp @@ -0,0 +1,36 @@ +;;;; functions which have a build order dependency on FUN-INFO +;;;; (because ANSI allows xc host structure slot setters to be +;;;; implemented as SETF expanders instead of SETF functions, so we +;;;; can't safely forward-reference them) and so have to be defined +;;;; physically late instead of in a more logical place + +(in-package "SB!C") + +(defun %def-reffer (name offset lowtag) + (let ((fun-info (fun-info-or-lose name))) + (setf (fun-info-ir2-convert fun-info) + (lambda (node block) + (ir2-convert-reffer node block name offset lowtag)))) + name) + +(defun %def-setter (name offset lowtag) + (let ((fun-info (fun-info-or-lose name))) + (setf (fun-info-ir2-convert fun-info) + (if (listp name) + (lambda (node block) + (ir2-convert-setfer node block name offset lowtag)) + (lambda (node block) + (ir2-convert-setter node block name offset lowtag))))) + name) + +(defun %def-alloc (name words var-length header lowtag inits) + (let ((info (fun-info-or-lose name))) + (setf (fun-info-ir2-convert info) + (if var-length + (lambda (node block) + (ir2-convert-variable-allocation node block name words header + lowtag inits)) + (lambda (node block) + (ir2-convert-fixed-allocation node block name words header + lowtag inits))))) + name) diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 361c54f..db60300 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -24,6 +24,8 @@ name offset lowtag) (move-continuation-result node block (list value-tn) (node-cont node)))) +;;; FIXME: Isn't there a name for this which looks less like a typo? +;;; (The name IR2-CONVERT-SETTER is used for something else, just above.) (defoptimizer ir2-convert-setfer ((value object) node block name offset lowtag) (let ((value-tn (continuation-tn node block value))) (vop set-slot node block (continuation-tn node block object) value-tn diff --git a/src/compiler/generic/vm-macs.lisp b/src/compiler/generic/vm-macs.lisp index b40ddff..8219a5a 100644 --- a/src/compiler/generic/vm-macs.lisp +++ b/src/compiler/generic/vm-macs.lisp @@ -128,43 +128,18 @@ (in-package "SB!C") -(defun %def-reffer (name offset lowtag) - (let ((info (fun-info-or-lose name))) - (setf (fun-info-ir2-convert info) - (lambda (node block) - (ir2-convert-reffer node block name offset lowtag)))) - name) - (defmacro def-reffer (name offset lowtag) `(%def-reffer ',name ,offset ,lowtag)) - -(defun %def-setter (name offset lowtag) - (let ((info (fun-info-or-lose name))) - (setf (fun-info-ir2-convert info) - (if (listp name) - (lambda (node block) - (ir2-convert-setfer node block name offset lowtag)) - (lambda (node block) - (ir2-convert-setter node block name offset lowtag))))) - name) - (defmacro def-setter (name offset lowtag) `(%def-setter ',name ,offset ,lowtag)) - -(defun %def-alloc (name words var-length header lowtag inits) - (let ((info (fun-info-or-lose name))) - (setf (fun-info-ir2-convert info) - (if var-length - (lambda (node block) - (ir2-convert-variable-allocation node block name words header - lowtag inits)) - (lambda (node block) - (ir2-convert-fixed-allocation node block name words header - lowtag inits))))) - name) - (defmacro def-alloc (name words var-length header lowtag inits) `(%def-alloc ',name ,words ,var-length ,header ,lowtag ,inits)) +;;; KLUDGE: The %DEF-FOO functions used to implement the macros here +;;; are defined later in another file, since they use structure slot +;;; setters defined later, and we can't have physical forward +;;; references to structure slot setters because ANSI in its wisdom +;;; allows the xc host CL to implement structure slot setters as SETF +;;; expanders instead of SETF functions. -- WHN 2002-02-09 ;;;; some general constant definitions diff --git a/version.lisp-expr b/version.lisp-expr index 6f60f68..644e2f8 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.16" +"0.7.1.17" -- 1.7.10.4