src/compiler/early-assem.lisp

   1 ;;;; constants and types for assembly
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB-ASSEM")
  13
  14 ;;; common supertype for all the different kinds of annotations
  15 (defstruct (annotation (:constructor nil)
  16                         (:copier nil))
  17   ;; Where in the raw output stream was this annotation emitted?
  18   (index 0 :type index)
  19   ;; What position does that correspond to?
  20   (posn nil :type (or index null)))
  21
  22 (defstruct (label (:include annotation)
  23                    (:constructor gen-label (&optional comment))
  24                    (:copier nil))
  25   (comment)
  26   (usedp nil :type boolean)) ; whether it was ever used as a branch target
  27
  28 (defmethod print-object ((label label) stream)
  29   (cond ((not (boundp 'sb-c:*compilation*))
  30          (print-unreadable-object (label stream :type t :identity t)))
  31         ((or *print-escape* *print-readably*)
  32          (print-unreadable-object (label stream :type t)
  33            (prin1 (sb-c:label-id label) stream)))
  34         (t
  35          (format stream "L~D" (sb-c:label-id label)))))
  36
  37 ;;; Not only can DEFINE-ASSEMBLY-ROUTINE not work in the target,
  38 ;;; the cross-compiler never sees a DEFUN for any of the helper functions
  39 ;;; that are called within, and therefore would issue "unknown function"
  40 ;;; warnings. So we avoid letting it see a load-time definition of the macro.
  41 (eval-when (:compile-toplevel #-sb-xc :load-toplevel :execute)
  42 (#-sb-xc defmacro #+sb-xc sb-xc:defmacro sb-vm::define-assembly-routine
  43     (name&options vars &body code)
  44   (multiple-value-bind (name options)
  45       (if (atom name&options)
  46           (values name&options nil)
  47           (values (car name&options) (cdr name&options)))
  48     (let ((regs (mapcar (lambda (var) (apply #'sb-c::parse-reg-spec var))
  49                         vars)))
  50       (if (member :sb-assembling sb-xc:*features*)
  51           (sb-c::emit-assemble name options regs code)
  52           (sb-c::emit-assemble-vop name options regs))))))