Added stack effect parser for reflection

client-tests.fs

@@ -104,7 +104,7 @@ UValue test#  0 to test#
       "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 ( -- )
@@ -115,7 +115,7 @@ UValue test#  0 to test#
       $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 ( -- )
@@ -138,7 +138,7 @@ UValue test#  0 to test#
       $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 ( -- )

net2o-cmd.fs

@@ -161,11 +161,13 @@ Defer gen-table
 
 : 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
@@ -244,10 +246,11 @@ User cmdbuf#
 : 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
@@ -261,10 +264,18 @@ Defer net2o:words
 
 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
@@ -275,7 +286,7 @@ get-current also net2o-base definitions previous
     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 ;
@@ -286,6 +297,7 @@ get-current also net2o-base definitions previous
 +net2o: words ( ustart -- ) \ reflection
     64>n net2o:words ;
 
+previous
 dup set-current
 
 gen-table $freeze
@@ -493,9 +505,10 @@ $10 net2o: <req ( -- ) ; \ stub: push own id in reply
 :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
 
@@ -572,8 +585,8 @@ net2o-base
     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
@@ -700,7 +713,7 @@ gen-table $freeze
 
 \ 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
@@ -750,11 +763,11 @@ reply-table $@ inherit-table log-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. ;
@@ -781,8 +794,6 @@ log-table >table
 
 \ safe initialization
 
-net2o-base
-
 : lit<   lit, push-lit ;
 : slit<  slit, push-slit ;
 :noname ( throwcode -- )
@@ -791,9 +802,7 @@ net2o-base
 	    ['] 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> ;

net2o-crypt.fs

@@ -300,7 +300,7 @@ Defer search-key \ search if that is one of our pubkeys
     ?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-dht.fs

@@ -302,8 +302,8 @@ reply-table $@ inherit-table dht-table
 
 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

net2o-msg.fs

@@ -17,7 +17,7 @@
 
 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

net2o.fs

@@ -2311,6 +2311,8 @@ $10 Constant tmp-crypt-val
 	crypto-key sec-off
 	data-resend $off
 	dest-pubkey $off
+	pubkey $off
+	mpubkey $off
 	log-context @ .dispose
 	ack-context @ >o timing-stat $off track-timing $off dispose o>
 	dispose  0 to connection