src/compiler/generic/parms.lisp

   1 ;;;; This file contains some parameterizations of various VM
   2 ;;;; attributes common to all architectures.
   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 ;;; When building the cross-compiler (and called by the host), read the
  16 ;;; dynamic-space-size file.
  17 ;;; When called by the cross-compiler (in the host), use the previously chosen value.
  18 ;;; The target function is never called, but if omitted via #-sb-xc-host,
  19 ;;; compilation of !GENCGC-SPACE-SETUP would issue an "undefined" warning.
  20 (defun !read-dynamic-space-size ()
  21   (unless (member :sb-xc-host *features*)
  22     (return-from !read-dynamic-space-size (symbol-value 'default-dynamic-space-size)))
  23   (with-open-file (f "output/dynamic-space-size.txt" :if-does-not-exist nil)
  24     (unless f
  25       (return-from !read-dynamic-space-size nil))
  26     (let ((line (read-line f)))
  27       (multiple-value-bind (number end)
  28           (parse-integer line :junk-allowed t)
  29         (when number
  30             (let* ((ext (subseq line end))
  31                    (mult (cond ((or (zerop (length ext))
  32                                     (member ext '("MB" "MIB") :test #'equalp))
  33                                 (expt 2 20))
  34                                ((member ext '("GB" "GIB") :test #'equalp)
  35                                 (expt 2 30))
  36                                (t
  37                                 (error "Invalid --dynamic-space-size=~A" line)))))
  38               (* number mult)))))))
  39
  40 #!+gencgc
  41 ;; Define START/END constants for GENCGC spaces.
  42 ;; Assumptions:
  43 ;;     We only need very small read-only and static spaces, because
  44 ;;     gencgc does not purify any more.  We can count on being able to
  45 ;;     allocate them with roughly the same size, and next to each other.
  46 ;;
  47 ;;     The linkage table (if enabled) can be treated the same way.
  48 ;;
  49 ;;     Dynamic space traditionally sits elsewhere, so has its own
  50 ;;     parameter.  But if not specified, it is allocated right after
  51 ;;     the other spaces (used on Windows/x86).
  52 ;;
  53 ;;     The safepoint page (if enabled) is to be allocated immediately
  54 ;;     prior to static page.
  55 (defmacro !gencgc-space-setup
  56     (small-spaces-start
  57           &key ((:dynamic-space-start dynamic-space-start*))
  58                ((:dynamic-space-size dynamic-space-size*))
  59                ;; The immobile-space START parameters should not be used
  60                ;; except in forcing discontiguous addresses for testing.
  61                ;; And of course, don't use them if unsupported.
  62                ((:fixedobj-space-start fixedobj-space-start*))
  63                ((:fixedobj-space-size  fixedobj-space-size*) (* 24 1024 1024))
  64                ((:varyobj-space-start  varyobj-space-start*))
  65                ((:varyobj-space-size   varyobj-space-size*) (* 104 1024 1024))
  66                (small-space-size #x100000))
  67   (declare (ignorable dynamic-space-start*)) ; might be unused in make-host-2
  68   (flet ((defconstantish (relocatable symbol value)
  69            (if (not relocatable) ; easy case
  70                `(defconstant ,symbol ,value)
  71                ;; Genesis needs to know the gspace start, but it's not constant.
  72                ;; This value will not be exposed to C code.
  73                #+sb-xc-host `(defparameter ,symbol ,value)
  74                ;; Ideally the #-sb-xc-host code be a DEFINE-ALIEN-VARIABLE,
  75                ;; but can't be due to dependency order problem.
  76                )))
  77     (let*
  78         ((spaces (append `((read-only ,small-space-size)
  79                            #!+sb-safepoint
  80                            (safepoint ,+backend-page-bytes+ gc-safepoint-page-addr)
  81                            (static ,small-space-size))
  82                          #!+linkage-table
  83                          `((linkage-table ,small-space-size))
  84                          #!+immobile-space
  85                          `((fixedobj ,fixedobj-space-size*)
  86                            (varyobj ,varyobj-space-size*))))
  87          (ptr small-spaces-start)
  88          (small-space-forms
  89            (loop for (space size var-name) in spaces
  90                  appending
  91                  (let* ((relocatable
  92                           ;; TODO: linkage-table could move with code, if the CPU
  93                           ;; prefers PC-relative jumps, and we emit better code
  94                           ;; (which we don't- for x86 we jmp via RBX always)
  95                           #!+relocatable-heap (member space '(fixedobj varyobj)))
  96                         (start ptr)
  97                         (end (+ ptr size)))
  98                    (setf ptr end)
  99                    (if var-name
 100                        `((defconstant ,var-name ,start))
 101                        (let ((start-sym (symbolicate space "-SPACE-START")))
 102                          ;; Allow expressly given addresses / sizes for immobile space.
 103                          ;; The addresses are for testing only - you should not need them.
 104                          (case space
 105                            (varyobj  (setq start (or varyobj-space-start* start)
 106                                            end (+ start varyobj-space-size*)))
 107                            (fixedobj (setq start (or fixedobj-space-start* start)
 108                                            end (+ start fixedobj-space-size*))))
 109                          `(,(defconstantish relocatable start-sym start)
 110                            ,(cond ((not relocatable)
 111                                    `(defconstant ,(symbolicate space "-SPACE-END") ,end))
 112                                   #-sb-xc-host ((eq space 'varyobj)) ; don't emit anything
 113                                   (t
 114                                    `(defconstant ,(symbolicate space "-SPACE-SIZE")
 115                                       ,(- end start)))))))))))
 116       `(progn
 117          ,@small-space-forms
 118          ,(defconstantish (or #!+relocatable-heap t) 'dynamic-space-start
 119             (or dynamic-space-start* ptr))
 120          (defconstant default-dynamic-space-size
 121            ;; Build-time make-config.sh option "--dynamic-space-size" overrides
 122            ;; keyword argument :dynamic-space-size which overrides general default.
 123            ;; All are overridden by runtime --dynamic-space-size command-line arg.
 124            (or ,(or (!read-dynamic-space-size) dynamic-space-size*)
 125                (ecase n-word-bits
 126                  (32 (expt 2 29))
 127                  (64 (expt 2 30)))))))))
 128
 129 (defconstant-eqx +c-callable-fdefns+
 130   '(sub-gc
 131     sb!kernel::post-gc
 132     internal-error
 133     sb!kernel::control-stack-exhausted-error
 134     sb!kernel::binding-stack-exhausted-error
 135     sb!kernel::alien-stack-exhausted-error
 136     sb!kernel::heap-exhausted-error
 137     sb!kernel::undefined-alien-variable-error
 138     sb!kernel::memory-fault-error
 139     sb!kernel::unhandled-trap-error
 140     ;; On these it's called through the internal errors mechanism
 141     #!-(or arm arm64 x86-64) undefined-alien-fun-error
 142     sb!di::handle-breakpoint
 143     sb!di::handle-single-step-trap
 144     #!+win32 sb!kernel::handle-win32-exception
 145     #!+sb-thruption sb!thread::run-interruption
 146     enter-alien-callback
 147     #!+sb-thread sb!thread::enter-foreign-callback
 148     #!+(and sb-safepoint-strictly (not win32))
 149     sb!unix::signal-handler-callback)
 150   #'equal)
 151
 152 ;;; Static symbols that C code must be able to assign to,
 153 ;;; as contrasted with static for other reasons such as:
 154 ;;;  - garbage collections roots (namely NIL)
 155 ;;;  - other symbols that Lisp codegen must hardwire (T)
 156 ;;;  - static for efficiency of access but need not be
 157 (defconstant-eqx !per-thread-c-interface-symbols
 158   `((*free-interrupt-context-index* 0)
 159     (sb!sys:*allow-with-interrupts* t)
 160     (sb!sys:*interrupts-enabled* t)
 161     *alloc-signal*
 162     sb!sys:*interrupt-pending*
 163     #!+sb-thruption sb!sys:*thruption-pending*
 164     #!+sb-thruption sb!kernel:*restart-clusters*
 165     *in-without-gcing*
 166     *gc-inhibit*
 167     *gc-pending*
 168     #!+sb-safepoint sb!impl::*gc-safe*
 169     #!+sb-safepoint sb!impl::*in-safepoint*
 170     #!+sb-thread *stop-for-gc-pending*
 171     ;; non-x86oid gencgc object pinning
 172     #!+(and gencgc (not (or x86 x86-64))) *pinned-objects*
 173     ;; things needed for non-local-exit
 174     (*current-catch-block* 0)
 175     (*current-unwind-protect-block* 0)
 176     )
 177   #'equal)
 178
 179 (defconstant-eqx +common-static-symbols+
 180   `(t
 181     ;; These symbols are accessed from C only through TLS,
 182     ;; never the symbol-value slot
 183     #!-sb-thread ,@(mapcar (lambda (x) (car (ensure-list x)))
 184                            !per-thread-c-interface-symbols)
 185     ;; NLX variables are thread slots on x86-64.  A static sym is needed
 186     ;; for arm64, ppc, and x86 because we haven't implemented TLS index fixups,
 187     ;; so must lookup the TLS index given the symbol.
 188     #!+(and sb-thread (not x86-64)) ,@'(*current-catch-block*
 189                                         *current-unwind-protect-block*)
 190
 191     ;; sb-safepoint in addition to accessing this symbol via TLS,
 192     ;; uses the symbol itself as a value. Kinda weird.
 193     #!+sb-safepoint *in-without-gcing*
 194
 195     #!+immobile-space *immobile-freelist* ; not per-thread (yet...)
 196
 197     #!+hpux *c-lra*
 198
 199     ;; stack pointers
 200     #!-sb-thread *binding-stack-start* ; a thread slot if #!+sb-thread
 201     #!-sb-thread *control-stack-start* ; ditto
 202     #!-sb-thread *control-stack-end*   ; ditto
 203
 204     #!-sb-thread *stepping*
 205
 206     ;; threading support
 207     #!+sb-thread *free-tls-index*
 208     ;; Keep in sync with 'compiler/early-backend.lisp':
 209     ;;  "only PPC uses a separate symbol for the TLS index lock"
 210     #!+(and sb-thread ppc) *tls-index-lock*
 211     ;; memory sanitizer argument-passing shadow bytes
 212     msan-param-tls
 213
 214     ;; dynamic runtime linking support
 215     #!+sb-dynamic-core +required-foreign-symbols+
 216
 217     ;; List of Lisp specials bindings made by create_thread_struct()
 218     ;; other than the per-thread-c-interface-symbols.
 219     sb!thread::*thread-initial-bindings*
 220
 221     ;;; The following symbols aren't strictly required to be static
 222     ;;; - they are not accessed from C - but we make them static in order
 223     ;;; to (perhaps) micro-optimize access in Lisp.
 224     ;;; However there is no efficiency gain if we have #!+immobile-space.
 225     #!-immobile-space ,@'(
 226      ;; arbitrary object that changes after each GC
 227      sb!kernel::*gc-epoch*
 228      ;; Dispatch tables for generic array access
 229      sb!impl::%%data-vector-reffers%%
 230      sb!impl::%%data-vector-reffers/check-bounds%%
 231      sb!impl::%%data-vector-setters%%
 232      sb!impl::%%data-vector-setters/check-bounds%%))
 233   #'equalp)
 234
 235 ;;; Number of entries in the thread local storage. Limits the number
 236 ;;; of symbols with thread local bindings.
 237 (defconstant tls-size 4096)
 238 ;;; Refer to the lengthy comment in 'src/runtime/interrupt.h' about
 239 ;;; the choice of this number. Rather than have to two copies
 240 ;;; of the comment, please see that file before adjusting this.
 241 (defconstant max-interrupts 1024)
 242
 243 #!+gencgc
 244 (progn
 245   (defconstant +highest-normal-generation+ 5)
 246   (defconstant +pseudo-static-generation+ 6))
 247
 248 (defun !unintern-symbols ()
 249   '("SB-VM"
 250     +c-callable-fdefns+
 251     +common-static-symbols+))