1 ;;;; patches to work around 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 (ext:without-package-lock ("SYSTEM")
17 (setf system::*inhibit-floating-point-underflow* t))
21 ;;; CMU CL, at least as of 18b, doesn't support PRINT-OBJECT. In
22 ;;; particular, it refuses to compile :PRINT-OBJECT options to
23 ;;; DEFSTRUCT, so we need to conditionalize such options on the
24 ;;; :NO-ANSI-PRINT-OBJECT feature in order to get the code to compile.
25 ;;; (It also fails to do anything useful with DEFMETHOD PRINT-OBJECT,
26 ;;; but that doesn't matter much, since it doesn't stop the
27 ;;; cross-compiler from working.)
30 (warn "CMU CL doesn't support the :PRINT-OBJECT option to DEFSTRUCT.~%")
31 (pushnew :no-ansi-print-object *features*))
33 ;;; KLUDGE: In CMU CL, at least as of 18b, READ-SEQUENCE is somewhat
34 ;;; dain-bramaged. Running
35 ;;; (defvar *buffer* (make-array (expt 10 6) :element-type 'character))
36 ;;; (with-open-file (s "/tmp/long-file.tmp")
37 ;;; (/show (read-sequence *buffer* s :start 0 :end 3000))
38 ;;; (/show (read-sequence *buffer* s :start 0 :end 15000))
39 ;;; (/show (read-sequence *buffer* s :start 0 :end 15000)))
40 ;;; on a large test file gives
41 ;;; /(READ-SEQUENCE *BUFFER* S :START 0 :END 3000)=3000
42 ;;; /(READ-SEQUENCE *BUFFER* S :START 0 :END 15000)=1096
43 ;;; /(READ-SEQUENCE *BUFFER* S :START 0 :END 15000)=0
46 (warn "CMU CL has a broken implementation of READ-SEQUENCE.")
47 (pushnew :no-ansi-read-sequence *features*))
50 (unless (ignore-errors (read-from-string "1.0l0"))
51 (error "CMUCL on Alpha can't read floats in the format \"1.0l0\". Patch your core file~%~%"))
54 (ext:set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero))
58 (unless (ignore-errors (funcall (constantly t) 1 2 3))
59 (error "please find a binary that understands CONSTANTLY to build from"))
62 ;;;; general non-ANSI-ness
66 (defmacro munging-cl-package (&body body)
67 #-clisp `(progn ,@body)
68 #+clisp `(ext:without-package-lock ("CL")
71 ;;; Do the exports of COMMON-LISP conform to the standard? If not, try
72 ;;; to make them conform. (Of course, ANSI says that bashing symbols
73 ;;; in the COMMON-LISP package like this is undefined, but then if the
74 ;;; host Common Lisp were ANSI, we wouldn't be doing this, now would
75 ;;; we? "One dirty unportable hack deserves another.":-)
76 (let ((standard-ht (make-hash-table :test 'equal))
77 (host-ht (make-hash-table :test 'equal))
78 (cl (find-package "COMMON-LISP")))
79 (do-external-symbols (i cl)
80 (setf (gethash (symbol-name i) host-ht) t))
81 (dolist (i (read-from-file "common-lisp-exports.lisp-expr"))
82 (setf (gethash i standard-ht) t))
83 (maphash (lambda (key value)
84 (declare (ignore value))
85 (unless (gethash key standard-ht)
86 (warn "removing non-ANSI export from package CL: ~S" key)
88 (unexport (intern key cl) cl))))
90 (maphash (lambda (key value)
91 (declare (ignore value))
92 (unless (gethash key host-ht)
93 (warn "adding required-by-ANSI export to package CL: ~S" key)
95 (export (intern key cl) cl)))
97 ;; FIXME: My righteous indignation below was misplaced. ANSI sez
98 ;; (in 11.1.2.1, "The COMMON-LISP Package") that it's OK for
99 ;; COMMON-LISP things to have their home packages elsewhere.
100 ;; For now, the hack below works, but it's not good to rely
101 ;; on this nonstandardness. Ergo, I should fix things so that even
102 ;; when the cross-compilation host COMMON-LISP package has
103 ;; symbols with home packages elsewhere, genesis dumps out
104 ;; the correct stuff. (For each symbol dumped, check whether it's
105 ;; exported from COMMON-LISP, and if so, dump it as though its
106 ;; home package is COMMON-LISP regardless of whether it actually
109 ;; X CMU CL, at least the Debian versions ca. 2.4.9 that I'm
110 ;; X using as I write this, plays a sneaky trick on us by
111 ;; X putting DEBUG and FLOATING-POINT-INEXACT in the
112 ;; X EXTENSIONS package, then IMPORTing them into
113 ;; X COMMON-LISP, then reEXPORTing them from COMMON-LISP.
114 ;; X This leaves their home packages bogusly set to
115 ;; X EXTENSIONS, which confuses genesis into thinking that
116 ;; X the CMU CL EXTENSIONS package has to be dumped into the
117 ;; X target SBCL. (perhaps a last-ditch survival strategy
118 ;; X for the CMU CL "nooo! don't bootstrap from scratch!"
119 ;; X meme?) As far as I can see, there's no even slightly
120 ;; X portable way to undo the damage, so we'll play the "one
121 ;; X dirty unportable hack deserves another" game, only even
122 ;; X dirtierly and more unportably than before..
124 (let ((symbol (intern key cl)))
125 (unless (eq (symbol-package symbol) cl)
126 (warn "using low-level hack to move ~S from ~S to ~S"
128 (symbol-package symbol)
130 (kernel:%set-symbol-package symbol cl))))