source: branches/ia32/level-1/l1-boot-2.lisp @ 7427

Last change on this file since 7427 was 7427, checked in by rme, 13 years ago

Conditionalize for x8632 and darwinx8632.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.5 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17;; l1-boot-2.lisp
18;; Second part of l1-boot
19
20(in-package "CCL")
21
22(macrolet ((l1-load (name)
23             (let* ((namestring
24                     (concatenate 'simple-base-string
25                                  "./l1-fasls/"
26                                  (string name)
27                                  (namestring (backend-target-fasl-pathname
28                                               *target-backend*)))))
29       `(let* ((*loading-file-source-file* *loading-file-source-file*))
30                 (%fasload ,namestring))))
31           (bin-load (name)
32             (let* ((namestring
33                     (concatenate 'simple-base-string
34                                  "./bin/"
35                                  (string name)
36                                  (namestring (backend-target-fasl-pathname
37                                               *target-backend*)))))
38               `(let* ((*loading-file-source-file* *loading-file-source-file*))
39                 (%fasload ,namestring)))))
40
41
42(catch :toplevel
43    #+ppc-target
44    (l1-load "ppc-error-signal")
45    #+x86-target
46    (l1-load "x86-error-signal")
47    (l1-load "l1-error-signal")
48    (l1-load "l1-sockets")
49    (setq *LEVEL-1-LOADED* t))
50
51#+ppc-target
52(defun altivec-available-p ()
53  "Return non-NIL if AltiVec is available."
54  (not (eql (%get-kernel-global 'ppc::altivec-present) 0)))
55
56#+ppc-target
57(defloadvar *altivec-available* (altivec-available-p)
58  "This variable is intitialized each time an OpenMCL session starts based
59on information provided by the lisp kernel. Its value is true if AltiVec is
60present and false otherwise. This variable shouldn't be set by user code.")
61
62       
63(defstatic *auto-flush-streams* ())
64(def-ccl-pointers *auto-flush-streams* () (setq *auto-flush-streams* nil))
65(defstatic *auto-flush-streams-lock* (make-lock))
66
67
68(defloadvar *batch-flag* (not (eql (%get-kernel-global 'batch-flag) 0)))
69(defloadvar *quiet-flag* nil)
70(defvar *terminal-input* ())
71(defvar *terminal-output* ())
72(defvar *stdin* ())
73(defvar *stdout* ())
74(defvar *stderr* ())
75
76
77(defun set-basic-stream-prototype (class)
78  (when (subtypep class 'basic-stream)
79    (setf (%class.prototype class) (or (%class.prototype class)
80                                       (allocate-basic-stream class)))
81    (dolist (subclass (class-direct-subclasses class))
82      (set-basic-stream-prototype subclass))))
83
84(set-basic-stream-prototype (find-class 'basic-stream))
85
86
87;;; The hard parts here have to do with setting up *TERMINAL-IO*.
88;;; Note that opening /dev/tty can fail, and that failure would
89;;; be reported as a negative return value from FD-OPEN.
90;;; It's pretty important that nothing signals an error here,
91;;; since there may not be any valid streams to write an error
92;;; message to.
93
94(defloadvar *interactive-streams-initialized* nil)
95
96(defun initialize-interactive-streams ()
97  (let* ((encoding (lookup-character-encoding *terminal-character-encoding-name*))
98         (encoding-name (if encoding (character-encoding-name encoding))))
99    (setq *stdin* (make-fd-stream 0
100                                  :basic t
101                                  :sharing :lock
102                                  :direction :input
103                                  :interactive (not *batch-flag*)
104                                  :encoding encoding-name))
105    (setq *stdout* (make-fd-stream 1 :basic t :direction :output :sharing :lock :encoding encoding-name))
106
107    (setq *stderr* (make-fd-stream 2 :basic t :direction :output :sharing :lock :encoding encoding-name))
108    (if *batch-flag*
109      (let* ((tty-fd (let* ((fd (fd-open "/dev/tty" #$O_RDWR)))
110                       (if (>= fd 0) fd)))
111             (can-use-tty (and tty-fd (eql (tcgetpgrp tty-fd) (getpid)))))
112        (if can-use-tty
113          (setq
114           *terminal-input* (make-fd-stream tty-fd
115                                            :basic t
116                                            :direction :input
117                                            :interactive t
118                                            :sharing :lock
119                                            :encoding encoding-name)
120           *terminal-output* (make-fd-stream tty-fd :basic t :direction :output :sharing :lock :encoding encoding-name)
121           *terminal-io* (make-echoing-two-way-stream
122                          *terminal-input* *terminal-output*))
123          (progn
124            (when tty-fd (fd-close tty-fd))
125            (setq *terminal-input* *stdin*
126                  *terminal-output* *stdout*
127                  *terminal-io* (make-two-way-stream
128                                 *terminal-input* *terminal-output*))))
129        (setq *standard-input* *stdin*
130              *standard-output* *stdout*))
131      (progn
132        (setq *terminal-input* *stdin*
133              *terminal-output* *stdout*
134              *terminal-io* (make-echoing-two-way-stream
135                             *terminal-input* *terminal-output*))
136        (setq *standard-input* (make-synonym-stream '*terminal-io*)
137              *standard-output* (make-synonym-stream '*terminal-io*))))
138    (setq *error-output* (if *batch-flag*
139                           (make-synonym-stream '*stderr*)
140                           (make-synonym-stream '*terminal-io*)))
141    (setq *query-io* (make-synonym-stream '*terminal-io*))
142    (setq *debug-io* *query-io*)
143    (setq *trace-output* *standard-output*)
144    (push *stdout* *auto-flush-streams*)
145    (setf (input-stream-shared-resource *terminal-input*)
146          (make-shared-resource "Shared Terminal Input")))
147  (setq *interactive-streams-initialized* t))
148
149(initialize-interactive-streams)
150
151(def-standard-initial-binding *standard-input*)
152(def-standard-initial-binding *standard-output*)
153(def-standard-initial-binding *error-output*)
154(def-standard-initial-binding *trace-output*)
155(def-standard-initial-binding *debug-io*)
156(def-standard-initial-binding *query-io*)
157
158
159
160
161(catch :toplevel
162    (macrolet ((l1-load-provide (module path)
163                 `(let* ((*package* *package*))
164                   (l1-load ,path)
165                   (provide ,module)))
166               (bin-load-provide (module path)
167                 `(let* ((*package* *package*))
168                   (bin-load ,path)
169                   (provide ,module))))
170      (bin-load-provide "SORT" "sort")
171      (bin-load-provide "NUMBERS" "numbers")
172     
173      (bin-load-provide "SUBPRIMS" "subprims")
174      #+ppc32-target
175      (bin-load-provide "PPC32-ARCH" "ppc32-arch") 
176      #+ppc64-target
177      (bin-load-provide "PPC64-ARCH" "ppc64-arch")
178      #+x8632-target
179      (bin-load-provide "X8632-ARCH" "x8632-arch")
180      #+x8664-target
181      (bin-load-provide "X8664-ARCH" "x8664-arch")
182      (bin-load-provide "VREG" "vreg")
183     
184      #+ppc-target
185      (bin-load-provide "PPC-ASM" "ppc-asm")
186     
187      (bin-load-provide "VINSN" "vinsn")
188      (bin-load-provide "REG" "reg")
189     
190      #+ppc-target
191      (bin-load-provide "PPC-LAP" "ppc-lap")
192      (bin-load-provide "BACKEND" "backend")
193     
194      #+ppc-target
195      (provide "PPC2")                  ; Lie, load the module manually
196
197      #+x86-target
198      (provide "X862")
199     
200      (l1-load-provide "NX" "nx")
201     
202      #+ppc-target
203      (bin-load "ppc2")
204
205      #+x86-target
206      (bin-load "x862")
207     
208      (bin-load-provide "LEVEL-2" "level-2")
209      (bin-load-provide "MACROS" "macros")
210      (bin-load-provide "SETF" "setf")
211      (bin-load-provide "SETF-RUNTIME" "setf-runtime")
212      (bin-load-provide "FORMAT" "format")
213      (bin-load-provide "STREAMS" "streams")
214      (bin-load-provide "OPTIMIZERS" "optimizers")     
215      (bin-load-provide "DEFSTRUCT-MACROS" "defstruct-macros")
216      (bin-load-provide "DEFSTRUCT-LDS" "defstruct-lds")
217      (bin-load-provide "NFCOMP" "nfcomp")
218      (bin-load-provide "BACKQUOTE" "backquote")
219      (bin-load-provide "BACKTRACE-LDS" "backtrace-lds")
220      (bin-load-provide "BACKTRACE" "backtrace")
221      (bin-load-provide "READ" "read")
222      (bin-load-provide "ARRAYS-FRY" "arrays-fry")
223      (bin-load-provide "APROPOS" "apropos")
224     
225      #+ppc-target
226      (progn
227        (bin-load-provide "PPC-DISASSEMBLE" "ppc-disassemble")
228        (bin-load-provide "PPC-LAPMACROS" "ppc-lapmacros"))
229
230      #+x86-target
231      (progn
232        (bin-load-provide "X86-DISASSEMBLE" "x86-disassemble")
233        (bin-load-provide "X86-LAPMACROS" "x86-lapmacros"))
234     
235
236      (bin-load-provide "FOREIGN-TYPES" "foreign-types")
237      (install-standard-foreign-types *host-ftd*)
238     
239      #+(and ppc32-target linux-target)
240      (bin-load-provide "FFI-LINUXPPC32" "ffi-linuxppc32")
241      #+(and ppc32-target darwin-target)
242      (bin-load-provide "FFI-DARWINPPC32" "ffi-darwinppc32")
243      #+(and ppc64-target darwin-target)
244      (bin-load-provide "FFI-DARWINPPC64" "ffi-darwinppc64")
245      #+(and ppc64-target linux-target)
246      (bin-load-provide "FFI-LINUXPPC64" "ffi-linuxppc64")
247      #+(and x8632-target darwin-target)
248      (bin-load-provide "FFI-DARWINX8632" "ffi-darwinx8632")
249      #+(and x8664-target linux-target) 
250      (bin-load-provide "FFI-LINUXX8664" "ffi-linuxx8664")
251      #+(and x8664-target darwin-target) 
252      (bin-load-provide "FFI-DARWINX8664" "ffi-darwinx8664")
253      #+(and x8664-target freebsd-target) 
254      (bin-load-provide "FFI-FREEBSDX8664" "ffi-freebsdx8664")
255     
256      (bin-load-provide "DB-IO" "db-io")
257
258      (canonicalize-foreign-type-ordinals *host-ftd*)
259     
260      (bin-load-provide "CASE-ERROR" "case-error")
261      (bin-load-provide "ENCAPSULATE" "encapsulate")
262      (bin-load-provide "METHOD-COMBINATION" "method-combination")
263      (bin-load-provide "MISC" "misc")
264      (bin-load-provide "PPRINT" "pprint")
265      (bin-load-provide "DUMPLISP" "dumplisp")
266      (bin-load-provide "PATHNAMES" "pathnames")
267      (bin-load-provide "TIME" "time")
268      (bin-load-provide "COMPILE-CCL" "compile-ccl")
269      (bin-load-provide "ARGLIST" "arglist")
270      (bin-load-provide "EDIT-CALLERS" "edit-callers")
271      (bin-load-provide "DESCRIBE" "describe")
272      (bin-load-provide "SOURCE-FILES" "source-files")
273      (bin-load-provide "MCL-COMPAT" "mcl-compat")
274      (require "LOOP")
275      (require "HASH-CONS")
276      (bin-load-provide "CCL-EXPORT-SYMS" "ccl-export-syms")
277      (l1-load-provide "VERSION" "version")
278      (require "LISPEQU") ; Shouldn't need this at load time ...
279      )
280    (setq *%fasload-verbose* nil)
281    )
282)
283
284
285
286
287
288
Note: See TracBrowser for help on using the repository browser.