diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor
index 8641246eed..54f5485758 100644
--- a/library/cross-compiler.factor
+++ b/library/cross-compiler.factor
@@ -73,6 +73,7 @@ DEFER: type-of
 DEFER: size-of
 DEFER: address-of
 DEFER: dump
+DEFER: heap-stats
 
 IN: strings
 DEFER: str=
@@ -376,6 +377,7 @@ IN: image
         set-alien-2
         alien-1
         set-alien-1
+        heap-stats
     ] [
         swap succ tuck primitive,
     ] each drop ;
diff --git a/library/platform/native/boot-stage2.factor b/library/platform/native/boot-stage2.factor
index d194b45267..8202e04ede 100644
--- a/library/platform/native/boot-stage2.factor
+++ b/library/platform/native/boot-stage2.factor
@@ -109,6 +109,7 @@ USE: stdio
     "/library/telnetd.factor"
     "/library/inferior.factor"
     "/library/platform/native/profiler.factor"
+    "/library/platform/native/heap-stats.factor"
 
     "/library/image.factor"
     "/library/cross-compiler.factor"
diff --git a/library/platform/native/heap-stats.factor b/library/platform/native/heap-stats.factor
new file mode 100644
index 0000000000..91e8a30237
--- /dev/null
+++ b/library/platform/native/heap-stats.factor
@@ -0,0 +1,52 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+IN: kernel
+USE: combinators
+USE: kernel
+USE: lists
+USE: math
+USE: namespaces
+USE: prettyprint
+USE: stack
+USE: stdio
+USE: words
+USE: vectors
+USE: unparser
+
+: heap-stat. ( type instances bytes -- )
+    dup 0 = [
+        3drop
+    ] [
+        rot type-name write ": " write
+        unparse write " bytes, " write
+        unparse write " instances" print
+    ] ifte ;
+
+: heap-stats. ( -- )
+    #! Print heap allocation breakdown.
+    0 heap-stats [ dupd uncons heap-stat. succ ] each drop ;
diff --git a/library/platform/native/primitives.factor b/library/platform/native/primitives.factor
index f9937d04dc..590ec98703 100644
--- a/library/platform/native/primitives.factor
+++ b/library/platform/native/primitives.factor
@@ -232,6 +232,7 @@ USE: words
     [ set-alien-2            | " n alien off -- " ]
     [ alien-1                | " alien off -- n " ]
     [ set-alien-1            | " n alien off -- " ]
+    [ heap-stats             | " -- instances bytes " ]
 ] [
     unswons "stack-effect" swap set-word-property
 ] each
diff --git a/library/platform/native/types.factor b/library/platform/native/types.factor
index 0c61d82de0..d4ea3bb2b1 100644
--- a/library/platform/native/types.factor
+++ b/library/platform/native/types.factor
@@ -48,10 +48,12 @@ IN: kernel
         [ 0 | "fixnum" ]
         [ 1 | "word" ]
         [ 2 | "cons" ]
+        [ 3 | "object" ]
         [ 4 | "ratio" ]
         [ 5 | "complex" ]
         [ 6 | "f" ]
         [ 7 | "t" ]
+        [ 8 | "array" ]
         [ 9 | "vector" ]
         [ 10 | "string" ]
         [ 11 | "sbuf" ]
diff --git a/native/memory.c b/native/memory.c
index ac47fb20f1..43cb88652e 100644
--- a/native/memory.c
+++ b/native/memory.c
@@ -117,3 +117,49 @@ void primitive_address(void)
 {
 	dpush(tag_object(s48_ulong_to_bignum(dpop())));
 }
+
+void primitive_heap_stats(void)
+{
+	int instances[TYPE_COUNT], bytes[TYPE_COUNT];
+	int i;
+	CELL ptr;
+	CELL list = F;
+
+	for(i = 0; i < TYPE_COUNT; i++)
+		instances[i] = 0;
+
+	for(i = 0; i < TYPE_COUNT; i++)
+		bytes[i] = 0;
+
+	ptr = active.base;
+	while(ptr < active.here)
+	{
+		CELL value = get(ptr);
+		CELL size;
+		CELL type;
+
+		if(TAG(value) == HEADER_TYPE)
+		{
+			size = align8(untagged_object_size(ptr));
+			type = untag_header(value);
+		}
+		else
+		{
+			size = CELLS * 2;
+			type = CONS_TYPE;
+		}
+
+		instances[type]++;
+		bytes[type] += size;
+		ptr += size;
+	}
+
+	for(i = TYPE_COUNT - 1; i >= 0; i--)
+	{
+		list = cons(
+			cons(tag_fixnum(instances[i]),tag_fixnum(bytes[i])),
+			list);
+	}
+
+	dpush(list);
+}
diff --git a/native/memory.h b/native/memory.h
index 816139c926..ebdad4e939 100644
--- a/native/memory.h
+++ b/native/memory.h
@@ -76,3 +76,4 @@ void primitive_memory_1(void);
 void primitive_set_memory_cell(void);
 void primitive_set_memory_4(void);
 void primitive_set_memory_1(void);
+void primitive_heap_stats(void);
diff --git a/native/primitives.c b/native/primitives.c
index bfd229424c..e6d542a280 100644
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -190,7 +190,8 @@ XT primitives[] = {
 	primitive_alien_2,
 	primitive_set_alien_2,
 	primitive_alien_1,
-	primitive_set_alien_1
+	primitive_set_alien_1,
+	primitive_heap_stats
 };
 
 CELL primitive_to_xt(CELL primitive)
diff --git a/native/primitives.h b/native/primitives.h
index 521fd4500b..c41f8b4796 100644
--- a/native/primitives.h
+++ b/native/primitives.h
@@ -1,4 +1,4 @@
 extern XT primitives[];
-#define PRIMITIVE_COUNT 190
+#define PRIMITIVE_COUNT 191
 
 CELL primitive_to_xt(CELL primitive);
diff --git a/native/types.h b/native/types.h
index c25d03e7e3..c13d01e0c9 100644
--- a/native/types.h
+++ b/native/types.h
@@ -34,6 +34,8 @@ CELL T;
 #define DLL_TYPE 15
 #define ALIEN_TYPE 16
 
+#define TYPE_COUNT 17
+
 /* Pseudo-types. For error reporting only. */
 #define INTEGER_TYPE 100 /* FIXNUM or BIGNUM */
 #define RATIONAL_TYPE 101 /* INTEGER or RATIO */