Changeset 10396
- Timestamp:
- Aug 8, 2008, 4:54:46 AM (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/working-0711/ccl/lib/dumplisp.lisp
r9620 r10396 27 27 28 28 (declaim (special *lisp-system-pointer-functions*)) ; defined in l1-init. 29 30 29 31 30 (defun kill-lisp-pointers () … … 42 41 (defun clear-ioblock-streams () 43 42 (%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)))))))) 53 64 54 65 (defun save-application (filename … … 217 228 218 229 (defun restore-lisp-pointers () 230 (setq *interactive-streams-initialized* nil) 219 231 (%revive-system-locks) 220 232 (refresh-external-entrypoints) 221 233 (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*) 225 237 (user-pointer-fns *lisp-user-pointer-functions*) 226 238 (lisp-startup-fns *lisp-startup-functions*)) … … 233 245 (if (symbolp f) f (function-name f))) 234 246 (funcall f))))) 247 (dolist (f system-ptr-fns) (funcall call-with-restart f)) 235 248 (dolist (f restore-lisp-fns) (funcall call-with-restart f)) 236 249 (dolist (f (reverse user-pointer-fns)) (funcall call-with-restart f))
Note: See TracChangeset
for help on using the changeset viewer.