Changeset 10396

Timestamp:

Aug 8, 2008, 4:54:46 AM (11 years ago)

Author:

gb

Message:

Create streams early.

Run *LISP-SYSTEM-POINTER-FUNCTIONS* with a handler in effect (better than
just crashing mysteriously, though anything on that list is likely to
be pretty critical, by definition.)

Be careful about use of TYPEP when clearing ioblock-based streams, mostly
for compatibility with trunk. (Issues related to "foreign" - as in ObjC -
classes getting revived.)

File:

• branches/working-0711/ccl/lib/dumplisp.lisp (modified) (4 diffs)

branches/working-0711/ccl/lib/dumplisp.lisp

@@ -27 +27 @@
 
 (declaim (special *lisp-system-pointer-functions*)) ; defined in l1-init.
-
 
 (defun kill-lisp-pointers ()
@@ -42 +41 @@
 (defun clear-ioblock-streams ()
   (%map-areas (lambda (o)
-                (if (typep o 'basic-stream)
-                  (let ((s (basic-stream.state o)))
-                    (when (and (typep s 'ioblock) (ioblock-device s))
-                      (setf (basic-stream.state o) nil)))
-                  (if (typep o 'buffered-stream-mixin)
-                    (let ((s (slot-value o 'ioblock)))
-                      (when (and (typep s 'ioblock) (ioblock-device s))
-                        (setf (slot-value o 'ioblock) nil))))))))
-
+                  (if (typep o 'basic-stream)
+                    (let ((s (basic-stream.state o)))
+                      (when (and (typep s 'ioblock)
+                                 (ioblock-device s)
+                                 (>= (ioblock-device s) 0))
+                        (setf (basic-stream.state o) nil)))
+                    ;; Have to be careful with use of TYPEP here (and
+                    ;; in the little bit of Lisp code that runs before
+                    ;; the image is saved.)  We may have just done
+                    ;; things to forget about (per-session) foreign
+                    ;; class addresses, and calling TYPEP on a pointer
+                    ;; to such a class might cause us to remember
+                    ;; those per-session addresses and confuse the
+                    ;; startup code.
+                    (if (and (eql (typecode o) target::subtag-instance)
+                             (typep o 'buffered-stream-mixin))
+                      (let ((s (slot-value o 'ioblock)))
+                        (when (and (typep s 'ioblock)
+                                   (ioblock-device s)
+                                   (>= (ioblock-device s) 0))
+                          (setf (slot-value o 'ioblock) nil))))))))
 
 (defun save-application (filename
@@ -217 +228 @@
 
 (defun restore-lisp-pointers ()
+  (setq *interactive-streams-initialized* nil)
   (%revive-system-locks)
   (refresh-external-entrypoints)
   (restore-pascal-functions)
-  (dolist (f (reverse *lisp-system-pointer-functions*))
-    (funcall f))
-  (let ((restore-lisp-fns *restore-lisp-functions*)
+  (initialize-interactive-streams)
+  (let ((system-ptr-fns (reverse *lisp-system-pointer-functions*))
+        (restore-lisp-fns *restore-lisp-functions*)
         (user-pointer-fns *lisp-user-pointer-functions*)
         (lisp-startup-fns *lisp-startup-functions*))
@@ -233 +245 @@
                                (if (symbolp f) f (function-name f)))
                      (funcall f)))))
+          (dolist (f system-ptr-fns) (funcall call-with-restart f))
           (dolist (f restore-lisp-fns) (funcall call-with-restart f))
           (dolist (f (reverse user-pointer-fns)) (funcall call-with-restart f))