image.lisp 22.3 KB
Newer Older
1
2
3
;;;; -------------------------------------------------------------------------
;;;; Starting, Stopping, Dumping a Lisp image

4
5
(uiop/package:define-package :uiop/image
  (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os)
6
  (:export
7
   #:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments*
8
   #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments #:argv0
9
   #:*lisp-interaction*
10
11
   #:fatal-condition #:fatal-condition-p
   #:handle-fatal-condition
12
13
14
   #:call-with-fatal-condition-handler #:with-fatal-condition-handler
   #:*image-restore-hook* #:*image-prelude* #:*image-entry-point*
   #:*image-postlude* #:*image-dump-hook*
15
   #:quit #:die #:raw-print-backtrace #:print-backtrace #:print-condition-backtrace
16
17
18
   #:shell-boolean-exit
   #:register-image-restore-hook #:register-image-dump-hook
   #:call-image-restore-hook #:call-image-dump-hook
19
   #:restore-image #:dump-image #:create-image
20
))
21
(in-package :uiop/image)
22

23
24
25
(with-upgradability ()
  (defvar *lisp-interaction* t
    "Is this an interactive Lisp environment, or is it batch processing?")
26

27
28
  (defvar *command-line-arguments* nil
    "Command-line arguments")
29

30
31
  (defvar *image-dumped-p* nil ; may matter as to how to get to command-line-arguments
    "Is this a dumped image? As a standalone executable?")
32

33
34
  (defvar *image-restore-hook* nil
    "Functions to call (in reverse order) when the image is restored")
35

36
37
38
  (defvar *image-restored-p* nil
    "Has the image been restored? A boolean, or :in-progress while restoring, :in-regress while dumping")

39
40
  (defvar *image-prelude* nil
    "a form to evaluate, or string containing forms to read and evaluate
41
42
when the image is restarted, but before the entry point is called.")

43
44
  (defvar *image-entry-point* nil
    "a function with which to restart the dumped image when execution is restored from it.")
45

46
47
  (defvar *image-postlude* nil
    "a form to evaluate, or string containing forms to read and evaluate
48
before the image dump hooks are called and before the image is dumped.")
49

50
  (defvar *image-dump-hook* nil
Robert Goldman's avatar
Robert Goldman committed
51
    "Functions to call (in order) when before an image is dumped"))
52

Robert Goldman's avatar
Robert Goldman committed
53
(eval-when (#-lispworks :compile-toplevel :load-toplevel :execute)
54
  (deftype fatal-condition ()
55
    `(and serious-condition #+clozure (not ccl:process-reset))))
56
57

;;; Exiting properly or im-
58
59
60
(with-upgradability ()
  (defun quit (&optional (code 0) (finish-output t))
    "Quits from the Lisp world, with the given exit status if provided.
61
This is designed to abstract away the implementation specific quit forms."
62
63
64
65
    (when finish-output ;; essential, for ClozureCL, and for standard compliance.
      (finish-outputs))
    #+(or abcl xcl) (ext:quit :status code)
    #+allegro (excl:exit code :quiet t)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
66
    #+(or clasp ecl) (si:quit code)
67
68
69
    #+clisp (ext:quit code)
    #+clozure (ccl:quit code)
    #+cormanlisp (win32:exitprocess code)
70
    #+(or cmucl scl) (unix:unix-exit code)
71
    #+gcl (system:quit code)
72
    #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code)
73
    #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
74
    #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
75
76
77
78
79
80
    #+mkcl (mk-ext:quit :exit-code code)
    #+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil))
                   (quit (find-symbol* :quit :sb-ext nil)))
               (cond
                 (exit `(,exit :code code :abort (not finish-output)))
                 (quit `(,quit :unix-status code :recklessly-p (not finish-output)))))
81
    #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
82
    (not-implemented-error 'quit "(called with exit code ~S)" code))
83
84
85
86
87

  (defun die (code format &rest arguments)
    "Die in error with some error message"
    (with-safe-io-syntax ()
      (ignore-errors
88
       (format! *stderr* "~&~?~&" format arguments)))
89
90
    (quit code))

91
  (defun raw-print-backtrace (&key (stream *debug-io*) count condition)
92
    "Print a backtrace, directly accessing the implementation"
93
94
    (declare (ignorable stream count condition))
    #+abcl
95
    (loop :for i :from 0
96
97
          :for frame :in (sys:backtrace (or count most-positive-fixnum)) :do
            (safe-format! stream "~&~D: ~A~%" i frame))
98
99
100
101
102
103
104
105
    #+allegro
    (let ((*terminal-io* stream)
          (*standard-output* stream)
          (tpl:*zoom-print-circle* *print-circle*)
          (tpl:*zoom-print-level* *print-level*)
          (tpl:*zoom-print-length* *print-length*))
      (tpl:do-command "zoom"
        :from-read-eval-print-loop nil
106
        :count (or count t)
107
        :all t))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
108
109
110
111
112
113
114
115
116
    #+(or clasp ecl mkcl)
    (let* ((top (si:ihs-top))
           (repeats (if count (min top count) top))
           (backtrace (loop :for ihs :from 0 :below top
                            :collect (list (si::ihs-fun ihs)
                                           (si::ihs-env ihs)))))
      (loop :for i :from 0 :below repeats
            :for frame :in (nreverse backtrace) :do
              (safe-format! stream "~&~D: ~S~%" i frame)))
117
118
119
120
    #+clisp
    (system::print-backtrace :out stream :limit count)
    #+(or clozure mcl)
    (let ((*debug-io* stream))
121
122
      #+clozure (ccl:print-call-history :count count :start-frame-number 1)
      #+mcl (ccl:print-call-history :detailed-p nil)
123
      (finish-output stream))
124
    #+(or cmucl scl)
125
126
    (let ((debug:*debug-print-level* *print-level*)
          (debug:*debug-print-length* *print-length*))
127
      (debug:backtrace (or count most-positive-fixnum) stream))
128
129
    #+gcl
    (let ((*debug-io* stream))
130
131
      (ignore-errors
       (with-safe-io-syntax ()
132
133
134
         (if condition
             (conditions::condition-backtrace condition)
             (system::simple-backtrace)))))
135
136
137
138
139
140
141
    #+lispworks
    (let ((dbg::*debugger-stack*
            (dbg::grab-stack nil :how-many (or count most-positive-fixnum)))
          (*debug-io* stream)
          (dbg:*debug-print-level* *print-level*)
          (dbg:*debug-print-length* *print-length*))
      (dbg:bug-backtrace nil))
142
143
144
    #+mezzano
    (let ((*standard-output* stream))
      (sys.int::backtrace count))
145
    #+sbcl
146
    (sb-debug:print-backtrace :stream stream :count (or count most-positive-fixnum))
147
    #+xcl
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
148
    (loop :for i :from 0 :below (or count most-positive-fixnum)
149
150
          :for frame :in (extensions:backtrace-as-list) :do
            (safe-format! stream "~&~D: ~S~%" i frame)))
151

152
  (defun print-backtrace (&rest keys &key stream count condition)
153
    "Print a backtrace"
154
    (declare (ignore stream count condition))
155
156
157
158
159
160
161
162
163
164
    (with-safe-io-syntax (:package :cl)
      (let ((*print-readably* nil)
            (*print-circle* t)
            (*print-miser-width* 75)
            (*print-length* nil)
            (*print-level* nil)
            (*print-pretty* t))
        (ignore-errors (apply 'raw-print-backtrace keys)))))

  (defun print-condition-backtrace (condition &key (stream *stderr*) count)
165
    "Print a condition after a backtrace triggered by that condition"
166
167
168
    ;; We print the condition *after* the backtrace,
    ;; for the sake of who sees the backtrace at a terminal.
    ;; It is up to the caller to print the condition *before*, with some context.
169
    (print-backtrace :stream stream :count count :condition condition)
170
171
172
173
174
    (when condition
      (safe-format! stream "~&Above backtrace due to this condition:~%~A~&"
                    condition)))

  (defun fatal-condition-p (condition)
175
176
    "Is the CONDITION fatal?"
    (typep condition 'fatal-condition))
177
178

  (defun handle-fatal-condition (condition)
179
180
    "Handle a fatal CONDITION:
depending on whether *LISP-INTERACTION* is set, enter debugger or die"
181
182
183
184
185
186
187
188
189
    (cond
      (*lisp-interaction*
       (invoke-debugger condition))
      (t
       (safe-format! *stderr* "~&Fatal condition:~%~A~%" condition)
       (print-condition-backtrace condition :stream *stderr*)
       (die 99 "~A" condition))))

  (defun call-with-fatal-condition-handler (thunk)
190
    "Call THUNK in a context where fatal conditions are appropriately handled"
191
    (handler-bind ((fatal-condition #'handle-fatal-condition))
192
193
194
      (funcall thunk)))

  (defmacro with-fatal-condition-handler ((&optional) &body body)
195
    "Execute BODY in a context where fatal conditions are appropriately handled"
196
197
198
199
200
    `(call-with-fatal-condition-handler #'(lambda () ,@body)))

  (defun shell-boolean-exit (x)
    "Quit with a return code that is 0 iff argument X is true"
    (quit (if x 0 1))))
201
202


203
;;; Using image hooks
204
205
(with-upgradability ()
  (defun register-image-restore-hook (hook &optional (call-now-p t))
206
    "Regiter a hook function to be run when restoring a dumped image"
207
    (register-hook-function '*image-restore-hook* hook call-now-p))
208

209
  (defun register-image-dump-hook (hook &optional (call-now-p nil))
210
    "Register a the hook function to be run before to dump an image"
211
    (register-hook-function '*image-dump-hook* hook call-now-p))
212

213
  (defun call-image-restore-hook ()
214
    "Call the hook functions registered to be run when restoring a dumped image"
215
    (call-functions (reverse *image-restore-hook*)))
216

217
  (defun call-image-dump-hook ()
218
    "Call the hook functions registered to be run before to dump an image"
219
    (call-functions *image-dump-hook*)))
220
221
222


;;; Proper command-line arguments
223
224
225
226
227
(with-upgradability ()
  (defun raw-command-line-arguments ()
    "Find what the actual command line for this process was."
    #+abcl ext:*command-line-argument-list* ; Use 1.0.0 or later!
    #+allegro (sys:command-line-arguments) ; default: :application t
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
228
    #+(or clasp ecl) (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
229
    #+clisp (coerce (ext:argv) 'list)
230
    #+clozure ccl:*command-line-argument-list*
231
    #+(or cmucl scl) extensions:*command-line-strings*
232
    #+gcl si:*command-args*
233
    #+(or genera mcl mezzano) nil
234
    #+lispworks sys:*line-arguments-list*
235
    #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i))
236
237
    #+sbcl sb-ext:*posix-argv*
    #+xcl system:*argv*
238
    #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mezzano mkcl sbcl scl xcl)
239
    (not-implemented-error 'raw-command-line-arguments))
240
241
242

  (defun command-line-arguments (&optional (arguments (raw-command-line-arguments)))
    "Extract user arguments from command-line invocation of current process.
243
244
Assume the calling conventions of a generated script that uses --
if we are not called from a directly executable image."
245
246
247
248
249
    (block nil
      #+abcl (return arguments)
      ;; SBCL and Allegro already separate user arguments from implementation arguments.
      #-(or sbcl allegro)
      (unless (eq *image-dumped-p* :executable)
250
251
252
253
254
255
256
257
        ;; LispWorks command-line processing isn't transparent to the user
        ;; unless you create a standalone executable; in that case,
        ;; we rely on cl-launch or some other script to set the arguments for us.
        #+lispworks (return *command-line-arguments*)
        ;; On other implementations, on non-standalone executables,
        ;; we trust cl-launch or whichever script starts the program
        ;; to use -- as a delimiter between implementation arguments and user arguments.
        #-lispworks (setf arguments (member "--" arguments :test 'string-equal)))
258
259
      (rest arguments)))

260
  (defun argv0 ()
261
262
263
    "On supported implementations (most that matter), or when invoked by a proper wrapper script,
return a string that for the name with which the program was invoked, i.e. argv[0] in C.
Otherwise, return NIL."
264
265
    (cond
      ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 !
266
       ;; NB: not currently available on ABCL, Corman, Genera, MCL
267
       (or #+(or allegro clisp clozure cmucl gcl lispworks sbcl scl xcl)
268
           (first (raw-command-line-arguments))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
269
           #+(or clasp ecl) (si:argv 0) #+mkcl (mkcl:argv 0)))
270
271
272
      (t ;; argv[0] is the name of the interpreter.
       ;; The wrapper script can export __CL_ARGV0. cl-launch does as of 4.0.1.8.
       (getenvp "__CL_ARGV0"))))
273

274
275
276
277
  (defun setup-command-line-arguments ()
    (setf *command-line-arguments* (command-line-arguments)))

  (defun restore-image (&key
278
                          (lisp-interaction *lisp-interaction*)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
279
                          (restore-hook *image-restore-hook*)
280
281
                          (prelude *image-prelude*)
                          (entry-point *image-entry-point*)
282
                          (if-already-restored '(cerror "RUN RESTORE-IMAGE ANYWAY")))
283
    "From a freshly restarted Lisp image, restore the saved Lisp environment
284
285
286
287
288
289
290
291
by setting appropriate variables, running various hooks, and calling any specified entry point.

If the image has already been restored or is already being restored, as per *IMAGE-RESTORED-P*,
call the IF-ALREADY-RESTORED error handler (by default, a continuable error), and do return
immediately to the surrounding restore process if allowed to continue.

Then, comes the restore process itself:
First, call each function in the RESTORE-HOOK,
292
in the order they were registered with REGISTER-IMAGE-RESTORE-HOOK.
293
294
295
296
297
298
299
300
301
302
303
304
305
306
Second, evaluate the prelude, which is often Lisp text that is read,
as per EVAL-INPUT.
Third, call the ENTRY-POINT function, if any is specified, with no argument.

The restore process happens in a WITH-FATAL-CONDITION-HANDLER, so that if LISP-INTERACTION is NIL,
any unhandled error leads to a backtrace and an exit with an error status.
If LISP-INTERACTION is NIL, the process also exits when no error occurs:
if neither restart nor entry function is provided, the program will exit with status 0 (success);
if a function was provided, the program will exit after the function returns (if it returns),
with status 0 if and only if the primary return value of result is generalized boolean true,
and with status 1 if this value is NIL.

If LISP-INTERACTION is true, unhandled errors will take you to the debugger, and the result
of the function will be returned rather than interpreted as a boolean designating an exit code."
307
308
    (when *image-restored-p*
      (if if-already-restored
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
309
310
          (call-function if-already-restored "Image already ~:[being ~;~]restored"
                         (eq *image-restored-p* t))
311
          (return-from restore-image)))
312
    (with-fatal-condition-handler ()
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
313
314
315
      (setf *lisp-interaction* lisp-interaction)
      (setf *image-restore-hook* restore-hook)
      (setf *image-prelude* prelude)
316
      (setf *image-restored-p* :in-progress)
317
      (call-image-restore-hook)
318
      (standard-eval-thunk prelude)
319
      (setf *image-restored-p* t)
320
      (let ((results (multiple-value-list
321
322
                      (if entry-point
                          (call-function entry-point)
323
                          t))))
324
        (if lisp-interaction
325
            (values-list results)
326
            (shell-boolean-exit (first results)))))))
327

328
329
330

;;; Dumping an image

331
332
(with-upgradability ()
  (defun dump-image (filename &key output-name executable
333
334
                                (postlude *image-postlude*)
                                (dump-hook *image-dump-hook*)
335
                                #+clozure prepend-symbols #+clozure (purify t)
336
                                #+sbcl compression
337
                                #+(and sbcl os-windows) application-type)
338
339
340
341
342
343
344
345
346
    "Dump an image of the current Lisp environment at pathname FILENAME, with various options.

First, finalize the image, by evaluating the POSTLUDE as per EVAL-INPUT, then calling each of
 the functions in DUMP-HOOK, in reverse order of registration by REGISTER-DUMP-HOOK.

If EXECUTABLE is true, create an standalone executable program that calls RESTORE-IMAGE on startup.

Pass various implementation-defined options, such as PREPEND-SYMBOLS and PURITY on CCL,
or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
347
348
    ;; Note: at least SBCL saves only global values of variables in the heap image,
    ;; so make sure things you want to dump are NOT just local bindings shadowing the global values.
349
350
    (declare (ignorable filename output-name executable))
    (setf *image-dumped-p* (if executable :executable t))
351
    (setf *image-restored-p* :in-regress)
352
    (setf *image-postlude* postlude)
353
    (standard-eval-thunk *image-postlude*)
354
    (setf *image-dump-hook* dump-hook)
355
    (call-image-dump-hook)
356
    (setf *image-restored-p* nil)
357
    #-(or clisp clozure (and cmucl executable) lispworks sbcl scl)
358
    (when executable
359
      (not-implemented-error 'dump-image "dumping an executable"))
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
    #+allegro
    (progn
      (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000
      (excl:dumplisp :name filename :suppress-allegro-cl-banner t))
    #+clisp
    (apply #'ext:saveinitmem filename
           :quiet t
           :start-package *package*
           :keep-global-handlers nil
           :executable (if executable 0 t) ;--- requires clisp 2.48 or later, still catches --clisp-x
           (when executable
             (list
              ;; :parse-options nil ;--- requires a non-standard patch to clisp.
              :norc t :script nil :init-function #'restore-image)))
    #+clozure
375
    (flet ((dump (prepend-kernel)
376
             (ccl:save-application filename :prepend-kernel prepend-kernel :purify purify
377
378
379
380
381
                                            :toplevel-function (when executable #'restore-image))))
      ;;(setf ccl::*application* (make-instance 'ccl::lisp-development-system))
      (if prepend-symbols
          (with-temporary-file (:prefix "ccl-symbols-" :direction :output :pathname path)
            (require 'elf)
382
            (funcall (fdefinition 'ccl::write-elf-symbols-to-file) path)
383
384
            (dump path))
          (dump t)))
385
    #+(or cmucl scl)
386
387
388
389
    (progn
      (ext:gc :full t)
      (setf ext:*batch-mode* nil)
      (setf ext::*gc-run-time* 0)
390
      (apply 'ext:save-lisp filename
391
392
393
394
             :allow-other-keys t ;; hush SCL and old versions of CMUCL
             #+(and cmucl executable) :executable #+(and cmucl executable) t
             (when executable '(:init-function restore-image :process-command-line nil
                                :quiet t :load-init-file nil :site-init nil))))
395
396
397
398
399
400
401
402
403
404
405
406
407
408
    #+gcl
    (progn
      (si::set-hole-size 500) (si::gbc nil) (si::sgc-on t)
      (si::save-system filename))
    #+lispworks
    (if executable
        (lispworks:deliver 'restore-image filename 0 :interface nil)
        (hcl:save-image filename :environment nil))
    #+sbcl
    (progn
      ;;(sb-pcl::precompile-random-code-segments) ;--- it is ugly slow at compile-time (!) when the initial core is a big CLOS program. If you want it, do it yourself
      (setf sb-ext::*gc-run-time* 0)
      (apply 'sb-ext:save-lisp-and-die filename
             :executable t ;--- always include the runtime that goes with the core
409
410
411
412
             (append
              (when compression (list :compression compression))
              ;;--- only save runtime-options for standalone executables
              (when executable (list :toplevel #'restore-image :save-runtime-options t))
413
              #+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window.
414
415
              ;; the default is :console - only works with SBCL 1.1.15 or later.
              (when application-type (list :application-type application-type)))))
416
    #-(or allegro clisp clozure cmucl gcl lispworks sbcl scl)
417
    (not-implemented-error 'dump-image))
418

419
420
  (defun create-image (destination lisp-object-files
                       &key kind output-name prologue-code epilogue-code extra-object-files
421
                         (prelude () preludep) (postlude () postludep)
422
                         (entry-point () entry-point-p) build-args no-uiop)
423
424
    (declare (ignorable destination lisp-object-files extra-object-files kind output-name
                        prologue-code epilogue-code prelude preludep postlude postludep
425
                        entry-point entry-point-p build-args no-uiop))
426
    "On ECL, create an executable at pathname DESTINATION from the specified OBJECT-FILES and options"
427
428
429
    ;; Is it meaningful to run these in the current environment?
    ;; only if we also track the object files that constitute the "current" image,
    ;; and otherwise simulate dump-image, including quitting at the end.
430
    #-(or clasp ecl mkcl) (not-implemented-error 'create-image)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
431
    #+(or clasp ecl mkcl)
432
    (let ((epilogue-code
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
           (if no-uiop
               epilogue-code
               (let ((forms
                      (append
                       (when epilogue-code `(,epilogue-code))
                       (when postludep `((setf *image-postlude* ',postlude)))
                       (when preludep `((setf *image-prelude* ',prelude)))
                       (when entry-point-p `((setf *image-entry-point* ',entry-point)))
                       (case kind
                         ((:image)
                          (setf kind :program) ;; to ECL, it's just another program.
                          `((setf *image-dumped-p* t)
                            (si::top-level #+(or clasp ecl) t) (quit)))
                         ((:program)
                          `((setf *image-dumped-p* :executable)
                            (shell-boolean-exit
                             (restore-image))))))))
                 (when forms `(progn ,@forms))))))
451
452
453
      #+(or clasp ecl mkcl)
      (check-type kind (member :dll :shared-library :lib :static-library
                               :fasl :fasb :program))
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
454
      (apply #+clasp 'cmp:builder #+clasp kind
455
456
457
458
459
460
             #+(or ecl mkcl)
             (ecase kind
               ((:dll :shared-library)
                #+ecl 'c::build-shared-library #+mkcl 'compiler:build-shared-library)
               ((:lib :static-library)
                #+ecl 'c::build-static-library #+mkcl 'compiler:build-static-library)
461
               ((:fasl #+ecl :fasb)
462
                #+ecl 'c::build-fasl #+mkcl 'compiler:build-fasl)
463
               #+mkcl ((:fasb) 'compiler:build-bundle)
464
465
               ((:program)
                #+ecl 'c::build-program #+mkcl 'compiler:build-program))
466
             (pathname destination)
467
468
469
             #+(or clasp ecl) :lisp-files #+mkcl :lisp-object-files
             (append lisp-object-files #+(or clasp ecl) extra-object-files)
             #+ecl :init-name
470
             #+ecl (getf build-args :init-name)
471
472
             (append
              (when prologue-code `(:prologue-code ,prologue-code))
473
              (when epilogue-code `(:epilogue-code ,epilogue-code))
474
475
              #+mkcl (when extra-object-files `(:object-files ,extra-object-files))
              build-args)))))
476
477


478
;;; Some universal image restore hooks
479
480
(with-upgradability ()
  (map () 'register-image-restore-hook
481
482
       '(setup-stdin setup-stdout setup-stderr
         setup-command-line-arguments setup-temporary-directory
483
         #+abcl detect-os)))