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 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 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;;; Given a byte offset, OFFSET, return the appropriate static symbol. 49(defun offset-static-symbol (offset) 50 (if (zerop offset) 51 nil 52 (multiple-value-bind (n rem) 53 (truncate (+ offset list-pointer-lowtag (- other-pointer-lowtag) 54 (- (pad-data-block (1- symbol-size)))) 55 (pad-data-block symbol-size)) 56 (unless (and (zerop rem) (<= 0 n (1- (length *static-symbols*)))) 57 (error "The byte offset ~W is not valid." offset)) 58 (elt *static-symbols* n)))) 59 60;;; Return the (byte) offset from NIL to the start of the fdefn object 61;;; for the static function NAME. 62(defun static-fdefn-offset (name) 63 (let ((static-syms (length *static-symbols*)) 64 (static-fun-index (position name *static-funs*))) 65 (unless static-fun-index 66 (error "~S isn't a static function." name)) 67 (+ (* static-syms (pad-data-block symbol-size)) 68 (pad-data-block (1- symbol-size)) 69 (- list-pointer-lowtag) 70 (* static-fun-index (pad-data-block fdefn-size)) 71 other-pointer-lowtag))) 72 73;;; Return the (byte) offset from NIL to the raw-addr slot of the 74;;; fdefn object for the static function NAME. 75(defun static-fun-offset (name) 76 (+ (static-fdefn-offset name) 77 (- other-pointer-lowtag) 78 (* fdefn-raw-addr-slot n-word-bytes))) 79 80;;; Various error-code generating helpers 81(defvar *adjustable-vectors* nil) 82 83(defmacro with-adjustable-vector ((var) &rest body) 84 `(let ((,var (or (pop *adjustable-vectors*) 85 (make-array 16 86 :element-type '(unsigned-byte 8) 87 :fill-pointer 0 88 :adjustable t)))) 89 ;; Don't declare the length - if it gets adjusted and pushed back 90 ;; onto the freelist, it's anyone's guess whether it was expanded. 91 ;; This code was wrong for >12 years, so nobody must have needed 92 ;; more than 16 elements. Maybe we should make it nonadjustable? 93 (declare (type (vector (unsigned-byte 8)) ,var)) 94 (setf (fill-pointer ,var) 0) 95 (unwind-protect 96 (progn 97 ,@body) 98 (push ,var *adjustable-vectors*)))) 99 100;;;; interfaces to IR2 conversion 101 102;;; Return a wired TN describing the N'th full call argument passing 103;;; location. 104(defun standard-arg-location (n) 105 (declare (type unsigned-byte n)) 106 (if (< n register-arg-count) 107 (make-wired-tn *backend-t-primitive-type* descriptor-reg-sc-number 108 (nth n *register-arg-offsets*)) 109 (make-wired-tn *backend-t-primitive-type* control-stack-sc-number n))) 110 111(defun standard-arg-location-sc (n) 112 (declare (type unsigned-byte n)) 113 (if (< n register-arg-count) 114 (make-sc-offset descriptor-reg-sc-number 115 (nth n *register-arg-offsets*)) 116 (make-sc-offset control-stack-sc-number n))) 117 118;;; Make a TN to hold the number-stack frame pointer. This is allocated 119;;; once per component, and is component-live. 120(defun make-nfp-tn () 121 #!+c-stack-is-control-stack 122 (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number) 123 #!-c-stack-is-control-stack 124 (component-live-tn 125 (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset))) 126 127;;; Make an environment-live stack TN for saving the SP for NLX entry. 128(defun make-nlx-sp-tn (env) 129 (physenv-live-tn 130 (make-representation-tn *fixnum-primitive-type* any-reg-sc-number) 131 env)) 132 133(defun make-stack-pointer-tn () 134 (make-normal-tn *fixnum-primitive-type*)) 135 136(defun make-number-stack-pointer-tn () 137 #!+c-stack-is-control-stack 138 (make-restricted-tn *fixnum-primitive-type* ignore-me-sc-number) 139 #!-c-stack-is-control-stack 140 (make-normal-tn *fixnum-primitive-type*)) 141 142;;; Return a list of TNs that can be used to represent an unknown-values 143;;; continuation within a function. 144(defun make-unknown-values-locations () 145 (list (make-stack-pointer-tn) 146 (make-normal-tn *fixnum-primitive-type*))) 147 148;;; This function is called by the ENTRY-ANALYZE phase, allowing 149;;; VM-dependent initialization of the IR2-COMPONENT structure. We 150;;; push placeholder entries in the CONSTANTS to leave room for 151;;; additional noise in the code object header. 152(defun select-component-format (component) 153 (declare (type component component)) 154 ;; The 1+ here is because for the x86 the first constant is a 155 ;; pointer to a list of fixups, or NIL if the code object has none. 156 ;; (The fixups are needed at GC copy time because the X86 code isn't 157 ;; relocatable.) 158 ;; 159 ;; KLUDGE: It'd be cleaner to have the fixups entry be a named 160 ;; element of the CODE (aka component) primitive object. However, 161 ;; it's currently a large, tricky, error-prone chore to change 162 ;; the layout of any primitive object, so for the foreseeable future 163 ;; we'll just live with this ugliness. -- WHN 2002-01-02 164 (dotimes (i (+ code-constants-offset #!+x86 1)) 165 (vector-push-extend nil 166 (ir2-component-constants (component-info component)))) 167 (values)) 168 169 170