[bknr-cvs] r2184 - in branches/trunk-reorg: . bknr/experimental bknr-web bknr-web/src

[bknr at bknr.net]

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)