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