source: trunk/source/level-1/l1-boot-lds.lisp @ 11887

Last change on this file since 11887 was 10914, checked in by rme, 11 years ago

On Unix systems, if "ccl-init" is not present, try to load ".ccl-init".
No longer try to load (or warn about) openmcl-init. Upate manual
to reflect these changes.

(ticket:337)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 4.4 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
18; l1-boot-lds.lisp
19
20(in-package "CCL")
21
22
23
24
25
26(defun command-line-arguments ()
27  *command-line-argument-list*)
28
29(defun startup-ccl (&optional init-file)
30  (with-simple-restart (abort "Abort startup.")
31    (let ((init-files (if (listp init-file) init-file (list init-file))))
32      (dolist (init-file init-files)
33        (with-simple-restart (continue "Skip loading init file.")
34          (when (load init-file :if-does-not-exist nil :verbose nil)
35            (return)))))
36    (flet ((eval-string (s)
37             (with-simple-restart (continue "Skip evaluation of ~a" s)
38               (eval (read-from-string s))))
39           (load-file (name)
40             (with-simple-restart (continue "Skip loading ~s" name)
41               (load name))))
42      (dolist (p *lisp-startup-parameters*)
43        (let* ((param (cdr p)))
44          (case (car p)
45            (:gc-threshold
46             (multiple-value-bind (n last) (parse-integer param :junk-allowed t)
47               (when n
48                 (if (< last (length param))
49                   (case (schar param last)
50                     ((#\k #\K) (setq n (ash n 10)))
51                     ((#\m #\M) (setq n (ash n 20)))))
52                 (set-lisp-heap-gc-threshold n)
53                 (use-lisp-heap-gc-threshold))))
54            (:eval (eval-string param))
55            (:load (load-file param))))))))
56
57
58(defun listener-function ()
59  (progn
60    (unless (or *inhibit-greeting* *quiet-flag*)
61      (format t "~&Welcome to ~A ~A!~%"
62              (lisp-implementation-type)
63              (lisp-implementation-version)))
64    (toplevel-loop)))
65
66
67(defun make-mcl-listener-process (procname
68                                  input-stream
69                                  output-stream
70                                  cleanup-function
71                                  &key
72                                  (initial-function #'listener-function)
73                                  (close-streams t)
74                                  (class 'process)
75                                  (control-stack-size *default-control-stack-size*)
76                                  (auto-flush t)
77                                  (value-stack-size *default-value-stack-size*)
78                                  (temp-stack-size *default-temp-stack-size*)
79                                  (echoing t)
80                                  (process))
81  (let ((p (if (typep process class)
82             (progn
83               (setf (process-thread process)
84                     (new-thread procname control-stack-size value-stack-size  temp-stack-size))
85               process)
86             (make-process procname
87                           :class class
88                           :stack-size control-stack-size
89                           :vstack-size value-stack-size
90                           :tstack-size temp-stack-size))))
91    (process-preset p #'(lambda ()
92                          (let ((*terminal-io*
93                                 (if echoing
94                                   (make-echoing-two-way-stream
95                                    input-stream output-stream)
96                                   (make-two-way-stream
97                                    input-stream output-stream))))
98                            (unwind-protect
99                                 (progn
100                                   (when auto-flush
101                                     (add-auto-flush-stream output-stream))
102                                   (let* ((shared-input
103                                           (input-stream-shared-resource
104                                            input-stream)))
105                                     (when shared-input
106                                       (setf (shared-resource-primary-owner
107                                              shared-input)
108                                             *current-process*)))
109                                   (application-ui-operation
110                                    *application*
111                                    :note-current-package *package*)
112                                   (funcall initial-function))
113                              (remove-auto-flush-stream output-stream)
114                              (funcall cleanup-function)
115                              (when close-streams
116                                (close input-stream)
117                                (close output-stream))))))
118    (process-enable p)
119    p))
120
121
122; End of l1-boot-lds.lisp
Note: See TracBrowser for help on using the repository browser.