From 17f5d79d7b50f15712961cd16a61a11545932908 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 11 May 1993 13:53:28 +0000 Subject: [PATCH] Add support for machine-independent fasl files. byte-xep => byte-function. --- compiler/dump.lisp | 72 ++++++++++++++++++++++++++-------------------- 1 file changed, 41 insertions(+), 31 deletions(-) diff --git a/compiler/dump.lisp b/compiler/dump.lisp index 20fab776e..58c8046f4 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.50 1993/05/08 00:46:17 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.51 1993/05/11 13:53:28 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -362,34 +362,43 @@ ;;; Open-Fasl-File -- Interface ;;; ;;; Return a Fasl-File object for dumping to the named file. Some -;;; information about the source is specified by the string Where. +;;; information about the source is specified by the string Where. If byte-p +;;; is true, this file will contain no native code, and is thus largely +;;; implementation independent. ;;; -(defun open-fasl-file (name where) +(defun open-fasl-file (name where &optional byte-p) (declare (type pathname name)) (let* ((stream (open name :direction :output :if-exists :new-version :element-type '(unsigned-byte 8))) (res (make-fasl-file :stream stream))) - (format stream - "FASL FILE output from ~A.~@ - Compiled ~A on ~A~@ - Compiler ~A, Lisp ~A~@ - Targeted for ~A, FASL version ~D~%" - where - (ext:format-universal-time nil (get-universal-time)) - (machine-instance) compiler-version - (lisp-implementation-version) - (backend-version *backend*) - (backend-fasl-file-version *backend*)) - ;; - ;; Terminate header. - (dump-byte 255 res) - ;; - ;; Specify code format. - (dump-fop 'lisp::fop-code-format res) - (dump-byte (backend-fasl-file-implementation *backend*) res) - (dump-byte (backend-fasl-file-version *backend*) res) - + (multiple-value-bind + (version f-vers f-imp) + (if byte-p + (values "Byte code" + byte-fasl-file-version + (backend-byte-fasl-file-implementation *backend*)) + (values (backend-version *backend*) + (backend-fasl-file-version *backend*) + (backend-fasl-file-implementation *backend*))) + (format stream + "FASL FILE output from ~A.~@ + Compiled ~A on ~A~@ + Compiler ~A, Lisp ~A~@ + Targeted for ~A, FASL version ~D~%" + where + (ext:format-universal-time nil (get-universal-time)) + (machine-instance) compiler-version + (lisp-implementation-version) + version f-vers) + ;; + ;; Terminate header. + (dump-byte 255 res) + ;; + ;; Specify code format. + (dump-fop 'lisp::fop-code-format res) + (dump-byte f-imp res) + (dump-byte f-vers res)) res)) @@ -666,8 +675,9 @@ ;;; DUMP-BYTE-CODE-OBJECT -- internal. ;;; -(defun dump-byte-code-object (segment constants file) +(defun dump-byte-code-object (segment length constants file) (declare (type new-assem:segment segment) + (type index length) (type vector constants) (type fasl-file file)) (collect ((entry-patches) (xep-patches)) @@ -707,11 +717,10 @@ (xep-patches (cons (cdr entry) i)) (dump-fop 'lisp::fop-misc-trap file))))))) - ;; ### No debug info for now. - (dump-object nil file) + ;; For now, just the component name as debug info: + (dump-object (component-name *compile-component*) file) - (let ((num-consts (1+ (length constants))) - (length (byte-output-length segment))) + (let ((num-consts (1+ (length constants)))) (cond ((and (< num-consts #x100) (< length #x10000)) (dump-fop 'lisp::fop-small-code file) (dump-byte num-consts file) @@ -734,8 +743,9 @@ ;;; Dump a byte-component. This is similar to FASL-DUMP-COMPONENT, but ;;; different. ;;; -(defun fasl-dump-byte-component (segment constants xeps file) +(defun fasl-dump-byte-component (segment length constants xeps file) (declare (type new-assem:segment segment) + (type index length) (type vector constants) (type list xeps) (type fasl-file file)) @@ -746,14 +756,14 @@ (multiple-value-bind (code-handle xep-patches) - (dump-byte-code-object segment constants file) + (dump-byte-code-object segment length constants file) (dump-fop 'lisp::fop-verify-empty-stack file) (dolist (noise xeps) (let* ((lambda (car noise)) (info (lambda-info lambda)) (xep (cdr noise)) (fake-component (list nil))) - (setf (byte-xep-component xep) fake-component) + (setf (byte-function-component xep) fake-component) (setf (gethash fake-component (fasl-file-eq-table file)) code-handle) (let ((*dump-only-valid-structures* nil)) (dump-object xep file)) -- GitLab