bson writer performance improvements

diff --git a/extra/bson/writer/writer.factor b/extra/bson/writer/writer.factor
index 658984dbcdafefddbb0983a08ff67fbaaa447700..0c494c98488baf29d08f17bc4508f91ba973fbee 100644 (file)
--- 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 399b5c4e8cbccf717e82c6a501dc309e0d149506..99587d826e1b411c99989c2eceb6d50546581c1b 100644 (file)
--- 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 -- )