From a050578c3b6946e593c33039d4a5dc9447e37cde Mon Sep 17 00:00:00 2001
From: Sascha Matzke <sascha.matzke@didolo.org>
Date: Wed, 25 Mar 2009 21:33:39 +0100
Subject: [PATCH] some further optimizations

---
 bson/writer/writer.factor            | 23 +++++++++++++------
 mongodb/benchmark/benchmark.factor   | 34 ++++++++++++++--------------
 mongodb/operations/operations.factor | 12 +++-------
 3 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/bson/writer/writer.factor b/bson/writer/writer.factor
index 6e3d7badea..6684888ad0 100644
--- a/bson/writer/writer.factor
+++ b/bson/writer/writer.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs bson.constants byte-arrays byte-vectors
 calendar fry io io.binary io.encodings io.encodings.string io.encodings.private
-io.encodings.utf8 kernel math math.parser namespaces quotations
+io.encodings.utf8.private io.encodings.utf8 kernel math math.parser namespaces quotations
 sequences sequences.private serialize strings tools.walker words ;
 
 
@@ -22,6 +22,13 @@ CONSTANT: INT64-SIZE 8
     shared-buffer get
     [ 8192 <byte-vector> [ shared-buffer set ] keep ] unless* ; inline
 
+: >le-stream ( x n -- )
+    ! >le write  
+    swap '[ _ swap nth-byte 0 B{ 0 }
+            [ set-nth-unsafe ] keep write ] each
+            ; inline
+
+
 PRIVATE>
 
 : reset-buffer ( buffer -- )
@@ -74,12 +81,14 @@ M: objref bson-type? ( objref -- type ) drop T_Binary ;
 M: quotation bson-type? ( quotation -- type ) drop T_Binary ; 
 M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ; 
 
-: write-utf8-string ( string -- ) output-stream get utf8 encoder-write ; inline
-: write-byte ( byte -- ) CHAR-SIZE >le write ; inline
-: write-int32 ( int -- ) INT32-SIZE >le write ; inline
-: write-double ( real -- ) double>bits INT64-SIZE >le write ; inline
-: write-cstring ( string -- ) write-utf8-string B{ 0 } write ; inline
-: write-longlong ( object -- ) INT64-SIZE >le write ; inline
+: write-utf8-string ( string -- )
+    output-stream get '[ _ swap char>utf8 ] each ; inline
+
+: write-byte ( byte -- ) CHAR-SIZE >le-stream ; inline
+: write-int32 ( int -- ) INT32-SIZE >le-stream ; inline
+: write-double ( real -- ) double>bits INT64-SIZE >le-stream ; inline
+: write-cstring ( string -- ) write-utf8-string 0 write-byte ; inline
+: write-longlong ( object -- ) INT64-SIZE >le-stream ; inline
 
 : write-eoo ( -- ) T_EOO write-byte ; inline
 : write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
diff --git a/mongodb/benchmark/benchmark.factor b/mongodb/benchmark/benchmark.factor
index c9c04dfab1..b8a0a7a8fe 100644
--- a/mongodb/benchmark/benchmark.factor
+++ b/mongodb/benchmark/benchmark.factor
@@ -254,23 +254,23 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
     
 : run-benchmarks ( -- )
     "db" "db" get* "host" "127.0.0.1" get* "port" 27020 get* ensure-number <mdb>
-    [   ensure-buffer
-        print-header
-        ! insert
-        ! { small-doc-prepare medium-doc-prepare
-        { large-doc-prepare }
-        { { } { index } { errcheck } { index errcheck }
-          { batch } { batch errcheck } { batch index errcheck }
-        } run-insert-bench
-        ! find-one
-        ! { small-doc medium-doc large-doc }
-        ! { { } { index } } run-find-one-bench
-        ! find-all
-        ! { small-doc medium-doc large-doc }
-        ! { { } { index } } run-find-all-bench
-        ! find-range
-        ! { small-doc medium-doc large-doc }
-        ! { { } { index } } run-find-range-bench        
+    [ ensure-buffer
+      print-header
+      ! insert
+      { small-doc-prepare medium-doc-prepare
+        large-doc-prepare }
+      { { } { index } { errcheck } { index errcheck }
+        { batch } { batch errcheck } { batch index errcheck }
+      } run-insert-bench
+      ! find-one
+      { small-doc medium-doc large-doc }
+      { { } { index } } run-find-one-bench
+      ! find-all
+      { small-doc medium-doc large-doc }
+      { { } { index } } run-find-all-bench
+      ! find-range
+      { small-doc medium-doc large-doc }
+      { { } { index } } run-find-range-bench        
     ] with-db ;
         
 MAIN: run-benchmarks
diff --git a/mongodb/operations/operations.factor b/mongodb/operations/operations.factor
index 0b7f027500..ef74bce7e9 100644
--- a/mongodb/operations/operations.factor
+++ b/mongodb/operations/operations.factor
@@ -1,7 +1,7 @@
 USING: accessors assocs bson.reader bson.writer byte-arrays
 byte-vectors combinators formatting fry io io.binary io.encodings.private
-io.encodings.binary io.encodings.string io.encodings.utf8 io.files
-kernel locals math mongodb.msg namespaces sequences uuid ;
+io.encodings.binary io.encodings.string io.encodings.utf8 io.encodings.utf8.private io.files
+kernel locals math mongodb.msg namespaces sequences uuid bson.writer.private ;
 
 IN: alien.c-types
 
@@ -38,12 +38,6 @@ SYMBOL: msg-bytes-read
 : change-bytes-read ( integer -- )
     bytes-read> [ 0 ] unless* + >bytes-read ; inline
 
-: write-byte ( byte -- ) 1 >le write ; inline
-: write-int32 ( int -- ) 4 >le write ; inline
-: write-double ( real -- ) double>bits 8 >le write ; inline
-: write-cstring ( string -- ) output-stream get utf8 encoder-write 0 write-byte ; inline
-: write-longlong ( object -- ) 8 >le write ; inline
-
 : read-int32 ( -- int32 ) 4 [ read le> ] [ change-bytes-read ] bi ; inline
 : read-longlong ( -- longlong ) 8 [ read le> ] [ change-bytes-read ] bi ; inline
 : read-byte-raw ( -- byte-raw ) 1 [ read le> ] [ change-bytes-read ] bi ; inline
@@ -156,7 +150,7 @@ USE: tools.walker
 
 : (write-message) ( message quot -- )    
     '[ [ [ _ write-header ] dip _ call ] with-length-prefix ] with-buffer
-    ! [ dump-to-file ] keep
+    [ dump-to-file ] keep
     write flush ; inline
 
 : build-query-object ( query -- selector )