1 ;;;; the implementation-independent parts of the code generator. We use
2 ;;;; functions and information provided by the VM definition to convert
3 ;;;; IR2 into assembly code. After emitting code, we finish the
4 ;;;; assembly and then do the post-assembly phase.
6 ;;;; This software is part of the SBCL system. See the README file for
9 ;;;; This software is derived from the CMU CL system, which was
10 ;;;; written at Carnegie Mellon University and released into the
11 ;;;; public domain. The software is in the public domain and is
12 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
13 ;;;; files for more information.
20 ;;;; utilities used during code generation
22 (defun component-header-length (&optional
23 (component *component-being-compiled*))
25 "Returns the number of bytes used by the code object header."
26 (let* ((2comp (component-info component))
27 (constants (ir2-component-constants 2comp))
28 (num-consts (length constants)))
29 (ash (logandc2 (1+ num-consts) 1) sb!vm:word-shift)))
31 (defun sb-allocated-size (name)
33 "The size of the Name'd SB in the currently compiled component. Useful
34 mainly for finding the size for allocating stack frames."
35 (finite-sb-current-size (sb-or-lose name)))
37 (defun current-nfp-tn (vop)
39 "Return the TN that is used to hold the number stack frame-pointer in VOP's
40 function. Returns NIL if no number stack frame was allocated."
41 (unless (zerop (sb-allocated-size 'non-descriptor-stack))
42 (let ((block (ir2-block-block (vop-block vop))))
43 (when (ir2-environment-number-stack-p
45 (block-environment block)))
46 (ir2-component-nfp (component-info (block-component block)))))))
48 (defun callee-nfp-tn (2env)
50 "Return the TN that is used to hold the number stack frame-pointer in the
51 function designated by 2env. Returns NIL if no number stack frame was
53 (unless (zerop (sb-allocated-size 'non-descriptor-stack))
54 (when (ir2-environment-number-stack-p 2env)
55 (ir2-component-nfp (component-info *component-being-compiled*)))))
57 (defun callee-return-pc-tn (2env)
59 "Return the TN used for passing the return PC in a local call to the function
61 (ir2-environment-return-pc-pass 2env))
63 ;;;; specials used during code generation
65 (defvar *trace-table-info*)
66 (defvar *code-segment* nil)
67 (defvar *elsewhere* nil)
68 (defvar *elsewhere-label* nil)
70 ;;;; noise to emit an instruction trace
72 (defvar *prev-segment*)
76 (defun trace-instruction (segment vop inst args)
77 (let ((*standard-output* *compiler-trace-output*))
78 (unless (eq *prev-segment* segment)
79 (format t "in the ~A segment:~%" (sb!assem:segment-name segment))
80 (setf *prev-segment* segment))
81 (unless (eq *prev-vop* vop)
86 (format *compiler-trace-output* "~S~%" vop)))
88 (setf *prev-vop* vop))
91 (format t "~A:~%" args))
93 (format t "~0,8T.align~0,8T~A~%" args))
95 (format t "~0,8T~A~@[~0,8T~{~A~^, ~}~]~%" inst args))))
98 ;;;; GENERATE-CODE and support routines
100 ;;; standard defaults for slots of SEGMENT objects
101 (defun default-segment-run-scheduler ()
102 (and *assembly-optimize*
105 (block-next (component-head *component-being-compiled*))))
106 (or (> speed cspeed) (> space cspeed)))))
107 (defun default-segment-inst-hook ()
109 (and *compiler-trace-output* #'trace-instruction))
111 (defun init-assembler ()
113 (sb!assem:make-segment :name "regular"
114 :run-scheduler (default-segment-run-scheduler)
115 :inst-hook (default-segment-inst-hook)))
117 (setf (sb!assem:segment-collect-dynamic-statistics *code-segment*)
118 *collect-dynamic-statistics*)
120 (sb!assem:make-segment :name "elsewhere"
121 :run-scheduler (default-segment-run-scheduler)
122 :inst-hook (default-segment-inst-hook)))
125 (defun generate-code (component)
127 (when *compiler-trace-output*
128 (format *compiler-trace-output*
129 "~|~%assembly code for ~S~2%"
132 (*trace-table-info* nil)
136 (let ((label (sb!assem:gen-label)))
137 (setf *elsewhere-label* label)
138 (sb!assem:assemble (*elsewhere*)
139 (sb!assem:emit-label label)))
140 (do-ir2-blocks (block component)
141 (let ((1block (ir2-block-block block)))
142 (when (and (eq (block-info 1block) block)
143 (block-start 1block))
144 (sb!assem:assemble (*code-segment*)
145 (sb!assem:emit-label (block-label 1block)))
146 (let ((env (block-environment 1block)))
147 (unless (eq env prev-env)
148 (let ((lab (gen-label)))
149 (setf (ir2-environment-elsewhere-start (environment-info env))
151 (emit-label-elsewhere lab))
152 (setq prev-env env)))))
153 (do ((vop (ir2-block-start-vop block) (vop-next vop)))
155 (let ((gen (vop-info-generator-function (vop-info vop))))
159 "missing generator for ~S~%"
160 (template-name (vop-info vop)))))))
161 (sb!assem:append-segment *code-segment* *elsewhere*)
162 (setf *elsewhere* nil)
163 (values (sb!assem:finalize-segment *code-segment*)
164 (nreverse *trace-table-info*)
167 (defun emit-label-elsewhere (label)
168 (sb!assem:assemble (*elsewhere*)
169 (sb!assem:emit-label label)))
171 (defun label-elsewhere-p (label-or-posn)
172 (<= (label-position *elsewhere-label*)
173 (etypecase label-or-posn
175 (label-position label-or-posn))