... |
... |
@@ -164,20 +164,48 @@ |
164
|
164
|
*default-external-format*))))
|
165
|
165
|
(values))
|
166
|
166
|
|
167
|
|
-
|
|
167
|
+(defun decode-runtime-strings (locale file-locale)
|
|
168
|
+ ;; The C runtime can initialize the following strings from the
|
|
169
|
+ ;; command line or the environment. We need to decode these into
|
|
170
|
+ ;; the utf-16 strings that Lisp uses.
|
|
171
|
+ (setf lisp-command-line-list
|
|
172
|
+ (mapcar #'(lambda (s)
|
|
173
|
+ (stream:string-decode s locale))
|
|
174
|
+ lisp-command-line-list))
|
|
175
|
+ (setf lisp-environment-list
|
|
176
|
+ (mapcar #'(lambda (s)
|
|
177
|
+ (stream:string-decode s locale))
|
|
178
|
+ lisp-environment-list))
|
|
179
|
+ ;; This needs more work.. *cmucl-lib* could be set from the the envvar
|
|
180
|
+ ;; "CMUCLLIB" or from the "-lib" command-line option, and thus
|
|
181
|
+ ;; should use the LOCALE to decode the string.
|
|
182
|
+ (when *cmucl-lib*
|
|
183
|
+ (setf *cmucl-lib*
|
|
184
|
+ (stream:string-decode *cmucl-lib* file-locale)))
|
|
185
|
+ ;; This also needs more work since the core path could come from the
|
|
186
|
+ ;; "-core" command-line option and should thus use LOCALE to decode
|
|
187
|
+ ;; the string. It could also come from the "CMUCLCORE" envvar.
|
|
188
|
+ (setf *cmucl-core-path*
|
|
189
|
+ (stream:string-decode *cmucl-core-path* file-locale))
|
|
190
|
+ ;; *unidata-path* defaults to a pathname object, but the user can
|
|
191
|
+ ;; specify a path, so we need to decode the string path if given.
|
|
192
|
+ (when (and *unidata-path* (stringp *unidata-path*))
|
|
193
|
+ (setf *unidata-path*
|
|
194
|
+ (stream:string-decode *unidata-path* file-locale))))
|
|
195
|
+
|
168
|
196
|
(defun save-lisp (core-file-name &key
|
169
|
|
- (purify t)
|
170
|
|
- (root-structures ())
|
171
|
|
- (environment-name "Auxiliary")
|
172
|
|
- (init-function #'%top-level)
|
173
|
|
- (load-init-file t)
|
174
|
|
- (site-init "library:site-init")
|
175
|
|
- (print-herald t)
|
176
|
|
- (process-command-line t)
|
177
|
|
- #+:executable
|
178
|
|
- (executable nil)
|
179
|
|
- (batch-mode nil)
|
180
|
|
- (quiet nil))
|
|
197
|
+ (purify t)
|
|
198
|
+ (root-structures ())
|
|
199
|
+ (environment-name "Auxiliary")
|
|
200
|
+ (init-function #'%top-level)
|
|
201
|
+ (load-init-file t)
|
|
202
|
+ (site-init "library:site-init")
|
|
203
|
+ (print-herald t)
|
|
204
|
+ (process-command-line t)
|
|
205
|
+ #+:executable
|
|
206
|
+ (executable nil)
|
|
207
|
+ (batch-mode nil)
|
|
208
|
+ (quiet nil))
|
181
|
209
|
"Saves a CMU Common Lisp core image in the file of the specified name. The
|
182
|
210
|
following keywords are defined:
|
183
|
211
|
|
... |
... |
@@ -278,13 +306,18 @@ |
278
|
306
|
;; Load external format aliases now so we can aliases to
|
279
|
307
|
;; specify the external format.
|
280
|
308
|
(stream::load-external-format-aliases)
|
281
|
|
- ;; Set the locale for lisp
|
282
|
|
- (intl::setlocale)
|
283
|
309
|
;; Set up :locale format
|
284
|
310
|
(set-up-locale-external-format)
|
285
|
311
|
;; Set terminal encodings to :locale and filename encoding to :utf-8.
|
286
|
312
|
;; (This needs more work on Darwin.)
|
287
|
313
|
(set-system-external-format :locale :utf-8)
|
|
314
|
+ (decode-runtime-strings :locale :utf-8)
|
|
315
|
+ ;; Need to reinitialize the environment again because
|
|
316
|
+ ;; we've possibly changed the environment variables and
|
|
317
|
+ ;; pathnames.
|
|
318
|
+ (environment-init)
|
|
319
|
+ ;; Set the locale for lisp
|
|
320
|
+ (intl::setlocale)
|
288
|
321
|
(ext::process-command-strings process-command-line)
|
289
|
322
|
(setf *editor-lisp-p* nil)
|
290
|
323
|
(macrolet ((find-switch (name)
|
... |
... |
@@ -340,14 +373,14 @@ |
340
|
373
|
(unix:unix-exit
|
341
|
374
|
(catch '%end-of-the-world
|
342
|
375
|
(unwind-protect
|
343
|
|
- (if *batch-mode*
|
344
|
|
- (handler-case
|
345
|
|
- (%restart-lisp)
|
346
|
|
- (error (cond)
|
347
|
|
- (format *error-output* (intl:gettext "Error in batch processing:~%~A~%")
|
348
|
|
- cond)
|
349
|
|
- (throw '%end-of-the-world 1)))
|
350
|
|
- (%restart-lisp))
|
|
376
|
+ (if *batch-mode*
|
|
377
|
+ (handler-case
|
|
378
|
+ (%restart-lisp)
|
|
379
|
+ (error (cond)
|
|
380
|
+ (format *error-output* (intl:gettext "Error in batch processing:~%~A~%")
|
|
381
|
+ cond)
|
|
382
|
+ (throw '%end-of-the-world 1)))
|
|
383
|
+ (%restart-lisp))
|
351
|
384
|
(finish-standard-output-streams))))))
|
352
|
385
|
|
353
|
386
|
;; Record dump time and host
|
... |
... |
@@ -357,7 +390,7 @@ |
357
|
390
|
(let ((initial-function (get-lisp-obj-address #'restart-lisp))
|
358
|
391
|
(core-name (unix-namestring core-file-name nil)))
|
359
|
392
|
(without-gcing
|
360
|
|
- #+:executable
|
|
393
|
+ #+:executable
|
361
|
394
|
(if executable
|
362
|
395
|
(save-executable core-name initial-function)
|
363
|
396
|
(save core-name initial-function #+sse2 1 #-sse2 0))
|