diff --git a/compiler/dump.lisp b/compiler/dump.lisp index 291c7c1bf05e933a7fe154bdb7d60aa43c01056f..a5c88839cb935e75c05470219af752301a7f3cef 100644 --- a/compiler/dump.lisp +++ b/compiler/dump.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.57 1993/08/19 23:43:19 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.58 1993/08/24 02:11:21 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -856,9 +856,11 @@ (typecase x (symbol (dump-symbol x file)) (list - (unless (equal-check-table x file) - (dump-list x file) - (equal-save-object x file))) + (if *coalesce-constants* + (unless (equal-check-table x file) + (dump-list x file) + (equal-save-object x file)) + (dump-list x file))) (layout (dump-layout x file) (eq-save-object x file)) @@ -1250,9 +1252,11 @@ x))) (typecase simple-version (simple-base-string - (unless (equal-check-table x file) - (dump-simple-string simple-version file) - (equal-save-object x file))) + (if *coalesce-constants* + (unless (equal-check-table x file) + (dump-simple-string simple-version file) + (equal-save-object x file)) + (dump-simple-string simple-version file))) (simple-vector (dump-simple-vector simple-version file) (eq-save-object x file)) diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index f956578a54e5c51c7897bae96d4d6f09423ba6ca..7714d18a1d974f39dd9e52153548d9cec2dd71d1 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.100 1993/08/21 00:35:06 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.101 1993/08/24 02:12:06 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -73,6 +73,12 @@ (defvar *constants*) (proclaim '(hash-table *constants*)) +;;; When compiling Dylan, we don't coalesce constants, because the dylan +;;; test suite implies that doing so is a bozo-no-no. +;;; +(defvar *coalesce-constants*) +(declaim (type (member t nil) *coalesce-constants*)) + ;;; *source-paths* is a hashtable from source code forms to the path taken ;;; through the source to reach the form. This provides a way to keep track of ;;; the location of original source forms, even when macroexpansions and other diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp index 13d8f65b1e9efd4f490e0881050f8ef2b1e45b84..33b35aff7aeb09ac2e8fac225210779f7f8c5aea 100644 --- a/compiler/ir1util.lisp +++ b/compiler/ir1util.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.69 1993/08/20 17:46:57 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.70 1993/08/24 02:12:13 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1360,11 +1360,16 @@ ;;; (declaim (maybe-inline find-constant)) (defun find-constant (object) - (or (gethash object *constants*) - (setf (gethash object *constants*) - (make-constant :value object :name nil - :type (ctype-of object) - :where-from :defined)))) + (if (or *coalesce-constants* + (typep object '(or symbol number character instance))) + (or (gethash object *constants*) + (setf (gethash object *constants*) + (make-constant :value object :name nil + :type (ctype-of object) + :where-from :defined))) + (make-constant :value object :name nil + :type (ctype-of object) + :where-from :defined))) ;;;; Find-NLX-Info -- Interface diff --git a/compiler/macros.lisp b/compiler/macros.lisp index a8a6d803b18927f4224cc901132dc9fd0396621f..b4d648029e8756e4c658a25f111302346bd6dbb9 100644 --- a/compiler/macros.lisp +++ b/compiler/macros.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.38 1993/08/20 17:46:33 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/macros.lisp,v 1.39 1993/08/24 02:12:18 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -721,6 +721,7 @@ `(let ((*free-variables* (make-hash-table :test #'eq)) (*free-functions* (make-hash-table :test #'equal)) (*constants* (make-hash-table :test #'equal)) + (*coalesce-constants* t) (*source-paths* (make-hash-table :test #'eq))) (handler-bind ((compiler-error #'compiler-error-handler) (style-warning #'compiler-style-warning-handler) diff --git a/compiler/main.lisp b/compiler/main.lisp index f8ab56bf215e7fe6e3f3ec96302a7027ab545670..891ea340445e239d65e5b30900a5373202787ad0 100644 --- a/compiler/main.lisp +++ b/compiler/main.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.97 1993/08/20 00:18:29 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.98 1993/08/24 02:12:21 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -40,7 +40,8 @@ *compiler-trace-output* *last-source-context* *last-original-source* *last-source-form* *last-format-string* *last-format-args* - *last-message-count* *lexical-environment*)) + *last-message-count* *lexical-environment* + *coalesce-constants*)) ;;; Exported: (defvar *block-compile-default* :specified @@ -865,6 +866,7 @@ (process-form form `(original-source-start 0 ,current-idx))))))) (:dylan + (setf *coalesce-constants* nil) (let ((*error-output* *compiler-error-output*)) (dylan::parse-and-convert stream