made some performance improvements by using a shared byte-vector buffer for serialization
parent
f56df9e965
commit
ca2459f729
|
@ -3,7 +3,7 @@
|
||||||
USING: assocs help.markup help.syntax kernel ;
|
USING: assocs help.markup help.syntax kernel ;
|
||||||
IN: bson.writer
|
IN: bson.writer
|
||||||
|
|
||||||
HELP: assoc>array
|
HELP: assoc>bv
|
||||||
{ $values
|
{ $values
|
||||||
{ "assoc" assoc }
|
{ "assoc" assoc }
|
||||||
{ "byte-array" null }
|
{ "byte-array" null }
|
||||||
|
|
|
@ -1,17 +1,51 @@
|
||||||
! Copyright (C) 2008 Sascha Matzke.
|
! Copyright (C) 2008 Sascha Matzke.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors assocs bson.constants byte-arrays fry io io.binary
|
USING: accessors assocs bson.constants
|
||||||
|
byte-arrays byte-vectors calendar fry io io.binary io.encodings
|
||||||
io.encodings.binary io.encodings.string io.encodings.utf8
|
io.encodings.binary io.encodings.string io.encodings.utf8
|
||||||
io.streams.byte-array kernel math math.parser quotations sequences
|
io.streams.byte-array kernel math math.parser namespaces
|
||||||
serialize strings words calendar ;
|
quotations sequences serialize strings words ;
|
||||||
|
|
||||||
|
|
||||||
IN: bson.writer
|
IN: bson.writer
|
||||||
|
|
||||||
#! Writes the object out to a stream in BSON format
|
#! Writes the object out to a byte-vector in BSON format
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
GENERIC: bson-type? ( obj -- type )
|
SYMBOL: shared-buffer
|
||||||
|
|
||||||
|
CONSTANT: INT32-SIZE 4
|
||||||
|
|
||||||
|
: (buffer) ( -- buffer )
|
||||||
|
shared-buffer get
|
||||||
|
[ 4096 <byte-vector> [ shared-buffer set ] keep ] unless* ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: ensure-buffer ( -- )
|
||||||
|
(buffer) drop ;
|
||||||
|
|
||||||
|
: reset-buffer ( -- )
|
||||||
|
(buffer) 0 >>length drop ;
|
||||||
|
|
||||||
|
: with-buffer ( quot -- byte-vector )
|
||||||
|
[ (buffer) ] dip [ output-stream get ] compose
|
||||||
|
with-output-stream* dup encoder? [ stream>> ] when ; inline
|
||||||
|
|
||||||
|
: with-length ( quot: ( -- ) -- bytes-written start-index )
|
||||||
|
[ (buffer) [ length ] keep ] dip call
|
||||||
|
length swap [ - ] keep ; inline
|
||||||
|
|
||||||
|
: with-length-prefix ( quot: ( -- ) -- )
|
||||||
|
[ B{ 0 0 0 0 } write ] prepose with-length
|
||||||
|
[ INT32-SIZE >le ] dip (buffer)
|
||||||
|
'[ _ over [ nth ] dip _ + _ set-nth ]
|
||||||
|
[ INT32-SIZE ] dip each-integer ; inline
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
GENERIC: bson-type? ( obj -- type ) foldable flushable
|
||||||
GENERIC: bson-write ( obj -- )
|
GENERIC: bson-write ( obj -- )
|
||||||
|
|
||||||
M: t bson-type? ( boolean -- type ) drop T_Boolean ;
|
M: t bson-type? ( boolean -- type ) drop T_Boolean ;
|
||||||
|
@ -42,7 +76,6 @@ M: byte-array bson-type? ( byte-array -- type ) drop T_Binary ;
|
||||||
: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
|
: write-type ( obj -- obj ) [ bson-type? write-byte ] keep ; inline
|
||||||
: write-pair ( name object -- ) write-type [ write-cstring ] dip bson-write ; inline
|
: write-pair ( name object -- ) write-type [ write-cstring ] dip bson-write ; inline
|
||||||
|
|
||||||
|
|
||||||
M: f bson-write ( f -- )
|
M: f bson-write ( f -- )
|
||||||
drop 0 write-byte ;
|
drop 0 write-byte ;
|
||||||
|
|
||||||
|
@ -91,12 +124,10 @@ M: objref bson-write ( objref -- )
|
||||||
write ;
|
write ;
|
||||||
|
|
||||||
M: sequence bson-write ( array -- )
|
M: sequence bson-write ( array -- )
|
||||||
'[ _ [ [ write-type ] dip number>string write-cstring bson-write ]
|
'[ _ [ [ write-type ] dip number>string
|
||||||
each-index ]
|
write-cstring bson-write ] each-index
|
||||||
binary swap with-byte-writer
|
write-eoo
|
||||||
[ length 5 + bson-write ] keep
|
] with-length-prefix ;
|
||||||
write
|
|
||||||
write-eoo ;
|
|
||||||
|
|
||||||
: write-oid ( assoc -- )
|
: write-oid ( assoc -- )
|
||||||
[ MDB_OID_FIELD ] dip at*
|
[ MDB_OID_FIELD ] dip at*
|
||||||
|
@ -106,20 +137,16 @@ M: sequence bson-write ( array -- )
|
||||||
{ "_id" "_mdb" } member? ; inline
|
{ "_id" "_mdb" } member? ; inline
|
||||||
|
|
||||||
M: assoc bson-write ( assoc -- )
|
M: assoc bson-write ( assoc -- )
|
||||||
[ binary ] dip
|
|
||||||
'[ _ [ write-oid ] keep
|
'[ _ [ write-oid ] keep
|
||||||
[ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each
|
[ over skip-field? [ 2drop ] [ write-pair ] if ] assoc-each
|
||||||
] with-byte-writer
|
write-eoo ] with-length-prefix ;
|
||||||
[ length 5 + bson-write ] keep
|
|
||||||
write
|
|
||||||
write-eoo ;
|
|
||||||
|
|
||||||
M: word bson-write name>> bson-write ;
|
M: word bson-write name>> bson-write ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: assoc>array ( assoc -- byte-array )
|
: assoc>bv ( assoc -- byte-vector )
|
||||||
'[ _ bson-write ] binary swap with-byte-writer ; inline
|
[ '[ _ bson-write ] with-buffer ] with-scope ; inline
|
||||||
|
|
||||||
: assoc>stream ( assoc -- )
|
: assoc>stream ( assoc -- )
|
||||||
bson-write ; inline
|
bson-write ; inline
|
||||||
|
|
|
@ -1,15 +1,21 @@
|
||||||
USING: mongodb.driver calendar math fry kernel assocs math.ranges
|
USING: calendar math fry kernel assocs math.ranges
|
||||||
sequences formatting combinators namespaces io tools.time prettyprint
|
sequences formatting combinators namespaces io tools.time prettyprint
|
||||||
accessors words ;
|
accessors words mongodb.driver ;
|
||||||
|
|
||||||
IN: mongodb.benchmark
|
IN: mongodb.benchmark
|
||||||
|
|
||||||
SYMBOLS: per-trial batch-size collection host db port ;
|
SYMBOLS: per-trial collection host db port ;
|
||||||
|
|
||||||
: get* ( symbol default -- value )
|
: get* ( symbol default -- value )
|
||||||
[ get ] dip or ; inline
|
[ get ] dip or ; inline
|
||||||
|
|
||||||
TUPLE: result doc index batch lasterror ;
|
: trial-size ( -- size )
|
||||||
|
per-trial 10000 get* ; inline flushable
|
||||||
|
|
||||||
|
: batch-size ( -- size )
|
||||||
|
\ batch-size 100 get* ; inline flushable
|
||||||
|
|
||||||
|
TUPLE: result doc collection index batch lasterror ;
|
||||||
|
|
||||||
: <result> ( -- ) result new result set ; inline
|
: <result> ( -- ) result new result set ; inline
|
||||||
|
|
||||||
|
@ -91,25 +97,34 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
|
||||||
"platform-as-a-service" "technology" "helps"
|
"platform-as-a-service" "technology" "helps"
|
||||||
"developers" "focus" "building" "mongodb" "mongo" } } }
|
"developers" "focus" "building" "mongodb" "mongo" } } }
|
||||||
|
|
||||||
: small-doc ( -- quot: ( i -- doc ) )
|
: set-doc ( name -- )
|
||||||
result [ "small" >>doc ] change
|
[ result ] dip '[ _ >>doc ] change ; inline
|
||||||
DOC-SMALL clone
|
|
||||||
'[ "x" _ [ set-at ] keep ] ; inline
|
|
||||||
|
|
||||||
: medium-doc ( -- quot: ( i -- doc ) )
|
: small-doc ( -- )
|
||||||
result [ "medium" >>doc ] change
|
"small" set-doc ; inline
|
||||||
DOC-MEDIUM clone
|
|
||||||
'[ "x" _ [ set-at ] keep ] ; inline
|
|
||||||
|
|
||||||
: large-doc ( -- quot: ( i -- doc ) )
|
: medium-doc ( -- )
|
||||||
result [ "large" >>doc ] change
|
"medium" set-doc ; inline
|
||||||
DOC-LARGE clone
|
|
||||||
'[ "x" _ [ set-at ] keep
|
: large-doc ( -- )
|
||||||
|
"large" set-doc ; inline
|
||||||
|
|
||||||
|
: small-doc-prepare ( -- quot: ( i -- doc ) )
|
||||||
|
small-doc
|
||||||
|
'[ "x" DOC-SMALL clone [ set-at ] keep ] ; inline
|
||||||
|
|
||||||
|
: medium-doc-prepare ( -- quot: ( i -- doc ) )
|
||||||
|
medium-doc
|
||||||
|
'[ "x" DOC-MEDIUM clone [ set-at ] keep ] ; inline
|
||||||
|
|
||||||
|
: large-doc-prepare ( -- quot: ( i -- doc ) )
|
||||||
|
large-doc
|
||||||
|
[ "x" DOC-LARGE clone [ set-at ] keep
|
||||||
[ now "access-time" ] dip
|
[ now "access-time" ] dip
|
||||||
[ set-at ] keep ] ;
|
[ set-at ] keep ] ;
|
||||||
|
|
||||||
: (insert) ( quot: ( i -- doc ) collection -- )
|
: (insert) ( quot: ( i -- doc ) collection -- )
|
||||||
[ per-trial get ] 2dip
|
[ trial-size ] 2dip
|
||||||
'[ _ call [ _ ] dip
|
'[ _ call [ _ ] dip
|
||||||
result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ; inline
|
result get lasterror>> [ save ] [ save-unsafe ] if ] each-integer ; inline
|
||||||
|
|
||||||
|
@ -118,13 +133,23 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
|
||||||
'[ _ call ] map ; inline
|
'[ _ call ] map ; inline
|
||||||
|
|
||||||
: (insert-batch) ( quot: ( i -- doc ) collection -- )
|
: (insert-batch) ( quot: ( i -- doc ) collection -- )
|
||||||
[ per-trial get batch-size get [ / ] keep ] 2dip
|
[ trial-size batch-size [ / ] keep ] 2dip
|
||||||
'[ _ _ (prepare-batch) [ _ ] dip
|
'[ _ _ (prepare-batch) [ _ ] dip
|
||||||
result get lasterror>> [ save ] [ save-unsafe ] if
|
result get lasterror>> [ save ] [ save-unsafe ] if
|
||||||
] each-integer ; inline
|
] each-integer ; inline
|
||||||
|
|
||||||
: prepare-collection ( -- collection )
|
: bchar ( boolean -- char )
|
||||||
|
[ "t" ] [ "f" ] if ; inline
|
||||||
|
|
||||||
|
: collection-name ( -- collection )
|
||||||
collection "benchmark" get*
|
collection "benchmark" get*
|
||||||
|
result get doc>>
|
||||||
|
result get index>> bchar
|
||||||
|
"%s-%s-%s" sprintf
|
||||||
|
[ [ result get ] dip >>collection drop ] keep ; inline
|
||||||
|
|
||||||
|
: prepare-collection ( -- collection )
|
||||||
|
collection-name
|
||||||
[ "_x_idx" drop-index ] keep
|
[ "_x_idx" drop-index ] keep
|
||||||
[ drop-collection ] keep
|
[ drop-collection ] keep
|
||||||
[ create-collection ] keep ; inline
|
[ create-collection ] keep ; inline
|
||||||
|
@ -138,6 +163,26 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
|
||||||
result get batch>>
|
result get batch>>
|
||||||
[ '[ _ _ (insert-batch) ] ] [ '[ _ _ (insert) ] ] if ;
|
[ '[ _ _ (insert-batch) ] ] [ '[ _ _ (insert) ] ] if ;
|
||||||
|
|
||||||
|
: check-for-key ( assoc key -- )
|
||||||
|
swap key? [ "ups... where's the key" throw ] unless ; inline
|
||||||
|
|
||||||
|
: find-one ( -- quot: ( -- ) )
|
||||||
|
collection-name
|
||||||
|
trial-size 2 / "x" H{ } clone [ set-at ] keep
|
||||||
|
'[ _ _ <query> 1 limit find [ drop ] dip first "x" check-for-key ] ;
|
||||||
|
|
||||||
|
: find-all ( -- quot: ( -- ) )
|
||||||
|
collection-name
|
||||||
|
H{ } clone
|
||||||
|
'[ _ _ <query> find [ "x" check-for-key ] each drop ] ;
|
||||||
|
|
||||||
|
: find-range ( -- quot: ( -- ) )
|
||||||
|
collection-name
|
||||||
|
trial-size 2 / "$gt" H{ } clone [ set-at ] keep
|
||||||
|
[ trial-size 2 / batch-size + "$lt" ] dip [ set-at ] keep
|
||||||
|
"x" H{ } clone [ set-at ] keep
|
||||||
|
'[ _ _ <query> find [ "x" check-for-key ] each drop ] ;
|
||||||
|
|
||||||
: batch ( -- )
|
: batch ( -- )
|
||||||
result [ t >>batch ] change ; inline
|
result [ t >>batch ] change ; inline
|
||||||
|
|
||||||
|
@ -147,46 +192,80 @@ CONSTANT: DOC-LARGE H{ { "base_url" "http://www.example.com/test-me" }
|
||||||
: errcheck ( -- )
|
: errcheck ( -- )
|
||||||
result [ t >>lasterror ] change ; inline
|
result [ t >>lasterror ] change ; inline
|
||||||
|
|
||||||
: bchar ( boolean -- char )
|
|
||||||
[ "t" ] [ "f" ] if ; inline
|
|
||||||
|
|
||||||
: print-result ( time -- )
|
: print-result ( time -- )
|
||||||
[ result get [ doc>> ] keep
|
[ result get [ collection>> ] keep
|
||||||
[ batch>> bchar ] keep
|
[ batch>> bchar ] keep
|
||||||
[ index>> bchar ] keep
|
[ index>> bchar ] keep
|
||||||
lasterror>> bchar
|
lasterror>> bchar
|
||||||
per-trial get ] dip
|
trial-size ] dip
|
||||||
1000000 / /i
|
1000000 / /i
|
||||||
"%-6s: {batch:%s,index:%s;errchk:%s} %7s op/s"
|
"%-18s: {batch:%s,index:%s;errchk:%s} %10s op/s"
|
||||||
sprintf print flush ; inline
|
sprintf print flush ; inline
|
||||||
|
|
||||||
: print-separator ( -- )
|
: print-separator ( -- )
|
||||||
"-----------------------------------------------" print flush ; inline
|
"--------------------------------------------------------------" print flush ; inline
|
||||||
|
|
||||||
|
: print-separator-bold ( -- )
|
||||||
|
"==============================================================" print flush ; inline
|
||||||
|
|
||||||
: print-header ( -- )
|
: print-header ( -- )
|
||||||
per-trial get
|
trial-size
|
||||||
batch-size get
|
batch-size
|
||||||
"MongoDB Factor Driver Benchmark\n%d ops per Trial, Batch-Size: %d\n"
|
"MongoDB Factor Driver Benchmark\n%d ops per Trial, Batch-Size: %d"
|
||||||
sprintf print flush
|
sprintf print flush
|
||||||
print-separator ;
|
print-separator-bold ;
|
||||||
|
|
||||||
: with-result ( quot: ( -- ) -- )
|
: with-result ( quot: ( -- ) -- )
|
||||||
[ <result> ] prepose
|
[ <result> ] prepose
|
||||||
[ print-result ] compose with-scope ; inline
|
[ print-result ] compose with-scope ; inline
|
||||||
|
|
||||||
: run-insert-bench ( doc-word-seq feat-seq -- )
|
: bench-quot ( feat-seq op-word -- quot: ( elt -- ) )
|
||||||
'[ _ swap
|
'[ _ swap _
|
||||||
'[ [ [ _ execute ] dip
|
'[ [ [ _ execute ] dip
|
||||||
[ execute ] each insert benchmark ] with-result ] each
|
[ execute ] each _ execute benchmark ] with-result ] each
|
||||||
print-separator ] each ;
|
print-separator ] ;
|
||||||
|
|
||||||
|
: run-insert-bench ( doc-word-seq feat-seq -- )
|
||||||
|
"Insert Tests" print
|
||||||
|
print-separator-bold
|
||||||
|
\ insert bench-quot each ;
|
||||||
|
|
||||||
|
: run-find-one-bench ( doc-word-seq feat-seq -- )
|
||||||
|
"Query Tests - Find-One" print
|
||||||
|
print-separator-bold
|
||||||
|
\ find-one bench-quot each ;
|
||||||
|
|
||||||
|
: run-find-all-bench ( doc-word-seq feat-seq -- )
|
||||||
|
"Query Tests - Find-All" print
|
||||||
|
print-separator-bold
|
||||||
|
\ find-all bench-quot each ;
|
||||||
|
|
||||||
|
: run-find-range-bench ( doc-word-seq feat-seq -- )
|
||||||
|
"Query Tests - Find-Range" print
|
||||||
|
print-separator-bold
|
||||||
|
\ find-range bench-quot each ;
|
||||||
|
|
||||||
|
|
||||||
: run-benchmarks ( -- )
|
: run-benchmarks ( -- )
|
||||||
db "db" get* host "127.0.0.1" get* port 27020 get* <mdb>
|
db "db" get* host "127.0.0.1" get* port 27020 get* <mdb>
|
||||||
[
|
[
|
||||||
print-header
|
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 }
|
{ small-doc medium-doc large-doc }
|
||||||
{ { } { errcheck } { batch } { batch errcheck }
|
{ { } { index } } run-find-one-bench
|
||||||
{ index } { index errcheck } { batch index errcheck } } run-insert-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 ;
|
] with-db ;
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: accessors assocs fry io.sockets kernel math mongodb.msg formatting linked-assocs destructors continuations
|
USING: accessors assocs fry io.sockets kernel math mongodb.msg formatting linked-assocs destructors continuations
|
||||||
mongodb.operations namespaces sequences splitting math.parser io.encodings.binary combinators io.streams.duplex
|
mongodb.operations namespaces sequences splitting math.parser io.encodings.binary combinators io.streams.duplex
|
||||||
arrays io memoize constructors sets strings uuid ;
|
arrays io memoize constructors sets strings uuid bson.writer ;
|
||||||
|
|
||||||
IN: mongodb.driver
|
IN: mongodb.driver
|
||||||
|
|
||||||
|
@ -52,7 +52,7 @@ SYMBOL: mdb-instance
|
||||||
nodes>> [ f ] dip at inet>> ;
|
nodes>> [ f ] dip at inet>> ;
|
||||||
|
|
||||||
: with-db ( mdb quot -- ... )
|
: with-db ( mdb quot -- ... )
|
||||||
[ [ '[ _ [ mdb-instance set ] keep master>>
|
[ [ '[ _ [ mdb-instance set ensure-buffer ] keep master>>
|
||||||
[ remote-address set ] keep
|
[ remote-address set ] keep
|
||||||
binary <client>
|
binary <client>
|
||||||
local-address set
|
local-address set
|
||||||
|
|
|
@ -3,6 +3,10 @@ io io.binary io.encodings.binary io.encodings.string io.encodings.utf8
|
||||||
io.streams.byte-array kernel math mongodb.msg namespaces sequences
|
io.streams.byte-array kernel math mongodb.msg namespaces sequences
|
||||||
locals assocs combinators linked-assocs ;
|
locals assocs combinators linked-assocs ;
|
||||||
|
|
||||||
|
IN: alien.c-types
|
||||||
|
|
||||||
|
M: byte-vector byte-length length ;
|
||||||
|
|
||||||
IN: mongodb.operations
|
IN: mongodb.operations
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -129,8 +133,7 @@ M: mdb-reply-op (read-message) ( msg-stub opcode -- message )
|
||||||
read-int32 >>opcode
|
read-int32 >>opcode
|
||||||
read-int32 >>flags ; inline
|
read-int32 >>flags ; inline
|
||||||
|
|
||||||
: write-header ( message length -- )
|
: write-header ( message -- )
|
||||||
MSG-HEADER-SIZE + write-int32
|
|
||||||
[ req-id>> write-int32 ] keep
|
[ req-id>> write-int32 ] keep
|
||||||
[ resp-id>> write-int32 ] keep
|
[ resp-id>> write-int32 ] keep
|
||||||
opcode>> write-int32 ; inline
|
opcode>> write-int32 ; inline
|
||||||
|
@ -145,10 +148,11 @@ PRIVATE>
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
USE: tools.walker
|
||||||
|
|
||||||
: (write-message) ( message quot -- )
|
: (write-message) ( message quot -- )
|
||||||
[ binary ] dip with-byte-writer
|
'[ [ [ _ write-header ] dip _ call ] with-length-prefix ] with-buffer
|
||||||
[ length write-header ] keep
|
write flush reset-buffer ; inline
|
||||||
write flush ; inline
|
|
||||||
|
|
||||||
: build-query-object ( query -- selector )
|
: build-query-object ( query -- selector )
|
||||||
[let | selector [ H{ } clone ] |
|
[let | selector [ H{ } clone ] |
|
||||||
|
@ -158,7 +162,7 @@ PRIVATE>
|
||||||
[ query>> "query" selector set-at ]
|
[ query>> "query" selector set-at ]
|
||||||
} cleave
|
} cleave
|
||||||
selector
|
selector
|
||||||
] ;
|
] ; inline flushable
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -169,8 +173,8 @@ M: mdb-query-msg write-message ( message -- )
|
||||||
[ collection>> write-cstring ] keep
|
[ collection>> write-cstring ] keep
|
||||||
[ skip#>> write-int32 ] keep
|
[ skip#>> write-int32 ] keep
|
||||||
[ return#>> write-int32 ] keep
|
[ return#>> write-int32 ] keep
|
||||||
[ build-query-object assoc>array write ] keep
|
[ build-query-object assoc>stream ] keep
|
||||||
returnfields>> [ assoc>array write ] when*
|
returnfields>> [ assoc>stream ] when*
|
||||||
] (write-message) ;
|
] (write-message) ;
|
||||||
|
|
||||||
M: mdb-insert-msg write-message ( message -- )
|
M: mdb-insert-msg write-message ( message -- )
|
||||||
|
@ -178,7 +182,7 @@ M: mdb-insert-msg write-message ( message -- )
|
||||||
'[ _
|
'[ _
|
||||||
[ flags>> write-int32 ] keep
|
[ flags>> write-int32 ] keep
|
||||||
[ collection>> write-cstring ] keep
|
[ collection>> write-cstring ] keep
|
||||||
objects>> [ assoc>array write ] each
|
objects>> [ assoc>stream ] each
|
||||||
] (write-message) ;
|
] (write-message) ;
|
||||||
|
|
||||||
M: mdb-update-msg write-message ( message -- )
|
M: mdb-update-msg write-message ( message -- )
|
||||||
|
@ -187,8 +191,8 @@ M: mdb-update-msg write-message ( message -- )
|
||||||
[ flags>> write-int32 ] keep
|
[ flags>> write-int32 ] keep
|
||||||
[ collection>> write-cstring ] keep
|
[ collection>> write-cstring ] keep
|
||||||
[ upsert?>> write-int32 ] keep
|
[ upsert?>> write-int32 ] keep
|
||||||
[ selector>> assoc>array write ] keep
|
[ selector>> assoc>stream ] keep
|
||||||
object>> assoc>array write
|
object>> assoc>stream
|
||||||
] (write-message) ;
|
] (write-message) ;
|
||||||
|
|
||||||
M: mdb-delete-msg write-message ( message -- )
|
M: mdb-delete-msg write-message ( message -- )
|
||||||
|
@ -197,7 +201,7 @@ M: mdb-delete-msg write-message ( message -- )
|
||||||
[ flags>> write-int32 ] keep
|
[ flags>> write-int32 ] keep
|
||||||
[ collection>> write-cstring ] keep
|
[ collection>> write-cstring ] keep
|
||||||
0 write-int32
|
0 write-int32
|
||||||
selector>> assoc>array write
|
selector>> assoc>stream
|
||||||
] (write-message) ;
|
] (write-message) ;
|
||||||
|
|
||||||
M: mdb-getmore-msg write-message ( message -- )
|
M: mdb-getmore-msg write-message ( message -- )
|
||||||
|
|
Loading…
Reference in New Issue