steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

bson writer performance improvements

db4
Sascha Matzke 2010-04-13 09:58:12 +02:00
parent c3df0a15fa
commit 134affb339
2 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
extra/bson/writer/writer.factor
View File

@ -11,9 +11,8 @@ IN: bson.writer
<PRIVATE <PRIVATE
CONSTANT: CHAR-SIZE 1 CONSTANT: INT32-SIZE { 0 1 2 3 }
CONSTANT: INT32-SIZE 4 CONSTANT: INT64-SIZE { 0 1 2 3 4 5 6 7 }
CONSTANT: INT64-SIZE 8
PRIVATE> PRIVATE>
@ -32,17 +31,21 @@ TYPED: with-length ( quot -- bytes-written: integer start-index: integer )
[ ] (with-length-prefix) ; inline [ ] (with-length-prefix) ; inline
: with-length-prefix-excl ( quot: ( .. -- .. ) -- ) : 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 <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 : write-eoo ( -- ) T_EOO write1 ; inline

3
extra/mongodb/benchmark/benchmark.factor
View File

@ -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 -- ) ) : [bench-quot] ( feat-seq op-word -- quot: ( doc-word -- ) )
'[ _ swap _ '[ _ swap _
'[ [ [ _ execute( -- quot ) ] dip '[ [ [ _ 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 ] ; print-separator ] ;
: run-serialization-bench ( doc-word-seq feat-seq -- ) : run-serialization-bench ( doc-word-seq feat-seq -- )