0000: 5c 20 67 65 6e 65 72 69 63 20 6e 65 74 32 6f 20 \ generic net2o
0010: 63 6f 6d 6d 61 6e 64 20 69 6e 74 65 72 70 72 65 command interpre
0020: 74 65 72 0a 0a 5c 20 43 6f 70 79 72 69 67 68 74 ter..\ Copyright
0030: 20 28 43 29 20 32 30 31 31 2d 32 30 31 34 20 20 (C) 2011-2014
0040: 20 42 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c Bernd Paysan..\
0050: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0060: 20 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 free software:
0070: 79 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 you can redistri
0080: 62 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d bute it and/or m
0090: 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 odify.\ it under
00a0: 20 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 the terms of th
00b0: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e e GNU Affero Gen
00c0: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
00d0: 6e 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 nse as published
00e0: 20 62 79 0a 5c 20 74 68 65 20 46 72 65 65 20 53 by.\ the Free S
00f0: 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 oftware Foundati
0100: 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 on, either versi
0110: 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 on 3 of the Lice
0120: 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f nse, or.\ (at yo
0130: 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c ur option) any l
0140: 61 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c ater version...\
0150: 20 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 This program is
0160: 20 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 distributed in
0170: 74 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 the hope that it
0180: 20 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c will be useful,
0190: 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 .\ but WITHOUT A
01a0: 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 NY WARRANTY; wit
01b0: 68 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d hout even the im
01c0: 70 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f plied warranty o
01d0: 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 4c f.\ MERCHANTABIL
01e0: 49 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 ITY or FITNESS F
01f0: 4f 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 OR A PARTICULAR
0200: 50 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 PURPOSE. See th
0210: 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 47 e.\ GNU Affero G
0220: 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 eneral Public Li
0230: 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 cense for more d
0240: 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 etails...\ You s
0250: 68 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 hould have recei
0260: 76 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 ved a copy of th
0270: 65 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e e GNU Affero Gen
0280: 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 eral Public Lice
0290: 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 nse.\ along with
02a0: 20 74 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 this program.
02b0: 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 If not, see <htt
02c0: 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f p://www.gnu.org/
02d0: 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71 licenses/>...req
02e0: 75 69 72 65 20 73 65 74 2d 63 6f 6d 70 73 65 6d uire set-compsem
02f0: 2e 66 73 0a 0a 5c 20 6e 65 74 32 6f 20 63 6f 6d .fs..\ net2o com
0300: 6d 61 6e 64 73 20 61 72 65 20 70 72 6f 74 6f 62 mands are protob
0310: 75 66 20 63 6f 64 65 64 2c 20 6e 6f 74 20 62 79 uf coded, not by
0320: 74 65 20 63 6f 64 65 64 2e 0a 0a 75 73 74 61 63 te coded...ustac
0330: 6b 20 73 74 72 69 6e 67 2d 73 74 61 63 6b 0a 75 k string-stack.u
0340: 73 74 61 63 6b 20 6f 62 6a 65 63 74 2d 73 74 61 stack object-sta
0350: 63 6b 0a 75 73 74 61 63 6b 20 74 2d 73 74 61 63 ck.ustack t-stac
0360: 6b 0a 75 73 74 61 63 6b 20 6e 65 73 74 2d 73 74 k.ustack nest-st
0370: 61 63 6b 0a 0a 5c 20 63 6f 6d 6d 61 6e 64 20 62 ack..\ command b
0380: 75 66 66 65 72 73 0a 0a 55 73 65 72 20 62 75 66 uffers..User buf
0390: 2d 73 74 61 74 65 20 63 65 6c 6c 20 75 61 6c 6c -state cell uall
03a0: 6f 74 20 64 72 6f 70 0a 55 73 65 72 20 62 75 66 ot drop.User buf
03b0: 2d 64 75 6d 70 20 20 63 65 6c 6c 20 75 61 6c 6c -dump cell uall
03c0: 6f 74 20 64 72 6f 70 0a 0a 75 73 65 72 2d 6f 20 ot drop..user-o
03d0: 63 6d 64 62 75 66 2d 6f 0a 0a 6f 62 6a 65 63 74 cmdbuf-o..object
03e0: 20 63 6c 61 73 73 0a 20 20 20 20 63 65 6c 6c 20 class. cell
03f0: 75 76 61 72 20 63 6d 64 62 75 66 23 0a 20 20 20 uvar cmdbuf#.
0400: 20 63 65 6c 6c 20 75 76 61 72 20 63 6d 64 2d 72 cell uvar cmd-r
0410: 65 70 6c 79 2d 78 74 0a 0a 20 20 20 20 75 6d 65 eply-xt.. ume
0420: 74 68 6f 64 20 63 6d 64 6c 6f 63 6b 0a 20 20 20 thod cmdlock.
0430: 20 75 6d 65 74 68 6f 64 20 63 6d 64 62 75 66 24 umethod cmdbuf$
0440: 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 63 6d 64 . umethod cmd
0450: 72 65 73 65 74 0a 20 20 20 20 75 6d 65 74 68 6f reset. umetho
0460: 64 20 6d 61 78 73 74 72 69 6e 67 0a 20 20 20 20 d maxstring.
0470: 75 6d 65 74 68 6f 64 20 2b 63 6d 64 62 75 66 0a umethod +cmdbuf.
0480: 20 20 20 20 75 6d 65 74 68 6f 64 20 2d 63 6d 64 umethod -cmd
0490: 62 75 66 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 buf. umethod
04a0: 63 6d 64 64 65 73 74 0a 65 6e 64 2d 63 6c 61 73 cmddest.end-clas
04b0: 73 20 63 6d 64 2d 62 75 66 2d 63 0a 0a 3a 20 63 s cmd-buf-c..: c
04c0: 6d 64 62 75 66 3a 20 28 20 61 64 64 72 20 2d 2d mdbuf: ( addr --
04d0: 20 29 20 20 43 72 65 61 74 65 20 2c 20 44 4f 45 ) Create , DOE
04e0: 53 3e 20 70 65 72 66 6f 72 6d 20 40 20 63 6d 64 S> perform @ cmd
04f0: 62 75 66 2d 6f 20 21 20 3b 0a 0a 3a 20 63 6d 64 buf-o ! ;..: cmd
0500: 2d 6e 65 73 74 20 7b 20 78 74 20 2d 2d 20 7d 0a -nest { xt -- }.
0510: 20 20 20 20 62 75 66 2d 64 75 6d 70 20 32 40 20 buf-dump 2@
0520: 32 3e 72 20 62 75 66 2d 73 74 61 74 65 20 32 40 2>r buf-state 2@
0530: 20 32 3e 72 20 63 6d 64 62 75 66 2d 6f 20 40 20 2>r cmdbuf-o @
0540: 3e 72 0a 20 20 20 20 63 6f 6e 6e 65 63 74 69 6f >r. connectio
0550: 6e 20 64 75 70 20 64 75 70 20 3e 72 20 3e 6f 20 n dup dup >r >o
0560: 49 46 0a 09 76 61 6c 69 64 61 74 65 64 20 40 20 IF..validated @
0570: 3e 72 20 20 78 74 20 63 61 74 63 68 20 20 72 3e >r xt catch r>
0580: 20 76 61 6c 69 64 61 74 65 64 20 21 0a 20 20 20 validated !.
0590: 20 45 4c 53 45 0a 09 78 74 20 63 61 74 63 68 0a ELSE..xt catch.
05a0: 20 20 20 20 54 48 45 4e 20 20 6f 3e 20 72 3e 20 THEN o> r>
05b0: 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 0a 20 to connection .
05c0: 20 20 20 72 3e 20 63 6d 64 62 75 66 2d 6f 20 21 r> cmdbuf-o !
05d0: 20 32 72 3e 20 62 75 66 2d 73 74 61 74 65 20 32 2r> buf-state 2
05e0: 21 20 32 72 3e 20 62 75 66 2d 64 75 6d 70 20 32 ! 2r> buf-dump 2
05f0: 21 0a 20 20 20 20 74 68 72 6f 77 20 3b 0a 0a 5c !. throw ;..\
0600: 20 63 6f 6d 6d 61 6e 64 20 68 65 6c 70 65 72 0a command helper.
0610: 0a 3a 20 70 40 20 28 20 2d 2d 20 36 34 75 20 29 .: p@ ( -- 64u )
0620: 20 62 75 66 2d 73 74 61 74 65 20 32 40 20 6f 76 buf-state 2@ ov
0630: 65 72 20 2b 20 3e 72 20 70 40 2b 20 72 3e 20 6f er + >r p@+ r> o
0640: 76 65 72 20 2d 20 62 75 66 2d 73 74 61 74 65 20 ver - buf-state
0650: 32 21 20 3b 0a 3a 20 70 73 40 20 28 20 2d 2d 20 2! ;.: ps@ ( --
0660: 36 34 6e 20 29 20 70 40 20 7a 7a 3e 6e 20 3b 0a 64n ) p@ zz>n ;.
0670: 0a 3a 20 62 79 74 65 40 20 28 20 61 64 64 72 20 .: byte@ ( addr
0680: 75 20 2d 2d 20 61 64 64 72 27 20 75 27 20 62 20 u -- addr' u' b
0690: 29 0a 20 20 20 20 3e 72 20 63 6f 75 6e 74 20 72 ). >r count r
06a0: 3e 20 31 2d 20 73 77 61 70 20 3b 0a 0a 5c 20 75 > 1- swap ;..\ u
06b0: 73 65 20 61 20 73 74 72 69 6e 67 20 73 74 61 63 se a string stac
06c0: 6b 20 74 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 k to make sure t
06d0: 68 61 74 20 73 74 72 69 6e 67 73 20 63 61 6e 20 hat strings can
06e0: 6f 6e 6c 79 20 6f 72 69 67 69 6e 61 74 65 20 66 only originate f
06f0: 72 6f 6d 0a 5c 20 61 20 73 74 72 69 6e 67 20 69 rom.\ a string i
0700: 6e 73 69 64 65 20 74 68 65 20 63 6f 6d 6d 61 6e nside the comman
0710: 64 20 77 65 20 61 72 65 20 6a 75 73 74 20 65 78 d we are just ex
0720: 65 63 75 74 69 6e 67 0a 0a 3a 20 3e 24 20 28 20 ecuting..: >$ (
0730: 61 64 64 72 20 75 20 2d 2d 20 24 3a 73 74 72 69 addr u -- $:stri
0740: 6e 67 20 29 0a 20 20 20 20 73 74 72 69 6e 67 2d ng ). string-
0750: 73 74 61 63 6b 20 24 5b 5d 23 20 31 2b 20 73 74 stack $[]# 1+ st
0760: 72 69 6e 67 2d 73 74 61 63 6b 20 24 5b 5d 20 63 ring-stack $[] c
0770: 65 6c 6c 2d 20 32 21 20 3b 0a 3a 20 24 3e 20 28 ell- 2! ;.: $> (
0780: 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 61 64 64 $:string -- add
0790: 72 20 75 20 29 0a 20 20 20 20 73 74 72 69 6e 67 r u ). string
07a0: 2d 73 74 61 63 6b 20 24 5b 5d 23 20 32 20 2d 0a -stack $[]# 2 -.
07b0: 20 20 20 20 64 75 70 20 30 3c 20 21 21 73 74 72 dup 0< !!str
07c0: 69 6e 67 2d 65 6d 70 74 79 21 21 20 64 75 70 20 ing-empty!! dup
07d0: 3e 72 0a 20 20 20 20 73 74 72 69 6e 67 2d 73 74 >r. string-st
07e0: 61 63 6b 20 24 5b 5d 20 32 40 0a 20 20 20 20 72 ack $[] 2@. r
07f0: 3e 20 63 65 6c 6c 73 20 73 74 72 69 6e 67 2d 73 > cells string-s
0800: 74 61 63 6b 20 24 21 6c 65 6e 20 3b 0a 0a 3a 20 tack $!len ;..:
0810: 40 3e 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 @>$ ( addr u --
0820: 24 3a 73 74 72 69 6e 67 20 61 64 64 72 27 20 75 $:string addr' u
0830: 27 20 29 0a 20 20 20 20 62 6f 75 6e 64 73 20 70 ' ). bounds p
0840: 40 2b 20 36 34 6e 2d 73 77 61 70 20 36 34 3e 6e @+ 64n-swap 64>n
0850: 20 62 6f 75 6e 64 73 20 28 20 65 6e 64 62 75 66 bounds ( endbuf
0860: 20 65 6e 64 73 74 72 69 6e 67 20 73 74 61 72 74 endstring start
0870: 73 74 72 69 6e 67 20 29 0a 20 20 20 20 3e 72 20 string ). >r
0880: 32 64 75 70 20 75 3c 20 49 46 20 20 7e 7e 20 74 2dup u< IF ~~ t
0890: 72 75 65 20 21 21 73 74 72 69 6e 67 66 69 74 21 rue !!stringfit!
08a0: 21 20 20 54 48 45 4e 0a 20 20 20 20 64 75 70 20 ! THEN. dup
08b0: 72 3e 20 6f 76 65 72 20 75 6d 69 6e 20 74 75 63 r> over umin tuc
08c0: 6b 20 2d 20 3e 24 20 74 75 63 6b 20 2d 20 3b 0a k - >$ tuck - ;.
08d0: 0a 3a 20 73 74 72 69 6e 67 40 20 28 20 2d 2d 20 .: string@ ( --
08e0: 24 3a 73 74 72 69 6e 67 20 29 0a 20 20 20 20 62 $:string ). b
08f0: 75 66 2d 73 74 61 74 65 20 32 40 20 40 3e 24 20 uf-state 2@ @>$
0900: 62 75 66 2d 73 74 61 74 65 20 32 21 20 3b 0a 0a buf-state 2! ;..
0910: 3a 20 40 3e 24 6e 6f 65 72 72 20 28 20 61 64 64 : @>$noerr ( add
0920: 72 20 75 20 2d 2d 20 24 3a 73 74 72 69 6e 67 20 r u -- $:string
0930: 61 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 62 addr' u' ). b
0940: 6f 75 6e 64 73 20 70 40 2b 20 36 34 6e 2d 73 77 ounds p@+ 64n-sw
0950: 61 70 20 36 34 3e 6e 20 62 6f 75 6e 64 73 20 28 ap 64>n bounds (
0960: 20 65 6e 64 62 75 66 20 65 6e 64 73 74 72 69 6e endbuf endstrin
0970: 67 20 73 74 61 72 74 73 74 72 69 6e 67 20 29 0a g startstring ).
0980: 20 20 20 20 3e 72 20 6f 76 65 72 20 75 6d 69 6e >r over umin
0990: 20 64 75 70 20 72 3e 20 6f 76 65 72 20 75 6d 69 dup r> over umi
09a0: 6e 20 74 75 63 6b 20 2d 20 3e 24 20 74 75 63 6b n tuck - >$ tuck
09b0: 20 2d 20 3b 0a 0a 3a 20 73 74 72 69 6e 67 40 6e - ;..: string@n
09c0: 6f 65 72 72 20 28 20 2d 2d 20 24 3a 73 74 72 69 oerr ( -- $:stri
09d0: 6e 67 20 29 0a 20 20 20 20 62 75 66 2d 73 74 61 ng ). buf-sta
09e0: 74 65 20 32 40 20 40 3e 24 6e 6f 65 72 72 20 62 te 2@ @>$noerr b
09f0: 75 66 2d 73 74 61 74 65 20 32 21 20 3b 0a 0a 5c uf-state 2! ;..\
0a00: 20 73 74 72 69 6e 67 20 64 65 62 75 67 67 69 6e string debuggin
0a10: 67 0a 0a 3a 20 2e 62 6c 61 63 6b 38 35 20 28 20 g..: .black85 (
0a20: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
0a30: 3c 62 6c 61 63 6b 3e 20 72 65 76 65 61 6c 28 20 <black> reveal(
0a40: 38 35 74 79 70 65 20 29 65 6c 73 65 28 20 6e 69 85type )else( ni
0a50: 70 20 35 20 34 20 2a 2f 20 73 70 61 63 65 73 20 p 5 4 */ spaces
0a60: 29 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 0a 24 ) <default> ;..$
0a70: 32 30 20 63 6f 6e 73 74 61 6e 74 20 6d 61 78 73 20 constant maxs
0a80: 74 72 23 0a 0a 3a 20 24 2e 6d 61 78 73 74 72 20 tr#..: $.maxstr
0a90: 28 20 61 64 64 72 20 75 20 78 74 20 2d 2d 20 29 ( addr u xt -- )
0aa0: 20 3e 72 0a 20 20 20 20 64 75 70 20 6d 61 78 73 >r. dup maxs
0ab0: 74 72 23 20 32 2a 20 75 3e 20 49 46 0a 09 32 64 tr# 2* u> IF..2d
0ac0: 75 70 20 6d 61 78 73 74 72 23 20 75 6d 69 6e 20 up maxstr# umin
0ad0: 72 40 20 65 78 65 63 75 74 65 0a 09 2e 22 20 5b r@ execute..." [
0ae0: 2e 2e 24 22 20 64 75 70 20 6d 61 78 73 74 72 23 ..$" dup maxstr#
0af0: 20 32 2a 20 2d 20 30 20 75 2e 72 20 2e 22 20 2e 2* - 0 u.r ." .
0b00: 2e 5d 22 0a 09 64 75 70 20 6d 61 78 73 74 72 23 .]"..dup maxstr#
0b10: 20 2d 20 2f 73 74 72 69 6e 67 20 72 40 20 65 78 - /string r@ ex
0b20: 65 63 75 74 65 0a 20 20 20 20 54 48 45 4e 0a 20 ecute. THEN.
0b30: 20 20 20 72 3e 20 65 78 65 63 75 74 65 20 3b 0a r> execute ;.
0b40: 0a 30 20 77 61 72 6e 69 6e 67 73 20 21 40 20 5c .0 warnings !@ \
0b50: 20 24 2e 20 63 6f 75 6c 64 20 62 65 20 6d 69 73 $. could be mis
0b60: 74 61 6b 65 6e 20 61 73 20 64 6f 75 62 6c 65 20 taken as double
0b70: 30 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 24 2e 20 0.in net2o : $.
0b80: 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 ( addr u -- ).
0b90: 20 20 32 64 75 70 20 70 72 69 6e 74 61 62 6c 65 2dup printable
0ba0: 3f 20 49 46 0a 09 2e 5c 22 20 5c 22 22 20 74 79 ? IF...\" \"" ty
0bb0: 70 65 20 5c 20 24 2e 6d 61 78 73 74 72 0a 20 20 pe \ $.maxstr.
0bc0: 20 20 45 4c 53 45 0a 09 2e 5c 22 20 38 35 5c 22 ELSE...\" 85\"
0bd0: 20 22 20 38 35 74 79 70 65 20 5c 20 24 2e 6d 61 " 85type \ $.ma
0be0: 78 73 74 72 0a 20 20 20 20 54 48 45 4e 20 20 27 xstr. THEN '
0bf0: 22 27 20 65 6d 69 74 20 3b 0a 77 61 72 6e 69 6e "' emit ;.warnin
0c00: 67 73 20 21 0a 0a 3a 20 6e 32 6f 2e 73 74 72 69 gs !..: n2o.stri
0c10: 6e 67 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d ng ( $:string --
0c20: 20 29 20 20 63 72 20 24 3e 20 6e 65 74 32 6f 3a ) cr $> net2o:
0c30: 24 2e 20 2e 22 20 20 24 2c 20 22 20 3b 0a 3a 20 $. ." $, " ;.:
0c40: 6e 32 6f 2e 73 65 63 73 74 72 69 6e 67 20 28 20 n2o.secstring (
0c50: 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 61 74 $:string -- ) at
0c60: 74 72 20 40 20 3e 72 0a 20 20 20 20 63 72 20 24 tr @ >r. cr $
0c70: 3e 20 2e 5c 22 20 38 35 5c 22 20 22 20 2e 62 6c > .\" 85\" " .bl
0c80: 61 63 6b 38 35 20 72 3e 20 61 74 74 72 21 20 2e ack85 r> attr! .
0c90: 5c 22 20 5c 22 20 73 65 63 24 2c 20 22 20 3b 0a \" \" sec$, " ;.
0ca0: 0a 66 6f 72 77 61 72 64 20 6b 65 79 3e 6e 69 63 .forward key>nic
0cb0: 6b 0a 3a 20 2e 3f 69 64 20 28 20 61 64 64 72 20 k.: .?id ( addr
0cc0: 2d 2d 20 29 20 6b 65 79 73 69 7a 65 20 32 64 75 -- ) keysize 2du
0cd0: 70 20 6b 65 79 3e 6e 69 63 6b 0a 20 20 20 20 64 p key>nick. d
0ce0: 75 70 20 49 46 20 20 74 79 70 65 20 32 64 72 6f up IF type 2dro
0cf0: 70 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 24 p ELSE 2drop $
0d00: 38 20 75 6d 69 6e 20 38 35 74 79 70 65 20 20 54 8 umin 85type T
0d10: 48 45 4e 20 3b 0a 3a 20 2e 70 6b 28 32 29 73 69 HEN ;.: .pk(2)si
0d20: 67 3f 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 g? ( addr u -- )
0d30: 0a 20 20 20 20 32 64 75 70 20 70 6b 32 2d 73 69 . 2dup pk2-si
0d40: 67 3f 20 30 3d 20 49 46 0a 09 73 70 61 63 65 20 g? 0= IF..space
0d50: 73 69 67 70 6b 32 73 69 7a 65 23 20 2d 20 2b 20 sigpk2size# - +
0d60: 2e 3f 69 64 0a 09 66 61 6c 73 65 20 2e 63 68 65 .?id..false .che
0d70: 63 6b 20 45 4c 53 45 0a 09 32 64 75 70 20 70 6b ck ELSE..2dup pk
0d80: 2d 73 69 67 3f 20 30 3d 20 49 46 0a 09 20 20 20 -sig? 0= IF..
0d90: 20 73 70 61 63 65 20 73 69 67 70 6b 73 69 7a 65 space sigpksize
0da0: 23 20 2d 20 2b 20 2e 3f 69 64 0a 09 20 20 20 20 # - + .?id..
0db0: 66 61 6c 73 65 20 2e 63 68 65 63 6b 0a 09 45 4c false .check..EL
0dc0: 53 45 20 20 32 64 72 6f 70 20 74 72 75 65 20 2e SE 2drop true .
0dd0: 63 68 65 63 6b 20 20 54 48 45 4e 20 20 54 48 45 check THEN THE
0de0: 4e 20 3b 0a 3a 20 6e 32 6f 2e 73 69 67 73 74 72 N ;.: n2o.sigstr
0df0: 69 6e 67 20 28 20 24 3a 73 74 72 69 6e 67 20 2d ing ( $:string -
0e00: 2d 20 29 0a 20 20 20 20 63 72 20 24 3e 20 32 64 - ). cr $> 2d
0e10: 75 70 20 6e 65 74 32 6f 3a 24 2e 20 2e 22 20 20 up net2o:$. ."
0e20: 28 20 22 20 32 64 75 70 20 5b 27 5d 20 2e 73 69 ( " 2dup ['] .si
0e30: 67 64 61 74 65 73 20 23 31 30 20 62 61 73 65 2d gdates #10 base-
0e40: 65 78 65 63 75 74 65 0a 20 20 20 20 32 64 72 6f execute. 2dro
0e50: 70 20 5c 20 2e 70 6b 28 32 29 73 69 67 3f 0a 20 p \ .pk(2)sig?.
0e60: 20 20 20 2e 22 20 20 29 20 24 2c 20 22 20 3b 0a ." ) $, " ;.
0e70: 0a 3a 20 24 2e 73 20 28 20 24 73 74 72 69 6e 67 .: $.s ( $string
0e80: 31 20 2e 2e 20 24 73 74 72 69 6e 67 6e 20 2d 2d 1 .. $stringn --
0e90: 20 29 0a 20 20 20 20 73 74 72 69 6e 67 2d 73 74 ). string-st
0ea0: 61 63 6b 20 24 40 20 62 6f 75 6e 64 73 20 55 2b ack $@ bounds U+
0eb0: 44 4f 0a 09 63 72 20 69 20 32 40 20 6e 65 74 32 DO..cr i 2@ net2
0ec0: 6f 3a 24 2e 0a 20 20 20 20 32 20 63 65 6c 6c 73 o:$.. 2 cells
0ed0: 20 2b 4c 4f 4f 50 20 3b 0a 0a 5c 20 6f 62 6a 65 +LOOP ;..\ obje
0ee0: 63 74 20 73 74 61 63 6b 0a 0a 3a 20 6f 2d 70 6f ct stack..: o-po
0ef0: 70 20 28 20 6f 3a 6f 31 20 6f 3a 78 20 2d 2d 20 p ( o:o1 o:x --
0f00: 6f 31 20 6f 3a 78 20 29 20 6f 62 6a 65 63 74 2d o1 o:x ) object-
0f10: 73 74 61 63 6b 20 73 74 61 63 6b 3e 20 3b 0a 3a stack stack> ;.:
0f20: 20 6f 2d 70 75 73 68 20 28 20 6f 31 20 6f 3a 78 o-push ( o1 o:x
0f30: 20 2d 2d 20 6f 3a 6f 31 20 6f 3a 78 20 29 20 6f -- o:o1 o:x ) o
0f40: 62 6a 65 63 74 2d 73 74 61 63 6b 20 3e 73 74 61 bject-stack >sta
0f50: 63 6b 20 3b 0a 0a 3a 20 6e 3a 3e 6f 20 28 20 6f ck ;..: n:>o ( o
0f60: 31 20 6f 3a 6f 32 20 2d 2d 20 6f 3a 6f 32 20 6f 1 o:o2 -- o:o2 o
0f70: 3a 6f 31 20 29 0a 20 20 20 20 3e 6f 20 72 3e 20 :o1 ). >o r>
0f80: 6f 2d 70 75 73 68 20 20 6f 20 49 46 20 20 31 20 o-push o IF 1
0f90: 72 65 71 3f 20 21 20 20 54 48 45 4e 20 3b 0a 3a req? ! THEN ;.:
0fa0: 20 6e 3a 6f 3e 20 28 20 6f 3a 6f 32 20 6f 3a 6f n:o> ( o:o2 o:o
0fb0: 31 20 2d 2d 20 6f 3a 6f 32 20 29 0a 20 20 20 20 1 -- o:o2 ).
0fc0: 6f 2d 70 6f 70 20 3e 72 20 6f 3e 20 3b 0a 3a 20 o-pop >r o> ;.:
0fd0: 6e 3a 6f 73 77 61 70 20 28 20 6f 3a 6f 31 20 6f n:oswap ( o:o1 o
0fe0: 3a 6f 32 20 2d 2d 20 6f 3a 6f 32 20 6f 3a 6f 31 :o2 -- o:o2 o:o1
0ff0: 20 29 0a 20 20 20 20 6f 2d 70 6f 70 20 3e 6f 20 ). o-pop >o
1000: 72 3e 20 6f 2d 70 75 73 68 20 3b 0a 0a 5c 20 74 r> o-push ;..\ t
1010: 6f 6b 65 6e 20 73 74 61 63 6b 20 2d 20 6f 6e 6c oken stack - onl
1020: 79 20 66 6f 72 20 64 65 63 6f 6d 70 69 6c 69 6e y for decompilin
1030: 67 0a 0a 3a 20 74 2d 70 75 73 68 20 28 20 61 64 g..: t-push ( ad
1040: 64 72 20 2d 2d 20 29 20 20 74 2d 73 74 61 63 6b dr -- ) t-stack
1050: 20 3e 73 74 61 63 6b 20 3b 0a 3a 20 74 2d 70 6f >stack ;.: t-po
1060: 70 20 28 20 2d 2d 20 61 64 64 72 20 29 20 20 20 p ( -- addr )
1070: 74 2d 73 74 61 63 6b 20 73 74 61 63 6b 3e 20 3b t-stack stack> ;
1080: 0a 3a 20 74 23 20 28 20 2d 2d 20 6e 20 29 20 74 .: t# ( -- n ) t
1090: 2d 73 74 61 63 6b 20 24 5b 5d 23 20 3b 0a 0a 5c -stack $[]# ;..\
10a0: 20 66 6c 6f 61 74 20 61 72 65 20 73 74 6f 72 65 float are store
10b0: 64 20 62 69 67 20 65 6e 64 69 61 6e 2e 0a 0a 3a d big endian...:
10c0: 20 70 66 40 2b 20 28 20 61 64 64 72 20 75 20 2d pf@+ ( addr u -
10d0: 2d 20 61 64 64 72 27 20 75 27 20 72 20 29 0a 20 - addr' u' r ).
10e0: 20 20 20 32 3e 72 20 36 34 20 36 34 23 30 20 32 2>r 64 64#0 2
10f0: 72 3e 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 37 r> bounds ?DO..7
1100: 20 36 34 6c 73 68 69 66 74 20 49 20 63 40 20 24 64lshift I c@ $
1110: 37 46 20 61 6e 64 20 6e 3e 36 34 20 36 34 2b 20 7F and n>64 64+
1120: 36 34 3e 72 20 37 20 2d 20 36 34 72 3e 0a 09 49 64>r 7 - 64r>..I
1130: 20 63 40 20 24 38 30 20 61 6e 64 20 20 30 3d 20 c@ $80 and 0=
1140: 49 46 0a 09 20 20 20 20 6e 36 34 2d 73 77 61 70 IF.. n64-swap
1150: 20 36 34 6c 73 68 69 66 74 0a 09 20 20 20 20 30 64lshift.. 0
1160: 65 20 7b 20 66 5e 20 70 66 74 6d 70 20 7d 20 70 e { f^ pftmp } p
1170: 66 74 6d 70 20 36 34 21 20 70 66 74 6d 70 20 66 ftmp 64! pftmp f
1180: 40 0a 09 20 20 20 20 49 20 31 2b 20 49 27 20 6f @.. I 1+ I' o
1190: 76 65 72 20 2d 20 75 6e 6c 6f 6f 70 20 20 45 58 ver - unloop EX
11a0: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 4c 4f 4f IT THEN. LOO
11b0: 50 20 20 20 74 72 75 65 20 21 21 66 6c 6f 61 74 P true !!float
11c0: 66 69 74 21 21 20 20 3b 0a 0a 3a 20 70 66 21 2b fit!! ;..: pf!+
11d0: 20 28 20 72 3a 66 6c 6f 61 74 20 61 64 64 72 20 ( r:float addr
11e0: 2d 2d 20 61 64 64 72 27 20 29 20 7b 20 66 5e 20 -- addr' ) { f^
11f0: 70 66 74 6d 70 20 7d 0a 20 20 20 20 42 45 47 49 pftmp }. BEGI
1200: 4e 0a 09 70 66 74 6d 70 20 36 34 40 20 35 37 20 N..pftmp 64@ 57
1210: 36 34 72 73 68 69 66 74 20 36 34 3e 6e 0a 09 70 64rshift 64>n..p
1220: 66 74 6d 70 20 36 34 40 20 37 20 36 34 6c 73 68 ftmp 64@ 7 64lsh
1230: 69 66 74 20 36 34 64 75 70 20 70 66 74 6d 70 20 ift 64dup pftmp
1240: 36 34 21 0a 09 36 34 2d 30 3c 3e 20 57 48 49 4c 64!..64-0<> WHIL
1250: 45 20 20 24 38 30 20 6f 72 20 6f 76 65 72 20 63 E $80 or over c
1260: 21 20 31 2b 20 20 52 45 50 45 41 54 0a 20 20 20 ! 1+ REPEAT.
1270: 20 6f 76 65 72 20 63 21 20 31 2b 20 3b 0a 0a 3a over c! 1+ ;..:
1280: 20 70 66 40 20 28 20 2d 2d 20 72 20 29 0a 20 20 pf@ ( -- r ).
1290: 20 20 62 75 66 2d 73 74 61 74 65 20 32 40 20 70 buf-state 2@ p
12a0: 66 40 2b 20 62 75 66 2d 73 74 61 74 65 20 32 21 f@+ buf-state 2!
12b0: 20 3b 0a 0a 3a 20 6e 65 74 32 6f 2d 63 72 61 73 ;..: net2o-cras
12c0: 68 20 74 72 75 65 20 21 21 66 75 6e 63 74 69 6f h true !!functio
12d0: 6e 21 21 20 3b 0a 0a 44 65 66 65 72 20 67 65 6e n!! ;..Defer gen
12e0: 2d 74 61 62 6c 65 0a 27 20 63 6d 64 2d 74 61 62 -table.' cmd-tab
12f0: 6c 65 20 49 53 20 67 65 6e 2d 74 61 62 6c 65 0a le IS gen-table.
1300: 0a 3a 20 6e 3e 63 6d 64 20 28 20 6e 20 2d 2d 20 .: n>cmd ( n --
1310: 61 64 64 72 20 29 20 63 65 6c 6c 73 20 3e 72 0a addr ) cells >r.
1320: 20 20 20 20 6f 20 49 46 20 20 74 6f 6b 65 6e 2d o IF token-
1330: 74 61 62 6c 65 20 20 45 4c 53 45 20 20 73 65 74 table ELSE set
1340: 75 70 2d 74 61 62 6c 65 20 20 54 48 45 4e 0a 20 up-table THEN.
1350: 20 20 20 24 40 20 72 40 20 75 3c 3d 20 21 21 66 $@ r@ u<= !!f
1360: 75 6e 63 74 69 6f 6e 21 21 20 72 3e 20 2b 20 3b unction!! r> + ;
1370: 0a 0a 3a 20 63 6d 64 40 20 28 20 2d 2d 20 75 20 ..: cmd@ ( -- u
1380: 29 20 62 75 66 2d 73 74 61 74 65 20 32 40 20 6f ) buf-state 2@ o
1390: 76 65 72 20 2b 20 3e 72 20 70 40 2b 20 72 3e 20 ver + >r p@+ r>
13a0: 6f 76 65 72 20 2d 20 62 75 66 2d 73 74 61 74 65 over - buf-state
13b0: 20 32 21 20 36 34 3e 6e 20 3b 0a 0a 73 74 61 6e 2! 64>n ;..stan
13c0: 64 61 72 64 3a 66 69 65 6c 64 0a 2d 37 20 63 65 dard:field.-7 ce
13d0: 6c 6c 73 20 30 20 2b 66 69 65 6c 64 20 6e 65 74 lls 0 +field net
13e0: 32 6f 2e 6e 61 6d 65 0a 64 72 6f 70 0a 0a 3a 20 2o.name.drop..:
13f0: 3e 6e 65 74 32 6f 2d 6e 61 6d 65 20 28 20 61 64 >net2o-name ( ad
1400: 64 72 20 2d 2d 20 61 64 64 72 27 20 75 20 29 0a dr -- addr' u ).
1410: 20 20 20 20 6e 65 74 32 6f 2e 6e 61 6d 65 20 62 net2o.name b
1420: 6f 64 79 3e 20 6e 61 6d 65 3e 73 74 72 69 6e 67 ody> name>string
1430: 20 3b 0a 3a 20 3e 6e 65 74 32 6f 2d 73 69 67 20 ;.: >net2o-sig
1440: 28 20 61 64 64 72 20 2d 2d 20 61 64 64 72 27 20 ( addr -- addr'
1450: 75 20 29 0a 20 20 20 20 6e 65 74 32 6f 2e 6e 61 u ). net2o.na
1460: 6d 65 20 33 20 63 65 6c 6c 73 20 2b 20 24 40 20 me 3 cells + $@
1470: 3b 0a 3a 20 2e 6e 65 74 32 6f 2d 6e 75 6d 20 28 ;.: .net2o-num (
1480: 20 6f 66 66 20 2d 2d 20 29 20 20 63 65 6c 6c 2f off -- ) cell/
1490: 20 27 3c 27 20 65 6d 69 74 20 30 20 2e 72 20 27 '<' emit 0 .r '
14a0: 3e 27 20 65 6d 69 74 20 73 70 61 63 65 20 3b 0a >' emit space ;.
14b0: 0a 55 73 65 72 20 73 65 65 3a 74 61 62 6c 65 20 .User see:table
14c0: 5c 20 63 75 72 72 65 6e 74 20 74 6f 6b 65 6e 20 \ current token
14d0: 74 61 62 6c 65 20 66 6f 72 20 73 65 65 20 6f 6e table for see on
14e0: 6c 79 0a 0a 3a 20 28 6e 65 74 32 6f 2d 73 65 65 ly..: (net2o-see
14f0: 29 20 28 20 61 64 64 72 20 69 6e 64 65 78 20 2d ) ( addr index -
1500: 2d 20 29 20 20 64 75 70 20 3e 72 20 2b 20 40 0a - ) dup >r + @.
1510: 20 20 20 20 64 75 70 20 30 3c 3e 20 49 46 0a 09 dup 0<> IF..
1520: 6e 65 74 32 6f 2e 6e 61 6d 65 0a 09 64 75 70 20 net2o.name..dup
1530: 32 20 63 65 6c 6c 73 20 2b 20 40 20 3f 64 75 70 2 cells + @ ?dup
1540: 2d 49 46 20 20 40 20 73 65 65 3a 74 61 62 6c 65 -IF @ see:table
1550: 20 40 20 74 2d 70 75 73 68 20 73 65 65 3a 74 61 @ t-push see:ta
1560: 62 6c 65 20 21 20 20 54 48 45 4e 0a 09 62 6f 64 ble ! THEN..bod
1570: 79 3e 20 2e 6e 61 6d 65 0a 20 20 20 20 45 4c 53 y> .name. ELS
1580: 45 20 20 64 72 6f 70 20 72 40 20 2e 6e 65 74 32 E drop r@ .net2
1590: 6f 2d 6e 75 6d 20 20 54 48 45 4e 20 20 72 64 72 o-num THEN rdr
15a0: 6f 70 20 3b 0a 0a 3a 20 2e 6e 65 74 32 6f 2d 6e op ;..: .net2o-n
15b0: 61 6d 65 20 28 20 6e 20 2d 2d 20 29 20 20 63 65 ame ( n -- ) ce
15c0: 6c 6c 73 20 3e 72 0a 20 20 20 20 73 65 65 3a 74 lls >r. see:t
15d0: 61 62 6c 65 20 24 40 20 72 40 20 75 3c 3d 0a 20 able $@ r@ u<=.
15e0: 20 20 20 49 46 20 20 64 72 6f 70 20 72 3e 20 2e IF drop r> .
15f0: 6e 65 74 32 6f 2d 6e 75 6d 20 20 45 58 49 54 20 net2o-num EXIT
1600: 20 54 48 45 4e 20 20 72 3e 20 28 6e 65 74 32 6f THEN r> (net2o
1610: 2d 73 65 65 29 20 3b 0a 3a 20 2e 6e 65 74 32 6f -see) ;.: .net2o
1620: 2d 6e 61 6d 65 27 20 28 20 6e 20 2d 2d 20 29 20 -name' ( n -- )
1630: 20 63 65 6c 6c 73 20 3e 72 0a 20 20 20 20 73 65 cells >r. se
1640: 65 3a 74 61 62 6c 65 20 24 40 20 72 40 20 75 3c e:table $@ r@ u<
1650: 3d 0a 20 20 20 20 49 46 20 20 64 72 6f 70 20 72 =. IF drop r
1660: 3e 20 2e 6e 65 74 32 6f 2d 6e 75 6d 20 20 45 58 > .net2o-num EX
1670: 49 54 20 20 54 48 45 4e 20 20 72 40 20 2b 20 40 IT THEN r@ + @
1680: 0a 20 20 20 20 64 75 70 20 30 3c 3e 20 49 46 0a . dup 0<> IF.
1690: 09 6e 65 74 32 6f 2e 6e 61 6d 65 20 62 6f 64 79 .net2o.name body
16a0: 3e 20 2e 6e 61 6d 65 0a 20 20 20 20 45 4c 53 45 > .name. ELSE
16b0: 20 20 64 72 6f 70 20 72 40 20 2e 6e 65 74 32 6f drop r@ .net2o
16c0: 2d 6e 75 6d 20 20 54 48 45 4e 20 20 72 64 72 6f -num THEN rdro
16d0: 70 20 3b 0a 0a 3a 20 6e 65 74 32 6f 2d 73 65 65 p ;..: net2o-see
16e0: 20 28 20 63 6d 64 20 2d 2d 20 29 20 68 65 78 5b ( cmd -- ) hex[
16f0: 0a 20 20 20 20 63 61 73 65 0a 09 30 20 6f 66 20 . case..0 of
1700: 20 2e 22 20 65 6e 64 2d 63 6f 64 65 22 20 63 72 ." end-code" cr
1710: 20 23 30 2e 20 62 75 66 2d 73 74 61 74 65 20 32 #0. buf-state 2
1720: 21 20 20 65 6e 64 6f 66 0a 09 31 20 6f 66 20 20 ! endof..1 of
1730: 70 40 20 20 20 20 20 20 20 20 20 20 75 36 34 2e p@ u64.
1740: 20 2e 22 20 6c 69 74 2c 20 22 20 20 65 6e 64 6f ." lit, " endo
1750: 66 0a 09 32 20 6f 66 20 20 70 40 20 36 34 69 6e f..2 of p@ 64in
1760: 76 65 72 74 20 73 36 34 2e 20 2e 22 20 6c 69 74 vert s64. ." lit
1770: 2c 20 22 20 20 65 6e 64 6f 66 0a 09 33 20 6f 66 , " endof..3 of
1780: 20 20 73 74 72 69 6e 67 40 6e 6f 65 72 72 20 62 string@noerr b
1790: 75 66 2d 73 74 61 74 65 20 32 40 20 64 72 6f 70 uf-state 2@ drop
17a0: 20 70 40 2b 20 64 72 6f 70 20 36 34 3e 6e 20 31 p@+ drop 64>n 1
17b0: 30 20 3d 0a 09 20 20 20 20 49 46 20 20 20 20 6e 0 =.. IF n
17c0: 32 6f 2e 73 69 67 73 74 72 69 6e 67 20 20 45 4c 2o.sigstring EL
17d0: 53 45 20 20 6e 32 6f 2e 73 74 72 69 6e 67 20 20 SE n2o.string
17e0: 54 48 45 4e 20 20 65 6e 64 6f 66 0a 09 34 20 6f THEN endof..4 o
17f0: 66 20 20 70 66 40 20 66 2e 20 2e 22 20 66 6c 6f f pf@ f. ." flo
1800: 61 74 2c 20 22 20 65 6e 64 6f 66 0a 09 35 20 6f at, " endof..5 o
1810: 66 20 20 2e 22 20 65 6e 64 2d 77 69 74 68 20 22 f ." end-with "
1820: 20 63 72 20 20 74 23 20 49 46 20 20 74 2d 70 6f cr t# IF t-po
1830: 70 20 73 65 65 3a 74 61 62 6c 65 20 21 20 20 54 p see:table ! T
1840: 48 45 4e 20 20 65 6e 64 6f 66 0a 09 36 20 6f 66 HEN endof..6 of
1850: 20 20 2e 22 20 6f 73 77 61 70 20 22 20 63 72 20 ." oswap " cr
1860: 73 65 65 3a 74 61 62 6c 65 20 40 20 74 2d 70 6f see:table @ t-po
1870: 70 20 73 65 65 3a 74 61 62 6c 65 20 21 20 74 2d p see:table ! t-
1880: 70 75 73 68 20 20 65 6e 64 6f 66 0a 09 31 31 20 push endof..11
1890: 6f 66 20 20 73 74 72 69 6e 67 40 6e 6f 65 72 72 of string@noerr
18a0: 20 6e 32 6f 2e 73 65 63 73 74 72 69 6e 67 20 20 n2o.secstring
18b0: 65 6e 64 6f 66 0a 09 31 33 20 6f 66 20 20 27 22 endof..13 of '"
18c0: 27 20 65 6d 69 74 20 70 40 20 36 34 3e 6e 20 78 ' emit p@ 64>n x
18d0: 65 6d 69 74 20 70 40 20 36 34 3e 6e 20 78 65 6d emit p@ 64>n xem
18e0: 69 74 20 70 40 20 36 34 3e 6e 20 78 65 6d 69 74 it p@ 64>n xemit
18f0: 20 2e 5c 22 20 5c 22 20 34 63 63 2c 20 22 0a 09 .\" \" 4cc, "..
1900: 65 6e 64 6f 66 0a 09 31 34 20 6f 66 20 20 73 74 endof..14 of st
1910: 72 69 6e 67 40 6e 6f 65 72 72 20 20 32 64 72 6f ring@noerr 2dro
1920: 70 20 20 65 6e 64 6f 66 0a 09 24 31 30 20 6f 66 p endof..$10 of
1930: 20 2e 22 20 70 75 73 68 27 20 22 20 70 40 20 36 ." push' " p@ 6
1940: 34 3e 6e 20 2e 6e 65 74 32 6f 2d 6e 61 6d 65 20 4>n .net2o-name
1950: 20 65 6e 64 6f 66 0a 09 2e 6e 65 74 32 6f 2d 6e endof...net2o-n
1960: 61 6d 65 0a 09 30 20 65 6e 64 63 61 73 65 20 5d ame..0 endcase ]
1970: 68 65 78 20 3b 0a 0a 55 73 65 72 20 73 68 6f 77 hex ;..User show
1980: 2d 6f 66 66 73 65 74 20 20 73 68 6f 77 2d 6f 66 -offset show-of
1990: 66 73 65 74 20 6f 6e 0a 0a 53 65 6d 61 20 73 65 fset on..Sema se
19a0: 65 2d 73 65 6d 61 0a 0a 3a 20 63 6d 64 2d 73 65 e-sema..: cmd-se
19b0: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 e ( addr u -- ad
19c0: 64 72 27 20 75 27 20 29 0a 20 20 20 20 64 75 70 dr' u' ). dup
19d0: 20 73 68 6f 77 2d 6f 66 66 73 65 74 20 40 20 3d show-offset @ =
19e0: 20 49 46 20 20 2e 22 20 3c 3c 3c 20 22 20 20 54 IF ." <<< " T
19f0: 48 45 4e 0a 20 20 20 20 62 75 66 2d 73 74 61 74 HEN. buf-stat
1a00: 65 20 32 21 20 70 40 20 36 34 3e 6e 20 6e 65 74 e 2! p@ 64>n net
1a10: 32 6f 2d 73 65 65 20 62 75 66 2d 73 74 61 74 65 2o-see buf-state
1a20: 20 32 40 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 2@ ;..in net2o
1a30: 3a 20 28 73 65 65 29 20 28 20 61 64 64 72 20 75 : (see) ( addr u
1a40: 20 2d 2d 20 29 0a 20 20 20 20 62 75 66 2d 73 74 -- ). buf-st
1a50: 61 74 65 20 32 40 20 32 3e 72 0a 20 20 20 20 5b ate 2@ 2>r. [
1a60: 3a 20 2e 22 20 6e 65 74 32 6f 2d 63 6f 64 65 22 : ." net2o-code"
1a70: 20 20 64 65 73 74 2d 66 6c 61 67 73 20 31 2b 20 dest-flags 1+
1a80: 63 40 20 73 74 61 74 65 6c 65 73 73 23 20 61 6e c@ stateless# an
1a90: 64 20 49 46 20 20 27 30 27 20 65 6d 69 74 20 20 d IF '0' emit
1aa0: 54 48 45 4e 0a 20 20 20 20 20 20 64 75 70 20 68 THEN. dup h
1ab0: 65 78 2e 20 74 2d 73 74 61 63 6b 20 24 6f 66 66 ex. t-stack $off
1ac0: 0a 20 20 20 20 20 20 5b 3a 20 42 45 47 49 4e 20 . [: BEGIN
1ad0: 20 63 6d 64 2d 73 65 65 20 64 75 70 20 30 3d 20 cmd-see dup 0=
1ae0: 55 4e 54 49 4c 20 3b 5d 20 63 61 74 63 68 0a 20 UNTIL ;] catch.
1af0: 20 20 20 20 20 2e 22 20 20 65 6e 64 2d 63 6f 64 ." end-cod
1b00: 65 22 20 63 72 20 74 68 72 6f 77 20 20 32 64 72 e" cr throw 2dr
1b10: 6f 70 20 3b 5d 20 73 65 65 2d 73 65 6d 61 20 63 op ;] see-sema c
1b20: 2d 73 65 63 74 69 6f 6e 0a 20 20 20 20 32 72 3e -section. 2r>
1b30: 20 62 75 66 2d 73 74 61 74 65 20 32 21 20 3b 0a buf-state 2! ;.
1b40: 0a 3a 20 3e 73 65 65 2d 74 61 62 6c 65 20 28 20 .: >see-table (
1b50: 2d 2d 20 29 0a 20 20 20 20 6f 20 49 46 20 20 74 -- ). o IF t
1b60: 6f 6b 65 6e 2d 74 61 62 6c 65 20 20 45 4c 53 45 oken-table ELSE
1b70: 20 20 73 65 74 75 70 2d 74 61 62 6c 65 20 20 54 setup-table T
1b80: 48 45 4e 20 20 40 20 73 65 65 3a 74 61 62 6c 65 HEN @ see:table
1b90: 20 21 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a ! ;..in net2o :
1ba0: 20 73 65 65 20 28 20 61 64 64 72 20 75 20 2d 2d see ( addr u --
1bb0: 20 29 0a 20 20 20 20 3e 73 65 65 2d 74 61 62 6c ). >see-tabl
1bc0: 65 20 6e 65 74 32 6f 3a 28 73 65 65 29 20 3b 0a e net2o:(see) ;.
1bd0: 0a 3a 20 2e 64 65 73 74 2d 61 64 64 72 20 28 20 .: .dest-addr (
1be0: 66 6c 61 67 20 2d 2d 20 29 0a 20 20 20 20 31 2b flag -- ). 1+
1bf0: 20 63 40 20 73 74 61 74 65 6c 65 73 73 23 20 61 c@ stateless# a
1c00: 6e 64 20 30 3d 20 49 46 20 64 65 73 74 2d 61 64 nd 0= IF dest-ad
1c10: 64 72 20 36 34 40 20 78 36 34 2e 20 54 48 45 4e dr 64@ x64. THEN
1c20: 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 73 ;..in net2o : s
1c30: 65 65 2d 6d 65 20 28 20 2d 2d 20 29 0a 20 20 20 ee-me ( -- ).
1c40: 20 2e 22 20 73 65 65 2d 6d 65 3a 20 22 20 20 69 ." see-me: " i
1c50: 6e 62 75 66 20 68 64 72 66 6c 61 67 73 20 2e 64 nbuf hdrflags .d
1c60: 65 73 74 2d 61 64 64 72 20 20 62 75 66 2d 64 75 est-addr buf-du
1c70: 6d 70 20 32 40 20 6e 65 74 32 6f 3a 73 65 65 20 mp 2@ net2o:see
1c80: 3b 0a 0a 3a 20 63 6d 64 2d 64 69 73 70 61 74 63 ;..: cmd-dispatc
1c90: 68 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 h ( addr u -- ad
1ca0: 64 72 27 20 75 27 20 29 0a 20 20 20 20 62 75 66 dr' u' ). buf
1cb0: 2d 73 74 61 74 65 20 32 21 0a 20 20 20 20 63 6d -state 2!. cm
1cc0: 64 40 20 74 72 61 63 65 28 20 64 75 70 20 49 46 d@ trace( dup IF
1cd0: 20 64 75 70 20 3e 73 65 65 2d 74 61 62 6c 65 20 dup >see-table
1ce0: 2e 6e 65 74 32 6f 2d 6e 61 6d 65 27 20 54 48 45 .net2o-name' THE
1cf0: 4e 20 3e 72 20 2e 73 20 72 3e 20 24 2e 73 20 63 N >r .s r> $.s c
1d00: 72 20 29 20 6e 3e 63 6d 64 0a 20 20 20 20 40 20 r ) n>cmd. @
1d10: 3f 64 75 70 2d 49 46 20 20 65 78 65 63 75 74 65 ?dup-IF execute
1d20: 20 20 45 4c 53 45 0a 09 74 72 61 63 65 28 20 2e ELSE..trace( .
1d30: 22 20 63 72 61 73 68 69 6e 67 22 20 63 72 20 63 " crashing" cr c
1d40: 72 20 29 20 6e 65 74 32 6f 2d 63 72 61 73 68 20 r ) net2o-crash
1d50: 20 54 48 45 4e 20 20 62 75 66 2d 73 74 61 74 65 THEN buf-state
1d60: 20 32 40 20 3b 0a 0a 3a 20 3e 63 6d 64 20 28 20 2@ ;..: >cmd (
1d70: 78 74 20 75 20 2d 2d 20 29 20 67 65 6e 2d 74 61 xt u -- ) gen-ta
1d80: 62 6c 65 20 24 5b 5d 20 21 20 3b 0a 0a 3a 20 75 ble $[] ! ;..: u
1d90: 6e 2d 63 6d 64 20 28 20 2d 2d 20 29 20 20 23 30 n-cmd ( -- ) #0
1da0: 2e 20 62 75 66 2d 73 74 61 74 65 20 32 21 20 20 . buf-state 2!
1db0: 30 20 3e 6f 20 72 64 72 6f 70 20 3b 0a 0a 44 65 0 >o rdrop ;..De
1dc0: 66 65 72 20 3e 74 68 72 6f 77 0a 0a 3a 20 63 6d fer >throw..: cm
1dd0: 64 2d 74 68 72 6f 77 20 28 20 65 72 72 6f 72 20 d-throw ( error
1de0: 2d 2d 20 29 0a 20 20 20 20 63 6d 64 28 20 74 72 -- ). cmd( tr
1df0: 75 65 20 29 65 6c 73 65 28 20 72 65 6d 6f 74 65 ue )else( remote
1e00: 3f 20 40 20 30 3d 20 29 20 49 46 0a 09 5b 3a 20 ? @ 0= ) IF..[:
1e10: 2e 22 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 3a 20 ." do-cmd-loop:
1e20: 22 20 64 75 70 20 2e 20 2e 65 78 65 20 63 72 20 " dup . .exe cr
1e30: 3b 5d 20 24 65 72 72 0a 09 64 75 70 20 44 6f 45 ;] $err..dup DoE
1e40: 72 72 6f 72 0a 09 62 75 66 2d 73 74 61 74 65 20 rror..buf-state
1e50: 40 20 73 68 6f 77 2d 6f 66 66 73 65 74 20 21 20 @ show-offset !
1e60: 20 3c 65 72 72 3e 20 63 72 20 6e 65 74 32 6f 3a <err> cr net2o:
1e70: 73 65 65 2d 6d 65 20 3c 64 65 66 61 75 6c 74 3e see-me <default>
1e80: 20 73 68 6f 77 2d 6f 66 66 73 65 74 20 6f 6e 0a show-offset on.
1e90: 20 20 20 20 54 48 45 4e 0a 20 20 20 20 75 6e 2d THEN. un-
1ea0: 63 6d 64 20 3e 74 68 72 6f 77 20 3b 0a 3a 20 64 cmd >throw ;.: d
1eb0: 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 28 20 61 64 64 o-cmd-loop ( add
1ec0: 72 20 75 20 2d 2d 20 29 20 20 32 64 75 70 20 62 r u -- ) 2dup b
1ed0: 75 66 2d 64 75 6d 70 20 32 21 0a 20 20 20 20 63 uf-dump 2!. c
1ee0: 6d 64 28 20 3c 77 61 72 6e 3e 20 64 65 73 74 2d md( <warn> dest-
1ef0: 66 6c 61 67 73 20 2e 64 65 73 74 2d 61 64 64 72 flags .dest-addr
1f00: 20 32 64 75 70 20 6e 65 74 32 6f 3a 73 65 65 20 2dup net2o:see
1f10: 3c 64 65 66 61 75 6c 74 3e 20 29 0a 20 20 20 20 <default> ).
1f20: 73 70 40 20 3e 72 0a 20 20 20 20 5b 3a 20 42 45 sp@ >r. [: BE
1f30: 47 49 4e 20 20 20 63 6d 64 2d 64 69 73 70 61 74 GIN cmd-dispat
1f40: 63 68 20 64 75 70 20 30 3c 3d 20 20 55 4e 54 49 ch dup 0<= UNTI
1f50: 4c 20 3b 5d 20 63 61 74 63 68 0a 20 20 20 20 74 L ;] catch. t
1f60: 72 61 63 65 28 20 2e 22 20 63 6d 64 20 6c 6f 6f race( ." cmd loo
1f70: 70 20 64 6f 6e 65 22 20 2e 73 20 63 72 20 29 0a p done" .s cr ).
1f80: 20 20 20 20 3f 64 75 70 2d 49 46 20 20 20 63 6d ?dup-IF cm
1f90: 64 2d 74 68 72 6f 77 20 20 54 48 45 4e 0a 20 20 d-throw THEN.
1fa0: 20 20 72 3e 20 73 70 21 20 32 64 72 6f 70 20 2b r> sp! 2drop +
1fb0: 63 6d 64 20 3b 0a 3a 20 6e 65 73 74 2d 63 6d 64 cmd ;.: nest-cmd
1fc0: 2d 6c 6f 6f 70 20 28 20 61 64 64 72 20 75 20 2d -loop ( addr u -
1fd0: 2d 20 29 0a 20 20 20 20 62 75 66 2d 64 75 6d 70 - ). buf-dump
1fe0: 20 32 40 20 32 3e 72 20 62 75 66 2d 73 74 61 74 2@ 2>r buf-stat
1ff0: 65 20 32 40 20 32 3e 72 20 5b 27 5d 20 64 6f 2d e 2@ 2>r ['] do-
2000: 63 6d 64 2d 6c 6f 6f 70 20 63 61 74 63 68 0a 20 cmd-loop catch.
2010: 20 20 20 32 72 3e 20 62 75 66 2d 73 74 61 74 65 2r> buf-state
2020: 20 32 40 20 64 30 3c 3e 20 49 46 20 20 62 75 66 2@ d0<> IF buf
2030: 2d 73 74 61 74 65 20 32 21 20 20 45 4c 53 45 20 -state 2! ELSE
2040: 20 32 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 2drop THEN.
2050: 20 32 72 3e 20 62 75 66 2d 64 75 6d 70 20 32 21 2r> buf-dump 2!
2060: 20 3f 64 75 70 2d 49 46 20 20 74 68 72 6f 77 20 ?dup-IF throw
2070: 20 54 48 45 4e 20 3b 0a 0a 63 6d 64 2d 62 75 66 THEN ;..cmd-buf
2080: 2d 63 20 27 20 6e 65 77 20 73 74 61 74 69 63 2d -c ' new static-
2090: 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 74 65 72 a with-allocater
20a0: 20 63 6f 64 65 2d 62 75 66 5e 20 21 0a 27 20 63 code-buf^ !.' c
20b0: 6f 64 65 2d 62 75 66 5e 20 63 6d 64 62 75 66 3a ode-buf^ cmdbuf:
20c0: 20 63 6f 64 65 2d 62 75 66 0a 0a 63 6f 64 65 2d code-buf..code-
20d0: 62 75 66 0a 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d buf..:noname ( -
20e0: 2d 20 29 20 20 63 6d 64 62 75 66 23 20 6f 66 66 - ) cmdbuf# off
20f0: 20 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e 6f 0a connection >o.
2100: 09 72 65 71 3f 20 6f 66 66 20 20 5b 27 5d 20 73 .req? off ['] s
2110: 65 6e 64 2d 63 58 20 63 6f 64 65 2d 72 65 70 6c end-cX code-repl
2120: 79 20 69 73 20 73 65 6e 64 2d 78 74 20 6f 3e 20 y is send-xt o>
2130: 3b 20 74 6f 20 63 6d 64 72 65 73 65 74 0a 3a 6e ; to cmdreset.:n
2140: 6f 6e 61 6d 65 20 28 20 2d 2d 20 61 64 64 72 20 oname ( -- addr
2150: 29 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 2e ) connection .
2160: 63 6f 64 65 2d 73 65 6d 61 20 3b 20 74 6f 20 63 code-sema ; to c
2170: 6d 64 6c 6f 63 6b 0a 3a 6e 6f 6e 61 6d 65 20 28 mdlock.:noname (
2180: 20 2d 2d 20 61 64 64 72 20 75 20 29 20 63 6f 6e -- addr u ) con
2190: 6e 65 63 74 69 6f 6e 20 2e 63 6f 64 65 2d 64 65 nection .code-de
21a0: 73 74 20 63 6d 64 62 75 66 23 20 40 20 3b 20 74 st cmdbuf# @ ; t
21b0: 6f 20 63 6d 64 62 75 66 24 0a 3a 6e 6f 6e 61 6d o cmdbuf$.:nonam
21c0: 65 20 28 20 2d 2d 20 6e 20 29 20 20 6d 61 78 64 e ( -- n ) maxd
21d0: 61 74 61 20 63 6d 64 62 75 66 23 20 40 20 2d 20 ata cmdbuf# @ -
21e0: 3b 20 74 6f 20 6d 61 78 73 74 72 69 6e 67 0a 3a ; to maxstring.:
21f0: 6e 6f 6e 61 6d 65 20 28 20 61 64 64 72 20 75 20 noname ( addr u
2200: 2d 2d 20 29 20 64 75 70 20 6d 61 78 73 74 72 69 -- ) dup maxstri
2210: 6e 67 20 75 3e 20 49 46 0a 09 63 6d 64 62 75 66 ng u> IF..cmdbuf
2220: 24 20 7e 7e 20 6e 65 74 32 6f 3a 73 65 65 20 74 $ ~~ net2o:see t
2230: 72 75 65 20 21 21 63 6d 64 66 69 74 21 21 20 20 rue !!cmdfit!!
2240: 54 48 45 4e 0a 20 20 20 20 74 75 63 6b 20 63 6d THEN. tuck cm
2250: 64 62 75 66 24 20 2b 20 73 77 61 70 20 6d 6f 76 dbuf$ + swap mov
2260: 65 20 63 6d 64 62 75 66 23 20 2b 21 20 3b 20 74 e cmdbuf# +! ; t
2270: 6f 20 2b 63 6d 64 62 75 66 0a 3a 6e 6f 6e 61 6d o +cmdbuf.:nonam
2280: 65 20 28 20 6e 20 2d 2d 20 29 20 20 63 6d 64 62 e ( n -- ) cmdb
2290: 75 66 23 20 2b 21 20 3b 20 74 6f 20 2d 63 6d 64 uf# +! ; to -cmd
22a0: 62 75 66 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d buf.:noname ( --
22b0: 20 36 34 64 65 73 74 20 29 20 63 6f 64 65 2d 76 64dest ) code-v
22c0: 64 65 73 74 20 36 34 64 75 70 20 36 34 2d 30 3d dest 64dup 64-0=
22d0: 20 21 21 6e 6f 2d 64 65 73 74 21 21 20 3b 20 74 !!no-dest!! ; t
22e0: 6f 20 63 6d 64 64 65 73 74 0a 0a 53 65 6d 61 20 o cmddest..Sema
22f0: 63 6d 64 30 6c 6f 63 6b 0a 0a 63 6d 64 2d 62 75 cmd0lock..cmd-bu
2300: 66 2d 63 20 63 6c 61 73 73 0a 20 20 20 20 6d 61 f-c class. ma
2310: 78 64 61 74 61 20 75 76 61 72 20 63 6d 64 30 62 xdata uvar cmd0b
2320: 75 66 0a 65 6e 64 2d 63 6c 61 73 73 20 63 6d 64 uf.end-class cmd
2330: 2d 62 75 66 30 0a 0a 63 6d 64 2d 62 75 66 30 20 -buf0..cmd-buf0
2340: 27 20 6e 65 77 20 73 74 61 74 69 63 2d 61 20 77 ' new static-a w
2350: 69 74 68 2d 61 6c 6c 6f 63 61 74 65 72 20 63 6f ith-allocater co
2360: 64 65 30 2d 62 75 66 5e 20 21 0a 27 20 63 6f 64 de0-buf^ !.' cod
2370: 65 30 2d 62 75 66 5e 20 63 6d 64 62 75 66 3a 20 e0-buf^ cmdbuf:
2380: 63 6f 64 65 30 2d 62 75 66 0a 0a 5c 20 63 6f 6d code0-buf..\ com
2390: 6d 61 6e 64 20 62 75 66 66 65 72 20 69 6e 20 61 mand buffer in a
23a0: 20 73 74 72 69 6e 67 0a 0a 53 65 6d 61 20 63 6d string..Sema cm
23b0: 64 24 6c 6f 63 6b 0a 0a 63 6d 64 2d 62 75 66 2d d$lock..cmd-buf-
23c0: 63 20 63 6c 61 73 73 0a 20 20 20 20 63 65 6c 6c c class. cell
23d0: 20 75 76 61 72 20 63 6d 64 24 0a 65 6e 64 2d 63 uvar cmd$.end-c
23e0: 6c 61 73 73 20 63 6d 64 2d 62 75 66 24 0a 0a 63 lass cmd-buf$..c
23f0: 6d 64 2d 62 75 66 24 20 27 20 6e 65 77 20 73 74 md-buf$ ' new st
2400: 61 74 69 63 2d 61 20 77 69 74 68 2d 61 6c 6c 6f atic-a with-allo
2410: 63 61 74 65 72 20 63 6f 64 65 2d 62 75 66 24 5e cater code-buf$^
2420: 20 21 0a 27 20 63 6f 64 65 2d 62 75 66 24 5e 20 !.' code-buf$^
2430: 63 6d 64 62 75 66 3a 20 63 6f 64 65 2d 62 75 66 cmdbuf: code-buf
2440: 24 0a 0a 63 6f 64 65 2d 62 75 66 24 0a 0a 27 20 $..code-buf$..'
2450: 63 6d 64 24 6c 6f 63 6b 20 74 6f 20 63 6d 64 6c cmd$lock to cmdl
2460: 6f 63 6b 0a 3a 6e 6f 6e 61 6d 65 20 20 63 6d 64 ock.:noname cmd
2470: 24 20 24 40 20 3b 20 74 6f 20 63 6d 64 62 75 66 $ $@ ; to cmdbuf
2480: 24 0a 3a 6e 6f 6e 61 6d 65 20 20 63 6d 64 24 20 $.:noname cmd$
2490: 24 6f 66 66 20 3b 20 74 6f 20 63 6d 64 72 65 73 $off ; to cmdres
24a0: 65 74 0a 27 20 74 72 75 65 20 74 6f 20 6d 61 78 et.' true to max
24b0: 73 74 72 69 6e 67 20 5c 20 72 65 61 6c 6c 79 20 string \ really
24c0: 6d 61 78 75 69 6e 74 20 3d 20 2d 31 20 3d 20 74 maxuint = -1 = t
24d0: 72 75 65 0a 3a 6e 6f 6e 61 6d 65 20 28 20 61 64 rue.:noname ( ad
24e0: 64 72 20 75 20 2d 2d 20 29 20 63 6d 64 24 20 24 dr u -- ) cmd$ $
24f0: 2b 21 20 3b 20 74 6f 20 2b 63 6d 64 62 75 66 0a +! ; to +cmdbuf.
2500: 3a 6e 6f 6e 61 6d 65 20 28 20 6e 20 2d 2d 20 29 :noname ( n -- )
2510: 20 20 63 6d 64 24 20 24 40 6c 65 6e 20 2b 20 63 cmd$ $@len + c
2520: 6d 64 24 20 24 21 6c 65 6e 20 3b 20 74 6f 20 2d md$ $!len ; to -
2530: 63 6d 64 62 75 66 0a 3a 6e 6f 6e 61 6d 65 20 28 cmdbuf.:noname (
2540: 20 2d 2d 20 36 34 64 65 73 74 20 29 20 36 34 23 -- 64dest ) 64#
2550: 30 20 3b 20 74 6f 20 63 6d 64 64 65 73 74 0a 0a 0 ; to cmddest..
2560: 3a 20 67 65 6e 2d 63 6d 64 20 28 20 78 74 20 2d : gen-cmd ( xt -
2570: 2d 20 24 61 64 64 72 20 29 0a 20 20 20 20 63 6d - $addr ). cm
2580: 64 62 75 66 2d 6f 20 40 20 3e 72 20 63 6f 64 65 dbuf-o @ >r code
2590: 2d 62 75 66 24 20 30 20 63 6d 64 24 20 21 40 20 -buf$ 0 cmd$ !@
25a0: 3e 72 20 63 6d 64 62 75 66 23 20 40 20 3e 72 0a >r cmdbuf# @ >r.
25b0: 20 20 20 20 63 61 74 63 68 0a 20 20 20 20 72 3e catch. r>
25c0: 20 63 6d 64 62 75 66 23 20 21 20 20 72 3e 20 63 cmdbuf# ! r> c
25d0: 6d 64 24 20 21 40 20 72 3e 20 63 6d 64 62 75 66 md$ !@ r> cmdbuf
25e0: 2d 6f 20 21 20 20 73 77 61 70 20 74 68 72 6f 77 -o ! swap throw
25f0: 20 3b 0a 3a 20 67 65 6e 2d 63 6d 64 24 20 28 20 ;.: gen-cmd$ (
2600: 78 74 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 xt -- addr u ).
2610: 20 20 20 67 65 6e 2d 63 6d 64 20 20 31 20 74 6d gen-cmd 1 tm
2620: 70 24 23 20 2b 21 20 20 74 6d 70 24 20 24 21 62 p$# +! tmp$ $!b
2630: 75 66 20 20 74 6d 70 24 20 24 40 20 3b 0a 0a 63 uf tmp$ $@ ;..c
2640: 6f 64 65 30 2d 62 75 66 20 5c 20 72 65 73 65 74 ode0-buf \ reset
2650: 20 64 65 66 61 75 6c 74 0a 0a 3a 6e 6f 6e 61 6d default..:nonam
2660: 65 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 20 e ( -- addr u )
2670: 63 6d 64 30 62 75 66 20 63 6d 64 62 75 66 23 20 cmd0buf cmdbuf#
2680: 40 20 3b 20 74 6f 20 63 6d 64 62 75 66 24 0a 27 @ ; to cmdbuf$.'
2690: 20 63 6d 64 30 6c 6f 63 6b 20 74 6f 20 63 6d 64 cmd0lock to cmd
26a0: 6c 6f 63 6b 0a 27 20 72 6e 67 36 34 20 74 6f 20 lock.' rng64 to
26b0: 63 6d 64 64 65 73 74 0a 3a 6e 6f 6e 61 6d 65 20 cmddest.:noname
26c0: 28 20 2d 2d 20 29 20 20 63 6d 64 62 75 66 23 20 ( -- ) cmdbuf#
26d0: 6f 66 66 20 20 6f 20 49 46 20 20 72 65 71 3f 20 off o IF req?
26e0: 6f 66 66 20 20 54 48 45 4e 20 3b 20 74 6f 20 63 off THEN ; to c
26f0: 6d 64 72 65 73 65 74 0a 0a 3a 6e 6f 6e 61 6d 65 mdreset..:noname
2700: 20 28 20 2d 2d 20 29 0a 20 20 20 20 63 6d 64 2d ( -- ). cmd-
2710: 62 75 66 30 20 6e 65 77 20 63 6f 64 65 30 2d 62 buf0 new code0-b
2720: 75 66 5e 20 21 0a 20 20 20 20 63 6d 64 2d 62 75 uf^ !. cmd-bu
2730: 66 2d 63 20 6e 65 77 20 63 6f 64 65 2d 62 75 66 f-c new code-buf
2740: 5e 20 21 0a 20 20 20 20 63 6d 64 2d 62 75 66 24 ^ !. cmd-buf$
2750: 20 6e 65 77 20 63 6f 64 65 2d 62 75 66 24 5e 20 new code-buf$^
2760: 21 20 3b 20 69 73 20 61 6c 6c 6f 63 2d 63 6f 64 ! ; is alloc-cod
2770: 65 2d 62 75 66 73 0a 3a 6e 6f 6e 61 6d 65 0a 20 e-bufs.:noname.
2780: 20 20 20 63 6f 64 65 30 2d 62 75 66 5e 20 40 20 code0-buf^ @
2790: 2e 64 69 73 70 6f 73 65 0a 20 20 20 20 63 6f 64 .dispose. cod
27a0: 65 2d 62 75 66 5e 20 40 20 2e 64 69 73 70 6f 73 e-buf^ @ .dispos
27b0: 65 0a 20 20 20 20 63 6f 64 65 2d 62 75 66 24 5e e. code-buf$^
27c0: 20 40 20 3e 6f 20 63 6d 64 24 20 24 6f 66 66 20 @ >o cmd$ $off
27d0: 64 69 73 70 6f 73 65 20 6f 3e 20 3b 20 69 73 20 dispose o> ; is
27e0: 66 72 65 65 2d 63 6f 64 65 2d 62 75 66 73 0a 0a free-code-bufs..
27f0: 5c 20 73 74 75 66 66 20 69 6e 74 6f 20 63 6f 64 \ stuff into cod
2800: 65 20 62 75 66 66 65 72 73 0a 0a 3a 20 64 6f 2d e buffers..: do-
2810: 3c 72 65 71 20 28 20 2d 2d 20 29 20 20 6f 20 49 <req ( -- ) o I
2820: 46 20 20 72 65 71 3f 20 40 20 30 3e 20 49 46 20 F req? @ 0> IF
2830: 20 72 65 71 3f 20 6f 6e 20 73 74 61 72 74 2d 72 req? on start-r
2840: 65 71 20 20 54 48 45 4e 20 20 54 48 45 4e 20 3b eq THEN THEN ;
2850: 0a 3a 20 63 6d 64 74 6d 70 24 20 28 20 36 34 6e .: cmdtmp$ ( 64n
2860: 20 2d 2d 20 61 64 64 72 20 75 20 29 20 20 63 6d -- addr u ) cm
2870: 64 74 6d 70 20 70 21 2b 20 63 6d 64 74 6d 70 20 dtmp p!+ cmdtmp
2880: 74 75 63 6b 20 2d 20 3b 0a 3a 20 63 6d 64 2c 20 tuck - ;.: cmd,
2890: 28 20 36 34 6e 20 2d 2d 20 29 20 20 64 6f 2d 3c ( 64n -- ) do-<
28a0: 72 65 71 20 63 6d 64 74 6d 70 24 20 2b 63 6d 64 req cmdtmp$ +cmd
28b0: 62 75 66 20 3b 0a 0a 3a 20 6e 65 74 32 6f 2c 20 buf ;..: net2o,
28c0: 40 20 6e 3e 36 34 20 63 6d 64 2c 20 3b 0a 0a 5c @ n>64 cmd, ;..\
28d0: 20 6e 65 74 32 6f 20 64 6f 63 20 70 72 6f 64 75 net2o doc produ
28e0: 63 74 69 6f 6e 0a 0a 44 65 66 65 72 20 2e 6e 2d ction..Defer .n-
28f0: 6e 61 6d 65 20 20 27 20 6e 6f 6f 70 20 69 73 20 name ' noop is
2900: 2e 6e 2d 6e 61 6d 65 0a 5b 49 46 44 45 46 5d 20 .n-name.[IFDEF]
2910: 64 6f 63 67 65 6e 0a 20 20 20 20 66 61 6c 73 65 docgen. false
2920: 20 77 61 72 6e 69 6e 67 73 20 21 40 0a 20 20 20 warnings !@.
2930: 20 3a 20 5c 67 20 28 20 72 65 73 74 2d 6f 66 2d : \g ( rest-of-
2940: 6c 69 6e 65 20 2d 2d 20 29 0a 09 73 6f 75 72 63 line -- )..sourc
2950: 65 20 3e 69 6e 20 40 20 2f 73 74 72 69 6e 67 20 e >in @ /string
2960: 6f 76 65 72 20 32 20 2d 20 63 40 20 27 67 27 20 over 2 - c@ 'g'
2970: 3d 20 3e 72 0a 09 3e 69 6e 20 40 20 33 20 3e 20 = >r..>in @ 3 >
2980: 72 40 20 61 6e 64 20 32 20 61 6e 64 20 73 70 61 r@ and 2 and spa
2990: 63 65 73 0a 09 64 75 70 20 3e 69 6e 20 2b 21 0a ces..dup >in +!.
29a0: 09 72 3e 20 49 46 20 20 74 79 70 65 20 63 72 20 .r> IF type cr
29b0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
29c0: 45 4e 20 3b 20 69 6d 6d 65 64 69 61 74 65 0a 20 EN ; immediate.
29d0: 20 20 20 77 61 72 6e 69 6e 67 73 20 21 0a 5b 54 warnings !.[T
29e0: 48 45 4e 5d 0a 0a 5c 20 6e 65 74 32 6f 20 63 6f HEN]..\ net2o co
29f0: 6d 6d 61 6e 64 20 64 65 66 69 6e 69 74 69 6f 6e mmand definition
2a00: 0a 0a 30 20 56 61 6c 75 65 20 6c 61 73 74 2d 32 ..0 Value last-2
2a10: 6f 0a 0a 3a 20 6e 65 74 32 6f 2d 64 6f 65 73 20 o..: net2o-does
2a20: 20 44 4f 45 53 3e 20 6e 65 74 32 6f 2c 20 3b 0a DOES> net2o, ;.
2a30: 3a 20 6e 65 74 32 6f 3a 20 28 20 6e 75 6d 62 65 : net2o: ( numbe
2a40: 72 20 22 6e 61 6d 65 22 20 2d 2d 20 29 0a 20 20 r "name" -- ).
2a50: 20 20 2e 6e 2d 6e 61 6d 65 0a 20 20 20 20 5b 27 .n-name. ['
2a60: 5d 20 6e 6f 6f 70 20 6f 76 65 72 20 3e 63 6d 64 ] noop over >cmd
2a70: 20 5c 20 61 6c 6c 6f 63 61 74 65 20 73 70 61 63 \ allocate spac
2a80: 65 20 69 6e 20 74 61 62 6c 65 0a 20 20 20 20 43 e in table. C
2a90: 72 65 61 74 65 20 20 68 65 72 65 20 74 6f 20 6c reate here to l
2aa0: 61 73 74 2d 32 6f 0a 20 20 20 20 64 75 70 20 3e ast-2o. dup >
2ab0: 72 20 2c 20 68 65 72 65 20 3e 72 20 30 20 2c 20 r , here >r 0 ,
2ac0: 30 20 2c 20 30 20 2c 20 6e 65 74 32 6f 2d 64 6f 0 , 0 , net2o-do
2ad0: 65 73 20 6e 6f 6e 61 6d 65 20 3a 0a 20 20 20 20 es noname :.
2ae0: 6c 61 73 74 78 74 20 64 75 70 20 72 3e 20 21 20 lastxt dup r> !
2af0: 72 3e 20 3e 63 6d 64 20 3b 0a 3a 20 2b 6e 65 74 r> >cmd ;.: +net
2b00: 32 6f 3a 20 28 20 22 6e 61 6d 65 22 20 2d 2d 20 2o: ( "name" --
2b10: 29 20 67 65 6e 2d 74 61 62 6c 65 20 24 5b 5d 23 ) gen-table $[]#
2b20: 20 6e 65 74 32 6f 3a 20 3b 0a 3a 20 3e 74 61 62 net2o: ;.: >tab
2b30: 6c 65 20 28 20 74 61 62 6c 65 20 2d 2d 20 29 20 le ( table -- )
2b40: 20 6c 61 73 74 2d 32 6f 20 32 20 63 65 6c 6c 73 last-2o 2 cells
2b50: 20 2b 20 21 20 3b 0a 3a 20 63 6d 64 73 69 67 20 + ! ;.: cmdsig
2b60: 28 20 2d 2d 20 61 64 64 72 20 29 20 20 6c 61 73 ( -- addr ) las
2b70: 74 2d 32 6f 20 33 20 63 65 6c 6c 73 20 2b 20 3b t-2o 3 cells + ;
2b80: 0a 3a 20 6e 65 74 32 6f 27 20 28 20 22 6e 61 6d .: net2o' ( "nam
2b90: 65 22 20 2d 2d 20 29 20 27 20 3e 62 6f 64 79 20 e" -- ) ' >body
2ba0: 40 20 3b 0a 0a 46 6f 72 77 61 72 64 20 6e 65 74 @ ;..Forward net
2bb0: 32 6f 3a 77 6f 72 64 73 0a 0a 3a 20 69 6e 68 65 2o:words..: inhe
2bc0: 72 69 74 2d 74 61 62 6c 65 20 28 20 61 64 64 72 rit-table ( addr
2bd0: 20 75 20 22 6e 61 6d 65 22 20 2d 2d 20 29 0a 20 u "name" -- ).
2be0: 20 20 20 27 20 64 75 70 20 49 53 20 67 65 6e 2d ' dup IS gen-
2bf0: 74 61 62 6c 65 20 20 65 78 65 63 75 74 65 20 24 table execute $
2c00: 21 20 3b 0a 0a 56 6f 63 61 62 75 6c 61 72 79 20 ! ;..Vocabulary
2c10: 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 46 6f 72 77 net2o-base..Forw
2c20: 61 72 64 20 64 6f 2d 72 65 71 3e 0a 0a 3a 20 64 ard do-req>..: d
2c30: 6f 2d 6e 65 73 74 20 28 20 61 64 64 72 20 75 20 o-nest ( addr u
2c40: 66 6c 61 67 20 2d 2d 20 29 0a 20 20 20 20 64 75 flag -- ). du
2c50: 70 20 3e 72 20 20 76 61 6c 69 64 61 74 65 64 20 p >r validated
2c60: 6f 72 21 20 20 5b 27 5d 20 6e 65 73 74 2d 63 6d or! ['] nest-cm
2c70: 64 2d 6c 6f 6f 70 20 63 61 74 63 68 0a 20 20 20 d-loop catch.
2c80: 20 72 3e 20 69 6e 76 65 72 74 20 76 61 6c 69 64 r> invert valid
2c90: 61 74 65 64 20 61 6e 64 21 20 20 74 68 72 6f 77 ated and! throw
2ca0: 20 3b 0a 0a 3a 20 64 6f 2d 6e 65 73 74 73 69 67 ;..: do-nestsig
2cb0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
2cc0: 20 20 20 73 69 67 6e 65 64 2d 76 61 6c 20 64 6f signed-val do
2cd0: 2d 6e 65 73 74 20 3b 0a 0a 3a 20 63 6d 64 3a 6e -nest ;..: cmd:n
2ce0: 65 73 74 73 69 67 20 28 20 61 64 64 72 20 75 20 estsig ( addr u
2cf0: 2d 2d 20 29 0a 20 20 20 20 6e 65 73 74 2d 73 69 -- ). nest-si
2d00: 67 20 64 75 70 20 30 3d 20 49 46 20 20 64 72 6f g dup 0= IF dro
2d10: 70 20 64 6f 2d 6e 65 73 74 73 69 67 20 20 45 4c p do-nestsig EL
2d20: 53 45 20 20 21 21 73 69 67 21 21 20 20 54 48 45 SE !!sig!! THE
2d30: 4e 20 3b 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 32 N ;..scope{ net2
2d40: 6f 2d 62 61 73 65 0a 0a 5c 20 43 6f 6d 6d 61 6e o-base..\ Comman
2d50: 64 20 6e 75 6d 62 65 72 73 20 70 72 65 6c 69 6d d numbers prelim
2d60: 69 6e 61 72 79 20 61 6e 64 20 73 75 62 6a 65 63 inary and subjec
2d70: 74 20 74 6f 20 63 68 61 6e 67 65 0a 0a 44 65 66 t to change..Def
2d80: 65 72 20 64 6f 63 28 67 65 6e 20 20 27 20 6e 6f er doc(gen ' no
2d90: 6f 70 20 69 73 20 64 6f 63 28 67 65 6e 0a 0a 3a op is doc(gen..:
2da0: 20 28 3e 73 69 67 20 28 20 22 63 6f 6d 6d 65 6e (>sig ( "commen
2db0: 74 73 22 2a 20 27 5d 27 20 2d 2d 20 29 0a 20 20 ts"* ']' -- ).
2dc0: 20 20 73 22 20 28 22 20 63 6d 64 73 69 67 20 24 s" (" cmdsig $
2dd0: 21 0a 20 20 20 20 42 45 47 49 4e 20 20 70 61 72 !. BEGIN par
2de0: 73 65 2d 6e 61 6d 65 20 64 75 70 20 20 57 48 49 se-name dup WHI
2df0: 4c 45 20 20 6f 76 65 72 20 63 40 20 63 6d 64 73 LE over c@ cmds
2e00: 69 67 20 63 24 2b 21 0a 09 73 22 20 29 22 20 73 ig c$+!..s" )" s
2e10: 74 72 3d 20 55 4e 54 49 4c 20 20 45 4c 53 45 20 tr= UNTIL ELSE
2e20: 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 2drop THEN ;..
2e30: 3a 20 28 20 28 20 22 74 79 70 65 22 2a 20 22 2d : ( ( "type"* "-
2e40: 2d 22 20 22 74 79 70 65 22 2a 20 22 72 70 61 72 -" "type"* "rpar
2e50: 65 6e 22 20 2d 2d 20 29 20 27 29 27 20 70 61 72 en" -- ) ')' par
2e60: 73 65 20 32 64 72 6f 70 20 3b 0a 63 6f 6d 70 73 se 2drop ;.comps
2e70: 65 6d 3a 20 63 6d 64 73 69 67 20 40 20 49 46 20 em: cmdsig @ IF
2e80: 20 27 29 27 20 70 61 72 73 65 20 32 64 72 6f 70 ')' parse 2drop
2e90: 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 EXIT THEN.
2ea0: 20 64 6f 63 28 67 65 6e 20 28 3e 73 69 67 20 3b doc(gen (>sig ;
2eb0: 0a 0a 30 20 6e 65 74 32 6f 3a 20 64 75 6d 6d 79 ..0 net2o: dummy
2ec0: 20 28 20 2d 2d 20 29 20 3b 0a 0a 5b 49 46 44 45 ( -- ) ;..[IFDE
2ed0: 46 5d 20 64 6f 63 67 65 6e 0a 20 20 20 20 3a 6e F] docgen. :n
2ee0: 6f 6e 61 6d 65 20 28 20 2d 2d 20 29 0a 09 3e 69 oname ( -- )..>i
2ef0: 6e 20 40 20 3e 72 20 27 29 27 20 70 61 72 73 65 n @ >r ')' parse
2f00: 20 2e 22 20 20 28 20 22 20 74 79 70 65 20 2e 22 ." ( " type ."
2f10: 20 29 22 20 63 72 20 72 3e 20 3e 69 6e 20 21 20 )" cr r> >in !
2f20: 3b 20 69 73 20 64 6f 63 28 67 65 6e 0a 20 20 20 ; is doc(gen.
2f30: 20 3a 6e 6f 6e 61 6d 65 20 28 20 6e 20 22 6e 61 :noname ( n "na
2f40: 6d 65 22 20 2d 2d 20 29 0a 09 2e 22 20 2a 20 22 me" -- )..." * "
2f50: 20 64 75 70 20 68 65 78 2e 20 3e 69 6e 20 40 20 dup hex. >in @
2f60: 3e 72 20 70 61 72 73 65 2d 6e 61 6d 65 20 74 79 >r parse-name ty
2f70: 70 65 20 72 3e 20 3e 69 6e 20 21 20 3b 20 69 73 pe r> >in ! ; is
2f80: 20 2e 6e 2d 6e 61 6d 65 0a 5b 54 48 45 4e 5d 0a .n-name.[THEN].
2f90: 0a 3a 20 3f 76 65 72 73 69 6f 6e 20 28 20 61 64 .: ?version ( ad
2fa0: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6e 65 dr u -- ). ne
2fb0: 74 32 6f 2d 76 65 72 73 69 6f 6e 20 32 6f 76 65 t2o-version 2ove
2fc0: 72 20 73 74 72 3c 20 49 46 0a 09 3c 65 72 72 3e r str< IF..<err>
2fd0: 20 2e 22 20 4f 74 68 65 72 20 73 69 64 65 20 68 ." Other side h
2fe0: 61 73 20 6d 6f 72 65 20 72 65 63 65 6e 74 20 6e as more recent n
2ff0: 65 74 32 6f 20 76 65 72 73 69 6f 6e 3a 20 22 20 et2o version: "
3000: 66 6f 72 74 68 3a 74 79 70 65 0a 09 3c 77 61 72 forth:type..<war
3010: 6e 3e 20 2e 22 20 2c 20 6f 75 72 73 3a 20 22 20 n> ." , ours: "
3020: 6e 65 74 32 6f 2d 76 65 72 73 69 6f 6e 20 66 6f net2o-version fo
3030: 72 74 68 3a 74 79 70 65 20 3c 64 65 66 61 75 6c rth:type <defaul
3040: 74 3e 20 66 6f 72 74 68 3a 63 72 0a 20 20 20 20 t> forth:cr.
3050: 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 45 ELSE 2drop THE
3060: 4e 20 3b 0a 0a 5c 67 20 23 20 43 6f 6d 6d 61 6e N ;..\g # Comman
3070: 64 73 20 23 0a 5c 67 20 0a 5c 67 20 56 65 72 73 ds #.\g .\g Vers
3080: 69 6f 6e 20 40 56 45 52 53 49 4f 4e 40 2e 0a 5c ion @VERSION@..\
3090: 67 20 0a 5c 67 20 6e 65 74 32 6f 20 73 65 70 61 g .\g net2o sepa
30a0: 72 61 74 65 73 20 64 61 74 61 20 61 6e 64 20 63 rates data and c
30b0: 6f 6d 6d 61 6e 64 73 2e 20 20 44 61 74 61 20 69 ommands. Data i
30c0: 73 20 70 61 73 73 65 64 20 74 68 72 6f 75 67 68 s passed through
30d0: 20 74 6f 20 68 69 67 68 65 72 0a 5c 67 20 6c 61 to higher.\g la
30e0: 79 65 72 73 2c 20 63 6f 6d 6d 61 6e 64 73 20 61 yers, commands a
30f0: 72 65 20 69 6e 74 65 72 70 72 65 74 65 64 20 77 re interpreted w
3100: 68 65 6e 20 74 68 65 79 20 61 72 72 69 76 65 2e hen they arrive.
3110: 20 20 46 6f 72 20 63 6f 6e 6e 65 63 74 69 6f 6e For connection
3120: 0a 5c 67 20 72 65 71 75 65 73 74 73 2c 20 61 20 .\g requests, a
3130: 73 70 65 63 69 61 6c 20 62 69 74 20 69 73 20 73 special bit is s
3140: 65 74 2c 20 61 6e 64 20 74 68 65 20 61 64 64 72 et, and the addr
3150: 65 73 73 20 74 68 65 6e 20 69 73 6e 27 74 20 75 ess then isn't u
3160: 73 65 64 20 61 73 0a 5c 67 20 61 64 64 72 65 73 sed as.\g addres
3170: 73 2c 20 62 75 74 20 61 73 20 49 56 20 66 6f 72 s, but as IV for
3180: 20 74 68 65 20 6f 70 70 6f 72 74 75 6e 69 73 74 the opportunist
3190: 69 63 20 65 6e 63 6f 64 69 6e 67 2e 0a 5c 67 20 ic encoding..\g
31a0: 0a 5c 67 20 54 68 65 20 63 6f 6d 6d 61 6e 64 20 .\g The command
31b0: 69 6e 74 65 72 70 72 65 74 65 72 20 69 73 20 61 interpreter is a
31c0: 20 73 74 61 63 6b 20 6d 61 63 68 69 6e 65 20 77 stack machine w
31d0: 69 74 68 20 74 77 6f 20 64 61 74 61 20 74 79 70 ith two data typ
31e0: 65 73 3a 20 36 34 0a 5c 67 20 62 69 74 20 69 6e es: 64.\g bit in
31f0: 74 65 67 65 72 73 20 61 6e 64 20 73 74 72 69 6e tegers and strin
3200: 67 73 20 28 66 6c 6f 61 74 73 20 61 72 65 20 61 gs (floats are a
3210: 6c 73 6f 20 73 75 70 70 6f 72 65 64 2c 20 62 75 lso suppored, bu
3220: 74 20 75 73 65 64 0a 5c 67 20 69 6e 66 72 65 71 t used.\g infreq
3230: 75 65 6e 74 6c 79 29 2e 20 20 45 6e 63 6f 64 69 uently). Encodi
3240: 6e 67 20 6f 66 20 63 6f 6d 6d 61 6e 64 73 2c 20 ng of commands,
3250: 69 6e 74 65 67 65 72 73 20 61 6e 64 20 73 74 72 integers and str
3260: 69 6e 67 20 6c 65 6e 67 74 68 0a 5c 67 20 66 6f ing length.\g fo
3270: 6c 6c 6f 77 73 20 70 72 6f 74 6f 62 75 66 20 63 llows protobuf c
3280: 6f 6e 63 65 70 74 75 61 6c 6c 79 20 28 62 75 74 onceptually (but
3290: 20 4d 53 42 20 66 69 72 73 74 2c 20 6e 6f 74 20 MSB first, not
32a0: 4c 53 42 20 66 69 72 73 74 20 61 73 20 77 69 74 LSB first as wit
32b0: 68 0a 5c 67 20 70 72 6f 74 6f 62 75 66 2c 20 74 h.\g protobuf, t
32c0: 6f 20 73 69 6d 70 6c 69 66 79 20 73 63 61 6e 6e o simplify scann
32d0: 69 6e 67 29 2c 20 73 74 72 69 6e 67 73 20 61 72 ing), strings ar
32e0: 65 20 6a 75 73 74 20 73 65 71 75 65 6e 63 65 73 e just sequences
32f0: 20 6f 66 0a 5c 67 20 62 79 74 65 73 20 28 69 6e of.\g bytes (in
3300: 74 65 72 70 72 65 74 61 74 69 6f 6e 20 63 61 6e terpretation can
3310: 20 76 61 72 79 29 2e 20 20 43 6f 6d 6d 61 6e 64 vary). Command
3320: 20 62 6c 6f 63 6b 73 20 63 6f 6e 74 61 69 6e 20 blocks contain
3330: 61 20 73 65 71 75 65 6e 63 65 0a 5c 67 20 6f 66 a sequence.\g of
3340: 20 63 6f 6d 6d 61 6e 64 73 3b 20 74 68 65 72 65 commands; there
3350: 20 61 72 65 20 6e 6f 20 63 6f 6e 64 69 74 69 6f are no conditio
3360: 6e 61 6c 73 20 61 6e 64 20 6c 6f 6f 70 69 6e 67 nals and looping
3370: 20 69 6e 73 74 72 75 63 74 69 6f 6e 73 2e 0a 5c instructions..\
3380: 67 20 0a 5c 67 20 53 74 72 69 6e 67 73 20 63 61 g .\g Strings ca
3390: 6e 20 63 6f 6e 74 61 69 6e 20 65 6e 63 72 79 70 n contain encryp
33a0: 74 65 64 20 6e 65 73 74 65 64 20 63 6f 6d 6d 61 ted nested comma
33b0: 6e 64 73 2c 20 75 73 65 64 20 64 75 72 69 6e 67 nds, used during
33c0: 0a 5c 67 20 63 6f 6d 6d 75 6e 69 63 61 74 69 6f .\g communicatio
33d0: 6e 20 73 65 74 75 70 2e 0a 5c 67 20 0a 5c 67 20 n setup..\g .\g
33e0: 23 23 20 4c 69 73 74 20 6f 66 20 43 6f 6d 6d 61 ## List of Comma
33f0: 6e 64 73 20 23 23 0a 5c 67 20 0a 5c 67 20 43 6f nds ##.\g .\g Co
3400: 6d 6d 61 6e 64 73 20 61 72 65 20 63 6f 6e 74 65 mmands are conte
3410: 78 74 2d 73 65 6e 73 69 74 69 76 65 20 69 6e 20 xt-sensitive in
3420: 61 6e 20 4f 4f 50 20 6d 65 74 68 6f 64 20 68 69 an OOP method hi
3430: 65 72 61 72 63 68 79 20 73 65 6e 73 65 2e 0a 5c erarchy sense..\
3440: 67 20 0a 5c 67 20 23 23 23 20 62 61 73 65 20 63 g .\g ### base c
3450: 6f 6d 6d 61 6e 64 73 20 23 23 23 0a 5c 67 20 0a ommands ###.\g .
3460: 0a 30 20 6e 65 74 32 6f 3a 20 65 6e 64 2d 63 6d .0 net2o: end-cm
3470: 64 20 28 20 2d 2d 20 29 20 5c 67 20 65 6e 64 20 d ( -- ) \g end
3480: 63 6f 6d 6d 61 6e 64 20 62 75 66 66 65 72 0a 20 command buffer.
3490: 20 20 20 30 20 62 75 66 2d 73 74 61 74 65 20 21 0 buf-state !
34a0: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6c 69 74 20 28 ;.+net2o: lit (
34b0: 20 23 75 20 2d 2d 20 75 20 29 20 5c 67 20 6c 69 #u -- u ) \g li
34c0: 74 65 72 61 6c 0a 20 20 20 20 70 40 20 3b 0a 2b teral. p@ ;.+
34d0: 6e 65 74 32 6f 3a 20 2d 6c 69 74 20 28 20 23 6e net2o: -lit ( #n
34e0: 20 2d 2d 20 6e 20 29 20 5c 67 20 6e 65 67 61 74 -- n ) \g negat
34f0: 69 76 65 20 6c 69 74 65 72 61 6c 2c 20 69 6e 76 ive literal, inv
3500: 65 72 74 65 64 20 65 6e 63 6f 64 65 64 0a 20 20 erted encoded.
3510: 20 20 70 40 20 36 34 69 6e 76 65 72 74 20 3b 0a p@ 64invert ;.
3520: 2b 6e 65 74 32 6f 3a 20 73 74 72 69 6e 67 20 28 +net2o: string (
3530: 20 23 73 74 72 69 6e 67 20 2d 2d 20 24 3a 73 74 #string -- $:st
3540: 72 69 6e 67 20 29 20 5c 67 20 73 74 72 69 6e 67 ring ) \g string
3550: 20 6c 69 74 65 72 61 6c 0a 20 20 20 20 73 74 72 literal. str
3560: 69 6e 67 40 20 3b 0a 2b 6e 65 74 32 6f 3a 20 66 ing@ ;.+net2o: f
3570: 6c 69 74 20 28 20 23 64 66 6c 6f 61 74 20 2d 2d lit ( #dfloat --
3580: 20 72 20 29 20 5c 67 20 64 6f 75 62 6c 65 20 66 r ) \g double f
3590: 6c 6f 61 74 20 6c 69 74 65 72 61 6c 0a 20 20 20 loat literal.
35a0: 20 70 66 40 20 3b 0a 2b 6e 65 74 32 6f 3a 20 65 pf@ ;.+net2o: e
35b0: 6e 64 2d 77 69 74 68 20 28 20 6f 3a 6f 62 6a 65 nd-with ( o:obje
35c0: 63 74 20 2d 2d 20 29 20 5c 67 20 65 6e 64 20 73 ct -- ) \g end s
35d0: 63 6f 70 65 0a 20 20 20 20 64 6f 2d 72 65 71 3e cope. do-req>
35e0: 20 6e 3a 6f 3e 20 3b 0a 2b 6e 65 74 32 6f 3a 20 n:o> ;.+net2o:
35f0: 6f 73 77 61 70 20 28 20 6f 3a 6e 65 73 74 20 6f oswap ( o:nest o
3600: 3a 63 75 72 72 65 6e 74 20 2d 2d 20 6f 3a 63 75 :current -- o:cu
3610: 72 72 65 6e 74 20 6f 3a 6e 65 73 74 20 29 0a 20 rrent o:nest ).
3620: 20 20 20 64 6f 2d 72 65 71 3e 20 6e 3a 6f 73 77 do-req> n:osw
3630: 61 70 20 3b 0a 2b 6e 65 74 32 6f 3a 20 74 72 75 ap ;.+net2o: tru
3640: 20 28 20 2d 2d 20 66 3a 74 72 75 65 20 29 20 5c ( -- f:true ) \
3650: 67 20 74 72 75 65 20 66 6c 61 67 20 6c 69 74 65 g true flag lite
3660: 72 61 6c 0a 20 20 20 20 74 72 75 65 20 3b 0a 2b ral. true ;.+
3670: 6e 65 74 32 6f 3a 20 66 61 6c 73 20 28 20 2d 2d net2o: fals ( --
3680: 20 66 3a 66 61 6c 73 65 20 29 20 5c 67 20 66 61 f:false ) \g fa
3690: 6c 73 65 20 66 6c 61 67 20 6c 69 74 65 72 61 6c lse flag literal
36a0: 0a 20 20 20 20 66 61 6c 73 65 20 3b 0a 2b 6e 65 . false ;.+ne
36b0: 74 32 6f 3a 20 77 6f 72 64 73 20 28 20 75 73 74 t2o: words ( ust
36c0: 61 72 74 20 2d 2d 20 29 20 5c 67 20 72 65 66 6c art -- ) \g refl
36d0: 65 63 74 69 6f 6e 0a 20 20 20 20 36 34 3e 6e 20 ection. 64>n
36e0: 6e 65 74 32 6f 3a 77 6f 72 64 73 20 3b 0a 2b 6e net2o:words ;.+n
36f0: 65 74 32 6f 3a 20 6e 65 73 74 73 69 67 20 28 20 et2o: nestsig (
3700: 24 3a 63 6d 64 2b 73 69 67 20 2d 2d 20 29 20 5c $:cmd+sig -- ) \
3710: 67 20 63 68 65 63 6b 20 73 69 67 2b 6e 65 73 74 g check sig+nest
3720: 0a 20 20 20 20 24 3e 20 63 6d 64 3a 6e 65 73 74 . $> cmd:nest
3730: 73 69 67 20 3b 20 5c 20 62 61 6c 6b 20 6f 6e 20 sig ; \ balk on
3740: 61 6c 6c 20 77 72 6f 6e 67 20 73 69 67 6e 61 74 all wrong signat
3750: 75 72 65 73 0a 2b 6e 65 74 32 6f 3a 20 73 65 63 ures.+net2o: sec
3760: 73 74 72 69 6e 67 20 28 20 23 73 74 72 69 6e 67 string ( #string
3770: 20 2d 2d 20 24 3a 73 74 72 69 6e 67 20 29 20 5c -- $:string ) \
3780: 67 20 73 65 63 72 65 74 20 73 74 72 69 6e 67 20 g secret string
3790: 6c 69 74 65 72 61 6c 0a 20 20 20 20 73 74 72 69 literal. stri
37a0: 6e 67 40 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6e 6f ng@ ;.+net2o: no
37b0: 70 20 28 20 2d 2d 20 29 20 6e 61 74 28 20 2e 22 p ( -- ) nat( ."
37c0: 20 6e 6f 70 22 20 66 6f 72 74 68 3a 63 72 20 29 nop" forth:cr )
37d0: 20 3b 20 5c 67 20 64 6f 20 6e 6f 74 68 69 6e 67 ; \g do nothing
37e0: 0a 2b 6e 65 74 32 6f 3a 20 34 63 63 20 28 20 23 .+net2o: 4cc ( #
37f0: 33 6c 65 74 74 65 72 20 2d 2d 20 29 0a 20 20 20 3letter -- ).
3800: 20 5c 67 20 41 74 20 74 68 65 20 62 65 67 69 6e \g At the begin
3810: 6e 69 6e 67 20 6f 66 20 61 20 66 69 6c 65 2c 20 ning of a file,
3820: 74 68 69 73 20 63 61 6e 20 62 65 20 75 73 65 64 this can be used
3830: 20 61 73 20 46 6f 75 72 43 43 20 63 6f 64 65 0a as FourCC code.
3840: 20 20 20 20 62 75 66 2d 73 74 61 74 65 20 32 40 buf-state 2@
3850: 20 33 20 2f 73 74 72 69 6e 67 20 64 75 70 20 30 3 /string dup 0
3860: 3c 20 21 21 73 74 72 69 6e 67 66 69 74 21 21 20 < !!stringfit!!
3870: 62 75 66 2d 73 74 61 74 65 20 32 21 20 3b 0a 2b buf-state 2! ;.+
3880: 6e 65 74 32 6f 3a 20 70 61 64 64 69 6e 67 20 28 net2o: padding (
3890: 20 23 6c 65 6e 20 2d 2d 20 29 0a 20 20 20 20 5c #len -- ). \
38a0: 67 20 61 64 64 20 70 61 64 64 69 6e 67 20 74 6f g add padding to
38b0: 20 61 6c 69 67 6e 20 66 69 65 6c 64 73 0a 20 20 align fields.
38c0: 20 20 73 74 72 69 6e 67 40 20 24 3e 20 32 64 72 string@ $> 2dr
38d0: 6f 70 20 3b 0a 2b 6e 65 74 32 6f 3a 20 76 65 72 op ;.+net2o: ver
38e0: 73 69 6f 6e 20 28 20 24 3a 76 65 72 73 69 6f 6e sion ( $:version
38f0: 20 2d 2d 20 29 20 5c 67 20 76 65 72 73 69 6f 6e -- ) \g version
3900: 20 63 68 65 63 6b 0a 20 20 20 20 24 3e 20 3f 76 check. $> ?v
3910: 65 72 73 69 6f 6e 20 3b 0a 7d 73 63 6f 70 65 0a ersion ;.}scope.
3920: 0a 63 6d 64 2d 74 61 62 6c 65 20 24 73 61 76 65 .cmd-table $save
3930: 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 ..also net2o-bas
3940: 65 0a 3a 20 64 6f 2d 72 65 71 3e 20 6f 20 49 46 e.: do-req> o IF
3950: 20 20 72 65 71 3f 20 40 20 30 3c 20 20 49 46 20 req? @ 0< IF
3960: 20 65 6e 64 2d 77 69 74 68 20 72 65 71 3f 20 6f end-with req? o
3970: 66 66 20 20 54 48 45 4e 20 20 54 48 45 4e 20 3b ff THEN THEN ;
3980: 0a 70 72 65 76 69 6f 75 73 0a 0a 67 65 6e 2d 74 .previous..gen-t
3990: 61 62 6c 65 20 24 40 20 69 6e 68 65 72 69 74 2d able $@ inherit-
39a0: 74 61 62 6c 65 20 72 65 70 6c 79 2d 74 61 62 6c table reply-tabl
39b0: 65 0a 0a 5c 20 6e 65 74 32 6f 20 61 73 73 65 6d e..\ net2o assem
39c0: 62 6c 65 72 0a 0a 3a 20 63 6d 64 30 21 20 28 20 bler..: cmd0! (
39d0: 2d 2d 20 29 0a 20 20 20 20 5c 47 20 69 6e 69 74 -- ). \G init
39e0: 69 61 6c 69 7a 65 20 61 20 73 74 61 74 65 6c 65 ialize a statele
39f0: 73 73 20 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 63 ss command. c
3a00: 6f 64 65 30 2d 62 75 66 20 20 73 74 61 74 65 6c ode0-buf statel
3a10: 65 73 73 23 20 6f 75 74 66 6c 61 67 20 21 20 3b ess# outflag ! ;
3a20: 0a 3a 20 63 6d 64 21 20 28 20 2d 2d 20 29 0a 20 .: cmd! ( -- ).
3a30: 20 20 20 5c 47 20 69 6e 69 74 69 61 6c 69 7a 65 \G initialize
3a40: 20 61 20 73 74 61 74 65 66 75 6c 6c 20 63 6f 6d a statefull com
3a50: 6d 61 6e 64 0a 20 20 20 20 63 6f 64 65 2d 62 75 mand. code-bu
3a60: 66 20 20 6f 75 74 66 6c 61 67 20 6f 66 66 20 3b f outflag off ;
3a70: 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 ..also net2o-bas
3a80: 65 0a 0a 55 44 65 66 65 72 20 65 78 70 65 63 74 e..UDefer expect
3a90: 2d 72 65 70 6c 79 3f 0a 27 20 65 6e 64 2d 63 6d -reply?.' end-cm
3aa0: 64 20 49 53 20 65 78 70 65 63 74 2d 72 65 70 6c d IS expect-repl
3ab0: 79 3f 0a 0a 3a 20 69 6e 69 74 2d 72 65 70 6c 79 y?..: init-reply
3ac0: 20 20 5b 27 5d 20 65 6e 64 2d 63 6d 64 20 49 53 ['] end-cmd IS
3ad0: 20 65 78 70 65 63 74 2d 72 65 70 6c 79 3f 20 20 expect-reply?
3ae0: 5b 27 5d 20 64 72 6f 70 20 63 6d 64 2d 72 65 70 ['] drop cmd-rep
3af0: 6c 79 2d 78 74 20 21 20 3b 0a 0a 70 72 65 76 69 ly-xt ! ;..previ
3b00: 6f 75 73 0a 0a 3a 20 6e 65 74 32 6f 2d 63 6f 64 ous..: net2o-cod
3b10: 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 e ( -- ). \G
3b20: 73 74 61 72 74 20 61 20 73 74 61 74 65 66 75 6c start a stateful
3b30: 6c 20 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 63 6d l command. cm
3b40: 64 21 20 20 63 6d 64 6c 6f 63 6b 20 6c 6f 63 6b d! cmdlock lock
3b50: 0a 20 20 20 20 63 6d 64 72 65 73 65 74 20 69 6e . cmdreset in
3b60: 69 74 2d 72 65 70 6c 79 20 31 20 63 6f 64 65 2b it-reply 1 code+
3b70: 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 also net2o-base
3b80: 20 3b 0a 63 6f 6d 70 73 65 6d 3a 20 5b 27 5d 20 ;.compsem: [']
3b90: 6e 65 74 32 6f 2d 63 6f 64 65 20 63 6f 6d 70 69 net2o-code compi
3ba0: 6c 65 2c 20 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 le, also net2o-b
3bb0: 61 73 65 20 3b 0a 3a 20 6e 65 74 32 6f 2d 63 6f ase ;.: net2o-co
3bc0: 64 65 30 0a 20 20 20 20 5c 47 20 73 74 61 72 74 de0. \G start
3bd0: 20 61 20 73 74 61 74 65 6c 65 73 73 20 63 6f 6d a stateless com
3be0: 6d 61 6e 64 0a 20 20 20 20 63 6d 64 30 21 20 20 mand. cmd0!
3bf0: 63 6d 64 6c 6f 63 6b 20 6c 6f 63 6b 0a 20 20 20 cmdlock lock.
3c00: 20 63 6d 64 72 65 73 65 74 20 69 6e 69 74 2d 72 cmdreset init-r
3c10: 65 70 6c 79 20 61 6c 73 6f 20 6e 65 74 32 6f 2d eply also net2o-
3c20: 62 61 73 65 20 3b 0a 63 6f 6d 70 73 65 6d 3a 20 base ;.compsem:
3c30: 5b 27 5d 20 6e 65 74 32 6f 2d 63 6f 64 65 30 20 ['] net2o-code0
3c40: 63 6f 6d 70 69 6c 65 2c 20 61 6c 73 6f 20 6e 65 compile, also ne
3c50: 74 32 6f 2d 62 61 73 65 20 3b 0a 0a 3a 20 70 75 t2o-base ;..: pu
3c60: 6e 63 68 2d 6f 75 74 20 28 20 2d 2d 20 29 0a 20 nch-out ( -- ).
3c70: 20 20 20 63 68 65 63 6b 2d 61 64 64 72 31 20 30 check-addr1 0
3c80: 3d 20 69 6e 64 2d 61 64 64 72 20 40 20 6f 72 20 = ind-addr @ or
3c90: 49 46 20 20 32 64 72 6f 70 20 20 45 58 49 54 20 IF 2drop EXIT
3ca0: 20 54 48 45 4e 0a 20 20 20 20 6e 61 74 28 20 74 THEN. nat( t
3cb0: 69 63 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 icks .ticks ."
3cc0: 70 75 6e 63 68 2d 63 6d 64 3a 20 22 20 32 64 75 punch-cmd: " 2du
3cd0: 70 20 2e 61 64 64 72 65 73 73 20 63 72 20 29 0a p .address cr ).
3ce0: 20 20 20 20 32 3e 72 20 6e 65 74 32 6f 2d 73 6f 2>r net2o-so
3cf0: 63 6b 20 6f 75 74 62 75 66 20 64 75 70 20 70 61 ck outbuf dup pa
3d00: 63 6b 65 74 2d 73 69 7a 65 20 30 20 32 72 3e 20 cket-size 0 2r>
3d10: 73 65 6e 64 74 6f 20 64 72 6f 70 20 3b 0a 0a 3a sendto drop ;..:
3d20: 20 3f 70 75 6e 63 68 2d 63 6d 64 73 20 28 20 2d ?punch-cmds ( -
3d30: 2d 20 29 0a 20 20 20 20 6f 20 49 46 0a 09 70 75 - ). o IF..pu
3d40: 6e 63 68 2d 61 64 64 72 73 20 40 20 49 46 0a 09 nch-addrs @ IF..
3d50: 20 20 20 20 5b 3a 0a 09 20 20 20 20 20 20 6f 75 [:.. ou
3d60: 74 62 75 66 20 64 65 73 74 69 6e 61 74 69 6f 6e tbuf destination
3d70: 20 24 31 30 20 65 72 61 73 65 20 5c 20 6f 6e 6c $10 erase \ onl
3d80: 79 20 64 69 72 65 63 74 20 70 61 63 6b 65 74 73 y direct packets
3d90: 0a 09 20 20 20 20 20 20 70 75 6e 63 68 2d 61 64 .. punch-ad
3da0: 64 72 73 20 24 40 20 62 6f 75 6e 64 73 20 3f 44 drs $@ bounds ?D
3db0: 4f 0a 09 09 20 20 49 20 40 20 5b 27 5d 20 70 75 O... I @ ['] pu
3dc0: 6e 63 68 2d 6f 75 74 20 61 64 64 72 3e 73 6f 63 nch-out addr>soc
3dd0: 6b 0a 09 20 20 20 20 20 20 63 65 6c 6c 20 2b 4c k.. cell +L
3de0: 4f 4f 50 20 20 3b 5d 20 70 75 6e 63 68 2d 77 72 OOP ;] punch-wr
3df0: 61 70 0a 09 54 48 45 4e 0a 20 20 20 20 54 48 45 ap..THEN. THE
3e00: 4e 20 3b 0a 0a 3a 20 73 65 6e 64 2d 63 6d 64 20 N ;..: send-cmd
3e10: 28 20 61 64 64 72 20 75 20 64 65 73 74 20 2d 2d ( addr u dest --
3e20: 20 73 69 7a 65 20 29 20 6e 36 34 2d 73 77 61 70 size ) n64-swap
3e30: 20 7b 20 62 75 66 23 20 7d 0a 20 20 20 20 2b 73 { buf# }. +s
3e40: 65 6e 64 2d 63 6d 64 20 64 65 73 74 2d 61 64 64 end-cmd dest-add
3e50: 72 20 36 34 40 20 36 34 3e 72 20 73 65 74 2d 64 r 64@ 64>r set-d
3e60: 65 73 74 0a 20 20 20 20 63 6d 64 28 20 3c 69 6e est. cmd( <in
3e70: 66 6f 3e 20 2e 22 20 73 65 6e 64 3a 20 22 20 6f fo> ." send: " o
3e80: 75 74 66 6c 61 67 20 2e 64 65 73 74 2d 61 64 64 utflag .dest-add
3e90: 72 20 64 75 70 20 62 75 66 23 20 6e 65 74 32 6f r dup buf# net2o
3ea0: 3a 73 65 65 20 3c 64 65 66 61 75 6c 74 3e 20 63 :see <default> c
3eb0: 72 20 29 0a 20 20 20 20 6d 61 78 2d 73 69 7a 65 r ). max-size
3ec0: 5e 32 20 31 2b 20 30 20 44 4f 0a 09 62 75 66 23 ^2 1+ 0 DO..buf#
3ed0: 20 6d 69 6e 2d 73 69 7a 65 20 49 20 6c 73 68 69 min-size I lshi
3ee0: 66 74 20 75 3c 3d 20 49 46 0a 09 20 20 20 20 49 ft u<= IF.. I
3ef0: 20 6f 75 74 66 6c 61 67 20 40 20 73 74 61 74 65 outflag @ state
3f00: 6c 65 73 73 23 20 61 6e 64 20 49 46 20 20 73 65 less# and IF se
3f10: 6e 64 2d 63 58 20 3f 70 75 6e 63 68 2d 63 6d 64 nd-cX ?punch-cmd
3f20: 73 0a 09 20 20 20 20 45 4c 53 45 0a 09 09 73 65 s.. ELSE...se
3f30: 6e 64 2d 72 65 70 6c 79 20 3e 72 20 6f 76 65 72 nd-reply >r over
3f40: 20 62 75 66 23 20 72 40 20 32 21 0a 09 09 72 3e buf# r@ 2!...r>
3f50: 20 61 63 74 69 6f 6e 2d 6f 66 20 73 65 6e 64 2d action-of send-
3f60: 78 74 20 3f 64 75 70 2d 49 46 20 20 65 78 65 63 xt ?dup-IF exec
3f70: 75 74 65 0a 09 09 45 4c 53 45 20 20 32 64 72 6f ute...ELSE 2dro
3f80: 70 20 3c 65 72 72 3e 20 2e 22 20 73 65 6e 64 2d p <err> ." send-
3f90: 78 74 20 69 73 20 30 22 20 63 72 20 3c 64 65 66 xt is 0" cr <def
3fa0: 61 75 6c 74 3e 20 20 54 48 45 4e 0a 09 20 20 20 ault> THEN..
3fb0: 20 54 48 45 4e 0a 09 20 20 20 20 6d 69 6e 2d 73 THEN.. min-s
3fc0: 69 7a 65 20 49 20 6c 73 68 69 66 74 20 20 55 4e ize I lshift UN
3fd0: 4c 4f 4f 50 0a 09 20 20 20 20 36 34 72 3e 20 64 LOOP.. 64r> d
3fe0: 65 73 74 2d 61 64 64 72 20 36 34 21 20 45 58 49 est-addr 64! EXI
3ff0: 54 20 20 54 48 45 4e 0a 20 20 20 20 4c 4f 4f 50 T THEN. LOOP
4000: 20 20 36 34 72 3e 20 64 65 73 74 2d 61 64 64 72 64r> dest-addr
4010: 20 36 34 21 20 20 74 72 75 65 20 21 21 63 6f 6d 64! true !!com
4020: 6d 61 6e 64 73 21 21 20 3b 0a 0a 5b 49 46 55 4e mands!! ;..[IFUN
4030: 44 45 46 5d 20 66 74 69 6d 65 0a 20 20 20 20 3a DEF] ftime. :
4040: 20 66 74 69 6d 65 20 28 20 2d 2d 20 72 20 29 20 ftime ( -- r )
4050: 6e 74 69 6d 65 20 64 3e 66 20 31 65 2d 39 20 66 ntime d>f 1e-9 f
4060: 2a 20 3b 0a 5b 54 48 45 4e 5d 0a 0a 3a 20 63 6d * ;.[THEN]..: cm
4070: 64 20 28 20 2d 2d 20 29 20 20 63 6d 64 62 75 66 d ( -- ) cmdbuf
4080: 23 20 40 20 31 20 75 3c 3d 20 3f 45 58 49 54 20 # @ 1 u<= ?EXIT
4090: 5c 20 64 6f 6e 27 74 20 73 65 6e 64 20 69 66 20 \ don't send if
40a0: 63 6d 64 62 75 66 20 69 73 20 65 6d 70 74 79 0a cmdbuf is empty.
40b0: 20 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e connection >
40c0: 6f 20 6f 75 74 66 6c 61 67 20 40 20 3e 72 20 63 o outflag @ >r c
40d0: 6d 64 62 75 66 24 20 63 6d 64 64 65 73 74 0a 20 mdbuf$ cmddest.
40e0: 20 20 20 61 76 61 6c 61 6e 63 68 65 28 20 2e 22 avalanche( ."
40f0: 20 73 65 6e 64 20 63 6d 64 3a 20 22 20 66 74 69 send cmd: " fti
4100: 6d 65 20 31 30 30 30 65 20 66 6d 6f 64 20 28 2e me 1000e fmod (.
4110: 74 69 6d 65 29 20 36 34 64 75 70 20 78 36 34 2e time) 64dup x64.
4120: 20 36 34 3e 72 20 64 75 70 20 68 65 78 2e 20 36 64>r dup hex. 6
4130: 34 72 3e 20 63 72 20 29 0a 20 20 20 20 6d 73 67 4r> cr ). msg
4140: 28 20 2e 22 20 73 65 6e 64 20 63 6d 64 20 74 6f ( ." send cmd to
4150: 3a 20 22 20 36 34 64 75 70 20 78 36 34 2e 20 66 : " 64dup x64. f
4160: 6f 72 74 68 3a 63 72 20 29 20 73 65 6e 64 2d 63 orth:cr ) send-c
4170: 6d 64 0a 20 20 20 20 72 3e 20 73 74 61 74 65 6c md. r> statel
4180: 65 73 73 23 20 61 6e 64 20 30 3d 20 49 46 20 20 ess# and 0= IF
4190: 63 6f 64 65 2d 75 70 64 61 74 65 20 20 45 4c 53 code-update ELS
41a0: 45 20 20 64 72 6f 70 20 20 54 48 45 4e 20 6f 3e E drop THEN o>
41b0: 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 ;..also net2o-b
41c0: 61 73 65 0a 0a 3a 20 63 6d 64 2d 73 65 6e 64 3f ase..: cmd-send?
41d0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 63 6d 64 62 ( -- ). cmdb
41e0: 75 66 23 20 40 20 31 20 75 3e 20 49 46 20 20 65 uf# @ 1 u> IF e
41f0: 78 70 65 63 74 2d 72 65 70 6c 79 3f 20 63 6d 64 xpect-reply? cmd
4200: 20 20 54 48 45 4e 20 3b 0a 0a 70 72 65 76 69 6f THEN ;..previo
4210: 75 73 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 6f us..in net2o : o
4220: 6b 3f 20 28 20 2d 2d 20 29 20 20 6f 3f 0a 20 20 k? ( -- ) o?.
4230: 20 20 74 61 67 2d 61 64 64 72 20 3e 72 20 63 6d tag-addr >r cm
4240: 64 62 75 66 24 20 72 40 20 32 21 0a 20 20 20 20 dbuf$ r@ 2!.
4250: 74 61 67 28 20 2e 22 20 74 61 67 3a 20 22 20 74 tag( ." tag: " t
4260: 61 67 2d 61 64 64 72 20 64 75 70 20 68 65 78 2e ag-addr dup hex.
4270: 20 32 40 20 73 77 61 70 20 68 65 78 2e 20 68 65 2@ swap hex. he
4280: 78 2e 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 x. forth:cr ).
4290: 20 20 63 6f 64 65 2d 76 64 65 73 74 20 72 40 20 code-vdest r@
42a0: 72 65 70 6c 79 2d 64 65 73 74 20 36 34 21 0a 20 reply-dest 64!.
42b0: 20 20 20 72 3e 20 63 6f 64 65 2d 72 65 70 6c 79 r> code-reply
42c0: 20 64 75 70 20 6f 66 66 20 20 74 6f 20 72 65 70 dup off to rep
42d0: 6c 79 2d 74 61 67 20 3b 0a 69 6e 20 6e 65 74 32 ly-tag ;.in net2
42e0: 6f 20 3a 20 6f 6b 20 28 20 74 61 67 20 2d 2d 20 o : ok ( tag --
42f0: 29 20 5c 20 2e 22 20 6f 6b 22 20 66 6f 72 74 68 ) \ ." ok" forth
4300: 3a 63 72 0a 5c 20 20 20 20 74 69 6d 65 6f 75 74 :cr.\ timeout
4310: 28 20 2e 22 20 6f 6b 3a 20 22 20 64 75 70 20 68 ( ." ok: " dup h
4320: 65 78 2e 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 ex. forth:cr ).
4330: 20 20 20 6f 20 30 3d 20 49 46 20 20 64 72 6f 70 o 0= IF drop
4340: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
4350: 72 65 71 75 65 73 74 28 20 2e 22 20 72 65 71 75 request( ." requ
4360: 65 73 74 20 61 63 6b 65 64 3a 20 22 20 64 75 70 est acked: " dup
4370: 20 2e 20 63 72 20 29 0a 20 20 20 20 72 65 73 65 . cr ). rese
4380: 6e 64 30 20 24 6f 66 66 0a 20 20 20 20 6e 61 74 nd0 $off. nat
4390: 28 20 2e 22 20 6f 6b 20 66 72 6f 6d 3a 20 22 20 ( ." ok from: "
43a0: 72 65 74 2d 61 64 64 72 20 2e 61 64 64 72 2d 70 ret-addr .addr-p
43b0: 61 74 68 20 73 70 61 63 65 20 64 75 70 20 2e 0a ath space dup ..
43c0: 20 20 20 20 64 75 70 20 72 65 70 6c 79 5b 5d 20 dup reply[]
43d0: 32 40 20 64 30 3d 20 49 46 20 2e 22 20 61 63 6b 2@ d0= IF ." ack
43e0: 65 64 22 20 20 54 48 45 4e 20 63 72 20 29 0a 20 ed" THEN cr ).
43f0: 20 20 20 23 30 2e 20 32 20 70 69 63 6b 20 72 65 #0. 2 pick re
4400: 70 6c 79 5b 5d 20 64 75 70 20 3e 72 20 32 21 0a ply[] dup >r 2!.
4410: 20 20 20 20 74 69 63 6b 73 20 72 40 20 72 65 70 ticks r@ rep
4420: 6c 79 2d 74 69 6d 65 20 36 34 40 20 36 34 2d 20 ly-time 64@ 64-
4430: 61 63 6b 40 20 3e 6f 0a 20 20 20 20 72 74 64 28 ack@ >o. rtd(
4440: 20 2e 22 20 72 74 64 65 6c 61 79 20 6f 6b 3a 20 ." rtdelay ok:
4450: 22 20 36 34 64 75 70 20 36 34 3e 66 20 2e 6e 73 " 64dup 64>f .ns
4460: 20 63 72 20 29 0a 20 20 20 20 30 20 74 69 6d 65 cr ). 0 time
4470: 6f 75 74 73 20 21 40 20 72 74 64 28 20 64 75 70 outs !@ rtd( dup
4480: 20 2e 20 29 20 31 20 75 3e 20 49 46 20 20 72 74 . ) 1 u> IF rt
4490: 64 65 6c 61 79 20 36 34 40 20 36 34 75 6d 61 78 delay 64@ 64umax
44a0: 0a 09 72 74 64 28 20 2e 22 20 72 74 64 65 6c 61 ..rtd( ." rtdela
44b0: 79 20 74 2d 6f 3a 20 22 20 36 34 64 75 70 20 36 y t-o: " 64dup 6
44c0: 34 3e 66 20 2e 6e 73 20 63 72 20 29 20 20 54 48 4>f .ns cr ) TH
44d0: 45 4e 0a 20 20 20 20 72 74 64 65 6c 61 79 20 36 EN. rtdelay 6
44e0: 34 21 20 20 6f 3e 0a 20 20 20 20 2d 31 20 72 65 4! o>. -1 re
44f0: 71 63 6f 75 6e 74 20 2b 21 40 20 31 20 3d 20 49 qcount +!@ 1 = I
4500: 46 0a 09 77 61 69 74 2d 74 61 73 6b 20 40 20 3f F..wait-task @ ?
4510: 64 75 70 2d 49 46 20 20 77 61 6b 65 23 20 27 73 dup-IF wake# 's
4520: 20 40 20 31 2b 20 65 6c 69 74 2c 20 3a 3e 77 61 @ 1+ elit, :>wa
4530: 6b 65 20 20 54 48 45 4e 0a 20 20 20 20 54 48 45 ke THEN. THE
4540: 4e 0a 20 20 20 20 30 20 72 3e 20 61 64 64 72 20 N. 0 r> addr
4550: 72 65 70 6c 79 2d 78 74 20 21 40 20 64 75 70 20 reply-xt !@ dup
4560: 49 46 20 20 65 78 65 63 75 74 65 20 20 45 4c 53 IF execute ELS
4570: 45 20 20 32 64 72 6f 70 20 20 54 48 45 4e 20 3b E 2drop THEN ;
4580: 20 5c 20 63 6c 65 61 72 20 72 65 71 75 65 73 74 \ clear request
4590: 0a 3a 20 6e 65 74 32 6f 3a 65 78 70 65 63 74 2d .: net2o:expect-
45a0: 72 65 70 6c 79 20 28 20 2d 2d 20 29 0a 20 20 20 reply ( -- ).
45b0: 20 6f 20 30 3d 20 49 46 20 20 6d 73 67 28 20 2e o 0= IF msg( .
45c0: 22 20 66 61 69 6c 20 65 78 70 65 63 74 20 72 65 " fail expect re
45d0: 70 6c 79 22 20 66 6f 72 74 68 3a 63 72 20 29 20 ply" forth:cr )
45e0: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
45f0: 74 69 6d 65 6f 75 74 28 20 63 6d 64 28 20 2e 22 timeout( cmd( ."
4600: 20 65 78 70 65 63 74 3a 20 22 20 63 6d 64 62 75 expect: " cmdbu
4610: 66 24 20 6e 65 74 32 6f 3a 73 65 65 20 29 20 29 f$ net2o:see ) )
4620: 0a 20 20 20 20 6d 73 67 28 20 2e 22 20 45 78 70 . msg( ." Exp
4630: 65 63 74 20 72 65 70 6c 79 22 20 6f 75 74 66 6c ect reply" outfl
4640: 61 67 20 40 20 73 74 61 74 65 6c 65 73 73 23 20 ag @ stateless#
4650: 61 6e 64 20 49 46 20 2e 22 20 20 73 74 61 74 65 and IF ." state
4660: 6c 65 73 73 22 20 54 48 45 4e 20 66 6f 72 74 68 less" THEN forth
4670: 3a 63 72 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 :cr ). connec
4680: 74 69 6f 6e 20 3e 6f 20 63 6f 64 65 2d 72 65 70 tion >o code-rep
4690: 6c 79 20 3e 72 0a 20 20 20 20 72 40 20 72 65 70 ly >r. r@ rep
46a0: 6c 79 2d 74 61 67 20 3f 64 75 70 2d 49 46 20 20 ly-tag ?dup-IF
46b0: 6f 66 66 20 20 30 20 72 40 20 74 6f 20 72 65 70 off 0 r@ to rep
46c0: 6c 79 2d 74 61 67 20 20 74 48 45 4e 0a 20 20 20 ly-tag tHEN.
46d0: 20 63 6f 64 65 2d 76 64 65 73 74 20 20 20 20 20 code-vdest
46e0: 72 40 20 72 65 70 6c 79 2d 64 65 73 74 20 36 34 r@ reply-dest 64
46f0: 21 0a 20 20 20 20 74 69 63 6b 73 20 20 20 20 20 !. ticks
4700: 20 20 20 20 20 72 40 20 72 65 70 6c 79 2d 74 69 r@ reply-ti
4710: 6d 65 20 36 34 21 0a 20 20 20 20 63 6d 64 2d 72 me 64!. cmd-r
4720: 65 70 6c 79 2d 78 74 20 40 20 72 3e 20 69 73 20 eply-xt @ r> is
4730: 72 65 70 6c 79 2d 78 74 0a 20 20 20 20 31 20 72 reply-xt. 1 r
4740: 65 71 63 6f 75 6e 74 20 2b 21 40 20 64 72 6f 70 eqcount +!@ drop
4750: 20 6f 3e 20 3b 0a 0a 3a 20 74 61 6b 65 2d 72 65 o> ;..: take-re
4760: 74 20 28 20 2d 2d 20 29 0a 5c 20 20 20 20 6e 61 t ( -- ).\ na
4770: 74 28 20 2e 22 20 74 61 6b 65 20 72 65 74 3a 20 t( ." take ret:
4780: 22 20 72 65 74 75 72 6e 2d 61 64 64 72 20 2e 61 " return-addr .a
4790: 64 64 72 2d 70 61 74 68 20 73 70 61 63 65 20 2e ddr-path space .
47a0: 22 20 20 2d 3e 20 22 20 72 65 74 75 72 6e 2d 61 " -> " return-a
47b0: 64 64 72 65 73 73 20 2e 61 64 64 72 2d 70 61 74 ddress .addr-pat
47c0: 68 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 h forth:cr ).
47d0: 20 72 65 74 75 72 6e 2d 61 64 64 72 20 72 65 74 return-addr ret
47e0: 75 72 6e 2d 61 64 64 72 65 73 73 20 24 31 30 20 urn-address $10
47f0: 6d 6f 76 65 20 3b 0a 0a 3a 20 74 61 67 2d 61 64 move ;..: tag-ad
4800: 64 72 3f 20 28 20 2d 2d 20 66 6c 61 67 20 29 0a dr? ( -- flag ).
4810: 20 20 20 20 74 61 67 2d 61 64 64 72 20 64 75 70 tag-addr dup
4820: 20 3e 72 20 32 40 0a 20 20 20 20 3f 64 75 70 2d >r 2@. ?dup-
4830: 49 46 0a 09 63 6d 64 28 20 64 65 73 74 2d 61 64 IF..cmd( dest-ad
4840: 64 72 20 36 34 40 20 78 36 34 2e 20 2e 22 20 72 dr 64@ x64. ." r
4850: 65 73 65 6e 64 20 63 61 6e 6e 65 64 20 63 6f 64 esend canned cod
4860: 65 20 72 65 70 6c 79 20 22 20 72 40 20 68 65 78 e reply " r@ hex
4870: 2e 20 66 6f 72 74 68 3a 63 72 20 29 0a 09 72 65 . forth:cr )..re
4880: 73 65 6e 64 28 20 2e 22 20 72 65 73 65 6e 64 20 send( ." resend
4890: 63 61 6e 6e 65 64 20 63 6f 64 65 20 72 65 70 6c canned code repl
48a0: 79 20 22 20 72 40 20 68 65 78 2e 20 66 6f 72 74 y " r@ hex. fort
48b0: 68 3a 63 72 20 29 0a 09 74 61 6b 65 2d 72 65 74 h:cr )..take-ret
48c0: 0a 09 72 3e 20 72 65 70 6c 79 2d 64 65 73 74 20 ..r> reply-dest
48d0: 36 34 40 20 73 65 6e 64 2d 63 6d 64 20 64 72 6f 64@ send-cmd dro
48e0: 70 20 74 72 75 65 0a 09 31 20 70 61 63 6b 65 74 p true..1 packet
48f0: 73 32 20 2b 21 0a 20 20 20 20 45 4c 53 45 20 20 s2 +!. ELSE
4900: 64 65 73 74 2d 61 64 64 72 20 36 34 40 20 5b 20 dest-addr 64@ [
4910: 63 65 6c 6c 20 34 20 3d 20 5d 20 5b 49 46 5d 20 cell 4 = ] [IF]
4920: 30 3c 3e 20 2d 20 5b 54 48 45 4e 5d 20 64 75 70 0<> - [THEN] dup
4930: 20 30 20 72 3e 20 32 21 20 75 3e 3d 20 20 54 48 0 r> 2! u>= TH
4940: 45 4e 20 3b 0a 0a 3a 20 63 6d 64 2d 65 78 65 63 EN ;..: cmd-exec
4950: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
4960: 20 20 20 6f 20 74 6f 20 63 6f 6e 6e 65 63 74 69 o to connecti
4970: 6f 6e 0a 20 20 20 20 6f 20 49 46 0a 09 6d 61 78 on. o IF..max
4980: 64 61 74 61 20 63 6f 64 65 2b 20 20 63 6d 64 21 data code+ cmd!
4990: 0a 09 74 61 67 2d 61 64 64 72 3f 20 49 46 0a 09 ..tag-addr? IF..
49a0: 20 20 20 20 32 64 72 6f 70 20 20 61 63 6b 40 20 2drop ack@
49b0: 2e 3e 66 6c 79 62 75 72 73 74 20 20 31 20 70 61 .>flyburst 1 pa
49c0: 63 6b 65 74 72 32 20 2b 21 20 20 45 58 49 54 20 cketr2 +! EXIT
49d0: 20 54 48 45 4e 0a 09 74 61 6b 65 2d 72 65 74 0a THEN..take-ret.
49e0: 20 20 20 20 45 4c 53 45 0a 09 63 6d 64 30 21 0a ELSE..cmd0!.
49f0: 20 20 20 20 54 48 45 4e 0a 20 20 20 20 73 74 72 THEN. str
4a00: 69 6e 67 2d 73 74 61 63 6b 20 24 66 72 65 65 20 ing-stack $free
4a10: 20 6f 62 6a 65 63 74 2d 73 74 61 63 6b 20 24 66 object-stack $f
4a20: 72 65 65 20 20 6e 65 73 74 2d 73 74 61 63 6b 20 ree nest-stack
4a30: 24 66 72 65 65 0a 20 20 20 20 5b 3a 20 6f 75 74 $free. [: out
4a40: 66 6c 61 67 20 40 20 3e 72 20 63 6d 64 72 65 73 flag @ >r cmdres
4a50: 65 74 20 69 6e 69 74 2d 72 65 70 6c 79 20 64 6f et init-reply do
4a60: 2d 63 6d 64 2d 6c 6f 6f 70 0a 20 20 20 20 20 20 -cmd-loop.
4a70: 72 3e 20 6f 75 74 66 6c 61 67 20 21 20 63 6d 64 r> outflag ! cmd
4a80: 2d 73 65 6e 64 3f 20 3b 5d 20 63 6d 64 6c 6f 63 -send? ;] cmdloc
4a90: 6b 20 63 2d 73 65 63 74 69 6f 6e 20 3b 0a 0a 5c k c-section ;..\
4aa0: 20 6e 65 73 74 65 64 20 63 6f 6d 6d 61 6e 64 73 nested commands
4ab0: 0a 0a 55 73 65 72 20 6e 65 73 74 73 74 61 72 74 ..User neststart
4ac0: 23 0a 55 73 65 72 20 6c 61 73 74 2d 73 69 67 6e #.User last-sign
4ad0: 65 64 20 63 65 6c 6c 20 75 61 6c 6c 6f 74 20 64 ed cell uallot d
4ae0: 72 6f 70 0a 3a 20 2b 6c 61 73 74 2d 73 69 67 6e rop.: +last-sign
4af0: 65 64 20 28 20 61 64 64 72 20 2d 2d 20 29 20 64 ed ( addr -- ) d
4b00: 72 6f 70 20 6c 61 73 74 2d 73 69 67 6e 65 64 20 rop last-signed
4b10: 63 65 6c 6c 2b 20 2b 21 20 3b 0a 0a 32 20 43 6f cell+ +! ;..2 Co
4b20: 6e 73 74 61 6e 74 20 66 77 64 23 20 5c 20 6d 61 nstant fwd# \ ma
4b30: 78 69 6d 75 6d 20 31 34 20 62 69 74 73 20 3d 20 ximum 14 bits =
4b40: 31 36 6b 42 0a 0a 3a 20 6e 65 73 74 24 20 28 20 16kB..: nest$ (
4b50: 2d 2d 20 61 64 64 72 20 75 20 29 20 20 63 6d 64 -- addr u ) cmd
4b60: 62 75 66 24 20 6e 65 73 74 73 74 61 72 74 23 20 buf$ neststart#
4b70: 40 20 73 61 66 65 2f 73 74 72 69 6e 67 20 3b 0a @ safe/string ;.
4b80: 0a 3a 20 63 6d 64 2d 72 65 73 6f 6c 76 65 3e 20 .: cmd-resolve>
4b90: 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 ( -- addr u ).
4ba0: 20 20 6e 65 73 74 24 20 6f 76 65 72 20 3e 72 20 nest$ over >r
4bb0: 64 75 70 20 6e 3e 36 34 20 63 6d 64 74 6d 70 24 dup n>64 cmdtmp$
4bc0: 20 64 75 70 20 66 77 64 23 20 75 3e 20 21 21 73 dup fwd# u> !!s
4bd0: 74 72 69 6e 67 66 69 74 21 21 0a 20 20 20 20 72 tringfit!!. r
4be0: 3e 20 6f 76 65 72 20 2d 20 73 77 61 70 20 6d 6f > over - swap mo
4bf0: 76 65 0a 20 20 20 20 6e 65 73 74 2d 73 74 61 63 ve. nest-stac
4c00: 6b 20 73 74 61 63 6b 3e 20 6e 65 73 74 73 74 61 k stack> neststa
4c10: 72 74 23 20 21 20 3b 0a 0a 61 6c 73 6f 20 6e 65 rt# ! ;..also ne
4c20: 74 32 6f 2d 62 61 73 65 0a 0a 3a 20 2b 7a 65 72 t2o-base..: +zer
4c30: 6f 31 36 20 28 20 2d 2d 20 29 20 22 5c 30 5c 30 o16 ( -- ) "\0\0
4c40: 5c 30 5c 30 5c 30 5c 30 5c 30 5c 30 5c 30 5c 30 \0\0\0\0\0\0\0\0
4c50: 5c 30 5c 30 5c 30 5c 30 5c 30 5c 30 22 20 2b 63 \0\0\0\0\0\0" +c
4c60: 6d 64 62 75 66 20 3b 0a 3a 20 73 69 67 6e 5b 20 mdbuf ;.: sign[
4c70: 28 20 2d 2d 20 29 20 6e 65 73 74 73 74 61 72 74 ( -- ) neststart
4c80: 23 20 40 20 6e 65 73 74 2d 73 74 61 63 6b 20 3e # @ nest-stack >
4c90: 73 74 61 63 6b 0a 20 20 20 20 73 74 72 69 6e 67 stack. string
4ca0: 20 22 5c 78 38 30 5c 78 30 30 22 20 2b 63 6d 64 "\x80\x00" +cmd
4cb0: 62 75 66 20 63 6d 64 62 75 66 24 20 6e 69 70 20 buf cmdbuf$ nip
4cc0: 6e 65 73 74 73 74 61 72 74 23 20 21 20 3b 0a 3a neststart# ! ;.:
4cd0: 20 6e 65 73 74 5b 20 28 20 2d 2d 20 29 20 73 69 nest[ ( -- ) si
4ce0: 67 6e 5b 20 2b 7a 65 72 6f 31 36 20 3b 20 5c 20 gn[ +zero16 ; \
4cf0: 61 64 64 20 73 70 61 63 65 20 66 6f 72 20 49 56 add space for IV
4d00: 0a 3a 20 27 5d 73 69 67 6e 20 28 20 78 74 20 2d .: ']sign ( xt -
4d10: 2d 20 29 0a 20 20 20 20 63 3a 30 6b 65 79 20 6e - ). c:0key n
4d20: 65 73 74 24 0a 5c 20 20 20 20 2e 22 20 73 69 67 est$.\ ." sig
4d30: 6e 3a 20 22 20 32 64 75 70 20 78 74 79 70 65 20 n: " 2dup xtype
4d40: 66 6f 72 74 68 3a 63 72 0a 20 20 20 20 63 3a 68 forth:cr. c:h
4d50: 61 73 68 20 24 74 6d 70 20 2b 63 6d 64 62 75 66 ash $tmp +cmdbuf
4d60: 0a 20 20 20 20 63 6d 64 2d 72 65 73 6f 6c 76 65 . cmd-resolve
4d70: 3e 20 20 3e 72 20 63 6d 64 62 75 66 24 20 64 72 > >r cmdbuf$ dr
4d80: 6f 70 20 2d 20 72 3e 20 6c 61 73 74 2d 73 69 67 op - r> last-sig
4d90: 6e 65 64 20 32 21 20 20 6e 65 73 74 73 69 67 20 ned 2! nestsig
4da0: 3b 0a 3a 20 5d 73 69 67 6e 20 28 20 2d 2d 20 29 ;.: ]sign ( -- )
4db0: 20 5b 27 5d 20 2e 73 69 67 20 27 5d 73 69 67 6e ['] .sig ']sign
4dc0: 20 3b 0a 3a 20 5d 70 6b 73 69 67 6e 20 28 20 2d ;.: ]pksign ( -
4dd0: 2d 20 29 20 5b 3a 20 2e 70 6b 20 2e 73 69 67 20 - ) [: .pk .sig
4de0: 3b 5d 20 27 5d 73 69 67 6e 20 3b 0a 0a 70 72 65 ;] ']sign ;..pre
4df0: 76 69 6f 75 73 0a 0a 3a 20 63 6d 64 3e 20 28 20 vious..: cmd> (
4e00: 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 -- addr u ).
4e10: 2b 7a 65 72 6f 31 36 20 5c 20 61 64 64 20 73 70 +zero16 \ add sp
4e20: 61 63 65 20 66 6f 72 20 63 68 65 63 6b 73 75 6d ace for checksum
4e30: 0a 20 20 20 20 63 6d 64 2d 72 65 73 6f 6c 76 65 . cmd-resolve
4e40: 3e 20 3b 0a 0a 3a 20 63 6d 64 3e 6e 65 73 74 20 > ;..: cmd>nest
4e50: 28 20 2d 2d 20 61 64 64 72 20 75 20 29 20 63 6d ( -- addr u ) cm
4e60: 64 3e 20 32 64 75 70 20 6d 79 6b 65 79 2d 65 6e d> 2dup mykey-en
4e70: 63 72 79 70 74 24 20 3b 0a 3a 20 63 6d 64 3e 74 crypt$ ;.: cmd>t
4e80: 6d 70 6e 65 73 74 20 28 20 2d 2d 20 61 64 64 72 mpnest ( -- addr
4e90: 20 75 20 29 0a 20 20 20 20 63 6d 64 3e 20 32 64 u ). cmd> 2d
4ea0: 75 70 20 74 6d 70 6b 65 79 40 20 6b 65 79 73 69 up tmpkey@ keysi
4eb0: 7a 65 20 75 6d 69 6e 0a 20 20 20 20 6b 65 79 28 ze umin. key(
4ec0: 20 2e 22 20 74 6d 70 6e 65 73 74 20 6b 65 79 3a ." tmpnest key:
4ed0: 20 22 20 32 64 75 70 20 38 35 74 79 70 65 20 66 " 2dup 85type f
4ee0: 6f 72 74 68 3a 63 72 20 29 20 65 6e 63 72 79 70 orth:cr ) encryp
4ef0: 74 24 20 3b 0a 3a 20 63 6d 64 3e 65 6e 63 6e 65 t$ ;.: cmd>encne
4f00: 73 74 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 st ( -- addr u )
4f10: 0a 20 20 20 20 63 6d 64 3e 20 32 64 75 70 20 74 . cmd> 2dup t
4f20: 6d 70 6b 65 79 40 0a 20 20 20 20 6b 65 79 28 20 mpkey@. key(
4f30: 2e 22 20 74 6d 70 6e 65 73 74 20 6b 65 79 3a 20 ." tmpnest key:
4f40: 22 20 32 64 75 70 20 38 35 74 79 70 65 20 66 6f " 2dup 85type fo
4f50: 72 74 68 3a 63 72 20 29 20 65 6e 63 72 79 70 74 rth:cr ) encrypt
4f60: 24 20 3b 0a 0a 3a 20 63 6d 64 6e 65 73 74 20 28 $ ;..: cmdnest (
4f70: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 20 6d 79 addr u -- ) my
4f80: 6b 65 79 2d 64 65 63 72 79 70 74 24 0a 20 20 20 key-decrypt$.
4f90: 20 49 46 20 20 6f 77 6e 2d 63 72 79 70 74 2d 76 IF own-crypt-v
4fa0: 61 6c 20 64 6f 2d 6e 65 73 74 20 20 45 4c 53 45 al do-nest ELSE
4fb0: 0a 09 3c 65 72 72 3e 20 2e 22 20 63 6d 64 6e 65 ..<err> ." cmdne
4fc0: 73 74 3a 20 6e 6f 20 6f 77 6e 63 72 79 70 74 2c st: no owncrypt,
4fd0: 20 75 6e 2d 63 6d 64 22 20 3c 64 65 66 61 75 6c un-cmd" <defaul
4fe0: 74 3e 20 66 6f 72 74 68 3a 63 72 0a 09 75 6e 2d t> forth:cr..un-
4ff0: 63 6d 64 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 63 cmd THEN ;..: c
5000: 6d 64 74 6d 70 6e 65 73 74 20 28 20 61 64 64 72 mdtmpnest ( addr
5010: 20 75 20 2d 2d 20 29 0a 20 20 20 20 24 3e 61 6c u -- ). $>al
5020: 69 67 6e 20 74 6d 70 6b 65 79 40 20 6b 65 79 7c ign tmpkey@ key|
5030: 20 64 75 70 20 49 46 0a 09 6b 65 79 28 20 2e 22 dup IF..key( ."
5040: 20 74 6d 70 6e 65 73 74 20 6b 65 79 3a 20 22 20 tmpnest key: "
5050: 32 64 75 70 20 38 35 74 79 70 65 20 66 6f 72 74 2dup 85type fort
5060: 68 3a 63 72 20 29 20 64 65 63 72 79 70 74 24 0a h:cr ) decrypt$.
5070: 09 49 46 20 20 20 20 74 6d 70 2d 63 72 79 70 74 .IF tmp-crypt
5080: 2d 76 61 6c 20 64 6f 2d 6e 65 73 74 0a 09 45 4c -val do-nest..EL
5090: 53 45 0a 09 20 20 20 20 3c 65 72 72 3e 20 2e 22 SE.. <err> ."
50a0: 20 74 6d 70 6e 65 73 74 20 66 61 69 6c 65 64 2c tmpnest failed,
50b0: 20 75 6e 63 6d 64 22 20 3c 64 65 66 61 75 6c 74 uncmd" <default
50c0: 3e 20 66 6f 72 74 68 3a 63 72 0a 09 20 20 20 20 > forth:cr..
50d0: 6e 65 74 32 6f 3a 73 65 65 2d 6d 65 20 32 64 72 net2o:see-me 2dr
50e0: 6f 70 20 75 6e 2d 63 6d 64 20 20 54 48 45 4e 0a op un-cmd THEN.
50f0: 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 ELSE 2drop
5100: 32 64 72 6f 70 20 75 6e 2d 63 6d 64 20 20 54 48 2drop un-cmd TH
5110: 45 4e 20 3b 0a 3a 20 63 6d 64 65 6e 63 6e 65 73 EN ;.: cmdencnes
5120: 74 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a t ( addr u -- ).
5130: 20 20 20 20 24 3e 61 6c 69 67 6e 20 74 6d 70 6b $>align tmpk
5140: 65 79 40 20 64 75 70 20 49 46 0a 09 6b 65 79 28 ey@ dup IF..key(
5150: 20 2e 22 20 65 6e 63 6e 65 73 74 20 6b 65 79 3a ." encnest key:
5160: 20 22 20 32 64 75 70 20 38 35 74 79 70 65 20 66 " 2dup 85type f
5170: 6f 72 74 68 3a 63 72 20 29 20 64 65 63 72 79 70 orth:cr ) decryp
5180: 74 24 0a 09 49 46 20 20 20 20 65 6e 63 2d 63 72 t$..IF enc-cr
5190: 79 70 74 2d 76 61 6c 20 64 6f 2d 6e 65 73 74 20 ypt-val do-nest
51a0: 20 5b 20 71 72 2d 74 6d 70 2d 76 61 6c 20 69 6e [ qr-tmp-val in
51b0: 76 65 72 74 20 5d 4c 20 76 61 6c 69 64 61 74 65 vert ]L validate
51c0: 64 20 61 6e 64 21 0a 09 45 4c 53 45 20 3c 65 72 d and!..ELSE <er
51d0: 72 3e 20 2e 22 20 65 6e 63 6e 65 73 74 20 66 61 r> ." encnest fa
51e0: 69 6c 65 64 2c 20 75 6e 63 6d 64 22 20 3c 64 65 iled, uncmd" <de
51f0: 66 61 75 6c 74 3e 20 66 6f 72 74 68 3a 63 72 0a fault> forth:cr.
5200: 09 20 20 20 20 32 64 72 6f 70 20 75 6e 2d 63 6d . 2drop un-cm
5210: 64 20 20 54 48 45 4e 0a 20 20 20 20 45 4c 53 45 d THEN. ELSE
5220: 20 20 3c 65 72 72 3e 20 2e 22 20 65 6e 63 6e 65 <err> ." encne
5230: 73 74 3a 20 6e 6f 20 74 6d 70 6b 65 79 22 20 3c st: no tmpkey" <
5240: 64 65 66 61 75 6c 74 3e 20 66 6f 72 74 68 3a 63 default> forth:c
5250: 72 0a 09 32 64 72 6f 70 20 32 64 72 6f 70 20 75 r..2drop 2drop u
5260: 6e 2d 63 6d 64 20 20 54 48 45 4e 20 3b 0a 0a 5c n-cmd THEN ;..\
5270: 20 6e 65 74 32 6f 20 61 73 73 65 6d 62 6c 65 72 net2o assembler
5280: 20 73 74 75 66 66 0a 0a 77 6f 72 64 6c 69 73 74 stuff..wordlist
5290: 20 63 6f 6e 73 74 61 6e 74 20 73 75 66 66 69 78 constant suffix
52a0: 2d 6c 69 73 74 0a 67 65 74 2d 63 75 72 72 65 6e -list.get-curren
52b0: 74 20 73 75 66 66 69 78 2d 6c 69 73 74 20 73 65 t suffix-list se
52c0: 74 2d 63 75 72 72 65 6e 74 0a 27 20 76 61 75 6c t-current.' vaul
52d0: 74 2d 74 61 62 6c 65 20 61 6c 69 61 73 20 76 32 t-table alias v2
52e0: 6f 0a 27 20 6b 65 79 2d 65 6e 74 72 79 2d 74 61 o.' key-entry-ta
52f0: 62 6c 65 20 61 6c 69 61 73 20 6e 32 6f 0a 73 65 ble alias n2o.se
5300: 74 2d 63 75 72 72 65 6e 74 0a 0a 3a 20 34 63 63 t-current..: 4cc
5310: 3e 74 61 62 6c 65 20 28 20 61 64 64 72 20 75 20 >table ( addr u
5320: 2d 2d 20 29 20 5c 20 72 65 61 6c 6c 79 20 69 73 -- ) \ really is
5330: 20 6a 75 73 74 20 33 20 63 68 61 72 61 63 74 65 just 3 characte
5340: 72 73 0a 20 20 20 20 73 75 66 66 69 78 2d 6c 69 rs. suffix-li
5350: 73 74 20 66 69 6e 64 2d 6e 61 6d 65 2d 69 6e 20 st find-name-in
5360: 3f 64 75 70 2d 49 46 20 20 6e 61 6d 65 3e 69 6e ?dup-IF name>in
5370: 74 20 65 78 65 63 75 74 65 20 40 0a 20 20 20 20 t execute @.
5380: 45 4c 53 45 20 20 73 65 65 3a 74 61 62 6c 65 20 ELSE see:table
5390: 40 20 20 54 48 45 4e 20 3b 0a 3a 20 73 75 66 66 @ THEN ;.: suff
53a0: 69 78 3e 74 61 62 6c 65 20 28 20 61 64 64 72 20 ix>table ( addr
53b0: 75 20 2d 2d 20 29 0a 20 20 20 20 32 64 75 70 20 u -- ). 2dup
53c0: 27 2e 27 20 2d 73 63 61 6e 20 6e 69 70 20 2f 73 '.' -scan nip /s
53d0: 74 72 69 6e 67 20 34 63 63 3e 74 61 62 6c 65 20 tring 4cc>table
53e0: 3b 0a 0a 73 63 6f 70 65 7b 20 6e 65 74 32 6f 2d ;..scope{ net2o-
53f0: 62 61 73 65 0a 0a 3a 20 6d 61 78 74 69 6d 69 6e base..: maxtimin
5400: 67 20 28 20 2d 2d 20 6e 20 29 20 20 6d 61 78 73 g ( -- n ) maxs
5410: 74 72 69 6e 67 20 74 69 6d 65 73 74 61 74 73 20 tring timestats
5420: 2d 20 64 75 70 20 74 69 6d 65 73 74 61 74 73 20 - dup timestats
5430: 6d 6f 64 20 2d 20 3b 0a 3a 20 73 74 72 69 6e 67 mod - ;.: string
5440: 2c 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 , ( addr u -- )
5450: 20 64 75 70 20 6e 3e 36 34 20 63 6d 64 2c 20 2b dup n>64 cmd, +
5460: 63 6d 64 62 75 66 20 3b 0a 3a 20 24 2c 20 28 20 cmdbuf ;.: $, (
5470: 61 64 64 72 20 75 20 2d 2d 20 29 20 20 73 74 72 addr u -- ) str
5480: 69 6e 67 0a 20 20 20 20 64 75 70 20 6d 61 78 73 ing. dup maxs
5490: 74 72 69 6e 67 20 75 3e 20 49 46 20 20 7e 7e 20 tring u> IF ~~
54a0: 74 72 75 65 20 21 21 73 74 72 69 6e 67 66 69 74 true !!stringfit
54b0: 21 21 20 20 54 48 45 4e 0a 20 20 20 20 5c 20 65 !! THEN. \ e
54c0: 78 74 72 61 20 74 65 73 74 20 74 6f 20 67 69 76 xtra test to giv
54d0: 65 20 6d 65 61 6e 69 6e 67 66 75 6c 20 65 72 72 e meaningful err
54e0: 6f 72 20 6d 65 73 73 61 67 65 73 0a 20 20 20 20 or messages.
54f0: 73 74 72 69 6e 67 2c 20 3b 0a 3a 20 73 65 63 24 string, ;.: sec$
5500: 2c 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 , ( addr u -- )
5510: 20 73 65 63 73 74 72 69 6e 67 20 73 74 72 69 6e secstring strin
5520: 67 2c 20 3b 0a 3a 20 6c 69 74 2c 20 28 20 36 34 g, ;.: lit, ( 64
5530: 6e 20 2d 2d 20 29 20 20 64 75 70 20 30 3c 20 49 n -- ) dup 0< I
5540: 46 20 20 2d 6c 69 74 20 36 34 69 6e 76 65 72 74 F -lit 64invert
5550: 20 45 4c 53 45 20 6c 69 74 20 54 48 45 4e 20 63 ELSE lit THEN c
5560: 6d 64 2c 20 3b 0a 3a 20 6e 6c 69 74 2c 20 28 20 md, ;.: nlit, (
5570: 6e 20 2d 2d 20 29 20 20 6e 3e 36 34 20 6c 69 74 n -- ) n>64 lit
5580: 2c 20 3b 0a 3a 20 75 6c 69 74 2c 20 28 20 75 20 , ;.: ulit, ( u
5590: 2d 2d 20 29 20 20 75 3e 36 34 20 6c 69 74 2c 20 -- ) u>64 lit,
55a0: 3b 0a 3a 20 34 63 63 2c 20 28 20 61 64 64 72 20 ;.: 4cc, ( addr
55b0: 75 20 2d 2d 20 29 20 32 64 75 70 20 2a 2d 77 69 u -- ) 2dup *-wi
55c0: 64 74 68 20 33 20 3c 3e 20 21 21 34 63 63 21 21 dth 3 <> !!4cc!!
55d0: 20 64 72 6f 70 0a 20 20 20 20 34 63 63 20 78 63 drop. 4cc xc
55e0: 40 2b 20 6e 3e 36 34 20 63 6d 64 2c 20 78 63 40 @+ n>64 cmd, xc@
55f0: 2b 20 6e 3e 36 34 20 63 6d 64 2c 20 78 63 40 2b + n>64 cmd, xc@+
5600: 20 6e 3e 36 34 20 63 6d 64 2c 20 64 72 6f 70 20 n>64 cmd, drop
5610: 3b 0a 3a 20 66 6c 6f 61 74 2c 20 28 20 72 20 2d ;.: float, ( r -
5620: 2d 20 29 20 20 66 6c 69 74 20 63 6d 64 74 6d 70 - ) flit cmdtmp
5630: 20 70 66 21 2b 20 63 6d 64 74 6d 70 20 74 75 63 pf!+ cmdtmp tuc
5640: 6b 20 2d 20 2b 63 6d 64 62 75 66 20 3b 0a 3a 20 k - +cmdbuf ;.:
5650: 66 6c 61 67 2c 20 28 20 66 6c 61 67 20 2d 2d 20 flag, ( flag --
5660: 29 20 49 46 20 74 72 75 20 45 4c 53 45 20 66 61 ) IF tru ELSE fa
5670: 6c 73 20 54 48 45 4e 20 3b 0a 3a 20 28 65 6e 64 ls THEN ;.: (end
5680: 2d 63 6f 64 65 29 20 28 20 2d 2d 20 29 20 65 78 -code) ( -- ) ex
5690: 70 65 63 74 2d 72 65 70 6c 79 3f 20 63 6d 64 20 pect-reply? cmd
56a0: 20 63 6d 64 6c 6f 63 6b 20 75 6e 6c 6f 63 6b 20 cmdlock unlock
56b0: 3b 0a 3a 20 65 6e 64 2d 63 6f 64 65 20 28 20 2d ;.: end-code ( -
56c0: 2d 20 29 20 28 65 6e 64 2d 63 6f 64 65 29 20 70 - ) (end-code) p
56d0: 72 65 76 69 6f 75 73 20 3b 0a 63 6f 6d 70 73 65 revious ;.compse
56e0: 6d 3a 20 5b 27 5d 20 65 6e 64 2d 63 6f 64 65 20 m: ['] end-code
56f0: 63 6f 6d 70 69 6c 65 2c 20 70 72 65 76 69 6f 75 compile, previou
5700: 73 20 3b 0a 3a 20 70 75 73 68 2d 63 6d 64 20 28 s ;.: push-cmd (
5710: 20 2d 2d 20 29 0a 20 20 20 20 65 6e 64 2d 63 6d -- ). end-cm
5720: 64 20 63 6d 64 62 75 66 24 20 70 75 73 68 2d 72 d cmdbuf$ push-r
5730: 65 70 6c 79 20 3b 0a 0a 3a 20 5d 6e 65 73 74 24 eply ;..: ]nest$
5740: 20 20 28 20 2d 2d 20 29 20 20 63 6d 64 3e 6e 65 ( -- ) cmd>ne
5750: 73 74 20 32 64 72 6f 70 20 3b 0a 3a 20 5d 6e 65 st 2drop ;.: ]ne
5760: 73 74 24 21 20 20 28 20 61 64 64 72 20 2d 2d 20 st$! ( addr --
5770: 29 0a 20 20 20 20 6e 65 73 74 73 74 61 72 74 23 ). neststart#
5780: 20 40 20 3e 72 20 63 6d 64 3e 6e 65 73 74 20 72 @ >r cmd>nest r
5790: 6f 74 20 24 21 0a 20 20 20 20 72 3e 20 66 77 64 ot $!. r> fwd
57a0: 23 20 2d 20 31 2d 20 63 6d 64 62 75 66 24 20 6e # - 1- cmdbuf$ n
57b0: 69 70 20 2d 20 2d 63 6d 64 62 75 66 20 3b 0a 7d ip - -cmdbuf ;.}
57c0: 73 63 6f 70 65 0a 0a 5b 49 46 44 45 46 5d 20 36 scope..[IFDEF] 6
57d0: 34 62 69 74 0a 20 20 20 20 27 20 6e 6f 6f 70 20 4bit. ' noop
57e0: 41 6c 69 61 73 20 32 2a 36 34 3e 6e 20 69 6d 6d Alias 2*64>n imm
57f0: 65 64 69 61 74 65 0a 20 20 20 20 27 20 6e 6f 6f ediate. ' noo
5800: 70 20 41 6c 69 61 73 20 33 2a 36 34 3e 6e 20 69 p Alias 3*64>n i
5810: 6d 6d 65 64 69 61 74 65 0a 5b 45 4c 53 45 5d 0a mmediate.[ELSE].
5820: 20 20 20 20 3a 20 32 2a 36 34 3e 6e 20 28 20 36 : 2*64>n ( 6
5830: 34 61 20 36 34 62 20 2d 2d 20 6e 61 20 6e 62 20 4a 64b -- na nb
5840: 29 20 36 34 3e 6e 20 3e 72 20 36 34 3e 6e 20 72 ) 64>n >r 64>n r
5850: 3e 20 3b 0a 20 20 20 20 3a 20 33 2a 36 34 3e 6e > ;. : 3*64>n
5860: 20 28 20 36 34 61 20 36 34 62 20 36 34 63 20 2d ( 64a 64b 64c -
5870: 2d 20 6e 61 20 6e 62 20 6e 63 20 29 20 36 34 3e - na nb nc ) 64>
5880: 6e 20 3e 72 20 36 34 3e 6e 20 3e 72 20 36 34 3e n >r 64>n >r 64>
5890: 6e 20 72 3e 20 72 3e 20 3b 0a 5b 54 48 45 4e 5d n r> r> ;.[THEN]
58a0: 0a 0a 5c 20 63 6f 6d 6d 61 6e 64 73 20 74 6f 20 ..\ commands to
58b0: 72 65 70 6c 79 0a 0a 73 63 6f 70 65 7b 20 6e 65 reply..scope{ ne
58c0: 74 32 6f 2d 62 61 73 65 0a 5c 67 20 0a 5c 67 20 t2o-base.\g .\g
58d0: 23 23 23 20 72 65 70 6c 79 20 63 6f 6d 6d 61 6e ### reply comman
58e0: 64 73 20 23 23 23 0a 5c 67 20 0a 24 31 30 20 6e ds ###.\g .$10 n
58f0: 65 74 32 6f 3a 20 70 75 73 68 27 20 28 20 23 63 et2o: push' ( #c
5900: 6d 64 20 2d 2d 20 29 20 5c 67 20 70 75 73 68 20 md -- ) \g push
5910: 63 6f 6d 6d 61 6e 64 20 69 6e 74 6f 20 61 6e 73 command into ans
5920: 77 65 72 20 70 61 63 6b 65 74 0a 20 20 20 20 70 wer packet. p
5930: 40 20 63 6d 64 2c 20 3b 0a 2b 6e 65 74 32 6f 3a @ cmd, ;.+net2o:
5940: 20 70 75 73 68 2d 6c 69 74 20 28 20 75 20 2d 2d push-lit ( u --
5950: 20 29 20 5c 67 20 70 75 73 68 20 75 6e 73 69 67 ) \g push unsig
5960: 6e 65 64 20 6c 69 74 65 72 61 6c 20 69 6e 74 6f ned literal into
5970: 20 61 6e 73 77 65 72 20 70 61 63 6b 65 74 0a 20 answer packet.
5980: 20 20 20 6c 69 74 2c 20 3b 0a 27 20 70 75 73 68 lit, ;.' push
5990: 2d 6c 69 74 20 61 6c 69 61 73 20 70 75 73 68 2d -lit alias push-
59a0: 63 68 61 72 0a 24 31 33 20 6e 65 74 32 6f 3a 20 char.$13 net2o:
59b0: 70 75 73 68 2d 24 20 28 20 24 3a 73 74 72 69 6e push-$ ( $:strin
59c0: 67 20 2d 2d 20 29 20 5c 67 20 70 75 73 68 20 73 g -- ) \g push s
59d0: 74 72 69 6e 67 20 69 6e 74 6f 20 61 6e 73 77 65 tring into answe
59e0: 72 20 70 61 63 6b 65 74 0a 20 20 20 20 24 3e 20 r packet. $>
59f0: 24 2c 20 3b 0a 2b 6e 65 74 32 6f 3a 20 70 75 73 $, ;.+net2o: pus
5a00: 68 2d 66 6c 6f 61 74 20 28 20 72 20 2d 2d 20 29 h-float ( r -- )
5a10: 20 5c 67 20 70 75 73 68 20 66 6c 6f 61 74 69 6e \g push floatin
5a20: 67 20 70 6f 69 6e 74 20 6e 75 6d 62 65 72 0a 20 g point number.
5a30: 20 20 20 66 6c 6f 61 74 2c 20 3b 0a 2b 6e 65 74 float, ;.+net
5a40: 32 6f 3a 20 6f 6b 20 28 20 75 74 61 67 20 2d 2d 2o: ok ( utag --
5a50: 20 29 20 5c 67 20 74 61 67 67 65 64 20 72 65 73 ) \g tagged res
5a60: 70 6f 6e 73 65 0a 20 20 20 20 36 34 3e 6e 20 6e ponse. 64>n n
5a70: 65 74 32 6f 3a 6f 6b 20 3b 0a 2b 6e 65 74 32 6f et2o:ok ;.+net2o
5a80: 3a 20 6f 6b 3f 20 28 20 75 74 61 67 20 2d 2d 20 : ok? ( utag --
5a90: 29 20 5c 67 20 72 65 71 75 65 73 74 20 74 61 67 ) \g request tag
5aa0: 67 65 64 20 72 65 73 70 6f 6e 73 65 0a 20 20 20 ged response.
5ab0: 20 6c 69 74 2c 20 6f 6b 20 6e 65 74 32 6f 3a 6f lit, ok net2o:o
5ac0: 6b 3f 20 3b 0a 5c 20 55 73 65 20 6b 6f 20 69 6e k? ;.\ Use ko in
5ad0: 73 74 65 61 64 20 6f 66 20 74 68 72 6f 77 20 66 stead of throw f
5ae0: 6f 72 20 6e 6f 74 20 61 63 6b 6e 6f 77 6c 65 64 or not acknowled
5af0: 67 65 20 28 6b 75 64 6f 73 20 74 6f 20 48 65 69 ge (kudos to Hei
5b00: 6e 7a 20 53 63 68 6e 69 74 74 65 72 29 0a 2b 6e nz Schnitter).+n
5b10: 65 74 32 6f 3a 20 6b 6f 20 28 20 75 65 72 72 6f et2o: ko ( uerro
5b20: 72 20 2d 2d 20 29 20 5c 67 20 72 65 63 65 69 76 r -- ) \g receiv
5b30: 65 20 65 72 72 6f 72 20 6d 65 73 73 61 67 65 0a e error message.
5b40: 20 20 20 20 72 65 6d 6f 74 65 3f 20 6f 66 66 20 remote? off
5b50: 74 68 72 6f 77 20 3b 0a 2b 6e 65 74 32 6f 3a 20 throw ;.+net2o:
5b60: 6e 65 73 74 20 28 20 24 3a 73 74 72 69 6e 67 20 nest ( $:string
5b70: 2d 2d 20 29 20 5c 67 20 6e 65 73 74 65 64 20 28 -- ) \g nested (
5b80: 73 65 6c 66 2d 65 6e 63 72 79 70 74 65 64 29 20 self-encrypted)
5b90: 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 24 3e 20 63 command. $> c
5ba0: 6d 64 6e 65 73 74 20 3b 0a 5c 20 69 6e 73 70 65 mdnest ;.\ inspe
5bb0: 63 74 69 6f 6e 0a 2b 6e 65 74 32 6f 3a 20 74 6f ction.+net2o: to
5bc0: 6b 65 6e 20 28 20 24 3a 74 6f 6b 65 6e 20 6e 20 ken ( $:token n
5bd0: 2d 2d 20 29 20 36 34 64 72 6f 70 20 24 3e 20 32 -- ) 64drop $> 2
5be0: 64 72 6f 70 20 3b 20 5c 67 20 67 65 6e 65 72 69 drop ; \g generi
5bf0: 63 20 69 6e 73 70 65 63 74 69 6f 6e 20 74 6f 6b c inspection tok
5c00: 65 6e 0a 2b 6e 65 74 32 6f 3a 20 65 72 72 6f 72 en.+net2o: error
5c10: 2d 69 64 20 28 20 24 3a 65 72 72 6f 72 69 64 20 -id ( $:errorid
5c20: 2d 2d 20 29 20 5c 67 20 65 72 72 6f 72 2d 69 64 -- ) \g error-id
5c30: 20 73 74 72 69 6e 67 0a 20 20 20 20 24 3e 20 24 string. $> $
5c40: 65 72 72 6f 72 2d 69 64 20 24 21 20 3b 0a 2b 6e error-id $! ;.+n
5c50: 65 74 32 6f 3a 20 76 65 72 73 69 6f 6e 3f 20 28 et2o: version? (
5c60: 20 24 3a 76 65 72 73 69 6f 6e 20 2d 2d 20 29 20 $:version -- )
5c70: 5c 67 20 76 65 72 73 69 6f 6e 20 63 72 6f 73 73 \g version cross
5c80: 2d 63 68 65 63 6b 0a 20 20 20 20 73 74 72 69 6e -check. strin
5c90: 67 2d 73 74 61 63 6b 20 24 5b 5d 23 20 49 46 20 g-stack $[]# IF
5ca0: 20 24 3e 20 3f 76 65 72 73 69 6f 6e 20 20 54 48 $> ?version TH
5cb0: 45 4e 20 5c 20 61 63 63 65 70 74 20 71 75 65 72 EN \ accept quer
5cc0: 79 2d 6f 6e 6c 79 0a 20 20 20 20 6e 65 74 32 6f y-only. net2o
5cd0: 2d 76 65 72 73 69 6f 6e 20 24 2c 20 76 65 72 73 -version $, vers
5ce0: 69 6f 6e 20 3b 0a 0a 3a 20 5d 6e 65 73 74 20 20 ion ;..: ]nest
5cf0: 28 20 2d 2d 20 29 20 20 5d 6e 65 73 74 24 20 70 ( -- ) ]nest$ p
5d00: 75 73 68 2d 24 20 70 75 73 68 27 20 6e 65 73 74 ush-$ push' nest
5d10: 20 3b 0a 0a 7d 73 63 6f 70 65 0a 0a 72 65 70 6c ;..}scope..repl
5d20: 79 2d 74 61 62 6c 65 20 24 73 61 76 65 0a 0a 61 y-table $save..a
5d30: 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a lso net2o-base..
5d40: 3a 20 6e 65 74 32 6f 3a 77 6f 72 64 73 20 28 20 : net2o:words (
5d50: 73 74 61 72 74 20 2d 2d 20 29 0a 20 20 20 20 74 start -- ). t
5d60: 6f 6b 65 6e 2d 74 61 62 6c 65 20 24 40 20 32 20 oken-table $@ 2
5d70: 70 69 63 6b 20 63 65 6c 6c 73 20 73 61 66 65 2f pick cells safe/
5d80: 73 74 72 69 6e 67 20 62 6f 75 6e 64 73 20 55 2b string bounds U+
5d90: 44 4f 0a 09 49 20 40 20 3f 64 75 70 2d 49 46 0a DO..I @ ?dup-IF.
5da0: 09 20 20 20 20 64 75 70 20 3e 6e 65 74 32 6f 2d . dup >net2o-
5db0: 73 69 67 20 32 3e 72 20 3e 6e 65 74 32 6f 2d 6e sig 2>r >net2o-n
5dc0: 61 6d 65 0a 09 20 20 20 20 64 75 70 20 24 41 30 ame.. dup $A0
5dd0: 20 2b 20 6d 61 78 73 74 72 69 6e 67 20 75 3c 20 + maxstring u<
5de0: 49 46 0a 09 09 32 20 70 69 63 6b 20 75 6c 69 74 IF...2 pick ulit
5df0: 2c 20 32 72 3e 20 32 73 77 61 70 20 5b 3a 20 74 , 2r> 2swap [: t
5e00: 79 70 65 20 74 79 70 65 20 3b 5d 20 24 74 6d 70 ype type ;] $tmp
5e10: 20 24 2c 20 74 6f 6b 65 6e 0a 09 20 20 20 20 45 $, token.. E
5e20: 4c 53 45 20 20 32 64 72 6f 70 20 72 64 72 6f 70 LSE 2drop rdrop
5e30: 20 72 64 72 6f 70 20 20 54 48 45 4e 0a 09 54 48 rdrop THEN..TH
5e40: 45 4e 20 20 31 2b 0a 20 20 20 20 63 65 6c 6c 20 EN 1+. cell
5e50: 2b 4c 4f 4f 50 20 20 64 72 6f 70 20 3b 0a 0a 70 +LOOP drop ;..p
5e60: 72 65 76 69 6f 75 73 0a 0a 5c 5c 5c 0a 4c 6f 63 revious..\\\.Loc
5e70: 61 6c 20 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f al Variables:.fo
5e80: 72 74 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a rth-local-words:
5e90: 0a 20 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e . (. (("n
5ea0: 65 74 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 et2o:" "+net2o:"
5eb0: 20 22 65 76 65 6e 74 3a 22 29 20 64 65 66 69 6e "event:") defin
5ec0: 69 74 69 6f 6e 2d 73 74 61 72 74 65 72 20 28 66 ition-starter (f
5ed0: 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 79 77 6f 72 64 ont-lock-keyword
5ee0: 2d 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20 -face . 1).
5ef0: 20 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d "[ \t\n]" t nam
5f00: 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 66 75 6e e (font-lock-fun
5f10: 63 74 69 6f 6e 2d 6e 61 6d 65 2d 66 61 63 65 20 ction-name-face
5f20: 2e 20 33 29 29 0a 20 20 20 20 20 28 28 22 64 65 . 3)). (("de
5f30: 62 75 67 3a 22 20 22 66 69 65 6c 64 3a 22 20 22 bug:" "field:" "
5f40: 32 66 69 65 6c 64 3a 22 20 22 73 66 66 69 65 6c 2field:" "sffiel
5f50: 64 3a 22 20 22 64 66 66 69 65 6c 64 3a 22 20 22 d:" "dffield:" "
5f60: 36 34 66 69 65 6c 64 3a 22 20 22 75 76 61 72 22 64field:" "uvar"
5f70: 20 22 75 76 61 6c 75 65 22 29 20 6e 6f 6e 2d 69 "uvalue") non-i
5f80: 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e 74 2d 6c mmediate (font-l
5f90: 6f 63 6b 2d 74 79 70 65 2d 66 61 63 65 20 2e 20 ock-type-face .
5fa0: 32 29 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 2). "[ \t\n
5fb0: 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d ]" t name (font-
5fc0: 6c 6f 63 6b 2d 76 61 72 69 61 62 6c 65 2d 6e 61 lock-variable-na
5fd0: 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 me-face . 3)).
5fe0: 20 20 20 28 22 5b 61 2d 7a 5c 2d 30 2d 39 5d 2b ("[a-z\-0-9]+
5ff0: 28 22 20 69 6d 6d 65 64 69 61 74 65 20 28 66 6f (" immediate (fo
6000: 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 6e 74 2d nt-lock-comment-
6010: 66 61 63 65 20 2e 20 31 29 0a 20 20 20 20 20 20 face . 1).
6020: 22 29 22 20 6e 69 6c 20 63 6f 6d 6d 65 6e 74 20 ")" nil comment
6030: 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f 6d 6d 65 (font-lock-comme
6040: 6e 74 2d 66 61 63 65 20 2e 20 31 29 29 0a 20 20 nt-face . 1)).
6050: 20 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d ).forth-local-
6060: 69 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 20 indent-words:.
6070: 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 32 (. (("net2
6080: 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 28 o:" "+net2o:") (
6090: 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 20 6e 0 . 2) (0 . 2) n
60a0: 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 on-immediate).
60b0: 20 20 20 28 28 22 65 76 65 6e 74 3a 22 29 20 28 (("event:") (
60c0: 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 20 6e 0 . 2) (0 . 2) n
60d0: 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 on-immediate).
60e0: 20 20 29 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a ).End:.[THEN].