Skip to content
Snippets Groups Projects
Commit 8522b601 authored by wlott's avatar wlott
Browse files

Fixed assemble-file to work with the new assembler.

parent 8b075c31
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.30 1992/05/22 18:05:20 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/assemfile.lisp,v 1.31 1992/06/12 03:55:28 wlott Exp $
;;; ;;;
;;; This file contains the extra code necessary to feed an entire file of ;;; This file contains the extra code necessary to feed an entire file of
;;; assembly code to the assembler. ;;; assembly code to the assembler.
...@@ -39,10 +39,20 @@ ...@@ -39,10 +39,20 @@
(won nil) (won nil)
(*code-segment* nil) (*code-segment* nil)
(*elsewhere* nil) (*elsewhere* nil)
(*assembly-optimize* nil)
(*compiler-trace-output* nil)
(*fixups* nil)) (*fixups* nil))
(unwind-protect (unwind-protect
(progn (progn
(pushnew :assembler *features*) (pushnew :assembler *features*)
(when (and (target-featurep :new-assembler) trace-file)
(setf *compiler-trace-output*
(open (if (eq trace-file t)
(make-pathname :defaults name
:type "trace")
trace-file)
:direction :output
:if-exists :supersede)))
(init-assembler) (init-assembler)
(load (merge-pathnames name (make-pathname :type "lisp"))) (load (merge-pathnames name (make-pathname :type "lisp")))
(fasl-dump-cold-load-form `(in-package ,(package-name *package*)) (fasl-dump-cold-load-form `(in-package ,(package-name *package*))
...@@ -78,6 +88,8 @@ ...@@ -78,6 +88,8 @@
(new-assem:release-segment *code-segment*) (new-assem:release-segment *code-segment*)
(when *elsewhere* (when *elsewhere*
(new-assem:release-segment *elsewhere*))) (new-assem:release-segment *elsewhere*)))
(when *compiler-trace-output*
(close *compiler-trace-output*))
(close-fasl-file *lap-output-file* (not won))) (close-fasl-file *lap-output-file* (not won)))
won)) won))
...@@ -116,22 +128,28 @@ ...@@ -116,22 +128,28 @@
(defun emit-assemble (name options regs code) (defun emit-assemble (name options regs code)
(if (backend-featurep :new-assembler) (if (backend-featurep :new-assembler)
`(let (,@(mapcar (collect ((decls))
#'(lambda (reg) (loop
`(,(reg-spec-name reg) (if (and (consp code) (consp (car code)) (eq (caar code) 'declare))
(make-random-tn (decls (pop code))
:kind :normal (return)))
:sc (sc-or-lose ',(reg-spec-sc reg)) `(let (,@(mapcar
:offset ,(reg-spec-offset reg)))) #'(lambda (reg)
regs)) `(,(reg-spec-name reg)
(new-assem:assemble (*code-segment* ',name) (make-random-tn
,name :kind :normal
(push (cons ',name ,name) *assembler-routines*) :sc (sc-or-lose ',(reg-spec-sc reg))
,@code :offset ,(reg-spec-offset reg))))
,@(generate-return-sequence regs))
(or (cadr (assoc :return-style options)) :raw))) ,@(decls)
(when *compile-print* (new-assem:assemble (*code-segment* ',name)
(format *error-output* "~S assembled~%" ',name))) ,name
(push (cons ',name ,name) *assembler-routines*)
,@code
,@(generate-return-sequence
(or (cadr (assoc :return-style options)) :raw)))
(when *compile-print*
(format *error-output* "~S assembled~%" ',name))))
(let* ((labels nil) (let* ((labels nil)
(insts (mapcar #'(lambda (inst) (insts (mapcar #'(lambda (inst)
(cond ((symbolp inst) (cond ((symbolp inst)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment