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