1 ;;;; patches to hide some implementation idiosyncrasies in our
2 ;;;; cross-compilation host
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.
16 (in-package "COMMON-LISP")
18 ;; no longer needed in CLISP 1999-01-08, hurrah!
20 ;; ANSI specifies that package LISP defines the type BOOLEAN, and the CMU CL
21 ;; compiler uses it a lot. This should be trivial to patch in CLISP, except
22 ;; that CLISP defines FFI:BOOLEAN, which conflicts. Gads.. Here we try to fix
23 ;; it with some package hacking. (Please do not take this as an example of
24 ;; good package hacking, I just messed with it until it seemed to work well
25 ;; enough to bootstrap CMU CL, because I'm highly unmotivated to make elegant
26 ;; fixes for nonstandard behavior. -- WHN)
27 (shadow 'ffi:boolean "FFI")
28 (deftype cl::boolean () '(member t nil))
29 (export 'boolean "LISP")
32 ;; I gave up on using CLISP-1999-01-08 as a cross-compilation host because of
33 ;; problems that I don't have workarounds for:
34 (error "can't use CLISP -- no MAKE-LOAD-FORM")
35 (error "can't use CLISP -- no (FUNCTION (SETF SYMBOL-FUNCTION))")
38 ;;; CMU CL, at least as of 18b, doesn't support PRINT-OBJECT. In particular, it
39 ;;; refuses to compile :PRINT-OBJECT options to DEFSTRUCT, so we need to
40 ;;; conditionalize such options on the :NO-ANSI-PRINT-OBJECT feature in order
41 ;;; to get the code to compile. (It also fails to do anything useful with
42 ;;; DEFMETHOD PRINT-OBJECT, but that doesn't matter much, since it doesn't stop
43 ;;; the cross-compiler from working.)
45 ;;; FIXME: SBCL 0.5.0 doesn't support PRINT-OBJECT either. SBCL 0.6.0 will,
46 ;;; at which time this conditional should go away.
49 (warn "CMU CL doesn't support the :PRINT-OBJECT option to DEFSTRUCT.~%")
50 (pushnew :no-ansi-print-object *features*))
52 ;;; KLUDGE: In CMU CL, at least as of 18b, READ-SEQUENCE is somewhat
53 ;;; dain-bramaged. Running
54 ;;; (defvar *buffer* (make-array (expt 10 6) :element-type 'character))
55 ;;; (with-open-file (s "/tmp/long-file.tmp")
56 ;;; (/show (read-sequence *buffer* s :start 0 :end 3000))
57 ;;; (/show (read-sequence *buffer* s :start 0 :end 15000))
58 ;;; (/show (read-sequence *buffer* s :start 0 :end 15000)))
59 ;;; on a large test file gives
60 ;;; /(READ-SEQUENCE *BUFFER* S :START 0 :END 3000)=3000
61 ;;; /(READ-SEQUENCE *BUFFER* S :START 0 :END 15000)=1096
62 ;;; /(READ-SEQUENCE *BUFFER* S :START 0 :END 15000)=0
63 #+cmu ; FIXME: Remove SBCL once we've patched READ-SEQUENCE.
65 (warn "CMU CL has a broken implementation of READ-SEQUENCE.")
66 (pushnew :no-ansi-read-sequence *features*))
68 ;;; Do the exports of COMMON-LISP conform to the standard? If not, try to make
69 ;;; them conform. (Of course, ANSI says that bashing symbols in the COMMON-LISP
70 ;;; package like this is undefined, but then if the host Common Lisp were ANSI,
71 ;;; we wouldn't be doing this, now would we? "One dirty unportable hack
72 ;;; deserves another.":-)
73 (let ((standard-ht (make-hash-table :test 'equal))
74 (host-ht (make-hash-table :test 'equal))
75 (cl (find-package "COMMON-LISP")))
76 (do-external-symbols (i cl)
77 (setf (gethash (symbol-name i) host-ht) t))
78 (dolist (i (read-from-file "common-lisp-exports.lisp-expr"))
79 (setf (gethash i standard-ht) t))
80 (maphash (lambda (key value)
81 (declare (ignore value))
82 (unless (gethash key standard-ht)
83 (warn "removing non-ANSI export from package CL: ~S" key)
84 (unexport (intern key cl) cl)))
86 (maphash (lambda (key value)
87 (declare (ignore value))
88 (unless (gethash key host-ht)
89 (warn "adding required-by-ANSI export to package CL: ~S" key)
90 (export (intern key cl) cl))
91 ;; FIXME: My righteous indignation below was misplaced. ANSI sez
92 ;; (in 11.1.2.1, "The COMMON-LISP Package") that it's OK for
93 ;; COMMON-LISP things to have their home packages elsewhere.
94 ;; For now, the hack below works, but it's not good to rely
95 ;; on this nonstandardness. Ergo, I should fix things so that even
96 ;; when the cross-compilation host COMMON-LISP package has
97 ;; symbols with home packages elsewhere, genesis dumps out
98 ;; the correct stuff. (For each symbol dumped, check whether it's
99 ;; exported from COMMON-LISP, and if so, dump it as though its
100 ;; home package is COMMON-LISP regardless of whether it actually
103 ;; X CMU CL, at least the Debian versions ca. 2.4.9 that I'm
104 ;; X using as I write this, plays a sneaky trick on us by
105 ;; X putting DEBUG and FLOATING-POINT-INEXACT in the
106 ;; X EXTENSIONS package, then IMPORTing them into
107 ;; X COMMON-LISP, then reEXPORTing them from COMMON-LISP.
108 ;; X This leaves their home packages bogusly set to
109 ;; X EXTENSIONS, which confuses genesis into thinking that
110 ;; X the CMU CL EXTENSIONS package has to be dumped into the
111 ;; X target SBCL. (perhaps a last-ditch survival strategy
112 ;; X for the CMU CL "nooo! don't bootstrap from scratch!"
113 ;; X meme?) As far as I can see, there's no even slightly
114 ;; X portable way to undo the damage, so we'll play the "one
115 ;; X dirty unportable hack deserves another" game, only even
116 ;; X dirtierly and more unportably than before..
118 (let ((symbol (intern key cl)))
119 (unless (eq (symbol-package symbol) cl)
120 (warn "using low-level hack to move ~S from ~S to ~S"
122 (symbol-package symbol)
124 (kernel:%set-symbol-package symbol cl))))
128 (unless (ignore-errors (read-from-string "1.0l0"))
129 (error "CMUCL on Alpha can't read floats in the format \"1.0l0\". Patch your core file~%~%"))