Skip to content
Snippets Groups Projects
Commit 119ed6bb authored by wlott's avatar wlott
Browse files

Put #+new-compiler in front of everything except the defstruct so that we

don't try to compile random %primitives with the old compiler.
parent a4b1a6c5
No related branches found
No related tags found
No related merge requests found
...@@ -37,6 +37,7 @@ ...@@ -37,6 +37,7 @@
;;; ;;;
;;; Make a function entry, filling in slots from the ENTRY-INFO. ;;; Make a function entry, filling in slots from the ENTRY-INFO.
;;; ;;;
#+new-compiler
(defun make-function-entry (entry code-obj object) (defun make-function-entry (entry code-obj object)
(declare (type entry-info entry) (type core-object object)) (declare (type entry-info entry) (type core-object object))
(let ((offset (label-position (entry-info-offset entry)))) (let ((offset (label-position (entry-info-offset entry))))
...@@ -60,6 +61,7 @@ ...@@ -60,6 +61,7 @@
;;; ;;;
;;; Get the function for a function entry that has been dumped to core. ;;; Get the function for a function entry that has been dumped to core.
;;; ;;;
#+new-compiler
(defun core-function-or-lose (fun object) (defun core-function-or-lose (fun object)
(declare (type clambda fun) (type core-object object)) (declare (type clambda fun) (type core-object object))
(let ((res (gethash (leaf-info fun) (core-object-entry-table object)))) (let ((res (gethash (leaf-info fun) (core-object-entry-table object))))
...@@ -71,6 +73,7 @@ ...@@ -71,6 +73,7 @@
;;; ;;;
;;; Do "load-time" fixups on the code vector. ;;; Do "load-time" fixups on the code vector.
;;; ;;;
#+new-compiler
(defun do-core-fixups (code fixups) (defun do-core-fixups (code fixups)
(declare (list fixups)) (declare (list fixups))
(dolist (info fixups) (dolist (info fixups)
...@@ -111,6 +114,7 @@ ...@@ -111,6 +114,7 @@
;;; Dump a component to core. We pass in the assembler fixups, code vector ;;; Dump a component to core. We pass in the assembler fixups, code vector
;;; and node info. ;;; and node info.
;;; ;;;
#+new-compiler
(defun make-core-component (component segment length object) (defun make-core-component (component segment length object)
(declare (type component component) (declare (type component component)
(type index length) (type index length)
...@@ -156,6 +160,7 @@ ...@@ -156,6 +160,7 @@
;;; Call the top-level lambda function dumped for Entry, returning the ;;; Call the top-level lambda function dumped for Entry, returning the
;;; values. ;;; values.
;;; ;;;
#+new-compiler
(defun core-call-top-level-lambda (entry object) (defun core-call-top-level-lambda (entry object)
(declare (type clambda entry) (type core-object object)) (declare (type clambda entry) (type core-object object))
(funcall (core-function-or-lose entry object))) (funcall (core-function-or-lose entry object)))
...@@ -166,6 +171,7 @@ ...@@ -166,6 +171,7 @@
;;; Backpatch all the DEBUG-INFOs dumped so far with the specified ;;; Backpatch all the DEBUG-INFOs dumped so far with the specified
;;; SOURCE-INFO list. ;;; SOURCE-INFO list.
;;; ;;;
#+new-compiler
(defun fix-core-source-info (info object) (defun fix-core-source-info (info object)
(declare (type source-info info) (type core-object object)) (declare (type source-info info) (type core-object object))
(let ((res (debug-source-for-info info))) (let ((res (debug-source-for-info info)))
...@@ -177,6 +183,7 @@ ...@@ -177,6 +183,7 @@
;;;; Code-instruction-streams ;;;; Code-instruction-streams
#+new-compiler
(defstruct (code-instruction-stream (defstruct (code-instruction-stream
(:print-function %print-code-inst-stream) (:print-function %print-code-inst-stream)
(:include stream (:include stream
...@@ -196,11 +203,13 @@ ...@@ -196,11 +203,13 @@
current current
end) end)
#+new-compiler
(defun %print-code-inst-stream (code-inst-stream stream depth) (defun %print-code-inst-stream (code-inst-stream stream depth)
(declare (ignore depth)) (declare (ignore depth))
(format stream "#<Code Instruction Stream for ~S>" (format stream "#<Code Instruction Stream for ~S>"
(code-instruction-stream-code-object code-inst-stream))) (code-instruction-stream-code-object code-inst-stream)))
#+new-compiler
(defun code-inst-stream-sout (stream string start end) (defun code-inst-stream-sout (stream string start end)
(let* ((start (or start 0)) (let* ((start (or start 0))
(end (or end (length string))) (end (or end (length string)))
...@@ -216,6 +225,7 @@ ...@@ -216,6 +225,7 @@
(* length vm:byte-bits)) (* length vm:byte-bits))
(setf (code-instruction-stream-current stream) new))) (setf (code-instruction-stream-current stream) new)))
#+new-compiler
(defun code-inst-stream-misc (stream method &optional arg1 arg2) (defun code-inst-stream-misc (stream method &optional arg1 arg2)
(declare (ignore arg1 arg2)) (declare (ignore arg1 arg2))
(case method (case method
......
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