From 134affb3398c5c5b2a487990df257e6bbb5dd82b Mon Sep 17 00:00:00 2001
From: Sascha Matzke <sascha.matzke@didolo.org>
Date: Tue, 13 Apr 2010 09:58:12 +0200
Subject: [PATCH] bson writer performance improvements

---
 extra/bson/writer/writer.factor          | 19 +++++++++++--------
 extra/mongodb/benchmark/benchmark.factor |  3 ++-
 2 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/extra/bson/writer/writer.factor b/extra/bson/writer/writer.factor
index 658984dbcd..0c494c9848 100644
--- a/extra/bson/writer/writer.factor
+++ b/extra/bson/writer/writer.factor
@@ -11,9 +11,8 @@ IN: bson.writer
 
 <PRIVATE
 
-CONSTANT: CHAR-SIZE  1
-CONSTANT: INT32-SIZE 4
-CONSTANT: INT64-SIZE 8
+CONSTANT: INT32-SIZE { 0 1 2 3 }
+CONSTANT: INT64-SIZE { 0 1 2 3 4 5 6 7 }
 
 PRIVATE>
 
@@ -32,17 +31,21 @@ TYPED: with-length ( quot -- bytes-written: integer start-index: integer )
     [ ] (with-length-prefix) ; inline
     
 : with-length-prefix-excl ( quot: ( .. -- .. ) -- )
-    [ INT32-SIZE - ] (with-length-prefix) ; inline
+    [ 4 - ] (with-length-prefix) ; inline
+
+: (>le) ( x n -- )
+    [ nth-byte write1 ] with each ; inline
     
 <PRIVATE
 
-TYPED: write-int32 ( int: integer -- ) INT32-SIZE >le write ; inline
+TYPED: write-int32 ( int: integer -- ) INT32-SIZE (>le) ; inline
 
-TYPED: write-double ( real: float -- ) double>bits INT64-SIZE >le write ; inline
+TYPED: write-double ( real: float -- ) double>bits INT64-SIZE (>le) ; inline
 
-TYPED: write-cstring ( string: string -- ) B{ } like write 0 write1 ; inline
+TYPED: write-cstring ( string: string -- )
+    get-output [ length ] [  ] bi copy 0 write1 ; inline
 
-: write-longlong ( object -- ) INT64-SIZE >le write ; inline
+: write-longlong ( object -- ) INT64-SIZE (>le) ; inline
 
 : write-eoo ( -- ) T_EOO write1 ; inline
 
diff --git a/extra/mongodb/benchmark/benchmark.factor b/extra/mongodb/benchmark/benchmark.factor
index 399b5c4e8c..99587d826e 100644
--- a/extra/mongodb/benchmark/benchmark.factor
+++ b/extra/mongodb/benchmark/benchmark.factor
@@ -247,7 +247,8 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
 : [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
     '[ _ swap _
        '[ [ [ _ execute( -- quot ) ] dip
-          [ execute( -- ) ] each _ execute( quot -- quot ) gc benchmark ] with-result ] each
+          [ execute( -- ) ] each _ execute( quot -- quot ) gc
+            benchmark ] with-result ] each
        print-separator ] ; 
 
 : run-serialization-bench ( doc-word-seq feat-seq -- )