src/code/cross-misc.lisp

   1 ;;;; cross-compile-time-only replacements for miscellaneous unportable
   2 ;;;; stuff
   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!IMPL")
  14
  15 ;;; In correct code, TRULY-THE has only a performance impact and can
  16 ;;; be safely degraded to ordinary THE.
  17 (defmacro truly-the (type expr)
  18   `(the ,type ,expr))
  19
  20 ;;; MAYBE-INLINE and FREEZE-TYPE declarations can be safely ignored
  21 ;;; (possibly at some cost in efficiency).
  22 (declaim (declaration freeze-type maybe-inline))
  23
  24 ;;; INHIBIT-WARNINGS declarations can be safely ignored (although we
  25 ;;; may then have to wade through some irrelevant warnings).
  26 (declaim (declaration inhibit-warnings))
  27
  28 ;;; Interrupt control isn't an issue in the cross-compiler: we don't
  29 ;;; use address-dependent (and thus GC-dependent) hashes, and we only
  30 ;;; have a single thread of control.
  31 (defmacro without-interrupts (&rest forms)
  32   `(progn ,@forms))
  33
  34 ;;; When we're running as a cross-compiler in an arbitrary host ANSI
  35 ;;; Lisp, we don't have any hooks available to manipulate the
  36 ;;; debugging name and debugging argument list of an interpreted
  37 ;;; function object (and don't care much about getting debugging name
  38 ;;; and debugging argument list right anyway).
  39 (defun try-to-rename-interpreted-function-as-macro (f name lambda-list)
  40   (declare (ignore f name lambda-list))
  41   (values))
  42
  43 ;;; When we're running as a cross-compiler in an arbitrary host ANSI
  44 ;;; Lisp, we shouldn't be doing anything which is sensitive to GC.
  45 ;;; KLUDGE: I (WHN 19990131) think the proper long-term solution would
  46 ;;; be to remove any operations from cross-compiler source files
  47 ;;; (putting them in target-only source files) if they refer to these
  48 ;;; hooks. This is a short-term hack.
  49 (defvar *before-gc-hooks* nil)
  50 (defvar *after-gc-hooks* nil)
  51
  52 ;;; The GENESIS function works with fasl code which would, in the
  53 ;;; target SBCL, work on LISP-STREAMs. A true LISP-STREAM doesn't seem
  54 ;;; to be a meaningful concept in ANSI Common Lisp, but we can fake it
  55 ;;; acceptably well using a standard STREAM.
  56 (deftype lisp-stream () 'stream)
  57
  58 ;;; In the target SBCL, the INSTANCE type refers to a base
  59 ;;; implementation for compound types. There's no way to express
  60 ;;; exactly that concept portably, but we can get essentially the same
  61 ;;; effect by testing for any of the standard types which would, in
  62 ;;; the target SBCL, be derived from INSTANCE:
  63 (deftype sb!kernel:instance ()
  64   '(or condition standard-object structure-object))
  65
  66 ;;; There aren't any FUNCALLABLE-INSTANCEs in the cross-compilation
  67 ;;; host Common Lisp.
  68 (defun funcallable-instance-p (x)
  69   (if (typep x 'generic-function)
  70     ;; In the target SBCL, FUNCALLABLE-INSTANCEs are used to implement
  71     ;; generic functions, so any case which tests for this might in
  72     ;; fact be trying to test for generic functions. My (WHN 19990313)
  73     ;; expectation is that this case won't arise in the
  74     ;; cross-compiler, but if it does, it deserves a little thought,
  75     ;; rather than reflexively returning NIL.
  76     (error "not clear how to handle GENERIC-FUNCTION")
  77     nil))
  78
  79 ;;; This seems to be the portable Common Lisp type test which
  80 ;;; corresponds to the effect of the target SBCL implementation test..
  81 (defun sb!kernel:array-header-p (x)
  82   (and (typep x 'simple-array)
  83        (= 1 (array-rank x))))
  84
  85 ;;; Genesis needs these at cross-compile time. The target
  86 ;;; implementation of these is reasonably efficient by virtue of its
  87 ;;; ability to peek into the internals of the package implementation;
  88 ;;; this reimplementation is portable but slow.
  89 (defun package-internal-symbol-count (package)
  90   (let ((result 0))
  91     (declare (type fixnum result))
  92     (do-symbols (i package)
  93       ;; KLUDGE: The ANSI Common Lisp specification warns that
  94       ;; DO-SYMBOLS may execute its body more than once for symbols
  95       ;; that are inherited from multiple packages, and we currently
  96       ;; make no attempt to correct for that here. (The current uses
  97       ;; of this function at cross-compile time don't really care if
  98       ;; the count is a little too high.) -- WHN 19990826
  99       (multiple-value-bind (symbol status)
 100           (find-symbol (symbol-name i) package)
 101         (declare (ignore symbol))
 102         (when (member status '(:internal :inherited))
 103           (incf result))))
 104     result))
 105 (defun package-external-symbol-count (package)
 106   (let ((result 0))
 107     (declare (type fixnum result))
 108     (do-external-symbols (i package)
 109       (declare (ignore i))
 110       (incf result))
 111     result))
 112
 113 ;;; In the target Lisp, INTERN* is the primitive and INTERN is
 114 ;;; implemented in terms of it. This increases efficiency by letting
 115 ;;; us reuse a fixed-size buffer; the alternative would be
 116 ;;; particularly painful because we don't implement DYNAMIC-EXTENT. In
 117 ;;; the host Lisp, this is only used at cold load time, and we don't
 118 ;;; care as much about efficiency, so it's fine to treat the host
 119 ;;; Lisp's INTERN as primitive and implement INTERN* in terms of it.
 120 (defun intern* (nameoid length package)
 121   (intern (replace (make-string length) nameoid :end2 length) package))
 122
 123 ;;; In the target Lisp this is implemented by reading a fixed slot in
 124 ;;; the symbol. In portable ANSI Common Lisp the same criteria can be
 125 ;;; met (more slowly, and with the extra property of repeatability
 126 ;;; between runs) by just calling SXHASH.
 127 (defun symbol-hash (symbol)
 128   (declare (type symbol symbol))
 129   (sxhash symbol))