From 8522b601b7e0c33e1688dc7808a145a9fe3566ac Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Fri, 12 Jun 1992 03:55:28 +0000 Subject: [PATCH] Fixed assemble-file to work with the new assembler. --- assembly/assemfile.lisp | 52 +++++++++++++++++++++++++++-------------- 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/assembly/assemfile.lisp b/assembly/assemfile.lisp index 543762f4e..6a6ebe446 100644 --- a/assembly/assemfile.lisp +++ b/assembly/assemfile.lisp @@ -7,7 +7,7 @@ ;;; 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 ;;; assembly code to the assembler. @@ -39,10 +39,20 @@ (won nil) (*code-segment* nil) (*elsewhere* nil) + (*assembly-optimize* nil) + (*compiler-trace-output* nil) (*fixups* nil)) (unwind-protect (progn (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) (load (merge-pathnames name (make-pathname :type "lisp"))) (fasl-dump-cold-load-form `(in-package ,(package-name *package*)) @@ -78,6 +88,8 @@ (new-assem:release-segment *code-segment*) (when *elsewhere* (new-assem:release-segment *elsewhere*))) + (when *compiler-trace-output* + (close *compiler-trace-output*)) (close-fasl-file *lap-output-file* (not won))) won)) @@ -116,22 +128,28 @@ (defun emit-assemble (name options regs code) (if (backend-featurep :new-assembler) - `(let (,@(mapcar - #'(lambda (reg) - `(,(reg-spec-name reg) - (make-random-tn - :kind :normal - :sc (sc-or-lose ',(reg-spec-sc reg)) - :offset ,(reg-spec-offset reg)))) - regs)) - (new-assem:assemble (*code-segment* ',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))) + (collect ((decls)) + (loop + (if (and (consp code) (consp (car code)) (eq (caar code) 'declare)) + (decls (pop code)) + (return))) + `(let (,@(mapcar + #'(lambda (reg) + `(,(reg-spec-name reg) + (make-random-tn + :kind :normal + :sc (sc-or-lose ',(reg-spec-sc reg)) + :offset ,(reg-spec-offset reg)))) + regs)) + ,@(decls) + (new-assem:assemble (*code-segment* ',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) (insts (mapcar #'(lambda (inst) (cond ((symbolp inst) -- GitLab