src/code/early-impl.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; This software is derived from the CMU CL system, which was
   5 ;;;; written at Carnegie Mellon University and released into the
   6 ;;;; public domain. The software is in the public domain and is
   7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
   8 ;;;; files for more information.
   9
  10 (in-package "SB-IMPL")
  11
  12 ;;; entries in STATIC-SYMBOLS table, references to which can be compiled
  13 ;;; as though they're special variables
  14 ;;;
  15 ;;; FIXME: These should be listed once and only once, instead of
  16 ;;; listed here and then listed separately (and by now, 2001-06-06,
  17 ;;; slightly differently) elsewhere. (Maybe this is resolved?)
  18 (declaim (special *posix-argv*
  19                   *stderr*
  20                   sb-vm:*current-catch-block*
  21                   sb-vm::*current-unwind-protect-block*
  22                   sb-vm::*alien-stack-pointer*
  23                   sb-vm:*control-stack-start*
  24                   sb-vm:*control-stack-end*
  25                   sb-vm:*binding-stack-start*
  26                   *allow-with-interrupts*
  27                   sb-unix::*unblock-deferrables-on-enabling-interrupts-p*
  28                   *interrupts-enabled*
  29                   *interrupt-pending*
  30                   #+sb-safepoint *thruption-pending*
  31                   #+sb-safepoint *in-safepoint*
  32                   *free-interrupt-context-index*
  33                   sb-vm::*binding-stack-pointer*
  34                   sb-pcl::*cache-miss-values-stack*
  35                   sb-pcl::*dfun-miss-gfs-on-stack*))
  36
  37 ;;; This is a slot of 'struct thread' if multithreaded,
  38 ;;; and the symbol-global-value should never be used.
  39 ;;; (And in any case it is not really a special var)
  40 #+(and (or x86 x86-64) (not sb-thread))
  41 (defvar *pseudo-atomic-bits* 0)
  42
  43 #+c-stack-is-control-stack
  44 (setf (info :variable :always-bound 'sb-c:*alien-stack-pointer*) :always-bound)
  45
  46 ;;; A unique GC id. This is supplied for code that needs to detect
  47 ;;; whether a GC has happened since some earlier point in time. For
  48 ;;; example:
  49 ;;;
  50 ;;;   (let ((epoch *gc-epoch*))
  51 ;;;      ...
  52 ;;;      (unless (eql epoch *gc-epoch)
  53 ;;;        ....))
  54 ;;;
  55 ;;; This isn't just a fixnum counter since then we'd have theoretical
  56 ;;; problems when exactly 2^29 GCs happen between epoch
  57 ;;; comparisons. Unlikely, but the cost of using a cons instead is too
  58 ;;; small to measure. -- JES, 2007-09-30
  59 (declaim (type cons sb-kernel::*gc-epoch*))
  60 (define-load-time-global sb-kernel::*gc-epoch* '(nil . nil))
  61
  62 ;;; Stores the code coverage instrumentation results. The CAR is a
  63 ;;; hashtable. The CDR is a list of weak pointers to code objects
  64 ;;; having coverage marks embedded in the unboxed constants. Keys in
  65 ;;; the hashtable are namestrings, the value is a list of (CONS PATH
  66 ;;; VISITED).
  67 (define-load-time-global *code-coverage-info*
  68     (list (make-hash-table :test 'equal :synchronized t)))
  69 (declaim (type (cons hash-table) *code-coverage-info*))
  70
  71 ;;; Default evaluator mode (interpreter / compiler)
  72
  73 (declaim (type (member :compile #+(or sb-eval sb-fasteval) :interpret)
  74                *evaluator-mode*))
  75 (defparameter *evaluator-mode* :compile
  76   "Toggle between different evaluator implementations. If set to :COMPILE,
  77 an implementation of EVAL that calls the compiler will be used. If set
  78 to :INTERPRET, an interpreter will be used.")
  79 (declaim (always-bound *evaluator-mode*))
  80
  81 (declaim (inline sb-vm:is-lisp-pointer))
  82 (defun sb-vm:is-lisp-pointer (addr) ; Same as is_lisp_pointer() in C
  83   #-64-bit (oddp addr)
  84   #+ppc64 (= (logand addr #b101) #b100)
  85   #+(and 64-bit (not ppc64)) (not (logtest (logxor addr 3) 3)))