src/compiler/codegen.lisp

   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.
   5
   6 ;;;; This software is part of the SBCL system. See the README file for
   7 ;;;; more information.
   8 ;;;;
   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.
  14
  15 (in-package "SB!C")
  16
  17 (file-comment
  18   "$Header$")
  19 \f
  20 ;;;; utilities used during code generation
  21
  22 (defun component-header-length (&optional
  23                                 (component *component-being-compiled*))
  24   #!+sb-doc
  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)))
  30
  31 (defun sb-allocated-size (name)
  32   #!+sb-doc
  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)))
  36
  37 (defun current-nfp-tn (vop)
  38   #!+sb-doc
  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
  44            (environment-info
  45             (block-environment block)))
  46       (ir2-component-nfp (component-info (block-component block)))))))
  47
  48 (defun callee-nfp-tn (2env)
  49   #!+sb-doc
  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
  52   allocated."
  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*)))))
  56
  57 (defun callee-return-pc-tn (2env)
  58   #!+sb-doc
  59   "Return the TN used for passing the return PC in a local call to the function
  60   designated by 2env."
  61   (ir2-environment-return-pc-pass 2env))
  62 \f
  63 ;;;; specials used during code generation
  64
  65 (defvar *trace-table-info*)
  66 (defvar *code-segment* nil)
  67 (defvar *elsewhere* nil)
  68 (defvar *elsewhere-label* nil)
  69 \f
  70 ;;;; noise to emit an instruction trace
  71
  72 (defvar *prev-segment*)
  73 (defvar *prev-vop*)
  74
  75 #!+sb-show
  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)
  82       (when vop
  83         (format t "~%VOP ")
  84         (if (vop-p vop)
  85             (print-vop vop)
  86             (format *compiler-trace-output* "~S~%" vop)))
  87       (terpri)
  88       (setf *prev-vop* vop))
  89     (case inst
  90       (:label
  91        (format t "~A:~%" args))
  92       (:align
  93        (format t "~0,8T.align~0,8T~A~%" args))
  94       (t
  95        (format t "~0,8T~A~@[~0,8T~{~A~^, ~}~]~%" inst args))))
  96   (values))
  97 \f
  98 ;;;; GENERATE-CODE and support routines
  99
 100 ;;; standard defaults for slots of SEGMENT objects
 101 (defun default-segment-run-scheduler ()
 102   (and *assembly-optimize*
 103         (policy (lambda-bind
 104                  (block-home-lambda
 105                   (block-next (component-head *component-being-compiled*))))
 106                 (or (> speed cspeed) (> space cspeed)))))
 107 (defun default-segment-inst-hook ()
 108   #!+sb-show
 109   (and *compiler-trace-output* #'trace-instruction))
 110
 111 (defun init-assembler ()
 112   (setf *code-segment*
 113         (sb!assem:make-segment :name "regular"
 114                                :run-scheduler (default-segment-run-scheduler)
 115                                :inst-hook (default-segment-inst-hook)))
 116   #!+sb-dyncount
 117   (setf (sb!assem:segment-collect-dynamic-statistics *code-segment*)
 118         *collect-dynamic-statistics*)
 119   (setf *elsewhere*
 120         (sb!assem:make-segment :name "elsewhere"
 121                                :run-scheduler (default-segment-run-scheduler)
 122                                :inst-hook (default-segment-inst-hook)))
 123   (values))
 124
 125 (defun generate-code (component)
 126   #!+sb-show
 127   (when *compiler-trace-output*
 128     (format *compiler-trace-output*
 129             "~|~%assembly code for ~S~2%"
 130             component))
 131   (let ((prev-env nil)
 132         (*trace-table-info* nil)
 133         (*prev-segment* nil)
 134         (*prev-vop* nil)
 135         (*fixups* 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))
 150                       lab)
 151                 (emit-label-elsewhere lab))
 152               (setq prev-env env)))))
 153       (do ((vop (ir2-block-start-vop block) (vop-next vop)))
 154           ((null vop))
 155         (let ((gen (vop-info-generator-function (vop-info vop))))
 156           (if gen
 157             (funcall gen vop)
 158             (format t
 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*)
 165             *fixups*)))
 166
 167 (defun emit-label-elsewhere (label)
 168   (sb!assem:assemble (*elsewhere*)
 169     (sb!assem:emit-label label)))
 170
 171 (defun label-elsewhere-p (label-or-posn)
 172   (<= (label-position *elsewhere-label*)
 173       (etypecase label-or-posn
 174         (label
 175          (label-position label-or-posn))
 176         (index
 177          label-or-posn))))