Author: hhubner Date: 2007-10-04 11:50:09 -0400 (Thu, 04 Oct 2007) New Revision: 2184 Added: branches/trunk-reorg/bknr-web/site/ branches/trunk-reorg/bknr-web/src/images/ branches/trunk-reorg/bknr/experimental/dump-core.lisp Removed: branches/trunk-reorg/bknr-web/images/ branches/trunk-reorg/bknr-web/src/xhtmlgen/ branches/trunk-reorg/site/ Log: More reorganization Added: branches/trunk-reorg/bknr/experimental/dump-core.lisp =================================================================== --- branches/trunk-reorg/bknr/experimental/dump-core.lisp 2007-10-04 15:45:02 UTC (rev 2183) +++ branches/trunk-reorg/bknr/experimental/dump-core.lisp 2007-10-04 15:50:09 UTC (rev 2184) @@ -0,0 +1,34 @@ +(in-package :bknr.datastore) + +(defun save-cmucl-clean-slime-debugger () + "Called in *after-save-initializations* because cores dumped +when slime is running has this bound. TODO" + (format t "~&clearing debugger hook (~A)" cl:*debugger-hook*) + (setf cl:*debugger-hook* nil)) + +(defun save-cmucl-close-fd-handlers () + (loop for handler in lisp::*descriptor-handlers* + when (> (lisp::handler-descriptor handler) 2) + do (SYSTEM:REMOVE-FD-HANDLER handler))) + +(defun save-cmucl-inits (corefilepath) + "called in the child process" + (save-cmucl-close-fd-handlers) + (mp::shutdown-multi-processing) + (when cl:*debugger-hook* + (warn "CHILD: setting debugger-hook to NIL") + (setf cl:*debugger-hook* nil) ; does not work! + (pushnew 'save-cmucl-clean-slime-debugger ext:*after-save-initializations*)) + (pushnew 'system::reinitialize-global-table ext:*after-save-initializations*) + (ext:save-lisp corefilepath) + (warn "CHILD: strangely survived. killing.") + (unix:unix-exit 1)) + +(defun snapshot-core (&optional (corefilepath "/tmp/bknr.core")) + (cond ((zerop (unix:unix-fork)) + (save-cmucl-inits corefilepath)) + (t (alien:alien-funcall + (alien:extern-alien "wait" + (alien:function alien:unsigned alien:unsigned)) + 0))) + (warn "PARENT saved")) Copied: branches/trunk-reorg/bknr-web/site (from rev 2182, branches/trunk-reorg/site) Copied: branches/trunk-reorg/bknr-web/src/images (from rev 2183, branches/trunk-reorg/bknr-web/images)