src/compiler/generic/utils.lisp

   1 ;;;; utility functions and macros needed by the back end to generate
   2 ;;;; code
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!VM")
  14 \f
  15 ;;; Make a fixnum out of NUM. (I.e. shift by two bits if it will fit.)
  16 (defun fixnumize (num)
  17   (if (fixnump num)
  18       (ash num n-fixnum-tag-bits)
  19       (error "~W is too big for a fixnum." num)))
  20
  21 ;;; Determining whether a constant offset fits in an addressing mode.
  22 #!+(or x86 x86-64)
  23 (defun foldable-constant-offset-p (element-size lowtag data-offset offset)
  24   (if (< element-size n-byte-bits)
  25       nil
  26       (multiple-value-bind (min max)
  27           (sb!impl::displacement-bounds lowtag element-size data-offset)
  28         (<= min offset max))))
  29
  30 \f
  31 ;;;; routines for dealing with static symbols
  32
  33 (defun static-symbol-p (symbol)
  34   (or (null symbol)
  35       (and (member symbol *static-symbols*) t)))
  36
  37 ;;; the byte offset of the static symbol SYMBOL
  38 (defun static-symbol-offset (symbol)
  39   (if symbol
  40       (let ((posn (position symbol *static-symbols*)))
  41         (unless posn (error "~S is not a static symbol." symbol))
  42         (+ (* posn (pad-data-block symbol-size))
  43            (pad-data-block (1- symbol-size))
  44            other-pointer-lowtag
  45            (- list-pointer-lowtag)))
  46       0))
  47
  48 ;;; Return the (byte) offset from NIL to the start of the fdefn object
  49 ;;; for the static function NAME.
  50 (defun static-fdefn-offset (name)
  51   (let ((static-syms (length *static-symbols*))
  52         (static-fun-index (position name *static-funs*)))
  53     (unless static-fun-index
  54       (error "~S isn't a static function." name))
  55     (+ (* static-syms (pad-data-block symbol-size))
  56        (pad-data-block (1- symbol-size))
  57        (- list-pointer-lowtag)
  58        (* static-fun-index (pad-data-block fdefn-size))
  59        other-pointer-lowtag)))
  60
  61 ;;; Return the (byte) offset from NIL to the raw-addr slot of the
  62 ;;; fdefn object for the static function NAME.
  63 (defun static-fun-offset (name)
  64   (+ (static-fdefn-offset name)
  65      (- other-pointer-lowtag)
  66      (* fdefn-raw-addr-slot n-word-bytes)))
  67 \f
  68 ;;; Various error-code generating helpers
  69 (defvar *adjustable-vectors* nil)
  70
  71 (defmacro with-adjustable-vector ((var) &rest body)
  72   `(let ((,var (or (pop *adjustable-vectors*)
  73                    (make-array 16
  74                                :element-type '(unsigned-byte 8)
  75                                :fill-pointer 0
  76                                :adjustable t))))
  77      ;; Don't declare the length - if it gets adjusted and pushed back
  78      ;; onto the freelist, it's anyone's guess whether it was expanded.
  79      ;; This code was wrong for >12 years, so nobody must have needed
  80      ;; more than 16 elements. Maybe we should make it nonadjustable?
  81      (declare (type (vector (unsigned-byte 8)) ,var))
  82      (setf (fill-pointer ,var) 0)
  83      (unwind-protect
  84          (progn
  85            ,@body)
  86        (push ,var *adjustable-vectors*))))
  87
  88 ;;;; interfaces to IR2 conversion
  89
  90 ;;; Return a wired TN describing the N'th full call argument passing
  91 ;;; location.
  92 (defun standard-arg-location (n)
  93   (declare (type unsigned-byte n))
  94   (if (< n register-arg-count)
  95       (make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number
  96                      (nth n *register-arg-offsets*))
  97       (make-wired-tn *backend-t-primitive-type* control-stack-sc-number n)))
  98
  99 (defun standard-arg-location-sc (n)
 100   (declare (type unsigned-byte n))
 101   (if (< n register-arg-count)
 102       (make-sc-offset descriptor-reg-sc-number
 103                       (nth n *register-arg-offsets*))
 104       (make-sc-offset control-stack-sc-number n)))
 105
 106 ;;; Make a TN to hold the number-stack frame pointer.  This is allocated
 107 ;;; once per component, and is component-live.
 108 (defun make-nfp-tn ()
 109   #!+c-stack-is-control-stack
 110   (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number)
 111   #!-c-stack-is-control-stack
 112   (component-live-tn
 113    (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset)))
 114
 115 ;;; Make an environment-live stack TN for saving the SP for NLX entry.
 116 (defun make-nlx-sp-tn (env)
 117   (physenv-live-tn
 118    (make-representation-tn *fixnum-primitive-type* any-reg-sc-number)
 119    env))
 120
 121 (defun make-stack-pointer-tn ()
 122   (make-normal-tn *fixnum-primitive-type*))
 123
 124 (defun make-number-stack-pointer-tn ()
 125   #!+c-stack-is-control-stack
 126   (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number)
 127   #!-c-stack-is-control-stack
 128   (make-normal-tn *fixnum-primitive-type*))
 129
 130 ;;; Return a list of TNs that can be used to represent an unknown-values
 131 ;;; continuation within a function.
 132 (defun make-unknown-values-locations ()
 133   (list (make-stack-pointer-tn)
 134         (make-normal-tn *fixnum-primitive-type*)))
 135
 136 ;;; This function is called by the ENTRY-ANALYZE phase, allowing
 137 ;;; VM-dependent initialization of the IR2-COMPONENT structure. We
 138 ;;; push placeholder entries in the CONSTANTS to leave room for
 139 ;;; additional noise in the code object header.
 140 (defun select-component-format (component)
 141   (declare (type component component))
 142   (dotimes (i code-constants-offset)
 143     (vector-push-extend nil
 144                         (ir2-component-constants (component-info component))))
 145   (values))
 146
 147