[Openmcl-cvs-notifications] r11301 - /trunk/source/lib/dumplisp.lisp

[gb at clozure.com]

Author: gb
Date: Wed Nov  5 16:03:46 2008
New Revision: 11301

Log:
Since we documented the :TOPLEVEL-FUNCTION option to SAVE-APPLICATION,
might as well make it actually do something (without requiring that
the user know how to do low-level lisp initialization.)

Modified:
    trunk/source/lib/dumplisp.lisp

Modified: trunk/source/lib/dumplisp.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/dumplisp.lisp (original)
+++ trunk/source/lib/dumplisp.lisp Wed Nov  5 16:03:46 2008
@@ -112,13 +112,24 @@
                                        (find-class application-class)
                                        application-class)))
     (setq *application* (make-instance application-class)))
-  (when (not toplevel-function)
+  (if (not toplevel-function)
     (setq toplevel-function =

           #'(lambda ()
               (toplevel-function *application*
 				 (if init-file-p
 				   init-file
-				   (application-init-file *application*))))))
+				   (application-init-file *application*)))))
+        (let* ((user-toplevel-function (coerce-to-function toplevel-functi=
on)))
+      (setq toplevel-function
+            (lambda ()
+              (restore-lisp-pointers)
+              ;; Shouldn't be necessary post 1.2
+              ;;(initialize-interactive-streams)
+              (process-run-function "toplevel" (lambda ()
+                                                 (funcall user-toplevel-fu=
nction)
+                                                 (quit)))
+              (%set-toplevel #'housekeeping-loop)
+              (toplevel)))))
   (when error-handler
     (make-application-error-handler *application* error-handler))
   =