Commit 58a3e223 authored by wlott's avatar wlott
Browse files

Removed traces of the old assembler.

parent aa8b71ad
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.17 1992/05/21 22:46:56 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/codegen.lisp,v 1.18 1992/08/03 12:36:01 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -18,8 +18,12 @@
;;;
;;; Written by Rob MacLachlan
;;;
(in-package 'c)
(in-package :c)
(in-package :new-assem)
(import '(label gen-label emit-label label-position) :c)
(in-package :c)
(export '(component-header-length sb-allocated-size current-nfp-tn
callee-nfp-tn callee-return-pc-tn *code-segment* *elsewhere*
trace-table-entry pack-trace-table note-fixup
......@@ -122,13 +126,10 @@
(defvar *elsewhere* nil)
(defvar *elsewhere-label* nil)
(defvar *assembly-optimize* t
(defvar *assembly-optimize* nil
"Set to NIL to inhibit assembly-level optimization. For compiler debugging,
rather than policy control.")
(defvar *assembly-check* nil
"Set to T to enable lifetime consistency checking of the assembly code.")
;;;; Noise to emit an instruction trace.
......@@ -159,41 +160,18 @@
;;;; Hooks used to dispatch between the two different assemblers.
;;;; Generate-code and support routines.
(defun make-segment (&optional name)
(if (backend-featurep :new-assembler)
(new-assem:make-segment
:name name
:run-scheduler
(and *assembly-optimize*
(policy (lambda-bind
(block-home-lambda
(block-next (component-head *compile-component*))))
(or (>= speed cspeed) (>= space cspeed))))
:inst-hook (if *compiler-trace-output* #'trace-instruction))
(assem:make-segment)))
(deftype label ()
'(or new-assem:label assem:label))
(defun gen-label ()
(if (backend-featurep :new-assembler)
(new-assem:gen-label)
(assem:gen-label)))
(defun emit-label (label)
(if (backend-featurep :new-assembler)
(new-assem:emit-label label)
(assem:emit-label label)))
(defun label-position (label)
(if (backend-featurep :new-assembler)
(new-assem:label-position label)
(assem:label-position label)))
;;;; Generate-code and support routines.
(new-assem:make-segment
:name name
:run-scheduler
(and *assembly-optimize*
(policy (lambda-bind
(block-home-lambda
(block-next (component-head *compile-component*))))
(or (>= speed cspeed) (>= space cspeed))))
:inst-hook (if *compiler-trace-output* #'trace-instruction)))
;;; Init-Assembler -- Interface
;;;
......@@ -205,7 +183,7 @@
;;; Generate-Code -- Interface
;;;
(defun generate-code (component)
(when (and *compiler-trace-output* (backend-featurep :new-assembler))
(when *compiler-trace-output*
(format *compiler-trace-output*
"~|~%Assembly code for ~S~2%"
component))
......@@ -214,20 +192,16 @@
(*prev-segment* nil)
(*prev-vop* nil)
(*fixups* nil))
(when (backend-featurep :new-assembler)
(let ((label (new-assem:gen-label)))
(setf *elsewhere-label* label)
(new-assem:assemble (*elsewhere*)
(new-assem:emit-label label))))
(let ((label (new-assem:gen-label)))
(setf *elsewhere-label* label)
(new-assem:assemble (*elsewhere*)
(new-assem:emit-label label)))
(do-ir2-blocks (block component)
(let ((1block (ir2-block-block block)))
(when (and (eq (block-info 1block) block)
(block-start 1block))
(if (backend-featurep :new-assembler)
(new-assem:assemble (*code-segment*)
(new-assem:emit-label (block-label 1block)))
(assem:assemble (*code-segment* nil)
(assem:emit-label (block-label 1block))))
(new-assem:assemble (*code-segment*)
(new-assem:emit-label (block-label 1block)))
(let ((env (block-environment 1block)))
(unless (eq env prev-env)
(let ((lab (gen-label)))
......@@ -244,38 +218,18 @@
(format t "Missing generator for ~S.~%"
(template-name (vop-info vop)))))))
(cond ((backend-featurep :new-assembler)
(new-assem:append-segment *code-segment* *elsewhere*)
(setf *elsewhere* nil)
(values (new-assem:finalize-segment *code-segment*)
(nreverse *trace-table-info*)
*fixups*))
(t
(assem:assemble (*code-segment* nil)
(assem:insert-segment *elsewhere*))
(assem:expand-pseudo-instructions *code-segment*)
(when *assembly-check*
(assem:segment-check-registers *code-segment* *elsewhere*))
(when (and (policy (lambda-bind
(block-home-lambda
(block-next (component-head component))))
(or (>= speed cspeed) (>= space cspeed)))
*assembly-optimize*)
(assem:optimize-segment *code-segment*))
(let ((length (assem:finalize-segment *code-segment*)))
(values length (nreverse *trace-table-info*)))))))
(new-assem:append-segment *code-segment* *elsewhere*)
(setf *elsewhere* nil)
(values (new-assem:finalize-segment *code-segment*)
(nreverse *trace-table-info*)
*fixups*)))
(defun emit-label-elsewhere (label)
(if (backend-featurep :new-assembler)
(new-assem:assemble (*elsewhere*)
(new-assem:emit-label label))
(assem:assemble (*elsewhere* nil)
(assem:emit-label label))))
(new-assem:assemble (*elsewhere*)
(new-assem:emit-label label)))
(defun label-elsewhere-p (label-or-posn)
(<= (label-position (if (backend-featurep :new-assembler)
*elsewhere-label*
*elsewhere*))
(<= (label-position *elsewhere-label*)
(etypecase label-or-posn
(label
(label-position label-or-posn))
......
......@@ -7,11 +7,11 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.43 1992/08/02 19:41:09 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.44 1992/08/03 12:37:12 wlott Exp $")
;;;
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.43 1992/08/02 19:41:09 ram Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/dump.lisp,v 1.44 1992/08/03 12:37:12 wlott Exp $
;;;
;;; This file contains stuff that knows about dumping FASL files.
;;;
......@@ -502,10 +502,7 @@
(dump-unsigned-32 total-length file))))
(flush-fasl-file-buffer file)
(if (backend-featurep :new-assembler)
(dump-segment code-segment code-length file)
(setf fixups
(assem:emit-code-vector (fasl-file-stream file) code-segment)))
(dump-segment code-segment code-length file)
(dump-i-vector trace-table file t)
(let ((handle (dump-pop file)))
(dump-fixups handle fixups file)
......@@ -519,14 +516,11 @@
(dump-fop 'lisp::fop-assembler-code file)
(dump-unsigned-32 length file)
(flush-fasl-file-buffer file)
(if (backend-featurep :new-assembler)
(let ((stream (fasl-file-stream file)))
(new-assem:segment-map-output
code-segment
#'(lambda (sap amount)
(system:output-raw-bytes stream sap 0 amount))))
(setf fixups
(assem:emit-code-vector (fasl-file-stream file) code-segment)))
(let ((stream (fasl-file-stream file)))
(new-assem:segment-map-output
code-segment
#'(lambda (sap amount)
(system:output-raw-bytes stream sap 0 amount))))
(dolist (routine routines)
(dump-fop 'lisp::fop-normal-load file)
(let ((*cold-load-dump* t))
......
......@@ -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.69 1992/08/02 19:40:14 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.70 1992/08/03 12:36:11 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -286,15 +286,7 @@
(length trace-table fixups)
(generate-code component)
(when (and *compiler-trace-output*
(not (backend-featurep :new-assembler)))
(format *compiler-trace-output*
"~|~%Assembly code for ~S~2%"
component)
(assem:dump-segment *code-segment* :stream *compiler-trace-output*))
(when (and *compiler-trace-output*
(backend-featurep :new-assembler))
(when *compiler-trace-output*
(format *compiler-trace-output*
"~|~%Disassembly of code for ~S~2%" component)
(disassem:disassemble-blocks *code-segment*
......@@ -320,13 +312,10 @@
*compile-object*))
(null))))
(cond ((backend-featurep :new-assembler)
(when *code-segment*
(new-assem:release-segment *code-segment*))
(when *elsewhere*
(new-assem:release-segment *elsewhere*)))
(t
(assem:nuke-segment *code-segment*)))))
(when *code-segment*
(new-assem:release-segment *code-segment*))
(when *elsewhere*
(new-assem:release-segment *elsewhere*))))
;; We are done, so don't bother keeping anything around.
(clear-ir2-info component)
......
......@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/vmdef.lisp,v 1.43 1992/07/14 03:40:11 wlott Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/vmdef.lisp,v 1.44 1992/08/03 12:36:24 wlott Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -290,13 +290,9 @@
(setf (svref (sc-move-functions to-sc) num) ',name)
(setf (svref (sc-load-costs to-sc) num) ',cost)))))
,(if (target-featurep :new-assembler)
`(defun ,name ,lambda-list
(new-assem:assemble (*code-segment* ,(first lambda-list))
,@body))
`(defun ,name ,lambda-list
(assem:assemble (*code-segment* ,(first lambda-list))
,@body)))))
(defun ,name ,lambda-list
(new-assem:assemble (*code-segment* ,(first lambda-list))
,@body))))
(defconstant sc-vop-slots '((:move . sc-move-vops)
......@@ -1205,11 +1201,8 @@
,@(binds))
(declare (ignore ,@(vop-parse-ignores parse)))
,@(loads)
,(if (target-featurep :new-assembler)
`(new-assem:assemble (*code-segment* ,n-vop)
,@(vop-parse-body parse))
`(assem:assemble (*code-segment* ,n-vop)
,@(vop-parse-body parse)))
(new-assem:assemble (*code-segment* ,n-vop)
,@(vop-parse-body parse))
,@(saves))))))
......@@ -2463,7 +2456,6 @@
Similar to NOTE-THIS-LOCATION, except the use the location of the next
instruction for the code location, wherever the scheduler decided to put
it."
(assert (backend-featurep :new-assembler))
(new-assem:emit-postit #'(lambda (segment posn)
(declare (ignore segment))
(note-debug-location vop posn kind))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment