;;;; files for more information.
(in-package "SB!C")
-
-(file-comment
- "$Header$")
\f
-(defvar *do-assembly* nil
- #!+sb-doc "If non-NIL, emit assembly code. If NIL, emit VOP templates.")
-
-(defvar *lap-output-file* nil
- #!+sb-doc "the FASL file currently being output to")
+;;; If non-NIL, emit assembly code. If NIL, emit VOP templates.
+(defvar *emit-assembly-code-not-vops-p* nil)
-(defvar *entry-points* nil
- #!+sb-doc "a list of (name . label) for every entry point")
+;;; a list of (NAME . LABEL) for every entry point
+(defvar *entry-points* nil)
-(defvar *assembly-optimize* t
- #!+sb-doc
- "Set this to NIL to inhibit assembly-level optimization. For compiler
- debugging, rather than policy control.")
+;;; Set this to NIL to inhibit assembly-level optimization. (For
+;;; compiler debugging, rather than policy control.)
+(defvar *assembly-optimize* t)
-;;; Note: You might think from the name that this would act like COMPILE-FILE,
-;;; but in fact it's arguably more like LOAD, even down to the return
-;;; convention. It LOADs a file, then writes out any assembly code created
-;;; by the process.
+;;; Note: You might think from the name that this would act like
+;;; COMPILE-FILE, but in fact it's arguably more like LOAD, even down
+;;; to the return convention. It LOADs a file, then writes out any
+;;; assembly code created by the process.
(defun assemble-file (name
&key
(output-file (make-pathname :defaults name
:type "assem")))
;; FIXME: Consider nuking the filename defaulting logic here.
- (let* ((*do-assembly* t)
+ (let* ((*emit-assembly-code-not-vops-p* t)
(name (pathname name))
- (*lap-output-file* (open-fasl-file (pathname output-file) name))
+ ;; the fasl file currently being output to
+ (lap-fasl-output (open-fasl-output (pathname output-file) name))
(*entry-points* nil)
(won nil)
(*code-segment* nil)
(let ((*features* (cons :sb-assembling *features*)))
(init-assembler)
(load (merge-pathnames name (make-pathname :type "lisp")))
- (fasl-dump-cold-load-form `(in-package ,(package-name *package*))
- *lap-output-file*)
+ (fasl-dump-cold-load-form `(in-package ,(package-name
+ (sane-package)))
+ lap-fasl-output)
(sb!assem:append-segment *code-segment* *elsewhere*)
(setf *elsewhere* nil)
(let ((length (sb!assem:finalize-segment *code-segment*)))
length
*fixups*
*entry-points*
- *lap-output-file*))
+ lap-fasl-output))
(setq won t))
- (close-fasl-file *lap-output-file* (not won)))
+ (close-fasl-output lap-fasl-output (not won)))
won))
-(defstruct reg-spec
+(defstruct (reg-spec (:copier nil))
(kind :temp :type (member :arg :temp :res))
(name nil :type symbol)
(temp nil :type symbol)
(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))
+ `(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)
(sb!assem:assemble (*code-segment* ',name)
,name
`(define-vop ,(if (atom name) (list name) name)
(:args ,@(mapcar #'arg-or-res-spec args))
,@(let ((index -1))
- (mapcar #'(lambda (arg)
- `(:temporary (:sc ,(reg-spec-sc arg)
- :offset ,(reg-spec-offset arg)
- :from (:argument ,(incf index))
- :to (:eval 2))
- ,(reg-spec-temp arg)))
+ (mapcar (lambda (arg)
+ `(:temporary (:sc ,(reg-spec-sc arg)
+ :offset ,(reg-spec-offset arg)
+ :from (:argument ,(incf index))
+ :to (:eval 2))
+ ,(reg-spec-temp arg)))
args))
- ,@(mapcar #'(lambda (temp)
- `(:temporary (:sc ,(reg-spec-sc temp)
- :offset ,(reg-spec-offset temp)
- :from (:eval 1)
- :to (:eval 3))
- ,(reg-spec-name temp)))
+ ,@(mapcar (lambda (temp)
+ `(:temporary (:sc ,(reg-spec-sc temp)
+ :offset ,(reg-spec-offset temp)
+ :from (:eval 1)
+ :to (:eval 3))
+ ,(reg-spec-name temp)))
temps)
,@call-temps
(:vop-var ,vop)
,@(let ((index -1))
- (mapcar #'(lambda (res)
- `(:temporary (:sc ,(reg-spec-sc res)
- :offset ,(reg-spec-offset res)
- :from (:eval 2)
- :to (:result ,(incf index))
- :target ,(reg-spec-name res))
- ,(reg-spec-temp res)))
+ (mapcar (lambda (res)
+ `(:temporary (:sc ,(reg-spec-sc res)
+ :offset ,(reg-spec-offset res)
+ :from (:eval 2)
+ :to (:result ,(incf index))
+ :target ,(reg-spec-name res))
+ ,(reg-spec-temp res)))
results))
(:results ,@(mapcar #'arg-or-res-spec results))
(:ignore ,@(mapcar #'reg-spec-name temps)
(mapcar #'cdr
(remove :ignore call-temps
:test-not #'eq :key #'car))))
- ,@(remove-if #'(lambda (x)
- (member x '(:return-style :cost)))
+ ,@(remove-if (lambda (x)
+ (member x '(:return-style :cost)))
options
:key #'car)
(:generator ,cost
- ,@(mapcar #'(lambda (arg)
- #!+(or hppa alpha) `(move ,(reg-spec-name arg)
- ,(reg-spec-temp arg))
- #!-(or hppa alpha) `(move ,(reg-spec-temp arg)
- ,(reg-spec-name arg)))
+ ,@(mapcar (lambda (arg)
+ #!+(or hppa alpha) `(move ,(reg-spec-name arg)
+ ,(reg-spec-temp arg))
+ #!-(or hppa alpha) `(move ,(reg-spec-temp arg)
+ ,(reg-spec-name arg)))
args)
,@call-sequence
- ,@(mapcar #'(lambda (res)
- #!+(or hppa alpha) `(move ,(reg-spec-temp res)
- ,(reg-spec-name res))
- #!-(or hppa alpha) `(move ,(reg-spec-name res)
- ,(reg-spec-temp res)))
+ ,@(mapcar (lambda (res)
+ #!+(or hppa alpha) `(move ,(reg-spec-temp res)
+ ,(reg-spec-name res))
+ #!-(or hppa alpha) `(move ,(reg-spec-name res)
+ ,(reg-spec-temp res)))
results))))))
(def!macro define-assembly-routine (name&options vars &body code)
(values name&options nil)
(values (car name&options)
(cdr name&options)))
- (let ((regs (mapcar #'(lambda (var) (apply #'parse-reg-spec var)) vars)))
- (if *do-assembly*
+ (let ((regs (mapcar (lambda (var) (apply #'parse-reg-spec var)) vars)))
+ (if *emit-assembly-code-not-vops-p*
(emit-assemble name options regs code)
(emit-vop name options regs)))))
projects / sbcl.git / blobdiff