llvm/compile.lisp

   1 (in-package :sb-c)
   2
   3 (defun compile-component-to-ir1 (component)
   4
   5   ;; miscellaneous sanity checks
   6   ;;
   7   ;; FIXME: These are basically pretty wimpy compared to the checks done
   8   ;; by the old CHECK-IR1-CONSISTENCY code. It would be really nice to
   9   ;; make those internal consistency checks work again and use them.
  10   (aver-live-component component)
  11   (do-blocks (block component)
  12     (aver (eql (block-component block) component)))
  13   (dolist (lambda (component-lambdas component))
  14     ;; sanity check to prevent weirdness from propagating insidiously as
  15     ;; far from its root cause as it did in bug 138: Make sure that
  16     ;; thing-to-COMPONENT links are consistent.
  17     (aver (eql (lambda-component lambda) component))
  18     (aver (eql (node-component (lambda-bind lambda)) component)))
  19
  20   (let* ((*component-being-compiled* component))
  21
  22     ;; Record xref information before optimization. This way the
  23     ;; stored xref data reflects the real source as closely as
  24     ;; possible.
  25     (record-component-xrefs component)
  26
  27     (ir1-phases component)
  28
  29     (when *loop-analyze*
  30       (dfo-as-needed component)
  31       (find-dominators component)
  32       (loop-analyze component))
  33
  34     #|
  35     (when (and *loop-analyze* *compiler-trace-output*)
  36       (labels ((print-blocks (block)
  37                  (format *compiler-trace-output* "    ~A~%" block)
  38                  (when (block-loop-next block)
  39                    (print-blocks (block-loop-next block))))
  40                (print-loop (loop)
  41                  (format *compiler-trace-output* "loop=~A~%" loop)
  42                  (print-blocks (loop-blocks loop))
  43                  (dolist (l (loop-inferiors loop))
  44                    (print-loop l))))
  45         (print-loop (component-outer-loop component))))
  46     |#
  47
  48     ;; FIXME: What is MAYBE-MUMBLE for? Do we need it any more?
  49     (maybe-mumble "env ")
  50     (physenv-analyze component)
  51     (dfo-as-needed component)
  52
  53     (delete-if-no-entries component)
  54
  55 ;    (unless (eq (block-next (component-head component))
  56 ;                (component-tail component))
  57 ;      (%compile-component component)))
  58
  59     )
  60   component)
  61
  62 (defun %compile-to-ir1 (lambda-expression
  63                  *compile-object*
  64                  &key
  65                  name
  66                  (path
  67                   ;; This magical idiom seems to be the appropriate
  68                   ;; path for compiling standalone LAMBDAs, judging
  69                   ;; from the CMU CL code and experiment, so it's a
  70                   ;; nice default for things where we don't have a
  71                   ;; real source path (as in e.g. inside CL:COMPILE).
  72                   '(original-source-start 0 0)))
  73   (when name
  74     (legal-fun-name-or-type-error name))
  75   (let* ((*lexenv* (make-lexenv
  76                     :policy *policy*
  77                     :handled-conditions *handled-conditions*
  78                     :disabled-package-locks *disabled-package-locks*))
  79          (*compiler-sset-counter* 0)
  80          (fun (make-functional-from-toplevel-lambda lambda-expression
  81                                                     :name name
  82                                                     :path path)))
  83     (locall-analyze-clambdas-until-done (list fun))
  84
  85     (let ((components-from-dfo (find-initial-dfo (list fun))))
  86       (map 'list 'compile-component-to-ir1 components-from-dfo))))
  87
  88 (defun cleanup-after-compile-to-ir1 (components-from-dfo)
  89   (clear-constant-info)
  90   (mapc #'clear-ir1-info components-from-dfo)
  91   (clear-stuff))
  92
  93
  94 (defun compile-to-ir1 (name definition &optional (*lexenv* (make-null-lexenv)))
  95   (with-compilation-values
  96     (with-compilation-unit ()
  97       ;; FIXME: These bindings were copied from SUB-COMPILE-FILE with
  98       ;; few changes. Once things are stable, the shared bindings
  99       ;; probably be merged back together into some shared utility
 100       ;; macro, or perhaps both merged into one of the existing utility
 101       ;; macros SB-C::WITH-COMPILATION-VALUES or
 102       ;; CL:WITH-COMPILATION-UNIT.
 103       (let* (;; FIXME: Do we need the *INFO-ENVIRONMENT* rebinding
 104              ;; here? It's a literal translation of the old CMU CL
 105              ;; rebinding to (OR *BACKEND-INFO-ENVIRONMENT*
 106              ;; *INFO-ENVIRONMENT*), and it's not obvious whether the
 107              ;; rebinding to itself is needed now that SBCL doesn't
 108              ;; need *BACKEND-INFO-ENVIRONMENT*.
 109              (*info-environment* *info-environment*)
 110              (form (get-lambda-to-compile definition))
 111              (*source-info* (make-lisp-source-info form :parent *source-info*))
 112              (*toplevel-lambdas* ())
 113              (*block-compile* nil)
 114              (*allow-instrumenting* nil)
 115              (*code-coverage-records* nil)
 116              (*code-coverage-blocks* nil)
 117              (*compiler-error-bailout*
 118               (lambda (&optional error)
 119                 (declare (ignore error))
 120                 (compiler-mumble
 121                  "~2&fatal error, aborting compilation~%")
 122                 (return-from compile-to-ir1 (values nil t nil))))
 123              (*current-path* nil)
 124              (*last-source-context* nil)
 125              (*last-original-source* nil)
 126              (*last-source-form* nil)
 127              (*last-format-string* nil)
 128              (*last-format-args* nil)
 129              (*last-message-count* 0)
 130              (*last-error-context* nil)
 131              (*gensym-counter* 0)
 132              ;; KLUDGE: This rebinding of policy is necessary so that
 133              ;; forms such as LOCALLY at the REPL actually extend the
 134              ;; compilation policy correctly.  However, there is an
 135              ;; invariant that is potentially violated: future
 136              ;; refactoring must not allow this to be done in the file
 137              ;; compiler.  At the moment we're clearly alright, as we
 138              ;; call %COMPILE with a core-object, not a fasl-stream,
 139              ;; but caveat future maintainers. -- CSR, 2002-10-27
 140              (*policy* (lexenv-policy *lexenv*))
 141              ;; see above
 142              (*handled-conditions* (lexenv-handled-conditions *lexenv*))
 143              ;; ditto
 144              (*disabled-package-locks* (lexenv-disabled-package-locks *lexenv*))
 145              ;; FIXME: ANSI doesn't say anything about CL:COMPILE
 146              ;; interacting with these variables, so we shouldn't. As
 147              ;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
 148              ;; binding these variables, so as a quick hack we do so
 149              ;; too. But a proper implementation would have verbosity
 150              ;; controlled by function arguments and lexical variables.
 151              (*compile-verbose* nil)
 152              (*compile-print* nil))
 153         (handler-bind (((satisfies handle-condition-p) #'handle-condition-handler))
 154           (clear-stuff)
 155           (find-source-paths form 0)
 156           (%compile-to-ir1 form (make-core-object)
 157                            :name name
 158                            :path '(original-source-start 0 0)))))))
 159