Skip to content
Snippets Groups Projects
Commit 22bf3c96 authored by ram's avatar ram
Browse files

Merged William's dylan hacks. Removed :XEP load-time-constant support from

byte code dumping, since it is no longer necessary, and didn't work anyway.
parent f2260269
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.56 1993/08/17 22:34:49 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.57 1993/08/19 23:43:19 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -447,8 +447,7 @@ ...@@ -447,8 +447,7 @@
;;; since we don't have the handle for the code object being dumped while we ;;; since we don't have the handle for the code object being dumped while we
;;; are dumping its constants. ;;; are dumping its constants.
;;; ;;;
;;; We dump a trap object as a placeholder for the code vector, which is ;;; We dump trap objects in any unused slots or forward referenced slots.
;;; actually filled in by the loader.
;;; ;;;
(defun dump-code-object (component code-segment code-length (defun dump-code-object (component code-segment code-length
trace-table fixups file) trace-table fixups file)
...@@ -496,7 +495,11 @@ ...@@ -496,7 +495,11 @@
(dump-push (cdr entry) file)) (dump-push (cdr entry) file))
(:fdefinition (:fdefinition
(dump-object (cdr entry) file) (dump-object (cdr entry) file)
(dump-fop 'lisp::fop-fdefinition file)))) (dump-fop 'lisp::fop-fdefinition file))
(:dylan-varinfo-value
(dump-object (cadr entry) file)
(dump-object (cddr entry) file)
(dump-fop 'lisp::fop-dylan-varinfo-value file))))
(null (null
(dump-fop 'lisp::fop-misc-trap file))))) (dump-fop 'lisp::fop-misc-trap file)))))
...@@ -680,7 +683,7 @@ ...@@ -680,7 +683,7 @@
(type index length) (type index length)
(type vector constants) (type vector constants)
(type fasl-file file)) (type fasl-file file))
(collect ((entry-patches) (xep-patches)) (collect ((entry-patches))
;; No trace table in byte-compiled functions. ;; No trace table in byte-compiled functions.
(dump-object 0 file) (dump-object 0 file)
...@@ -708,15 +711,16 @@ ...@@ -708,15 +711,16 @@
(:fdefinition (:fdefinition
(dump-object (cdr entry) file) (dump-object (cdr entry) file)
(dump-fop 'lisp::fop-fdefinition file)) (dump-fop 'lisp::fop-fdefinition file))
(:dylan-varinfo-value
(dump-object (cadr entry) file)
(dump-object (cddr entry) file)
(dump-fop 'lisp::fop-dylan-varinfo-value file))
(:type-predicate (:type-predicate
(dump-object 'load-type-predicate file) (dump-object 'load-type-predicate file)
(let ((*unparse-function-type-simplify* t)) (let ((*unparse-function-type-simplify* t))
(dump-object (type-specifier (cdr entry)) file)) (dump-object (type-specifier (cdr entry)) file))
(dump-fop 'lisp::fop-funcall file) (dump-fop 'lisp::fop-funcall file)
(dump-byte 1 file)) (dump-byte 1 file)))))))
(:xep
(xep-patches (cons (cdr entry) (+ i vm:code-constants-offset)))
(dump-fop 'lisp::fop-misc-trap file)))))))
;; Dump the debug info. ;; Dump the debug info.
(let ((info (make-debug-info :name (component-name *compile-component*))) (let ((info (make-debug-info :name (component-name *compile-component*)))
...@@ -742,7 +746,7 @@ ...@@ -742,7 +746,7 @@
(dolist (patch (entry-patches)) (dolist (patch (entry-patches))
(push (cons code-handle (cdr patch)) (push (cons code-handle (cdr patch))
(gethash (car patch) patch-table))) (gethash (car patch) patch-table)))
(values code-handle (xep-patches))))) code-handle)))
;;; DUMP-BYTE-FUNCTION -- Internal ;;; DUMP-BYTE-FUNCTION -- Internal
...@@ -777,35 +781,24 @@ ...@@ -777,35 +781,24 @@
(type list xeps) (type list xeps)
(type fasl-file file)) (type fasl-file file))
(multiple-value-bind (let ((code-handle (dump-byte-code-object segment length constants file)))
(code-handle xep-patches)
(dump-byte-code-object segment length constants file)
(dolist (noise xeps) (dolist (noise xeps)
(let* ((lambda (car noise)) (let* ((lambda (car noise))
(info (lambda-info lambda)) (info (lambda-info lambda))
(xep (cdr noise))) (xep (cdr noise)))
(dump-byte-function xep code-handle file) (dump-byte-function xep code-handle file)
(let ((patches (remove lambda xep-patches :key #'car :test-not #'eq))) (let* ((entry-handle (dump-pop file))
(cond (patch-table (fasl-file-patch-table file))
(patches (old (gethash info patch-table)))
;; We only have direct references to XEPs for closures. Therefore, (setf (gethash info (fasl-file-entry-table file)) entry-handle)
;; there better not be any :entry references to it. (when old
(assert (null (gethash info (fasl-file-patch-table file)))) (dolist (patch old)
(let ((xep-handle (dump-pop file))) (alter-code-object (car patch) (cdr patch)
(dolist (patch patches) entry-handle file))
(alter-code-object code-handle (cdr patch) xep-handle file)))) (remhash info patch-table))))))
(t
(let* ((entry-handle (dump-pop file))
(patch-table (fasl-file-patch-table file))
(old (gethash info patch-table)))
(setf (gethash info (fasl-file-entry-table file)) entry-handle)
(when old
(dolist (patch old)
(alter-code-object (car patch) (cdr patch)
entry-handle file))
(remhash info patch-table)))))))))
(undefined-value)) (undefined-value))
;;; FASL-DUMP-TOP-LEVEL-LAMBDA-CALL -- Interface ;;; FASL-DUMP-TOP-LEVEL-LAMBDA-CALL -- Interface
;;; ;;;
;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at load ;;; Dump a FOP-FUNCALL to call an already dumped top-level lambda at load
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment