Added stack effect parser for reflection

      "data/2011-06-27_19-33-04-small.jpg" "photo006s.jpg" >cache n2o:copy

      "data/2011-06-27_19-55-48-small.jpg" "photo007s.jpg" >cache n2o:copy

      "data/2011-06-28_06-54-09-small.jpg" "photo008s.jpg" >cache n2o:copy

      n2o:done

      n2o:done push' log log $20 ulit, words endwith push' cr push' endwith

    end-code| n2o:close-all ['] .time $err ;

: c:download3 ( -- )

      $10000 blocksize! $400 blockalign! stat( request-stats )

      "data/2011-05-13_11-26-57.jpg" "photo000.jpg" >cache n2o:copy

      "data/2011-05-20_17-01-12.jpg" "photo001.jpg" >cache n2o:copy

      n2o:done

      n2o:done push' log 0 file-id $20 ulit, words endwith push' cr push' endwith

    end-code| n2o:close-all ['] .time $err ;

: c:download4 ( -- )

      $50000. 4 limit!

      $60000. 5 limit!

      $70000. 6 limit!

      n2o:done

      n2o:done push' log "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" $, dht-id $20 ulit, words endwith push' cr push' endwith

    end-code| ['] .time $err ;

: c:download4a ( -- )

: cmd@ ( -- u ) buf-state 2@ over + >r p@+ r> over - buf-state 2! 64>n ;

-5 cells 0 +field net2o.name

-6 dup 1+ 1 and cell 4 = and - cells 0 +field net2o.name

drop

: >net2o-name ( addr -- addr' u )

    net2o.name body> name>string ;

: >net2o-sig ( addr -- addr' u )

    net2o.name 3 cells + $@ ;

: (net2o-see) ( addr -- )  @

    dup 0<> IF

: net2o: ( number "name" -- )

    ['] noop over >cmd \ allocate space in table

    Create  here to last-2o

    dup >r , here >r 0 , 0 , net2o-does noname :

    dup >r , here >r 0 , 0 , 0 , net2o-does noname :

    lastxt dup r> ! r> >cmd ;

: +net2o: ( "name" -- ) gen-table $[]# net2o: ;

: >table ( table -- )  last-2o 2 cells + ! ;

: cmdsig ( -- addr )  last-2o 3 cells + ;

: net2o' ( "name" -- ) ' >body @ ;

: F also forth parse-name parser1 execute previous ; immediate

Vocabulary net2o-base

get-current also net2o-base definitions previous

get-current also net2o-base definitions

\ Command numbers preliminary and subject to change

: ( ( "type"* "--" "type"* "rparen" -- ) ')' parse 2drop ;

comp: drop cmdsig @ IF  ')' parse 2drop  EXIT  THEN

    s" (" cmdsig $!

    BEGIN  parse-name dup  WHILE  over c@ cmdsig c$+!

	s" )" str= UNTIL  ELSE  2drop  THEN

    \ cmdsig $freeze

;

0 net2o: dummy ( -- ) ; \ alias

0 net2o: end-cmd ( -- ) 0 buf-state ! ;

+net2o: ulit ( #u -- u ) \ unsigned literal

    string@ ;

+net2o: flit ( #dfloat -- r ) \ double float literal

    pf@ ;

+net2o: endwith ( o:object -- ) \ last command in buffer

+net2o: endwith ( o:object -- ) \ end scope

    n:o> ;

+net2o: oswap ( o:nest o:current -- o:current o:nest )

    n:oswap ;

+net2o: words ( ustart -- ) \ reflection

    64>n net2o:words ;

previous

dup set-current

gen-table $freeze

:noname ( start -- )

    token-table $@ 2 pick cells safe/string bounds U+DO

	I @ ?dup-IF

	    >net2o-name dup $A0 + maxstring < IF

		2 pick ulit, [: type ." (-)" ;] $tmp $, token

	    ELSE  2drop  THEN

	    dup >net2o-sig 2>r >net2o-name

	    dup $A0 + maxstring < IF

		2 pick ulit, 2r> 2swap [: type type ;] $tmp $, token

	    ELSE  2drop rdrop rdrop  THEN

	THEN  1+

    cell +LOOP  drop ; IS net2o:words

    pkc keysize $, receive-key ;

+net2o: tmpkey-request ( -- ) \ request ephemeral key

    stpkc keysize $, receive-tmpkey nest[ ;

+net2o: keypair ( $:yourkey $:mykey -- ) $> $> 2swap \ select a pubkey

    tmp-crypt? IF  net2o:keypair  ELSE  2drop 2drop  THEN ;

+net2o: keypair ( $:yourkey $:mykey -- ) \ select a pubkey

    $> $> tmp-crypt? IF  2swap net2o:keypair  ELSE  2drop 2drop  THEN ;

+net2o: update-key ( -- ) \ update secrets

    net2o:update-key ;

+net2o: gen-ivs ( $:string -- ) \ generate IVs

\ flow control functions

$31 net2o: ack ( -- )  ack-context @ n:>o ;

$31 net2o: ack ( -- o:acko )  ack-context @ n:>o ;

ack-table >table

reply-table $@ inherit-table ack-table

net2o' token net2o: log-token ( $:token n -- )

    64>n 0 .r ." :" $> F type space ;

$20 net2o: emit ( xc -- ) \ emit character on server log

$20 net2o: emit ( utf8 -- ) \ emit character on server log

    64>n xemit ;

+net2o: type ( $:string -- ) \ type string on server log

    $> F type ;

+net2o: . ( u -- ) \ print number on server log

+net2o: . ( n -- ) \ print number on server log

    64. ;

+net2o: f. ( -- ) \ print fp number on server log

    F f. ;

\ safe initialization

net2o-base

: lit<   lit, push-lit ;

: slit<  slit, push-slit ;

:noname ( throwcode -- )

	    ['] end-cmd IS expect-reply? (end-code)  THEN

    THEN  throw ; IS >throw

set-current previous

also net2o-base

set-current

: open-tracked-file ( addr u mode --)

    open-file <req get-size get-stat req> ;

    ?keysize dup keysize [: check-key ;] $err

    dup keysize pubkey $! r> key-stage2 ;

: net2o:receive-key ( addr u -- )

    o 0= IF  2drop EXIT  THEN  skc key-rest ;

    o 0= IF  2drop EXIT  THEN  pkc keysize mpubkey $! skc key-rest ;

: net2o:keypair ( pkc uc pk u -- )

    o 0= IF  2drop EXIT  THEN

    2dup mpubkey $! ?keysize search-key key-rest ;

net2o' <req net2o: <req-dht ( -- ) dht-hash $@ $, dht-id ; \ redefine <req

net2o' emit net2o: dht-host+ ( $:string -- ) $> d#host+ ;

+net2o: dht-tags+ ( $:string -- ) $> d#tags+ ;

+net2o: dht-host- ( $:string -- ) $> d#host- ;

+net2o: dht-tags+ ( $:string -- ) $> d#tags+ ;

+net2o: dht-tags- ( $:string -- ) $> d#tags- ;

set-current

get-current also net2o-base definitions

$34 net2o: msg ( -- ) \ push a message object

$34 net2o: msg ( -- o:msg ) \ push a message object

    msg-context @ n:>o buf-state 2@ msg-buf 2! ;

msg-table >table