From 224d2afa5018d93b0470fae639b1a6965d0af8a2 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sun, 17 Apr 2005 22:41:05 +0000
Subject: [PATCH] dump tool added

---
 library/bootstrap/boot-stage3.factor |  1 +
 library/tools/dump.factor            | 40 ++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+)
 create mode 100644 library/tools/dump.factor

diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor
index c7c60c0f5a..60a4a42b60 100644
--- a/library/bootstrap/boot-stage3.factor
+++ b/library/bootstrap/boot-stage3.factor
@@ -45,6 +45,7 @@ t [
     "/library/tools/walker.factor"
     "/library/tools/annotations.factor"
     "/library/tools/jedit.factor"
+    "/library/tools/dump.factor"
     "/library/bootstrap/image.factor"
 
     "/library/httpd/url-encoding.factor"
diff --git a/library/tools/dump.factor b/library/tools/dump.factor
new file mode 100644
index 0000000000..c10735ebbd
--- /dev/null
+++ b/library/tools/dump.factor
@@ -0,0 +1,40 @@
+! Copyright (C) 2004, 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: dump
+USING: alien assembler generic kernel kernel-internals math
+memory sequences stdio strings unparser ;
+
+: cell. >hex cell 2 * CHAR: 0 pad write ;
+
+TUPLE: integer-slot-seq object ;
+
+M: integer-slot-seq length
+    integer-slot-seq-object size cell / ;
+
+M: integer-slot-seq nth
+    integer-slot-seq-object swap >fixnum integer-slot ;
+
+: slot@ ( address n -- n ) cell * swap 7 bitnot bitand + ;
+
+: dump-line ( address n value -- )
+    >r slot@ cell. ": " write r> cell. terpri ;
+
+: (dump) ( address sequence -- )
+    0 swap [ 2dup dump-line 1 + ] seq-each 2drop ;
+
+TUPLE: alien-seq alien length ;
+
+M: alien-seq length
+    alien-seq-length ;
+
+M: alien-seq nth
+    alien-seq-alien swap cell * alien-unsigned-4 ;
+
+: dump ( obj -- )
+    #! Dump an object's memory.
+    dup address <integer-slot-seq> (dump) ;
+
+: dump* ( alien len -- )
+    #! Dump an alien's memory.
+    dup string? [ c-size ] when 
+    >r [ alien-address ] keep r> <alien-seq> (dump) ;