diff --git a/compiler/dump.lisp b/compiler/dump.lisp index ceee9e1f4a2f913cd0584a2dfb95c8b14ed21712..323f4b8090420440bc91350a9bce1d6089b46029 100644 --- a/compiler/dump.lisp +++ b/compiler/dump.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.23 1990/10/25 20:48:32 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.24 1990/11/03 03:13:41 wlott Exp $ ;;; ;;; This file contains stuff that knows about dumping FASL files. ;;; @@ -15,15 +15,10 @@ (proclaim '(special compiler-version)) -(in-package "VM") -(export '(target-fasl-file-implementation - target-fasl-file-version - fasl-file-implementations +(export '(fasl-file-implementations pmax-fasl-file-implementation sparc-fasl-file-implementation)) -(in-package "C") - ;;;; Different Implementations: @@ -34,10 +29,6 @@ (defconstant pmax-fasl-file-implementation 1) (defconstant sparc-fasl-file-implementation 2) -(proclaim '(special vm:target-fasl-file-implementation)) -(proclaim '(special vm:target-fasl-file-version)) - - ;;;; Fasl dumper state: @@ -53,7 +44,7 @@ (namestring (fasl-file-stream s)))))) ;; ;; The stream we dump to. - (stream nil :type stream) + (stream (required-argument) :type stream) ;; ;; Hashtables we use to keep track of dumped constants so that we can get ;; them from the table rather than dumping them again. The EQUAL-TABLE is @@ -102,13 +93,13 @@ (defstruct circularity ;; ;; Kind of modification to make to create circularity. - (type nil :type (member :rplaca :rplacd :svset :struct-set)) + (type (required-argument) :type (member :rplaca :rplacd :svset :struct-set)) ;; ;; Object containing circularity. object ;; ;; Index in object for circularity. - (index nil :type unsigned-byte) + (index (required-argument) :type unsigned-byte) ;; ;; The object to be stored at Index in Object. This is that the key that we ;; were using when we discovered the circularity. @@ -306,7 +297,9 @@ where (ext:format-universal-time nil (get-universal-time)) (machine-instance) compiler-version - (lisp-implementation-version) vm-version target-fasl-file-version) + (lisp-implementation-version) + (backend-version *backend*) + (backend-fasl-file-version *backend*)) ;; ;; Terminate header. (dump-byte 255 res) @@ -1029,11 +1022,12 @@ (dump-fop 'lisp::fop-int-vector file) (quick-dump-number len 4 file) (dump-byte size file) - (cond ((or (eq target-byte-order native-byte-order) + (cond ((or (eq (backend-byte-order *backend*) + (backend-byte-order *native-backend*)) (= size 8)) (system:output-raw-bytes (fasl-file-stream file) vec 0 bytes)) ((> size 8) - (ecase target-byte-order + (ecase (backend-byte-order *backend*) (:little-endian (dotimes (i len) (let ((int (aref vec i))) @@ -1056,7 +1050,7 @@ (dump-byte byte file) (setq shift ,initial byte 0))) (unless (= shift ,initial) (dump-byte byte file))))) - (ecase target-byte-order + (ecase (backend-byte-order *backend*) (:little-endian (frob 0 incf (= shift 8))) (:big-endian diff --git a/compiler/gtn.lisp b/compiler/gtn.lisp index 76cf61fc5be01d802a796fa1ce29d4dac404b4c3..f800ff684554f9a265d1459b655fbbf87034441b 100644 --- a/compiler/gtn.lisp +++ b/compiler/gtn.lisp @@ -50,7 +50,7 @@ (dolist (var (lambda-vars fun)) (when (leaf-refs var) (let* ((type (if (lambda-var-indirect var) - *any-primitive-type* + (backend-any-primitive-type *backend*) (primitive-type (leaf-type var)))) (temp (make-normal-tn type)) (node (lambda-bind fun)) @@ -77,9 +77,9 @@ (let ((ptype (etypecase thing (lambda-var (if (lambda-var-indirect thing) - *any-primitive-type* + (backend-any-primitive-type *backend*) (primitive-type (leaf-type thing)))) - (nlx-info *any-primitive-type*)))) + (nlx-info (backend-any-primitive-type *backend*))))) (env (cons thing (make-normal-tn ptype))))) (let ((res (make-ir2-environment @@ -233,6 +233,6 @@ (make-ir2-nlx-info :home (when (member (cleanup-kind (nlx-info-cleanup nlx)) '(:block :tagbody)) - (make-normal-tn *any-primitive-type*)) + (make-normal-tn (backend-any-primitive-type *backend*))) :save-sp (make-nlx-sp-tn env))))) (undefined-value))