1 ;;;; cross-compile-time-only replacements for miscellaneous unportable
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.
13 (in-package "SB!IMPL")
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)
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))
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))
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)
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
42 (defun try-to-rename-interpreted-function-as-macro (f name lambda-list)
43 (declare (ignore f name lambda-list))
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)
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
58 (deftype lisp-stream () 'stream)
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
65 (deftype sb!kernel:instance ()
66 '(or condition standard-object structure-object))
68 ;;; There aren't any FUNCALLABLE-INSTANCEs in the cross-compilation
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")
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))))
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
90 (defun package-internal-symbol-count (package)
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))
105 (defun package-external-symbol-count (package)
107 (declare (type fixnum result))
108 (do-external-symbols (i package)
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
120 (defun intern* (nameoid length package)
121 (intern (replace (make-string length) nameoid :end2 length) package))
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
127 (defun symbol-hash (symbol)
128 (declare (type symbol symbol))