1 ;;;; utility functions and macros needed by the back end to generate
4 ;;;; This software is part of the SBCL system. See the README file for
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.
15 ;;; Make a fixnum out of NUM. (I.e. shift by two bits if it will fit.)
16 (defun fixnumize (num)
18 (ash num
(1- n-lowtag-bits
))
19 (error "~W is too big for a fixnum." num
)))
21 ;;; Determining whether a constant offset fits in an addressing mode.
23 (defun foldable-constant-offset-p (element-size lowtag data-offset offset
)
24 (if (< element-size n-byte-bits
)
26 (multiple-value-bind (min max
)
27 (sb!impl
::displacement-bounds lowtag element-size data-offset
)
28 (<= min offset max
))))
31 ;;;; routines for dealing with static symbols
33 (defun static-symbol-p (symbol)
35 (and (member symbol
*static-symbols
*) t
)))
37 ;;; the byte offset of the static symbol SYMBOL
38 (defun static-symbol-offset (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
))
45 (- list-pointer-lowtag
)))
48 ;;; Given a byte offset, OFFSET, return the appropriate static symbol.
49 (defun offset-static-symbol (offset)
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
))))
60 ;;; Return the (byte) offset from NIL to the start of the fdefn object
61 ;;; for the static function NAME.
62 (defun static-fun-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 (* fdefn-raw-addr-slot n-word-bytes
))))
73 ;;; Various error-code generating helpers
74 (defvar *adjustable-vectors
* nil
)
76 (defmacro with-adjustable-vector
((var) &rest body
)
77 `(let ((,var
(or (pop *adjustable-vectors
*)
79 :element-type
'(unsigned-byte 8)
82 (declare (type (vector (unsigned-byte 8) 16) ,var
))
83 (setf (fill-pointer ,var
) 0)
87 (push ,var
*adjustable-vectors
*))))