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 c2 a9 20 32 30 31 31 2d 32 30 31 34 20 20 20 © 2011-2014
0040: 42 65 72 6e 64 20 50 61 79 73 61 6e 0a 0a 5c 20 Bernd Paysan..\
0050: 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 This program is
0060: 66 72 65 65 20 73 6f 66 74 77 61 72 65 3a 20 79 free software: y
0070: 6f 75 20 63 61 6e 20 72 65 64 69 73 74 72 69 62 ou can redistrib
0080: 75 74 65 20 69 74 20 61 6e 64 2f 6f 72 20 6d 6f ute it and/or mo
0090: 64 69 66 79 0a 5c 20 69 74 20 75 6e 64 65 72 20 dify.\ it under
00a0: 74 68 65 20 74 65 72 6d 73 20 6f 66 20 74 68 65 the terms of the
00b0: 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 GNU Affero Gene
00c0: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
00d0: 73 65 20 61 73 20 70 75 62 6c 69 73 68 65 64 20 se as published
00e0: 62 79 0a 5c 20 74 68 65 20 46 72 65 65 20 53 6f by.\ the Free So
00f0: 66 74 77 61 72 65 20 46 6f 75 6e 64 61 74 69 6f ftware Foundatio
0100: 6e 2c 20 65 69 74 68 65 72 20 76 65 72 73 69 6f n, either versio
0110: 6e 20 33 20 6f 66 20 74 68 65 20 4c 69 63 65 6e n 3 of the Licen
0120: 73 65 2c 20 6f 72 0a 5c 20 28 61 74 20 79 6f 75 se, or.\ (at you
0130: 72 20 6f 70 74 69 6f 6e 29 20 61 6e 79 20 6c 61 r option) any la
0140: 74 65 72 20 76 65 72 73 69 6f 6e 2e 0a 0a 5c 20 ter version...\
0150: 54 68 69 73 20 70 72 6f 67 72 61 6d 20 69 73 20 This program is
0160: 64 69 73 74 72 69 62 75 74 65 64 20 69 6e 20 74 distributed in t
0170: 68 65 20 68 6f 70 65 20 74 68 61 74 20 69 74 20 he hope that it
0180: 77 69 6c 6c 20 62 65 20 75 73 65 66 75 6c 2c 0a will be useful,.
0190: 5c 20 62 75 74 20 57 49 54 48 4f 55 54 20 41 4e \ but WITHOUT AN
01a0: 59 20 57 41 52 52 41 4e 54 59 3b 20 77 69 74 68 Y WARRANTY; with
01b0: 6f 75 74 20 65 76 65 6e 20 74 68 65 20 69 6d 70 out even the imp
01c0: 6c 69 65 64 20 77 61 72 72 61 6e 74 79 20 6f 66 lied warranty of
01d0: 0a 5c 20 4d 45 52 43 48 41 4e 54 41 42 49 4c 49 .\ MERCHANTABILI
01e0: 54 59 20 6f 72 20 46 49 54 4e 45 53 53 20 46 4f TY or FITNESS FO
01f0: 52 20 41 20 50 41 52 54 49 43 55 4c 41 52 20 50 R A PARTICULAR P
0200: 55 52 50 4f 53 45 2e 20 20 53 65 65 20 74 68 65 URPOSE. See the
0210: 0a 5c 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 .\ GNU Affero Ge
0220: 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 neral Public Lic
0230: 65 6e 73 65 20 66 6f 72 20 6d 6f 72 65 20 64 65 ense for more de
0240: 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f 75 20 73 68 tails...\ You sh
0250: 6f 75 6c 64 20 68 61 76 65 20 72 65 63 65 69 76 ould have receiv
0260: 65 64 20 61 20 63 6f 70 79 20 6f 66 20 74 68 65 ed a copy of the
0270: 20 47 4e 55 20 41 66 66 65 72 6f 20 47 65 6e 65 GNU Affero Gene
0280: 72 61 6c 20 50 75 62 6c 69 63 20 4c 69 63 65 6e ral Public Licen
0290: 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 69 74 68 20 se.\ along with
02a0: 74 68 69 73 20 70 72 6f 67 72 61 6d 2e 20 20 49 this program. I
02b0: 66 20 6e 6f 74 2c 20 73 65 65 20 3c 68 74 74 70 f not, see <http
02c0: 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f 72 67 2f 6c ://www.gnu.org/l
02d0: 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a 72 65 71 75 icenses/>...requ
02e0: 69 72 65 20 73 65 74 2d 63 6f 6d 70 73 65 6d 2e ire set-compsem.
02f0: 66 73 0a 0a 5c 20 6e 65 74 32 6f 20 63 6f 6d 6d fs..\ net2o comm
0300: 61 6e 64 73 20 61 72 65 20 70 72 6f 74 6f 62 75 ands are protobu
0310: 66 20 63 6f 64 65 64 2c 20 6e 6f 74 20 62 79 74 f coded, not byt
0320: 65 20 63 6f 64 65 64 2e 0a 0a 75 73 74 61 63 6b e coded...ustack
0330: 20 73 74 72 69 6e 67 2d 73 74 61 63 6b 0a 75 73 string-stack.us
0340: 74 61 63 6b 20 6f 62 6a 65 63 74 2d 73 74 61 63 tack object-stac
0350: 6b 0a 75 73 74 61 63 6b 20 74 2d 73 74 61 63 6b k.ustack t-stack
0360: 0a 75 73 74 61 63 6b 20 6e 65 73 74 2d 73 74 61 .ustack nest-sta
0370: 63 6b 0a 0a 5c 20 63 6f 6d 6d 61 6e 64 20 62 75 ck..\ command bu
0380: 66 66 65 72 73 0a 0a 55 73 65 72 20 62 75 66 2d ffers..User buf-
0390: 73 74 61 74 65 20 63 65 6c 6c 20 75 61 6c 6c 6f state cell uallo
03a0: 74 20 64 72 6f 70 0a 55 73 65 72 20 62 75 66 2d t drop.User buf-
03b0: 64 75 6d 70 20 20 63 65 6c 6c 20 75 61 6c 6c 6f dump cell uallo
03c0: 74 20 64 72 6f 70 0a 0a 75 73 65 72 2d 6f 20 63 t drop..user-o c
03d0: 6d 64 62 75 66 2d 6f 0a 0a 6f 62 6a 65 63 74 20 mdbuf-o..object
03e0: 63 6c 61 73 73 0a 20 20 20 20 63 65 6c 6c 20 75 class. cell u
03f0: 76 61 72 20 63 6d 64 62 75 66 23 0a 20 20 20 20 var cmdbuf#.
0400: 63 65 6c 6c 20 75 76 61 72 20 63 6d 64 2d 72 65 cell uvar cmd-re
0410: 70 6c 79 2d 78 74 0a 0a 20 20 20 20 75 6d 65 74 ply-xt.. umet
0420: 68 6f 64 20 63 6d 64 6c 6f 63 6b 0a 20 20 20 20 hod cmdlock.
0430: 75 6d 65 74 68 6f 64 20 63 6d 64 62 75 66 24 0a umethod cmdbuf$.
0440: 20 20 20 20 75 6d 65 74 68 6f 64 20 63 6d 64 72 umethod cmdr
0450: 65 73 65 74 0a 20 20 20 20 75 6d 65 74 68 6f 64 eset. umethod
0460: 20 6d 61 78 73 74 72 69 6e 67 0a 20 20 20 20 75 maxstring. u
0470: 6d 65 74 68 6f 64 20 2b 63 6d 64 62 75 66 0a 20 method +cmdbuf.
0480: 20 20 20 75 6d 65 74 68 6f 64 20 2d 63 6d 64 62 umethod -cmdb
0490: 75 66 0a 20 20 20 20 75 6d 65 74 68 6f 64 20 63 uf. umethod c
04a0: 6d 64 64 65 73 74 0a 65 6e 64 2d 63 6c 61 73 73 mddest.end-class
04b0: 20 63 6d 64 2d 62 75 66 2d 63 0a 0a 3a 20 63 6d cmd-buf-c..: cm
04c0: 64 62 75 66 3a 20 28 20 61 64 64 72 20 2d 2d 20 dbuf: ( addr --
04d0: 29 20 20 43 72 65 61 74 65 20 2c 20 44 4f 45 53 ) Create , DOES
04e0: 3e 20 70 65 72 66 6f 72 6d 20 40 20 63 6d 64 62 > perform @ cmdb
04f0: 75 66 2d 6f 20 21 20 3b 0a 0a 3a 20 63 6d 64 2d uf-o ! ;..: cmd-
0500: 6e 65 73 74 20 7b 20 78 74 20 2d 2d 20 7d 0a 20 nest { xt -- }.
0510: 20 20 20 62 75 66 2d 64 75 6d 70 20 32 40 20 32 buf-dump 2@ 2
0520: 3e 72 20 62 75 66 2d 73 74 61 74 65 20 32 40 20 >r buf-state 2@
0530: 32 3e 72 20 63 6d 64 62 75 66 2d 6f 20 40 20 3e 2>r cmdbuf-o @ >
0540: 72 0a 20 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e r. connection
0550: 20 64 75 70 20 64 75 70 20 3e 72 20 3e 6f 20 49 dup dup >r >o I
0560: 46 0a 09 76 61 6c 69 64 61 74 65 64 20 40 20 3e F..validated @ >
0570: 72 20 20 78 74 20 63 61 74 63 68 20 20 72 3e 20 r xt catch r>
0580: 76 61 6c 69 64 61 74 65 64 20 21 0a 20 20 20 20 validated !.
0590: 45 4c 53 45 0a 09 78 74 20 63 61 74 63 68 0a 20 ELSE..xt catch.
05a0: 20 20 20 54 48 45 4e 20 20 6f 3e 20 72 3e 20 74 THEN o> r> t
05b0: 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 0a 20 20 o connection .
05c0: 20 20 72 3e 20 63 6d 64 62 75 66 2d 6f 20 21 20 r> cmdbuf-o !
05d0: 32 72 3e 20 62 75 66 2d 73 74 61 74 65 20 32 21 2r> buf-state 2!
05e0: 20 32 72 3e 20 62 75 66 2d 64 75 6d 70 20 32 21 2r> buf-dump 2!
05f0: 0a 20 20 20 20 74 68 72 6f 77 20 3b 0a 0a 5c 20 . throw ;..\
0600: 63 6f 6d 6d 61 6e 64 20 68 65 6c 70 65 72 0a 0a command helper..
0610: 3a 20 70 40 20 28 20 2d 2d 20 36 34 75 20 29 20 : p@ ( -- 64u )
0620: 62 75 66 2d 73 74 61 74 65 20 32 40 20 6f 76 65 buf-state 2@ ove
0630: 72 20 2b 20 3e 72 20 70 40 2b 20 72 3e 20 6f 76 r + >r p@+ r> ov
0640: 65 72 20 2d 20 62 75 66 2d 73 74 61 74 65 20 32 er - buf-state 2
0650: 21 20 3b 0a 3a 20 70 73 40 20 28 20 2d 2d 20 36 ! ;.: ps@ ( -- 6
0660: 34 6e 20 29 20 70 40 20 7a 7a 3e 6e 20 3b 0a 0a 4n ) p@ zz>n ;..
0670: 3a 20 62 79 74 65 40 20 28 20 61 64 64 72 20 75 : byte@ ( addr u
0680: 20 2d 2d 20 61 64 64 72 27 20 75 27 20 62 20 29 -- addr' u' b )
0690: 0a 20 20 20 20 3e 72 20 63 6f 75 6e 74 20 72 3e . >r count r>
06a0: 20 31 2d 20 73 77 61 70 20 3b 0a 0a 5c 20 75 73 1- swap ;..\ us
06b0: 65 20 61 20 73 74 72 69 6e 67 20 73 74 61 63 6b e a string stack
06c0: 20 74 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 68 to make sure th
06d0: 61 74 20 73 74 72 69 6e 67 73 20 63 61 6e 20 6f at strings can o
06e0: 6e 6c 79 20 6f 72 69 67 69 6e 61 74 65 20 66 72 nly originate fr
06f0: 6f 6d 0a 5c 20 61 20 73 74 72 69 6e 67 20 69 6e om.\ a string in
0700: 73 69 64 65 20 74 68 65 20 63 6f 6d 6d 61 6e 64 side the command
0710: 20 77 65 20 61 72 65 20 6a 75 73 74 20 65 78 65 we are just exe
0720: 63 75 74 69 6e 67 0a 0a 3a 20 3e 24 20 28 20 61 cuting..: >$ ( a
0730: 64 64 72 20 75 20 2d 2d 20 24 3a 73 74 72 69 6e ddr u -- $:strin
0740: 67 20 29 0a 20 20 20 20 73 74 72 69 6e 67 2d 73 g ). string-s
0750: 74 61 63 6b 20 24 5b 5d 23 20 31 2b 20 73 74 72 tack $[]# 1+ str
0760: 69 6e 67 2d 73 74 61 63 6b 20 24 5b 5d 20 63 65 ing-stack $[] ce
0770: 6c 6c 2d 20 32 21 20 3b 0a 3a 20 24 3e 20 28 20 ll- 2! ;.: $> (
0780: 24 3a 73 74 72 69 6e 67 20 2d 2d 20 61 64 64 72 $:string -- addr
0790: 20 75 20 29 0a 20 20 20 20 73 74 72 69 6e 67 2d u ). string-
07a0: 73 74 61 63 6b 20 24 5b 5d 23 20 32 20 2d 0a 20 stack $[]# 2 -.
07b0: 20 20 20 64 75 70 20 30 3c 20 21 21 73 74 72 69 dup 0< !!stri
07c0: 6e 67 2d 65 6d 70 74 79 21 21 20 64 75 70 20 3e ng-empty!! dup >
07d0: 72 0a 20 20 20 20 73 74 72 69 6e 67 2d 73 74 61 r. string-sta
07e0: 63 6b 20 24 5b 5d 20 32 40 0a 20 20 20 20 72 3e ck $[] 2@. r>
07f0: 20 63 65 6c 6c 73 20 73 74 72 69 6e 67 2d 73 74 cells string-st
0800: 61 63 6b 20 24 21 6c 65 6e 20 3b 0a 0a 3a 20 40 ack $!len ;..: @
0810: 3e 24 20 28 20 61 64 64 72 20 75 20 2d 2d 20 24 >$ ( addr u -- $
0820: 3a 73 74 72 69 6e 67 20 61 64 64 72 27 20 75 27 :string addr' u'
0830: 20 29 0a 20 20 20 20 62 6f 75 6e 64 73 20 70 40 ). bounds p@
0840: 2b 20 36 34 6e 2d 73 77 61 70 20 36 34 3e 6e 20 + 64n-swap 64>n
0850: 62 6f 75 6e 64 73 20 28 20 65 6e 64 62 75 66 20 bounds ( endbuf
0860: 65 6e 64 73 74 72 69 6e 67 20 73 74 61 72 74 73 endstring starts
0870: 74 72 69 6e 67 20 29 0a 20 20 20 20 3e 72 20 32 tring ). >r 2
0880: 64 75 70 20 75 3c 20 49 46 20 20 7e 7e 20 74 72 dup u< IF ~~ tr
0890: 75 65 20 21 21 73 74 72 69 6e 67 66 69 74 21 21 ue !!stringfit!!
08a0: 20 20 54 48 45 4e 0a 20 20 20 20 64 75 70 20 72 THEN. dup r
08b0: 3e 20 6f 76 65 72 20 75 6d 69 6e 20 74 75 63 6b > over umin tuck
08c0: 20 2d 20 3e 24 20 74 75 63 6b 20 2d 20 3b 0a 0a - >$ tuck - ;..
08d0: 3a 20 73 74 72 69 6e 67 40 20 28 20 2d 2d 20 24 : string@ ( -- $
08e0: 3a 73 74 72 69 6e 67 20 29 0a 20 20 20 20 62 75 :string ). bu
08f0: 66 2d 73 74 61 74 65 20 32 40 20 40 3e 24 20 62 f-state 2@ @>$ b
0900: 75 66 2d 73 74 61 74 65 20 32 21 20 3b 0a 0a 3a uf-state 2! ;..:
0910: 20 40 3e 24 6e 6f 65 72 72 20 28 20 61 64 64 72 @>$noerr ( addr
0920: 20 75 20 2d 2d 20 24 3a 73 74 72 69 6e 67 20 61 u -- $:string a
0930: 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 62 6f ddr' u' ). bo
0940: 75 6e 64 73 20 70 40 2b 20 36 34 6e 2d 73 77 61 unds p@+ 64n-swa
0950: 70 20 36 34 3e 6e 20 62 6f 75 6e 64 73 20 28 20 p 64>n bounds (
0960: 65 6e 64 62 75 66 20 65 6e 64 73 74 72 69 6e 67 endbuf endstring
0970: 20 73 74 61 72 74 73 74 72 69 6e 67 20 29 0a 20 startstring ).
0980: 20 20 20 3e 72 20 6f 76 65 72 20 75 6d 69 6e 20 >r over umin
0990: 64 75 70 20 72 3e 20 6f 76 65 72 20 75 6d 69 6e dup r> over umin
09a0: 20 74 75 63 6b 20 2d 20 3e 24 20 74 75 63 6b 20 tuck - >$ tuck
09b0: 2d 20 3b 0a 0a 3a 20 73 74 72 69 6e 67 40 6e 6f - ;..: string@no
09c0: 65 72 72 20 28 20 2d 2d 20 24 3a 73 74 72 69 6e err ( -- $:strin
09d0: 67 20 29 0a 20 20 20 20 62 75 66 2d 73 74 61 74 g ). buf-stat
09e0: 65 20 32 40 20 40 3e 24 6e 6f 65 72 72 20 62 75 e 2@ @>$noerr bu
09f0: 66 2d 73 74 61 74 65 20 32 21 20 3b 0a 0a 5c 20 f-state 2! ;..\
0a00: 73 74 72 69 6e 67 20 64 65 62 75 67 67 69 6e 67 string debugging
0a10: 0a 0a 24 32 30 20 63 6f 6e 73 74 61 6e 74 20 6d ..$20 constant m
0a20: 61 78 73 74 72 23 0a 0a 3a 20 24 2e 6d 61 78 73 axstr#..: $.maxs
0a30: 74 72 20 28 20 61 64 64 72 20 75 20 78 74 20 2d tr ( addr u xt -
0a40: 2d 20 29 20 3e 72 0a 20 20 20 20 64 75 70 20 6d - ) >r. dup m
0a50: 61 78 73 74 72 23 20 32 2a 20 75 3e 20 49 46 0a axstr# 2* u> IF.
0a60: 09 32 64 75 70 20 6d 61 78 73 74 72 23 20 75 6d .2dup maxstr# um
0a70: 69 6e 20 72 40 20 65 78 65 63 75 74 65 0a 09 2e in r@ execute...
0a80: 22 20 5b 2e 2e 24 22 20 64 75 70 20 6d 61 78 73 " [..$" dup maxs
0a90: 74 72 23 20 32 2a 20 2d 20 30 20 75 2e 72 20 2e tr# 2* - 0 u.r .
0aa0: 22 20 2e 2e 5d 22 0a 09 64 75 70 20 6d 61 78 73 " ..]"..dup maxs
0ab0: 74 72 23 20 2d 20 2f 73 74 72 69 6e 67 20 72 40 tr# - /string r@
0ac0: 20 65 78 65 63 75 74 65 0a 20 20 20 20 54 48 45 execute. THE
0ad0: 4e 0a 20 20 20 20 72 3e 20 65 78 65 63 75 74 65 N. r> execute
0ae0: 20 3b 0a 0a 30 20 77 61 72 6e 69 6e 67 73 20 21 ;..0 warnings !
0af0: 40 20 5c 20 24 2e 20 63 6f 75 6c 64 20 62 65 20 @ \ $. could be
0b00: 6d 69 73 74 61 6b 65 6e 20 61 73 20 64 6f 75 62 mistaken as doub
0b10: 6c 65 20 30 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 le 0.in net2o :
0b20: 24 2e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 $. ( addr u -- )
0b30: 0a 20 20 20 20 32 64 75 70 20 70 72 69 6e 74 61 . 2dup printa
0b40: 62 6c 65 3f 20 49 46 0a 09 2e 5c 22 20 5c 22 22 ble? IF...\" \""
0b50: 20 74 79 70 65 20 5c 20 24 2e 6d 61 78 73 74 72 type \ $.maxstr
0b60: 0a 20 20 20 20 45 4c 53 45 0a 09 2e 5c 22 20 38 . ELSE...\" 8
0b70: 35 5c 22 20 22 20 38 35 74 79 70 65 20 5c 20 24 5\" " 85type \ $
0b80: 2e 6d 61 78 73 74 72 0a 20 20 20 20 54 48 45 4e .maxstr. THEN
0b90: 20 20 27 22 27 20 65 6d 69 74 20 3b 0a 77 61 72 '"' emit ;.war
0ba0: 6e 69 6e 67 73 20 21 0a 0a 3a 20 6e 32 6f 2e 73 nings !..: n2o.s
0bb0: 74 72 69 6e 67 20 28 20 24 3a 73 74 72 69 6e 67 tring ( $:string
0bc0: 20 2d 2d 20 29 20 20 63 72 20 24 3e 20 6e 65 74 -- ) cr $> net
0bd0: 32 6f 3a 24 2e 20 2e 22 20 20 24 2c 20 22 20 3b 2o:$. ." $, " ;
0be0: 0a 3a 20 6e 32 6f 2e 73 65 63 73 74 72 69 6e 67 .: n2o.secstring
0bf0: 20 28 20 24 3a 73 74 72 69 6e 67 20 2d 2d 20 29 ( $:string -- )
0c00: 20 61 74 74 72 20 40 20 3e 72 0a 20 20 20 20 63 attr @ >r. c
0c10: 72 20 24 3e 20 2e 5c 22 20 38 35 5c 22 20 22 20 r $> .\" 85\" "
0c20: 2e 62 6c 61 63 6b 38 35 20 72 3e 20 61 74 74 72 .black85 r> attr
0c30: 21 20 2e 5c 22 20 5c 22 20 73 65 63 24 2c 20 22 ! .\" \" sec$, "
0c40: 20 3b 0a 0a 66 6f 72 77 61 72 64 20 6b 65 79 3e ;..forward key>
0c50: 6e 69 63 6b 0a 3a 20 2e 3f 69 64 20 28 20 61 64 nick.: .?id ( ad
0c60: 64 72 20 2d 2d 20 29 20 6b 65 79 73 69 7a 65 20 dr -- ) keysize
0c70: 32 64 75 70 20 6b 65 79 3e 6e 69 63 6b 0a 20 20 2dup key>nick.
0c80: 20 20 64 75 70 20 49 46 20 20 74 79 70 65 20 32 dup IF type 2
0c90: 64 72 6f 70 20 20 45 4c 53 45 20 20 32 64 72 6f drop ELSE 2dro
0ca0: 70 20 24 38 20 75 6d 69 6e 20 38 35 74 79 70 65 p $8 umin 85type
0cb0: 20 20 54 48 45 4e 20 3b 0a 3a 20 2e 70 6b 28 32 THEN ;.: .pk(2
0cc0: 29 73 69 67 3f 20 28 20 61 64 64 72 20 75 20 2d )sig? ( addr u -
0cd0: 2d 20 29 0a 20 20 20 20 32 64 75 70 20 70 6b 32 - ). 2dup pk2
0ce0: 2d 73 69 67 3f 20 30 3d 20 49 46 0a 09 73 70 61 -sig? 0= IF..spa
0cf0: 63 65 20 73 69 67 70 6b 32 73 69 7a 65 23 20 2d ce sigpk2size# -
0d00: 20 2b 20 2e 3f 69 64 0a 09 66 61 6c 73 65 20 2e + .?id..false .
0d10: 63 68 65 63 6b 20 45 4c 53 45 0a 09 32 64 75 70 check ELSE..2dup
0d20: 20 70 6b 2d 73 69 67 3f 20 30 3d 20 49 46 0a 09 pk-sig? 0= IF..
0d30: 20 20 20 20 73 70 61 63 65 20 73 69 67 70 6b 73 space sigpks
0d40: 69 7a 65 23 20 2d 20 2b 20 2e 3f 69 64 0a 09 20 ize# - + .?id..
0d50: 20 20 20 66 61 6c 73 65 20 2e 63 68 65 63 6b 0a false .check.
0d60: 09 45 4c 53 45 20 20 32 64 72 6f 70 20 74 72 75 .ELSE 2drop tru
0d70: 65 20 2e 63 68 65 63 6b 20 20 54 48 45 4e 20 20 e .check THEN
0d80: 54 48 45 4e 20 3b 0a 3a 20 6e 32 6f 2e 73 69 67 THEN ;.: n2o.sig
0d90: 73 74 72 69 6e 67 20 28 20 24 3a 73 74 72 69 6e string ( $:strin
0da0: 67 20 2d 2d 20 29 0a 20 20 20 20 63 72 20 24 3e g -- ). cr $>
0db0: 20 32 64 75 70 20 6e 65 74 32 6f 3a 24 2e 20 2e 2dup net2o:$. .
0dc0: 22 20 20 28 20 22 20 32 64 75 70 20 5b 27 5d 20 " ( " 2dup [']
0dd0: 2e 73 69 67 64 61 74 65 73 20 23 31 30 20 62 61 .sigdates #10 ba
0de0: 73 65 2d 65 78 65 63 75 74 65 0a 20 20 20 20 32 se-execute. 2
0df0: 64 72 6f 70 20 5c 20 2e 70 6b 28 32 29 73 69 67 drop \ .pk(2)sig
0e00: 3f 0a 20 20 20 20 2e 22 20 20 29 20 24 2c 20 22 ?. ." ) $, "
0e10: 20 3b 0a 0a 3a 20 24 2e 73 20 28 20 24 73 74 72 ;..: $.s ( $str
0e20: 69 6e 67 31 20 2e 2e 20 24 73 74 72 69 6e 67 6e ing1 .. $stringn
0e30: 20 2d 2d 20 29 0a 20 20 20 20 73 74 72 69 6e 67 -- ). string
0e40: 2d 73 74 61 63 6b 20 24 40 20 62 6f 75 6e 64 73 -stack $@ bounds
0e50: 20 55 2b 44 4f 0a 09 63 72 20 69 20 32 40 20 6e U+DO..cr i 2@ n
0e60: 65 74 32 6f 3a 24 2e 0a 20 20 20 20 32 20 63 65 et2o:$.. 2 ce
0e70: 6c 6c 73 20 2b 4c 4f 4f 50 20 3b 0a 0a 5c 20 6f lls +LOOP ;..\ o
0e80: 62 6a 65 63 74 20 73 74 61 63 6b 0a 0a 3a 20 6f bject stack..: o
0e90: 2d 70 6f 70 20 28 20 6f 3a 6f 31 20 6f 3a 78 20 -pop ( o:o1 o:x
0ea0: 2d 2d 20 6f 31 20 6f 3a 78 20 29 20 6f 62 6a 65 -- o1 o:x ) obje
0eb0: 63 74 2d 73 74 61 63 6b 20 73 74 61 63 6b 3e 20 ct-stack stack>
0ec0: 3b 0a 3a 20 6f 2d 70 75 73 68 20 28 20 6f 31 20 ;.: o-push ( o1
0ed0: 6f 3a 78 20 2d 2d 20 6f 3a 6f 31 20 6f 3a 78 20 o:x -- o:o1 o:x
0ee0: 29 20 6f 62 6a 65 63 74 2d 73 74 61 63 6b 20 3e ) object-stack >
0ef0: 73 74 61 63 6b 20 3b 0a 0a 3a 20 6e 3a 3e 6f 20 stack ;..: n:>o
0f00: 28 20 6f 31 20 6f 3a 6f 32 20 2d 2d 20 6f 3a 6f ( o1 o:o2 -- o:o
0f10: 32 20 6f 3a 6f 31 20 29 0a 20 20 20 20 3e 6f 20 2 o:o1 ). >o
0f20: 72 3e 20 6f 2d 70 75 73 68 20 20 6f 20 49 46 20 r> o-push o IF
0f30: 20 31 20 72 65 71 3f 20 21 20 20 54 48 45 4e 20 1 req? ! THEN
0f40: 3b 0a 3a 20 6e 3a 6f 3e 20 28 20 6f 3a 6f 32 20 ;.: n:o> ( o:o2
0f50: 6f 3a 6f 31 20 2d 2d 20 6f 3a 6f 32 20 29 0a 20 o:o1 -- o:o2 ).
0f60: 20 20 20 6f 2d 70 6f 70 20 3e 72 20 6f 3e 20 3b o-pop >r o> ;
0f70: 0a 3a 20 6e 3a 6f 73 77 61 70 20 28 20 6f 3a 6f .: n:oswap ( o:o
0f80: 31 20 6f 3a 6f 32 20 2d 2d 20 6f 3a 6f 32 20 6f 1 o:o2 -- o:o2 o
0f90: 3a 6f 31 20 29 0a 20 20 20 20 6f 2d 70 6f 70 20 :o1 ). o-pop
0fa0: 3e 6f 20 72 3e 20 6f 2d 70 75 73 68 20 3b 0a 0a >o r> o-push ;..
0fb0: 5c 20 74 6f 6b 65 6e 20 73 74 61 63 6b 20 2d 20 \ token stack -
0fc0: 6f 6e 6c 79 20 66 6f 72 20 64 65 63 6f 6d 70 69 only for decompi
0fd0: 6c 69 6e 67 0a 0a 3a 20 74 2d 70 75 73 68 20 28 ling..: t-push (
0fe0: 20 61 64 64 72 20 2d 2d 20 29 20 20 74 2d 73 74 addr -- ) t-st
0ff0: 61 63 6b 20 3e 73 74 61 63 6b 20 3b 0a 3a 20 74 ack >stack ;.: t
1000: 2d 70 6f 70 20 28 20 2d 2d 20 61 64 64 72 20 29 -pop ( -- addr )
1010: 20 20 20 74 2d 73 74 61 63 6b 20 73 74 61 63 6b t-stack stack
1020: 3e 20 3b 0a 3a 20 74 23 20 28 20 2d 2d 20 6e 20 > ;.: t# ( -- n
1030: 29 20 74 2d 73 74 61 63 6b 20 24 5b 5d 23 20 3b ) t-stack $[]# ;
1040: 0a 0a 5c 20 66 6c 6f 61 74 20 61 72 65 20 73 74 ..\ float are st
1050: 6f 72 65 64 20 62 69 67 20 65 6e 64 69 61 6e 2e ored big endian.
1060: 0a 0a 3a 20 70 66 40 2b 20 28 20 61 64 64 72 20 ..: pf@+ ( addr
1070: 75 20 2d 2d 20 61 64 64 72 27 20 75 27 20 72 20 u -- addr' u' r
1080: 29 0a 20 20 20 20 32 3e 72 20 36 34 20 36 34 23 ). 2>r 64 64#
1090: 30 20 32 72 3e 20 62 6f 75 6e 64 73 20 3f 44 4f 0 2r> bounds ?DO
10a0: 0a 09 37 20 36 34 6c 73 68 69 66 74 20 49 20 63 ..7 64lshift I c
10b0: 40 20 24 37 46 20 61 6e 64 20 6e 3e 36 34 20 36 @ $7F and n>64 6
10c0: 34 2b 20 36 34 3e 72 20 37 20 2d 20 36 34 72 3e 4+ 64>r 7 - 64r>
10d0: 0a 09 49 20 63 40 20 24 38 30 20 61 6e 64 20 20 ..I c@ $80 and
10e0: 30 3d 20 49 46 0a 09 20 20 20 20 6e 36 34 2d 73 0= IF.. n64-s
10f0: 77 61 70 20 36 34 6c 73 68 69 66 74 0a 09 20 20 wap 64lshift..
1100: 20 20 30 65 20 7b 20 66 5e 20 70 66 74 6d 70 20 0e { f^ pftmp
1110: 7d 20 70 66 74 6d 70 20 36 34 21 20 70 66 74 6d } pftmp 64! pftm
1120: 70 20 66 40 0a 09 20 20 20 20 49 20 31 2b 20 49 p f@.. I 1+ I
1130: 27 20 6f 76 65 72 20 2d 20 75 6e 6c 6f 6f 70 20 ' over - unloop
1140: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
1150: 4c 4f 4f 50 20 20 20 74 72 75 65 20 21 21 66 6c LOOP true !!fl
1160: 6f 61 74 66 69 74 21 21 20 20 3b 0a 0a 3a 20 70 oatfit!! ;..: p
1170: 66 21 2b 20 28 20 72 3a 66 6c 6f 61 74 20 61 64 f!+ ( r:float ad
1180: 64 72 20 2d 2d 20 61 64 64 72 27 20 29 20 7b 20 dr -- addr' ) {
1190: 66 5e 20 70 66 74 6d 70 20 7d 0a 20 20 20 20 42 f^ pftmp }. B
11a0: 45 47 49 4e 0a 09 70 66 74 6d 70 20 36 34 40 20 EGIN..pftmp 64@
11b0: 35 37 20 36 34 72 73 68 69 66 74 20 36 34 3e 6e 57 64rshift 64>n
11c0: 0a 09 70 66 74 6d 70 20 36 34 40 20 37 20 36 34 ..pftmp 64@ 7 64
11d0: 6c 73 68 69 66 74 20 36 34 64 75 70 20 70 66 74 lshift 64dup pft
11e0: 6d 70 20 36 34 21 0a 09 36 34 2d 30 3c 3e 20 57 mp 64!..64-0<> W
11f0: 48 49 4c 45 20 20 24 38 30 20 6f 72 20 6f 76 65 HILE $80 or ove
1200: 72 20 63 21 20 31 2b 20 20 52 45 50 45 41 54 0a r c! 1+ REPEAT.
1210: 20 20 20 20 6f 76 65 72 20 63 21 20 31 2b 20 3b over c! 1+ ;
1220: 0a 0a 3a 20 70 66 40 20 28 20 2d 2d 20 72 20 29 ..: pf@ ( -- r )
1230: 0a 20 20 20 20 62 75 66 2d 73 74 61 74 65 20 32 . buf-state 2
1240: 40 20 70 66 40 2b 20 62 75 66 2d 73 74 61 74 65 @ pf@+ buf-state
1250: 20 32 21 20 3b 0a 0a 3a 20 6e 65 74 32 6f 2d 63 2! ;..: net2o-c
1260: 72 61 73 68 20 74 72 75 65 20 21 21 66 75 6e 63 rash true !!func
1270: 74 69 6f 6e 21 21 20 3b 0a 0a 44 65 66 65 72 20 tion!! ;..Defer
1280: 67 65 6e 2d 74 61 62 6c 65 0a 27 20 63 6d 64 2d gen-table.' cmd-
1290: 74 61 62 6c 65 20 49 53 20 67 65 6e 2d 74 61 62 table IS gen-tab
12a0: 6c 65 0a 0a 3a 20 6e 3e 63 6d 64 20 28 20 6e 20 le..: n>cmd ( n
12b0: 2d 2d 20 61 64 64 72 20 29 20 63 65 6c 6c 73 20 -- addr ) cells
12c0: 3e 72 0a 20 20 20 20 6f 20 49 46 20 20 74 6f 6b >r. o IF tok
12d0: 65 6e 2d 74 61 62 6c 65 20 20 45 4c 53 45 20 20 en-table ELSE
12e0: 73 65 74 75 70 2d 74 61 62 6c 65 20 20 54 48 45 setup-table THE
12f0: 4e 0a 20 20 20 20 24 40 20 72 40 20 75 3c 3d 20 N. $@ r@ u<=
1300: 21 21 66 75 6e 63 74 69 6f 6e 21 21 20 72 3e 20 !!function!! r>
1310: 2b 20 3b 0a 0a 3a 20 63 6d 64 40 20 28 20 2d 2d + ;..: cmd@ ( --
1320: 20 75 20 29 20 62 75 66 2d 73 74 61 74 65 20 32 u ) buf-state 2
1330: 40 20 6f 76 65 72 20 2b 20 3e 72 20 70 40 2b 20 @ over + >r p@+
1340: 72 3e 20 6f 76 65 72 20 2d 20 62 75 66 2d 73 74 r> over - buf-st
1350: 61 74 65 20 32 21 20 36 34 3e 6e 20 3b 0a 0a 73 ate 2! 64>n ;..s
1360: 74 61 6e 64 61 72 64 3a 66 69 65 6c 64 0a 2d 36 tandard:field.-6
1370: 20 63 65 6c 6c 73 20 30 20 2b 66 69 65 6c 64 20 cells 0 +field
1380: 6e 65 74 32 6f 2e 6e 61 6d 65 0a 64 72 6f 70 0a net2o.name.drop.
1390: 0a 3a 20 3e 6e 65 74 32 6f 2d 6e 61 6d 65 20 28 .: >net2o-name (
13a0: 20 61 64 64 72 20 2d 2d 20 61 64 64 72 27 20 75 addr -- addr' u
13b0: 20 29 0a 20 20 20 20 6e 65 74 32 6f 2e 6e 61 6d ). net2o.nam
13c0: 65 20 62 6f 64 79 3e 20 6e 61 6d 65 3e 73 74 72 e body> name>str
13d0: 69 6e 67 20 3b 0a 3a 20 3e 6e 65 74 32 6f 2d 73 ing ;.: >net2o-s
13e0: 69 67 20 28 20 61 64 64 72 20 2d 2d 20 61 64 64 ig ( addr -- add
13f0: 72 27 20 75 20 29 0a 20 20 20 20 6e 65 74 32 6f r' u ). net2o
1400: 2e 6e 61 6d 65 20 33 20 63 65 6c 6c 73 20 2b 20 .name 3 cells +
1410: 24 40 20 3b 0a 3a 20 2e 6e 65 74 32 6f 2d 6e 75 $@ ;.: .net2o-nu
1420: 6d 20 28 20 6f 66 66 20 2d 2d 20 29 20 20 63 65 m ( off -- ) ce
1430: 6c 6c 2f 20 27 3c 27 20 65 6d 69 74 20 30 20 2e ll/ '<' emit 0 .
1440: 72 20 27 3e 27 20 65 6d 69 74 20 73 70 61 63 65 r '>' emit space
1450: 20 3b 0a 0a 55 73 65 72 20 73 65 65 3a 74 61 62 ;..User see:tab
1460: 6c 65 20 5c 20 63 75 72 72 65 6e 74 20 74 6f 6b le \ current tok
1470: 65 6e 20 74 61 62 6c 65 20 66 6f 72 20 73 65 65 en table for see
1480: 20 6f 6e 6c 79 0a 0a 3a 20 28 6e 65 74 32 6f 2d only..: (net2o-
1490: 73 65 65 29 20 28 20 61 64 64 72 20 69 6e 64 65 see) ( addr inde
14a0: 78 20 2d 2d 20 29 20 20 64 75 70 20 3e 72 20 2b x -- ) dup >r +
14b0: 20 40 0a 20 20 20 20 64 75 70 20 30 3c 3e 20 49 @. dup 0<> I
14c0: 46 0a 09 6e 65 74 32 6f 2e 6e 61 6d 65 0a 09 64 F..net2o.name..d
14d0: 75 70 20 32 20 63 65 6c 6c 73 20 2b 20 40 20 3f up 2 cells + @ ?
14e0: 64 75 70 2d 49 46 20 20 40 20 73 65 65 3a 74 61 dup-IF @ see:ta
14f0: 62 6c 65 20 40 20 74 2d 70 75 73 68 20 73 65 65 ble @ t-push see
1500: 3a 74 61 62 6c 65 20 21 20 20 54 48 45 4e 0a 09 :table ! THEN..
1510: 62 6f 64 79 3e 20 2e 6e 61 6d 65 0a 20 20 20 20 body> .name.
1520: 45 4c 53 45 20 20 64 72 6f 70 20 72 40 20 2e 6e ELSE drop r@ .n
1530: 65 74 32 6f 2d 6e 75 6d 20 20 54 48 45 4e 20 20 et2o-num THEN
1540: 72 64 72 6f 70 20 3b 0a 0a 3a 20 2e 6e 65 74 32 rdrop ;..: .net2
1550: 6f 2d 6e 61 6d 65 20 28 20 6e 20 2d 2d 20 29 20 o-name ( n -- )
1560: 20 63 65 6c 6c 73 20 3e 72 0a 20 20 20 20 73 65 cells >r. se
1570: 65 3a 74 61 62 6c 65 20 24 40 20 72 40 20 75 3c e:table $@ r@ u<
1580: 3d 0a 20 20 20 20 49 46 20 20 64 72 6f 70 20 72 =. IF drop r
1590: 3e 20 2e 6e 65 74 32 6f 2d 6e 75 6d 20 20 45 58 > .net2o-num EX
15a0: 49 54 20 20 54 48 45 4e 20 20 72 3e 20 28 6e 65 IT THEN r> (ne
15b0: 74 32 6f 2d 73 65 65 29 20 3b 0a 3a 20 2e 6e 65 t2o-see) ;.: .ne
15c0: 74 32 6f 2d 6e 61 6d 65 27 20 28 20 6e 20 2d 2d t2o-name' ( n --
15d0: 20 29 20 20 63 65 6c 6c 73 20 3e 72 0a 20 20 20 ) cells >r.
15e0: 20 73 65 65 3a 74 61 62 6c 65 20 24 40 20 72 40 see:table $@ r@
15f0: 20 75 3c 3d 0a 20 20 20 20 49 46 20 20 64 72 6f u<=. IF dro
1600: 70 20 72 3e 20 2e 6e 65 74 32 6f 2d 6e 75 6d 20 p r> .net2o-num
1610: 20 45 58 49 54 20 20 54 48 45 4e 20 20 72 40 20 EXIT THEN r@
1620: 2b 20 40 0a 20 20 20 20 64 75 70 20 30 3c 3e 20 + @. dup 0<>
1630: 49 46 0a 09 6e 65 74 32 6f 2e 6e 61 6d 65 20 62 IF..net2o.name b
1640: 6f 64 79 3e 20 2e 6e 61 6d 65 0a 20 20 20 20 45 ody> .name. E
1650: 4c 53 45 20 20 64 72 6f 70 20 72 40 20 2e 6e 65 LSE drop r@ .ne
1660: 74 32 6f 2d 6e 75 6d 20 20 54 48 45 4e 20 20 72 t2o-num THEN r
1670: 64 72 6f 70 20 3b 0a 0a 3a 20 6e 65 74 32 6f 2d drop ;..: net2o-
1680: 73 65 65 20 28 20 63 6d 64 20 2d 2d 20 29 20 68 see ( cmd -- ) h
1690: 65 78 5b 0a 20 20 20 20 63 61 73 65 0a 09 30 20 ex[. case..0
16a0: 6f 66 20 20 2e 22 20 65 6e 64 2d 63 6f 64 65 22 of ." end-code"
16b0: 20 63 72 20 23 30 2e 20 62 75 66 2d 73 74 61 74 cr #0. buf-stat
16c0: 65 20 32 21 20 20 65 6e 64 6f 66 0a 09 31 20 6f e 2! endof..1 o
16d0: 66 20 20 70 40 20 20 20 20 20 20 20 20 20 20 75 f p@ u
16e0: 36 34 2e 20 2e 22 20 6c 69 74 2c 20 22 20 20 65 64. ." lit, " e
16f0: 6e 64 6f 66 0a 09 32 20 6f 66 20 20 70 40 20 36 ndof..2 of p@ 6
1700: 34 69 6e 76 65 72 74 20 73 36 34 2e 20 2e 22 20 4invert s64. ."
1710: 6c 69 74 2c 20 22 20 20 65 6e 64 6f 66 0a 09 33 lit, " endof..3
1720: 20 6f 66 20 20 73 74 72 69 6e 67 40 6e 6f 65 72 of string@noer
1730: 72 20 62 75 66 2d 73 74 61 74 65 20 32 40 20 64 r buf-state 2@ d
1740: 72 6f 70 20 70 40 2b 20 64 72 6f 70 20 36 34 3e rop p@+ drop 64>
1750: 6e 20 31 30 20 3d 0a 09 20 20 20 20 49 46 20 20 n 10 =.. IF
1760: 20 20 6e 32 6f 2e 73 69 67 73 74 72 69 6e 67 20 n2o.sigstring
1770: 20 45 4c 53 45 20 20 6e 32 6f 2e 73 74 72 69 6e ELSE n2o.strin
1780: 67 20 20 54 48 45 4e 20 20 65 6e 64 6f 66 0a 09 g THEN endof..
1790: 34 20 6f 66 20 20 70 66 40 20 66 2e 20 2e 22 20 4 of pf@ f. ."
17a0: 66 6c 6f 61 74 2c 20 22 20 65 6e 64 6f 66 0a 09 float, " endof..
17b0: 35 20 6f 66 20 20 2e 22 20 65 6e 64 2d 77 69 74 5 of ." end-wit
17c0: 68 20 22 20 63 72 20 20 74 23 20 49 46 20 20 74 h " cr t# IF t
17d0: 2d 70 6f 70 20 73 65 65 3a 74 61 62 6c 65 20 21 -pop see:table !
17e0: 20 20 54 48 45 4e 20 20 65 6e 64 6f 66 0a 09 36 THEN endof..6
17f0: 20 6f 66 20 20 2e 22 20 6f 73 77 61 70 20 22 20 of ." oswap "
1800: 63 72 20 73 65 65 3a 74 61 62 6c 65 20 40 20 74 cr see:table @ t
1810: 2d 70 6f 70 20 73 65 65 3a 74 61 62 6c 65 20 21 -pop see:table !
1820: 20 74 2d 70 75 73 68 20 20 65 6e 64 6f 66 0a 09 t-push endof..
1830: 31 31 20 6f 66 20 20 73 74 72 69 6e 67 40 6e 6f 11 of string@no
1840: 65 72 72 20 6e 32 6f 2e 73 65 63 73 74 72 69 6e err n2o.secstrin
1850: 67 20 20 65 6e 64 6f 66 0a 09 31 33 20 6f 66 20 g endof..13 of
1860: 20 27 22 27 20 65 6d 69 74 20 70 40 20 36 34 3e '"' emit p@ 64>
1870: 6e 20 78 65 6d 69 74 20 70 40 20 36 34 3e 6e 20 n xemit p@ 64>n
1880: 78 65 6d 69 74 20 70 40 20 36 34 3e 6e 20 78 65 xemit p@ 64>n xe
1890: 6d 69 74 20 2e 5c 22 20 5c 22 20 34 63 63 2c 20 mit .\" \" 4cc,
18a0: 22 0a 09 65 6e 64 6f 66 0a 09 31 34 20 6f 66 20 "..endof..14 of
18b0: 20 73 74 72 69 6e 67 40 6e 6f 65 72 72 20 20 32 string@noerr 2
18c0: 64 72 6f 70 20 20 65 6e 64 6f 66 0a 09 24 31 30 drop endof..$10
18d0: 20 6f 66 20 2e 22 20 70 75 73 68 27 20 22 20 70 of ." push' " p
18e0: 40 20 36 34 3e 6e 20 2e 6e 65 74 32 6f 2d 6e 61 @ 64>n .net2o-na
18f0: 6d 65 20 20 65 6e 64 6f 66 0a 09 2e 6e 65 74 32 me endof...net2
1900: 6f 2d 6e 61 6d 65 0a 09 30 20 65 6e 64 63 61 73 o-name..0 endcas
1910: 65 20 5d 68 65 78 20 3b 0a 0a 55 73 65 72 20 73 e ]hex ;..User s
1920: 68 6f 77 2d 6f 66 66 73 65 74 20 20 73 68 6f 77 how-offset show
1930: 2d 6f 66 66 73 65 74 20 6f 6e 0a 0a 53 65 6d 61 -offset on..Sema
1940: 20 73 65 65 2d 73 65 6d 61 0a 0a 3a 20 63 6d 64 see-sema..: cmd
1950: 2d 73 65 65 20 28 20 61 64 64 72 20 75 20 2d 2d -see ( addr u --
1960: 20 61 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 addr' u' ).
1970: 64 75 70 20 73 68 6f 77 2d 6f 66 66 73 65 74 20 dup show-offset
1980: 40 20 3d 20 49 46 20 20 2e 22 20 3c 3c 3c 20 22 @ = IF ." <<< "
1990: 20 20 54 48 45 4e 0a 20 20 20 20 62 75 66 2d 73 THEN. buf-s
19a0: 74 61 74 65 20 32 21 20 70 40 20 36 34 3e 6e 20 tate 2! p@ 64>n
19b0: 6e 65 74 32 6f 2d 73 65 65 20 62 75 66 2d 73 74 net2o-see buf-st
19c0: 61 74 65 20 32 40 20 3b 0a 0a 69 6e 20 6e 65 74 ate 2@ ;..in net
19d0: 32 6f 20 3a 20 28 73 65 65 29 20 28 20 61 64 64 2o : (see) ( add
19e0: 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 62 75 66 r u -- ). buf
19f0: 2d 73 74 61 74 65 20 32 40 20 32 3e 72 0a 20 20 -state 2@ 2>r.
1a00: 20 20 5b 3a 20 2e 22 20 6e 65 74 32 6f 2d 63 6f [: ." net2o-co
1a10: 64 65 22 20 20 64 65 73 74 2d 66 6c 61 67 73 20 de" dest-flags
1a20: 31 2b 20 63 40 20 73 74 61 74 65 6c 65 73 73 23 1+ c@ stateless#
1a30: 20 61 6e 64 20 49 46 20 20 27 30 27 20 65 6d 69 and IF '0' emi
1a40: 74 20 20 54 48 45 4e 0a 20 20 20 20 20 20 64 75 t THEN. du
1a50: 70 20 68 65 78 2e 20 74 2d 73 74 61 63 6b 20 24 p hex. t-stack $
1a60: 6f 66 66 0a 20 20 20 20 20 20 5b 3a 20 42 45 47 off. [: BEG
1a70: 49 4e 20 20 63 6d 64 2d 73 65 65 20 64 75 70 20 IN cmd-see dup
1a80: 30 3d 20 55 4e 54 49 4c 20 3b 5d 20 63 61 74 63 0= UNTIL ;] catc
1a90: 68 0a 20 20 20 20 20 20 2e 22 20 20 65 6e 64 2d h. ." end-
1aa0: 63 6f 64 65 22 20 63 72 20 74 68 72 6f 77 20 20 code" cr throw
1ab0: 32 64 72 6f 70 20 3b 5d 20 73 65 65 2d 73 65 6d 2drop ;] see-sem
1ac0: 61 20 63 2d 73 65 63 74 69 6f 6e 0a 20 20 20 20 a c-section.
1ad0: 32 72 3e 20 62 75 66 2d 73 74 61 74 65 20 32 21 2r> buf-state 2!
1ae0: 20 3b 0a 0a 3a 20 3e 73 65 65 2d 74 61 62 6c 65 ;..: >see-table
1af0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6f 20 49 46 ( -- ). o IF
1b00: 20 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 20 45 token-table E
1b10: 4c 53 45 20 20 73 65 74 75 70 2d 74 61 62 6c 65 LSE setup-table
1b20: 20 20 54 48 45 4e 20 20 40 20 73 65 65 3a 74 61 THEN @ see:ta
1b30: 62 6c 65 20 21 20 3b 0a 0a 69 6e 20 6e 65 74 32 ble ! ;..in net2
1b40: 6f 20 3a 20 73 65 65 20 28 20 61 64 64 72 20 75 o : see ( addr u
1b50: 20 2d 2d 20 29 0a 20 20 20 20 3e 73 65 65 2d 74 -- ). >see-t
1b60: 61 62 6c 65 20 6e 65 74 32 6f 3a 28 73 65 65 29 able net2o:(see)
1b70: 20 3b 0a 0a 3a 20 2e 64 65 73 74 2d 61 64 64 72 ;..: .dest-addr
1b80: 20 28 20 66 6c 61 67 20 2d 2d 20 29 0a 20 20 20 ( flag -- ).
1b90: 20 31 2b 20 63 40 20 73 74 61 74 65 6c 65 73 73 1+ c@ stateless
1ba0: 23 20 61 6e 64 20 30 3d 20 49 46 20 64 65 73 74 # and 0= IF dest
1bb0: 2d 61 64 64 72 20 36 34 40 20 78 36 34 2e 20 54 -addr 64@ x64. T
1bc0: 48 45 4e 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 HEN ;..in net2o
1bd0: 3a 20 73 65 65 2d 6d 65 20 28 20 2d 2d 20 29 0a : see-me ( -- ).
1be0: 20 20 20 20 2e 22 20 73 65 65 2d 6d 65 3a 20 22 ." see-me: "
1bf0: 20 20 69 6e 62 75 66 20 68 64 72 66 6c 61 67 73 inbuf hdrflags
1c00: 20 2e 64 65 73 74 2d 61 64 64 72 20 20 62 75 66 .dest-addr buf
1c10: 2d 64 75 6d 70 20 32 40 20 6e 65 74 32 6f 3a 73 -dump 2@ net2o:s
1c20: 65 65 20 3b 0a 0a 3a 20 63 6d 64 2d 64 69 73 70 ee ;..: cmd-disp
1c30: 61 74 63 68 20 28 20 61 64 64 72 20 75 20 2d 2d atch ( addr u --
1c40: 20 61 64 64 72 27 20 75 27 20 29 0a 20 20 20 20 addr' u' ).
1c50: 62 75 66 2d 73 74 61 74 65 20 32 21 0a 20 20 20 buf-state 2!.
1c60: 20 63 6d 64 40 20 74 72 61 63 65 28 20 64 75 70 cmd@ trace( dup
1c70: 20 49 46 20 64 75 70 20 3e 73 65 65 2d 74 61 62 IF dup >see-tab
1c80: 6c 65 20 2e 6e 65 74 32 6f 2d 6e 61 6d 65 27 20 le .net2o-name'
1c90: 54 48 45 4e 20 3e 72 20 2e 73 20 72 3e 20 24 2e THEN >r .s r> $.
1ca0: 73 20 63 72 20 29 0a 20 20 20 20 6e 3e 63 6d 64 s cr ). n>cmd
1cb0: 20 40 20 3f 64 75 70 2d 49 46 20 20 65 78 65 63 @ ?dup-IF exec
1cc0: 75 74 65 20 20 45 4c 53 45 0a 09 74 72 61 63 65 ute ELSE..trace
1cd0: 28 20 2e 22 20 63 72 61 73 68 69 6e 67 22 20 63 ( ." crashing" c
1ce0: 72 20 63 72 20 29 20 6e 65 74 32 6f 2d 63 72 61 r cr ) net2o-cra
1cf0: 73 68 20 20 54 48 45 4e 0a 20 20 20 20 62 75 66 sh THEN. buf
1d00: 2d 73 74 61 74 65 20 32 40 20 3b 0a 0a 3a 20 3e -state 2@ ;..: >
1d10: 63 6d 64 20 28 20 78 74 20 75 20 2d 2d 20 29 20 cmd ( xt u -- )
1d20: 67 65 6e 2d 74 61 62 6c 65 20 24 5b 5d 20 21 20 gen-table $[] !
1d30: 3b 0a 0a 3a 20 75 6e 2d 63 6d 64 20 28 20 2d 2d ;..: un-cmd ( --
1d40: 20 29 20 20 23 30 2e 20 62 75 66 2d 73 74 61 74 ) #0. buf-stat
1d50: 65 20 32 21 20 20 30 20 3e 6f 20 72 64 72 6f 70 e 2! 0 >o rdrop
1d60: 20 3b 0a 0a 44 65 66 65 72 20 3e 74 68 72 6f 77 ;..Defer >throw
1d70: 0a 0a 3a 20 63 6d 64 2d 74 68 72 6f 77 20 28 20 ..: cmd-throw (
1d80: 65 72 72 6f 72 20 2d 2d 20 29 0a 20 20 20 20 63 error -- ). c
1d90: 6d 64 28 20 74 72 75 65 20 29 65 6c 73 65 28 20 md( true )else(
1da0: 72 65 6d 6f 74 65 3f 20 40 20 30 3d 20 29 20 49 remote? @ 0= ) I
1db0: 46 0a 09 5b 3a 20 2e 22 20 64 6f 2d 63 6d 64 2d F..[: ." do-cmd-
1dc0: 6c 6f 6f 70 3a 20 22 20 64 75 70 20 2e 20 2e 65 loop: " dup . .e
1dd0: 78 65 20 63 72 20 3b 5d 20 24 65 72 72 0a 09 64 xe cr ;] $err..d
1de0: 75 70 20 44 6f 45 72 72 6f 72 0a 09 62 75 66 2d up DoError..buf-
1df0: 73 74 61 74 65 20 40 20 73 68 6f 77 2d 6f 66 66 state @ show-off
1e00: 73 65 74 20 21 20 20 3c 65 72 72 3e 20 63 72 20 set ! <err> cr
1e10: 6e 65 74 32 6f 3a 73 65 65 2d 6d 65 20 3c 64 65 net2o:see-me <de
1e20: 66 61 75 6c 74 3e 20 73 68 6f 77 2d 6f 66 66 73 fault> show-offs
1e30: 65 74 20 6f 6e 0a 20 20 20 20 54 48 45 4e 0a 20 et on. THEN.
1e40: 20 20 20 75 6e 2d 63 6d 64 20 3e 74 68 72 6f 77 un-cmd >throw
1e50: 20 3b 0a 3a 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 ;.: do-cmd-loop
1e60: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 20 ( addr u -- )
1e70: 32 64 75 70 20 62 75 66 2d 64 75 6d 70 20 32 21 2dup buf-dump 2!
1e80: 0a 20 20 20 20 63 6d 64 28 20 3c 77 61 72 6e 3e . cmd( <warn>
1e90: 20 64 65 73 74 2d 66 6c 61 67 73 20 2e 64 65 73 dest-flags .des
1ea0: 74 2d 61 64 64 72 20 32 64 75 70 20 6e 65 74 32 t-addr 2dup net2
1eb0: 6f 3a 73 65 65 20 3c 64 65 66 61 75 6c 74 3e 20 o:see <default>
1ec0: 29 0a 20 20 20 20 73 70 40 20 3e 72 0a 20 20 20 ). sp@ >r.
1ed0: 20 5b 3a 20 42 45 47 49 4e 20 20 20 63 6d 64 2d [: BEGIN cmd-
1ee0: 64 69 73 70 61 74 63 68 20 64 75 70 20 30 3c 3d dispatch dup 0<=
1ef0: 20 20 55 4e 54 49 4c 20 3b 5d 20 63 61 74 63 68 UNTIL ;] catch
1f00: 0a 20 20 20 20 74 72 61 63 65 28 20 2e 22 20 63 . trace( ." c
1f10: 6d 64 20 6c 6f 6f 70 20 64 6f 6e 65 22 20 2e 73 md loop done" .s
1f20: 20 63 72 20 29 0a 20 20 20 20 3f 64 75 70 2d 49 cr ). ?dup-I
1f30: 46 20 20 20 63 6d 64 2d 74 68 72 6f 77 20 20 54 F cmd-throw T
1f40: 48 45 4e 0a 20 20 20 20 72 3e 20 73 70 21 20 32 HEN. r> sp! 2
1f50: 64 72 6f 70 20 2b 63 6d 64 20 3b 0a 3a 20 6e 65 drop +cmd ;.: ne
1f60: 73 74 2d 63 6d 64 2d 6c 6f 6f 70 20 28 20 61 64 st-cmd-loop ( ad
1f70: 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 62 75 dr u -- ). bu
1f80: 66 2d 64 75 6d 70 20 32 40 20 32 3e 72 20 62 75 f-dump 2@ 2>r bu
1f90: 66 2d 73 74 61 74 65 20 32 40 20 32 3e 72 20 5b f-state 2@ 2>r [
1fa0: 27 5d 20 64 6f 2d 63 6d 64 2d 6c 6f 6f 70 20 63 '] do-cmd-loop c
1fb0: 61 74 63 68 0a 20 20 20 20 32 72 3e 20 62 75 66 atch. 2r> buf
1fc0: 2d 73 74 61 74 65 20 32 40 20 64 30 3c 3e 20 49 -state 2@ d0<> I
1fd0: 46 20 20 62 75 66 2d 73 74 61 74 65 20 32 21 20 F buf-state 2!
1fe0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
1ff0: 45 4e 0a 20 20 20 20 32 72 3e 20 62 75 66 2d 64 EN. 2r> buf-d
2000: 75 6d 70 20 32 21 20 3f 64 75 70 2d 49 46 20 20 ump 2! ?dup-IF
2010: 74 68 72 6f 77 20 20 54 48 45 4e 20 3b 0a 0a 63 throw THEN ;..c
2020: 6d 64 2d 62 75 66 2d 63 20 27 20 6e 65 77 20 73 md-buf-c ' new s
2030: 74 61 74 69 63 2d 61 20 77 69 74 68 2d 61 6c 6c tatic-a with-all
2040: 6f 63 61 74 65 72 20 63 6f 64 65 2d 62 75 66 5e ocater code-buf^
2050: 20 21 0a 27 20 63 6f 64 65 2d 62 75 66 5e 20 63 !.' code-buf^ c
2060: 6d 64 62 75 66 3a 20 63 6f 64 65 2d 62 75 66 0a mdbuf: code-buf.
2070: 0a 63 6f 64 65 2d 62 75 66 0a 0a 3a 6e 6f 6e 61 .code-buf..:nona
2080: 6d 65 20 28 20 2d 2d 20 29 20 20 63 6d 64 62 75 me ( -- ) cmdbu
2090: 66 23 20 6f 66 66 20 20 63 6f 6e 6e 65 63 74 69 f# off connecti
20a0: 6f 6e 20 3e 6f 0a 09 72 65 71 3f 20 6f 66 66 20 on >o..req? off
20b0: 20 5b 27 5d 20 73 65 6e 64 2d 63 58 20 63 6f 64 ['] send-cX cod
20c0: 65 2d 72 65 70 6c 79 20 69 73 20 73 65 6e 64 2d e-reply is send-
20d0: 78 74 20 6f 3e 20 3b 20 74 6f 20 63 6d 64 72 65 xt o> ; to cmdre
20e0: 73 65 74 0a 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d set.:noname ( --
20f0: 20 61 64 64 72 20 29 20 20 20 63 6f 6e 6e 65 63 addr ) connec
2100: 74 69 6f 6e 20 2e 63 6f 64 65 2d 73 65 6d 61 20 tion .code-sema
2110: 3b 20 74 6f 20 63 6d 64 6c 6f 63 6b 0a 3a 6e 6f ; to cmdlock.:no
2120: 6e 61 6d 65 20 28 20 2d 2d 20 61 64 64 72 20 75 name ( -- addr u
2130: 20 29 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 2e 63 ) connection .c
2140: 6f 64 65 2d 64 65 73 74 20 63 6d 64 62 75 66 23 ode-dest cmdbuf#
2150: 20 40 20 3b 20 74 6f 20 63 6d 64 62 75 66 24 0a @ ; to cmdbuf$.
2160: 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 6e 20 29 :noname ( -- n )
2170: 20 20 6d 61 78 64 61 74 61 20 63 6d 64 62 75 66 maxdata cmdbuf
2180: 23 20 40 20 2d 20 3b 20 74 6f 20 6d 61 78 73 74 # @ - ; to maxst
2190: 72 69 6e 67 0a 3a 6e 6f 6e 61 6d 65 20 28 20 61 ring.:noname ( a
21a0: 64 64 72 20 75 20 2d 2d 20 29 20 64 75 70 20 6d ddr u -- ) dup m
21b0: 61 78 73 74 72 69 6e 67 20 75 3e 20 49 46 0a 09 axstring u> IF..
21c0: 63 6d 64 62 75 66 24 20 7e 7e 20 6e 65 74 32 6f cmdbuf$ ~~ net2o
21d0: 3a 73 65 65 20 74 72 75 65 20 21 21 63 6d 64 66 :see true !!cmdf
21e0: 69 74 21 21 20 20 54 48 45 4e 0a 20 20 20 20 74 it!! THEN. t
21f0: 75 63 6b 20 63 6d 64 62 75 66 24 20 2b 20 73 77 uck cmdbuf$ + sw
2200: 61 70 20 6d 6f 76 65 20 63 6d 64 62 75 66 23 20 ap move cmdbuf#
2210: 2b 21 20 3b 20 74 6f 20 2b 63 6d 64 62 75 66 0a +! ; to +cmdbuf.
2220: 3a 6e 6f 6e 61 6d 65 20 28 20 6e 20 2d 2d 20 29 :noname ( n -- )
2230: 20 20 63 6d 64 62 75 66 23 20 2b 21 20 3b 20 74 cmdbuf# +! ; t
2240: 6f 20 2d 63 6d 64 62 75 66 0a 3a 6e 6f 6e 61 6d o -cmdbuf.:nonam
2250: 65 20 28 20 2d 2d 20 36 34 64 65 73 74 20 29 20 e ( -- 64dest )
2260: 63 6f 64 65 2d 76 64 65 73 74 20 36 34 64 75 70 code-vdest 64dup
2270: 20 36 34 2d 30 3d 20 21 21 6e 6f 2d 64 65 73 74 64-0= !!no-dest
2280: 21 21 20 3b 20 74 6f 20 63 6d 64 64 65 73 74 0a !! ; to cmddest.
2290: 0a 53 65 6d 61 20 63 6d 64 30 6c 6f 63 6b 0a 0a .Sema cmd0lock..
22a0: 63 6d 64 2d 62 75 66 2d 63 20 63 6c 61 73 73 0a cmd-buf-c class.
22b0: 20 20 20 20 6d 61 78 64 61 74 61 20 75 76 61 72 maxdata uvar
22c0: 20 63 6d 64 30 62 75 66 0a 65 6e 64 2d 63 6c 61 cmd0buf.end-cla
22d0: 73 73 20 63 6d 64 2d 62 75 66 30 0a 0a 63 6d 64 ss cmd-buf0..cmd
22e0: 2d 62 75 66 30 20 27 20 6e 65 77 20 73 74 61 74 -buf0 ' new stat
22f0: 69 63 2d 61 20 77 69 74 68 2d 61 6c 6c 6f 63 61 ic-a with-alloca
2300: 74 65 72 20 63 6f 64 65 30 2d 62 75 66 5e 20 21 ter code0-buf^ !
2310: 0a 27 20 63 6f 64 65 30 2d 62 75 66 5e 20 63 6d .' code0-buf^ cm
2320: 64 62 75 66 3a 20 63 6f 64 65 30 2d 62 75 66 0a dbuf: code0-buf.
2330: 0a 5c 20 63 6f 6d 6d 61 6e 64 20 62 75 66 66 65 .\ command buffe
2340: 72 20 69 6e 20 61 20 73 74 72 69 6e 67 0a 0a 53 r in a string..S
2350: 65 6d 61 20 63 6d 64 24 6c 6f 63 6b 0a 0a 63 6d ema cmd$lock..cm
2360: 64 2d 62 75 66 2d 63 20 63 6c 61 73 73 0a 20 20 d-buf-c class.
2370: 20 20 63 65 6c 6c 20 75 76 61 72 20 63 6d 64 24 cell uvar cmd$
2380: 0a 65 6e 64 2d 63 6c 61 73 73 20 63 6d 64 2d 62 .end-class cmd-b
2390: 75 66 24 0a 0a 63 6d 64 2d 62 75 66 24 20 27 20 uf$..cmd-buf$ '
23a0: 6e 65 77 20 73 74 61 74 69 63 2d 61 20 77 69 74 new static-a wit
23b0: 68 2d 61 6c 6c 6f 63 61 74 65 72 20 63 6f 64 65 h-allocater code
23c0: 2d 62 75 66 24 5e 20 21 0a 27 20 63 6f 64 65 2d -buf$^ !.' code-
23d0: 62 75 66 24 5e 20 63 6d 64 62 75 66 3a 20 63 6f buf$^ cmdbuf: co
23e0: 64 65 2d 62 75 66 24 0a 0a 63 6f 64 65 2d 62 75 de-buf$..code-bu
23f0: 66 24 0a 0a 27 20 63 6d 64 24 6c 6f 63 6b 20 74 f$..' cmd$lock t
2400: 6f 20 63 6d 64 6c 6f 63 6b 0a 3a 6e 6f 6e 61 6d o cmdlock.:nonam
2410: 65 20 20 63 6d 64 24 20 24 40 20 3b 20 74 6f 20 e cmd$ $@ ; to
2420: 63 6d 64 62 75 66 24 0a 3a 6e 6f 6e 61 6d 65 20 cmdbuf$.:noname
2430: 20 63 6d 64 24 20 24 6f 66 66 20 3b 20 74 6f 20 cmd$ $off ; to
2440: 63 6d 64 72 65 73 65 74 0a 27 20 74 72 75 65 20 cmdreset.' true
2450: 74 6f 20 6d 61 78 73 74 72 69 6e 67 20 5c 20 72 to maxstring \ r
2460: 65 61 6c 6c 79 20 6d 61 78 75 69 6e 74 20 3d 20 eally maxuint =
2470: 2d 31 20 3d 20 74 72 75 65 0a 3a 6e 6f 6e 61 6d -1 = true.:nonam
2480: 65 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 e ( addr u -- )
2490: 63 6d 64 24 20 24 2b 21 20 3b 20 74 6f 20 2b 63 cmd$ $+! ; to +c
24a0: 6d 64 62 75 66 0a 3a 6e 6f 6e 61 6d 65 20 28 20 mdbuf.:noname (
24b0: 6e 20 2d 2d 20 29 20 20 63 6d 64 24 20 24 40 6c n -- ) cmd$ $@l
24c0: 65 6e 20 2b 20 63 6d 64 24 20 24 21 6c 65 6e 20 en + cmd$ $!len
24d0: 3b 20 74 6f 20 2d 63 6d 64 62 75 66 0a 3a 6e 6f ; to -cmdbuf.:no
24e0: 6e 61 6d 65 20 28 20 2d 2d 20 36 34 64 65 73 74 name ( -- 64dest
24f0: 20 29 20 36 34 23 30 20 3b 20 74 6f 20 63 6d 64 ) 64#0 ; to cmd
2500: 64 65 73 74 0a 0a 3a 20 67 65 6e 2d 63 6d 64 20 dest..: gen-cmd
2510: 28 20 78 74 20 2d 2d 20 24 61 64 64 72 20 29 0a ( xt -- $addr ).
2520: 20 20 20 20 63 6d 64 62 75 66 2d 6f 20 40 20 3e cmdbuf-o @ >
2530: 72 20 63 6f 64 65 2d 62 75 66 24 20 30 20 63 6d r code-buf$ 0 cm
2540: 64 24 20 21 40 20 3e 72 20 63 6d 64 62 75 66 23 d$ !@ >r cmdbuf#
2550: 20 40 20 3e 72 0a 20 20 20 20 63 61 74 63 68 0a @ >r. catch.
2560: 20 20 20 20 72 3e 20 63 6d 64 62 75 66 23 20 21 r> cmdbuf# !
2570: 20 20 72 3e 20 63 6d 64 24 20 21 40 20 72 3e 20 r> cmd$ !@ r>
2580: 63 6d 64 62 75 66 2d 6f 20 21 20 20 73 77 61 70 cmdbuf-o ! swap
2590: 20 74 68 72 6f 77 20 3b 0a 3a 20 67 65 6e 2d 63 throw ;.: gen-c
25a0: 6d 64 24 20 28 20 78 74 20 2d 2d 20 61 64 64 72 md$ ( xt -- addr
25b0: 20 75 20 29 0a 20 20 20 20 67 65 6e 2d 63 6d 64 u ). gen-cmd
25c0: 20 20 31 20 74 6d 70 24 23 20 2b 21 20 20 74 6d 1 tmp$# +! tm
25d0: 70 24 20 24 21 62 75 66 20 20 74 6d 70 24 20 24 p$ $!buf tmp$ $
25e0: 40 20 3b 0a 0a 63 6f 64 65 30 2d 62 75 66 20 5c @ ;..code0-buf \
25f0: 20 72 65 73 65 74 20 64 65 66 61 75 6c 74 0a 0a reset default..
2600: 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 61 64 64 :noname ( -- add
2610: 72 20 75 20 29 20 63 6d 64 30 62 75 66 20 63 6d r u ) cmd0buf cm
2620: 64 62 75 66 23 20 40 20 3b 20 74 6f 20 63 6d 64 dbuf# @ ; to cmd
2630: 62 75 66 24 0a 27 20 63 6d 64 30 6c 6f 63 6b 20 buf$.' cmd0lock
2640: 74 6f 20 63 6d 64 6c 6f 63 6b 0a 27 20 72 6e 67 to cmdlock.' rng
2650: 36 34 20 74 6f 20 63 6d 64 64 65 73 74 0a 3a 6e 64 to cmddest.:n
2660: 6f 6e 61 6d 65 20 28 20 2d 2d 20 29 20 20 63 6d oname ( -- ) cm
2670: 64 62 75 66 23 20 6f 66 66 20 20 6f 20 49 46 20 dbuf# off o IF
2680: 20 72 65 71 3f 20 6f 66 66 20 20 54 48 45 4e 20 req? off THEN
2690: 3b 20 74 6f 20 63 6d 64 72 65 73 65 74 0a 0a 3a ; to cmdreset..:
26a0: 6e 6f 6e 61 6d 65 20 28 20 2d 2d 20 29 0a 20 20 noname ( -- ).
26b0: 20 20 63 6d 64 2d 62 75 66 30 20 6e 65 77 20 63 cmd-buf0 new c
26c0: 6f 64 65 30 2d 62 75 66 5e 20 21 0a 20 20 20 20 ode0-buf^ !.
26d0: 63 6d 64 2d 62 75 66 2d 63 20 6e 65 77 20 63 6f cmd-buf-c new co
26e0: 64 65 2d 62 75 66 5e 20 21 0a 20 20 20 20 63 6d de-buf^ !. cm
26f0: 64 2d 62 75 66 24 20 6e 65 77 20 63 6f 64 65 2d d-buf$ new code-
2700: 62 75 66 24 5e 20 21 20 3b 20 69 73 20 61 6c 6c buf$^ ! ; is all
2710: 6f 63 2d 63 6f 64 65 2d 62 75 66 73 0a 3a 6e 6f oc-code-bufs.:no
2720: 6e 61 6d 65 0a 20 20 20 20 63 6f 64 65 30 2d 62 name. code0-b
2730: 75 66 5e 20 40 20 2e 64 69 73 70 6f 73 65 0a 20 uf^ @ .dispose.
2740: 20 20 20 63 6f 64 65 2d 62 75 66 5e 20 40 20 2e code-buf^ @ .
2750: 64 69 73 70 6f 73 65 0a 20 20 20 20 63 6f 64 65 dispose. code
2760: 2d 62 75 66 24 5e 20 40 20 3e 6f 20 63 6d 64 24 -buf$^ @ >o cmd$
2770: 20 24 6f 66 66 20 64 69 73 70 6f 73 65 20 6f 3e $off dispose o>
2780: 20 3b 20 69 73 20 66 72 65 65 2d 63 6f 64 65 2d ; is free-code-
2790: 62 75 66 73 0a 0a 5c 20 73 74 75 66 66 20 69 6e bufs..\ stuff in
27a0: 74 6f 20 63 6f 64 65 20 62 75 66 66 65 72 73 0a to code buffers.
27b0: 0a 3a 20 64 6f 2d 3c 72 65 71 20 28 20 2d 2d 20 .: do-<req ( --
27c0: 29 20 20 6f 20 49 46 20 20 72 65 71 3f 20 40 20 ) o IF req? @
27d0: 30 3e 20 49 46 20 20 72 65 71 3f 20 6f 6e 20 73 0> IF req? on s
27e0: 74 61 72 74 2d 72 65 71 20 20 54 48 45 4e 20 20 tart-req THEN
27f0: 54 48 45 4e 20 3b 0a 3a 20 63 6d 64 74 6d 70 24 THEN ;.: cmdtmp$
2800: 20 28 20 36 34 6e 20 2d 2d 20 61 64 64 72 20 75 ( 64n -- addr u
2810: 20 29 20 20 63 6d 64 74 6d 70 20 70 21 2b 20 63 ) cmdtmp p!+ c
2820: 6d 64 74 6d 70 20 74 75 63 6b 20 2d 20 3b 0a 3a mdtmp tuck - ;.:
2830: 20 63 6d 64 2c 20 28 20 36 34 6e 20 2d 2d 20 29 cmd, ( 64n -- )
2840: 20 20 64 6f 2d 3c 72 65 71 20 63 6d 64 74 6d 70 do-<req cmdtmp
2850: 24 20 2b 63 6d 64 62 75 66 20 3b 0a 0a 3a 20 6e $ +cmdbuf ;..: n
2860: 65 74 32 6f 2c 20 40 20 6e 3e 36 34 20 63 6d 64 et2o, @ n>64 cmd
2870: 2c 20 3b 0a 0a 5c 20 6e 65 74 32 6f 20 64 6f 63 , ;..\ net2o doc
2880: 20 70 72 6f 64 75 63 74 69 6f 6e 0a 0a 44 65 66 production..Def
2890: 65 72 20 2e 6e 2d 6e 61 6d 65 20 20 27 20 6e 6f er .n-name ' no
28a0: 6f 70 20 69 73 20 2e 6e 2d 6e 61 6d 65 0a 5b 49 op is .n-name.[I
28b0: 46 44 45 46 5d 20 64 6f 63 67 65 6e 0a 20 20 20 FDEF] docgen.
28c0: 20 66 61 6c 73 65 20 77 61 72 6e 69 6e 67 73 20 false warnings
28d0: 21 40 0a 20 20 20 20 3a 20 5c 67 20 28 20 72 65 !@. : \g ( re
28e0: 73 74 2d 6f 66 2d 6c 69 6e 65 20 2d 2d 20 29 0a st-of-line -- ).
28f0: 09 73 6f 75 72 63 65 20 3e 69 6e 20 40 20 2f 73 .source >in @ /s
2900: 74 72 69 6e 67 20 6f 76 65 72 20 32 20 2d 20 63 tring over 2 - c
2910: 40 20 27 67 27 20 3d 20 3e 72 0a 09 3e 69 6e 20 @ 'g' = >r..>in
2920: 40 20 33 20 3e 20 72 40 20 61 6e 64 20 32 20 61 @ 3 > r@ and 2 a
2930: 6e 64 20 73 70 61 63 65 73 0a 09 64 75 70 20 3e nd spaces..dup >
2940: 69 6e 20 2b 21 0a 09 72 3e 20 49 46 20 20 74 79 in +!..r> IF ty
2950: 70 65 20 63 72 20 20 45 4c 53 45 20 20 32 64 72 pe cr ELSE 2dr
2960: 6f 70 20 20 54 48 45 4e 20 3b 20 69 6d 6d 65 64 op THEN ; immed
2970: 69 61 74 65 0a 20 20 20 20 77 61 72 6e 69 6e 67 iate. warning
2980: 73 20 21 0a 5b 54 48 45 4e 5d 0a 0a 5c 20 6e 65 s !.[THEN]..\ ne
2990: 74 32 6f 20 63 6f 6d 6d 61 6e 64 20 64 65 66 69 t2o command defi
29a0: 6e 69 74 69 6f 6e 0a 0a 30 20 56 61 6c 75 65 20 nition..0 Value
29b0: 6c 61 73 74 2d 32 6f 0a 0a 3a 20 6e 65 74 32 6f last-2o..: net2o
29c0: 2d 64 6f 65 73 20 20 44 4f 45 53 3e 20 6e 65 74 -does DOES> net
29d0: 32 6f 2c 20 3b 0a 3a 20 6e 65 74 32 6f 3a 20 28 2o, ;.: net2o: (
29e0: 20 6e 75 6d 62 65 72 20 22 6e 61 6d 65 22 20 2d number "name" -
29f0: 2d 20 29 0a 20 20 20 20 2e 6e 2d 6e 61 6d 65 0a - ). .n-name.
2a00: 20 20 20 20 5b 27 5d 20 6e 6f 6f 70 20 6f 76 65 ['] noop ove
2a10: 72 20 3e 63 6d 64 20 5c 20 61 6c 6c 6f 63 61 74 r >cmd \ allocat
2a20: 65 20 73 70 61 63 65 20 69 6e 20 74 61 62 6c 65 e space in table
2a30: 0a 20 20 20 20 43 72 65 61 74 65 20 20 68 65 72 . Create her
2a40: 65 20 74 6f 20 6c 61 73 74 2d 32 6f 0a 20 20 20 e to last-2o.
2a50: 20 64 75 70 20 3e 72 20 2c 20 68 65 72 65 20 3e dup >r , here >
2a60: 72 20 30 20 2c 20 30 20 2c 20 30 20 2c 20 6e 65 r 0 , 0 , 0 , ne
2a70: 74 32 6f 2d 64 6f 65 73 20 6e 6f 6e 61 6d 65 20 t2o-does noname
2a80: 3a 0a 20 20 20 20 6c 61 73 74 78 74 20 64 75 70 :. lastxt dup
2a90: 20 72 3e 20 21 20 72 3e 20 3e 63 6d 64 20 3b 0a r> ! r> >cmd ;.
2aa0: 3a 20 2b 6e 65 74 32 6f 3a 20 28 20 22 6e 61 6d : +net2o: ( "nam
2ab0: 65 22 20 2d 2d 20 29 20 67 65 6e 2d 74 61 62 6c e" -- ) gen-tabl
2ac0: 65 20 24 5b 5d 23 20 6e 65 74 32 6f 3a 20 3b 0a e $[]# net2o: ;.
2ad0: 3a 20 3e 74 61 62 6c 65 20 28 20 74 61 62 6c 65 : >table ( table
2ae0: 20 2d 2d 20 29 20 20 6c 61 73 74 2d 32 6f 20 32 -- ) last-2o 2
2af0: 20 63 65 6c 6c 73 20 2b 20 21 20 3b 0a 3a 20 63 cells + ! ;.: c
2b00: 6d 64 73 69 67 20 28 20 2d 2d 20 61 64 64 72 20 mdsig ( -- addr
2b10: 29 20 20 6c 61 73 74 2d 32 6f 20 33 20 63 65 6c ) last-2o 3 cel
2b20: 6c 73 20 2b 20 3b 0a 3a 20 6e 65 74 32 6f 27 20 ls + ;.: net2o'
2b30: 28 20 22 6e 61 6d 65 22 20 2d 2d 20 29 20 27 20 ( "name" -- ) '
2b40: 3e 62 6f 64 79 20 40 20 3b 0a 0a 46 6f 72 77 61 >body @ ;..Forwa
2b50: 72 64 20 6e 65 74 32 6f 3a 77 6f 72 64 73 0a 0a rd net2o:words..
2b60: 3a 20 69 6e 68 65 72 69 74 2d 74 61 62 6c 65 20 : inherit-table
2b70: 28 20 61 64 64 72 20 75 20 22 6e 61 6d 65 22 20 ( addr u "name"
2b80: 2d 2d 20 29 0a 20 20 20 20 27 20 64 75 70 20 49 -- ). ' dup I
2b90: 53 20 67 65 6e 2d 74 61 62 6c 65 20 20 65 78 65 S gen-table exe
2ba0: 63 75 74 65 20 24 21 20 3b 0a 0a 56 6f 63 61 62 cute $! ;..Vocab
2bb0: 75 6c 61 72 79 20 6e 65 74 32 6f 2d 62 61 73 65 ulary net2o-base
2bc0: 0a 0a 46 6f 72 77 61 72 64 20 64 6f 2d 72 65 71 ..Forward do-req
2bd0: 3e 0a 0a 3a 20 64 6f 2d 6e 65 73 74 20 28 20 61 >..: do-nest ( a
2be0: 64 64 72 20 75 20 66 6c 61 67 20 2d 2d 20 29 0a ddr u flag -- ).
2bf0: 20 20 20 20 64 75 70 20 3e 72 20 20 76 61 6c 69 dup >r vali
2c00: 64 61 74 65 64 20 6f 72 21 20 20 5b 27 5d 20 6e dated or! ['] n
2c10: 65 73 74 2d 63 6d 64 2d 6c 6f 6f 70 20 63 61 74 est-cmd-loop cat
2c20: 63 68 0a 20 20 20 20 72 3e 20 69 6e 76 65 72 74 ch. r> invert
2c30: 20 76 61 6c 69 64 61 74 65 64 20 61 6e 64 21 20 validated and!
2c40: 20 74 68 72 6f 77 20 3b 0a 0a 3a 20 64 6f 2d 6e throw ;..: do-n
2c50: 65 73 74 73 69 67 20 28 20 61 64 64 72 20 75 20 estsig ( addr u
2c60: 2d 2d 20 29 0a 20 20 20 20 73 69 67 6e 65 64 2d -- ). signed-
2c70: 76 61 6c 20 64 6f 2d 6e 65 73 74 20 3b 0a 0a 3a val do-nest ;..:
2c80: 20 63 6d 64 3a 6e 65 73 74 73 69 67 20 28 20 61 cmd:nestsig ( a
2c90: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 6e ddr u -- ). n
2ca0: 65 73 74 2d 73 69 67 20 64 75 70 20 30 3d 20 49 est-sig dup 0= I
2cb0: 46 20 20 64 72 6f 70 20 64 6f 2d 6e 65 73 74 73 F drop do-nests
2cc0: 69 67 20 20 45 4c 53 45 20 20 21 21 73 69 67 21 ig ELSE !!sig!
2cd0: 21 20 20 54 48 45 4e 20 3b 0a 0a 73 63 6f 70 65 ! THEN ;..scope
2ce0: 7b 20 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 5c 20 { net2o-base..\
2cf0: 43 6f 6d 6d 61 6e 64 20 6e 75 6d 62 65 72 73 20 Command numbers
2d00: 70 72 65 6c 69 6d 69 6e 61 72 79 20 61 6e 64 20 preliminary and
2d10: 73 75 62 6a 65 63 74 20 74 6f 20 63 68 61 6e 67 subject to chang
2d20: 65 0a 0a 44 65 66 65 72 20 64 6f 63 28 67 65 6e e..Defer doc(gen
2d30: 20 20 27 20 6e 6f 6f 70 20 69 73 20 64 6f 63 28 ' noop is doc(
2d40: 67 65 6e 0a 0a 3a 20 28 3e 73 69 67 20 28 20 22 gen..: (>sig ( "
2d50: 63 6f 6d 6d 65 6e 74 73 22 2a 20 27 5d 27 20 2d comments"* ']' -
2d60: 2d 20 29 0a 20 20 20 20 73 22 20 28 22 20 63 6d - ). s" (" cm
2d70: 64 73 69 67 20 24 21 0a 20 20 20 20 42 45 47 49 dsig $!. BEGI
2d80: 4e 20 20 70 61 72 73 65 2d 6e 61 6d 65 20 64 75 N parse-name du
2d90: 70 20 20 57 48 49 4c 45 20 20 6f 76 65 72 20 63 p WHILE over c
2da0: 40 20 63 6d 64 73 69 67 20 63 24 2b 21 0a 09 73 @ cmdsig c$+!..s
2db0: 22 20 29 22 20 73 74 72 3d 20 55 4e 54 49 4c 20 " )" str= UNTIL
2dc0: 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 48 ELSE 2drop TH
2dd0: 45 4e 20 3b 0a 0a 3a 20 28 20 28 20 22 74 79 70 EN ;..: ( ( "typ
2de0: 65 22 2a 20 22 2d 2d 22 20 22 74 79 70 65 22 2a e"* "--" "type"*
2df0: 20 22 72 70 61 72 65 6e 22 20 2d 2d 20 29 20 27 "rparen" -- ) '
2e00: 29 27 20 70 61 72 73 65 20 32 64 72 6f 70 20 3b )' parse 2drop ;
2e10: 0a 63 6f 6d 70 73 65 6d 3a 20 63 6d 64 73 69 67 .compsem: cmdsig
2e20: 20 40 20 49 46 20 20 27 29 27 20 70 61 72 73 65 @ IF ')' parse
2e30: 20 32 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 2drop EXIT TH
2e40: 45 4e 0a 20 20 20 20 64 6f 63 28 67 65 6e 20 28 EN. doc(gen (
2e50: 3e 73 69 67 20 3b 0a 0a 30 20 6e 65 74 32 6f 3a >sig ;..0 net2o:
2e60: 20 64 75 6d 6d 79 20 28 20 2d 2d 20 29 20 3b 0a dummy ( -- ) ;.
2e70: 0a 5b 49 46 44 45 46 5d 20 64 6f 63 67 65 6e 0a .[IFDEF] docgen.
2e80: 20 20 20 20 3a 6e 6f 6e 61 6d 65 20 28 20 2d 2d :noname ( --
2e90: 20 29 0a 09 3e 69 6e 20 40 20 3e 72 20 27 29 27 )..>in @ >r ')'
2ea0: 20 70 61 72 73 65 20 2e 22 20 20 28 20 22 20 74 parse ." ( " t
2eb0: 79 70 65 20 2e 22 20 29 22 20 63 72 20 72 3e 20 ype ." )" cr r>
2ec0: 3e 69 6e 20 21 20 3b 20 69 73 20 64 6f 63 28 67 >in ! ; is doc(g
2ed0: 65 6e 0a 20 20 20 20 3a 6e 6f 6e 61 6d 65 20 28 en. :noname (
2ee0: 20 6e 20 22 6e 61 6d 65 22 20 2d 2d 20 29 0a 09 n "name" -- )..
2ef0: 2e 22 20 2a 20 22 20 64 75 70 20 68 65 78 2e 20 ." * " dup hex.
2f00: 3e 69 6e 20 40 20 3e 72 20 70 61 72 73 65 2d 6e >in @ >r parse-n
2f10: 61 6d 65 20 74 79 70 65 20 72 3e 20 3e 69 6e 20 ame type r> >in
2f20: 21 20 3b 20 69 73 20 2e 6e 2d 6e 61 6d 65 0a 5b ! ; is .n-name.[
2f30: 54 48 45 4e 5d 0a 0a 3a 20 3f 76 65 72 73 69 6f THEN]..: ?versio
2f40: 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a n ( addr u -- ).
2f50: 20 20 20 20 6e 65 74 32 6f 2d 76 65 72 73 69 6f net2o-versio
2f60: 6e 20 32 6f 76 65 72 20 73 74 72 3c 20 49 46 0a n 2over str< IF.
2f70: 09 3c 65 72 72 3e 20 2e 22 20 4f 74 68 65 72 20 .<err> ." Other
2f80: 73 69 64 65 20 68 61 73 20 6d 6f 72 65 20 72 65 side has more re
2f90: 63 65 6e 74 20 6e 65 74 32 6f 20 76 65 72 73 69 cent net2o versi
2fa0: 6f 6e 3a 20 22 20 66 6f 72 74 68 3a 74 79 70 65 on: " forth:type
2fb0: 0a 09 3c 77 61 72 6e 3e 20 2e 22 20 2c 20 6f 75 ..<warn> ." , ou
2fc0: 72 73 3a 20 22 20 6e 65 74 32 6f 2d 76 65 72 73 rs: " net2o-vers
2fd0: 69 6f 6e 20 66 6f 72 74 68 3a 74 79 70 65 20 3c ion forth:type <
2fe0: 64 65 66 61 75 6c 74 3e 20 66 6f 72 74 68 3a 63 default> forth:c
2ff0: 72 0a 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f r. ELSE 2dro
3000: 70 20 20 54 48 45 4e 20 3b 0a 0a 5c 67 20 23 20 p THEN ;..\g #
3010: 43 6f 6d 6d 61 6e 64 73 20 23 0a 5c 67 20 0a 5c Commands #.\g .\
3020: 67 20 56 65 72 73 69 6f 6e 20 40 56 45 52 53 49 g Version @VERSI
3030: 4f 4e 40 2e 0a 5c 67 20 0a 5c 67 20 6e 65 74 32 ON@..\g .\g net2
3040: 6f 20 73 65 70 61 72 61 74 65 73 20 64 61 74 61 o separates data
3050: 20 61 6e 64 20 63 6f 6d 6d 61 6e 64 73 2e 20 20 and commands.
3060: 44 61 74 61 20 69 73 20 70 61 73 73 65 64 20 74 Data is passed t
3070: 68 72 6f 75 67 68 20 74 6f 20 68 69 67 68 65 72 hrough to higher
3080: 0a 5c 67 20 6c 61 79 65 72 73 2c 20 63 6f 6d 6d .\g layers, comm
3090: 61 6e 64 73 20 61 72 65 20 69 6e 74 65 72 70 72 ands are interpr
30a0: 65 74 65 64 20 77 68 65 6e 20 74 68 65 79 20 61 eted when they a
30b0: 72 72 69 76 65 2e 20 20 46 6f 72 20 63 6f 6e 6e rrive. For conn
30c0: 65 63 74 69 6f 6e 0a 5c 67 20 72 65 71 75 65 73 ection.\g reques
30d0: 74 73 2c 20 61 20 73 70 65 63 69 61 6c 20 62 69 ts, a special bi
30e0: 74 20 69 73 20 73 65 74 2c 20 61 6e 64 20 74 68 t is set, and th
30f0: 65 20 61 64 64 72 65 73 73 20 74 68 65 6e 20 69 e address then i
3100: 73 6e 27 74 20 75 73 65 64 20 61 73 0a 5c 67 20 sn't used as.\g
3110: 61 64 64 72 65 73 73 2c 20 62 75 74 20 61 73 20 address, but as
3120: 49 56 20 66 6f 72 20 74 68 65 20 6f 70 70 6f 72 IV for the oppor
3130: 74 75 6e 69 73 74 69 63 20 65 6e 63 6f 64 69 6e tunistic encodin
3140: 67 2e 0a 5c 67 20 0a 5c 67 20 54 68 65 20 63 6f g..\g .\g The co
3150: 6d 6d 61 6e 64 20 69 6e 74 65 72 70 72 65 74 65 mmand interprete
3160: 72 20 69 73 20 61 20 73 74 61 63 6b 20 6d 61 63 r is a stack mac
3170: 68 69 6e 65 20 77 69 74 68 20 74 77 6f 20 64 61 hine with two da
3180: 74 61 20 74 79 70 65 73 3a 20 36 34 0a 5c 67 20 ta types: 64.\g
3190: 62 69 74 20 69 6e 74 65 67 65 72 73 20 61 6e 64 bit integers and
31a0: 20 73 74 72 69 6e 67 73 20 28 66 6c 6f 61 74 73 strings (floats
31b0: 20 61 72 65 20 61 6c 73 6f 20 73 75 70 70 6f 72 are also suppor
31c0: 65 64 2c 20 62 75 74 20 75 73 65 64 0a 5c 67 20 ed, but used.\g
31d0: 69 6e 66 72 65 71 75 65 6e 74 6c 79 29 2e 20 20 infrequently).
31e0: 45 6e 63 6f 64 69 6e 67 20 6f 66 20 63 6f 6d 6d Encoding of comm
31f0: 61 6e 64 73 2c 20 69 6e 74 65 67 65 72 73 20 61 ands, integers a
3200: 6e 64 20 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 nd string length
3210: 0a 5c 67 20 66 6f 6c 6c 6f 77 73 20 70 72 6f 74 .\g follows prot
3220: 6f 62 75 66 20 63 6f 6e 63 65 70 74 75 61 6c 6c obuf conceptuall
3230: 79 20 28 62 75 74 20 4d 53 42 20 66 69 72 73 74 y (but MSB first
3240: 2c 20 6e 6f 74 20 4c 53 42 20 66 69 72 73 74 20 , not LSB first
3250: 61 73 20 77 69 74 68 0a 5c 67 20 70 72 6f 74 6f as with.\g proto
3260: 62 75 66 2c 20 74 6f 20 73 69 6d 70 6c 69 66 79 buf, to simplify
3270: 20 73 63 61 6e 6e 69 6e 67 29 2c 20 73 74 72 69 scanning), stri
3280: 6e 67 73 20 61 72 65 20 6a 75 73 74 20 73 65 71 ngs are just seq
3290: 75 65 6e 63 65 73 20 6f 66 0a 5c 67 20 62 79 74 uences of.\g byt
32a0: 65 73 20 28 69 6e 74 65 72 70 72 65 74 61 74 69 es (interpretati
32b0: 6f 6e 20 63 61 6e 20 76 61 72 79 29 2e 20 20 43 on can vary). C
32c0: 6f 6d 6d 61 6e 64 20 62 6c 6f 63 6b 73 20 63 6f ommand blocks co
32d0: 6e 74 61 69 6e 20 61 20 73 65 71 75 65 6e 63 65 ntain a sequence
32e0: 0a 5c 67 20 6f 66 20 63 6f 6d 6d 61 6e 64 73 3b .\g of commands;
32f0: 20 74 68 65 72 65 20 61 72 65 20 6e 6f 20 63 6f there are no co
3300: 6e 64 69 74 69 6f 6e 61 6c 73 20 61 6e 64 20 6c nditionals and l
3310: 6f 6f 70 69 6e 67 20 69 6e 73 74 72 75 63 74 69 ooping instructi
3320: 6f 6e 73 2e 0a 5c 67 20 0a 5c 67 20 53 74 72 69 ons..\g .\g Stri
3330: 6e 67 73 20 63 61 6e 20 63 6f 6e 74 61 69 6e 20 ngs can contain
3340: 65 6e 63 72 79 70 74 65 64 20 6e 65 73 74 65 64 encrypted nested
3350: 20 63 6f 6d 6d 61 6e 64 73 2c 20 75 73 65 64 20 commands, used
3360: 64 75 72 69 6e 67 0a 5c 67 20 63 6f 6d 6d 75 6e during.\g commun
3370: 69 63 61 74 69 6f 6e 20 73 65 74 75 70 2e 0a 5c ication setup..\
3380: 67 20 0a 5c 67 20 23 23 20 4c 69 73 74 20 6f 66 g .\g ## List of
3390: 20 43 6f 6d 6d 61 6e 64 73 20 23 23 0a 5c 67 20 Commands ##.\g
33a0: 0a 5c 67 20 43 6f 6d 6d 61 6e 64 73 20 61 72 65 .\g Commands are
33b0: 20 63 6f 6e 74 65 78 74 2d 73 65 6e 73 69 74 69 context-sensiti
33c0: 76 65 20 69 6e 20 61 6e 20 4f 4f 50 20 6d 65 74 ve in an OOP met
33d0: 68 6f 64 20 68 69 65 72 61 72 63 68 79 20 73 65 hod hierarchy se
33e0: 6e 73 65 2e 0a 5c 67 20 0a 5c 67 20 23 23 23 20 nse..\g .\g ###
33f0: 62 61 73 65 20 63 6f 6d 6d 61 6e 64 73 20 23 23 base commands ##
3400: 23 0a 5c 67 20 0a 0a 30 20 6e 65 74 32 6f 3a 20 #.\g ..0 net2o:
3410: 65 6e 64 2d 63 6d 64 20 28 20 2d 2d 20 29 20 5c end-cmd ( -- ) \
3420: 67 20 65 6e 64 20 63 6f 6d 6d 61 6e 64 20 62 75 g end command bu
3430: 66 66 65 72 0a 20 20 20 20 30 20 62 75 66 2d 73 ffer. 0 buf-s
3440: 74 61 74 65 20 21 20 3b 0a 2b 6e 65 74 32 6f 3a tate ! ;.+net2o:
3450: 20 6c 69 74 20 28 20 23 75 20 2d 2d 20 75 20 29 lit ( #u -- u )
3460: 20 5c 67 20 6c 69 74 65 72 61 6c 0a 20 20 20 20 \g literal.
3470: 70 40 20 3b 0a 2b 6e 65 74 32 6f 3a 20 2d 6c 69 p@ ;.+net2o: -li
3480: 74 20 28 20 23 6e 20 2d 2d 20 6e 20 29 20 5c 67 t ( #n -- n ) \g
3490: 20 6e 65 67 61 74 69 76 65 20 6c 69 74 65 72 61 negative litera
34a0: 6c 2c 20 69 6e 76 65 72 74 65 64 20 65 6e 63 6f l, inverted enco
34b0: 64 65 64 0a 20 20 20 20 70 40 20 36 34 69 6e 76 ded. p@ 64inv
34c0: 65 72 74 20 3b 0a 2b 6e 65 74 32 6f 3a 20 73 74 ert ;.+net2o: st
34d0: 72 69 6e 67 20 28 20 23 73 74 72 69 6e 67 20 2d ring ( #string -
34e0: 2d 20 24 3a 73 74 72 69 6e 67 20 29 20 5c 67 20 - $:string ) \g
34f0: 73 74 72 69 6e 67 20 6c 69 74 65 72 61 6c 0a 20 string literal.
3500: 20 20 20 73 74 72 69 6e 67 40 20 3b 0a 2b 6e 65 string@ ;.+ne
3510: 74 32 6f 3a 20 66 6c 69 74 20 28 20 23 64 66 6c t2o: flit ( #dfl
3520: 6f 61 74 20 2d 2d 20 72 20 29 20 5c 67 20 64 6f oat -- r ) \g do
3530: 75 62 6c 65 20 66 6c 6f 61 74 20 6c 69 74 65 72 uble float liter
3540: 61 6c 0a 20 20 20 20 70 66 40 20 3b 0a 2b 6e 65 al. pf@ ;.+ne
3550: 74 32 6f 3a 20 65 6e 64 2d 77 69 74 68 20 28 20 t2o: end-with (
3560: 6f 3a 6f 62 6a 65 63 74 20 2d 2d 20 29 20 5c 67 o:object -- ) \g
3570: 20 65 6e 64 20 73 63 6f 70 65 0a 20 20 20 20 64 end scope. d
3580: 6f 2d 72 65 71 3e 20 6e 3a 6f 3e 20 3b 0a 2b 6e o-req> n:o> ;.+n
3590: 65 74 32 6f 3a 20 6f 73 77 61 70 20 28 20 6f 3a et2o: oswap ( o:
35a0: 6e 65 73 74 20 6f 3a 63 75 72 72 65 6e 74 20 2d nest o:current -
35b0: 2d 20 6f 3a 63 75 72 72 65 6e 74 20 6f 3a 6e 65 - o:current o:ne
35c0: 73 74 20 29 0a 20 20 20 20 64 6f 2d 72 65 71 3e st ). do-req>
35d0: 20 6e 3a 6f 73 77 61 70 20 3b 0a 2b 6e 65 74 32 n:oswap ;.+net2
35e0: 6f 3a 20 74 72 75 20 28 20 2d 2d 20 66 3a 74 72 o: tru ( -- f:tr
35f0: 75 65 20 29 20 5c 67 20 74 72 75 65 20 66 6c 61 ue ) \g true fla
3600: 67 20 6c 69 74 65 72 61 6c 0a 20 20 20 20 74 72 g literal. tr
3610: 75 65 20 3b 0a 2b 6e 65 74 32 6f 3a 20 66 61 6c ue ;.+net2o: fal
3620: 73 20 28 20 2d 2d 20 66 3a 66 61 6c 73 65 20 29 s ( -- f:false )
3630: 20 5c 67 20 66 61 6c 73 65 20 66 6c 61 67 20 6c \g false flag l
3640: 69 74 65 72 61 6c 0a 20 20 20 20 66 61 6c 73 65 iteral. false
3650: 20 3b 0a 2b 6e 65 74 32 6f 3a 20 77 6f 72 64 73 ;.+net2o: words
3660: 20 28 20 75 73 74 61 72 74 20 2d 2d 20 29 20 5c ( ustart -- ) \
3670: 67 20 72 65 66 6c 65 63 74 69 6f 6e 0a 20 20 20 g reflection.
3680: 20 36 34 3e 6e 20 6e 65 74 32 6f 3a 77 6f 72 64 64>n net2o:word
3690: 73 20 3b 0a 2b 6e 65 74 32 6f 3a 20 6e 65 73 74 s ;.+net2o: nest
36a0: 73 69 67 20 28 20 24 3a 63 6d 64 2b 73 69 67 20 sig ( $:cmd+sig
36b0: 2d 2d 20 29 20 5c 67 20 63 68 65 63 6b 20 73 69 -- ) \g check si
36c0: 67 2b 6e 65 73 74 0a 20 20 20 20 24 3e 20 63 6d g+nest. $> cm
36d0: 64 3a 6e 65 73 74 73 69 67 20 3b 20 5c 20 62 61 d:nestsig ; \ ba
36e0: 6c 6b 20 6f 6e 20 61 6c 6c 20 77 72 6f 6e 67 20 lk on all wrong
36f0: 73 69 67 6e 61 74 75 72 65 73 0a 2b 6e 65 74 32 signatures.+net2
3700: 6f 3a 20 73 65 63 73 74 72 69 6e 67 20 28 20 23 o: secstring ( #
3710: 73 74 72 69 6e 67 20 2d 2d 20 24 3a 73 74 72 69 string -- $:stri
3720: 6e 67 20 29 20 5c 67 20 73 65 63 72 65 74 20 73 ng ) \g secret s
3730: 74 72 69 6e 67 20 6c 69 74 65 72 61 6c 0a 20 20 tring literal.
3740: 20 20 73 74 72 69 6e 67 40 20 3b 0a 2b 6e 65 74 string@ ;.+net
3750: 32 6f 3a 20 6e 6f 70 20 28 20 2d 2d 20 29 20 6e 2o: nop ( -- ) n
3760: 61 74 28 20 2e 22 20 6e 6f 70 22 20 66 6f 72 74 at( ." nop" fort
3770: 68 3a 63 72 20 29 20 3b 20 5c 67 20 64 6f 20 6e h:cr ) ; \g do n
3780: 6f 74 68 69 6e 67 0a 2b 6e 65 74 32 6f 3a 20 34 othing.+net2o: 4
3790: 63 63 20 28 20 23 33 6c 65 74 74 65 72 20 2d 2d cc ( #3letter --
37a0: 20 29 0a 20 20 20 20 5c 67 20 41 74 20 74 68 65 ). \g At the
37b0: 20 62 65 67 69 6e 6e 69 6e 67 20 6f 66 20 61 20 beginning of a
37c0: 66 69 6c 65 2c 20 74 68 69 73 20 63 61 6e 20 62 file, this can b
37d0: 65 20 75 73 65 64 20 61 73 20 46 6f 75 72 43 43 e used as FourCC
37e0: 20 63 6f 64 65 0a 20 20 20 20 62 75 66 2d 73 74 code. buf-st
37f0: 61 74 65 20 32 40 20 33 20 2f 73 74 72 69 6e 67 ate 2@ 3 /string
3800: 20 64 75 70 20 30 3c 20 21 21 73 74 72 69 6e 67 dup 0< !!string
3810: 66 69 74 21 21 20 62 75 66 2d 73 74 61 74 65 20 fit!! buf-state
3820: 32 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 70 61 64 2! ;.+net2o: pad
3830: 64 69 6e 67 20 28 20 23 6c 65 6e 20 2d 2d 20 29 ding ( #len -- )
3840: 0a 20 20 20 20 5c 67 20 61 64 64 20 70 61 64 64 . \g add padd
3850: 69 6e 67 20 74 6f 20 61 6c 69 67 6e 20 66 69 65 ing to align fie
3860: 6c 64 73 0a 20 20 20 20 73 74 72 69 6e 67 40 20 lds. string@
3870: 24 3e 20 32 64 72 6f 70 20 3b 0a 2b 6e 65 74 32 $> 2drop ;.+net2
3880: 6f 3a 20 76 65 72 73 69 6f 6e 20 28 20 24 3a 76 o: version ( $:v
3890: 65 72 73 69 6f 6e 20 2d 2d 20 29 20 5c 67 20 76 ersion -- ) \g v
38a0: 65 72 73 69 6f 6e 20 63 68 65 63 6b 0a 20 20 20 ersion check.
38b0: 20 24 3e 20 3f 76 65 72 73 69 6f 6e 20 3b 0a 7d $> ?version ;.}
38c0: 73 63 6f 70 65 0a 0a 63 6d 64 2d 74 61 62 6c 65 scope..cmd-table
38d0: 20 24 73 61 76 65 0a 0a 61 6c 73 6f 20 6e 65 74 $save..also net
38e0: 32 6f 2d 62 61 73 65 0a 3a 20 64 6f 2d 72 65 71 2o-base.: do-req
38f0: 3e 20 6f 20 49 46 20 20 72 65 71 3f 20 40 20 30 > o IF req? @ 0
3900: 3c 20 20 49 46 20 20 65 6e 64 2d 77 69 74 68 20 < IF end-with
3910: 72 65 71 3f 20 6f 66 66 20 20 54 48 45 4e 20 20 req? off THEN
3920: 54 48 45 4e 20 3b 0a 70 72 65 76 69 6f 75 73 0a THEN ;.previous.
3930: 0a 67 65 6e 2d 74 61 62 6c 65 20 24 40 20 69 6e .gen-table $@ in
3940: 68 65 72 69 74 2d 74 61 62 6c 65 20 72 65 70 6c herit-table repl
3950: 79 2d 74 61 62 6c 65 0a 0a 5c 20 6e 65 74 32 6f y-table..\ net2o
3960: 20 61 73 73 65 6d 62 6c 65 72 0a 0a 3a 20 63 6d assembler..: cm
3970: 64 30 21 20 28 20 2d 2d 20 29 0a 20 20 20 20 5c d0! ( -- ). \
3980: 47 20 69 6e 69 74 69 61 6c 69 7a 65 20 61 20 73 G initialize a s
3990: 74 61 74 65 6c 65 73 73 20 63 6f 6d 6d 61 6e 64 tateless command
39a0: 0a 20 20 20 20 63 6f 64 65 30 2d 62 75 66 20 20 . code0-buf
39b0: 73 74 61 74 65 6c 65 73 73 23 20 6f 75 74 66 6c stateless# outfl
39c0: 61 67 20 21 20 3b 0a 3a 20 63 6d 64 21 20 28 20 ag ! ;.: cmd! (
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 66 75 ialize a statefu
39f0: 6c 6c 20 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 63 ll command. c
3a00: 6f 64 65 2d 62 75 66 20 20 6f 75 74 66 6c 61 67 ode-buf outflag
3a10: 20 6f 66 66 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74 off ;..also net
3a20: 32 6f 2d 62 61 73 65 0a 0a 55 44 65 66 65 72 20 2o-base..UDefer
3a30: 65 78 70 65 63 74 2d 72 65 70 6c 79 3f 0a 27 20 expect-reply?.'
3a40: 65 6e 64 2d 63 6d 64 20 49 53 20 65 78 70 65 63 end-cmd IS expec
3a50: 74 2d 72 65 70 6c 79 3f 0a 0a 3a 20 69 6e 69 74 t-reply?..: init
3a60: 2d 72 65 70 6c 79 20 20 5b 27 5d 20 65 6e 64 2d -reply ['] end-
3a70: 63 6d 64 20 49 53 20 65 78 70 65 63 74 2d 72 65 cmd IS expect-re
3a80: 70 6c 79 3f 20 20 5b 27 5d 20 64 72 6f 70 20 63 ply? ['] drop c
3a90: 6d 64 2d 72 65 70 6c 79 2d 78 74 20 21 20 3b 0a md-reply-xt ! ;.
3aa0: 0a 70 72 65 76 69 6f 75 73 0a 0a 3a 20 6e 65 74 .previous..: net
3ab0: 32 6f 2d 63 6f 64 65 20 28 20 2d 2d 20 29 0a 20 2o-code ( -- ).
3ac0: 20 20 20 5c 47 20 73 74 61 72 74 20 61 20 73 74 \G start a st
3ad0: 61 74 65 66 75 6c 6c 20 63 6f 6d 6d 61 6e 64 0a atefull command.
3ae0: 20 20 20 20 63 6d 64 21 20 20 63 6d 64 6c 6f 63 cmd! cmdloc
3af0: 6b 20 6c 6f 63 6b 0a 20 20 20 20 63 6d 64 72 65 k lock. cmdre
3b00: 73 65 74 20 69 6e 69 74 2d 72 65 70 6c 79 20 31 set init-reply 1
3b10: 20 63 6f 64 65 2b 20 61 6c 73 6f 20 6e 65 74 32 code+ also net2
3b20: 6f 2d 62 61 73 65 20 3b 0a 63 6f 6d 70 73 65 6d o-base ;.compsem
3b30: 3a 20 5b 27 5d 20 6e 65 74 32 6f 2d 63 6f 64 65 : ['] net2o-code
3b40: 20 63 6f 6d 70 69 6c 65 2c 20 61 6c 73 6f 20 6e compile, also n
3b50: 65 74 32 6f 2d 62 61 73 65 20 3b 0a 3a 20 6e 65 et2o-base ;.: ne
3b60: 74 32 6f 2d 63 6f 64 65 30 0a 20 20 20 20 5c 47 t2o-code0. \G
3b70: 20 73 74 61 72 74 20 61 20 73 74 61 74 65 6c 65 start a statele
3b80: 73 73 20 63 6f 6d 6d 61 6e 64 0a 20 20 20 20 63 ss command. c
3b90: 6d 64 30 21 20 20 63 6d 64 6c 6f 63 6b 20 6c 6f md0! cmdlock lo
3ba0: 63 6b 0a 20 20 20 20 63 6d 64 72 65 73 65 74 20 ck. cmdreset
3bb0: 69 6e 69 74 2d 72 65 70 6c 79 20 61 6c 73 6f 20 init-reply also
3bc0: 6e 65 74 32 6f 2d 62 61 73 65 20 3b 0a 63 6f 6d net2o-base ;.com
3bd0: 70 73 65 6d 3a 20 5b 27 5d 20 6e 65 74 32 6f 2d psem: ['] net2o-
3be0: 63 6f 64 65 30 20 63 6f 6d 70 69 6c 65 2c 20 61 code0 compile, a
3bf0: 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 20 3b lso net2o-base ;
3c00: 0a 0a 3a 20 70 75 6e 63 68 2d 6f 75 74 20 28 20 ..: punch-out (
3c10: 2d 2d 20 29 0a 20 20 20 20 63 68 65 63 6b 2d 61 -- ). check-a
3c20: 64 64 72 31 20 30 3d 20 69 6e 64 2d 61 64 64 72 ddr1 0= ind-addr
3c30: 20 40 20 6f 72 20 49 46 20 20 32 64 72 6f 70 20 @ or IF 2drop
3c40: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
3c50: 6e 61 74 28 20 74 69 63 6b 73 20 2e 74 69 63 6b nat( ticks .tick
3c60: 73 20 2e 22 20 20 70 75 6e 63 68 2d 63 6d 64 3a s ." punch-cmd:
3c70: 20 22 20 32 64 75 70 20 2e 61 64 64 72 65 73 73 " 2dup .address
3c80: 20 63 72 20 29 0a 20 20 20 20 32 3e 72 20 6e 65 cr ). 2>r ne
3c90: 74 32 6f 2d 73 6f 63 6b 20 6f 75 74 62 75 66 20 t2o-sock outbuf
3ca0: 64 75 70 20 70 61 63 6b 65 74 2d 73 69 7a 65 20 dup packet-size
3cb0: 30 20 32 72 3e 20 73 65 6e 64 74 6f 20 64 72 6f 0 2r> sendto dro
3cc0: 70 20 3b 0a 0a 3a 20 3f 70 75 6e 63 68 2d 63 6d p ;..: ?punch-cm
3cd0: 64 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 6f 20 ds ( -- ). o
3ce0: 49 46 0a 09 70 75 6e 63 68 2d 61 64 64 72 73 20 IF..punch-addrs
3cf0: 40 20 49 46 0a 09 20 20 20 20 5b 3a 0a 09 20 20 @ IF.. [:..
3d00: 20 20 20 20 6f 75 74 62 75 66 20 64 65 73 74 69 outbuf desti
3d10: 6e 61 74 69 6f 6e 20 24 31 30 20 65 72 61 73 65 nation $10 erase
3d20: 20 5c 20 6f 6e 6c 79 20 64 69 72 65 63 74 20 70 \ only direct p
3d30: 61 63 6b 65 74 73 0a 09 20 20 20 20 20 20 70 75 ackets.. pu
3d40: 6e 63 68 2d 61 64 64 72 73 20 24 40 20 62 6f 75 nch-addrs $@ bou
3d50: 6e 64 73 20 3f 44 4f 0a 09 09 20 20 49 20 40 20 nds ?DO... I @
3d60: 5b 27 5d 20 70 75 6e 63 68 2d 6f 75 74 20 61 64 ['] punch-out ad
3d70: 64 72 3e 73 6f 63 6b 0a 09 20 20 20 20 20 20 63 dr>sock.. c
3d80: 65 6c 6c 20 2b 4c 4f 4f 50 20 20 3b 5d 20 70 75 ell +LOOP ;] pu
3d90: 6e 63 68 2d 77 72 61 70 0a 09 54 48 45 4e 0a 20 nch-wrap..THEN.
3da0: 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 6e THEN ;..: sen
3db0: 64 2d 63 6d 64 20 28 20 61 64 64 72 20 75 20 64 d-cmd ( addr u d
3dc0: 65 73 74 20 2d 2d 20 73 69 7a 65 20 29 20 6e 36 est -- size ) n6
3dd0: 34 2d 73 77 61 70 20 7b 20 62 75 66 23 20 7d 0a 4-swap { buf# }.
3de0: 20 20 20 20 2b 73 65 6e 64 2d 63 6d 64 20 64 65 +send-cmd de
3df0: 73 74 2d 61 64 64 72 20 36 34 40 20 36 34 3e 72 st-addr 64@ 64>r
3e00: 20 73 65 74 2d 64 65 73 74 0a 20 20 20 20 63 6d set-dest. cm
3e10: 64 28 20 3c 69 6e 66 6f 3e 20 2e 22 20 73 65 6e d( <info> ." sen
3e20: 64 3a 20 22 20 6f 75 74 66 6c 61 67 20 2e 64 65 d: " outflag .de
3e30: 73 74 2d 61 64 64 72 20 64 75 70 20 62 75 66 23 st-addr dup buf#
3e40: 20 6e 65 74 32 6f 3a 73 65 65 20 3c 64 65 66 61 net2o:see <defa
3e50: 75 6c 74 3e 20 63 72 20 29 0a 20 20 20 20 6d 61 ult> cr ). ma
3e60: 78 2d 73 69 7a 65 5e 32 20 31 2b 20 30 20 44 4f x-size^2 1+ 0 DO
3e70: 0a 09 62 75 66 23 20 6d 69 6e 2d 73 69 7a 65 20 ..buf# min-size
3e80: 49 20 6c 73 68 69 66 74 20 75 3c 3d 20 49 46 0a I lshift u<= IF.
3e90: 09 20 20 20 20 49 20 6f 75 74 66 6c 61 67 20 40 . I outflag @
3ea0: 20 73 74 61 74 65 6c 65 73 73 23 20 61 6e 64 20 stateless# and
3eb0: 49 46 0a 09 09 6f 20 49 46 20 20 73 65 6e 64 30 IF...o IF send0
3ec0: 2d 78 74 20 3f 70 75 6e 63 68 2d 63 6d 64 73 20 -xt ?punch-cmds
3ed0: 20 45 4c 53 45 20 20 73 65 6e 64 2d 63 58 20 20 ELSE send-cX
3ee0: 54 48 45 4e 0a 09 20 20 20 20 45 4c 53 45 0a 09 THEN.. ELSE..
3ef0: 09 73 65 6e 64 2d 72 65 70 6c 79 20 3e 72 20 6f .send-reply >r o
3f00: 76 65 72 20 62 75 66 23 20 72 40 20 32 21 20 72 ver buf# r@ 2! r
3f10: 3e 20 73 65 6e 64 2d 78 74 0a 09 20 20 20 20 54 > send-xt.. T
3f20: 48 45 4e 0a 09 20 20 20 20 6d 69 6e 2d 73 69 7a HEN.. min-siz
3f30: 65 20 49 20 6c 73 68 69 66 74 20 20 55 4e 4c 4f e I lshift UNLO
3f40: 4f 50 0a 09 20 20 20 20 36 34 72 3e 20 64 65 73 OP.. 64r> des
3f50: 74 2d 61 64 64 72 20 36 34 21 20 45 58 49 54 20 t-addr 64! EXIT
3f60: 20 54 48 45 4e 0a 20 20 20 20 4c 4f 4f 50 20 20 THEN. LOOP
3f70: 36 34 72 3e 20 64 65 73 74 2d 61 64 64 72 20 36 64r> dest-addr 6
3f80: 34 21 20 20 74 72 75 65 20 21 21 63 6f 6d 6d 61 4! true !!comma
3f90: 6e 64 73 21 21 20 3b 0a 0a 3a 20 63 6d 64 20 28 nds!! ;..: cmd (
3fa0: 20 2d 2d 20 29 20 20 63 6d 64 62 75 66 23 20 40 -- ) cmdbuf# @
3fb0: 20 31 20 75 3c 3d 20 3f 45 58 49 54 20 5c 20 64 1 u<= ?EXIT \ d
3fc0: 6f 6e 27 74 20 73 65 6e 64 20 69 66 20 63 6d 64 on't send if cmd
3fd0: 62 75 66 20 69 73 20 65 6d 70 74 79 0a 20 20 20 buf is empty.
3fe0: 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 3e 6f 20 6f connection >o o
3ff0: 75 74 66 6c 61 67 20 40 20 3e 72 20 63 6d 64 62 utflag @ >r cmdb
4000: 75 66 24 20 63 6d 64 64 65 73 74 0a 20 20 20 20 uf$ cmddest.
4010: 61 76 61 6c 61 6e 63 68 65 28 20 2e 22 20 73 65 avalanche( ." se
4020: 6e 64 20 63 6d 64 3a 20 22 20 66 74 69 6d 65 20 nd cmd: " ftime
4030: 31 30 30 30 65 20 66 6d 6f 64 20 28 2e 74 69 6d 1000e fmod (.tim
4040: 65 29 20 36 34 64 75 70 20 78 36 34 2e 20 36 34 e) 64dup x64. 64
4050: 3e 72 20 64 75 70 20 68 65 78 2e 20 36 34 72 3e >r dup hex. 64r>
4060: 20 63 72 20 29 0a 20 20 20 20 6d 73 67 28 20 2e cr ). msg( .
4070: 22 20 73 65 6e 64 20 63 6d 64 20 74 6f 3a 20 22 " send cmd to: "
4080: 20 36 34 64 75 70 20 78 36 34 2e 20 66 6f 72 74 64dup x64. fort
4090: 68 3a 63 72 20 29 20 73 65 6e 64 2d 63 6d 64 0a h:cr ) send-cmd.
40a0: 20 20 20 20 72 3e 20 73 74 61 74 65 6c 65 73 73 r> stateless
40b0: 23 20 61 6e 64 20 30 3d 20 49 46 20 20 63 6f 64 # and 0= IF cod
40c0: 65 2d 75 70 64 61 74 65 20 20 45 4c 53 45 20 20 e-update ELSE
40d0: 64 72 6f 70 20 20 54 48 45 4e 20 6f 3e 20 3b 0a drop THEN o> ;.
40e0: 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d 62 61 73 65 .also net2o-base
40f0: 0a 0a 3a 20 63 6d 64 2d 73 65 6e 64 3f 20 28 20 ..: cmd-send? (
4100: 2d 2d 20 29 0a 20 20 20 20 63 6d 64 62 75 66 23 -- ). cmdbuf#
4110: 20 40 20 31 20 75 3e 20 49 46 20 20 65 78 70 65 @ 1 u> IF expe
4120: 63 74 2d 72 65 70 6c 79 3f 20 63 6d 64 20 20 54 ct-reply? cmd T
4130: 48 45 4e 20 3b 0a 0a 70 72 65 76 69 6f 75 73 0a HEN ;..previous.
4140: 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 6f 6b 3f 20 .in net2o : ok?
4150: 28 20 2d 2d 20 29 20 20 6f 3f 0a 20 20 20 20 74 ( -- ) o?. t
4160: 61 67 2d 61 64 64 72 20 3e 72 20 63 6d 64 62 75 ag-addr >r cmdbu
4170: 66 24 20 72 40 20 32 21 0a 20 20 20 20 74 61 67 f$ r@ 2!. tag
4180: 28 20 2e 22 20 74 61 67 3a 20 22 20 74 61 67 2d ( ." tag: " tag-
4190: 61 64 64 72 20 64 75 70 20 68 65 78 2e 20 32 40 addr dup hex. 2@
41a0: 20 73 77 61 70 20 68 65 78 2e 20 68 65 78 2e 20 swap hex. hex.
41b0: 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 63 forth:cr ). c
41c0: 6f 64 65 2d 76 64 65 73 74 20 72 40 20 72 65 70 ode-vdest r@ rep
41d0: 6c 79 2d 64 65 73 74 20 36 34 21 0a 20 20 20 20 ly-dest 64!.
41e0: 72 3e 20 63 6f 64 65 2d 72 65 70 6c 79 20 64 75 r> code-reply du
41f0: 70 20 6f 66 66 20 20 74 6f 20 72 65 70 6c 79 2d p off to reply-
4200: 74 61 67 20 3b 0a 69 6e 20 6e 65 74 32 6f 20 3a tag ;.in net2o :
4210: 20 6f 6b 20 28 20 74 61 67 20 2d 2d 20 29 20 5c ok ( tag -- ) \
4220: 20 2e 22 20 6f 6b 22 20 66 6f 72 74 68 3a 63 72 ." ok" forth:cr
4230: 0a 5c 20 20 20 20 74 69 6d 65 6f 75 74 28 20 2e .\ timeout( .
4240: 22 20 6f 6b 3a 20 22 20 64 75 70 20 68 65 78 2e " ok: " dup hex.
4250: 20 66 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 forth:cr ).
4260: 6f 20 30 3d 20 49 46 20 20 64 72 6f 70 20 45 58 o 0= IF drop EX
4270: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 72 65 71 IT THEN. req
4280: 75 65 73 74 28 20 2e 22 20 72 65 71 75 65 73 74 uest( ." request
4290: 20 61 63 6b 65 64 3a 20 22 20 64 75 70 20 2e 20 acked: " dup .
42a0: 63 72 20 29 0a 20 20 20 20 72 65 73 65 6e 64 30 cr ). resend0
42b0: 20 24 6f 66 66 0a 20 20 20 20 6e 61 74 28 20 2e $off. nat( .
42c0: 22 20 6f 6b 20 66 72 6f 6d 3a 20 22 20 72 65 74 " ok from: " ret
42d0: 2d 61 64 64 72 20 2e 61 64 64 72 2d 70 61 74 68 -addr .addr-path
42e0: 20 73 70 61 63 65 20 64 75 70 20 2e 0a 20 20 20 space dup ..
42f0: 20 64 75 70 20 72 65 70 6c 79 5b 5d 20 32 40 20 dup reply[] 2@
4300: 64 30 3d 20 49 46 20 2e 22 20 61 63 6b 65 64 22 d0= IF ." acked"
4310: 20 20 54 48 45 4e 20 63 72 20 29 0a 20 20 20 20 THEN cr ).
4320: 23 30 2e 20 32 20 70 69 63 6b 20 72 65 70 6c 79 #0. 2 pick reply
4330: 5b 5d 20 64 75 70 20 3e 72 20 32 21 0a 20 20 20 [] dup >r 2!.
4340: 20 74 69 63 6b 73 20 72 40 20 72 65 70 6c 79 2d ticks r@ reply-
4350: 74 69 6d 65 20 36 34 40 20 36 34 2d 20 61 63 6b time 64@ 64- ack
4360: 40 20 3e 6f 0a 20 20 20 20 72 74 64 28 20 2e 22 @ >o. rtd( ."
4370: 20 72 74 64 65 6c 61 79 20 6f 6b 3a 20 22 20 36 rtdelay ok: " 6
4380: 34 64 75 70 20 36 34 3e 66 20 2e 6e 73 20 63 72 4dup 64>f .ns cr
4390: 20 29 0a 20 20 20 20 30 20 74 69 6d 65 6f 75 74 ). 0 timeout
43a0: 73 20 21 40 20 72 74 64 28 20 64 75 70 20 2e 20 s !@ rtd( dup .
43b0: 29 20 31 20 75 3e 20 49 46 20 20 72 74 64 65 6c ) 1 u> IF rtdel
43c0: 61 79 20 36 34 40 20 36 34 75 6d 61 78 0a 09 72 ay 64@ 64umax..r
43d0: 74 64 28 20 2e 22 20 72 74 64 65 6c 61 79 20 74 td( ." rtdelay t
43e0: 2d 6f 3a 20 22 20 36 34 64 75 70 20 36 34 3e 66 -o: " 64dup 64>f
43f0: 20 2e 6e 73 20 63 72 20 29 20 20 54 48 45 4e 0a .ns cr ) THEN.
4400: 20 20 20 20 72 74 64 65 6c 61 79 20 36 34 21 20 rtdelay 64!
4410: 20 6f 3e 0a 20 20 20 20 2d 31 20 72 65 71 63 6f o>. -1 reqco
4420: 75 6e 74 20 2b 21 40 20 31 20 3d 20 49 46 0a 09 unt +!@ 1 = IF..
4430: 77 61 69 74 2d 74 61 73 6b 20 40 20 3f 64 75 70 wait-task @ ?dup
4440: 2d 49 46 20 20 77 61 6b 65 23 20 27 73 20 40 20 -IF wake# 's @
4450: 31 2b 20 65 6c 69 74 2c 20 3a 3e 77 61 6b 65 20 1+ elit, :>wake
4460: 20 54 48 45 4e 0a 20 20 20 20 54 48 45 4e 0a 20 THEN. THEN.
4470: 20 20 20 30 20 72 3e 20 61 64 64 72 20 72 65 70 0 r> addr rep
4480: 6c 79 2d 78 74 20 21 40 20 64 75 70 20 49 46 20 ly-xt !@ dup IF
4490: 20 65 78 65 63 75 74 65 20 20 45 4c 53 45 20 20 execute ELSE
44a0: 32 64 72 6f 70 20 20 54 48 45 4e 20 3b 20 5c 20 2drop THEN ; \
44b0: 63 6c 65 61 72 20 72 65 71 75 65 73 74 0a 3a 20 clear request.:
44c0: 6e 65 74 32 6f 3a 65 78 70 65 63 74 2d 72 65 70 net2o:expect-rep
44d0: 6c 79 20 28 20 2d 2d 20 29 0a 20 20 20 20 6f 20 ly ( -- ). o
44e0: 30 3d 20 49 46 20 20 6d 73 67 28 20 2e 22 20 66 0= IF msg( ." f
44f0: 61 69 6c 20 65 78 70 65 63 74 20 72 65 70 6c 79 ail expect reply
4500: 22 20 66 6f 72 74 68 3a 63 72 20 29 20 20 45 58 " forth:cr ) EX
4510: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 74 69 6d IT THEN. tim
4520: 65 6f 75 74 28 20 63 6d 64 28 20 2e 22 20 65 78 eout( cmd( ." ex
4530: 70 65 63 74 3a 20 22 20 63 6d 64 62 75 66 24 20 pect: " cmdbuf$
4540: 6e 65 74 32 6f 3a 73 65 65 20 29 20 29 0a 20 20 net2o:see ) ).
4550: 20 20 6d 73 67 28 20 2e 22 20 45 78 70 65 63 74 msg( ." Expect
4560: 20 72 65 70 6c 79 22 20 6f 75 74 66 6c 61 67 20 reply" outflag
4570: 40 20 73 74 61 74 65 6c 65 73 73 23 20 61 6e 64 @ stateless# and
4580: 20 49 46 20 2e 22 20 20 73 74 61 74 65 6c 65 73 IF ." stateles
4590: 73 22 20 54 48 45 4e 20 66 6f 72 74 68 3a 63 72 s" THEN forth:cr
45a0: 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 74 69 6f ). connectio
45b0: 6e 20 3e 6f 20 63 6f 64 65 2d 72 65 70 6c 79 20 n >o code-reply
45c0: 3e 72 0a 20 20 20 20 72 40 20 72 65 70 6c 79 2d >r. r@ reply-
45d0: 74 61 67 20 3f 64 75 70 2d 49 46 20 20 6f 66 66 tag ?dup-IF off
45e0: 20 20 30 20 72 40 20 74 6f 20 72 65 70 6c 79 2d 0 r@ to reply-
45f0: 74 61 67 20 20 74 48 45 4e 0a 20 20 20 20 63 6f tag tHEN. co
4600: 64 65 2d 76 64 65 73 74 20 20 20 20 20 72 40 20 de-vdest r@
4610: 72 65 70 6c 79 2d 64 65 73 74 20 36 34 21 0a 20 reply-dest 64!.
4620: 20 20 20 74 69 63 6b 73 20 20 20 20 20 20 20 20 ticks
4630: 20 20 72 40 20 72 65 70 6c 79 2d 74 69 6d 65 20 r@ reply-time
4640: 36 34 21 0a 20 20 20 20 63 6d 64 2d 72 65 70 6c 64!. cmd-repl
4650: 79 2d 78 74 20 40 20 72 3e 20 69 73 20 72 65 70 y-xt @ r> is rep
4660: 6c 79 2d 78 74 0a 20 20 20 20 31 20 72 65 71 63 ly-xt. 1 reqc
4670: 6f 75 6e 74 20 2b 21 40 20 64 72 6f 70 20 6f 3e ount +!@ drop o>
4680: 20 3b 0a 0a 3a 20 74 61 6b 65 2d 72 65 74 20 28 ;..: take-ret (
4690: 20 2d 2d 20 29 0a 5c 20 20 20 20 6e 61 74 28 20 -- ).\ nat(
46a0: 2e 22 20 74 61 6b 65 20 72 65 74 3a 20 22 20 72 ." take ret: " r
46b0: 65 74 75 72 6e 2d 61 64 64 72 20 2e 61 64 64 72 eturn-addr .addr
46c0: 2d 70 61 74 68 20 73 70 61 63 65 20 2e 22 20 20 -path space ."
46d0: 2d 3e 20 22 20 72 65 74 75 72 6e 2d 61 64 64 72 -> " return-addr
46e0: 65 73 73 20 2e 61 64 64 72 2d 70 61 74 68 20 66 ess .addr-path f
46f0: 6f 72 74 68 3a 63 72 20 29 0a 20 20 20 20 72 65 orth:cr ). re
4700: 74 75 72 6e 2d 61 64 64 72 20 72 65 74 75 72 6e turn-addr return
4710: 2d 61 64 64 72 65 73 73 20 24 31 30 20 6d 6f 76 -address $10 mov
4720: 65 20 3b 0a 0a 3a 20 74 61 67 2d 61 64 64 72 3f e ;..: tag-addr?
4730: 20 28 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 ( -- flag ).
4740: 20 74 61 67 2d 61 64 64 72 20 64 75 70 20 3e 72 tag-addr dup >r
4750: 20 32 40 0a 20 20 20 20 3f 64 75 70 2d 49 46 0a 2@. ?dup-IF.
4760: 09 63 6d 64 28 20 64 65 73 74 2d 61 64 64 72 20 .cmd( dest-addr
4770: 36 34 40 20 78 36 34 2e 20 2e 22 20 72 65 73 65 64@ x64. ." rese
4780: 6e 64 20 63 61 6e 6e 65 64 20 63 6f 64 65 20 72 nd canned code r
4790: 65 70 6c 79 20 22 20 72 40 20 68 65 78 2e 20 66 eply " r@ hex. f
47a0: 6f 72 74 68 3a 63 72 20 29 0a 09 72 65 73 65 6e orth:cr )..resen
47b0: 64 28 20 2e 22 20 72 65 73 65 6e 64 20 63 61 6e d( ." resend can
47c0: 6e 65 64 20 63 6f 64 65 20 72 65 70 6c 79 20 22 ned code reply "
47d0: 20 72 40 20 68 65 78 2e 20 66 6f 72 74 68 3a 63 r@ hex. forth:c
47e0: 72 20 29 0a 09 74 61 6b 65 2d 72 65 74 0a 09 72 r )..take-ret..r
47f0: 3e 20 72 65 70 6c 79 2d 64 65 73 74 20 36 34 40 > reply-dest 64@
4800: 20 73 65 6e 64 2d 63 6d 64 20 64 72 6f 70 20 74 send-cmd drop t
4810: 72 75 65 0a 09 31 20 70 61 63 6b 65 74 73 32 20 rue..1 packets2
4820: 2b 21 0a 20 20 20 20 45 4c 53 45 20 20 64 65 73 +!. ELSE des
4830: 74 2d 61 64 64 72 20 36 34 40 20 5b 20 63 65 6c t-addr 64@ [ cel
4840: 6c 20 34 20 3d 20 5d 20 5b 49 46 5d 20 30 3c 3e l 4 = ] [IF] 0<>
4850: 20 2d 20 5b 54 48 45 4e 5d 20 64 75 70 20 30 20 - [THEN] dup 0
4860: 72 3e 20 32 21 20 75 3e 3d 20 20 54 48 45 4e 20 r> 2! u>= THEN
4870: 3b 0a 0a 3a 20 63 6d 64 2d 65 78 65 63 20 28 20 ;..: cmd-exec (
4880: 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 addr u -- ).
4890: 6f 20 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a o to connection.
48a0: 20 20 20 20 6f 20 49 46 0a 09 6d 61 78 64 61 74 o IF..maxdat
48b0: 61 20 63 6f 64 65 2b 20 20 63 6d 64 21 0a 09 74 a code+ cmd!..t
48c0: 61 67 2d 61 64 64 72 3f 20 49 46 0a 09 20 20 20 ag-addr? IF..
48d0: 20 32 64 72 6f 70 20 20 61 63 6b 40 20 2e 3e 66 2drop ack@ .>f
48e0: 6c 79 62 75 72 73 74 20 20 31 20 70 61 63 6b 65 lyburst 1 packe
48f0: 74 72 32 20 2b 21 20 20 45 58 49 54 20 20 54 48 tr2 +! EXIT TH
4900: 45 4e 0a 09 74 61 6b 65 2d 72 65 74 0a 20 20 20 EN..take-ret.
4910: 20 45 4c 53 45 0a 09 63 6d 64 30 21 0a 20 20 20 ELSE..cmd0!.
4920: 20 54 48 45 4e 0a 20 20 20 20 73 74 72 69 6e 67 THEN. string
4930: 2d 73 74 61 63 6b 20 24 66 72 65 65 20 20 6f 62 -stack $free ob
4940: 6a 65 63 74 2d 73 74 61 63 6b 20 24 66 72 65 65 ject-stack $free
4950: 20 20 6e 65 73 74 2d 73 74 61 63 6b 20 24 66 72 nest-stack $fr
4960: 65 65 0a 20 20 20 20 5b 3a 20 6f 75 74 66 6c 61 ee. [: outfla
4970: 67 20 40 20 3e 72 20 63 6d 64 72 65 73 65 74 20 g @ >r cmdreset
4980: 69 6e 69 74 2d 72 65 70 6c 79 20 64 6f 2d 63 6d init-reply do-cm
4990: 64 2d 6c 6f 6f 70 0a 20 20 20 20 20 20 72 3e 20 d-loop. r>
49a0: 6f 75 74 66 6c 61 67 20 21 20 63 6d 64 2d 73 65 outflag ! cmd-se
49b0: 6e 64 3f 20 3b 5d 20 63 6d 64 6c 6f 63 6b 20 63 nd? ;] cmdlock c
49c0: 2d 73 65 63 74 69 6f 6e 20 3b 0a 0a 5c 20 6e 65 -section ;..\ ne
49d0: 73 74 65 64 20 63 6f 6d 6d 61 6e 64 73 0a 0a 55 sted commands..U
49e0: 73 65 72 20 6e 65 73 74 73 74 61 72 74 23 0a 55 ser neststart#.U
49f0: 73 65 72 20 6c 61 73 74 2d 73 69 67 6e 65 64 20 ser last-signed
4a00: 63 65 6c 6c 20 75 61 6c 6c 6f 74 20 64 72 6f 70 cell uallot drop
4a10: 0a 3a 20 2b 6c 61 73 74 2d 73 69 67 6e 65 64 20 .: +last-signed
4a20: 28 20 61 64 64 72 20 2d 2d 20 29 20 64 72 6f 70 ( addr -- ) drop
4a30: 20 6c 61 73 74 2d 73 69 67 6e 65 64 20 63 65 6c last-signed cel
4a40: 6c 2b 20 2b 21 20 3b 0a 0a 32 20 43 6f 6e 73 74 l+ +! ;..2 Const
4a50: 61 6e 74 20 66 77 64 23 20 5c 20 6d 61 78 69 6d ant fwd# \ maxim
4a60: 75 6d 20 31 34 20 62 69 74 73 20 3d 20 31 36 6b um 14 bits = 16k
4a70: 42 0a 0a 3a 20 6e 65 73 74 24 20 28 20 2d 2d 20 B..: nest$ ( --
4a80: 61 64 64 72 20 75 20 29 20 20 63 6d 64 62 75 66 addr u ) cmdbuf
4a90: 24 20 6e 65 73 74 73 74 61 72 74 23 20 40 20 73 $ neststart# @ s
4aa0: 61 66 65 2f 73 74 72 69 6e 67 20 3b 0a 0a 3a 20 afe/string ;..:
4ab0: 63 6d 64 2d 72 65 73 6f 6c 76 65 3e 20 28 20 2d cmd-resolve> ( -
4ac0: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 6e - addr u ). n
4ad0: 65 73 74 24 20 6f 76 65 72 20 3e 72 20 64 75 70 est$ over >r dup
4ae0: 20 6e 3e 36 34 20 63 6d 64 74 6d 70 24 20 64 75 n>64 cmdtmp$ du
4af0: 70 20 66 77 64 23 20 75 3e 20 21 21 73 74 72 69 p fwd# u> !!stri
4b00: 6e 67 66 69 74 21 21 0a 20 20 20 20 72 3e 20 6f ngfit!!. r> o
4b10: 76 65 72 20 2d 20 73 77 61 70 20 6d 6f 76 65 0a ver - swap move.
4b20: 20 20 20 20 6e 65 73 74 2d 73 74 61 63 6b 20 73 nest-stack s
4b30: 74 61 63 6b 3e 20 6e 65 73 74 73 74 61 72 74 23 tack> neststart#
4b40: 20 21 20 3b 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f ! ;..also net2o
4b50: 2d 62 61 73 65 0a 0a 3a 20 2b 7a 65 72 6f 31 36 -base..: +zero16
4b60: 20 28 20 2d 2d 20 29 20 22 5c 30 5c 30 5c 30 5c ( -- ) "\0\0\0\
4b70: 30 5c 30 5c 30 5c 30 5c 30 5c 30 5c 30 5c 30 5c 0\0\0\0\0\0\0\0\
4b80: 30 5c 30 5c 30 5c 30 5c 30 22 20 2b 63 6d 64 62 0\0\0\0\0" +cmdb
4b90: 75 66 20 3b 0a 3a 20 73 69 67 6e 5b 20 28 20 2d uf ;.: sign[ ( -
4ba0: 2d 20 29 20 6e 65 73 74 73 74 61 72 74 23 20 40 - ) neststart# @
4bb0: 20 6e 65 73 74 2d 73 74 61 63 6b 20 3e 73 74 61 nest-stack >sta
4bc0: 63 6b 0a 20 20 20 20 73 74 72 69 6e 67 20 22 5c ck. string "\
4bd0: 78 38 30 5c 78 30 30 22 20 2b 63 6d 64 62 75 66 x80\x00" +cmdbuf
4be0: 20 63 6d 64 62 75 66 24 20 6e 69 70 20 6e 65 73 cmdbuf$ nip nes
4bf0: 74 73 74 61 72 74 23 20 21 20 3b 0a 3a 20 6e 65 tstart# ! ;.: ne
4c00: 73 74 5b 20 28 20 2d 2d 20 29 20 73 69 67 6e 5b st[ ( -- ) sign[
4c10: 20 2b 7a 65 72 6f 31 36 20 3b 20 5c 20 61 64 64 +zero16 ; \ add
4c20: 20 73 70 61 63 65 20 66 6f 72 20 49 56 0a 3a 20 space for IV.:
4c30: 27 5d 6e 65 73 74 73 69 67 20 28 20 78 74 20 2d ']nestsig ( xt -
4c40: 2d 20 29 0a 20 20 20 20 24 74 6d 70 20 2b 63 6d - ). $tmp +cm
4c50: 64 62 75 66 0a 20 20 20 20 63 6d 64 2d 72 65 73 dbuf. cmd-res
4c60: 6f 6c 76 65 3e 20 20 3e 72 20 63 6d 64 62 75 66 olve> >r cmdbuf
4c70: 24 20 64 72 6f 70 20 2d 20 72 3e 20 6c 61 73 74 $ drop - r> last
4c80: 2d 73 69 67 6e 65 64 20 32 21 20 20 6e 65 73 74 -signed 2! nest
4c90: 73 69 67 20 3b 0a 3a 20 27 5d 73 69 67 6e 20 28 sig ;.: ']sign (
4ca0: 20 78 74 20 2d 2d 20 29 0a 20 20 20 20 63 3a 30 xt -- ). c:0
4cb0: 6b 65 79 20 6e 65 73 74 24 20 63 3a 68 61 73 68 key nest$ c:hash
4cc0: 20 27 5d 6e 65 73 74 73 69 67 20 3b 0a 3a 20 5d ']nestsig ;.: ]
4cd0: 73 69 67 6e 20 28 20 2d 2d 20 29 20 5b 27 5d 20 sign ( -- ) [']
4ce0: 2e 73 69 67 20 27 5d 73 69 67 6e 20 3b 0a 3a 20 .sig ']sign ;.:
4cf0: 5d 70 6b 73 69 67 6e 20 28 20 2d 2d 20 29 20 5b ]pksign ( -- ) [
4d00: 3a 20 2e 70 6b 20 2e 73 69 67 20 3b 5d 20 27 5d : .pk .sig ;] ']
4d10: 73 69 67 6e 20 3b 0a 0a 70 72 65 76 69 6f 75 73 sign ;..previous
4d20: 0a 0a 3a 20 63 6d 64 3e 20 28 20 2d 2d 20 61 64 ..: cmd> ( -- ad
4d30: 64 72 20 75 20 29 0a 20 20 20 20 2b 7a 65 72 6f dr u ). +zero
4d40: 31 36 20 5c 20 61 64 64 20 73 70 61 63 65 20 66 16 \ add space f
4d50: 6f 72 20 63 68 65 63 6b 73 75 6d 0a 20 20 20 20 or checksum.
4d60: 63 6d 64 2d 72 65 73 6f 6c 76 65 3e 20 3b 0a 0a cmd-resolve> ;..
4d70: 3a 20 63 6d 64 3e 6e 65 73 74 20 28 20 2d 2d 20 : cmd>nest ( --
4d80: 61 64 64 72 20 75 20 29 20 63 6d 64 3e 20 32 64 addr u ) cmd> 2d
4d90: 75 70 20 6d 79 6b 65 79 2d 65 6e 63 72 79 70 74 up mykey-encrypt
4da0: 24 20 3b 0a 3a 20 63 6d 64 3e 74 6d 70 6e 65 73 $ ;.: cmd>tmpnes
4db0: 74 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a t ( -- addr u ).
4dc0: 20 20 20 20 63 6d 64 3e 20 32 64 75 70 20 74 6d cmd> 2dup tm
4dd0: 70 6b 65 79 40 20 6b 65 79 7c 0a 20 20 20 20 6b pkey@ key|. k
4de0: 65 79 28 20 2e 22 20 74 6d 70 6e 65 73 74 20 6b ey( ." tmpnest k
4df0: 65 79 3a 20 22 20 32 64 75 70 20 38 35 74 79 70 ey: " 2dup 85typ
4e00: 65 20 66 6f 72 74 68 3a 63 72 20 29 20 65 6e 63 e forth:cr ) enc
4e10: 72 79 70 74 24 20 3b 0a 3a 20 63 6d 64 3e 65 6e rypt$ ;.: cmd>en
4e20: 63 6e 65 73 74 20 28 20 2d 2d 20 61 64 64 72 20 cnest ( -- addr
4e30: 75 20 29 0a 20 20 20 20 63 6d 64 3e 20 32 64 75 u ). cmd> 2du
4e40: 70 20 74 6d 70 6b 65 79 40 0a 20 20 20 20 6b 65 p tmpkey@. ke
4e50: 79 28 20 2e 22 20 74 6d 70 6e 65 73 74 20 6b 65 y( ." tmpnest ke
4e60: 79 3a 20 22 20 32 64 75 70 20 38 35 74 79 70 65 y: " 2dup 85type
4e70: 20 66 6f 72 74 68 3a 63 72 20 29 20 65 6e 63 72 forth:cr ) encr
4e80: 79 70 74 24 20 3b 0a 0a 3a 20 63 6d 64 6e 65 73 ypt$ ;..: cmdnes
4e90: 74 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 t ( addr u -- )
4ea0: 20 6d 79 6b 65 79 2d 64 65 63 72 79 70 74 24 0a mykey-decrypt$.
4eb0: 20 20 20 20 49 46 20 20 6f 77 6e 2d 63 72 79 70 IF own-cryp
4ec0: 74 2d 76 61 6c 20 64 6f 2d 6e 65 73 74 20 20 45 t-val do-nest E
4ed0: 4c 53 45 0a 09 3c 65 72 72 3e 20 2e 22 20 63 6d LSE..<err> ." cm
4ee0: 64 6e 65 73 74 3a 20 6e 6f 20 6f 77 6e 63 72 79 dnest: no owncry
4ef0: 70 74 2c 20 75 6e 2d 63 6d 64 22 20 3c 64 65 66 pt, un-cmd" <def
4f00: 61 75 6c 74 3e 20 66 6f 72 74 68 3a 63 72 0a 09 ault> forth:cr..
4f10: 75 6e 2d 63 6d 64 20 20 54 48 45 4e 20 3b 0a 0a un-cmd THEN ;..
4f20: 3a 20 63 6d 64 74 6d 70 6e 65 73 74 20 28 20 61 : cmdtmpnest ( a
4f30: 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 20 24 ddr u -- ). $
4f40: 3e 61 6c 69 67 6e 20 74 6d 70 6b 65 79 40 20 6b >align tmpkey@ k
4f50: 65 79 7c 20 64 75 70 20 49 46 0a 09 6b 65 79 28 ey| dup IF..key(
4f60: 20 2e 22 20 74 6d 70 6e 65 73 74 20 6b 65 79 3a ." tmpnest key:
4f70: 20 22 20 32 64 75 70 20 38 35 74 79 70 65 20 66 " 2dup 85type f
4f80: 6f 72 74 68 3a 63 72 20 29 20 64 65 63 72 79 70 orth:cr ) decryp
4f90: 74 24 0a 09 49 46 20 20 20 20 74 6d 70 2d 63 72 t$..IF tmp-cr
4fa0: 79 70 74 2d 76 61 6c 20 64 6f 2d 6e 65 73 74 20 ypt-val do-nest
4fb0: 20 45 58 49 54 20 20 54 48 45 4e 0a 09 63 6d 64 EXIT THEN..cmd
4fc0: 28 20 3c 65 72 72 3e 20 2e 22 20 74 6d 70 6e 65 ( <err> ." tmpne
4fd0: 73 74 20 66 61 69 6c 65 64 2c 20 75 6e 63 6d 64 st failed, uncmd
4fe0: 22 20 3c 64 65 66 61 75 6c 74 3e 20 66 6f 72 74 " <default> fort
4ff0: 68 3a 63 72 0a 09 6e 65 74 32 6f 3a 73 65 65 2d h:cr..net2o:see-
5000: 6d 65 20 29 0a 20 20 20 20 45 4c 53 45 20 20 32 me ). ELSE 2
5010: 64 72 6f 70 20 20 54 48 45 4e 20 20 32 64 72 6f drop THEN 2dro
5020: 70 20 75 6e 2d 63 6d 64 20 3b 0a 3a 20 63 6d 64 p un-cmd ;.: cmd
5030: 65 6e 63 6e 65 73 74 20 28 20 61 64 64 72 20 75 encnest ( addr u
5040: 20 2d 2d 20 29 0a 20 20 20 20 24 3e 61 6c 69 67 -- ). $>alig
5050: 6e 20 74 6d 70 6b 65 79 40 20 64 75 70 20 49 46 n tmpkey@ dup IF
5060: 0a 09 6b 65 79 28 20 2e 22 20 65 6e 63 6e 65 73 ..key( ." encnes
5070: 74 20 6b 65 79 3a 20 22 20 32 64 75 70 20 38 35 t key: " 2dup 85
5080: 74 79 70 65 20 66 6f 72 74 68 3a 63 72 20 29 20 type forth:cr )
5090: 64 65 63 72 79 70 74 24 0a 09 49 46 20 20 20 20 decrypt$..IF
50a0: 65 6e 63 2d 63 72 79 70 74 2d 76 61 6c 20 64 6f enc-crypt-val do
50b0: 2d 6e 65 73 74 20 20 5b 20 71 72 2d 74 6d 70 2d -nest [ qr-tmp-
50c0: 76 61 6c 20 69 6e 76 65 72 74 20 5d 4c 20 76 61 val invert ]L va
50d0: 6c 69 64 61 74 65 64 20 61 6e 64 21 0a 09 45 4c lidated and!..EL
50e0: 53 45 20 3c 65 72 72 3e 20 2e 22 20 65 6e 63 6e SE <err> ." encn
50f0: 65 73 74 20 66 61 69 6c 65 64 2c 20 75 6e 63 6d est failed, uncm
5100: 64 22 20 3c 64 65 66 61 75 6c 74 3e 20 66 6f 72 d" <default> for
5110: 74 68 3a 63 72 0a 09 20 20 20 20 32 64 72 6f 70 th:cr.. 2drop
5120: 20 75 6e 2d 63 6d 64 20 20 54 48 45 4e 0a 20 20 un-cmd THEN.
5130: 20 20 45 4c 53 45 20 20 3c 65 72 72 3e 20 2e 22 ELSE <err> ."
5140: 20 65 6e 63 6e 65 73 74 3a 20 6e 6f 20 74 6d 70 encnest: no tmp
5150: 6b 65 79 22 20 3c 64 65 66 61 75 6c 74 3e 20 66 key" <default> f
5160: 6f 72 74 68 3a 63 72 0a 09 32 64 72 6f 70 20 32 orth:cr..2drop 2
5170: 64 72 6f 70 20 75 6e 2d 63 6d 64 20 20 54 48 45 drop un-cmd THE
5180: 4e 20 3b 0a 0a 5c 20 6e 65 74 32 6f 20 61 73 73 N ;..\ net2o ass
5190: 65 6d 62 6c 65 72 20 73 74 75 66 66 0a 0a 77 6f embler stuff..wo
51a0: 72 64 6c 69 73 74 20 63 6f 6e 73 74 61 6e 74 20 rdlist constant
51b0: 73 75 66 66 69 78 2d 6c 69 73 74 0a 67 65 74 2d suffix-list.get-
51c0: 63 75 72 72 65 6e 74 20 73 75 66 66 69 78 2d 6c current suffix-l
51d0: 69 73 74 20 73 65 74 2d 63 75 72 72 65 6e 74 0a ist set-current.
51e0: 27 20 76 61 75 6c 74 2d 74 61 62 6c 65 20 61 6c ' vault-table al
51f0: 69 61 73 20 76 32 6f 0a 27 20 6b 65 79 2d 65 6e ias v2o.' key-en
5200: 74 72 79 2d 74 61 62 6c 65 20 61 6c 69 61 73 20 try-table alias
5210: 6e 32 6f 0a 73 65 74 2d 63 75 72 72 65 6e 74 0a n2o.set-current.
5220: 0a 3a 20 34 63 63 3e 74 61 62 6c 65 20 28 20 61 .: 4cc>table ( a
5230: 64 64 72 20 75 20 2d 2d 20 29 20 5c 20 72 65 61 ddr u -- ) \ rea
5240: 6c 6c 79 20 69 73 20 6a 75 73 74 20 33 20 63 68 lly is just 3 ch
5250: 61 72 61 63 74 65 72 73 0a 20 20 20 20 73 75 66 aracters. suf
5260: 66 69 78 2d 6c 69 73 74 20 66 69 6e 64 2d 6e 61 fix-list find-na
5270: 6d 65 2d 69 6e 20 3f 64 75 70 2d 49 46 20 20 6e me-in ?dup-IF n
5280: 61 6d 65 3e 69 6e 74 20 65 78 65 63 75 74 65 20 ame>int execute
5290: 40 0a 20 20 20 20 45 4c 53 45 20 20 73 65 65 3a @. ELSE see:
52a0: 74 61 62 6c 65 20 40 20 20 54 48 45 4e 20 3b 0a table @ THEN ;.
52b0: 3a 20 73 75 66 66 69 78 3e 74 61 62 6c 65 20 28 : suffix>table (
52c0: 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 20 20 addr u -- ).
52d0: 20 32 64 75 70 20 27 2e 27 20 2d 73 63 61 6e 20 2dup '.' -scan
52e0: 6e 69 70 20 2f 73 74 72 69 6e 67 20 34 63 63 3e nip /string 4cc>
52f0: 74 61 62 6c 65 20 3b 0a 0a 73 63 6f 70 65 7b 20 table ;..scope{
5300: 6e 65 74 32 6f 2d 62 61 73 65 0a 0a 3a 20 6d 61 net2o-base..: ma
5310: 78 74 69 6d 69 6e 67 20 28 20 2d 2d 20 6e 20 29 xtiming ( -- n )
5320: 20 20 6d 61 78 73 74 72 69 6e 67 20 74 69 6d 65 maxstring time
5330: 73 74 61 74 73 20 2d 20 64 75 70 20 74 69 6d 65 stats - dup time
5340: 73 74 61 74 73 20 6d 6f 64 20 2d 20 3b 0a 3a 20 stats mod - ;.:
5350: 73 74 72 69 6e 67 2c 20 28 20 61 64 64 72 20 75 string, ( addr u
5360: 20 2d 2d 20 29 20 20 64 75 70 20 6e 3e 36 34 20 -- ) dup n>64
5370: 63 6d 64 2c 20 2b 63 6d 64 62 75 66 20 3b 0a 3a cmd, +cmdbuf ;.:
5380: 20 24 2c 20 28 20 61 64 64 72 20 75 20 2d 2d 20 $, ( addr u --
5390: 29 20 20 73 74 72 69 6e 67 0a 20 20 20 20 64 75 ) string. du
53a0: 70 20 6d 61 78 73 74 72 69 6e 67 20 75 3e 20 49 p maxstring u> I
53b0: 46 20 20 7e 7e 20 74 72 75 65 20 21 21 73 74 72 F ~~ true !!str
53c0: 69 6e 67 66 69 74 21 21 20 20 54 48 45 4e 0a 20 ingfit!! THEN.
53d0: 20 20 20 5c 20 65 78 74 72 61 20 74 65 73 74 20 \ extra test
53e0: 74 6f 20 67 69 76 65 20 6d 65 61 6e 69 6e 67 66 to give meaningf
53f0: 75 6c 20 65 72 72 6f 72 20 6d 65 73 73 61 67 65 ul error message
5400: 73 0a 20 20 20 20 73 74 72 69 6e 67 2c 20 3b 0a s. string, ;.
5410: 3a 20 73 65 63 24 2c 20 28 20 61 64 64 72 20 75 : sec$, ( addr u
5420: 20 2d 2d 20 29 20 20 73 65 63 73 74 72 69 6e 67 -- ) secstring
5430: 20 73 74 72 69 6e 67 2c 20 3b 0a 3a 20 6c 69 74 string, ;.: lit
5440: 2c 20 28 20 36 34 6e 20 2d 2d 20 29 20 20 64 75 , ( 64n -- ) du
5450: 70 20 30 3c 20 49 46 20 20 2d 6c 69 74 20 36 34 p 0< IF -lit 64
5460: 69 6e 76 65 72 74 20 45 4c 53 45 20 6c 69 74 20 invert ELSE lit
5470: 54 48 45 4e 20 63 6d 64 2c 20 3b 0a 3a 20 6e 6c THEN cmd, ;.: nl
5480: 69 74 2c 20 28 20 6e 20 2d 2d 20 29 20 20 6e 3e it, ( n -- ) n>
5490: 36 34 20 6c 69 74 2c 20 3b 0a 3a 20 75 6c 69 74 64 lit, ;.: ulit
54a0: 2c 20 28 20 75 20 2d 2d 20 29 20 20 75 3e 36 34 , ( u -- ) u>64
54b0: 20 6c 69 74 2c 20 3b 0a 3a 20 34 63 63 2c 20 28 lit, ;.: 4cc, (
54c0: 20 61 64 64 72 20 75 20 2d 2d 20 29 20 32 64 75 addr u -- ) 2du
54d0: 70 20 2a 2d 77 69 64 74 68 20 33 20 3c 3e 20 21 p *-width 3 <> !
54e0: 21 34 63 63 21 21 20 64 72 6f 70 0a 20 20 20 20 !4cc!! drop.
54f0: 34 63 63 20 78 63 40 2b 20 6e 3e 36 34 20 63 6d 4cc xc@+ n>64 cm
5500: 64 2c 20 78 63 40 2b 20 6e 3e 36 34 20 63 6d 64 d, xc@+ n>64 cmd
5510: 2c 20 78 63 40 2b 20 6e 3e 36 34 20 63 6d 64 2c , xc@+ n>64 cmd,
5520: 20 64 72 6f 70 20 3b 0a 3a 20 66 6c 6f 61 74 2c drop ;.: float,
5530: 20 28 20 72 20 2d 2d 20 29 20 20 66 6c 69 74 20 ( r -- ) flit
5540: 63 6d 64 74 6d 70 20 70 66 21 2b 20 63 6d 64 74 cmdtmp pf!+ cmdt
5550: 6d 70 20 74 75 63 6b 20 2d 20 2b 63 6d 64 62 75 mp tuck - +cmdbu
5560: 66 20 3b 0a 3a 20 66 6c 61 67 2c 20 28 20 66 6c f ;.: flag, ( fl
5570: 61 67 20 2d 2d 20 29 20 49 46 20 74 72 75 20 45 ag -- ) IF tru E
5580: 4c 53 45 20 66 61 6c 73 20 54 48 45 4e 20 3b 0a LSE fals THEN ;.
5590: 3a 20 28 65 6e 64 2d 63 6f 64 65 29 20 28 20 2d : (end-code) ( -
55a0: 2d 20 29 20 65 78 70 65 63 74 2d 72 65 70 6c 79 - ) expect-reply
55b0: 3f 20 63 6d 64 20 20 63 6d 64 6c 6f 63 6b 20 75 ? cmd cmdlock u
55c0: 6e 6c 6f 63 6b 20 3b 0a 3a 20 65 6e 64 2d 63 6f nlock ;.: end-co
55d0: 64 65 20 28 20 2d 2d 20 29 20 28 65 6e 64 2d 63 de ( -- ) (end-c
55e0: 6f 64 65 29 20 70 72 65 76 69 6f 75 73 20 3b 0a ode) previous ;.
55f0: 63 6f 6d 70 73 65 6d 3a 20 5b 27 5d 20 65 6e 64 compsem: ['] end
5600: 2d 63 6f 64 65 20 63 6f 6d 70 69 6c 65 2c 20 70 -code compile, p
5610: 72 65 76 69 6f 75 73 20 3b 0a 3a 20 70 75 73 68 revious ;.: push
5620: 2d 63 6d 64 20 28 20 2d 2d 20 29 0a 20 20 20 20 -cmd ( -- ).
5630: 65 6e 64 2d 63 6d 64 20 63 6d 64 62 75 66 24 20 end-cmd cmdbuf$
5640: 70 75 73 68 2d 72 65 70 6c 79 20 3b 0a 0a 3a 20 push-reply ;..:
5650: 5d 6e 65 73 74 24 20 20 28 20 2d 2d 20 29 20 20 ]nest$ ( -- )
5660: 63 6d 64 3e 6e 65 73 74 20 32 64 72 6f 70 20 3b cmd>nest 2drop ;
5670: 0a 3a 20 5d 6e 65 73 74 24 21 20 20 28 20 61 64 .: ]nest$! ( ad
5680: 64 72 20 2d 2d 20 29 0a 20 20 20 20 6e 65 73 74 dr -- ). nest
5690: 73 74 61 72 74 23 20 40 20 3e 72 20 63 6d 64 3e start# @ >r cmd>
56a0: 6e 65 73 74 20 72 6f 74 20 24 21 0a 20 20 20 20 nest rot $!.
56b0: 72 3e 20 66 77 64 23 20 2d 20 31 2d 20 63 6d 64 r> fwd# - 1- cmd
56c0: 62 75 66 24 20 6e 69 70 20 2d 20 2d 63 6d 64 62 buf$ nip - -cmdb
56d0: 75 66 20 3b 0a 7d 73 63 6f 70 65 0a 0a 5b 49 46 uf ;.}scope..[IF
56e0: 44 45 46 5d 20 36 34 62 69 74 0a 20 20 20 20 27 DEF] 64bit. '
56f0: 20 6e 6f 6f 70 20 41 6c 69 61 73 20 32 2a 36 34 noop Alias 2*64
5700: 3e 6e 20 69 6d 6d 65 64 69 61 74 65 0a 20 20 20 >n immediate.
5710: 20 27 20 6e 6f 6f 70 20 41 6c 69 61 73 20 33 2a ' noop Alias 3*
5720: 36 34 3e 6e 20 69 6d 6d 65 64 69 61 74 65 0a 5b 64>n immediate.[
5730: 45 4c 53 45 5d 0a 20 20 20 20 3a 20 32 2a 36 34 ELSE]. : 2*64
5740: 3e 6e 20 28 20 36 34 61 20 36 34 62 20 2d 2d 20 >n ( 64a 64b --
5750: 6e 61 20 6e 62 20 29 20 36 34 3e 6e 20 3e 72 20 na nb ) 64>n >r
5760: 36 34 3e 6e 20 72 3e 20 3b 0a 20 20 20 20 3a 20 64>n r> ;. :
5770: 33 2a 36 34 3e 6e 20 28 20 36 34 61 20 36 34 62 3*64>n ( 64a 64b
5780: 20 36 34 63 20 2d 2d 20 6e 61 20 6e 62 20 6e 63 64c -- na nb nc
5790: 20 29 20 36 34 3e 6e 20 3e 72 20 36 34 3e 6e 20 ) 64>n >r 64>n
57a0: 3e 72 20 36 34 3e 6e 20 72 3e 20 72 3e 20 3b 0a >r 64>n r> r> ;.
57b0: 5b 54 48 45 4e 5d 0a 0a 5c 20 63 6f 6d 6d 61 6e [THEN]..\ comman
57c0: 64 73 20 74 6f 20 72 65 70 6c 79 0a 0a 73 63 6f ds to reply..sco
57d0: 70 65 7b 20 6e 65 74 32 6f 2d 62 61 73 65 0a 5c pe{ net2o-base.\
57e0: 67 20 0a 5c 67 20 23 23 23 20 72 65 70 6c 79 20 g .\g ### reply
57f0: 63 6f 6d 6d 61 6e 64 73 20 23 23 23 0a 5c 67 20 commands ###.\g
5800: 0a 24 31 30 20 6e 65 74 32 6f 3a 20 70 75 73 68 .$10 net2o: push
5810: 27 20 28 20 23 63 6d 64 20 2d 2d 20 29 20 5c 67 ' ( #cmd -- ) \g
5820: 20 70 75 73 68 20 63 6f 6d 6d 61 6e 64 20 69 6e push command in
5830: 74 6f 20 61 6e 73 77 65 72 20 70 61 63 6b 65 74 to answer packet
5840: 0a 20 20 20 20 70 40 20 63 6d 64 2c 20 3b 0a 2b . p@ cmd, ;.+
5850: 6e 65 74 32 6f 3a 20 70 75 73 68 2d 6c 69 74 20 net2o: push-lit
5860: 28 20 75 20 2d 2d 20 29 20 5c 67 20 70 75 73 68 ( u -- ) \g push
5870: 20 75 6e 73 69 67 6e 65 64 20 6c 69 74 65 72 61 unsigned litera
5880: 6c 20 69 6e 74 6f 20 61 6e 73 77 65 72 20 70 61 l into answer pa
5890: 63 6b 65 74 0a 20 20 20 20 6c 69 74 2c 20 3b 0a cket. lit, ;.
58a0: 27 20 70 75 73 68 2d 6c 69 74 20 61 6c 69 61 73 ' push-lit alias
58b0: 20 70 75 73 68 2d 63 68 61 72 0a 24 31 33 20 6e push-char.$13 n
58c0: 65 74 32 6f 3a 20 70 75 73 68 2d 24 20 28 20 24 et2o: push-$ ( $
58d0: 3a 73 74 72 69 6e 67 20 2d 2d 20 29 20 5c 67 20 :string -- ) \g
58e0: 70 75 73 68 20 73 74 72 69 6e 67 20 69 6e 74 6f push string into
58f0: 20 61 6e 73 77 65 72 20 70 61 63 6b 65 74 0a 20 answer packet.
5900: 20 20 20 24 3e 20 24 2c 20 3b 0a 2b 6e 65 74 32 $> $, ;.+net2
5910: 6f 3a 20 70 75 73 68 2d 66 6c 6f 61 74 20 28 20 o: push-float (
5920: 72 20 2d 2d 20 29 20 5c 67 20 70 75 73 68 20 66 r -- ) \g push f
5930: 6c 6f 61 74 69 6e 67 20 70 6f 69 6e 74 20 6e 75 loating point nu
5940: 6d 62 65 72 0a 20 20 20 20 66 6c 6f 61 74 2c 20 mber. float,
5950: 3b 0a 2b 6e 65 74 32 6f 3a 20 6f 6b 20 28 20 75 ;.+net2o: ok ( u
5960: 74 61 67 20 2d 2d 20 29 20 5c 67 20 74 61 67 67 tag -- ) \g tagg
5970: 65 64 20 72 65 73 70 6f 6e 73 65 0a 20 20 20 20 ed response.
5980: 36 34 3e 6e 20 6e 65 74 32 6f 3a 6f 6b 20 3b 0a 64>n net2o:ok ;.
5990: 2b 6e 65 74 32 6f 3a 20 6f 6b 3f 20 28 20 75 74 +net2o: ok? ( ut
59a0: 61 67 20 2d 2d 20 29 20 5c 67 20 72 65 71 75 65 ag -- ) \g reque
59b0: 73 74 20 74 61 67 67 65 64 20 72 65 73 70 6f 6e st tagged respon
59c0: 73 65 0a 20 20 20 20 6c 69 74 2c 20 6f 6b 20 6e se. lit, ok n
59d0: 65 74 32 6f 3a 6f 6b 3f 20 3b 0a 5c 20 55 73 65 et2o:ok? ;.\ Use
59e0: 20 6b 6f 20 69 6e 73 74 65 61 64 20 6f 66 20 74 ko instead of t
59f0: 68 72 6f 77 20 66 6f 72 20 6e 6f 74 20 61 63 6b hrow for not ack
5a00: 6e 6f 77 6c 65 64 67 65 20 28 6b 75 64 6f 73 20 nowledge (kudos
5a10: 74 6f 20 48 65 69 6e 7a 20 53 63 68 6e 69 74 74 to Heinz Schnitt
5a20: 65 72 29 0a 2b 6e 65 74 32 6f 3a 20 6b 6f 20 28 er).+net2o: ko (
5a30: 20 75 65 72 72 6f 72 20 2d 2d 20 29 20 5c 67 20 uerror -- ) \g
5a40: 72 65 63 65 69 76 65 20 65 72 72 6f 72 20 6d 65 receive error me
5a50: 73 73 61 67 65 0a 20 20 20 20 72 65 6d 6f 74 65 ssage. remote
5a60: 3f 20 6f 66 66 20 74 68 72 6f 77 20 3b 0a 2b 6e ? off throw ;.+n
5a70: 65 74 32 6f 3a 20 6e 65 73 74 20 28 20 24 3a 73 et2o: nest ( $:s
5a80: 74 72 69 6e 67 20 2d 2d 20 29 20 5c 67 20 6e 65 tring -- ) \g ne
5a90: 73 74 65 64 20 28 73 65 6c 66 2d 65 6e 63 72 79 sted (self-encry
5aa0: 70 74 65 64 29 20 63 6f 6d 6d 61 6e 64 0a 20 20 pted) command.
5ab0: 20 20 24 3e 20 63 6d 64 6e 65 73 74 20 3b 0a 5c $> cmdnest ;.\
5ac0: 20 69 6e 73 70 65 63 74 69 6f 6e 0a 2b 6e 65 74 inspection.+net
5ad0: 32 6f 3a 20 74 6f 6b 65 6e 20 28 20 24 3a 74 6f 2o: token ( $:to
5ae0: 6b 65 6e 20 6e 20 2d 2d 20 29 20 36 34 64 72 6f ken n -- ) 64dro
5af0: 70 20 24 3e 20 32 64 72 6f 70 20 3b 20 5c 67 20 p $> 2drop ; \g
5b00: 67 65 6e 65 72 69 63 20 69 6e 73 70 65 63 74 69 generic inspecti
5b10: 6f 6e 20 74 6f 6b 65 6e 0a 2b 6e 65 74 32 6f 3a on token.+net2o:
5b20: 20 65 72 72 6f 72 2d 69 64 20 28 20 24 3a 65 72 error-id ( $:er
5b30: 72 6f 72 69 64 20 2d 2d 20 29 20 5c 67 20 65 72 rorid -- ) \g er
5b40: 72 6f 72 2d 69 64 20 73 74 72 69 6e 67 0a 20 20 ror-id string.
5b50: 20 20 24 3e 20 24 65 72 72 6f 72 2d 69 64 20 24 $> $error-id $
5b60: 21 20 3b 0a 2b 6e 65 74 32 6f 3a 20 76 65 72 73 ! ;.+net2o: vers
5b70: 69 6f 6e 3f 20 28 20 24 3a 76 65 72 73 69 6f 6e ion? ( $:version
5b80: 20 2d 2d 20 29 20 5c 67 20 76 65 72 73 69 6f 6e -- ) \g version
5b90: 20 63 72 6f 73 73 2d 63 68 65 63 6b 0a 20 20 20 cross-check.
5ba0: 20 73 74 72 69 6e 67 2d 73 74 61 63 6b 20 24 5b string-stack $[
5bb0: 5d 23 20 49 46 20 20 24 3e 20 3f 76 65 72 73 69 ]# IF $> ?versi
5bc0: 6f 6e 20 20 54 48 45 4e 20 5c 20 61 63 63 65 70 on THEN \ accep
5bd0: 74 20 71 75 65 72 79 2d 6f 6e 6c 79 0a 20 20 20 t query-only.
5be0: 20 6e 65 74 32 6f 2d 76 65 72 73 69 6f 6e 20 24 net2o-version $
5bf0: 2c 20 76 65 72 73 69 6f 6e 20 3b 0a 0a 3a 20 5d , version ;..: ]
5c00: 6e 65 73 74 20 20 28 20 2d 2d 20 29 20 20 5d 6e nest ( -- ) ]n
5c10: 65 73 74 24 20 70 75 73 68 2d 24 20 70 75 73 68 est$ push-$ push
5c20: 27 20 6e 65 73 74 20 3b 0a 0a 7d 73 63 6f 70 65 ' nest ;..}scope
5c30: 0a 0a 72 65 70 6c 79 2d 74 61 62 6c 65 20 24 73 ..reply-table $s
5c40: 61 76 65 0a 0a 61 6c 73 6f 20 6e 65 74 32 6f 2d ave..also net2o-
5c50: 62 61 73 65 0a 0a 3a 20 6e 65 74 32 6f 3a 77 6f base..: net2o:wo
5c60: 72 64 73 20 28 20 73 74 61 72 74 20 2d 2d 20 29 rds ( start -- )
5c70: 0a 20 20 20 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 . token-table
5c80: 20 24 40 20 32 20 70 69 63 6b 20 63 65 6c 6c 73 $@ 2 pick cells
5c90: 20 73 61 66 65 2f 73 74 72 69 6e 67 20 62 6f 75 safe/string bou
5ca0: 6e 64 73 20 55 2b 44 4f 0a 09 49 20 40 20 3f 64 nds U+DO..I @ ?d
5cb0: 75 70 2d 49 46 0a 09 20 20 20 20 64 75 70 20 3e up-IF.. dup >
5cc0: 6e 65 74 32 6f 2d 73 69 67 20 32 3e 72 20 3e 6e net2o-sig 2>r >n
5cd0: 65 74 32 6f 2d 6e 61 6d 65 0a 09 20 20 20 20 64 et2o-name.. d
5ce0: 75 70 20 24 41 30 20 2b 20 6d 61 78 73 74 72 69 up $A0 + maxstri
5cf0: 6e 67 20 75 3c 20 49 46 0a 09 09 32 20 70 69 63 ng u< IF...2 pic
5d00: 6b 20 75 6c 69 74 2c 20 32 72 3e 20 32 73 77 61 k ulit, 2r> 2swa
5d10: 70 20 5b 3a 20 74 79 70 65 20 74 79 70 65 20 3b p [: type type ;
5d20: 5d 20 24 74 6d 70 20 24 2c 20 74 6f 6b 65 6e 0a ] $tmp $, token.
5d30: 09 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 . ELSE 2drop
5d40: 20 72 64 72 6f 70 20 72 64 72 6f 70 20 20 54 48 rdrop rdrop TH
5d50: 45 4e 0a 09 54 48 45 4e 20 20 31 2b 0a 20 20 20 EN..THEN 1+.
5d60: 20 63 65 6c 6c 20 2b 4c 4f 4f 50 20 20 64 72 6f cell +LOOP dro
5d70: 70 20 3b 0a 0a 70 72 65 76 69 6f 75 73 0a 0a 5c p ;..previous..\
5d80: 5c 5c 0a 4c 6f 63 61 6c 20 56 61 72 69 61 62 6c \\.Local Variabl
5d90: 65 73 3a 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c 2d es:.forth-local-
5da0: 77 6f 72 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 words:. (.
5db0: 20 20 28 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e (("net2o:" "+n
5dc0: 65 74 32 6f 3a 22 20 22 65 76 65 6e 74 3a 22 29 et2o:" "event:")
5dd0: 20 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 definition-star
5de0: 74 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b ter (font-lock-k
5df0: 65 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 eyword-face . 1)
5e00: 0a 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 . "[ \t\n]"
5e10: 20 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f t name (font-lo
5e20: 63 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 ck-function-name
5e30: 2d 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 -face . 3)).
5e40: 20 28 28 22 64 65 62 75 67 3a 22 20 22 66 69 65 (("debug:" "fie
5e50: 6c 64 3a 22 20 22 32 66 69 65 6c 64 3a 22 20 22 ld:" "2field:" "
5e60: 73 66 66 69 65 6c 64 3a 22 20 22 64 66 66 69 65 sffield:" "dffie
5e70: 6c 64 3a 22 20 22 36 34 66 69 65 6c 64 3a 22 20 ld:" "64field:"
5e80: 22 75 76 61 72 22 20 22 75 76 61 6c 75 65 22 29 "uvar" "uvalue")
5e90: 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 20 28 non-immediate (
5ea0: 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d 66 font-lock-type-f
5eb0: 61 63 65 20 2e 20 32 29 0a 20 20 20 20 20 20 22 ace . 2). "
5ec0: 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 [ \t\n]" t name
5ed0: 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 61 (font-lock-varia
5ee0: 62 6c 65 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 ble-name-face .
5ef0: 33 29 29 0a 20 20 20 20 20 28 22 5b 61 2d 7a 5c 3)). ("[a-z\
5f00: 2d 30 2d 39 5d 2b 28 22 20 69 6d 6d 65 64 69 61 -0-9]+(" immedia
5f10: 74 65 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 63 6f te (font-lock-co
5f20: 6d 6d 65 6e 74 2d 66 61 63 65 20 2e 20 31 29 0a mment-face . 1).
5f30: 20 20 20 20 20 20 22 29 22 20 6e 69 6c 20 63 6f ")" nil co
5f40: 6d 6d 65 6e 74 20 28 66 6f 6e 74 2d 6c 6f 63 6b mment (font-lock
5f50: 2d 63 6f 6d 6d 65 6e 74 2d 66 61 63 65 20 2e 20 -comment-face .
5f60: 31 29 29 0a 20 20 20 20 29 0a 66 6f 72 74 68 2d 1)). ).forth-
5f70: 6c 6f 63 61 6c 2d 69 6e 64 65 6e 74 2d 77 6f 72 local-indent-wor
5f80: 64 73 3a 0a 20 20 20 20 28 0a 20 20 20 20 20 28 ds:. (. (
5f90: 28 22 6e 65 74 32 6f 3a 22 20 22 2b 6e 65 74 32 ("net2o:" "+net2
5fa0: 6f 3a 22 29 20 28 30 20 2e 20 32 29 20 28 30 20 o:") (0 . 2) (0
5fb0: 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 . 2) non-immedia
5fc0: 74 65 29 0a 20 20 20 20 20 28 28 22 65 76 65 6e te). (("even
5fd0: 74 3a 22 29 20 28 30 20 2e 20 32 29 20 28 30 20 t:") (0 . 2) (0
5fe0: 2e 20 32 29 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 . 2) non-immedia
5ff0: 74 65 29 0a 20 20 20 20 29 0a 45 6e 64 3a 0a 5b te). ).End:.[
6000: 54 48 45 4e 5d 0a THEN].