Changeset 10396


Ignore:
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:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/dumplisp.lisp

    r9620 r10396  
    2727
    2828(declaim (special *lisp-system-pointer-functions*)) ; defined in l1-init.
    29 
    3029
    3130(defun kill-lisp-pointers ()
     
    4241(defun clear-ioblock-streams ()
    4342  (%map-areas (lambda (o)
    44                 (if (typep o 'basic-stream)
    45                   (let ((s (basic-stream.state o)))
    46                     (when (and (typep s 'ioblock) (ioblock-device s))
    47                       (setf (basic-stream.state o) nil)))
    48                   (if (typep o 'buffered-stream-mixin)
    49                     (let ((s (slot-value o 'ioblock)))
    50                       (when (and (typep s 'ioblock) (ioblock-device s))
    51                         (setf (slot-value o 'ioblock) nil))))))))
    52 
     43                  (if (typep o 'basic-stream)
     44                    (let ((s (basic-stream.state o)))
     45                      (when (and (typep s 'ioblock)
     46                                 (ioblock-device s)
     47                                 (>= (ioblock-device s) 0))
     48                        (setf (basic-stream.state o) nil)))
     49                    ;; Have to be careful with use of TYPEP here (and
     50                    ;; in the little bit of Lisp code that runs before
     51                    ;; the image is saved.)  We may have just done
     52                    ;; things to forget about (per-session) foreign
     53                    ;; class addresses, and calling TYPEP on a pointer
     54                    ;; to such a class might cause us to remember
     55                    ;; those per-session addresses and confuse the
     56                    ;; startup code.
     57                    (if (and (eql (typecode o) target::subtag-instance)
     58                             (typep o 'buffered-stream-mixin))
     59                      (let ((s (slot-value o 'ioblock)))
     60                        (when (and (typep s 'ioblock)
     61                                   (ioblock-device s)
     62                                   (>= (ioblock-device s) 0))
     63                          (setf (slot-value o 'ioblock) nil))))))))
    5364
    5465(defun save-application (filename
     
    217228
    218229(defun restore-lisp-pointers ()
     230  (setq *interactive-streams-initialized* nil)
    219231  (%revive-system-locks)
    220232  (refresh-external-entrypoints)
    221233  (restore-pascal-functions)
    222   (dolist (f (reverse *lisp-system-pointer-functions*))
    223     (funcall f))
    224   (let ((restore-lisp-fns *restore-lisp-functions*)
     234  (initialize-interactive-streams)
     235  (let ((system-ptr-fns (reverse *lisp-system-pointer-functions*))
     236        (restore-lisp-fns *restore-lisp-functions*)
    225237        (user-pointer-fns *lisp-user-pointer-functions*)
    226238        (lisp-startup-fns *lisp-startup-functions*))
     
    233245                               (if (symbolp f) f (function-name f)))
    234246                     (funcall f)))))
     247          (dolist (f system-ptr-fns) (funcall call-with-restart f))
    235248          (dolist (f restore-lisp-fns) (funcall call-with-restart f))
    236249          (dolist (f (reverse user-pointer-fns)) (funcall call-with-restart f))
Note: See TracChangeset for help on using the changeset viewer.