diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor index a41fc1e6c3..d0977dd3d0 100644 --- a/basis/io/sockets/sockets-docs.factor +++ b/basis/io/sockets/sockets-docs.factor @@ -34,6 +34,10 @@ ARTICLE: "network-connection" "Connection-oriented networking" with-client } +"The local address of a client socket can be controlled with this word:" +{ $subsections + with-local-address +} "Connection-oriented network servers are implemented by first opening a server socket, then waiting for connections:" { $subsections @@ -215,3 +219,17 @@ HELP: send HELP: resolve-host { $values { "addrspec" "an address specifier" } { "seq" "a sequence of address specifiers" } } { $description "Resolves host names to IP addresses." } ; + +HELP: with-local-address +{ $values { "addr" "an " { $link inet4 } " or " { $link inet6 } " address specifier" } { "quot" quotation } } +{ $description "Client sockets opened within the scope of the quotation passed to this combinator will have their local address bound to the given address." } +{ $examples + { "Binds the local address of a newly created client socket within the quotation to 127.0.0.1." + "This ensures that all traffic originates from the given address (the port is choosen by the TCP stack)." } + { $code "\"127.0.0.1\" 0 [ ] with-local-address" } + $nl + { "Binds the local address of a newly created client socket within the quotation to the local address 192.168.0.1 and the local port 23000. " + "Be aware that you can only have one client socket with the same local address at a time or else an I/O error (\"address already in use\") will be thrown." + } + { $code "\"192.168.0.1\" 23000 [ ] with-local-address" } +} ; diff --git a/basis/tools/disassembler/udis/udis-tests.factor b/basis/tools/disassembler/udis/udis-tests.factor index df3ef41365..522893f368 100644 --- a/basis/tools/disassembler/udis/udis-tests.factor +++ b/basis/tools/disassembler/udis/udis-tests.factor @@ -2,8 +2,7 @@ IN: tools.disassembler.udis.tests USING: tools.disassembler.udis tools.test alien.c-types system combinators kernel ; { - { [ os linux? cpu x86.64? and ] [ [ 656 ] [ ud heap-size ] unit-test ] } - { [ os macosx? cpu x86.32? and ] [ [ 592 ] [ ud heap-size ] unit-test ] } - { [ os macosx? cpu x86.64? and ] [ [ 656 ] [ ud heap-size ] unit-test ] } + { [ cpu x86.32? ] [ [ 604 ] [ ud heap-size ] unit-test ] } + { [ cpu x86.64? ] [ [ 672 ] [ ud heap-size ] unit-test ] } [ ] } cond \ No newline at end of file diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index e998a5cfdb..8cf885f583 100644 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -67,7 +67,11 @@ STRUCT: ud { c3 uchar } { inp_cache uchar[256] } { inp_sess uchar[64] } - { itab_entry void* } ; + { have_modrm uchar } + { modrm uchar } + { user_opaque_data void* } + { itab_entry void* } + { le void* } ; FUNCTION: void ud_translate_intel ( ud* u ) ; FUNCTION: void ud_translate_att ( ud* u ) ; diff --git a/extra/bson/constants/constants.factor b/extra/bson/constants/constants.factor index 2d126857c3..e4bf14432a 100644 --- a/extra/bson/constants/constants.factor +++ b/extra/bson/constants/constants.factor @@ -19,6 +19,16 @@ TUPLE: oid { a initial: 0 } { b initial: 0 } ; TUPLE: dbref ref id db ; +TUPLE: mongo-timestamp incr seconds ; + +: ( incr seconds -- mongo-timestamp ) + mongo-timestamp boa ; + +TUPLE: mongo-scoped-code code object ; + +: ( code object -- mongo-scoped-code ) + mongo-scoped-code boa ; + CONSTRUCTOR: dbref ( ref id -- dbref ) ; : dbref>assoc ( dbref -- assoc ) @@ -47,30 +57,31 @@ TUPLE: mdbregexp { regexp string } { options string } ; CONSTANT: MDB_OID_FIELD "_id" CONSTANT: MDB_META_FIELD "_mfd" -CONSTANT: T_EOO 0 -CONSTANT: T_Double 1 -CONSTANT: T_Integer 16 -CONSTANT: T_Boolean 8 -CONSTANT: T_String 2 -CONSTANT: T_Object 3 -CONSTANT: T_Array 4 -CONSTANT: T_Binary 5 -CONSTANT: T_Undefined 6 -CONSTANT: T_OID 7 -CONSTANT: T_Date 9 -CONSTANT: T_NULL 10 -CONSTANT: T_Regexp 11 -CONSTANT: T_DBRef 12 -CONSTANT: T_Code 13 -CONSTANT: T_ScopedCode 17 -CONSTANT: T_Symbol 14 -CONSTANT: T_JSTypeMax 16 -CONSTANT: T_MaxKey 127 - -CONSTANT: T_Binary_Function 1 -CONSTANT: T_Binary_Bytes 2 -CONSTANT: T_Binary_UUID 3 -CONSTANT: T_Binary_MD5 5 -CONSTANT: T_Binary_Custom 128 +CONSTANT: T_EOO 0 +CONSTANT: T_Double HEX: 1 +CONSTANT: T_String HEX: 2 +CONSTANT: T_Object HEX: 3 +CONSTANT: T_Array HEX: 4 +CONSTANT: T_Binary HEX: 5 +CONSTANT: T_Undefined HEX: 6 +CONSTANT: T_OID HEX: 7 +CONSTANT: T_Boolean HEX: 8 +CONSTANT: T_Date HEX: 9 +CONSTANT: T_NULL HEX: A +CONSTANT: T_Regexp HEX: B +CONSTANT: T_DBRef HEX: C +CONSTANT: T_Code HEX: D +CONSTANT: T_Symbol HEX: E +CONSTANT: T_ScopedCode HEX: F +CONSTANT: T_Integer HEX: 10 +CONSTANT: T_Timestamp HEX: 11 +CONSTANT: T_Integer64 HEX: 12 +CONSTANT: T_MinKey HEX: FF +CONSTANT: T_MaxKey HEX: 7F +CONSTANT: T_Binary_Function HEX: 1 +CONSTANT: T_Binary_Bytes HEX: 2 +CONSTANT: T_Binary_UUID HEX: 3 +CONSTANT: T_Binary_MD5 HEX: 5 +CONSTANT: T_Binary_Custom HEX: 80 diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor index e0cf0bc4f4..852f46f951 100644 --- a/extra/bson/reader/reader.factor +++ b/extra/bson/reader/reader.factor @@ -10,65 +10,46 @@ FROM: typed => TYPED: ; IN: bson.reader +SYMBOL: state + +DEFER: stream>assoc + ( exemplar -- state ) - [ state new ] dip - { - [ clone >>exemplar ] - [ clone >>result ] - [ V{ } clone [ push ] keep >>scope ] - } cleave - (prepare-elements) >>elements ; - -TYPED: get-state ( -- state: state ) - state get ; inline - -TYPED: read-int32 ( -- int32: integer ) +: read-int32 ( -- int32 ) 4 read signed-le> ; inline -TYPED: read-longlong ( -- longlong: integer ) +: read-longlong ( -- longlong ) 8 read signed-le> ; inline -TYPED: read-double ( -- double: float ) +: read-double ( -- double ) 8 read le> bits>double ; inline -TYPED: read-byte-raw ( -- byte-raw: byte-array ) +: read-byte-raw ( -- byte-raw ) 1 read ; inline -TYPED: read-byte ( -- byte: integer ) +: read-byte ( -- byte ) read-byte-raw first ; inline -TYPED: read-cstring ( -- string: string ) +: read-cstring ( -- string ) "\0" read-until drop >string ; inline -TYPED: read-sized-string ( length: integer -- string: string ) +: read-sized-string ( length -- string ) read 1 head-slice* >string ; inline -TYPED: push-element ( type: integer name: string state: state -- ) - [ element boa ] dip elements>> push ; inline +: read-timestamp ( -- timestamp ) + 8 read [ 4 head signed-le> ] [ 4 tail signed-le> ] bi ; -TYPED: pop-element ( state: state -- element: element ) - elements>> pop ; inline +: object-result ( quot -- object ) + [ + state get clone + [ clear-assoc ] [ ] [ ] tri state + ] dip with-variable ; inline -TYPED: peek-scope ( state: state -- ht ) - scope>> last ; inline - -: bson-object-data-read ( -- object ) - read-int32 drop get-state - [ exemplar>> clone dup ] [ scope>> ] bi push ; inline +: bson-object-data-read ( -- ) + read-int32 drop read-elements ; inline recursive : bson-binary-read ( -- binary ) read-int32 read-byte @@ -86,68 +67,35 @@ TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp ) TYPED: bson-oid-read ( -- oid: oid ) read-longlong read-int32 oid boa ; inline -TYPED: element-data-read ( type: integer -- object ) - { - { T_OID [ bson-oid-read ] } - { T_String [ read-int32 read-sized-string ] } - { T_Integer [ read-int32 ] } - { T_Binary [ bson-binary-read ] } - { T_Object [ bson-object-data-read ] } - { T_Array [ bson-object-data-read ] } - { T_Double [ read-double ] } - { T_Boolean [ read-byte 1 = ] } - { T_Date [ read-longlong millis>timestamp ] } - { T_Regexp [ bson-regexp-read ] } - { T_NULL [ f ] } - } case ; inline - -TYPED: bson-array? ( type: integer -- ?: boolean ) - T_Array = ; inline - -TYPED: bson-object? ( type: integer -- ?: boolean ) - T_Object = ; inline - : check-object ( assoc -- object ) dup dbref-assoc? [ assoc>dbref ] when ; inline -TYPED: fix-result ( assoc type: integer -- result ) +TYPED: element-data-read ( type: integer -- object ) { - { T_Array [ values ] } - { T_Object [ check-object ] } - } case ; inline + { T_OID [ bson-oid-read ] } + { T_String [ read-int32 read-sized-string ] } + { T_Integer [ read-int32 ] } + { T_Integer64 [ read-longlong ] } + { T_Binary [ bson-binary-read ] } + { T_Object [ [ bson-object-data-read ] object-result check-object ] } + { T_Array [ [ bson-object-data-read ] object-result values ] } + { T_Double [ read-double ] } + { T_Boolean [ read-byte 1 = ] } + { T_Date [ read-longlong millis>timestamp ] } + { T_Regexp [ bson-regexp-read ] } + { T_Timestamp [ read-timestamp ] } + { T_Code [ read-int32 read-sized-string ] } + { T_ScopedCode [ read-int32 drop read-cstring H{ } clone stream>assoc ] } + { T_NULL [ f ] } + } case ; inline recursive -TYPED: end-element ( type: integer -- ) - { [ bson-object? ] [ bson-array? ] } 1|| - [ get-state pop-element drop ] unless ; inline - -TYPED: (>state<) ( -- state: state scope: vector element: element ) - get-state [ ] [ scope>> ] [ pop-element ] tri ; inline - -TYPED: (prepare-result) ( scope: vector element: element -- result ) - [ pop ] [ type>> ] bi* fix-result ; inline - -: bson-eoo-element-read ( -- cont?: boolean ) - (>state<) - [ (prepare-result) ] [ ] [ drop empty? ] 2tri - [ 2drop >>result drop f ] - [ swap [ name>> ] [ last ] bi* set-at drop t ] if ; inline - -TYPED: (prepare-object) ( type: integer -- object ) - [ element-data-read ] [ end-element ] bi ; inline - -:: (read-object) ( type name state -- ) - state peek-scope :> scope - type (prepare-object) name scope set-at ; inline - -TYPED: bson-not-eoo-element-read ( type: integer -- cont?: boolean ) - read-cstring get-state - [ push-element ] - [ (read-object) t ] 3bi ; inline +TYPED: (read-object) ( type: integer name: string -- ) + [ element-data-read ] dip state get set-at ; inline recursive TYPED: (element-read) ( type: integer -- cont?: boolean ) dup T_EOO > - [ bson-not-eoo-element-read ] - [ drop bson-eoo-element-read ] if ; inline + [ read-cstring (read-object) t ] + [ drop f ] if ; inline recursive : read-elements ( -- ) read-byte (element-read) @@ -156,6 +104,6 @@ TYPED: (element-read) ( type: integer -- cont?: boolean ) PRIVATE> : stream>assoc ( exemplar -- assoc ) - read-int32 >>size - [ state [ read-elements ] with-variable ] - [ result>> ] bi ; + clone [ + state [ bson-object-data-read ] with-variable + ] keep ; diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 8d3990fcd8..d54b0cd337 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/misc/fuel/fuel-font-lock.el @@ -59,6 +59,7 @@ (ratio constant "ratios") (declaration keyword "declaration words") (ebnf-form constant "EBNF: ... ;EBNF form") + (error-form warning "ERROR: ... ; form") (parsing-word keyword "parsing words") (postpone-body comment "postponed form") (setter-word function-name "setter words (>>foo)") @@ -101,6 +102,9 @@ (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word) (,fuel-syntax--alien-function-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) + (,fuel-syntax--alien-function-alias-regex (1 'factor-font-lock-word) + (2 'factor-font-lock-type-name) + (3 'factor-font-lock-word)) (,fuel-syntax--alien-callback-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) (,fuel-syntax--vocab-ref-regexp 2 'factor-font-lock-vocabulary-name) @@ -111,6 +115,11 @@ (,fuel-syntax--typedef-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-type-name) (3 'factor-font-lock-invalid-syntax nil t)) + (,fuel-syntax--c-global-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-word) + (3 'factor-font-lock-invalid-syntax nil t)) + (,fuel-syntax--c-type-regex (1 'factor-font-lock-type-name) + (2 'factor-font-lock-invalid-syntax nil t)) (,fuel-syntax--rename-regex (1 'factor-font-lock-word) (2 'factor-font-lock-vocabulary-name) (3 'factor-font-lock-word) @@ -124,6 +133,7 @@ (,fuel-syntax--float-regex . 'factor-font-lock-number) (,fuel-syntax--ratio-regex . 'factor-font-lock-ratio) (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name) + (,fuel-syntax--error-regex 2 'factor-font-lock-error-form) (,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name) (2 'factor-font-lock-word)) (,fuel-syntax--before-definition-regex (1 'factor-font-lock-type-name) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index 80010235b1..e2db30db3d 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -47,10 +47,10 @@ '(":" "::" ";" "&:" "<<" ">" "ABOUT:" "AFTER:" "ALIAS:" "ALIEN:" "ARTICLE:" "B" "BEFORE:" "BIN:" - "C:" "CALLBACK:" "ENUM:" "C-TYPE:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "CONSULT:" "call-next-method" - "DEFER:" - "EBNF:" ";EBNF" "ERROR:" "EXCLUDE:" - "f" "FORGET:" "FROM:" "FUNCTION:" + "C:" "CALLBACK:" "C-GLOBAL:" "C-TYPE:" "CHAR:" "COM-INTERFACE:" "CONSTANT:" "CONSULT:" "call-next-method" + "DEFER:" "DESTRUCTOR:" + "EBNF:" ";EBNF" "ENUM:" "ERROR:" "EXCLUDE:" + "f" "FORGET:" "FROM:" "FUNCTION:" "FUNCTION-ALIAS:" "GAME:" "GENERIC#" "GENERIC:" "GLSL-SHADER:" "GLSL-PROGRAM:" "HELP:" "HEX:" "HOOK:" @@ -135,6 +135,9 @@ (fuel-syntax--second-word-regex '("C-STRUCT:" "C-UNION:" "COM-INTERFACE:" "MIXIN:" "TUPLE:" "SINGLETON:" "SPECIALIZED-ARRAY:" "STRUCT:" "UNION:" "UNION-STRUCT:"))) +(defconst fuel-syntax--error-regex + (fuel-syntax--second-word-regex '("ERROR:"))) + (defconst fuel-syntax--tuple-decl-regex "^TUPLE: +\\([^ \n]+\\) +< +\\([^ \n]+\\)\\_>") @@ -158,15 +161,19 @@ (defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$") (defconst fuel-syntax--alien-function-regex - "\\_ +\\(\\w+\\)\\( .*\\)?$")