0000: 5c 20 6e 65 74 32 6f 20 70 72 6f 74 6f 63 6f 6c \ net2o protocol
0010: 20 73 74 61 63 6b 0a 0a 5c 20 43 6f 70 79 72 69 stack..\ Copyri
0020: 67 68 74 20 28 43 29 20 32 30 31 30 2d 32 30 31 ght (C) 2010-201
0030: 35 20 20 20 42 65 72 6e 64 20 50 61 79 73 61 6e 5 Bernd Paysan
0040: 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67 72 61 6d ..\ This program
0050: 20 69 73 20 66 72 65 65 20 73 6f 66 74 77 61 72 is free softwar
0060: 65 3a 20 79 6f 75 20 63 61 6e 20 72 65 64 69 73 e: you can redis
0070: 74 72 69 62 75 74 65 20 69 74 20 61 6e 64 2f 6f tribute it and/o
0080: 72 20 6d 6f 64 69 66 79 0a 5c 20 69 74 20 75 6e r modify.\ it un
0090: 64 65 72 20 74 68 65 20 74 65 72 6d 73 20 6f 66 der the terms of
00a0: 20 74 68 65 20 47 4e 55 20 41 66 66 65 72 6f 20 the GNU Affero
00b0: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
00c0: 69 63 65 6e 73 65 20 61 73 20 70 75 62 6c 69 73 icense as publis
00d0: 68 65 64 20 62 79 0a 5c 20 74 68 65 20 46 72 65 hed by.\ the Fre
00e0: 65 20 53 6f 66 74 77 61 72 65 20 46 6f 75 6e 64 e Software Found
00f0: 61 74 69 6f 6e 2c 20 65 69 74 68 65 72 20 76 65 ation, either ve
0100: 72 73 69 6f 6e 20 33 20 6f 66 20 74 68 65 20 4c rsion 3 of the L
0110: 69 63 65 6e 73 65 2c 20 6f 72 0a 5c 20 28 61 74 icense, or.\ (at
0120: 20 79 6f 75 72 20 6f 70 74 69 6f 6e 29 20 61 6e your option) an
0130: 79 20 6c 61 74 65 72 20 76 65 72 73 69 6f 6e 2e y later version.
0140: 0a 0a 5c 20 54 68 69 73 20 70 72 6f 67 72 61 6d ..\ This program
0150: 20 69 73 20 64 69 73 74 72 69 62 75 74 65 64 20 is distributed
0160: 69 6e 20 74 68 65 20 68 6f 70 65 20 74 68 61 74 in the hope that
0170: 20 69 74 20 77 69 6c 6c 20 62 65 20 75 73 65 66 it will be usef
0180: 75 6c 2c 0a 5c 20 62 75 74 20 57 49 54 48 4f 55 ul,.\ but WITHOU
0190: 54 20 41 4e 59 20 57 41 52 52 41 4e 54 59 3b 20 T ANY WARRANTY;
01a0: 77 69 74 68 6f 75 74 20 65 76 65 6e 20 74 68 65 without even the
01b0: 20 69 6d 70 6c 69 65 64 20 77 61 72 72 61 6e 74 implied warrant
01c0: 79 20 6f 66 0a 5c 20 4d 45 52 43 48 41 4e 54 41 y of.\ MERCHANTA
01d0: 42 49 4c 49 54 59 20 6f 72 20 46 49 54 4e 45 53 BILITY or FITNES
01e0: 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 4c S FOR A PARTICUL
01f0: 41 52 20 50 55 52 50 4f 53 45 2e 20 20 53 65 65 AR PURPOSE. See
0200: 20 74 68 65 0a 5c 20 47 4e 55 20 41 66 66 65 72 the.\ GNU Affer
0210: 6f 20 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 o General Public
0220: 20 4c 69 63 65 6e 73 65 20 66 6f 72 20 6d 6f 72 License for mor
0230: 65 20 64 65 74 61 69 6c 73 2e 0a 0a 5c 20 59 6f e details...\ Yo
0240: 75 20 73 68 6f 75 6c 64 20 68 61 76 65 20 72 65 u should have re
0250: 63 65 69 76 65 64 20 61 20 63 6f 70 79 20 6f 66 ceived a copy of
0260: 20 74 68 65 20 47 4e 55 20 41 66 66 65 72 6f 20 the GNU Affero
0270: 47 65 6e 65 72 61 6c 20 50 75 62 6c 69 63 20 4c General Public L
0280: 69 63 65 6e 73 65 0a 5c 20 61 6c 6f 6e 67 20 77 icense.\ along w
0290: 69 74 68 20 74 68 69 73 20 70 72 6f 67 72 61 6d ith this program
02a0: 2e 20 20 49 66 20 6e 6f 74 2c 20 73 65 65 20 3c . If not, see <
02b0: 68 74 74 70 3a 2f 2f 77 77 77 2e 67 6e 75 2e 6f http://www.gnu.o
02c0: 72 67 2f 6c 69 63 65 6e 73 65 73 2f 3e 2e 0a 0a rg/licenses/>...
02d0: 5c 20 68 65 6c 70 65 72 20 77 6f 72 64 73 0a 0a \ helper words..
02e0: 72 65 71 75 69 72 65 20 76 65 72 73 69 6f 6e 2e require version.
02f0: 66 73 0a 72 65 71 75 69 72 65 20 65 72 72 2e 66 fs.require err.f
0300: 73 0a 0a 5c 20 72 65 71 75 69 72 65 64 20 74 6f s..\ required to
0310: 6f 6c 73 0a 0a 72 65 71 75 69 72 65 20 66 6f 72 ols..require for
0320: 77 61 72 64 2e 66 73 0a 72 65 71 75 69 72 65 20 ward.fs.require
0330: 6d 69 6e 69 2d 6f 6f 66 32 2e 66 73 0a 72 65 71 mini-oof2.fs.req
0340: 75 69 72 65 20 75 73 65 72 2d 6f 62 6a 65 63 74 uire user-object
0350: 2e 66 73 0a 72 65 71 75 69 72 65 20 73 74 72 75 .fs.require stru
0360: 63 74 2d 76 61 6c 2e 66 73 0a 72 65 71 75 69 72 ct-val.fs.requir
0370: 65 20 72 65 63 2d 73 63 6f 70 65 2e 66 73 0a 72 e rec-scope.fs.r
0380: 65 71 75 69 72 65 20 75 6e 69 78 2f 73 6f 63 6b equire unix/sock
0390: 65 74 2e 66 73 0a 72 65 71 75 69 72 65 20 75 6e et.fs.require un
03a0: 69 78 2f 6d 6d 61 70 2e 66 73 0a 72 65 71 75 69 ix/mmap.fs.requi
03b0: 72 65 20 75 6e 69 78 2f 70 74 68 72 65 61 64 2e re unix/pthread.
03c0: 66 73 0a 72 65 71 75 69 72 65 20 75 6e 69 78 2f fs.require unix/
03d0: 66 69 6c 65 73 74 61 74 2e 66 73 0a 72 65 71 75 filestat.fs.requ
03e0: 69 72 65 20 74 6f 6f 6c 73 2e 66 73 0a 72 65 71 ire tools.fs.req
03f0: 75 69 72 65 20 64 65 62 75 67 67 69 6e 67 2e 66 uire debugging.f
0400: 73 0a 72 65 71 75 69 72 65 20 6b 72 65 67 69 6f s.require kregio
0410: 6e 2e 66 73 0a 72 65 71 75 69 72 65 20 63 72 79 n.fs.require cry
0420: 70 74 6f 2d 61 70 69 2e 66 73 0a 72 65 71 75 69 pto-api.fs.requi
0430: 72 65 20 6b 65 63 63 61 6b 2e 66 73 0a 72 65 71 re keccak.fs.req
0440: 75 69 72 65 20 74 68 72 65 65 66 69 73 68 2e 66 uire threefish.f
0450: 73 0a 6b 65 63 63 61 6b 2d 6f 20 63 72 79 70 74 s.keccak-o crypt
0460: 6f 2d 6f 20 21 0a 72 65 71 75 69 72 65 20 72 6e o-o !.require rn
0470: 67 2e 66 73 0a 72 65 71 75 69 72 65 20 65 64 32 g.fs.require ed2
0480: 35 35 31 39 2d 64 6f 6e 6e 61 2e 66 73 0a 72 65 5519-donna.fs.re
0490: 71 75 69 72 65 20 68 61 73 68 2d 74 61 62 6c 65 quire hash-table
04a0: 2e 66 73 0a 72 65 71 75 69 72 65 20 62 64 65 6c .fs.require bdel
04b0: 74 61 2e 66 73 0a 0a 5c 20 72 61 6e 64 6f 6d 20 ta.fs..\ random
04c0: 69 6e 69 74 69 61 6c 69 7a 65 72 20 66 6f 72 20 initializer for
04d0: 68 61 73 68 0a 0a 3a 20 68 61 73 68 2d 69 6e 69 hash..: hash-ini
04e0: 74 2d 72 6e 67 20 28 20 2d 2d 20 29 20 20 24 31 t-rng ( -- ) $1
04f0: 30 20 72 6e 67 24 20 68 61 73 68 69 6e 69 74 20 0 rng$ hashinit
0500: 73 77 61 70 20 6d 6f 76 65 20 3b 0a 0a 68 61 73 swap move ;..has
0510: 68 2d 69 6e 69 74 2d 72 6e 67 0a 0a 5c 20 63 72 h-init-rng..\ cr
0520: 79 70 74 6f 20 73 65 6c 65 63 74 69 6f 6e 0a 0a ypto selection..
0530: 43 72 65 61 74 65 20 63 72 79 70 74 2d 6d 6f 64 Create crypt-mod
0540: 65 73 20 27 20 6b 65 63 63 61 6b 2d 74 20 2c 20 es ' keccak-t ,
0550: 27 20 74 68 72 65 65 66 69 73 68 2d 74 20 2c 0a ' threefish-t ,.
0560: 68 65 72 65 20 63 72 79 70 74 2d 6d 6f 64 65 73 here crypt-modes
0570: 20 2d 20 63 65 6c 6c 2f 20 43 6f 6e 73 74 61 6e - cell/ Constan
0580: 74 20 63 72 79 70 74 73 23 0a 0a 3a 20 3e 63 72 t crypts#..: >cr
0590: 79 70 74 20 28 20 6e 20 2d 2d 20 29 0a 20 20 20 ypt ( n -- ).
05a0: 20 63 72 79 70 74 73 23 20 31 2d 20 75 6d 69 6e crypts# 1- umin
05b0: 20 63 65 6c 6c 73 20 63 72 79 70 74 2d 6d 6f 64 cells crypt-mod
05c0: 65 73 20 2b 20 70 65 72 66 6f 72 6d 20 40 20 63 es + perform @ c
05d0: 72 79 70 74 6f 2d 6f 20 21 20 63 3a 69 6e 69 74 rypto-o ! c:init
05e0: 20 3b 0a 30 20 3e 63 72 79 70 74 0a 0a 5c 20 76 ;.0 >crypt..\ v
05f0: 61 6c 75 65 73 2c 20 63 6f 6e 66 69 67 75 72 61 alues, configura
0600: 62 6c 65 0a 0a 24 34 20 56 61 6c 75 65 20 6d 61 ble..$4 Value ma
0610: 78 2d 73 69 7a 65 5e 32 20 5c 20 31 6b 2c 20 64 x-size^2 \ 1k, d
0620: 6f 6e 27 74 20 66 72 61 67 6d 65 6e 74 20 62 79 on't fragment by
0630: 20 64 65 66 61 75 6c 74 0a 24 31 32 20 56 61 6c default.$12 Val
0640: 75 65 20 6d 61 78 2d 64 61 74 61 23 20 5c 20 31 ue max-data# \ 1
0650: 36 4d 42 20 64 61 74 61 20 73 70 61 63 65 0a 24 6MB data space.$
0660: 30 43 20 56 61 6c 75 65 20 6d 61 78 2d 63 6f 64 0C Value max-cod
0670: 65 23 20 5c 20 32 35 36 6b 20 63 6f 64 65 20 73 e# \ 256k code s
0680: 70 61 63 65 0a 24 31 30 20 56 61 6c 75 65 20 6d pace.$10 Value m
0690: 61 78 2d 62 6c 6f 63 6b 23 20 5c 20 36 34 6b 20 ax-block# \ 64k
06a0: 6d 61 78 69 6d 75 6d 20 62 6c 6f 63 6b 20 73 69 maximum block si
06b0: 7a 65 2b 61 6c 69 67 6e 6d 65 6e 74 0a 0a 5c 20 ze+alignment..\
06c0: 76 61 6c 75 65 73 2c 20 73 74 61 74 75 73 0a 0a values, status..
06d0: 74 72 75 65 20 56 61 6c 75 65 20 63 6f 6e 6e 65 true Value conne
06e0: 63 74 65 64 3f 0a 30 20 56 61 6c 75 65 20 64 68 cted?.0 Value dh
06f0: 74 2d 63 6f 6e 6e 65 63 74 69 6f 6e 0a 0a 5c 20 t-connection..\
0700: 63 6f 6e 73 74 61 6e 74 73 2c 20 61 6e 64 20 64 constants, and d
0710: 65 70 65 6e 64 69 6e 67 20 76 61 6c 75 65 73 0a epending values.
0720: 0a 24 32 41 20 43 6f 6e 73 74 61 6e 74 20 6f 76 .$2A Constant ov
0730: 65 72 68 65 61 64 20 5c 20 63 6f 6e 73 74 61 6e erhead \ constan
0740: 74 20 6f 76 65 72 68 65 61 64 0a 24 34 30 20 43 t overhead.$40 C
0750: 6f 6e 73 74 61 6e 74 20 6d 69 6e 2d 73 69 7a 65 onstant min-size
0760: 0a 31 20 56 61 6c 75 65 20 62 75 66 66 65 72 73 .1 Value buffers
0770: 23 0a 6d 69 6e 2d 73 69 7a 65 20 6d 61 78 2d 73 #.min-size max-s
0780: 69 7a 65 5e 32 20 6c 73 68 69 66 74 20 56 61 6c ize^2 lshift Val
0790: 75 65 20 6d 61 78 64 61 74 61 20 28 20 2d 2d 20 ue maxdata ( --
07a0: 6e 20 29 0a 6d 61 78 64 61 74 61 20 6f 76 65 72 n ).maxdata over
07b0: 68 65 61 64 20 2b 20 56 61 6c 75 65 20 6d 61 78 head + Value max
07c0: 70 61 63 6b 65 74 0a 6d 61 78 70 61 63 6b 65 74 packet.maxpacket
07d0: 20 24 46 20 2b 20 2d 24 31 30 20 61 6e 64 20 56 $F + -$10 and V
07e0: 61 6c 75 65 20 6d 61 78 70 61 63 6b 65 74 2d 61 alue maxpacket-a
07f0: 6c 69 67 6e 65 64 0a 6d 61 78 2d 73 69 7a 65 5e ligned.max-size^
0800: 32 20 36 20 2b 20 56 61 6c 75 65 20 63 68 75 6e 2 6 + Value chun
0810: 6b 2d 70 32 0a 24 31 30 20 43 6f 6e 73 74 61 6e k-p2.$10 Constan
0820: 74 20 6b 65 79 2d 73 61 6c 74 23 0a 24 31 30 20 t key-salt#.$10
0830: 43 6f 6e 73 74 61 6e 74 20 6b 65 79 2d 63 6b 73 Constant key-cks
0840: 75 6d 23 0a 0a 5c 20 66 6f 72 20 62 69 67 67 65 um#..\ for bigge
0850: 72 20 62 6c 6f 63 6b 73 2c 20 77 65 20 75 73 65 r blocks, we use
0860: 20 75 73 65 20 61 6c 6c 6f 63 2b 67 75 61 72 64 use alloc+guard
0870: 2c 20 69 2e 65 2e 20 6d 6d 61 70 20 77 69 74 68 , i.e. mmap with
0880: 20 61 0a 5c 20 67 75 61 72 64 20 70 61 67 65 20 a.\ guard page
0890: 61 66 74 65 72 20 74 68 65 20 65 6e 64 2e 0a 0a after the end...
08a0: 3a 20 61 6c 6c 6f 63 2d 62 75 66 20 28 20 2d 2d : alloc-buf ( --
08b0: 20 61 64 64 72 20 29 0a 20 20 20 20 6d 61 78 70 addr ). maxp
08c0: 61 63 6b 65 74 2d 61 6c 69 67 6e 65 64 20 62 75 acket-aligned bu
08d0: 66 66 65 72 73 23 20 2a 20 61 6c 6c 6f 63 2b 67 ffers# * alloc+g
08e0: 75 61 72 64 20 3b 0a 3a 20 61 6c 6c 6f 63 2d 62 uard ;.: alloc-b
08f0: 75 66 2b 36 20 28 20 2d 2d 20 61 64 64 72 20 29 uf+6 ( -- addr )
0900: 20 20 61 6c 6c 6f 63 2d 62 75 66 20 36 20 2b 20 alloc-buf 6 +
0910: 3b 0a 3a 20 66 72 65 65 2d 62 75 66 20 28 20 61 ;.: free-buf ( a
0920: 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 6d 61 78 ddr -- ). max
0930: 70 61 63 6b 65 74 2d 61 6c 69 67 6e 65 64 20 62 packet-aligned b
0940: 75 66 66 65 72 73 23 20 2a 20 32 64 75 70 20 65 uffers# * 2dup e
0950: 72 61 73 65 20 66 72 65 65 2b 67 75 61 72 64 20 rase free+guard
0960: 3b 0a 3a 20 66 72 65 65 2d 62 75 66 2b 36 20 28 ;.: free-buf+6 (
0970: 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 36 addr -- ). 6
0980: 20 2d 20 66 72 65 65 2d 62 75 66 20 3b 0a 0a 5b - free-buf ;..[
0990: 49 46 44 45 46 5d 20 63 79 67 77 69 6e 0a 20 20 IFDEF] cygwin.
09a0: 20 20 3a 20 6e 6f 2d 68 79 62 72 69 64 20 3b 20 : no-hybrid ;
09b0: 5c 20 63 79 67 77 69 6e 20 63 61 6e 27 74 20 64 \ cygwin can't d
09c0: 65 61 6c 20 77 69 74 68 20 68 79 62 72 69 64 20 eal with hybrid
09d0: 73 74 61 63 6b 73 0a 5b 54 48 45 4e 5d 0a 0a 5c stacks.[THEN]..\
09e0: 20 70 65 72 2d 74 68 72 65 61 64 20 6d 65 6d 6f per-thread memo
09f0: 72 79 20 73 70 61 63 65 0a 0a 55 56 61 6c 75 65 ry space..UValue
0a00: 20 69 6e 62 75 66 20 20 20 20 28 20 2d 2d 20 61 inbuf ( -- a
0a10: 64 64 72 20 29 0a 55 56 61 6c 75 65 20 74 6d 70 ddr ).UValue tmp
0a20: 62 75 66 20 20 20 28 20 2d 2d 20 61 64 64 72 20 buf ( -- addr
0a30: 29 0a 55 56 61 6c 75 65 20 6f 75 74 62 75 66 20 ).UValue outbuf
0a40: 20 20 28 20 2d 2d 20 61 64 64 72 20 29 0a 68 61 ( -- addr ).ha
0a50: 73 68 3a 20 72 6f 75 74 65 73 23 0a 0a 5c 20 61 sh: routes#..\ a
0a60: 64 64 20 49 50 20 61 64 64 72 65 73 73 65 73 0a dd IP addresses.
0a70: 0a 72 65 71 75 69 72 65 20 63 6c 61 73 73 65 73 .require classes
0a80: 2e 66 73 0a 72 65 71 75 69 72 65 20 69 70 2e 66 .fs.require ip.f
0a90: 73 0a 72 65 71 75 69 72 65 20 73 6f 63 6b 73 2e s.require socks.
0aa0: 66 73 0a 0a 55 44 65 66 65 72 20 6f 74 68 65 72 fs..UDefer other
0ab0: 0a 0a 3a 20 2d 6f 74 68 65 72 20 20 20 20 20 20 ..: -other
0ac0: 20 20 5b 27 5d 20 6e 6f 6f 70 20 69 73 20 6f 74 ['] noop is ot
0ad0: 68 65 72 20 3b 0a 2d 6f 74 68 65 72 0a 0a 44 65 her ;.-other..De
0ae0: 66 65 72 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 fer alloc-code-b
0af0: 75 66 73 20 27 20 6e 6f 6f 70 20 69 73 20 61 6c ufs ' noop is al
0b00: 6c 6f 63 2d 63 6f 64 65 2d 62 75 66 73 0a 44 65 loc-code-bufs.De
0b10: 66 65 72 20 66 72 65 65 2d 63 6f 64 65 2d 62 75 fer free-code-bu
0b20: 66 73 20 20 27 20 6e 6f 6f 70 20 69 73 20 66 72 fs ' noop is fr
0b30: 65 65 2d 63 6f 64 65 2d 62 75 66 73 0a 0a 56 61 ee-code-bufs..Va
0b40: 72 69 61 62 6c 65 20 74 61 73 6b 2d 69 64 23 0a riable task-id#.
0b50: 0a 3a 20 61 6c 6c 6f 63 2d 69 6f 20 28 20 2d 2d .: alloc-io ( --
0b60: 20 29 20 5c 20 61 6c 6c 6f 63 61 74 65 20 49 4f ) \ allocate IO
0b70: 20 61 6e 64 20 72 65 73 65 74 20 67 65 6e 65 72 and reset gener
0b80: 69 63 20 75 73 65 72 20 76 61 72 69 61 62 6c 65 ic user variable
0b90: 73 0a 20 20 20 20 69 6f 2d 62 75 66 66 65 72 73 s. io-buffers
0ba0: 20 6e 65 77 20 69 6f 2d 6d 65 6d 20 21 0a 20 20 new io-mem !.
0bb0: 20 20 31 20 74 61 73 6b 2d 69 64 23 20 2b 21 40 1 task-id# +!@
0bc0: 20 74 61 73 6b 23 20 21 0a 20 20 20 20 2d 6f 74 task# !. -ot
0bd0: 68 65 72 0a 20 20 20 20 61 6c 6c 6f 63 2d 62 75 her. alloc-bu
0be0: 66 2b 36 20 74 6f 20 69 6e 62 75 66 0a 20 20 20 f+6 to inbuf.
0bf0: 20 61 6c 6c 6f 63 2d 62 75 66 20 74 6f 20 74 6d alloc-buf to tm
0c00: 70 62 75 66 0a 20 20 20 20 61 6c 6c 6f 63 2d 62 pbuf. alloc-b
0c10: 75 66 2b 36 20 74 6f 20 6f 75 74 62 75 66 0a 20 uf+6 to outbuf.
0c20: 20 20 20 61 6c 6c 6f 63 2d 63 6f 64 65 2d 62 75 alloc-code-bu
0c30: 66 73 0a 20 20 20 20 69 6e 69 74 2d 65 64 32 35 fs. init-ed25
0c40: 35 31 39 20 63 3a 69 6e 69 74 20 3b 0a 0a 3a 6e 519 c:init ;..:n
0c50: 6f 6e 61 6d 65 20 28 20 2d 2d 20 29 20 64 65 66 oname ( -- ) def
0c60: 65 72 73 20 74 68 72 65 61 64 2d 69 6e 69 74 0a ers thread-init.
0c70: 20 20 20 20 61 6c 6c 6f 63 2d 69 6f 20 62 2d 6f alloc-io b-o
0c80: 75 74 20 6f 70 2d 76 65 63 74 6f 72 20 40 20 64 ut op-vector @ d
0c90: 65 62 75 67 2d 76 65 63 74 6f 72 20 21 20 3b 20 ebug-vector ! ;
0ca0: 69 73 20 74 68 72 65 61 64 2d 69 6e 69 74 0a 0a is thread-init..
0cb0: 3a 20 66 72 65 65 2d 69 6f 20 28 20 2d 2d 20 29 : free-io ( -- )
0cc0: 0a 20 20 20 20 66 72 65 65 2d 65 64 32 35 35 31 . free-ed2551
0cd0: 39 20 63 3a 66 72 65 65 0a 20 20 20 20 66 72 65 9 c:free. fre
0ce0: 65 2d 63 6f 64 65 2d 62 75 66 73 0a 20 20 20 20 e-code-bufs.
0cf0: 30 20 69 6f 2d 6d 65 6d 20 21 40 20 2e 64 69 73 0 io-mem !@ .dis
0d00: 70 6f 73 65 0a 20 20 20 20 69 6e 62 75 66 20 20 pose. inbuf
0d10: 66 72 65 65 2d 62 75 66 2b 36 0a 20 20 20 20 74 free-buf+6. t
0d20: 6d 70 62 75 66 20 66 72 65 65 2d 62 75 66 0a 20 mpbuf free-buf.
0d30: 20 20 20 6f 75 74 62 75 66 20 66 72 65 65 2d 62 outbuf free-b
0d40: 75 66 2b 36 20 3b 0a 0a 61 6c 6c 6f 63 2d 69 6f uf+6 ;..alloc-io
0d50: 0a 0a 56 61 72 69 61 62 6c 65 20 6e 65 74 32 6f ..Variable net2o
0d60: 2d 74 61 73 6b 73 0a 0a 3a 20 6e 65 74 32 6f 2d -tasks..: net2o-
0d70: 70 61 73 73 20 28 20 70 61 72 61 6d 73 20 78 74 pass ( params xt
0d80: 20 6e 20 74 61 73 6b 20 2d 2d 20 29 0a 20 20 20 n task -- ).
0d90: 20 64 75 70 20 6e 65 74 32 6f 2d 74 61 73 6b 73 dup net2o-tasks
0da0: 20 3e 73 74 61 63 6b 20 20 70 61 73 73 0a 20 20 >stack pass.
0db0: 20 20 3f 73 61 6c 74 2d 69 6e 69 74 20 6f 66 66 ?salt-init off
0dc0: 20 20 72 6e 67 2d 6f 20 6f 66 66 20 5c 20 6d 61 rng-o off \ ma
0dd0: 6b 65 20 64 6f 75 62 6c 65 20 73 75 72 65 20 6e ke double sure n
0de0: 6f 20 72 6e 67 20 69 73 20 61 63 74 69 76 65 0a o rng is active.
0df0: 20 20 20 20 61 6c 6c 6f 63 2d 69 6f 20 70 72 65 alloc-io pre
0e00: 70 2d 73 6f 63 6b 73 20 63 61 74 63 68 2d 6c 6f p-socks catch-lo
0e10: 6f 70 0a 20 20 20 20 31 2b 20 3f 64 75 70 2d 49 op. 1+ ?dup-I
0e20: 46 20 20 66 72 65 65 2d 69 6f 20 31 2d 20 3f 64 F free-io 1- ?d
0e30: 75 70 2d 49 46 20 20 44 6f 45 72 72 6f 72 20 20 up-IF DoError
0e40: 54 48 45 4e 0a 20 20 20 20 45 4c 53 45 20 20 7e THEN. ELSE ~
0e50: 7e 20 62 66 6c 75 73 68 20 30 20 28 62 79 65 29 ~ bflush 0 (bye)
0e60: 20 7e 7e 20 20 54 48 45 4e 20 3b 0a 3a 20 6e 65 ~~ THEN ;.: ne
0e70: 74 32 6f 2d 74 61 73 6b 20 28 20 70 61 72 61 6d t2o-task ( param
0e80: 73 20 78 74 20 6e 20 2d 2d 20 74 61 73 6b 20 29 s xt n -- task )
0e90: 0a 20 20 20 20 73 74 61 63 6b 73 69 7a 65 34 20 . stacksize4
0ea0: 4e 65 77 54 61 73 6b 34 20 64 75 70 20 3e 72 20 NewTask4 dup >r
0eb0: 6e 65 74 32 6f 2d 70 61 73 73 20 72 3e 20 3b 0a net2o-pass r> ;.
0ec0: 0a 56 61 72 69 61 62 6c 65 20 6b 69 6c 6c 73 0a .Variable kills.
0ed0: 65 76 65 6e 74 3a 20 3a 3e 6b 69 6c 6c 65 64 20 event: :>killed
0ee0: 28 20 2d 2d 20 29 20 20 2d 31 20 6b 69 6c 6c 73 ( -- ) -1 kills
0ef0: 20 2b 21 20 3b 0a 65 76 65 6e 74 3a 20 3a 3e 6b +! ;.event: :>k
0f00: 69 6c 6c 20 28 20 74 61 73 6b 20 2d 2d 20 29 0a ill ( task -- ).
0f10: 20 20 20 20 3c 65 76 65 6e 74 20 3a 3e 6b 69 6c <event :>kil
0f20: 6c 65 64 20 65 76 65 6e 74 3e 20 30 20 28 62 79 led event> 0 (by
0f30: 65 29 20 3b 0a 3a 20 73 65 6e 64 2d 6b 69 6c 6c e) ;.: send-kill
0f40: 20 28 20 74 61 73 6b 20 2d 2d 20 29 20 3c 65 76 ( task -- ) <ev
0f50: 65 6e 74 20 75 70 40 20 65 6c 69 74 2c 20 3a 3e ent up@ elit, :>
0f60: 6b 69 6c 6c 20 65 76 65 6e 74 3e 20 3b 0a 0a 32 kill event> ;..2
0f70: 20 43 6f 6e 73 74 61 6e 74 20 6b 69 6c 6c 2d 73 Constant kill-s
0f80: 65 63 6f 6e 64 73 23 0a 6b 69 6c 6c 2d 73 65 63 econds#.kill-sec
0f90: 6f 6e 64 73 23 20 31 2b 20 23 31 30 30 30 30 30 onds# 1+ #100000
0fa0: 30 30 30 30 20 75 6d 2a 20 32 63 6f 6e 73 74 61 0000 um* 2consta
0fb0: 6e 74 20 6b 69 6c 6c 2d 74 69 6d 65 6f 75 74 23 nt kill-timeout#
0fc0: 20 5c 20 33 73 0a 0a 3a 20 6e 65 74 32 6f 2d 6b \ 3s..: net2o-k
0fd0: 69 6c 6c 73 20 28 20 2d 2d 20 29 0a 20 20 20 20 ills ( -- ).
0fe0: 6e 65 74 32 6f 2d 74 61 73 6b 73 20 67 65 74 2d net2o-tasks get-
0ff0: 73 74 61 63 6b 20 6b 69 6c 6c 73 20 21 20 20 6e stack kills ! n
1000: 65 74 32 6f 2d 74 61 73 6b 73 20 24 66 72 65 65 et2o-tasks $free
1010: 0a 20 20 20 20 6b 69 6c 6c 73 20 40 20 30 20 3f . kills @ 0 ?
1020: 44 4f 20 20 73 65 6e 64 2d 6b 69 6c 6c 20 20 4c DO send-kill L
1030: 4f 4f 50 0a 20 20 20 20 6e 74 69 6d 65 20 6b 69 OOP. ntime ki
1040: 6c 6c 2d 74 69 6d 65 6f 75 74 23 20 64 2b 20 7b ll-timeout# d+ {
1050: 20 64 3a 20 74 69 6d 65 6f 75 74 20 7d 0a 20 20 d: timeout }.
1060: 20 20 6b 69 6c 6c 2d 73 65 63 6f 6e 64 73 23 20 kill-seconds#
1070: 3e 72 20 5c 20 67 69 76 65 20 74 69 6d 65 20 74 >r \ give time t
1080: 6f 20 74 65 72 6d 69 6e 61 74 65 0a 20 20 20 20 o terminate.
1090: 42 45 47 49 4e 20 20 74 69 6d 65 6f 75 74 20 6e BEGIN timeout n
10a0: 74 69 6d 65 20 64 2d 20 32 64 75 70 20 64 30 3e time d- 2dup d0>
10b0: 20 6b 69 6c 6c 73 20 40 20 61 6e 64 20 20 57 48 kills @ and WH
10c0: 49 4c 45 0a 09 20 20 20 20 73 74 6f 70 2d 64 6e ILE.. stop-dn
10d0: 73 0a 09 20 20 20 20 74 69 6d 65 6f 75 74 20 6e s.. timeout n
10e0: 74 69 6d 65 20 64 2d 20 31 30 30 30 30 30 30 30 time d- 10000000
10f0: 30 30 20 66 6d 2f 6d 6f 64 20 6e 69 70 0a 09 20 00 fm/mod nip..
1100: 20 20 20 64 75 70 20 72 3e 20 3c 3e 20 49 46 20 dup r> <> IF
1110: 20 27 2e 27 20 65 6d 69 74 20 20 54 48 45 4e 20 '.' emit THEN
1120: 20 3e 72 0a 20 20 20 20 52 45 50 45 41 54 0a 20 >r. REPEAT.
1130: 20 20 20 72 3e 20 6b 69 6c 6c 2d 73 65 63 6f 6e r> kill-secon
1140: 64 73 23 20 3c 3e 20 49 46 20 20 63 72 20 20 54 ds# <> IF cr T
1150: 48 45 4e 20 20 32 64 72 6f 70 20 3b 0a 0a 66 6f HEN 2drop ;..fo
1160: 72 77 61 72 64 20 21 73 61 76 65 2d 61 6c 6c 2d rward !save-all-
1170: 6d 73 67 73 0a 0a 30 20 77 61 72 6e 69 6e 67 73 msgs..0 warnings
1180: 20 21 40 0a 3a 20 62 79 65 20 20 21 73 61 76 65 !@.: bye !save
1190: 2d 61 6c 6c 2d 6d 73 67 73 20 6e 65 74 32 6f 2d -all-msgs net2o-
11a0: 6b 69 6c 6c 73 20 62 79 65 20 3b 0a 77 61 72 6e kills bye ;.warn
11b0: 69 6e 67 73 20 21 0a 0a 5c 20 70 61 63 6b 65 74 ings !..\ packet
11c0: 26 68 65 61 64 65 72 20 73 69 7a 65 0a 0a 5c 20 &header size..\
11d0: 54 68 65 20 66 69 72 73 74 20 62 79 74 65 20 69 The first byte i
11e0: 73 20 6f 72 67 61 6e 69 7a 65 64 20 69 6e 20 61 s organized in a
11f0: 20 77 61 79 20 74 68 61 74 20 77 6f 72 6b 73 20 way that works
1200: 6f 6e 20 77 69 72 65 64 2d 6f 72 20 62 75 73 73 on wired-or buss
1210: 65 73 2c 0a 5c 20 65 2e 67 2e 20 43 41 4e 20 62 es,.\ e.g. CAN b
1220: 75 73 2c 20 69 2e 65 2e 20 68 69 67 68 65 72 20 us, i.e. higher
1230: 70 72 69 6f 72 69 74 79 20 61 6e 64 20 73 6d 61 priority and sma
1240: 6c 6c 65 72 20 68 65 61 64 65 72 20 61 6e 64 20 ller header and
1250: 64 61 74 61 20 73 69 7a 65 0a 5c 20 77 69 6e 73 data size.\ wins
1260: 20 61 72 62 69 74 72 61 74 69 6f 6e 2e 20 20 55 arbitration. U
1270: 73 65 20 4d 53 42 20 66 69 72 73 74 2c 20 30 20 se MSB first, 0
1280: 61 73 20 64 6f 6d 69 6e 61 6e 74 20 62 69 74 2e as dominant bit.
1290: 0a 0a 24 30 30 20 43 6f 6e 73 74 61 6e 74 20 71 ..$00 Constant q
12a0: 6f 73 30 23 20 5c 20 68 69 67 68 65 73 74 20 70 os0# \ highest p
12b0: 72 69 6f 72 69 74 79 0a 24 34 30 20 43 6f 6e 73 riority.$40 Cons
12c0: 74 61 6e 74 20 71 6f 73 31 23 0a 24 38 30 20 43 tant qos1#.$80 C
12d0: 6f 6e 73 74 61 6e 74 20 71 6f 73 32 23 0a 24 43 onstant qos2#.$C
12e0: 30 20 43 6f 6e 73 74 61 6e 74 20 71 6f 73 33 23 0 Constant qos3#
12f0: 20 5c 20 6c 6f 77 65 73 74 0a 0a 24 33 30 20 43 \ lowest..$30 C
1300: 6f 6e 73 74 61 6e 74 20 68 65 61 64 65 72 73 69 onstant headersi
1310: 7a 65 23 0a 24 30 30 20 43 6f 6e 73 74 61 6e 74 ze#.$00 Constant
1320: 20 31 36 62 69 74 23 20 5c 20 70 72 6f 74 6f 63 16bit# \ protoc
1330: 6f 6c 20 66 6f 72 20 76 65 72 79 20 73 6d 61 6c ol for very smal
1340: 6c 20 6e 65 74 77 6f 72 6b 73 0a 24 31 30 20 43 l networks.$10 C
1350: 6f 6e 73 74 61 6e 74 20 36 34 62 69 74 23 20 5c onstant 64bit# \
1360: 20 73 74 61 6e 64 61 72 64 2c 20 65 6e 63 72 79 standard, encry
1370: 70 74 65 64 20 70 72 6f 74 6f 63 6f 6c 0a 24 30 pted protocol.$0
1380: 46 20 43 6f 6e 73 74 61 6e 74 20 64 61 74 61 73 F Constant datas
1390: 69 7a 65 23 0a 0a 43 72 65 61 74 65 20 68 65 61 ize#..Create hea
13a0: 64 65 72 2d 73 69 7a 65 73 20 20 24 30 36 20 63 der-sizes $06 c
13b0: 2c 20 24 31 61 20 63 2c 20 24 46 46 20 63 2c 20 , $1a c, $FF c,
13c0: 24 46 46 20 63 2c 0a 43 72 65 61 74 65 20 74 61 $FF c,.Create ta
13d0: 69 6c 2d 73 69 7a 65 73 20 20 20 20 24 30 30 20 il-sizes $00
13e0: 63 2c 20 24 31 30 20 63 2c 20 24 46 46 20 63 2c c, $10 c, $FF c,
13f0: 20 24 46 46 20 63 2c 0a 43 72 65 61 74 65 20 61 $FF c,.Create a
1400: 64 64 2d 73 69 7a 65 73 20 20 20 20 20 24 30 36 dd-sizes $06
1410: 20 63 2c 20 24 32 61 20 63 2c 20 24 46 46 20 63 c, $2a c, $FF c
1420: 2c 20 24 46 46 20 63 2c 0a 5c 20 77 65 20 64 6f , $FF c,.\ we do
1430: 6e 27 74 20 6b 6e 6f 77 20 74 68 65 20 68 65 61 n't know the hea
1440: 64 65 72 20 73 69 7a 65 73 20 6f 66 20 70 72 6f der sizes of pro
1450: 74 6f 63 6f 6c 73 20 32 20 61 6e 64 20 33 20 79 tocols 2 and 3 y
1460: 65 74 20 3b 2d 29 0a 0a 3a 20 68 65 61 64 65 72 et ;-)..: header
1470: 2d 73 69 7a 65 20 28 20 61 64 64 72 20 2d 2d 20 -size ( addr --
1480: 6e 20 29 20 20 63 40 20 68 65 61 64 65 72 73 69 n ) c@ headersi
1490: 7a 65 23 20 61 6e 64 20 34 20 72 73 68 69 66 74 ze# and 4 rshift
14a0: 20 68 65 61 64 65 72 2d 73 69 7a 65 73 20 2b 20 header-sizes +
14b0: 63 40 20 3b 0a 3a 20 74 61 69 6c 2d 73 69 7a 65 c@ ;.: tail-size
14c0: 20 28 20 61 64 64 72 20 2d 2d 20 6e 20 29 20 20 ( addr -- n )
14d0: 63 40 20 68 65 61 64 65 72 73 69 7a 65 23 20 61 c@ headersize# a
14e0: 6e 64 20 34 20 72 73 68 69 66 74 20 74 61 69 6c nd 4 rshift tail
14f0: 2d 73 69 7a 65 73 20 2b 20 63 40 20 3b 0a 3a 20 -sizes + c@ ;.:
1500: 61 64 64 2d 73 69 7a 65 20 28 20 61 64 64 72 20 add-size ( addr
1510: 2d 2d 20 6e 20 29 20 20 63 40 20 68 65 61 64 65 -- n ) c@ heade
1520: 72 73 69 7a 65 23 20 61 6e 64 20 34 20 72 73 68 rsize# and 4 rsh
1530: 69 66 74 20 61 64 64 2d 73 69 7a 65 73 20 2b 20 ift add-sizes +
1540: 63 40 20 3b 0a 3a 20 62 6f 64 79 2d 73 69 7a 65 c@ ;.: body-size
1550: 20 28 20 61 64 64 72 20 2d 2d 20 6e 20 29 20 6d ( addr -- n ) m
1560: 69 6e 2d 73 69 7a 65 20 73 77 61 70 20 63 40 20 in-size swap c@
1570: 64 61 74 61 73 69 7a 65 23 20 61 6e 64 20 6c 73 datasize# and ls
1580: 68 69 66 74 20 3b 0a 3a 20 70 61 63 6b 65 74 2d hift ;.: packet-
1590: 73 69 7a 65 20 28 20 61 64 64 72 20 2d 2d 20 6e size ( addr -- n
15a0: 20 29 0a 20 20 20 20 64 75 70 20 61 64 64 2d 73 ). dup add-s
15b0: 69 7a 65 20 73 77 61 70 20 62 6f 64 79 2d 73 69 ize swap body-si
15c0: 7a 65 20 2b 20 3b 0a 3a 20 70 61 63 6b 65 74 2d ze + ;.: packet-
15d0: 62 6f 64 79 20 28 20 61 64 64 72 20 2d 2d 20 61 body ( addr -- a
15e0: 64 64 72 20 29 0a 20 20 20 20 64 75 70 20 68 65 ddr ). dup he
15f0: 61 64 65 72 2d 73 69 7a 65 20 2b 20 3b 0a 3a 20 ader-size + ;.:
1600: 70 61 63 6b 65 74 2d 64 61 74 61 20 28 20 61 64 packet-data ( ad
1610: 64 72 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 dr -- addr u ).
1620: 20 20 20 3e 72 20 72 40 20 68 65 61 64 65 72 2d >r r@ header-
1630: 73 69 7a 65 20 72 40 20 2b 20 72 3e 20 62 6f 64 size r@ + r> bod
1640: 79 2d 73 69 7a 65 20 3b 0a 0a 61 64 64 2d 73 69 y-size ;..add-si
1650: 7a 65 73 20 31 2b 20 63 40 20 6d 69 6e 2d 73 69 zes 1+ c@ min-si
1660: 7a 65 20 2b 20 43 6f 6e 73 74 61 6e 74 20 6d 69 ze + Constant mi
1670: 6e 70 61 63 6b 65 74 23 0a 0a 5c 20 73 65 63 6f npacket#..\ seco
1680: 6e 64 20 62 79 74 65 20 63 6f 6e 73 74 61 6e 74 nd byte constant
1690: 73 0a 0a 24 38 30 20 43 6f 6e 73 74 61 6e 74 20 s..$80 Constant
16a0: 62 72 6f 61 64 63 61 73 74 69 6e 67 23 20 5c 20 broadcasting# \
16b0: 73 70 65 63 69 61 6c 20 66 6c 61 67 73 20 66 6f special flags fo
16c0: 72 20 73 77 69 74 63 68 65 73 0a 24 34 30 20 43 r switches.$40 C
16d0: 6f 6e 73 74 61 6e 74 20 6d 75 6c 74 69 63 61 73 onstant multicas
16e0: 74 69 6e 67 23 0a 0a 5c 20 24 33 30 20 43 6f 6e ting#..\ $30 Con
16f0: 73 74 61 6e 74 20 6e 65 74 32 6f 2d 72 65 73 65 stant net2o-rese
1700: 72 76 65 64 23 20 2d 20 73 68 6f 75 6c 64 20 62 rved# - should b
1710: 65 20 30 0a 0a 24 30 38 20 43 6f 6e 73 74 61 6e e 0..$08 Constan
1720: 74 20 73 74 61 74 65 6c 65 73 73 23 20 5c 20 73 t stateless# \ s
1730: 74 61 74 65 6c 65 73 73 20 6d 65 73 73 61 67 65 tateless message
1740: 0a 24 30 37 20 43 6f 6e 73 74 61 6e 74 20 61 63 .$07 Constant ac
1750: 6b 73 23 0a 24 30 31 20 43 6f 6e 73 74 61 6e 74 ks#.$01 Constant
1760: 20 61 63 6b 2d 74 6f 67 67 6c 65 23 0a 24 30 32 ack-toggle#.$02
1770: 20 43 6f 6e 73 74 61 6e 74 20 62 32 62 2d 74 6f Constant b2b-to
1780: 67 67 6c 65 23 0a 24 30 34 20 43 6f 6e 73 74 61 ggle#.$04 Consta
1790: 6e 74 20 72 65 73 65 6e 64 2d 74 6f 67 67 6c 65 nt resend-toggle
17a0: 23 0a 0a 5c 20 73 68 6f 72 74 20 70 61 63 6b 65 #..\ short packe
17b0: 74 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 0a 0a 3a t information..:
17c0: 20 2e 68 65 61 64 65 72 20 28 20 61 64 64 72 20 .header ( addr
17d0: 2d 2d 20 29 20 62 61 73 65 20 40 20 3e 72 20 68 -- ) base @ >r h
17e0: 65 78 0a 20 20 20 20 64 75 70 20 63 40 20 3e 72 ex. dup c@ >r
17f0: 0a 20 20 20 20 6d 69 6e 2d 73 69 7a 65 20 72 3e . min-size r>
1800: 20 64 61 74 61 73 69 7a 65 23 20 61 6e 64 20 6c datasize# and l
1810: 73 68 69 66 74 20 68 65 78 2e 20 2e 22 20 62 79 shift hex. ." by
1820: 74 65 73 20 74 6f 20 22 0a 20 20 20 20 6d 61 70 tes to ". map
1830: 61 64 64 72 20 6c 65 2d 36 34 40 20 75 36 34 2e addr le-64@ u64.
1840: 20 63 72 0a 20 20 20 20 72 3e 20 62 61 73 65 20 cr. r> base
1850: 21 20 3b 0a 0a 5c 20 65 61 63 68 20 73 6f 75 72 ! ;..\ each sour
1860: 63 65 20 68 61 73 20 6d 75 6c 74 69 70 6c 65 20 ce has multiple
1870: 64 65 73 74 69 6e 61 74 69 6f 6e 20 73 70 61 63 destination spac
1880: 65 73 0a 0a 36 34 55 73 65 72 20 64 65 73 74 2d es..64User dest-
1890: 61 64 64 72 0a 55 73 65 72 20 64 65 73 74 2d 66 addr.User dest-f
18a0: 6c 61 67 73 0a 0a 3a 20 3e 72 65 74 2d 61 64 64 lags..: >ret-add
18b0: 72 20 28 20 2d 2d 20 29 0a 20 20 20 20 69 6e 62 r ( -- ). inb
18c0: 75 66 20 64 65 73 74 69 6e 61 74 69 6f 6e 20 72 uf destination r
18d0: 65 74 75 72 6e 2d 61 64 64 72 20 72 65 76 65 72 eturn-addr rever
18e0: 73 65 24 31 36 20 3b 0a 3a 20 3e 64 65 73 74 2d se$16 ;.: >dest-
18f0: 61 64 64 72 20 28 20 2d 2d 20 29 0a 20 20 20 20 addr ( -- ).
1900: 69 6e 62 75 66 20 6d 61 70 61 64 64 72 20 6c 65 inbuf mapaddr le
1910: 2d 36 34 40 20 64 65 73 74 2d 61 64 64 72 20 36 -64@ dest-addr 6
1920: 34 21 0a 20 20 20 20 69 6e 62 75 66 20 68 64 72 4!. inbuf hdr
1930: 66 6c 61 67 73 20 6c 65 2d 75 77 40 20 64 65 73 flags le-uw@ des
1940: 74 2d 66 6c 61 67 73 20 6c 65 2d 77 21 20 3b 0a t-flags le-w! ;.
1950: 0a 5c 20 76 61 6c 69 64 61 74 69 6f 6e 20 73 74 .\ validation st
1960: 75 66 66 0a 0a 55 73 65 72 20 76 61 6c 69 64 61 uff..User valida
1970: 74 65 64 0a 0a 24 30 30 30 31 20 43 6f 6e 73 74 ted..$0001 Const
1980: 61 6e 74 20 63 72 79 70 74 2d 76 61 6c 0a 24 30 ant crypt-val.$0
1990: 30 30 32 20 43 6f 6e 73 74 61 6e 74 20 6f 77 6e 002 Constant own
19a0: 2d 63 72 79 70 74 2d 76 61 6c 0a 24 30 30 30 34 -crypt-val.$0004
19b0: 20 43 6f 6e 73 74 61 6e 74 20 6c 6f 67 69 6e 2d Constant login-
19c0: 76 61 6c 0a 24 30 30 30 38 20 43 6f 6e 73 74 61 val.$0008 Consta
19d0: 6e 74 20 63 6f 6f 6b 69 65 2d 76 61 6c 0a 24 30 nt cookie-val.$0
19e0: 30 31 30 20 43 6f 6e 73 74 61 6e 74 20 74 6d 70 010 Constant tmp
19f0: 2d 63 72 79 70 74 2d 76 61 6c 0a 24 30 30 32 30 -crypt-val.$0020
1a00: 20 43 6f 6e 73 74 61 6e 74 20 73 69 67 6e 65 64 Constant signed
1a10: 2d 76 61 6c 0a 24 30 30 34 30 20 43 6f 6e 73 74 -val.$0040 Const
1a20: 61 6e 74 20 6e 65 77 64 61 74 61 2d 76 61 6c 0a ant newdata-val.
1a30: 24 30 30 38 30 20 43 6f 6e 73 74 61 6e 74 20 6e $0080 Constant n
1a40: 65 77 63 6f 64 65 2d 76 61 6c 0a 24 30 31 30 30 ewcode-val.$0100
1a50: 20 43 6f 6e 73 74 61 6e 74 20 6b 65 79 70 61 69 Constant keypai
1a60: 72 2d 76 61 6c 0a 24 30 32 30 30 20 43 6f 6e 73 r-val.$0200 Cons
1a70: 74 61 6e 74 20 72 65 63 65 69 76 65 2d 76 61 6c tant receive-val
1a80: 0a 24 30 34 30 30 20 43 6f 6e 73 74 61 6e 74 20 .$0400 Constant
1a90: 69 76 73 2d 76 61 6c 0a 24 30 38 30 30 20 43 6f ivs-val.$0800 Co
1aa0: 6e 73 74 61 6e 74 20 71 72 2d 74 6d 70 2d 76 61 nstant qr-tmp-va
1ab0: 6c 0a 24 31 30 30 30 20 43 6f 6e 73 74 61 6e 74 l.$1000 Constant
1ac0: 20 65 6e 63 2d 63 72 79 70 74 2d 76 61 6c 0a 24 enc-crypt-val.$
1ad0: 32 30 30 30 20 43 6f 6e 73 74 61 6e 74 20 61 63 2000 Constant ac
1ae0: 6b 2d 6f 72 64 65 72 2d 76 61 6c 0a 24 34 30 30 k-order-val.$400
1af0: 30 20 43 6f 6e 73 74 61 6e 74 20 77 61 6c 6c 65 0 Constant walle
1b00: 74 2d 76 61 6c 0a 0a 24 31 30 20 43 6f 6e 73 74 t-val..$10 Const
1b10: 61 6e 74 20 76 61 6c 69 64 61 74 65 64 23 0a 0a ant validated#..
1b20: 3a 20 63 72 79 70 74 3f 20 20 20 20 20 28 20 2d : crypt? ( -
1b30: 2d 20 66 6c 61 67 20 29 20 20 76 61 6c 69 64 61 - flag ) valida
1b40: 74 65 64 20 40 20 63 72 79 70 74 2d 76 61 6c 20 ted @ crypt-val
1b50: 20 20 20 20 61 6e 64 20 3b 0a 3a 20 6f 77 6e 2d and ;.: own-
1b60: 63 72 79 70 74 3f 20 28 20 2d 2d 20 66 6c 61 67 crypt? ( -- flag
1b70: 20 29 20 20 76 61 6c 69 64 61 74 65 64 20 40 20 ) validated @
1b80: 6f 77 6e 2d 63 72 79 70 74 2d 76 61 6c 20 61 6e own-crypt-val an
1b90: 64 20 3b 0a 3a 20 6c 6f 67 69 6e 3f 20 20 20 20 d ;.: login?
1ba0: 20 28 20 2d 2d 20 66 6c 61 67 20 29 20 20 76 61 ( -- flag ) va
1bb0: 6c 69 64 61 74 65 64 20 40 20 6c 6f 67 69 6e 2d lidated @ login-
1bc0: 76 61 6c 20 20 20 20 20 61 6e 64 20 3b 0a 3a 20 val and ;.:
1bd0: 63 6f 6f 6b 69 65 3f 20 20 20 20 28 20 2d 2d 20 cookie? ( --
1be0: 66 6c 61 67 20 29 20 20 76 61 6c 69 64 61 74 65 flag ) validate
1bf0: 64 20 40 20 63 6f 6f 6b 69 65 2d 76 61 6c 20 20 d @ cookie-val
1c00: 20 20 61 6e 64 20 3b 0a 3a 20 74 6d 70 2d 63 72 and ;.: tmp-cr
1c10: 79 70 74 3f 20 28 20 2d 2d 20 66 6c 61 67 20 29 ypt? ( -- flag )
1c20: 20 20 76 61 6c 69 64 61 74 65 64 20 40 20 74 6d validated @ tm
1c30: 70 2d 63 72 79 70 74 2d 76 61 6c 20 61 6e 64 20 p-crypt-val and
1c40: 3b 0a 3a 20 73 69 67 6e 65 64 3f 20 20 20 20 28 ;.: signed? (
1c50: 20 2d 2d 20 66 6c 61 67 20 29 20 20 76 61 6c 69 -- flag ) vali
1c60: 64 61 74 65 64 20 40 20 73 69 67 6e 65 64 2d 76 dated @ signed-v
1c70: 61 6c 20 20 20 20 61 6e 64 20 3b 0a 3a 20 71 72 al and ;.: qr
1c80: 2d 63 72 79 70 74 3f 20 20 28 20 2d 2d 20 66 6c -crypt? ( -- fl
1c90: 61 67 20 29 20 20 76 61 6c 69 64 61 74 65 64 20 ag ) validated
1ca0: 40 20 71 72 2d 74 6d 70 2d 76 61 6c 20 20 20 20 @ qr-tmp-val
1cb0: 61 6e 64 20 3b 0a 3a 20 65 6e 63 2d 63 72 79 70 and ;.: enc-cryp
1cc0: 74 3f 20 28 20 2d 2d 20 66 6c 61 67 20 29 20 20 t? ( -- flag )
1cd0: 76 61 6c 69 64 61 74 65 64 20 40 20 65 6e 63 2d validated @ enc-
1ce0: 63 72 79 70 74 2d 76 61 6c 20 61 6e 64 20 3b 0a crypt-val and ;.
1cf0: 3a 20 61 63 6b 2d 6f 72 64 65 72 3f 20 28 20 2d : ack-order? ( -
1d00: 2d 20 66 6c 61 67 20 29 20 20 76 61 6c 69 64 61 - flag ) valida
1d10: 74 65 64 20 40 20 61 63 6b 2d 6f 72 64 65 72 2d ted @ ack-order-
1d20: 76 61 6c 20 61 6e 64 20 3b 0a 3a 20 21 21 77 61 val and ;.: !!wa
1d30: 6c 6c 65 74 3f 20 20 28 20 2d 2d 20 29 20 20 20 llet? ( -- )
1d40: 20 20 20 20 76 61 6c 69 64 61 74 65 64 20 40 20 validated @
1d50: 77 61 6c 6c 65 74 2d 76 61 6c 20 20 20 20 61 6e wallet-val an
1d60: 64 20 30 3d 20 21 21 77 61 6c 6c 65 74 21 21 20 d 0= !!wallet!!
1d70: 3b 0a 3a 20 21 21 73 69 67 6e 65 64 3f 20 20 28 ;.: !!signed? (
1d80: 20 2d 2d 20 29 20 73 69 67 6e 65 64 3f 20 30 3d -- ) signed? 0=
1d90: 20 21 21 75 6e 73 69 67 6e 65 64 21 21 20 3b 0a !!unsigned!! ;.
1da0: 3a 20 21 21 75 6e 73 69 67 6e 65 64 3f 20 20 28 : !!unsigned? (
1db0: 20 2d 2d 20 29 20 73 69 67 6e 65 64 3f 20 20 21 -- ) signed? !
1dc0: 21 73 69 67 6e 65 64 21 21 20 3b 0a 0a 5c 20 3a !signed!! ;..\ :
1dd0: 20 72 65 71 6d 61 73 6b 20 28 20 2d 2d 20 61 64 reqmask ( -- ad
1de0: 64 72 20 29 0a 5c 20 20 20 20 20 74 61 73 6b 23 dr ).\ task#
1df0: 20 40 20 72 65 71 6d 61 73 6b 5b 5d 20 24 5b 5d @ reqmask[] $[]
1e00: 20 3b 0a 0a 5c 20 65 76 65 6e 74 73 20 66 6f 72 ;..\ events for
1e10: 20 63 6f 6e 74 65 78 74 2d 6f 72 69 65 6e 74 65 context-oriente
1e20: 64 20 62 65 68 61 76 69 6f 72 0a 0a 44 65 66 65 d behavior..Defe
1e30: 72 20 64 6f 2d 63 6f 6e 6e 65 63 74 0a 44 65 66 r do-connect.Def
1e40: 65 72 20 64 6f 2d 64 69 73 63 6f 6e 6e 65 63 74 er do-disconnect
1e50: 0a 0a 65 76 65 6e 74 3a 20 3a 3e 63 6f 6e 6e 65 ..event: :>conne
1e60: 63 74 20 20 20 20 28 20 63 6f 6e 6e 65 63 74 69 ct ( connecti
1e70: 6f 6e 20 2d 2d 20 29 20 2e 64 6f 2d 63 6f 6e 6e on -- ) .do-conn
1e80: 65 63 74 20 3b 0a 0a 5c 20 63 68 65 63 6b 20 66 ect ;..\ check f
1e90: 6f 72 20 76 61 6c 69 64 20 64 65 73 74 69 6e 61 or valid destina
1ea0: 74 69 6f 6e 0a 0a 56 61 72 69 61 62 6c 65 20 64 tion..Variable d
1eb0: 65 73 74 2d 6d 61 70 20 73 22 20 22 20 64 65 73 est-map s" " des
1ec0: 74 2d 6d 61 70 20 24 21 0a 3a 6e 6f 6e 61 6d 65 t-map $!.:noname
1ed0: 20 64 65 66 65 72 73 20 27 63 6f 6c 64 20 61 6c defers 'cold al
1ee0: 6c 6f 63 2d 69 6f 20 64 65 73 74 2d 6d 61 70 20 loc-io dest-map
1ef0: 24 69 6e 69 74 20 3b 20 69 73 20 27 63 6f 6c 64 $init ; is 'cold
1f00: 0a 0a 24 31 30 30 20 56 61 6c 75 65 20 64 65 73 ..$100 Value des
1f10: 74 73 23 0a 35 36 20 56 61 6c 75 65 20 64 65 73 ts#.56 Value des
1f20: 74 73 3e 3e 0a 0a 3a 20 73 65 74 2d 64 65 73 74 ts>>..: set-dest
1f30: 73 23 20 28 20 62 69 74 73 20 2d 2d 20 29 0a 20 s# ( bits -- ).
1f40: 20 20 20 31 20 6f 76 65 72 20 6c 73 68 69 66 74 1 over lshift
1f50: 20 74 6f 20 64 65 73 74 73 23 0a 20 20 20 20 36 to dests#. 6
1f60: 34 20 73 77 61 70 20 2d 20 74 6f 20 64 65 73 74 4 swap - to dest
1f70: 73 3e 3e 0a 20 20 20 20 64 65 73 74 73 23 20 32 s>>. dests# 2
1f80: 2a 20 63 65 6c 6c 73 20 64 65 73 74 2d 6d 61 70 * cells dest-map
1f90: 20 24 21 6c 65 6e 0a 20 20 20 20 64 65 73 74 2d $!len. dest-
1fa0: 6d 61 70 20 24 40 20 65 72 61 73 65 20 3b 0a 0a map $@ erase ;..
1fb0: 38 20 73 65 74 2d 64 65 73 74 73 23 0a 0a 3a 20 8 set-dests#..:
1fc0: 3e 64 65 73 74 2d 6d 61 70 20 28 20 76 61 64 64 >dest-map ( vadd
1fd0: 72 20 2d 2d 20 61 64 64 72 20 29 0a 20 20 20 20 r -- addr ).
1fe0: 64 65 73 74 73 3e 3e 20 36 34 72 73 68 69 66 74 dests>> 64rshift
1ff0: 20 36 34 3e 6e 20 32 2a 20 63 65 6c 6c 73 20 64 64>n 2* cells d
2000: 65 73 74 2d 6d 61 70 20 24 40 20 64 72 6f 70 20 est-map $@ drop
2010: 2b 20 3b 0a 0a 73 63 6f 70 65 7b 20 6d 61 70 63 + ;..scope{ mapc
2020: 0a 0a 3a 20 3e 64 61 74 61 2d 68 65 61 64 20 28 ..: >data-head (
2030: 20 61 64 64 72 20 6f 3a 6d 61 70 20 2d 2d 20 66 addr o:map -- f
2040: 6c 61 67 20 29 20 20 64 65 73 74 2d 73 69 7a 65 lag ) dest-size
2050: 20 31 2d 20 3e 72 0a 20 20 20 20 64 75 70 20 64 1- >r. dup d
2060: 65 73 74 2d 62 61 63 6b 20 72 40 20 61 6e 64 20 est-back r@ and
2070: 75 3c 20 49 46 20 20 72 40 20 2b 20 31 2b 20 20 u< IF r@ + 1+
2080: 54 48 45 4e 0a 20 20 20 20 64 65 73 74 2d 62 61 THEN. dest-ba
2090: 63 6b 20 72 3e 20 69 6e 76 65 72 74 20 61 6e 64 ck r> invert and
20a0: 20 2b 20 5c 20 61 64 64 20 74 6f 74 61 6c 20 6f + \ add total o
20b0: 66 66 73 65 74 0a 20 20 20 20 6d 61 78 64 61 74 ffset. maxdat
20c0: 61 20 2b 20 20 20 20 20 20 20 20 20 20 20 20 20 a +
20d0: 20 20 20 20 20 20 5c 20 61 64 64 20 6f 6e 65 20 \ add one
20e0: 70 61 63 6b 65 74 20 73 69 7a 65 0a 20 20 20 20 packet size.
20f0: 64 75 70 20 61 64 64 72 20 64 65 73 74 2d 68 65 dup addr dest-he
2100: 61 64 20 75 6d 61 78 21 40 20 3c 3e 20 3b 0a 0a ad umax!@ <> ;..
2110: 3a 20 3e 6c 69 6e 65 61 72 20 28 20 61 64 64 72 : >linear ( addr
2120: 20 2d 2d 20 61 64 64 72 27 20 29 20 5c 20 6f 3a -- addr' ) \ o:
2130: 6d 61 70 0a 20 20 20 20 64 75 70 20 64 65 73 74 map. dup dest
2140: 2d 62 61 63 6b 20 64 65 73 74 2d 73 69 7a 65 20 -back dest-size
2150: 31 2d 20 61 6e 64 20 75 3c 20 64 65 73 74 2d 73 1- and u< dest-s
2160: 69 7a 65 20 61 6e 64 20 2b 0a 20 20 20 20 64 65 ize and +. de
2170: 73 74 2d 62 61 63 6b 20 64 65 73 74 2d 73 69 7a st-back dest-siz
2180: 65 20 6e 65 67 61 74 65 20 61 6e 64 20 2b 20 3b e negate and + ;
2190: 0a 0a 7d 73 63 6f 70 65 0a 0a 3a 20 64 65 73 74 ..}scope..: dest
21a0: 2d 69 6e 64 65 78 20 28 20 2d 2d 20 61 64 64 72 -index ( -- addr
21b0: 20 29 20 64 65 73 74 2d 61 64 64 72 20 36 34 40 ) dest-addr 64@
21c0: 20 3e 64 65 73 74 2d 6d 61 70 20 3b 0a 0a 3a 20 >dest-map ;..:
21d0: 63 68 65 63 6b 2d 64 65 73 74 20 28 20 73 69 7a check-dest ( siz
21e0: 65 20 2d 2d 20 61 64 64 72 20 6d 61 70 20 6f 3a e -- addr map o:
21f0: 6a 6f 62 20 2f 20 66 20 29 0a 20 20 20 20 5c 47 job / f ). \G
2200: 20 72 65 74 75 72 6e 20 66 61 6c 73 65 20 69 66 return false if
2210: 20 69 6e 76 61 6c 69 64 20 64 65 73 74 69 6e 61 invalid destina
2220: 74 69 6f 6e 0a 20 20 20 20 5c 47 20 72 65 74 75 tion. \G retu
2230: 72 6e 20 31 20 69 66 20 63 6f 64 65 2c 20 2d 31 rn 1 if code, -1
2240: 20 69 66 20 64 61 74 61 2c 20 70 6c 75 73 20 64 if data, plus d
2250: 65 73 74 69 6e 61 74 69 6f 6e 20 61 64 64 72 65 estination addre
2260: 73 73 0a 20 20 20 20 6e 65 67 61 74 65 20 5c 20 ss. negate \
2270: 67 65 6e 65 72 61 74 65 20 6d 61 73 6b 0a 20 20 generate mask.
2280: 20 20 64 65 73 74 2d 69 6e 64 65 78 20 32 20 63 dest-index 2 c
2290: 65 6c 6c 73 20 62 6f 75 6e 64 73 20 3f 44 4f 0a ells bounds ?DO.
22a0: 09 49 20 40 20 49 46 0a 09 20 20 20 20 64 75 70 .I @ IF.. dup
22b0: 20 64 65 73 74 2d 61 64 64 72 20 36 34 40 20 49 dest-addr 64@ I
22c0: 20 40 20 77 69 74 68 20 6d 61 70 63 0a 09 20 20 @ with mapc..
22d0: 20 20 64 65 73 74 2d 76 61 64 64 72 20 36 34 2d dest-vaddr 64-
22e0: 20 36 34 3e 6e 20 61 6e 64 20 64 75 70 0a 09 20 64>n and dup..
22f0: 20 20 20 64 65 73 74 2d 73 69 7a 65 20 75 3c 0a dest-size u<.
2300: 09 20 20 20 20 49 46 0a 09 09 64 75 70 20 61 64 . IF...dup ad
2310: 64 72 3e 62 69 74 73 20 61 63 6b 2d 62 69 74 23 dr>bits ack-bit#
2320: 20 21 0a 09 09 64 65 73 74 2d 72 61 64 64 72 20 !...dest-raddr
2330: 73 77 61 70 20 64 75 70 20 3e 64 61 74 61 2d 68 swap dup >data-h
2340: 65 61 64 20 74 6f 20 61 63 6b 2d 61 64 76 61 6e ead to ack-advan
2350: 63 65 3f 20 2b 0a 09 09 6f 20 70 61 72 65 6e 74 ce? +...o parent
2360: 20 6f 3e 20 3e 6f 20 72 64 72 6f 70 0a 09 09 55 o> >o rdrop...U
2370: 4e 4c 4f 4f 50 20 20 72 6f 74 20 64 72 6f 70 20 NLOOP rot drop
2380: 20 45 58 49 54 20 20 54 48 45 4e 0a 09 20 20 20 EXIT THEN..
2390: 20 64 72 6f 70 20 65 6e 64 77 69 74 68 0a 09 54 drop endwith..T
23a0: 48 45 4e 0a 20 20 20 20 63 65 6c 6c 20 2b 4c 4f HEN. cell +LO
23b0: 4f 50 0a 20 20 20 20 64 72 6f 70 20 66 61 6c 73 OP. drop fals
23c0: 65 20 3b 0a 0a 5c 20 63 6f 6e 74 65 78 74 20 64 e ;..\ context d
23d0: 65 62 75 67 67 69 6e 67 0a 0a 3a 20 2e 6f 20 28 ebugging..: .o (
23e0: 20 2d 2d 20 29 20 63 6f 6e 74 65 78 74 23 20 3f -- ) context# ?
23f0: 20 3b 0a 3a 20 6f 3f 20 28 20 2d 2d 20 29 20 5d ;.: o? ( -- ) ]
2400: 5d 20 6f 20 30 3d 20 3f 45 58 49 54 20 5b 5b 20 ] o 0= ?EXIT [[
2410: 3b 20 69 6d 6d 65 64 69 61 74 65 0a 0a 5c 20 44 ; immediate..\ D
2420: 65 73 74 69 6e 61 74 69 6f 6e 20 6d 61 70 70 69 estination mappi
2430: 6e 67 20 63 6f 6e 74 61 69 6e 73 0a 5c 20 61 64 ng contains.\ ad
2440: 64 72 20 75 20 2d 20 72 61 6e 67 65 20 6f 66 20 dr u - range of
2450: 76 69 72 74 61 6c 20 61 64 64 72 65 73 73 65 73 virtal addresses
2460: 0a 5c 20 61 64 64 72 27 20 2d 20 72 65 61 6c 20 .\ addr' - real
2470: 73 74 61 72 74 20 61 64 64 72 65 73 73 0a 5c 20 start address.\
2480: 63 6f 6e 74 65 78 74 20 2d 20 66 6f 72 20 65 78 context - for ex
2490: 65 63 20 72 65 67 69 6f 6e 73 2c 20 74 68 69 73 ec regions, this
24a0: 20 69 73 20 74 68 65 20 6a 6f 62 20 63 6f 6e 74 is the job cont
24b0: 65 78 74 0a 0a 55 73 65 72 20 3e 63 6f 64 65 2d ext..User >code-
24c0: 66 6c 61 67 0a 0a 73 63 6f 70 65 7b 20 6d 61 70 flag..scope{ map
24d0: 63 0a 0a 3a 20 61 6c 6c 6f 63 2d 64 61 74 61 20 c..: alloc-data
24e0: 28 20 61 64 64 72 20 75 20 2d 2d 20 75 20 29 0a ( addr u -- u ).
24f0: 20 20 20 20 64 75 70 20 3e 72 20 74 6f 20 64 65 dup >r to de
2500: 73 74 2d 73 69 7a 65 20 74 6f 20 64 65 73 74 2d st-size to dest-
2510: 76 61 64 64 72 20 72 3e 0a 20 20 20 20 64 75 70 vaddr r>. dup
2520: 20 61 6c 6c 6f 63 2b 67 75 61 72 64 20 74 6f 20 alloc+guard to
2530: 64 65 73 74 2d 72 61 64 64 72 0a 20 20 20 20 63 dest-raddr. c
2540: 3a 6b 65 79 23 20 63 72 79 70 74 2d 61 6c 69 67 :key# crypt-alig
2550: 6e 20 2b 20 61 6c 6c 6f 7a 20 61 64 64 72 20 64 n + alloz addr d
2560: 65 73 74 2d 69 76 73 67 65 6e 20 21 20 5c 20 21 est-ivsgen ! \ !
2570: 21 46 49 58 4d 45 21 21 20 73 68 6f 75 6c 64 20 !FIXME!! should
2580: 62 65 20 61 20 6b 61 6c 6c 6f 63 0a 20 20 20 20 be a kalloc.
2590: 3e 63 6f 64 65 2d 66 6c 61 67 20 40 0a 20 20 20 >code-flag @.
25a0: 20 49 46 0a 09 64 75 70 20 61 64 64 72 3e 72 65 IF..dup addr>re
25b0: 70 6c 69 65 73 20 20 61 6c 6c 6f 63 2b 67 75 61 plies alloc+gua
25c0: 72 64 20 74 6f 20 64 65 73 74 2d 72 65 70 6c 69 rd to dest-repli
25d0: 65 73 0a 09 33 20 74 6f 20 64 65 73 74 2d 69 76 es..3 to dest-iv
25e0: 73 6c 61 73 74 67 65 6e 0a 20 20 20 20 45 4c 53 slastgen. ELS
25f0: 45 0a 09 64 75 70 20 61 64 64 72 3e 74 73 20 20 E..dup addr>ts
2600: 20 20 20 20 20 61 6c 6c 6f 7a 20 74 6f 20 64 65 alloz to de
2610: 73 74 2d 74 69 6d 65 73 74 61 6d 70 73 0a 20 20 st-timestamps.
2620: 20 20 54 48 45 4e 20 3b 0a 0a 7d 73 63 6f 70 65 THEN ;..}scope
2630: 0a 0a 3a 20 70 61 72 65 6e 74 21 20 28 20 6f 20 ..: parent! ( o
2640: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 74 6f 20 -- ). dup to
2650: 70 61 72 65 6e 74 20 3f 64 75 70 2d 49 46 20 20 parent ?dup-IF
2660: 2e 6d 79 2d 6b 65 79 20 20 45 4c 53 45 20 20 6d .my-key ELSE m
2670: 79 2d 6b 65 79 2d 64 65 66 61 75 6c 74 20 20 54 y-key-default T
2680: 48 45 4e 20 20 74 6f 20 6d 79 2d 6b 65 79 20 3b HEN to my-key ;
2690: 0a 0a 3a 20 6d 61 70 2d 64 61 74 61 20 28 20 61 ..: map-data ( a
26a0: 64 64 72 20 75 20 2d 2d 20 6f 20 29 0a 20 20 20 ddr u -- o ).
26b0: 20 6f 20 3e 63 6f 64 65 2d 66 6c 61 67 20 40 20 o >code-flag @
26c0: 49 46 20 6d 61 70 63 3a 72 63 6f 64 65 2d 63 6c IF mapc:rcode-cl
26d0: 61 73 73 20 45 4c 53 45 20 6d 61 70 63 3a 72 64 ass ELSE mapc:rd
26e0: 61 74 61 2d 63 6c 61 73 73 20 54 48 45 4e 20 6e ata-class THEN n
26f0: 65 77 0a 20 20 20 20 77 69 74 68 20 6d 61 70 63 ew. with mapc
2700: 20 70 61 72 65 6e 74 21 0a 20 20 20 20 61 6c 6c parent!. all
2710: 6f 63 2d 64 61 74 61 0a 20 20 20 20 3e 63 6f 64 oc-data. >cod
2720: 65 2d 66 6c 61 67 20 40 20 30 3d 20 49 46 0a 09 e-flag @ 0= IF..
2730: 64 75 70 20 61 64 64 72 3e 62 79 74 65 73 20 61 dup addr>bytes a
2740: 6c 6c 6f 63 61 74 65 2d 62 69 74 73 20 64 61 74 llocate-bits dat
2750: 61 2d 61 63 6b 62 69 74 73 20 21 0a 20 20 20 20 a-ackbits !.
2760: 54 48 45 4e 0a 20 20 20 20 64 72 6f 70 0a 20 20 THEN. drop.
2770: 20 20 6f 20 65 6e 64 77 69 74 68 20 3b 0a 0a 3a o endwith ;..:
2780: 20 6d 61 70 2d 73 6f 75 72 63 65 20 28 20 61 64 map-source ( ad
2790: 64 72 20 75 20 61 64 64 72 78 20 2d 2d 20 6f 20 dr u addrx -- o
27a0: 29 0a 20 20 20 20 6f 20 3e 63 6f 64 65 2d 66 6c ). o >code-fl
27b0: 61 67 20 40 20 49 46 20 6d 61 70 63 3a 63 6f 64 ag @ IF mapc:cod
27c0: 65 2d 63 6c 61 73 73 20 45 4c 53 45 20 6d 61 70 e-class ELSE map
27d0: 63 3a 64 61 74 61 2d 63 6c 61 73 73 20 54 48 45 c:data-class THE
27e0: 4e 20 6e 65 77 0a 20 20 20 20 77 69 74 68 20 6d N new. with m
27f0: 61 70 63 20 70 61 72 65 6e 74 21 0a 20 20 20 20 apc parent!.
2800: 61 6c 6c 6f 63 2d 64 61 74 61 0a 20 20 20 20 3e alloc-data. >
2810: 63 6f 64 65 2d 66 6c 61 67 20 40 20 30 3d 20 49 code-flag @ 0= I
2820: 46 0a 09 64 75 70 20 61 64 64 72 3e 74 73 20 61 F..dup addr>ts a
2830: 6c 6c 6f 31 20 64 61 74 61 2d 72 65 73 65 6e 64 llo1 data-resend
2840: 23 20 21 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 # !. THEN.
2850: 20 64 72 6f 70 0a 20 20 20 20 6f 20 65 6e 64 77 drop. o endw
2860: 69 74 68 20 3b 0a 0a 3a 20 6d 61 70 2d 64 61 74 ith ;..: map-dat
2870: 61 2d 64 65 73 74 20 28 20 76 61 64 64 72 20 75 a-dest ( vaddr u
2880: 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 3e addr -- ). >
2890: 72 20 3e 72 20 36 34 64 75 70 20 72 3e 20 6d 61 r >r 64dup r> ma
28a0: 70 2d 64 61 74 61 20 72 40 20 21 20 3e 64 65 73 p-data r@ ! >des
28b0: 74 2d 6d 61 70 20 72 3e 20 40 20 73 77 61 70 20 t-map r> @ swap
28c0: 21 20 3b 0a 3a 20 6d 61 70 2d 63 6f 64 65 2d 64 ! ;.: map-code-d
28d0: 65 73 74 20 28 20 76 61 64 64 72 20 75 20 61 64 est ( vaddr u ad
28e0: 64 72 20 2d 2d 20 29 0a 20 20 20 20 3e 72 20 3e dr -- ). >r >
28f0: 72 20 36 34 64 75 70 20 72 3e 20 6d 61 70 2d 64 r 64dup r> map-d
2900: 61 74 61 20 72 40 20 21 20 3e 64 65 73 74 2d 6d ata r@ ! >dest-m
2910: 61 70 20 63 65 6c 6c 2b 20 72 3e 20 40 20 73 77 ap cell+ r> @ sw
2920: 61 70 20 21 20 3b 0a 0a 5c 20 63 72 65 61 74 65 ap ! ;..\ create
2930: 20 63 6f 6e 74 65 78 74 0a 0a 38 20 56 61 6c 75 context..8 Valu
2940: 65 20 62 75 72 73 74 73 23 20 5c 20 6e 75 6d 62 e bursts# \ numb
2950: 65 72 20 6f 66 20 0a 38 20 56 61 6c 75 65 20 64 er of .8 Value d
2960: 65 6c 74 61 2d 64 61 6d 70 23 20 5c 20 66 6f 72 elta-damp# \ for
2970: 20 63 6c 6f 63 6b 73 20 77 69 74 68 20 61 20 73 clocks with a s
2980: 6c 69 67 68 74 20 64 72 69 66 74 0a 62 75 72 73 light drift.burs
2990: 74 73 23 20 32 2a 20 32 2a 20 31 2d 20 56 61 6c ts# 2* 2* 1- Val
29a0: 75 65 20 74 69 63 6b 2d 69 6e 69 74 20 5c 20 74 ue tick-init \ t
29b0: 69 63 6b 73 20 77 69 74 68 6f 75 74 20 61 63 6b icks without ack
29c0: 0a 23 31 30 30 30 30 30 30 20 6d 61 78 2d 73 69 .#1000000 max-si
29d0: 7a 65 5e 32 20 6c 73 68 69 66 74 20 56 61 6c 75 ze^2 lshift Valu
29e0: 65 20 62 61 6e 64 77 69 64 74 68 2d 69 6e 69 74 e bandwidth-init
29f0: 20 5c 20 33 32 c2 b5 73 2f 62 75 72 73 74 3d 32 \ 32µs/burst=2
2a00: 4d 42 2f 73 0a 23 32 30 30 30 20 6d 61 78 2d 73 MB/s.#2000 max-s
2a10: 69 7a 65 5e 32 20 6c 73 68 69 66 74 20 56 61 6c ize^2 lshift Val
2a20: 75 65 20 62 61 6e 64 77 69 64 74 68 2d 6d 61 78 ue bandwidth-max
2a30: 0a 36 34 23 2d 31 20 36 34 43 6f 6e 73 74 61 6e .64#-1 64Constan
2a40: 74 20 6e 65 76 65 72 0a 32 20 56 61 6c 75 65 20 t never.2 Value
2a50: 66 6c 79 62 75 72 73 74 73 23 0a 24 31 30 30 20 flybursts#.$100
2a60: 56 61 6c 75 65 20 66 6c 79 62 75 72 73 74 73 2d Value flybursts-
2a70: 6d 61 78 23 0a 24 32 30 20 63 65 6c 6c 73 20 56 max#.$20 cells V
2a80: 61 6c 75 65 20 72 65 73 65 6e 64 2d 73 69 7a 65 alue resend-size
2a90: 23 0a 23 35 30 2e 30 30 30 2e 30 30 30 20 64 3e #.#50.000.000 d>
2aa0: 36 34 20 36 34 43 6f 6e 73 74 61 6e 74 20 69 6e 64 64Constant in
2ab0: 69 74 2d 64 65 6c 61 79 23 20 5c 20 35 30 6d 73 it-delay# \ 50ms
2ac0: 20 69 6e 69 74 69 61 6c 20 74 69 6d 65 6f 75 74 initial timeout
2ad0: 20 73 74 65 70 0a 23 36 30 2e 30 30 30 2e 30 30 step.#60.000.00
2ae0: 30 2e 30 30 30 20 64 3e 36 34 20 36 34 43 6f 6e 0.000 d>64 64Con
2af0: 73 74 61 6e 74 20 63 6f 6e 6e 65 63 74 2d 74 69 stant connect-ti
2b00: 6d 65 6f 75 74 23 20 5c 20 36 30 73 20 63 6f 6e meout# \ 60s con
2b10: 6e 65 63 74 20 74 69 6d 65 6f 75 74 0a 0a 56 61 nect timeout..Va
2b20: 72 69 61 62 6c 65 20 69 6e 69 74 2d 63 6f 6e 74 riable init-cont
2b30: 65 78 74 23 0a 68 61 73 68 3a 20 6d 73 67 2d 67 ext#.hash: msg-g
2b40: 72 6f 75 70 23 20 28 20 68 61 73 68 20 66 6f 72 roup# ( hash for
2b50: 20 67 72 6f 75 70 20 6f 62 6a 65 63 74 73 20 29 group objects )
2b60: 0a 55 56 61 6c 75 65 20 6d 73 67 2d 67 72 6f 75 .UValue msg-grou
2b70: 70 2d 6f 0a 55 56 61 6c 75 65 20 63 6f 6e 6e 65 p-o.UValue conne
2b80: 63 74 69 6f 6e 0a 0a 69 6e 20 6e 65 74 32 6f 20 ction..in net2o
2b90: 3a 20 6e 65 77 2d 6c 6f 67 20 28 20 2d 2d 20 6f : new-log ( -- o
2ba0: 20 29 0a 20 20 20 20 63 6d 64 2d 63 6c 61 73 73 ). cmd-class
2bb0: 20 6e 65 77 20 3e 6f 20 20 6c 6f 67 2d 74 61 62 new >o log-tab
2bc0: 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 le @ token-table
2bd0: 20 21 20 6f 20 6f 3e 20 3b 0a 69 6e 20 6e 65 74 ! o o> ;.in net
2be0: 32 6f 20 3a 20 6e 65 77 2d 61 63 6b 20 28 20 2d 2o : new-ack ( -
2bf0: 2d 20 6f 20 29 0a 20 20 20 20 6f 20 61 63 6b 2d - o ). o ack-
2c00: 63 6c 61 73 73 20 6e 65 77 20 3e 6f 20 20 70 61 class new >o pa
2c10: 72 65 6e 74 21 20 20 61 63 6b 2d 74 61 62 6c 65 rent! ack-table
2c20: 20 40 20 74 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 @ token-table !
2c30: 0a 20 20 20 20 69 6e 69 74 2d 64 65 6c 61 79 23 . init-delay#
2c40: 20 72 74 64 65 6c 61 79 20 36 34 21 0a 20 20 20 rtdelay 64!.
2c50: 20 66 6c 79 62 75 72 73 74 73 23 20 64 75 70 20 flybursts# dup
2c60: 66 6c 79 62 75 72 73 74 73 20 21 20 66 6c 79 62 flybursts ! flyb
2c70: 75 72 73 74 20 21 0a 20 20 20 20 74 69 63 6b 73 urst !. ticks
2c80: 20 6c 61 73 74 61 63 6b 20 36 34 21 20 5c 20 61 lastack 64! \ a
2c90: 73 6b 69 6e 67 20 66 6f 72 20 63 6f 6e 74 65 78 sking for contex
2ca0: 74 20 63 72 65 61 74 69 6f 6e 20 69 73 20 61 73 t creation is as
2cb0: 20 67 6f 6f 64 20 61 73 20 61 6e 20 61 63 6b 0a good as an ack.
2cc0: 20 20 20 20 62 61 6e 64 77 69 64 74 68 2d 69 6e bandwidth-in
2cd0: 69 74 20 6e 3e 36 34 20 6e 73 2f 62 75 72 73 74 it n>64 ns/burst
2ce0: 20 36 34 21 0a 20 20 20 20 6e 65 76 65 72 20 20 64!. never
2cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 nex
2d00: 74 2d 74 69 63 6b 20 36 34 21 0a 20 20 20 20 36 t-tick 64!. 6
2d10: 34 23 30 20 20 20 20 20 20 20 20 20 20 20 20 20 4#0
2d20: 20 20 20 65 78 74 72 61 2d 6e 73 20 36 34 21 0a extra-ns 64!.
2d30: 20 20 20 20 6d 61 78 2d 69 6e 74 36 34 20 36 34 max-int64 64
2d40: 2d 32 2f 20 6d 69 6e 2d 73 6c 61 63 6b 20 36 34 -2/ min-slack 64
2d50: 21 0a 20 20 20 20 6d 61 78 2d 69 6e 74 36 34 20 !. max-int64
2d60: 36 34 2d 32 2f 20 36 34 6e 65 67 61 74 65 20 6d 64-2/ 64negate m
2d70: 61 78 2d 73 6c 61 63 6b 20 36 34 21 0a 20 20 20 ax-slack 64!.
2d80: 20 6f 20 6f 3e 20 3b 0a 3a 20 61 63 6b 40 20 28 o o> ;.: ack@ (
2d90: 20 2d 2d 20 6f 20 29 0a 20 20 20 20 61 63 6b 2d -- o ). ack-
2da0: 63 6f 6e 74 65 78 74 20 40 20 3f 64 75 70 2d 30 context @ ?dup-0
2db0: 3d 2d 49 46 20 20 6e 65 74 32 6f 3a 6e 65 77 2d =-IF net2o:new-
2dc0: 61 63 6b 20 64 75 70 20 61 63 6b 2d 63 6f 6e 74 ack dup ack-cont
2dd0: 65 78 74 20 21 20 20 54 48 45 4e 20 3b 0a 73 63 ext ! THEN ;.sc
2de0: 6f 70 65 7b 20 6e 65 74 32 6f 0a 3a 20 6e 65 77 ope{ net2o.: new
2df0: 2d 74 6d 73 67 20 28 20 2d 2d 20 6f 20 29 0a 20 -tmsg ( -- o ).
2e00: 20 20 20 6f 20 6d 73 67 2d 63 6c 61 73 73 20 6e o msg-class n
2e10: 65 77 20 3e 6f 20 20 70 61 72 65 6e 74 21 20 20 ew >o parent!
2e20: 6d 73 67 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 msg-table @ toke
2e30: 6e 2d 74 61 62 6c 65 20 21 20 6f 20 6f 3e 20 3b n-table ! o o> ;
2e40: 0a 3a 20 6e 65 77 2d 6d 73 67 69 6e 67 20 28 20 .: new-msging (
2e50: 2d 2d 20 6f 20 29 0a 20 20 20 20 6f 20 6d 73 67 -- o ). o msg
2e60: 69 6e 67 2d 63 6c 61 73 73 20 6e 65 77 20 3e 6f ing-class new >o
2e70: 20 20 70 61 72 65 6e 74 21 20 20 6d 73 67 69 6e parent! msgin
2e80: 67 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e 2d g-table @ token-
2e90: 74 61 62 6c 65 20 21 20 6f 20 6f 3e 20 3b 0a 64 table ! o o> ;.d
2ea0: 65 66 65 72 20 6e 65 77 2d 6d 73 67 20 20 27 20 efer new-msg '
2eb0: 6e 65 77 2d 74 6d 73 67 20 69 73 20 6e 65 77 2d new-tmsg is new-
2ec0: 6d 73 67 0a 7d 73 63 6f 70 65 0a 20 20 20 20 0a msg.}scope. .
2ed0: 3a 20 6e 6f 2d 74 69 6d 65 6f 75 74 20 28 20 2d : no-timeout ( -
2ee0: 2d 20 29 20 20 6d 61 78 2d 69 6e 74 36 34 20 6e - ) max-int64 n
2ef0: 65 78 74 2d 74 69 6d 65 6f 75 74 20 36 34 21 0a ext-timeout 64!.
2f00: 20 20 20 20 61 63 6b 2d 63 6f 6e 74 65 78 74 20 ack-context
2f10: 40 20 3f 64 75 70 2d 49 46 20 20 2e 74 69 6d 65 @ ?dup-IF .time
2f20: 6f 75 74 73 20 6f 66 66 20 20 54 48 45 4e 20 3b outs off THEN ;
2f30: 0a 0a 3a 20 2d 66 6c 6f 77 2d 63 6f 6e 74 72 6f ..: -flow-contro
2f40: 6c 20 5b 27 5d 20 6e 6f 6f 70 20 69 73 20 61 63 l ['] noop is ac
2f50: 6b 2d 78 74 20 3b 0a 0a 36 34 55 73 65 72 20 74 k-xt ;..64User t
2f60: 69 63 6b 65 72 0a 36 34 55 73 65 72 20 63 6f 6e icker.64User con
2f70: 74 65 78 74 2d 74 69 63 6b 65 72 20 20 36 34 23 text-ticker 64#
2f80: 30 20 63 6f 6e 74 65 78 74 2d 74 69 63 6b 65 72 0 context-ticker
2f90: 20 36 34 21 0a 0a 3a 20 72 74 64 65 6c 61 79 21 64!..: rtdelay!
2fa0: 20 28 20 74 69 6d 65 20 2d 2d 20 29 0a 20 20 20 ( time -- ).
2fb0: 20 74 69 6d 65 6f 75 74 73 20 40 20 49 46 20 5c timeouts @ IF \
2fc0: 20 64 6f 6e 27 74 20 75 70 64 61 74 65 20 72 74 don't update rt
2fd0: 64 65 6c 61 79 20 69 66 20 74 68 65 72 65 20 77 delay if there w
2fe0: 65 72 65 20 74 69 6d 65 6f 75 74 73 0a 09 72 74 ere timeouts..rt
2ff0: 64 65 6c 61 79 20 36 34 40 20 69 6e 69 74 2d 64 delay 64@ init-d
3000: 65 6c 61 79 23 20 36 34 3c 3e 20 49 46 20 20 36 elay# 64<> IF 6
3010: 34 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4drop EXIT THE
3020: 4e 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 72 N. THEN. r
3030: 65 63 76 2d 74 69 63 6b 20 36 34 40 20 36 34 73 ecv-tick 64@ 64s
3040: 77 61 70 20 36 34 2d 0a 20 20 20 20 72 74 64 28 wap 64-. rtd(
3050: 20 2e 22 20 72 74 64 65 6c 61 79 3a 20 22 20 36 ." rtdelay: " 6
3060: 34 64 75 70 20 36 34 3e 66 20 2e 6e 73 20 63 72 4dup 64>f .ns cr
3070: 20 29 20 72 74 64 65 6c 61 79 20 36 34 21 20 3b ) rtdelay 64! ;
3080: 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 6e 65 77 ..in net2o : new
3090: 2d 63 6f 6e 74 65 78 74 20 28 20 2d 2d 20 6f 20 -context ( -- o
30a0: 29 0a 20 20 20 20 63 6f 6e 74 65 78 74 2d 63 6c ). context-cl
30b0: 61 73 73 20 6e 65 77 20 3e 6f 20 74 69 6d 65 6f ass new >o timeo
30c0: 75 74 28 20 2e 22 20 6e 65 77 20 63 6f 6e 74 65 ut( ." new conte
30d0: 78 74 3a 20 22 20 6f 20 68 65 78 2e 20 63 72 20 xt: " o hex. cr
30e0: 29 0a 20 20 20 20 6d 79 2d 6b 65 79 2d 64 65 66 ). my-key-def
30f0: 61 75 6c 74 20 74 6f 20 6d 79 2d 6b 65 79 20 5c ault to my-key \
3100: 20 73 65 74 20 64 65 66 61 75 6c 74 20 6b 65 79 set default key
3110: 0a 20 20 20 20 6f 20 63 6f 6e 74 65 78 74 73 20 . o contexts
3120: 21 40 20 6e 65 78 74 2d 63 6f 6e 74 65 78 74 20 !@ next-context
3130: 21 0a 20 20 20 20 6f 20 74 6f 20 63 6f 6e 6e 65 !. o to conne
3140: 63 74 69 6f 6e 20 5c 20 63 75 72 72 65 6e 74 20 ction \ current
3150: 63 6f 6e 6e 65 63 74 69 6f 6e 0a 20 20 20 20 63 connection. c
3160: 6f 6e 74 65 78 74 2d 74 61 62 6c 65 20 40 20 74 ontext-table @ t
3170: 6f 6b 65 6e 2d 74 61 62 6c 65 20 21 20 5c 20 63 oken-table ! \ c
3180: 6f 70 79 20 70 6f 69 6e 74 65 72 0a 20 20 20 20 opy pointer.
3190: 69 6e 69 74 2d 63 6f 6e 74 65 78 74 23 20 40 20 init-context# @
31a0: 63 6f 6e 74 65 78 74 23 20 21 20 20 31 20 69 6e context# ! 1 in
31b0: 69 74 2d 63 6f 6e 74 65 78 74 23 20 2b 21 0a 20 it-context# +!.
31c0: 20 20 20 72 65 74 75 72 6e 2d 61 64 64 72 20 72 return-addr r
31d0: 65 74 75 72 6e 2d 61 64 64 72 65 73 73 20 24 31 eturn-address $1
31e0: 30 20 6d 6f 76 65 0a 20 20 20 20 5b 27 5d 20 6e 0 move. ['] n
31f0: 6f 2d 74 69 6d 65 6f 75 74 20 69 73 20 74 69 6d o-timeout is tim
3200: 65 6f 75 74 2d 78 74 20 5b 27 5d 20 2e 69 70 65 eout-xt ['] .ipe
3210: 72 72 20 69 73 20 73 65 74 69 70 2d 78 74 0a 20 rr is setip-xt.
3220: 20 20 20 5b 27 5d 20 6e 6f 6f 70 20 69 73 20 70 ['] noop is p
3230: 75 6e 63 68 2d 64 6f 6e 65 2d 78 74 20 5b 27 5d unch-done-xt [']
3240: 20 6e 6f 6f 70 20 69 73 20 73 79 6e 63 2d 64 6f noop is sync-do
3250: 6e 65 2d 78 74 0a 20 20 20 20 5b 27 5d 20 6e 6f ne-xt. ['] no
3260: 6f 70 20 69 73 20 73 79 6e 63 2d 6e 6f 6e 65 2d op is sync-none-
3270: 78 74 20 20 5b 27 5d 20 6e 6f 6f 70 20 69 73 20 xt ['] noop is
3280: 61 63 6b 2d 78 74 0a 20 20 20 20 2d 66 6c 6f 77 ack-xt. -flow
3290: 2d 63 6f 6e 74 72 6f 6c 0a 20 20 20 20 2d 31 20 -control. -1
32a0: 62 6c 6f 63 6b 73 69 7a 65 20 21 0a 20 20 20 20 blocksize !.
32b0: 31 20 62 6c 6f 63 6b 61 6c 69 67 6e 20 21 0a 20 1 blockalign !.
32c0: 20 20 20 63 6f 6e 66 69 67 3a 74 69 6d 65 6f 75 config:timeou
32d0: 74 73 23 20 40 20 74 6f 20 6d 61 78 2d 74 69 6d ts# @ to max-tim
32e0: 65 6f 75 74 73 0a 20 20 20 20 65 6e 64 2d 73 65 eouts. end-se
32f0: 6d 61 73 20 73 74 61 72 74 2d 73 65 6d 61 73 20 mas start-semas
3300: 44 4f 20 20 49 20 30 20 70 74 68 72 65 61 64 5f DO I 0 pthread_
3310: 6d 75 74 65 78 5f 69 6e 69 74 20 64 72 6f 70 0a mutex_init drop.
3320: 20 20 20 20 31 20 70 74 68 72 65 61 64 2d 6d 75 1 pthread-mu
3330: 74 65 78 65 73 20 2b 4c 4f 4f 50 0a 20 20 20 20 texes +LOOP.
3340: 36 34 23 30 20 63 6f 6e 74 65 78 74 2d 74 69 63 64#0 context-tic
3350: 6b 65 72 20 36 34 21 40 20 36 34 64 75 70 20 36 ker 64!@ 64dup 6
3360: 34 23 30 20 36 34 3c 3e 20 49 46 0a 09 61 63 6b 4#0 64<> IF..ack
3370: 40 20 3e 6f 20 74 69 63 6b 65 72 20 36 34 40 20 @ >o ticker 64@
3380: 72 65 63 76 2d 74 69 63 6b 20 36 34 21 20 72 74 recv-tick 64! rt
3390: 64 65 6c 61 79 21 20 6f 3e 20 20 45 4c 53 45 20 delay! o> ELSE
33a0: 20 36 34 64 72 6f 70 20 20 54 48 45 4e 0a 20 20 64drop THEN.
33b0: 20 20 6f 20 6f 3e 20 3b 0a 0a 3a 20 72 65 74 2d o o> ;..: ret-
33c0: 61 64 64 72 20 28 20 2d 2d 20 61 64 64 72 20 29 addr ( -- addr )
33d0: 20 6f 20 49 46 20 20 72 65 74 75 72 6e 2d 61 64 o IF return-ad
33e0: 64 72 65 73 73 20 20 45 4c 53 45 20 20 72 65 74 dress ELSE ret
33f0: 75 72 6e 2d 61 64 64 72 20 20 54 48 45 4e 20 3b urn-addr THEN ;
3400: 0a 0a 5c 20 63 72 65 61 74 65 20 6e 65 77 20 6d ..\ create new m
3410: 61 70 73 0a 0a 56 61 72 69 61 62 6c 65 20 6d 61 aps..Variable ma
3420: 70 73 74 61 72 74 20 24 31 20 6d 61 70 73 74 61 pstart $1 mapsta
3430: 72 74 20 21 0a 0a 3a 20 72 65 74 30 20 28 20 2d rt !..: ret0 ( -
3440: 2d 20 29 20 72 65 74 75 72 6e 2d 61 64 64 72 20 - ) return-addr
3450: 24 31 30 20 65 72 61 73 65 20 3b 0a 3a 20 73 65 $10 erase ;.: se
3460: 74 75 70 21 20 28 20 2d 2d 20 29 20 20 20 73 65 tup! ( -- ) se
3470: 74 75 70 2d 74 61 62 6c 65 20 40 20 74 6f 6b 65 tup-table @ toke
3480: 6e 2d 74 61 62 6c 65 20 21 20 20 72 65 74 30 20 n-table ! ret0
3490: 3b 0a 3a 20 63 6f 6e 74 65 78 74 21 20 28 20 2d ;.: context! ( -
34a0: 2d 20 29 0a 20 20 20 20 63 6f 6e 74 65 78 74 2d - ). context-
34b0: 74 61 62 6c 65 20 40 20 74 6f 6b 65 6e 2d 74 61 table @ token-ta
34c0: 62 6c 65 20 21 0a 20 20 20 20 3c 65 76 65 6e 74 ble !. <event
34d0: 20 77 61 69 74 2d 74 61 73 6b 20 40 20 6d 61 69 wait-task @ mai
34e0: 6e 2d 75 70 40 20 6f 76 65 72 20 73 65 6c 65 63 n-up@ over selec
34f0: 74 20 6f 20 65 6c 69 74 2c 20 3a 3e 63 6f 6e 6e t o elit, :>conn
3500: 65 63 74 20 65 76 65 6e 74 3e 20 3b 0a 0a 3a 20 ect event> ;..:
3510: 6e 65 77 2d 63 6f 64 65 40 20 28 20 2d 2d 20 61 new-code@ ( -- a
3520: 64 64 72 73 20 61 64 64 72 64 20 75 20 2d 2d 20 ddrs addrd u --
3530: 29 0a 20 20 20 20 6e 65 77 2d 63 6f 64 65 2d 73 ). new-code-s
3540: 20 36 34 40 20 6e 65 77 2d 63 6f 64 65 2d 64 20 64@ new-code-d
3550: 36 34 40 20 6e 65 77 2d 63 6f 64 65 2d 73 69 7a 64@ new-code-siz
3560: 65 20 40 20 3b 0a 3a 20 6e 65 77 2d 63 6f 64 65 e @ ;.: new-code
3570: 21 20 28 20 61 64 64 72 73 20 61 64 64 72 64 20 ! ( addrs addrd
3580: 75 20 2d 2d 20 29 0a 20 20 20 20 6e 65 77 2d 63 u -- ). new-c
3590: 6f 64 65 2d 73 69 7a 65 20 21 20 6e 65 77 2d 63 ode-size ! new-c
35a0: 6f 64 65 2d 64 20 36 34 21 20 6e 65 77 2d 63 6f ode-d 64! new-co
35b0: 64 65 2d 73 20 36 34 21 20 6e 65 77 63 6f 64 65 de-s 64! newcode
35c0: 2d 76 61 6c 20 76 61 6c 69 64 61 74 65 64 20 6f -val validated o
35d0: 72 21 20 3b 0a 3a 20 6e 65 77 2d 64 61 74 61 40 r! ;.: new-data@
35e0: 20 28 20 2d 2d 20 61 64 64 72 73 20 61 64 64 72 ( -- addrs addr
35f0: 64 20 75 20 2d 2d 20 29 0a 20 20 20 20 6e 65 77 d u -- ). new
3600: 2d 64 61 74 61 2d 73 20 36 34 40 20 6e 65 77 2d -data-s 64@ new-
3610: 64 61 74 61 2d 64 20 36 34 40 20 6e 65 77 2d 64 data-d 64@ new-d
3620: 61 74 61 2d 73 69 7a 65 20 40 20 3b 0a 3a 20 6e ata-size @ ;.: n
3630: 65 77 2d 64 61 74 61 21 20 28 20 61 64 64 72 73 ew-data! ( addrs
3640: 20 61 64 64 72 64 20 75 20 2d 2d 20 29 0a 20 20 addrd u -- ).
3650: 20 20 6e 65 77 2d 64 61 74 61 2d 73 69 7a 65 20 new-data-size
3660: 21 20 6e 65 77 2d 64 61 74 61 2d 64 20 36 34 21 ! new-data-d 64!
3670: 20 6e 65 77 2d 64 61 74 61 2d 73 20 36 34 21 20 new-data-s 64!
3680: 6e 65 77 64 61 74 61 2d 76 61 6c 20 76 61 6c 69 newdata-val vali
3690: 64 61 74 65 64 20 6f 72 21 20 3b 0a 0a 69 6e 20 dated or! ;..in
36a0: 6e 65 74 32 6f 20 3a 20 6e 65 77 2d 6d 61 70 20 net2o : new-map
36b0: 28 20 2d 2d 20 61 64 64 72 20 29 0a 20 20 20 20 ( -- addr ).
36c0: 6d 61 70 73 74 61 72 74 20 40 20 31 20 6d 61 70 mapstart @ 1 map
36d0: 73 74 61 72 74 20 2b 21 20 72 65 76 65 72 73 65 start +! reverse
36e0: 0a 20 20 20 20 5b 20 63 65 6c 6c 20 34 20 3d 20 . [ cell 4 =
36f0: 5d 20 5b 49 46 5d 20 20 30 20 73 77 61 70 20 20 ] [IF] 0 swap
3700: 5b 45 4c 53 45 5d 20 24 46 46 46 46 46 46 46 46 [ELSE] $FFFFFFFF
3710: 30 30 30 30 30 30 30 30 20 61 6e 64 20 5b 54 48 00000000 and [TH
3720: 45 4e 5d 20 3b 0a 69 6e 20 6e 65 74 32 6f 20 3a EN] ;.in net2o :
3730: 20 6e 65 77 2d 64 61 74 61 20 28 20 61 64 64 72 new-data ( addr
3740: 73 20 61 64 64 72 64 20 75 20 2d 2d 20 29 0a 20 s addrd u -- ).
3750: 20 20 20 64 75 70 20 6d 61 78 2d 64 61 74 61 23 dup max-data#
3760: 20 75 3e 20 21 21 6d 61 70 73 69 7a 65 21 21 20 u> !!mapsize!!
3770: 6d 69 6e 2d 73 69 7a 65 20 73 77 61 70 20 6c 73 min-size swap ls
3780: 68 69 66 74 0a 20 20 20 20 7b 20 36 34 3a 20 61 hift. { 64: a
3790: 64 64 72 73 20 36 34 3a 20 61 64 64 72 64 20 75 ddrs 64: addrd u
37a0: 20 2d 2d 20 7d 0a 20 20 20 20 6f 20 30 3d 20 49 -- }. o 0= I
37b0: 46 0a 09 61 64 64 72 64 20 3e 64 65 73 74 2d 6d F..addrd >dest-m
37c0: 61 70 20 40 20 3f 45 58 49 54 0a 09 6e 65 74 32 ap @ ?EXIT..net2
37d0: 6f 3a 6e 65 77 2d 63 6f 6e 74 65 78 74 20 3e 6f o:new-context >o
37e0: 20 72 64 72 6f 70 20 20 73 65 74 75 70 21 20 20 rdrop setup!
37f0: 54 48 45 4e 0a 20 20 20 20 6d 73 67 28 20 2e 22 THEN. msg( ."
3800: 20 64 61 74 61 20 6d 61 70 3a 20 22 20 61 64 64 data map: " add
3810: 72 73 20 78 36 34 2e 20 2e 22 20 6f 77 6e 3a 20 rs x64. ." own:
3820: 22 20 61 64 64 72 64 20 78 36 34 2e 20 75 20 68 " addrd x64. u h
3830: 65 78 2e 20 63 72 20 29 0a 20 20 20 20 3e 63 6f ex. cr ). >co
3840: 64 65 2d 66 6c 61 67 20 6f 66 66 0a 20 20 20 20 de-flag off.
3850: 61 64 64 72 64 20 75 20 61 64 64 72 20 64 61 74 addrd u addr dat
3860: 61 2d 72 6d 61 70 20 6d 61 70 2d 64 61 74 61 2d a-rmap map-data-
3870: 64 65 73 74 0a 20 20 20 20 61 64 64 72 73 20 75 dest. addrs u
3880: 20 6d 61 70 2d 73 6f 75 72 63 65 20 74 6f 20 64 map-source to d
3890: 61 74 61 2d 6d 61 70 20 3b 0a 69 6e 20 6e 65 74 ata-map ;.in net
38a0: 32 6f 20 3a 20 6e 65 77 2d 63 6f 64 65 20 28 20 2o : new-code (
38b0: 61 64 64 72 73 20 61 64 64 72 64 20 75 20 2d 2d addrs addrd u --
38c0: 20 29 0a 20 20 20 20 64 75 70 20 6d 61 78 2d 63 ). dup max-c
38d0: 6f 64 65 23 20 75 3e 20 21 21 6d 61 70 73 69 7a ode# u> !!mapsiz
38e0: 65 21 21 20 6d 69 6e 2d 73 69 7a 65 20 73 77 61 e!! min-size swa
38f0: 70 20 6c 73 68 69 66 74 0a 20 20 20 20 7b 20 36 p lshift. { 6
3900: 34 3a 20 61 64 64 72 73 20 36 34 3a 20 61 64 64 4: addrs 64: add
3910: 72 64 20 75 20 2d 2d 20 7d 0a 20 20 20 20 6f 20 rd u -- }. o
3920: 30 3d 20 49 46 0a 09 61 64 64 72 64 20 3e 64 65 0= IF..addrd >de
3930: 73 74 2d 6d 61 70 20 40 20 3f 45 58 49 54 0a 09 st-map @ ?EXIT..
3940: 6e 65 74 32 6f 3a 6e 65 77 2d 63 6f 6e 74 65 78 net2o:new-contex
3950: 74 20 3e 6f 20 72 64 72 6f 70 20 20 73 65 74 75 t >o rdrop setu
3960: 70 21 20 20 54 48 45 4e 0a 20 20 20 20 6d 73 67 p! THEN. msg
3970: 28 20 2e 22 20 63 6f 64 65 20 6d 61 70 3a 20 22 ( ." code map: "
3980: 20 61 64 64 72 73 20 78 36 34 2e 20 2e 22 20 6f addrs x64. ." o
3990: 77 6e 3a 20 22 20 61 64 64 72 64 20 78 36 34 2e wn: " addrd x64.
39a0: 20 75 20 68 65 78 2e 20 63 72 20 29 0a 20 20 20 u hex. cr ).
39b0: 20 3e 63 6f 64 65 2d 66 6c 61 67 20 6f 6e 0a 20 >code-flag on.
39c0: 20 20 20 61 64 64 72 64 20 75 20 61 64 64 72 20 addrd u addr
39d0: 63 6f 64 65 2d 72 6d 61 70 20 6d 61 70 2d 63 6f code-rmap map-co
39e0: 64 65 2d 64 65 73 74 0a 20 20 20 20 61 64 64 72 de-dest. addr
39f0: 73 20 75 20 6d 61 70 2d 73 6f 75 72 63 65 20 74 s u map-source t
3a00: 6f 20 63 6f 64 65 2d 6d 61 70 20 3b 0a 0a 46 6f o code-map ;..Fo
3a10: 72 77 61 72 64 20 6e 65 77 2d 69 76 73 20 28 20 rward new-ivs (
3a20: 2d 2d 20 29 0a 5c 47 20 49 6e 69 74 20 74 68 65 -- ).\G Init the
3a30: 20 6e 65 77 20 49 56 53 0a 3a 20 63 72 65 61 74 new IVS.: creat
3a40: 65 2d 6d 61 70 73 20 28 20 2d 2d 20 29 20 76 61 e-maps ( -- ) va
3a50: 6c 69 64 61 74 65 64 20 40 20 3e 72 0a 20 20 20 lidated @ >r.
3a60: 20 5b 20 6e 65 77 63 6f 64 65 2d 76 61 6c 20 6e [ newcode-val n
3a70: 65 77 64 61 74 61 2d 76 61 6c 20 6f 72 20 69 6e ewdata-val or in
3a80: 76 65 72 74 20 5d 4c 20 72 40 20 61 6e 64 20 76 vert ]L r@ and v
3a90: 61 6c 69 64 61 74 65 64 20 21 0a 20 20 20 20 72 alidated !. r
3aa0: 40 20 6e 65 77 63 6f 64 65 2d 76 61 6c 20 61 6e @ newcode-val an
3ab0: 64 20 49 46 20 20 6e 65 77 2d 63 6f 64 65 40 20 d IF new-code@
3ac0: 6e 65 74 32 6f 3a 6e 65 77 2d 63 6f 64 65 20 45 net2o:new-code E
3ad0: 4c 53 45 20 20 72 64 72 6f 70 20 45 58 49 54 20 LSE rdrop EXIT
3ae0: 20 54 48 45 4e 0a 20 20 20 20 72 3e 20 6e 65 77 THEN. r> new
3af0: 64 61 74 61 2d 76 61 6c 20 61 6e 64 20 49 46 20 data-val and IF
3b00: 20 6e 65 77 2d 64 61 74 61 40 20 6e 65 74 32 6f new-data@ net2o
3b10: 3a 6e 65 77 2d 64 61 74 61 20 54 48 45 4e 20 3b :new-data THEN ;
3b20: 0a 3a 20 75 70 64 61 74 65 2d 63 64 6d 61 70 20 .: update-cdmap
3b30: 28 20 2d 2d 20 29 0a 20 20 20 20 6f 20 30 3d 20 ( -- ). o 0=
3b40: 49 46 20 20 64 6f 2d 6b 65 79 70 61 64 20 73 65 IF do-keypad se
3b50: 63 40 20 6e 69 70 20 6b 65 79 73 69 7a 65 32 20 c@ nip keysize2
3b60: 3c 3e 20 3f 45 58 49 54 20 20 54 48 45 4e 0a 20 <> ?EXIT THEN.
3b70: 20 20 20 63 72 65 61 74 65 2d 6d 61 70 73 0a 20 create-maps.
3b80: 20 20 20 6f 20 49 46 0a 09 76 61 6c 69 64 61 74 o IF..validat
3b90: 65 64 20 40 20 6b 65 79 70 61 69 72 2d 76 61 6c ed @ keypair-val
3ba0: 20 61 6e 64 20 49 46 0a 09 20 20 20 20 74 6d 70 and IF.. tmp
3bb0: 2d 70 75 62 6b 65 79 20 20 24 40 20 70 75 62 6b -pubkey $@ pubk
3bc0: 65 79 20 20 24 21 0a 09 20 20 20 20 74 6d 70 2d ey $!.. tmp-
3bd0: 6d 79 2d 6b 65 79 20 20 20 40 20 74 6f 20 6d 79 my-key @ to my
3be0: 2d 6b 65 79 0a 09 54 48 45 4e 0a 09 76 61 6c 69 -key..THEN..vali
3bf0: 64 61 74 65 64 20 40 20 69 76 73 2d 76 61 6c 20 dated @ ivs-val
3c00: 61 6e 64 20 49 46 20 20 6e 65 77 2d 69 76 73 20 and IF new-ivs
3c10: 20 54 48 45 4e 0a 09 74 6d 70 2d 70 65 72 6d 20 THEN..tmp-perm
3c20: 40 20 3f 64 75 70 2d 49 46 20 20 70 65 72 6d 2d @ ?dup-IF perm-
3c30: 6d 61 73 6b 20 21 20 20 74 6d 70 2d 70 65 72 6d mask ! tmp-perm
3c40: 20 6f 66 66 20 20 54 48 45 4e 0a 09 5b 20 6b 65 off THEN..[ ke
3c50: 79 70 61 69 72 2d 76 61 6c 20 69 76 73 2d 76 61 ypair-val ivs-va
3c60: 6c 20 6f 72 20 69 6e 76 65 72 74 20 5d 4c 20 76 l or invert ]L v
3c70: 61 6c 69 64 61 74 65 64 20 61 6e 64 21 0a 20 20 alidated and!.
3c80: 20 20 54 48 45 4e 20 3b 0a 0a 5c 20 64 69 73 70 THEN ;..\ disp
3c90: 6f 73 65 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 0a ose connection..
3ca0: 73 63 6f 70 65 7b 20 6d 61 70 63 0a 0a 3a 20 66 scope{ mapc..: f
3cb0: 72 65 65 2d 72 65 73 65 6e 64 20 28 20 6f 3a 64 ree-resend ( o:d
3cc0: 61 74 61 20 29 20 64 65 73 74 2d 73 69 7a 65 20 ata ) dest-size
3cd0: 61 64 64 72 3e 74 73 20 3e 72 0a 20 20 20 20 64 addr>ts >r. d
3ce0: 61 74 61 2d 72 65 73 65 6e 64 23 20 20 20 20 72 ata-resend# r
3cf0: 40 20 3f 66 72 65 65 0a 20 20 20 20 61 64 64 72 @ ?free. addr
3d00: 20 64 65 73 74 2d 74 69 6d 65 73 74 61 6d 70 73 dest-timestamps
3d10: 20 72 3e 20 3f 66 72 65 65 20 3b 0a 3a 20 66 72 r> ?free ;.: fr
3d20: 65 65 2d 72 65 73 65 6e 64 27 20 28 20 6f 3a 64 ee-resend' ( o:d
3d30: 61 74 61 20 29 20 64 65 73 74 2d 73 69 7a 65 20 ata ) dest-size
3d40: 61 64 64 72 3e 74 73 20 3e 72 0a 20 20 20 20 61 addr>ts >r. a
3d50: 64 64 72 20 64 65 73 74 2d 74 69 6d 65 73 74 61 ddr dest-timesta
3d60: 6d 70 73 20 72 3e 20 3f 66 72 65 65 20 3b 0a 3a mps r> ?free ;.:
3d70: 20 66 72 65 65 2d 63 6f 64 65 20 28 20 6f 3a 64 free-code ( o:d
3d80: 61 74 61 20 2d 2d 20 29 20 64 65 73 74 2d 73 69 ata -- ) dest-si
3d90: 7a 65 20 3e 72 0a 20 20 20 20 61 64 64 72 20 64 ze >r. addr d
3da0: 65 73 74 2d 72 61 64 64 72 20 20 20 72 40 20 20 est-raddr r@
3db0: 20 20 20 20 20 20 20 20 20 20 20 20 3f 66 72 65 ?fre
3dc0: 65 2b 67 75 61 72 64 0a 20 20 20 20 61 64 64 72 e+guard. addr
3dd0: 20 64 65 73 74 2d 69 76 73 67 65 6e 20 20 63 3a dest-ivsgen c:
3de0: 6b 65 79 23 20 20 20 20 20 20 20 20 20 20 3f 66 key# ?f
3df0: 72 65 65 0a 20 20 20 20 61 64 64 72 20 64 65 73 ree. addr des
3e00: 74 2d 72 65 70 6c 69 65 73 20 72 40 20 61 64 64 t-replies r@ add
3e10: 72 3e 72 65 70 6c 69 65 73 20 3f 66 72 65 65 2b r>replies ?free+
3e20: 67 75 61 72 64 0a 20 20 20 20 72 64 72 6f 70 20 guard. rdrop
3e30: 64 69 73 70 6f 73 65 20 3b 0a 27 20 66 72 65 65 dispose ;.' free
3e40: 2d 63 6f 64 65 20 63 6f 64 65 2d 63 6c 61 73 73 -code code-class
3e50: 20 74 6f 20 66 72 65 65 2d 64 61 74 61 0a 3a 6e to free-data.:n
3e60: 6f 6e 61 6d 65 20 28 20 6f 3a 64 61 74 61 20 2d oname ( o:data -
3e70: 2d 20 29 0a 20 20 20 20 66 72 65 65 2d 72 65 73 - ). free-res
3e80: 65 6e 64 20 66 72 65 65 2d 63 6f 64 65 20 3b 20 end free-code ;
3e90: 64 61 74 61 2d 63 6c 61 73 73 20 74 6f 20 66 72 data-class to fr
3ea0: 65 65 2d 64 61 74 61 0a 0a 3a 20 66 72 65 65 2d ee-data..: free-
3eb0: 72 63 6f 64 65 20 28 20 6f 3a 64 61 74 61 20 2d rcode ( o:data -
3ec0: 2d 2d 20 29 0a 20 20 20 20 64 61 74 61 2d 61 63 -- ). data-ac
3ed0: 6b 62 69 74 73 20 64 65 73 74 2d 73 69 7a 65 20 kbits dest-size
3ee0: 61 64 64 72 3e 62 79 74 65 73 20 3f 66 72 65 65 addr>bytes ?free
3ef0: 0a 20 20 20 20 64 61 74 61 2d 61 63 6b 62 69 74 . data-ackbit
3f00: 73 2d 62 75 66 20 24 6f 66 66 0a 20 20 20 20 66 s-buf $off. f
3f10: 72 65 65 2d 63 6f 64 65 20 3b 0a 3a 6e 6f 6e 61 ree-code ;.:nona
3f20: 6d 65 20 28 20 6f 3a 64 61 74 61 20 2d 2d 20 29 me ( o:data -- )
3f30: 0a 20 20 20 20 66 72 65 65 2d 72 65 73 65 6e 64 . free-resend
3f40: 27 20 66 72 65 65 2d 72 63 6f 64 65 20 3b 20 72 ' free-rcode ; r
3f50: 64 61 74 61 2d 63 6c 61 73 73 20 74 6f 20 66 72 data-class to fr
3f60: 65 65 2d 64 61 74 61 0a 27 20 66 72 65 65 2d 72 ee-data.' free-r
3f70: 63 6f 64 65 20 72 63 6f 64 65 2d 63 6c 61 73 73 code rcode-class
3f80: 20 74 6f 20 66 72 65 65 2d 64 61 74 61 0a 0a 7d to free-data..}
3f90: 73 63 6f 70 65 0a 0a 5c 20 73 79 6d 6d 65 74 72 scope..\ symmetr
3fa0: 69 63 20 6b 65 79 20 6d 61 6e 61 67 65 6d 65 6e ic key managemen
3fb0: 74 20 61 6e 64 20 73 65 61 72 63 68 69 6e 67 20 t and searching
3fc0: 69 6e 20 6f 70 65 6e 20 63 6f 6e 6e 65 63 74 69 in open connecti
3fd0: 6f 6e 73 0a 0a 3a 20 73 65 61 72 63 68 2d 63 6f ons..: search-co
3fe0: 6e 74 65 78 74 20 28 20 2e 2e 20 78 74 20 2d 2d ntext ( .. xt --
3ff0: 20 2e 2e 20 29 20 7b 20 78 74 20 7d 0a 20 20 20 .. ) { xt }.
4000: 20 5c 47 20 78 74 20 68 61 73 20 28 20 2e 2e 20 \G xt has ( ..
4010: 2d 2d 20 2e 2e 20 66 6c 61 67 20 29 20 77 69 74 -- .. flag ) wit
4020: 68 20 74 72 75 65 20 74 6f 20 63 6f 6e 74 69 6e h true to contin
4030: 75 65 0a 20 20 20 20 63 6f 6e 74 65 78 74 73 20 ue. contexts
4040: 20 42 45 47 49 4e 20 20 40 20 64 75 70 20 20 57 BEGIN @ dup W
4050: 48 49 4c 45 20 20 3e 6f 20 20 78 74 20 65 78 65 HILE >o xt exe
4060: 63 75 74 65 0a 09 6e 65 78 74 2d 63 6f 6e 74 65 cute..next-conte
4070: 78 74 20 6f 3e 20 73 77 61 70 20 20 30 3d 20 55 xt o> swap 0= U
4080: 4e 54 49 4c 20 20 54 48 45 4e 20 20 64 72 6f 70 NTIL THEN drop
4090: 20 3b 0a 0a 5c 20 64 61 74 61 20 73 65 6e 64 69 ;..\ data sendi
40a0: 6e 67 20 61 72 6f 75 6e 64 0a 0a 3a 20 3e 62 6c ng around..: >bl
40b0: 6f 63 6b 61 6c 69 67 6e 20 28 20 6e 20 2d 2d 20 ockalign ( n --
40c0: 62 6c 6f 63 6b 20 29 0a 20 20 20 20 62 6c 6f 63 block ). bloc
40d0: 6b 61 6c 69 67 6e 20 40 20 64 75 70 20 3e 72 20 kalign @ dup >r
40e0: 31 2d 20 2b 20 72 3e 20 6e 65 67 61 74 65 20 61 1- + r> negate a
40f0: 6e 64 20 3b 0a 3a 20 3e 6d 61 78 61 6c 69 67 6e nd ;.: >maxalign
4100: 20 28 20 6e 20 2d 2d 20 62 6c 6f 63 6b 20 29 0a ( n -- block ).
4110: 20 20 20 20 6d 61 78 64 61 74 61 20 35 20 6c 73 maxdata 5 ls
4120: 68 69 66 74 20 64 75 70 20 3e 72 20 31 2d 20 2b hift dup >r 1- +
4130: 20 72 3e 20 6e 65 67 61 74 65 20 61 6e 64 20 3b r> negate and ;
4140: 0a 3a 20 36 34 3e 62 6c 6f 63 6b 61 6c 69 67 6e .: 64>blockalign
4150: 20 28 20 36 34 20 2d 2d 20 62 6c 6f 63 6b 20 29 ( 64 -- block )
4160: 0a 20 20 20 20 62 6c 6f 63 6b 61 6c 69 67 6e 20 . blockalign
4170: 40 20 64 75 70 20 3e 72 20 31 2d 20 6e 3e 36 34 @ dup >r 1- n>64
4180: 20 36 34 2b 20 72 3e 20 6e 65 67 61 74 65 20 6e 64+ r> negate n
4190: 3e 36 34 20 36 34 61 6e 64 20 3b 0a 3a 20 2f 68 >64 64and ;.: /h
41a0: 65 61 64 20 28 20 75 20 2d 2d 20 29 0a 20 20 20 ead ( u -- ).
41b0: 20 3e 62 6c 6f 63 6b 61 6c 69 67 6e 20 64 75 70 >blockalign dup
41c0: 20 6e 65 67 61 74 65 20 72 65 73 69 64 75 61 6c negate residual
41d0: 72 65 61 64 20 2b 21 0a 20 20 20 20 64 61 74 61 read +!. data
41e0: 2d 6d 61 70 20 77 69 74 68 20 6d 61 70 63 20 2b -map with mapc +
41f0: 74 6f 20 64 65 73 74 2d 68 65 61 64 20 65 6e 64 to dest-head end
4200: 77 69 74 68 20 3b 0a 3a 20 6d 61 78 2f 68 65 61 with ;.: max/hea
4210: 64 20 28 20 2d 2d 20 29 0a 20 20 20 20 64 61 74 d ( -- ). dat
4220: 61 2d 6d 61 70 20 77 69 74 68 20 6d 61 70 63 20 a-map with mapc
4230: 64 65 73 74 2d 68 65 61 64 20 3e 6d 61 78 61 6c dest-head >maxal
4240: 69 67 6e 20 74 6f 20 64 65 73 74 2d 68 65 61 64 ign to dest-head
4250: 20 65 6e 64 77 69 74 68 20 3b 0a 3a 20 2f 62 61 endwith ;.: /ba
4260: 63 6b 20 28 20 75 20 2d 2d 20 29 0a 20 20 20 20 ck ( u -- ).
4270: 3e 62 6c 6f 63 6b 61 6c 69 67 6e 20 64 75 70 20 >blockalign dup
4280: 6e 65 67 61 74 65 20 72 65 73 69 64 75 61 6c 77 negate residualw
4290: 72 69 74 65 20 2b 21 0a 20 20 20 20 64 61 74 61 rite +!. data
42a0: 2d 72 6d 61 70 20 77 69 74 68 20 6d 61 70 63 20 -rmap with mapc
42b0: 2b 74 6f 20 64 65 73 74 2d 62 61 63 6b 20 65 6e +to dest-back en
42c0: 64 77 69 74 68 20 3b 0a 3a 20 6d 61 78 2f 62 61 dwith ;.: max/ba
42d0: 63 6b 20 28 20 2d 2d 20 29 0a 20 20 20 20 64 61 ck ( -- ). da
42e0: 74 61 2d 72 6d 61 70 20 77 69 74 68 20 6d 61 70 ta-rmap with map
42f0: 63 20 64 65 73 74 2d 62 61 63 6b 20 3e 6d 61 78 c dest-back >max
4300: 61 6c 69 67 6e 20 74 6f 20 64 65 73 74 2d 62 61 align to dest-ba
4310: 63 6b 20 65 6e 64 77 69 74 68 20 3b 0a 3a 20 2f ck endwith ;.: /
4320: 74 61 69 6c 20 28 20 75 20 2d 2d 20 29 0a 20 20 tail ( u -- ).
4330: 20 20 64 61 74 61 2d 6d 61 70 20 3e 6f 20 2b 74 data-map >o +t
4340: 6f 20 6d 61 70 63 3a 64 65 73 74 2d 74 61 69 6c o mapc:dest-tail
4350: 20 6f 3e 20 3b 0a 3a 20 64 61 74 61 2d 64 65 73 o> ;.: data-des
4360: 74 20 28 20 2d 2d 20 61 64 64 72 20 29 0a 20 20 t ( -- addr ).
4370: 20 20 64 61 74 61 2d 6d 61 70 20 77 69 74 68 20 data-map with
4380: 6d 61 70 63 0a 20 20 20 20 64 65 73 74 2d 76 61 mapc. dest-va
4390: 64 64 72 20 64 65 73 74 2d 74 61 69 6c 20 64 65 ddr dest-tail de
43a0: 73 74 2d 73 69 7a 65 20 31 2d 20 61 6e 64 20 6e st-size 1- and n
43b0: 3e 36 34 20 36 34 2b 20 65 6e 64 77 69 74 68 20 >64 64+ endwith
43c0: 3b 0a 0a 5c 20 6e 65 77 20 64 61 74 61 20 73 65 ;..\ new data se
43d0: 6e 64 69 6e 67 20 61 72 6f 75 6e 64 20 73 74 75 nding around stu
43e0: 66 66 2c 20 77 69 74 68 20 66 72 6f 6e 74 2b 62 ff, with front+b
43f0: 61 63 6b 0a 0a 73 63 6f 70 65 7b 20 6d 61 70 63 ack..scope{ mapc
4400: 0a 0a 3a 20 66 69 78 2d 73 69 7a 65 20 28 20 6f ..: fix-size ( o
4410: 66 66 73 65 74 31 20 6f 66 66 73 65 74 32 20 2d ffset1 offset2 -
4420: 2d 20 61 64 64 72 20 6c 65 6e 20 29 0a 20 20 20 - addr len ).
4430: 20 6f 76 65 72 20 2d 20 3e 72 20 64 65 73 74 2d over - >r dest-
4440: 73 69 7a 65 20 31 2d 20 61 6e 64 20 72 3e 20 6f size 1- and r> o
4450: 76 65 72 20 2b 20 64 65 73 74 2d 73 69 7a 65 20 ver + dest-size
4460: 75 6d 69 6e 20 6f 76 65 72 20 2d 20 3b 0a 3a 20 umin over - ;.:
4470: 66 69 78 2d 74 73 73 69 7a 65 20 28 20 6f 66 66 fix-tssize ( off
4480: 73 65 74 31 20 6f 66 66 73 65 74 32 20 2d 2d 20 set1 offset2 --
4490: 61 64 64 72 20 6c 65 6e 20 29 0a 20 20 20 20 6f addr len ). o
44a0: 76 65 72 20 2d 20 3e 72 20 64 65 73 74 2d 73 69 ver - >r dest-si
44b0: 7a 65 20 61 64 64 72 3e 74 73 20 31 2d 20 61 6e ze addr>ts 1- an
44c0: 64 20 72 3e 20 6f 76 65 72 20 2b 0a 20 20 20 20 d r> over +.
44d0: 64 65 73 74 2d 73 69 7a 65 20 61 64 64 72 3e 74 dest-size addr>t
44e0: 73 20 75 6d 69 6e 20 6f 76 65 72 20 2d 20 3b 0a s umin over - ;.
44f0: 3a 20 66 69 78 2d 62 69 74 73 69 7a 65 20 28 20 : fix-bitsize (
4500: 6f 66 66 73 65 74 31 20 6f 66 66 73 65 74 32 20 offset1 offset2
4510: 2d 2d 20 61 64 64 72 20 6c 65 6e 20 29 0a 20 20 -- addr len ).
4520: 20 20 6f 76 65 72 20 2d 20 3e 72 20 64 65 73 74 over - >r dest
4530: 2d 73 69 7a 65 20 61 64 64 72 3e 62 69 74 73 20 -size addr>bits
4540: 31 2d 20 61 6e 64 20 72 3e 20 6f 76 65 72 20 2b 1- and r> over +
4550: 0a 20 20 20 20 64 65 73 74 2d 73 69 7a 65 20 61 . dest-size a
4560: 64 64 72 3e 62 69 74 73 20 75 6d 69 6e 20 6f 76 ddr>bits umin ov
4570: 65 72 20 2d 20 3b 0a 3a 20 72 61 64 64 72 2b 20 er - ;.: raddr+
4580: 28 20 61 64 64 72 20 6c 65 6e 20 2d 2d 20 61 64 ( addr len -- ad
4590: 64 72 27 20 6c 65 6e 20 29 20 3e 72 20 64 65 73 dr' len ) >r des
45a0: 74 2d 72 61 64 64 72 20 2b 20 72 3e 20 3b 0a 3a t-raddr + r> ;.:
45b0: 20 66 69 78 2d 73 69 7a 65 27 20 28 20 62 61 73 fix-size' ( bas
45c0: 65 20 6f 66 66 73 65 74 31 20 6f 66 66 73 65 74 e offset1 offset
45d0: 32 20 2d 2d 20 61 64 64 72 20 6c 65 6e 20 29 0a 2 -- addr len ).
45e0: 20 20 20 20 6f 76 65 72 20 2d 20 3e 72 20 64 65 over - >r de
45f0: 73 74 2d 73 69 7a 65 20 31 2d 20 61 6e 64 20 2b st-size 1- and +
4600: 20 72 3e 20 3b 0a 0a 7d 73 63 6f 70 65 0a 0a 3a r> ;..}scope..:
4610: 20 68 65 61 64 40 20 28 20 2d 2d 20 68 65 61 64 head@ ( -- head
4620: 20 29 20 20 64 61 74 61 2d 6d 61 70 20 2e 6d 61 ) data-map .ma
4630: 70 63 3a 64 65 73 74 2d 68 65 61 64 20 3b 0a 0a pc:dest-head ;..
4640: 3a 20 64 61 74 61 2d 68 65 61 64 40 20 28 20 2d : data-head@ ( -
4650: 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 20 5c - addr u ). \
4660: 47 20 79 6f 75 20 63 61 6e 20 72 65 61 64 20 69 G you can read i
4670: 6e 74 6f 20 74 68 69 73 2c 20 69 74 27 73 20 61 nto this, it's a
4680: 20 62 6c 6f 63 6b 20 61 74 20 61 20 74 69 6d 65 block at a time
4690: 20 28 77 72 61 70 61 72 6f 75 6e 64 21 29 0a 20 (wraparound!).
46a0: 20 20 20 64 61 74 61 2d 6d 61 70 20 77 69 74 68 data-map with
46b0: 20 6d 61 70 63 0a 20 20 20 20 64 65 73 74 2d 68 mapc. dest-h
46c0: 65 61 64 20 64 65 73 74 2d 62 61 63 6b 20 64 65 ead dest-back de
46d0: 73 74 2d 73 69 7a 65 20 2b 20 66 69 78 2d 73 69 st-size + fix-si
46e0: 7a 65 20 72 61 64 64 72 2b 20 65 6e 64 77 69 74 ze raddr+ endwit
46f0: 68 0a 20 20 20 20 72 65 73 69 64 75 61 6c 72 65 h. residualre
4700: 61 64 20 40 20 75 6d 69 6e 20 3b 0a 3a 20 72 64 ad @ umin ;.: rd
4710: 61 74 61 2d 62 61 63 6b 40 20 28 20 74 61 69 6c ata-back@ ( tail
4720: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
4730: 20 5c 47 20 79 6f 75 20 63 61 6e 20 77 72 69 74 \G you can writ
4740: 65 20 66 72 6f 6d 20 74 68 69 73 2c 20 61 6c 73 e from this, als
4750: 6f 20 61 20 62 6c 6f 63 6b 20 61 74 20 61 20 74 o a block at a t
4760: 69 6d 65 0a 20 20 20 20 64 61 74 61 2d 72 6d 61 ime. data-rma
4770: 70 20 77 69 74 68 20 6d 61 70 63 0a 20 20 20 20 p with mapc.
4780: 64 65 73 74 2d 62 61 63 6b 20 73 77 61 70 20 66 dest-back swap f
4790: 69 78 2d 73 69 7a 65 20 72 61 64 64 72 2b 20 65 ix-size raddr+ e
47a0: 6e 64 77 69 74 68 0a 20 20 20 20 72 65 73 69 64 ndwith. resid
47b0: 75 61 6c 77 72 69 74 65 20 40 20 75 6d 69 6e 20 ualwrite @ umin
47c0: 3b 0a 3a 20 64 61 74 61 2d 74 61 69 6c 40 20 28 ;.: data-tail@ (
47d0: 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 20 -- addr u ).
47e0: 20 5c 47 20 79 6f 75 20 63 61 6e 20 73 65 6e 64 \G you can send
47f0: 20 66 72 6f 6d 20 74 68 69 73 20 2d 20 61 73 20 from this - as
4800: 6c 6f 6e 67 20 61 73 20 79 6f 75 20 73 74 61 79 long as you stay
4810: 20 62 6c 6f 63 6b 20 61 6c 69 67 6e 65 64 0a 20 block aligned.
4820: 20 20 20 64 61 74 61 2d 6d 61 70 20 77 69 74 68 data-map with
4830: 20 6d 61 70 63 0a 20 20 20 20 64 65 73 74 2d 72 mapc. dest-r
4840: 61 64 64 72 20 64 65 73 74 2d 74 61 69 6c 20 64 addr dest-tail d
4850: 65 73 74 2d 68 65 61 64 20 66 69 78 2d 73 69 7a est-head fix-siz
4860: 65 27 20 65 6e 64 77 69 74 68 20 3b 0a 0a 3a 20 e' endwith ;..:
4870: 64 61 74 61 2d 68 65 61 64 3f 20 28 20 2d 2d 20 data-head? ( --
4880: 66 6c 61 67 20 29 0a 20 20 20 20 5c 47 20 72 65 flag ). \G re
4890: 74 75 72 6e 20 74 72 75 65 20 69 66 20 74 68 65 turn true if the
48a0: 72 65 20 69 73 20 73 70 61 63 65 20 74 6f 20 72 re is space to r
48b0: 65 61 64 20 64 61 74 61 20 69 6e 0a 20 20 20 20 ead data in.
48c0: 64 61 74 61 2d 6d 61 70 20 77 69 74 68 20 6d 61 data-map with ma
48d0: 70 63 20 64 65 73 74 2d 68 65 61 64 20 64 65 73 pc dest-head des
48e0: 74 2d 62 61 63 6b 20 64 65 73 74 2d 73 69 7a 65 t-back dest-size
48f0: 20 2b 20 75 3c 20 65 6e 64 77 69 74 68 20 3b 0a + u< endwith ;.
4900: 3a 20 64 61 74 61 2d 74 61 69 6c 3f 20 28 20 2d : data-tail? ( -
4910: 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 5c 47 20 - flag ). \G
4920: 72 65 74 75 72 6e 20 74 72 75 65 20 69 66 20 74 return true if t
4930: 68 65 72 65 20 69 73 20 64 61 74 61 20 74 6f 20 here is data to
4940: 73 65 6e 64 0a 20 20 20 20 64 61 74 61 2d 6d 61 send. data-ma
4950: 70 20 77 69 74 68 20 6d 61 70 63 20 64 65 73 74 p with mapc dest
4960: 2d 74 61 69 6c 20 64 65 73 74 2d 68 65 61 64 20 -tail dest-head
4970: 75 3c 20 65 6e 64 77 69 74 68 20 3b 0a 3a 20 72 u< endwith ;.: r
4980: 64 61 74 61 2d 62 61 63 6b 3f 20 28 20 74 61 69 data-back? ( tai
4990: 6c 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 l -- flag ).
49a0: 5c 47 20 72 65 74 75 72 6e 20 74 72 75 65 20 69 \G return true i
49b0: 66 20 74 68 65 72 65 20 69 73 20 64 61 74 61 20 f there is data
49c0: 61 76 61 69 6c 61 62 65 20 74 6f 20 77 72 69 74 availabe to writ
49d0: 65 20 6f 75 74 0a 20 20 20 20 64 61 74 61 2d 72 e out. data-r
49e0: 6d 61 70 20 2e 6d 61 70 63 3a 64 65 73 74 2d 62 map .mapc:dest-b
49f0: 61 63 6b 20 75 3e 20 3b 0a 0a 5c 20 63 6f 64 65 ack u> ;..\ code
4a00: 20 73 65 6e 64 69 6e 67 20 61 72 6f 75 6e 64 0a sending around.
4a10: 0a 3a 20 63 6f 64 65 2d 64 65 73 74 20 28 20 2d .: code-dest ( -
4a20: 2d 20 61 64 64 72 20 29 0a 20 20 20 20 63 6f 64 - addr ). cod
4a30: 65 2d 6d 61 70 20 77 69 74 68 20 6d 61 70 63 20 e-map with mapc
4a40: 64 65 73 74 2d 72 61 64 64 72 20 64 65 73 74 2d dest-raddr dest-
4a50: 74 61 69 6c 20 6d 61 78 64 61 74 61 20 6e 65 67 tail maxdata neg
4a60: 61 74 65 20 61 6e 64 20 2b 20 65 6e 64 77 69 74 ate and + endwit
4a70: 68 20 3b 0a 3a 20 63 6f 64 65 2d 76 64 65 73 74 h ;.: code-vdest
4a80: 20 28 20 2d 2d 20 61 64 64 72 20 29 0a 20 20 20 ( -- addr ).
4a90: 20 63 6f 64 65 2d 6d 61 70 20 77 69 74 68 20 6d code-map with m
4aa0: 61 70 63 20 64 65 73 74 2d 76 61 64 64 72 20 64 apc dest-vaddr d
4ab0: 65 73 74 2d 74 61 69 6c 20 6e 3e 36 34 20 36 34 est-tail n>64 64
4ac0: 2b 20 65 6e 64 77 69 74 68 20 3b 0a 3a 20 63 6f + endwith ;.: co
4ad0: 64 65 2d 72 65 70 6c 79 20 28 20 2d 2d 20 61 64 de-reply ( -- ad
4ae0: 64 72 20 29 0a 20 20 20 20 63 6f 64 65 2d 6d 61 dr ). code-ma
4af0: 70 20 77 69 74 68 20 6d 61 70 63 20 64 65 73 74 p with mapc dest
4b00: 2d 74 61 69 6c 20 61 64 64 72 3e 72 65 70 6c 69 -tail addr>repli
4b10: 65 73 20 64 65 73 74 2d 72 65 70 6c 69 65 73 20 es dest-replies
4b20: 2b 20 65 6e 64 77 69 74 68 20 3b 0a 3a 20 73 65 + endwith ;.: se
4b30: 6e 64 2d 72 65 70 6c 79 20 28 20 2d 2d 20 61 64 nd-reply ( -- ad
4b40: 64 72 20 29 0a 20 20 20 20 63 6f 64 65 2d 6d 61 dr ). code-ma
4b50: 70 20 77 69 74 68 20 6d 61 70 63 20 64 65 73 74 p with mapc dest
4b60: 2d 61 64 64 72 20 36 34 40 20 64 65 73 74 2d 76 -addr 64@ dest-v
4b70: 61 64 64 72 20 36 34 2d 20 36 34 3e 6e 20 61 64 addr 64- 64>n ad
4b80: 64 72 3e 72 65 70 6c 69 65 73 0a 09 64 65 73 74 dr>replies..dest
4b90: 2d 72 65 70 6c 69 65 73 20 2b 20 65 6e 64 77 69 -replies + endwi
4ba0: 74 68 20 3b 0a 0a 3a 20 74 61 67 2d 61 64 64 72 th ;..: tag-addr
4bb0: 20 28 20 2d 2d 20 61 64 64 72 20 29 0a 20 20 20 ( -- addr ).
4bc0: 20 63 6f 64 65 2d 72 6d 61 70 20 77 69 74 68 20 code-rmap with
4bd0: 6d 61 70 63 20 64 65 73 74 2d 61 64 64 72 20 36 mapc dest-addr 6
4be0: 34 40 20 64 65 73 74 2d 76 61 64 64 72 20 36 34 4@ dest-vaddr 64
4bf0: 2d 20 36 34 3e 6e 20 61 64 64 72 3e 72 65 70 6c - 64>n addr>repl
4c00: 69 65 73 0a 09 64 65 73 74 2d 72 65 70 6c 69 65 ies..dest-replie
4c10: 73 20 2b 20 65 6e 64 77 69 74 68 20 3b 0a 0a 72 s + endwith ;..r
4c20: 65 70 6c 79 20 62 75 66 66 65 72 3a 20 64 75 6d eply buffer: dum
4c30: 6d 79 2d 72 65 70 6c 79 0a 27 20 6e 6f 6f 70 20 my-reply.' noop
4c40: 64 75 6d 6d 79 2d 72 65 70 6c 79 20 69 73 20 72 dummy-reply is r
4c50: 65 70 6c 79 2d 78 74 0a 0a 3a 20 72 65 70 6c 79 eply-xt..: reply
4c60: 5b 5d 20 28 20 69 6e 64 65 78 20 2d 2d 20 61 64 [] ( index -- ad
4c70: 64 72 20 29 0a 20 20 20 20 63 6f 64 65 2d 6d 61 dr ). code-ma
4c80: 70 20 77 69 74 68 20 6d 61 70 63 0a 20 20 20 20 p with mapc.
4c90: 64 75 70 20 64 65 73 74 2d 73 69 7a 65 20 61 64 dup dest-size ad
4ca0: 64 72 3e 62 69 74 73 20 75 3c 0a 20 20 20 20 49 dr>bits u<. I
4cb0: 46 20 20 72 65 70 6c 79 20 2a 20 64 65 73 74 2d F reply * dest-
4cc0: 72 65 70 6c 69 65 73 20 2b 20 20 45 4c 53 45 20 replies + ELSE
4cd0: 20 64 75 6d 6d 79 2d 72 65 70 6c 79 20 20 54 48 dummy-reply TH
4ce0: 45 4e 20 20 65 6e 64 77 69 74 68 20 3b 0a 0a 3a EN endwith ;..:
4cf0: 20 72 65 70 6c 79 2d 69 6e 64 65 78 20 28 20 2d reply-index ( -
4d00: 2d 20 69 6e 64 65 78 20 29 0a 20 20 20 20 63 6f - index ). co
4d10: 64 65 2d 6d 61 70 20 2e 6d 61 70 63 3a 64 65 73 de-map .mapc:des
4d20: 74 2d 74 61 69 6c 20 61 64 64 72 3e 62 69 74 73 t-tail addr>bits
4d30: 20 3b 0a 0a 3a 20 63 6f 64 65 2b 20 28 20 6e 20 ;..: code+ ( n
4d40: 2d 2d 20 29 0a 20 20 20 20 63 6f 6e 6e 65 63 74 -- ). connect
4d50: 69 6f 6e 20 2e 63 6f 64 65 2d 6d 61 70 20 77 69 ion .code-map wi
4d60: 74 68 20 6d 61 70 63 20 64 75 70 20 6e 65 67 61 th mapc dup nega
4d70: 74 65 20 64 65 73 74 2d 74 61 69 6c 20 61 6e 64 te dest-tail and
4d80: 20 2b 0a 20 20 20 20 64 65 73 74 2d 73 69 7a 65 +. dest-size
4d90: 20 31 2d 20 61 6e 64 20 74 6f 20 64 65 73 74 2d 1- and to dest-
4da0: 62 61 63 6b 20 65 6e 64 77 69 74 68 20 3b 0a 0a back endwith ;..
4db0: 3a 20 63 6f 64 65 2d 75 70 64 61 74 65 20 28 20 : code-update (
4dc0: 6e 20 2d 2d 20 29 20 64 72 6f 70 20 5c 20 74 6f n -- ) drop \ to
4dd0: 20 62 65 20 75 73 65 64 20 6c 61 74 65 72 0a 20 be used later.
4de0: 20 20 20 63 6f 6e 6e 65 63 74 69 6f 6e 20 2e 63 connection .c
4df0: 6f 64 65 2d 6d 61 70 20 77 69 74 68 20 6d 61 70 ode-map with map
4e00: 63 20 64 65 73 74 2d 62 61 63 6b 20 74 6f 20 64 c dest-back to d
4e10: 65 73 74 2d 74 61 69 6c 20 65 6e 64 77 69 74 68 est-tail endwith
4e20: 20 3b 0a 0a 5c 20 61 6c 69 67 6e 65 64 20 62 75 ;..\ aligned bu
4e30: 66 66 65 72 20 74 6f 20 6d 61 6b 65 20 65 6e 63 ffer to make enc
4e40: 72 79 70 74 69 6f 6e 2f 64 65 63 72 79 70 74 69 ryption/decrypti
4e50: 6f 6e 20 66 61 73 74 0a 0a 3a 20 24 3e 61 6c 69 on fast..: $>ali
4e60: 67 6e 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 gn ( addr u -- a
4e70: 64 64 72 27 20 75 20 29 20 64 75 70 20 24 34 30 ddr' u ) dup $40
4e80: 30 20 75 3e 20 3f 45 58 49 54 0a 20 20 20 20 74 0 u> ?EXIT. t
4e90: 75 63 6b 20 61 6c 69 67 6e 65 64 24 20 73 77 61 uck aligned$ swa
4ea0: 70 20 6d 6f 76 65 20 61 6c 69 67 6e 65 64 24 20 p move aligned$
4eb0: 73 77 61 70 20 3b 0a 20 20 20 20 0a 5c 20 74 69 swap ;. .\ ti
4ec0: 6d 69 6e 67 20 72 65 63 6f 72 64 73 0a 0a 53 65 ming records..Se
4ed0: 6d 61 20 74 69 6d 69 6e 67 2d 73 65 6d 61 0a 0a ma timing-sema..
4ee0: 69 6e 20 6e 65 74 32 6f 20 3a 20 74 72 61 63 6b in net2o : track
4ef0: 2d 74 69 6d 69 6e 67 20 28 20 2d 2d 20 29 20 5c -timing ( -- ) \
4f00: 20 69 6e 69 74 69 61 6c 69 7a 65 20 74 69 6d 69 initialize timi
4f10: 6e 67 20 72 65 63 6f 72 64 73 0a 20 20 20 20 74 ng records. t
4f20: 69 6d 69 6e 67 2d 73 74 61 74 20 24 6f 66 66 20 iming-stat $off
4f30: 3b 0a 0a 3a 20 29 73 74 61 74 73 20 5d 5d 20 54 ;..: )stats ]] T
4f40: 48 45 4e 20 5b 5b 20 3b 0a 3a 20 73 74 61 74 73 HEN [[ ;.: stats
4f50: 28 20 5d 5d 20 74 69 6d 69 6e 67 2d 73 74 61 74 ( ]] timing-stat
4f60: 20 40 20 49 46 20 5b 5b 20 5b 27 5d 20 29 73 74 @ IF [[ ['] )st
4f70: 61 74 73 20 61 73 73 65 72 74 2d 63 61 6e 61 72 ats assert-canar
4f80: 79 20 3b 20 69 6d 6d 65 64 69 61 74 65 0a 0a 69 y ; immediate..i
4f90: 6e 20 6e 65 74 32 6f 20 3a 20 74 69 6d 69 6e 67 n net2o : timing
4fa0: 24 20 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a $ ( -- addr u ).
4fb0: 20 20 20 20 73 74 61 74 73 28 20 74 69 6d 69 6e stats( timin
4fc0: 67 2d 73 74 61 74 20 24 40 20 20 45 58 49 54 20 g-stat $@ EXIT
4fd0: 29 20 2e 22 20 6e 6f 20 74 69 6d 69 6e 67 20 73 ) ." no timing s
4fe0: 74 61 74 73 22 20 63 72 20 73 22 20 22 20 3b 0a tats" cr s" " ;.
4ff0: 69 6e 20 6e 65 74 32 6f 20 3a 20 2f 74 69 6d 69 in net2o : /timi
5000: 6e 67 20 28 20 6e 20 2d 2d 20 29 0a 20 20 20 20 ng ( n -- ).
5010: 73 74 61 74 73 28 20 74 69 6d 69 6e 67 2d 73 74 stats( timing-st
5020: 61 74 20 30 20 72 6f 74 20 24 64 65 6c 20 29 20 at 0 rot $del )
5030: 3b 0a 0a 3a 20 2e 72 65 63 2d 74 69 6d 69 6e 67 ;..: .rec-timing
5040: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 0a 20 ( addr u -- ).
5050: 20 20 20 5b 3a 20 61 63 6b 40 20 3e 6f 20 74 72 [: ack@ >o tr
5060: 61 63 6b 2d 74 69 6d 69 6e 67 20 24 40 20 5c 20 ack-timing $@ \
5070: 64 6f 20 73 6f 6d 65 20 64 75 6d 70 73 0a 20 20 do some dumps.
5080: 20 20 20 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 bounds ?DO..
5090: 20 20 49 20 74 73 2d 64 65 6c 74 61 20 66 3e 36 I ts-delta f>6
50a0: 34 20 6c 61 73 74 2d 74 69 6d 65 20 36 34 2b 21 4 last-time 64+!
50b0: 0a 09 20 20 6c 61 73 74 2d 74 69 6d 65 20 36 34 .. last-time 64
50c0: 40 20 36 34 3e 66 20 31 6e 20 66 2a 20 66 64 75 @ 64>f 1n f* fdu
50d0: 70 20 66 2e 0a 09 20 20 74 69 6d 65 2d 6f 66 66 p f... time-off
50e0: 73 65 74 20 36 34 40 20 36 34 3e 66 20 31 6e 20 set 64@ 64>f 1n
50f0: 66 2a 20 31 30 65 20 66 6d 6f 64 20 66 2b 20 66 f* 10e fmod f+ f
5100: 2e 0a 09 20 20 5c 20 49 20 74 73 2d 64 65 6c 74 ... \ I ts-delt
5110: 61 20 66 2e 0a 09 20 20 49 20 74 73 2d 73 6c 61 a f... I ts-sla
5120: 63 6b 20 31 75 20 66 2a 20 66 2e 0a 09 20 20 74 ck 1u f* f... t
5130: 69 63 6b 2d 69 6e 69 74 20 31 2b 20 6d 61 78 64 ick-init 1+ maxd
5140: 61 74 61 20 2a 20 31 6b 20 66 6d 2a 20 66 64 75 ata * 1k fm* fdu
5150: 70 0a 09 20 20 49 20 74 73 2d 72 65 71 72 61 74 p.. I ts-reqrat
5160: 65 20 66 2f 20 66 2e 0a 09 20 20 49 20 74 73 2d e f/ f... I ts-
5170: 72 61 74 65 20 66 2f 20 66 2e 0a 09 20 20 49 20 rate f/ f... I
5180: 74 73 2d 67 72 6f 77 20 31 75 20 66 2a 20 66 2e ts-grow 1u f* f.
5190: 0a 09 20 20 2e 22 20 74 69 6d 69 6e 67 22 20 63 .. ." timing" c
51a0: 72 0a 20 20 20 20 20 20 74 69 6d 65 73 74 61 74 r. timestat
51b0: 73 20 2b 4c 4f 4f 50 0a 20 20 20 20 20 20 74 72 s +LOOP. tr
51c0: 61 63 6b 2d 74 69 6d 69 6e 67 20 24 6f 66 66 20 ack-timing $off
51d0: 6f 3e 20 3b 5d 20 74 69 6d 69 6e 67 2d 73 65 6d o> ;] timing-sem
51e0: 61 20 63 2d 73 65 63 74 69 6f 6e 20 3b 0a 0a 69 a c-section ;..i
51f0: 6e 20 6e 65 74 32 6f 20 3a 20 72 65 63 2d 74 69 n net2o : rec-ti
5200: 6d 69 6e 67 20 28 20 61 64 64 72 20 75 20 2d 2d ming ( addr u --
5210: 20 29 0a 20 20 20 20 5b 3a 20 74 72 61 63 6b 2d ). [: track-
5220: 74 69 6d 69 6e 67 20 24 2b 21 20 3b 5d 20 74 69 timing $+! ;] ti
5230: 6d 69 6e 67 2d 73 65 6d 61 20 63 2d 73 65 63 74 ming-sema c-sect
5240: 69 6f 6e 20 3b 0a 0a 3a 20 73 74 61 74 2b 20 28 ion ;..: stat+ (
5250: 20 61 64 64 72 20 2d 2d 20 29 20 20 73 74 61 74 addr -- ) stat
5260: 2d 74 75 70 6c 65 20 74 69 6d 65 73 74 61 74 73 -tuple timestats
5270: 20 20 74 69 6d 69 6e 67 2d 73 74 61 74 20 24 2b timing-stat $+
5280: 21 20 3b 0a 0a 5c 20 66 6c 6f 77 20 63 6f 6e 74 ! ;..\ flow cont
5290: 72 6f 6c 0a 0a 3a 20 21 74 69 63 6b 73 20 28 20 rol..: !ticks (
52a0: 2d 2d 20 29 0a 20 20 20 20 74 69 63 6b 73 20 74 -- ). ticks t
52b0: 69 63 6b 65 72 20 36 34 21 20 3b 0a 0a 3a 20 74 icker 64! ;..: t
52c0: 69 63 6b 73 2d 69 6e 69 74 20 28 20 74 69 63 6b icks-init ( tick
52d0: 73 20 2d 2d 20 29 0a 20 20 20 20 36 34 64 75 70 s -- ). 64dup
52e0: 20 62 61 6e 64 77 69 64 74 68 2d 74 69 63 6b 20 bandwidth-tick
52f0: 36 34 21 20 20 6e 65 78 74 2d 74 69 63 6b 20 36 64! next-tick 6
5300: 34 21 20 3b 0a 0a 3a 20 3e 72 74 64 65 6c 61 79 4! ;..: >rtdelay
5310: 20 28 20 63 6c 69 65 6e 74 20 73 65 72 76 20 2d ( client serv -
5320: 2d 20 63 6c 69 65 6e 74 20 73 65 72 76 20 29 0a - client serv ).
5330: 20 20 20 20 72 65 63 76 2d 74 69 63 6b 20 36 34 recv-tick 64
5340: 40 20 36 34 64 75 70 20 6c 61 73 74 61 63 6b 20 @ 64dup lastack
5350: 36 34 21 0a 20 20 20 20 36 34 6f 76 65 72 20 36 64!. 64over 6
5360: 34 2d 20 72 74 64 28 20 2e 22 20 72 74 64 65 6c 4- rtd( ." rtdel
5370: 61 79 20 6d 69 6e 20 74 6f 20 22 20 36 34 64 75 ay min to " 64du
5380: 70 20 36 34 3e 66 20 2e 6e 73 20 63 72 20 29 20 p 64>f .ns cr )
5390: 72 74 64 65 6c 61 79 20 36 34 6d 69 6e 21 20 3b rtdelay 64min! ;
53a0: 0a 0a 3a 20 74 69 6d 65 73 74 61 74 20 28 20 63 ..: timestat ( c
53b0: 6c 69 65 6e 74 20 73 65 72 76 20 2d 2d 20 29 0a lient serv -- ).
53c0: 20 20 20 20 36 34 64 75 70 20 36 34 2d 30 3c 3d 64dup 64-0<=
53d0: 20 20 20 20 49 46 20 20 36 34 64 72 6f 70 20 36 IF 64drop 6
53e0: 34 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4drop EXIT THE
53f0: 4e 0a 20 20 20 20 74 69 6d 69 6e 67 28 20 36 34 N. timing( 64
5400: 6f 76 65 72 20 75 36 34 2e 20 36 34 64 75 70 20 over u64. 64dup
5410: 75 36 34 2e 20 2e 22 20 61 63 6b 74 69 6d 65 22 u64. ." acktime"
5420: 20 63 72 20 29 0a 20 20 20 20 3e 72 74 64 65 6c cr ). >rtdel
5430: 61 79 20 20 36 34 2d 20 36 34 64 75 70 20 6c 61 ay 64- 64dup la
5440: 73 74 73 6c 61 63 6b 20 36 34 21 0a 20 20 20 20 stslack 64!.
5450: 6c 61 73 74 64 65 6c 74 61 74 20 36 34 40 20 64 lastdeltat 64@ d
5460: 65 6c 74 61 2d 64 61 6d 70 23 20 36 34 72 73 68 elta-damp# 64rsh
5470: 69 66 74 0a 20 20 20 20 36 34 64 75 70 20 6d 69 ift. 64dup mi
5480: 6e 2d 73 6c 61 63 6b 20 36 34 2b 21 20 36 34 6e n-slack 64+! 64n
5490: 65 67 61 74 65 20 6d 61 78 2d 73 6c 61 63 6b 20 egate max-slack
54a0: 36 34 2b 21 0a 20 20 20 20 36 34 64 75 70 20 6d 64+!. 64dup m
54b0: 69 6e 2d 73 6c 61 63 6b 20 36 34 6d 69 6e 21 0a in-slack 64min!.
54c0: 20 20 20 20 6d 61 78 2d 73 6c 61 63 6b 20 36 34 max-slack 64
54d0: 6d 61 78 21 20 3b 0a 0a 3a 20 62 32 62 2d 74 69 max! ;..: b2b-ti
54e0: 6d 65 73 74 61 74 20 28 20 63 6c 69 65 6e 74 20 mestat ( client
54f0: 73 65 72 76 20 2d 2d 20 29 0a 20 20 20 20 36 34 serv -- ). 64
5500: 64 75 70 20 36 34 2d 30 3c 3d 20 49 46 20 20 36 dup 64-0<= IF 6
5510: 34 64 72 6f 70 20 36 34 64 72 6f 70 20 20 45 58 4drop 64drop EX
5520: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 36 34 2d IT THEN. 64-
5530: 20 6c 61 73 74 73 6c 61 63 6b 20 36 34 40 20 36 lastslack 64@ 6
5540: 34 2d 20 73 6c 61 63 6b 67 72 6f 77 20 36 34 21 4- slackgrow 64!
5550: 20 3b 0a 0a 73 63 6f 70 65 7b 20 6d 61 70 63 0a ;..scope{ mapc.
5560: 0a 3a 20 3e 6f 66 66 73 65 74 20 28 20 61 64 64 .: >offset ( add
5570: 72 20 2d 2d 20 61 64 64 72 27 20 66 6c 61 67 20 r -- addr' flag
5580: 29 0a 20 20 20 20 64 65 73 74 2d 76 61 64 64 72 ). dest-vaddr
5590: 20 36 34 2d 20 36 34 3e 6e 20 64 75 70 20 64 65 64- 64>n dup de
55a0: 73 74 2d 73 69 7a 65 20 75 3c 20 3b 0a 0a 7d 73 st-size u< ;..}s
55b0: 63 6f 70 65 0a 0a 23 35 30 30 30 30 30 30 20 56 cope..#5000000 V
55c0: 61 6c 75 65 20 72 74 2d 62 69 61 73 23 20 5c 20 alue rt-bias# \
55d0: 35 6d 73 20 61 64 64 69 74 69 6f 6e 61 6c 20 66 5ms additional f
55e0: 6c 79 62 75 72 73 74 73 20 61 6c 6c 6f 77 65 64 lybursts allowed
55f0: 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 73 65 74 ..in net2o : set
5600: 2d 66 6c 79 62 75 72 73 74 20 28 20 2d 2d 20 62 -flyburst ( -- b
5610: 75 72 73 74 73 20 29 0a 20 20 20 20 72 74 64 65 ursts ). rtde
5620: 6c 61 79 20 36 34 40 20 36 34 3e 66 20 72 74 2d lay 64@ 64>f rt-
5630: 62 69 61 73 23 20 73 3e 66 20 66 2b 20 6e 73 2f bias# s>f f+ ns/
5640: 62 75 72 73 74 20 36 34 40 20 36 34 3e 66 20 66 burst 64@ 64>f f
5650: 2f 20 66 3e 73 0a 20 20 20 20 66 6c 79 62 75 72 / f>s. flybur
5660: 73 74 73 23 20 2b 0a 20 20 20 20 62 75 72 73 74 sts# +. burst
5670: 73 28 20 64 75 70 20 2e 20 2e 6f 20 2e 22 20 66 s( dup . .o ." f
5680: 6c 79 62 75 72 73 74 73 20 22 0a 20 20 20 20 72 lybursts ". r
5690: 74 64 65 6c 61 79 20 36 34 40 20 75 36 34 2e 20 tdelay 64@ u64.
56a0: 6e 73 2f 62 75 72 73 74 20 36 34 40 20 75 36 34 ns/burst 64@ u64
56b0: 2e 20 2e 22 20 72 74 64 65 6c 61 79 22 20 63 72 . ." rtdelay" cr
56c0: 20 29 0a 20 20 20 20 64 75 70 20 66 6c 79 62 75 ). dup flybu
56d0: 72 73 74 73 2d 6d 61 78 23 20 6d 69 6e 20 72 61 rsts-max# min ra
56e0: 74 65 28 20 2e 22 20 66 6c 79 62 75 72 73 74 3a te( ." flyburst:
56f0: 20 22 20 64 75 70 20 2e 20 29 20 66 6c 79 62 75 " dup . ) flybu
5700: 72 73 74 20 21 20 3b 0a 69 6e 20 6e 65 74 32 6f rst ! ;.in net2o
5710: 20 3a 20 6d 61 78 2d 66 6c 79 62 75 72 73 74 20 : max-flyburst
5720: 28 20 62 75 72 73 74 73 20 2d 2d 20 29 20 20 66 ( bursts -- ) f
5730: 6c 79 62 75 72 73 74 73 2d 6d 61 78 23 20 6d 69 lybursts-max# mi
5740: 6e 20 66 6c 79 62 75 72 73 74 73 20 6d 61 78 21 n flybursts max!
5750: 40 0a 20 20 20 20 62 75 72 73 74 73 28 20 30 3d @. bursts( 0=
5760: 20 49 46 20 20 2e 6f 20 2e 22 20 73 74 61 72 74 IF .o ." start
5770: 20 62 75 72 73 74 73 22 20 63 72 20 54 48 45 4e bursts" cr THEN
5780: 20 29 65 6c 73 65 28 20 64 72 6f 70 20 29 20 3b )else( drop ) ;
5790: 0a 0a 3a 20 3e 66 6c 79 62 75 72 73 74 20 28 20 ..: >flyburst (
57a0: 2d 2d 20 29 0a 20 20 20 20 66 6c 79 62 75 72 73 -- ). flyburs
57b0: 74 20 40 20 66 6c 79 62 75 72 73 74 73 20 6d 61 t @ flybursts ma
57c0: 78 21 40 20 5c 20 72 65 73 65 74 20 62 75 72 73 x!@ \ reset burs
57d0: 74 73 20 69 6e 20 66 6c 69 67 68 74 0a 20 20 20 ts in flight.
57e0: 20 30 3d 20 49 46 20 20 72 65 63 76 2d 74 69 63 0= IF recv-tic
57f0: 6b 20 36 34 40 20 74 69 63 6b 73 2d 69 6e 69 74 k 64@ ticks-init
5800: 0a 09 62 75 72 73 74 73 28 20 2e 6f 20 2e 22 20 ..bursts( .o ."
5810: 72 65 73 74 61 72 74 20 62 75 72 73 74 73 20 22 restart bursts "
5820: 20 66 6c 79 62 75 72 73 74 73 20 3f 20 63 72 20 flybursts ? cr
5830: 29 0a 09 6e 65 74 32 6f 3a 73 65 74 2d 66 6c 79 )..net2o:set-fly
5840: 62 75 72 73 74 20 6e 65 74 32 6f 3a 6d 61 78 2d burst net2o:max-
5850: 66 6c 79 62 75 72 73 74 0a 20 20 20 20 54 48 45 flyburst. THE
5860: 4e 20 3b 0a 0a 3a 20 3e 74 69 6d 65 73 74 61 6d N ;..: >timestam
5870: 70 20 28 20 74 69 6d 65 20 61 64 64 72 20 2d 2d p ( time addr --
5880: 20 74 69 6d 65 27 20 74 73 2d 61 72 72 61 79 20 time' ts-array
5890: 69 6e 64 65 78 20 2f 20 74 69 6d 65 27 20 30 20 index / time' 0
58a0: 30 20 29 0a 20 20 20 20 3e 66 6c 79 62 75 72 73 0 ). >flyburs
58b0: 74 0a 20 20 20 20 36 34 3e 72 20 74 69 6d 65 2d t. 64>r time-
58c0: 6f 66 66 73 65 74 20 36 34 40 20 36 34 2b 20 36 offset 64@ 64+ 6
58d0: 34 72 3e 0a 20 20 20 20 70 61 72 65 6e 74 20 2e 4r>. parent .
58e0: 64 61 74 61 2d 6d 61 70 20 64 75 70 20 30 3d 20 data-map dup 0=
58f0: 49 46 20 20 64 72 6f 70 20 30 20 30 20 20 45 58 IF drop 0 0 EX
5900: 49 54 20 20 54 48 45 4e 20 20 3e 72 0a 20 20 20 IT THEN >r.
5910: 20 72 40 20 77 69 74 68 20 6d 61 70 63 20 3e 6f r@ with mapc >o
5920: 66 66 73 65 74 20 20 49 46 0a 09 64 65 73 74 2d ffset IF..dest-
5930: 74 61 69 6c 20 64 65 73 74 2d 73 69 7a 65 20 65 tail dest-size e
5940: 6e 64 77 69 74 68 20 20 3e 72 20 6f 76 65 72 20 ndwith >r over
5950: 2d 20 72 3e 20 31 2d 20 61 6e 64 0a 09 61 64 64 - r> 1- and..add
5960: 72 3e 62 69 74 73 20 31 20 6d 61 78 20 77 69 6e r>bits 1 max win
5970: 64 6f 77 2d 73 69 7a 65 20 21 0a 09 61 64 64 72 dow-size !..addr
5980: 3e 74 73 20 72 3e 20 2e 6d 61 70 63 3a 64 65 73 >ts r> .mapc:des
5990: 74 2d 74 69 6d 65 73 74 61 6d 70 73 20 73 77 61 t-timestamps swa
59a0: 70 0a 20 20 20 20 45 4c 53 45 20 20 6f 3e 20 72 p. ELSE o> r
59b0: 64 72 6f 70 20 30 20 30 20 20 54 48 45 4e 20 3b drop 0 0 THEN ;
59c0: 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 61 63 6b ..in net2o : ack
59d0: 2d 61 64 64 72 74 69 6d 65 20 28 20 74 69 63 6b -addrtime ( tick
59e0: 73 20 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 s addr -- ).
59f0: 3e 74 69 6d 65 73 74 61 6d 70 20 6f 76 65 72 20 >timestamp over
5a00: 20 49 46 0a 09 64 75 70 20 74 69 63 6b 2d 69 6e IF..dup tick-in
5a10: 69 74 20 31 2b 20 36 34 73 20 75 3e 0a 09 49 46 it 1+ 64s u>..IF
5a20: 20 20 2b 20 64 75 70 20 3e 72 20 20 36 34 40 0a + dup >r 64@.
5a30: 09 20 20 20 20 72 40 20 74 69 63 6b 2d 69 6e 69 . r@ tick-ini
5a40: 74 20 31 2b 20 36 34 73 20 2d 20 36 34 40 0a 09 t 1+ 64s - 64@..
5a50: 20 20 20 20 36 34 64 75 70 20 36 34 2d 30 3c 3d 64dup 64-0<=
5a60: 20 3e 72 20 36 34 6f 76 65 72 20 36 34 2d 30 3c >r 64over 64-0<
5a70: 3d 20 72 3e 20 6f 72 0a 09 20 20 20 20 49 46 20 = r> or.. IF
5a80: 20 36 34 64 72 6f 70 20 36 34 64 72 6f 70 20 20 64drop 64drop
5a90: 45 4c 53 45 20 20 36 34 2d 20 6c 61 73 74 64 65 ELSE 64- lastde
5aa0: 6c 74 61 74 20 36 34 21 20 20 54 48 45 4e 20 20 ltat 64! THEN
5ab0: 72 3e 0a 09 45 4c 53 45 20 20 2b 20 20 54 48 45 r>..ELSE + THE
5ac0: 4e 0a 09 36 34 40 20 74 69 6d 65 73 74 61 74 0a N..64@ timestat.
5ad0: 20 20 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 ELSE 2drop
5ae0: 36 34 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 64drop THEN ;..
5af0: 69 6e 20 6e 65 74 32 6f 20 3a 20 61 63 6b 2d 62 in net2o : ack-b
5b00: 32 62 74 69 6d 65 20 28 20 74 69 63 6b 73 20 61 2btime ( ticks a
5b10: 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 3e 74 69 ddr -- ). >ti
5b20: 6d 65 73 74 61 6d 70 20 6f 76 65 72 20 20 49 46 mestamp over IF
5b30: 20 20 2b 20 36 34 40 20 62 32 62 2d 74 69 6d 65 + 64@ b2b-time
5b40: 73 74 61 74 0a 20 20 20 20 45 4c 53 45 20 20 32 stat. ELSE 2
5b50: 64 72 6f 70 20 36 34 64 72 6f 70 20 20 54 48 45 drop 64drop THE
5b60: 4e 20 3b 0a 0a 5c 20 73 65 74 20 72 61 74 65 20 N ;..\ set rate
5b70: 63 61 6c 63 75 6c 61 74 69 6f 6e 0a 0a 23 32 30 calculation..#20
5b80: 30 30 30 30 30 30 20 56 61 6c 75 65 20 73 6c 61 000000 Value sla
5b90: 63 6b 2d 64 65 66 61 75 6c 74 23 20 5c 20 32 30 ck-default# \ 20
5ba0: 6d 73 20 73 6c 61 63 6b 20 6c 65 61 64 73 20 74 ms slack leads t
5bb0: 6f 20 62 61 63 6b 64 72 6f 70 20 6f 66 20 66 61 o backdrop of fa
5bc0: 63 74 6f 72 20 32 0a 23 31 30 30 30 30 30 30 20 ctor 2.#1000000
5bd0: 56 61 6c 75 65 20 73 6c 61 63 6b 2d 62 69 61 73 Value slack-bias
5be0: 23 20 5c 20 31 6d 73 20 77 69 74 68 6f 75 74 20 # \ 1ms without
5bf0: 65 66 66 65 63 74 0a 73 6c 61 63 6b 2d 64 65 66 effect.slack-def
5c00: 61 75 6c 74 23 20 32 2a 20 32 2a 20 6e 3e 36 34 ault# 2* 2* n>64
5c10: 20 36 34 43 6f 6e 73 74 61 6e 74 20 73 6c 61 63 64Constant slac
5c20: 6b 2d 69 67 6e 6f 72 65 23 20 5c 20 61 62 6f 76 k-ignore# \ abov
5c30: 65 20 38 30 6d 73 20 69 73 20 69 67 6e 6f 72 65 e 80ms is ignore
5c40: 64 0a 23 30 20 56 61 6c 75 65 20 73 6c 61 63 6b d.#0 Value slack
5c50: 2d 6d 69 6e 23 20 5c 20 6d 69 6e 69 6d 75 6d 20 -min# \ minimum
5c60: 65 66 66 65 63 74 20 6c 69 6d 69 74 0a 33 20 34 effect limit.3 4
5c70: 20 32 43 6f 6e 73 74 61 6e 74 20 65 78 74 2d 64 2Constant ext-d
5c80: 61 6d 70 23 20 5c 20 37 35 25 20 64 61 6d 70 69 amp# \ 75% dampi
5c90: 6e 67 0a 35 20 32 20 32 43 6f 6e 73 74 61 6e 74 ng.5 2 2Constant
5ca0: 20 64 65 6c 74 61 2d 74 2d 67 72 6f 77 23 20 5c delta-t-grow# \
5cb0: 20 34 20 74 69 6d 65 73 20 64 65 6c 74 61 2d 74 4 times delta-t
5cc0: 0a 0a 3a 20 73 6c 61 63 6b 2d 6d 61 78 23 20 28 ..: slack-max# (
5cd0: 20 2d 2d 20 6e 20 29 20 6d 61 78 2d 73 6c 61 63 -- n ) max-slac
5ce0: 6b 20 36 34 40 20 6d 69 6e 2d 73 6c 61 63 6b 20 k 64@ min-slack
5cf0: 36 34 40 20 36 34 2d 20 3b 0a 3a 20 73 6c 61 63 64@ 64- ;.: slac
5d00: 6b 23 20 28 20 2d 2d 20 6e 20 29 20 20 73 6c 61 k# ( -- n ) sla
5d10: 63 6b 2d 6d 61 78 23 20 36 34 3e 6e 20 32 2f 20 ck-max# 64>n 2/
5d20: 32 2f 20 73 6c 61 63 6b 2d 64 65 66 61 75 6c 74 2/ slack-default
5d30: 23 20 6d 61 78 20 3b 0a 0a 3a 20 3e 73 6c 61 63 # max ;..: >slac
5d40: 6b 2d 65 78 70 20 28 20 2d 2d 20 72 66 61 63 74 k-exp ( -- rfact
5d50: 6f 72 20 29 0a 20 20 20 20 6c 61 73 74 73 6c 61 or ). lastsla
5d60: 63 6b 20 36 34 40 20 6d 69 6e 2d 73 6c 61 63 6b ck 64@ min-slack
5d70: 20 36 34 40 20 36 34 2d 0a 20 20 20 20 36 34 64 64@ 64-. 64d
5d80: 75 70 20 36 34 61 62 73 20 73 6c 61 63 6b 2d 69 up 64abs slack-i
5d90: 67 6e 6f 72 65 23 20 36 34 75 3e 20 49 46 0a 09 gnore# 64u> IF..
5da0: 6d 73 67 28 20 2e 22 20 73 6c 61 63 6b 20 69 67 msg( ." slack ig
5db0: 6e 6f 72 65 64 3a 20 22 20 36 34 64 75 70 20 75 nored: " 64dup u
5dc0: 36 34 2e 20 63 72 20 29 0a 09 36 34 64 72 6f 70 64. cr )..64drop
5dd0: 20 36 34 23 30 20 6c 61 73 74 73 6c 61 63 6b 20 64#0 lastslack
5de0: 36 34 40 20 6d 69 6e 2d 73 6c 61 63 6b 20 36 34 64@ min-slack 64
5df0: 21 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 36 !. THEN. 6
5e00: 34 3e 6e 20 73 74 61 74 73 28 20 64 75 70 20 73 4>n stats( dup s
5e10: 3e 66 20 73 74 61 74 2d 74 75 70 6c 65 20 74 6f >f stat-tuple to
5e20: 20 74 73 2d 73 6c 61 63 6b 20 29 0a 20 20 20 20 ts-slack ).
5e30: 73 6c 61 63 6b 2d 62 69 61 73 23 20 2d 20 73 6c slack-bias# - sl
5e40: 61 63 6b 2d 6d 69 6e 23 20 6d 61 78 20 73 6c 61 ack-min# max sla
5e50: 63 6b 23 20 32 2a 20 32 2a 20 6d 69 6e 0a 20 20 ck# 2* 2* min.
5e60: 20 20 73 3e 66 20 73 6c 61 63 6b 23 20 66 6d 2f s>f slack# fm/
5e70: 20 32 65 20 66 73 77 61 70 20 66 2a 2a 20 3b 0a 2e fswap f** ;.
5e80: 0a 3a 20 61 67 67 72 65 73 73 69 76 69 74 79 2d .: aggressivity-
5e90: 72 61 74 65 20 28 20 73 6c 61 63 6b 20 2d 2d 20 rate ( slack --
5ea0: 73 6c 61 63 6b 27 20 29 0a 20 20 20 20 73 6c 61 slack' ). sla
5eb0: 63 6b 2d 6d 61 78 23 20 36 34 2d 32 2f 20 36 34 ck-max# 64-2/ 64
5ec0: 3e 6e 20 73 6c 61 63 6b 2d 64 65 66 61 75 6c 74 >n slack-default
5ed0: 23 20 74 75 63 6b 20 6d 69 6e 20 73 77 61 70 20 # tuck min swap
5ee0: 36 34 2a 2f 20 3b 0a 0a 3a 20 73 6c 61 63 6b 65 64*/ ;..: slacke
5ef0: 78 74 20 28 20 72 66 61 63 74 6f 72 20 2d 2d 20 xt ( rfactor --
5f00: 73 6c 61 63 6b 20 29 0a 20 20 20 20 73 6c 61 63 slack ). slac
5f10: 6b 67 72 6f 77 20 36 34 40 0a 20 20 20 20 77 69 kgrow 64@. wi
5f20: 6e 64 6f 77 2d 73 69 7a 65 20 40 20 74 69 63 6b ndow-size @ tick
5f30: 2d 69 6e 69 74 20 31 2b 20 62 75 72 73 74 73 23 -init 1+ bursts#
5f40: 20 2d 20 32 2a 20 36 34 2a 2f 0a 20 20 20 20 36 - 2* 64*/. 6
5f50: 34 3e 66 20 66 2a 20 66 3e 36 34 0a 20 20 20 20 4>f f* f>64.
5f60: 73 6c 61 63 6b 67 72 6f 77 27 20 36 34 40 20 36 slackgrow' 64@ 6
5f70: 34 2b 20 36 34 64 75 70 20 65 78 74 2d 64 61 6d 4+ 64dup ext-dam
5f80: 70 23 20 36 34 2a 2f 20 73 6c 61 63 6b 67 72 6f p# 64*/ slackgro
5f90: 77 27 20 36 34 21 0a 20 20 20 20 36 34 23 30 20 w' 64!. 64#0
5fa0: 36 34 6d 61 78 20 61 67 67 72 65 73 73 69 76 69 64max aggressivi
5fb0: 74 79 2d 72 61 74 65 20 3b 0a 0a 3a 20 72 61 74 ty-rate ;..: rat
5fc0: 65 2d 6c 69 6d 69 74 20 28 20 72 61 74 65 20 2d e-limit ( rate -
5fd0: 2d 20 72 61 74 65 27 20 29 0a 20 20 20 20 5c 20 - rate' ). \
5fe0: 6e 6f 74 20 74 6f 6f 20 71 75 69 63 6b 6c 79 20 not too quickly
5ff0: 67 6f 20 66 61 73 74 65 72 21 0a 20 20 20 20 36 go faster!. 6
6000: 34 64 75 70 20 6c 61 73 74 2d 6e 73 2f 62 75 72 4dup last-ns/bur
6010: 73 74 20 36 34 21 40 20 36 34 6d 61 78 20 3b 0a st 64!@ 64max ;.
6020: 0a 3a 20 3e 65 78 74 72 61 2d 6e 73 20 28 20 72 .: >extra-ns ( r
6030: 61 74 65 20 2d 2d 20 72 61 74 65 27 20 29 0a 20 ate -- rate' ).
6040: 20 20 20 3e 73 6c 61 63 6b 2d 65 78 70 20 66 64 >slack-exp fd
6050: 75 70 20 36 34 3e 66 20 66 2a 20 66 3e 36 34 20 up 64>f f* f>64
6060: 73 6c 61 63 6b 65 78 74 0a 20 20 20 20 36 34 6f slackext. 64o
6070: 76 65 72 20 36 34 2d 32 2a 20 36 34 2d 32 2a 20 ver 64-2* 64-2*
6080: 36 34 6d 69 6e 20 5c 20 6c 69 6d 69 74 20 74 6f 64min \ limit to
6090: 20 34 2a 20 72 61 74 65 0a 20 20 20 20 36 34 64 4* rate. 64d
60a0: 75 70 20 65 78 74 72 61 2d 6e 73 20 36 34 21 20 up extra-ns 64!
60b0: 36 34 2b 20 3b 0a 0a 3a 20 72 61 74 65 2d 73 74 64+ ;..: rate-st
60c0: 61 74 31 20 28 20 72 61 74 65 20 64 65 6c 74 61 at1 ( rate delta
60d0: 74 20 2d 2d 20 29 0a 20 20 20 20 73 74 61 74 73 t -- ). stats
60e0: 28 20 72 65 63 76 2d 74 69 63 6b 20 36 34 40 20 ( recv-tick 64@
60f0: 74 69 6d 65 2d 6f 66 66 73 65 74 20 36 34 40 20 time-offset 64@
6100: 36 34 2d 0a 20 20 20 20 20 20 20 20 20 20 20 36 64-. 6
6110: 34 64 75 70 20 6c 61 73 74 2d 74 69 6d 65 20 36 4dup last-time 6
6120: 34 21 40 20 36 34 2d 20 36 34 3e 66 20 73 74 61 4!@ 64- 64>f sta
6130: 74 2d 74 75 70 6c 65 20 74 6f 20 74 73 2d 64 65 t-tuple to ts-de
6140: 6c 74 61 0a 20 20 20 20 20 20 20 20 20 20 20 36 lta. 6
6150: 34 6f 76 65 72 20 36 34 3e 66 20 73 74 61 74 2d 4over 64>f stat-
6160: 74 75 70 6c 65 20 74 6f 20 74 73 2d 72 65 71 72 tuple to ts-reqr
6170: 61 74 65 20 29 20 3b 0a 0a 3a 20 72 61 74 65 2d ate ) ;..: rate-
6180: 73 74 61 74 32 20 28 20 72 61 74 65 20 2d 2d 20 stat2 ( rate --
6190: 72 61 74 65 20 29 0a 20 20 20 20 73 74 61 74 73 rate ). stats
61a0: 28 20 36 34 64 75 70 20 65 78 74 72 61 2d 6e 73 ( 64dup extra-ns
61b0: 20 36 34 40 20 36 34 2b 20 36 34 3e 66 20 73 74 64@ 64+ 64>f st
61c0: 61 74 2d 74 75 70 6c 65 20 74 6f 20 74 73 2d 72 at-tuple to ts-r
61d0: 61 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 73 ate. s
61e0: 6c 61 63 6b 67 72 6f 77 20 36 34 40 20 36 34 3e lackgrow 64@ 64>
61f0: 66 20 73 74 61 74 2d 74 75 70 6c 65 20 74 6f 20 f stat-tuple to
6200: 74 73 2d 67 72 6f 77 0a 20 20 20 20 20 20 20 20 ts-grow.
6210: 20 20 20 73 74 61 74 2b 20 29 20 3b 0a 0a 69 6e stat+ ) ;..in
6220: 20 6e 65 74 32 6f 20 3a 20 73 65 74 2d 72 61 74 net2o : set-rat
6230: 65 20 28 20 72 61 74 65 20 64 65 6c 74 61 74 20 e ( rate deltat
6240: 2d 2d 20 29 0a 20 20 20 20 72 61 74 65 28 20 2e -- ). rate( .
6250: 22 20 72 2f 64 3a 20 22 20 36 34 6f 76 65 72 20 " r/d: " 64over
6260: 75 36 34 2e 20 36 34 64 75 70 20 75 36 34 2e 20 u64. 64dup u64.
6270: 29 0a 20 20 20 20 72 61 74 65 2d 73 74 61 74 31 ). rate-stat1
6280: 0a 20 20 20 20 36 34 3e 72 20 74 69 63 6b 2d 69 . 64>r tick-i
6290: 6e 69 74 20 31 2b 20 76 61 6c 69 64 61 74 65 64 nit 1+ validated
62a0: 20 40 20 76 61 6c 69 64 61 74 65 64 23 20 72 73 @ validated# rs
62b0: 68 69 66 74 20 31 20 6d 61 78 20 36 34 2a 2f 0a hift 1 max 64*/.
62c0: 20 20 20 20 36 34 64 75 70 20 3e 65 78 74 72 61 64dup >extra
62d0: 2d 6e 73 20 6e 6f 65 6e 73 28 20 36 34 64 72 6f -ns noens( 64dro
62e0: 70 20 29 65 6c 73 65 28 20 36 34 6e 69 70 20 29 p )else( 64nip )
62f0: 0a 20 20 20 20 36 34 72 3e 20 64 65 6c 74 61 2d . 64r> delta-
6300: 74 2d 67 72 6f 77 23 20 36 34 2a 2f 20 36 34 6d t-grow# 64*/ 64m
6310: 69 6e 20 28 20 6e 6f 20 6d 6f 72 65 20 74 68 61 in ( no more tha
6320: 6e 20 32 2a 64 65 6c 74 61 74 20 29 0a 20 20 20 n 2*deltat ).
6330: 20 62 61 6e 64 77 69 64 74 68 2d 6d 61 78 20 6e bandwidth-max n
6340: 3e 36 34 20 36 34 6d 61 78 0a 20 20 20 20 72 61 >64 64max. ra
6350: 74 65 2d 6c 69 6d 69 74 20 20 72 61 74 65 2d 73 te-limit rate-s
6360: 74 61 74 32 20 72 61 74 65 28 20 2e 22 20 72 61 tat2 rate( ." ra
6370: 74 65 3a 20 22 20 36 34 64 75 70 20 75 36 34 2e te: " 64dup u64.
6380: 20 29 0a 20 20 20 20 6e 73 2f 62 75 72 73 74 20 ). ns/burst
6390: 36 34 21 40 20 62 61 6e 64 77 69 64 74 68 2d 69 64!@ bandwidth-i
63a0: 6e 69 74 20 6e 3e 36 34 20 36 34 3d 20 49 46 20 nit n>64 64= IF
63b0: 5c 20 66 69 72 73 74 20 61 63 6b 6e 6f 77 6c 65 \ first acknowle
63c0: 64 67 65 0a 09 6e 65 74 32 6f 3a 73 65 74 2d 66 dge..net2o:set-f
63d0: 6c 79 62 75 72 73 74 0a 09 6e 65 74 32 6f 3a 6d lyburst..net2o:m
63e0: 61 78 2d 66 6c 79 62 75 72 73 74 0a 20 20 20 20 ax-flyburst.
63f0: 54 48 45 4e 20 72 61 74 65 28 20 63 72 20 29 20 THEN rate( cr )
6400: 3b 0a 0a 5c 20 61 63 6b 6e 6f 77 6c 65 64 67 65 ;..\ acknowledge
6410: 0a 0a 24 32 30 20 56 61 6c 75 65 20 6d 61 73 6b ..$20 Value mask
6420: 2d 62 69 74 73 23 0a 3a 20 3e 6d 61 73 6b 30 20 -bits#.: >mask0
6430: 28 20 61 64 64 72 20 6d 61 73 6b 20 2d 2d 20 61 ( addr mask -- a
6440: 64 64 72 27 20 6d 61 73 6b 27 20 29 0a 20 20 20 ddr' mask' ).
6450: 20 42 45 47 49 4e 20 20 64 75 70 20 31 20 61 6e BEGIN dup 1 an
6460: 64 20 30 3d 20 57 48 49 4c 45 20 20 31 20 72 73 d 0= WHILE 1 rs
6470: 68 69 66 74 20 3e 72 20 6d 61 78 64 61 74 61 20 hift >r maxdata
6480: 2b 20 72 3e 20 20 64 75 70 20 30 3d 20 55 4e 54 + r> dup 0= UNT
6490: 49 4c 20 20 54 48 45 4e 20 3b 0a 3a 20 3e 6c 65 IL THEN ;.: >le
64a0: 67 69 74 2d 62 61 63 6b 20 28 20 61 64 64 72 20 git-back ( addr
64b0: 6d 61 73 6b 20 2d 2d 20 61 64 64 72 27 20 6d 61 mask -- addr' ma
64c0: 73 6b 27 20 29 0a 20 20 20 20 64 61 74 61 2d 6d sk' ). data-m
64d0: 61 70 20 2e 6d 61 70 63 3a 64 65 73 74 2d 62 61 ap .mapc:dest-ba
64e0: 63 6b 20 3e 72 0a 20 20 20 20 6f 76 65 72 20 72 ck >r. over r
64f0: 40 20 5b 20 6d 61 78 64 61 74 61 20 24 32 30 20 @ [ maxdata $20
6500: 2a 20 5d 4c 20 75 6d 61 78 20 5b 20 6d 61 78 64 * ]L umax [ maxd
6510: 61 74 61 20 24 32 30 20 2a 20 5d 4c 20 20 2d 20 ata $20 * ]L -
6520: 75 3c 0a 20 20 20 20 49 46 20 20 72 3e 20 32 64 u<. IF r> 2d
6530: 72 6f 70 20 30 20 20 45 58 49 54 20 20 54 48 45 rop 0 EXIT THE
6540: 4e 0a 20 20 20 20 6f 76 65 72 20 72 40 20 75 3c N. over r@ u<
6550: 20 49 46 20 20 72 40 20 72 6f 74 20 2d 20 61 64 IF r@ rot - ad
6560: 64 72 3e 62 69 74 73 20 72 73 68 69 66 74 20 72 dr>bits rshift r
6570: 3e 20 73 77 61 70 20 20 45 58 49 54 20 20 54 48 > swap EXIT TH
6580: 45 4e 0a 20 20 20 20 72 64 72 6f 70 20 3b 0a 3a EN. rdrop ;.:
6590: 20 3e 6c 65 67 69 74 2d 68 65 61 64 20 28 20 61 >legit-head ( a
65a0: 64 64 72 20 6d 61 73 6b 20 2d 2d 20 61 64 64 72 ddr mask -- addr
65b0: 27 20 6d 61 73 6b 27 20 29 0a 20 20 20 20 64 61 ' mask' ). da
65c0: 74 61 2d 6d 61 70 20 2e 6d 61 70 63 3a 64 65 73 ta-map .mapc:des
65d0: 74 2d 68 65 61 64 20 3e 72 0a 20 20 20 20 6f 76 t-head >r. ov
65e0: 65 72 20 72 40 20 75 3e 3d 0a 20 20 20 20 49 46 er r@ u>=. IF
65f0: 20 20 72 3e 20 32 64 72 6f 70 20 30 20 20 45 58 r> 2drop 0 EX
6600: 49 54 20 20 54 48 45 4e 0a 20 20 20 20 6f 76 65 IT THEN. ove
6610: 72 20 5b 20 6d 61 78 64 61 74 61 20 24 32 30 20 r [ maxdata $20
6620: 2a 20 5d 4c 20 2b 20 72 40 20 75 3e 0a 20 20 20 * ]L + r@ u>.
6630: 20 49 46 20 20 6f 76 65 72 20 5b 20 6d 61 78 64 IF over [ maxd
6640: 61 74 61 20 24 32 30 20 2a 20 5d 4c 20 2b 20 72 ata $20 * ]L + r
6650: 3e 20 2d 20 61 64 64 72 3e 62 69 74 73 20 2d 31 > - addr>bits -1
6660: 20 73 77 61 70 20 6c 73 68 69 66 74 0a 09 69 6e swap lshift..in
6670: 76 65 72 74 20 61 6e 64 20 20 45 58 49 54 20 20 vert and EXIT
6680: 54 48 45 4e 0a 20 20 20 20 72 64 72 6f 70 20 3b THEN. rdrop ;
6690: 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 72 65 73 65 .in net2o : rese
66a0: 6e 64 2d 6d 61 73 6b 20 28 20 61 64 64 72 20 6d nd-mask ( addr m
66b0: 61 73 6b 20 2d 2d 20 29 0a 20 20 20 20 3e 6c 65 ask -- ). >le
66c0: 67 69 74 2d 62 61 63 6b 20 3e 6c 65 67 69 74 2d git-back >legit-
66d0: 68 65 61 64 20 64 75 70 20 30 3d 20 49 46 20 20 head dup 0= IF
66e0: 32 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 2drop EXIT THE
66f0: 4e 0a 20 20 20 20 3e 6d 61 73 6b 30 0a 20 20 20 N. >mask0.
6700: 20 72 65 73 65 6e 64 28 20 2e 22 20 6d 61 73 6b resend( ." mask
6710: 3a 20 22 20 68 65 78 5b 20 3e 72 20 64 75 70 20 : " hex[ >r dup
6720: 75 2e 20 72 3e 20 64 75 70 20 75 2e 20 5d 68 65 u. r> dup u. ]he
6730: 78 20 63 72 20 29 0a 20 20 20 20 64 61 74 61 2d x cr ). data-
6740: 72 65 73 65 6e 64 20 24 40 20 62 6f 75 6e 64 73 resend $@ bounds
6750: 20 3f 44 4f 0a 09 6f 76 65 72 20 49 20 63 65 6c ?DO..over I cel
6760: 6c 2b 20 40 20 73 77 61 70 20 64 75 70 20 6d 61 l+ @ swap dup ma
6770: 78 64 61 74 61 20 6d 61 73 6b 2d 62 69 74 73 23 xdata mask-bits#
6780: 20 2a 20 2b 20 77 69 74 68 69 6e 20 49 46 0a 09 * + within IF..
6790: 20 20 20 20 6f 76 65 72 20 49 20 32 40 20 72 6f over I 2@ ro
67a0: 74 20 3e 72 0a 09 20 20 20 20 42 45 47 49 4e 20 t >r.. BEGIN
67b0: 20 6f 76 65 72 20 72 40 20 75 3e 20 20 57 48 49 over r@ u> WHI
67c0: 4c 45 20 20 32 2a 20 3e 72 20 6d 61 78 64 61 74 LE 2* >r maxdat
67d0: 61 20 2d 20 72 3e 20 20 52 45 50 45 41 54 0a 09 a - r> REPEAT..
67e0: 20 20 20 20 72 64 72 6f 70 20 6e 69 70 20 6f 72 rdrop nip or
67f0: 20 3e 6d 61 73 6b 30 0a 09 20 20 20 20 72 65 73 >mask0.. res
6800: 65 6e 64 28 20 49 20 32 40 20 68 65 78 5b 20 2e end( I 2@ hex[ .
6810: 22 20 72 65 70 6c 61 63 65 3a 20 22 20 73 77 61 " replace: " swa
6820: 70 20 2e 20 2e 20 2e 22 20 2d 3e 20 22 0a 09 20 p . . ." -> "..
6830: 20 20 20 3e 72 20 64 75 70 20 75 2e 20 72 3e 20 >r dup u. r>
6840: 64 75 70 20 75 2e 20 63 72 20 5d 68 65 78 20 29 dup u. cr ]hex )
6850: 0a 09 20 20 20 20 49 20 32 21 20 20 55 4e 4c 4f .. I 2! UNLO
6860: 4f 50 20 20 45 58 49 54 0a 09 54 48 45 4e 0a 20 OP EXIT..THEN.
6870: 20 20 20 32 20 63 65 6c 6c 73 20 2b 4c 4f 4f 50 2 cells +LOOP
6880: 20 7b 20 64 5e 20 6d 61 73 6b 2b 20 7d 20 6d 61 { d^ mask+ } ma
6890: 73 6b 2b 20 32 20 63 65 6c 6c 73 20 64 61 74 61 sk+ 2 cells data
68a0: 2d 72 65 73 65 6e 64 20 24 2b 21 20 3b 0a 69 6e -resend $+! ;.in
68b0: 20 6e 65 74 32 6f 20 3a 20 61 63 6b 2d 72 65 73 net2o : ack-res
68c0: 65 6e 64 20 28 20 66 6c 61 67 20 2d 2d 20 29 20 end ( flag -- )
68d0: 20 72 65 73 65 6e 64 2d 74 6f 67 67 6c 65 23 20 resend-toggle#
68e0: 61 6e 64 20 74 6f 20 61 63 6b 2d 72 65 73 65 6e and to ack-resen
68f0: 64 7e 20 3b 0a 3a 20 72 65 73 65 6e 64 24 40 20 d~ ;.: resend$@
6900: 28 20 2d 2d 20 61 64 64 72 20 75 20 29 0a 20 20 ( -- addr u ).
6910: 20 20 64 61 74 61 2d 72 65 73 65 6e 64 20 24 40 data-resend $@
6920: 20 20 49 46 0a 09 32 40 20 3e 6d 61 73 6b 30 20 IF..2@ >mask0
6930: 31 20 61 6e 64 20 49 46 20 20 6d 61 78 64 61 74 1 and IF maxdat
6940: 61 20 20 45 4c 53 45 20 20 30 20 20 54 48 45 4e a ELSE 0 THEN
6950: 0a 09 73 77 61 70 20 64 61 74 61 2d 6d 61 70 20 ..swap data-map
6960: 3e 6f 20 6d 61 70 63 3a 64 65 73 74 2d 73 69 7a >o mapc:dest-siz
6970: 65 20 31 2d 20 61 6e 64 20 6d 61 70 63 3a 64 65 e 1- and mapc:de
6980: 73 74 2d 72 61 64 64 72 20 2b 20 6f 3e 20 73 77 st-raddr + o> sw
6990: 61 70 0a 20 20 20 20 45 4c 53 45 20 20 64 72 6f ap. ELSE dro
69a0: 70 20 30 20 30 20 20 54 48 45 4e 20 3b 0a 3a 20 p 0 0 THEN ;.:
69b0: 72 65 73 65 6e 64 3f 20 28 20 2d 2d 20 66 6c 61 resend? ( -- fla
69c0: 67 20 29 0a 20 20 20 20 64 61 74 61 2d 72 65 73 g ). data-res
69d0: 65 6e 64 20 24 40 20 20 49 46 0a 09 32 40 20 30 end $@ IF..2@ 0
69e0: 3c 3e 20 73 77 61 70 20 64 61 74 61 2d 6d 61 70 <> swap data-map
69f0: 20 2e 6d 61 70 63 3a 64 65 73 74 2d 68 65 61 64 .mapc:dest-head
6a00: 20 75 3c 20 61 6e 64 0a 20 20 20 20 45 4c 53 45 u< and. ELSE
6a10: 20 20 64 72 6f 70 20 66 61 6c 73 65 20 20 54 48 drop false TH
6a20: 45 4e 20 3b 0a 0a 3a 20 72 65 73 65 6e 64 2d 64 EN ;..: resend-d
6a30: 65 73 74 20 28 20 2d 2d 20 61 64 64 72 20 29 0a est ( -- addr ).
6a40: 20 20 20 20 64 61 74 61 2d 72 65 73 65 6e 64 20 data-resend
6a50: 24 40 20 64 72 6f 70 20 63 65 6c 6c 2b 20 40 0a $@ drop cell+ @.
6a60: 20 20 20 20 64 61 74 61 2d 6d 61 70 20 77 69 74 data-map wit
6a70: 68 20 6d 61 70 63 20 64 65 73 74 2d 73 69 7a 65 h mapc dest-size
6a80: 20 31 2d 20 61 6e 64 20 6e 3e 36 34 20 64 65 73 1- and n>64 des
6a90: 74 2d 76 61 64 64 72 20 36 34 2b 20 65 6e 64 77 t-vaddr 64+ endw
6aa0: 69 74 68 20 3b 0a 3a 20 2f 72 65 73 65 6e 64 20 ith ;.: /resend
6ab0: 28 20 75 20 2d 2d 20 29 0a 20 20 20 20 30 20 2b ( u -- ). 0 +
6ac0: 44 4f 0a 09 64 61 74 61 2d 72 65 73 65 6e 64 20 DO..data-resend
6ad0: 24 40 20 64 72 6f 70 0a 09 64 75 70 20 3e 72 20 $@ drop..dup >r
6ae0: 32 40 20 2d 32 20 61 6e 64 20 3e 6d 61 73 6b 30 2@ -2 and >mask0
6af0: 20 74 75 63 6b 20 72 3e 20 32 21 0a 09 30 3d 20 tuck r> 2!..0=
6b00: 49 46 20 20 64 61 74 61 2d 72 65 73 65 6e 64 20 IF data-resend
6b10: 30 20 32 20 63 65 6c 6c 73 20 24 64 65 6c 20 20 0 2 cells $del
6b20: 54 48 45 4e 0a 20 20 20 20 6d 61 78 64 61 74 61 THEN. maxdata
6b30: 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 64 61 74 61 +LOOP ;..: data
6b40: 2d 72 65 73 65 6e 64 2d 66 6c 75 73 68 20 28 20 -resend-flush (
6b50: 2d 2d 20 29 0a 20 20 20 20 64 61 74 61 2d 72 65 -- ). data-re
6b60: 73 65 6e 64 20 24 40 6c 65 6e 20 30 20 55 2b 44 send $@len 0 U+D
6b70: 4f 0a 09 64 61 74 61 2d 72 65 73 65 6e 64 20 24 O..data-resend $
6b80: 40 20 49 20 2f 73 74 72 69 6e 67 20 64 72 6f 70 @ I /string drop
6b90: 20 40 20 30 3d 20 49 46 0a 09 20 20 20 20 64 61 @ 0= IF.. da
6ba0: 74 61 2d 72 65 73 65 6e 64 20 49 20 32 20 63 65 ta-resend I 2 ce
6bb0: 6c 6c 73 20 24 64 65 6c 0a 09 20 20 20 20 30 20 lls $del.. 0
6bc0: 20 64 61 74 61 2d 72 65 73 65 6e 64 20 24 40 6c data-resend $@l
6bd0: 65 6e 20 49 20 75 6e 6c 6f 6f 70 20 55 2b 44 4f en I unloop U+DO
6be0: 20 4e 4f 50 45 0a 09 45 4c 53 45 0a 09 20 20 20 NOPE..ELSE..
6bf0: 20 5b 20 32 20 63 65 6c 6c 73 20 5d 4c 0a 09 54 [ 2 cells ]L..T
6c00: 48 45 4e 0a 20 20 20 20 2b 4c 4f 4f 50 20 3b 0a HEN. +LOOP ;.
6c10: 0a 3a 20 72 65 6d 6f 76 65 2d 72 65 73 65 6e 64 .: remove-resend
6c20: 20 7b 20 6e 62 61 63 6b 20 2d 2d 20 7d 0a 20 20 { nback -- }.
6c30: 20 20 64 61 74 61 2d 72 65 73 65 6e 64 20 24 40 data-resend $@
6c40: 20 62 6f 75 6e 64 73 20 55 2b 44 4f 0a 09 49 20 bounds U+DO..I
6c50: 63 65 6c 6c 2b 20 40 20 6e 62 61 63 6b 20 5b 20 cell+ @ nback [
6c60: 6d 61 78 64 61 74 61 20 24 32 30 20 2a 20 5d 4c maxdata $20 * ]L
6c70: 20 75 6d 61 78 20 5b 20 6d 61 78 64 61 74 61 20 umax [ maxdata
6c80: 24 32 30 20 2a 20 5d 4c 20 2d 0a 09 75 3c 20 49 $20 * ]L -..u< I
6c90: 46 20 20 49 20 6f 66 66 0a 09 45 4c 53 45 20 20 F I off..ELSE
6ca0: 49 20 63 65 6c 6c 2b 20 40 20 6e 62 61 63 6b 20 I cell+ @ nback
6cb0: 75 3c 20 49 46 0a 09 09 6e 62 61 63 6b 20 64 75 u< IF...nback du
6cc0: 70 20 49 20 63 65 6c 6c 2b 20 21 40 20 2d 0a 09 p I cell+ !@ -..
6cd0: 09 61 64 64 72 3e 62 69 74 73 20 49 20 40 20 73 .addr>bits I @ s
6ce0: 77 61 70 20 72 73 68 69 66 74 20 49 20 21 0a 09 wap rshift I !..
6cf0: 20 20 20 20 54 48 45 4e 0a 09 54 48 45 4e 0a 20 THEN..THEN.
6d00: 20 20 20 5b 20 32 20 63 65 6c 6c 73 20 5d 4c 20 [ 2 cells ]L
6d10: 2b 4c 4f 4f 50 0a 20 20 20 20 64 61 74 61 2d 72 +LOOP. data-r
6d20: 65 73 65 6e 64 2d 66 6c 75 73 68 20 3b 0a 0a 3a esend-flush ;..:
6d30: 20 72 65 77 69 6e 64 2d 72 65 73 65 6e 64 20 28 rewind-resend (
6d40: 20 6f 62 61 63 6b 20 6e 62 61 63 6b 20 6f 3a 6d oback nback o:m
6d50: 61 70 20 2d 2d 20 29 0a 20 20 20 20 70 61 72 65 ap -- ). pare
6d60: 6e 74 20 2e 72 65 6d 6f 76 65 2d 72 65 73 65 6e nt .remove-resen
6d70: 64 20 64 72 6f 70 20 3b 0a 0a 5c 20 72 65 73 65 d drop ;..\ rese
6d80: 6e 64 20 74 68 69 72 64 20 68 61 6e 64 73 68 61 nd third handsha
6d90: 6b 65 0a 0a 3a 20 70 75 73 68 2d 72 65 70 6c 79 ke..: push-reply
6da0: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 29 20 20 ( addr u -- )
6db0: 72 65 73 65 6e 64 30 20 24 21 20 20 72 65 74 75 resend0 $! retu
6dc0: 72 6e 2d 61 64 64 72 20 72 30 2d 61 64 64 72 65 rn-addr r0-addre
6dd0: 73 73 20 24 31 30 20 6d 6f 76 65 20 3b 0a 0a 5c ss $10 move ;..\
6de0: 20 6c 6f 61 64 20 63 72 79 70 74 6f 20 68 65 72 load crypto her
6df0: 65 0a 0a 72 65 71 75 69 72 65 20 63 72 79 70 74 e..require crypt
6e00: 2e 66 73 0a 0a 5c 20 66 69 6c 65 20 68 61 6e 64 .fs..\ file hand
6e10: 6c 69 6e 67 0a 0a 72 65 71 75 69 72 65 20 66 69 ling..require fi
6e20: 6c 65 2e 66 73 0a 0a 5c 20 68 65 6c 70 65 72 73 le.fs..\ helpers
6e30: 20 66 6f 72 20 61 64 64 72 65 73 73 65 73 0a 0a for addresses..
6e40: 46 6f 72 77 61 72 64 20 3e 73 6f 63 6b 61 64 64 Forward >sockadd
6e50: 72 0a 46 6f 72 77 61 72 64 20 73 6f 63 6b 61 64 r.Forward sockad
6e60: 64 72 2b 72 65 74 75 72 6e 0a 0a 3a 20 2d 73 69 dr+return..: -si
6e70: 67 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 g ( addr u -- ad
6e80: 64 72 20 75 27 20 29 20 32 64 75 70 20 2b 20 31 dr u' ) 2dup + 1
6e90: 2d 20 63 40 20 32 2a 20 24 31 31 20 2b 20 2d 20 - c@ 2* $11 + -
6ea0: 3b 0a 3a 20 6e 32 6f 61 64 64 72 73 20 28 20 78 ;.: n2oaddrs ( x
6eb0: 74 20 2d 2d 20 29 0a 20 20 20 20 6d 79 2d 61 64 t -- ). my-ad
6ec0: 64 72 24 20 5b 3a 20 2d 73 69 67 20 73 6f 63 6b dr$ [: -sig sock
6ed0: 61 64 64 72 2b 72 65 74 75 72 6e 20 72 6f 74 20 addr+return rot
6ee0: 64 75 70 20 3e 72 20 65 78 65 63 75 74 65 20 72 dup >r execute r
6ef0: 3e 20 3b 5d 20 24 5b 5d 6d 61 70 20 64 72 6f 70 > ;] $[]map drop
6f00: 20 3b 0a 0a 5c 20 73 65 6e 64 20 62 6c 6f 63 6b ;..\ send block
6f10: 73 20 6f 66 20 6d 65 6d 6f 72 79 0a 0a 3a 20 3e s of memory..: >
6f20: 64 65 73 74 20 28 20 61 64 64 72 20 2d 2d 20 29 dest ( addr -- )
6f30: 20 6f 75 74 62 75 66 20 64 65 73 74 69 6e 61 74 outbuf destinat
6f40: 69 6f 6e 20 24 31 30 20 6d 6f 76 65 20 3b 0a 3a ion $10 move ;.:
6f50: 20 73 65 74 2d 64 65 73 74 20 28 20 74 61 72 67 set-dest ( targ
6f60: 65 74 20 2d 2d 20 29 0a 20 20 20 20 36 34 64 75 et -- ). 64du
6f70: 70 20 64 65 73 74 2d 61 64 64 72 20 36 34 21 20 p dest-addr 64!
6f80: 20 6f 75 74 62 75 66 20 6d 61 70 61 64 64 72 20 outbuf mapaddr
6f90: 6c 65 2d 36 34 21 20 3b 0a 3a 20 73 65 74 2d 64 le-64! ;.: set-d
6fa0: 65 73 74 23 20 28 20 72 65 73 65 6e 64 23 20 2d est# ( resend# -
6fb0: 2d 20 29 0a 20 20 20 20 6e 3e 36 34 20 64 65 73 - ). n>64 des
6fc0: 74 2d 61 64 64 72 20 36 34 2b 21 20 20 64 65 73 t-addr 64+! des
6fd0: 74 2d 61 64 64 72 20 36 34 40 20 6f 75 74 62 75 t-addr 64@ outbu
6fe0: 66 20 6d 61 70 61 64 64 72 20 6c 65 2d 36 34 21 f mapaddr le-64!
6ff0: 20 3b 0a 0a 55 73 65 72 20 6f 75 74 66 6c 61 67 ;..User outflag
7000: 20 20 6f 75 74 66 6c 61 67 20 6f 66 66 0a 0a 3a outflag off..:
7010: 20 73 65 74 2d 66 6c 61 67 73 20 28 20 2d 2d 20 set-flags ( --
7020: 29 0a 20 20 20 20 30 20 6f 75 74 66 6c 61 67 20 ). 0 outflag
7030: 21 40 20 6f 75 74 62 75 66 20 68 64 72 74 61 67 !@ outbuf hdrtag
7040: 73 20 63 21 0a 20 20 20 20 6f 75 74 62 75 66 20 s c!. outbuf
7050: 68 64 72 66 6c 61 67 73 20 6c 65 2d 75 77 40 20 hdrflags le-uw@
7060: 64 65 73 74 2d 66 6c 61 67 73 20 6c 65 2d 77 21 dest-flags le-w!
7070: 20 3b 0a 0a 23 39 30 20 43 6f 6e 73 74 61 6e 74 ;..#90 Constant
7080: 20 45 4d 53 47 53 49 5a 45 0a 0a 3a 20 3f 6d 73 EMSGSIZE..: ?ms
7090: 67 73 69 7a 65 20 28 20 69 6f 72 20 2d 2d 20 29 gsize ( ior -- )
70a0: 0a 20 20 20 20 30 3c 20 49 46 0a 09 65 72 72 6e . 0< IF..errn
70b0: 6f 20 45 4d 53 47 53 49 5a 45 20 3c 3e 20 3f 69 o EMSGSIZE <> ?i
70c0: 6f 72 0a 09 6d 61 78 2d 73 69 7a 65 5e 32 20 31 or..max-size^2 1
70d0: 2d 20 74 6f 20 6d 61 78 2d 73 69 7a 65 5e 32 20 - to max-size^2
70e0: 20 2e 22 20 70 6d 74 75 2f 32 22 20 63 72 0a 20 ." pmtu/2" cr.
70f0: 20 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 70 61 63 THEN ;..: pac
7100: 6b 65 74 2d 74 6f 20 28 20 2d 2d 20 29 0a 20 20 ket-to ( -- ).
7110: 20 20 6f 75 74 2d 72 6f 75 74 65 20 20 6f 75 74 out-route out
7120: 62 75 66 20 64 75 70 20 70 61 63 6b 65 74 2d 73 buf dup packet-s
7130: 69 7a 65 0a 20 20 20 20 73 65 6e 64 2d 61 2d 70 ize. send-a-p
7140: 61 63 6b 65 74 20 3f 6d 73 67 73 69 7a 65 20 3b acket ?msgsize ;
7150: 0a 0a 3a 20 73 65 6e 64 2d 63 6f 64 65 2d 70 61 ..: send-code-pa
7160: 63 6b 65 74 20 28 20 2d 2d 20 29 20 2b 73 65 6e cket ( -- ) +sen
7170: 64 58 0a 20 20 20 20 68 65 61 64 65 72 28 20 2e dX. header( .
7180: 22 20 73 65 6e 64 20 63 6f 64 65 20 22 20 6f 75 " send code " ou
7190: 74 62 75 66 20 2e 68 65 61 64 65 72 20 29 0a 20 tbuf .header ).
71a0: 20 20 20 6f 75 74 62 75 66 20 68 64 72 74 61 67 outbuf hdrtag
71b0: 73 20 63 40 20 73 74 61 74 65 6c 65 73 73 23 20 s c@ stateless#
71c0: 61 6e 64 20 49 46 0a 09 6f 75 74 62 75 66 30 2d and IF..outbuf0-
71d0: 65 6e 63 72 79 70 74 0a 09 63 6d 64 30 28 20 2e encrypt..cmd0( .
71e0: 74 69 6d 65 20 2e 22 20 63 6d 64 30 20 74 6f 3a time ." cmd0 to:
71f0: 20 22 20 72 65 74 2d 61 64 64 72 20 2e 61 64 64 " ret-addr .add
7200: 72 2d 70 61 74 68 20 63 72 20 29 0a 20 20 20 20 r-path cr ).
7210: 45 4c 53 45 0a 09 63 6f 64 65 2d 6d 61 70 20 6f ELSE..code-map o
7220: 75 74 62 75 66 2d 65 6e 63 72 79 70 74 0a 20 20 utbuf-encrypt.
7230: 20 20 54 48 45 4e 20 20 20 72 65 74 2d 61 64 64 THEN ret-add
7240: 72 20 3e 64 65 73 74 20 70 61 63 6b 65 74 2d 74 r >dest packet-t
7250: 6f 20 3b 0a 0a 3a 20 73 65 6e 64 2d 64 61 74 61 o ;..: send-data
7260: 2d 70 61 63 6b 65 74 20 28 20 2d 2d 20 29 20 2b -packet ( -- ) +
7270: 73 65 6e 64 58 0a 20 20 20 20 68 65 61 64 65 72 sendX. header
7280: 28 20 2e 22 20 73 65 6e 64 20 64 61 74 61 20 22 ( ." send data "
7290: 20 6f 75 74 62 75 66 20 2e 68 65 61 64 65 72 20 outbuf .header
72a0: 29 0a 20 20 20 20 64 61 74 61 2d 6d 61 70 20 20 ). data-map
72b0: 6f 75 74 62 75 66 2d 65 6e 63 72 79 70 74 0a 20 outbuf-encrypt.
72c0: 20 20 20 72 65 74 2d 61 64 64 72 20 3e 64 65 73 ret-addr >des
72d0: 74 20 70 61 63 6b 65 74 2d 74 6f 20 3b 0a 0a 3a t packet-to ;..:
72e0: 20 3e 73 65 6e 64 20 28 20 61 64 64 72 20 6e 20 >send ( addr n
72f0: 2d 2d 20 29 0a 20 20 20 20 3e 72 20 20 72 40 20 -- ). >r r@
7300: 5b 20 36 34 62 69 74 23 20 71 6f 73 33 23 20 6f [ 64bit# qos3# o
7310: 72 20 5d 4c 20 6f 72 20 6f 75 74 62 75 66 20 63 r ]L or outbuf c
7320: 21 20 20 73 65 74 2d 66 6c 61 67 73 0a 20 20 20 ! set-flags.
7330: 20 6f 75 74 62 75 66 20 70 61 63 6b 65 74 2d 62 outbuf packet-b
7340: 6f 64 79 20 6d 69 6e 2d 73 69 7a 65 20 72 3e 20 ody min-size r>
7350: 6c 73 68 69 66 74 20 6d 6f 76 65 20 3b 0a 0a 3a lshift move ;..:
7360: 20 62 61 6e 64 77 69 64 74 68 2b 20 28 20 2d 2d bandwidth+ ( --
7370: 20 29 0a 20 20 20 20 6e 73 2f 62 75 72 73 74 20 ). ns/burst
7380: 36 34 40 20 31 20 74 69 63 6b 2d 69 6e 69 74 20 64@ 1 tick-init
7390: 31 2b 20 36 34 2a 2f 20 62 61 6e 64 77 69 64 74 1+ 64*/ bandwidt
73a0: 68 2d 74 69 63 6b 20 36 34 2b 21 20 3b 0a 0a 3a h-tick 64+! ;..:
73b0: 20 62 75 72 73 74 2d 65 6e 64 20 28 20 66 6c 61 burst-end ( fla
73c0: 67 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 g -- flag ).
73d0: 74 69 63 6b 65 72 20 36 34 40 20 62 61 6e 64 77 ticker 64@ bandw
73e0: 69 64 74 68 2d 74 69 63 6b 20 36 34 40 20 36 34 idth-tick 64@ 64
73f0: 6d 61 78 20 6e 65 78 74 2d 74 69 63 6b 20 36 34 max next-tick 64
7400: 21 20 64 72 6f 70 20 66 61 6c 73 65 20 3b 0a 0a ! drop false ;..
7410: 3a 20 73 65 6e 64 2d 63 58 20 28 20 61 64 64 72 : send-cX ( addr
7420: 20 6e 20 2d 2d 20 29 20 2b 73 65 6e 64 58 32 20 n -- ) +sendX2
7430: 20 3e 73 65 6e 64 20 20 73 65 6e 64 2d 63 6f 64 >send send-cod
7440: 65 2d 70 61 63 6b 65 74 20 3b 0a 0a 5c 20 21 21 e-packet ;..\ !!
7450: 46 49 58 4d 45 21 21 20 75 73 65 20 66 66 7a 3e FIXME!! use ffz>
7460: 2c 20 62 72 61 6e 63 68 6c 65 73 73 20 77 69 74 , branchless wit
7470: 68 20 66 6c 6f 61 74 69 6e 67 20 70 6f 69 6e 74 h floating point
7480: 0a 0a 3a 20 36 34 66 66 7a 3c 20 28 20 36 34 62 ..: 64ffz< ( 64b
7490: 20 2d 2d 20 75 20 2f 20 2d 31 20 29 0a 20 20 20 -- u / -1 ).
74a0: 20 5c 47 20 66 69 6e 64 20 66 69 72 73 74 20 7a \G find first z
74b0: 65 72 6f 20 66 72 6f 6d 20 74 68 65 20 72 69 67 ero from the rig
74c0: 68 74 2c 20 75 20 69 73 20 62 69 74 20 70 6f 73 ht, u is bit pos
74d0: 69 74 69 6f 6e 0a 20 20 20 20 36 34 20 30 20 44 ition. 64 0 D
74e0: 4f 0a 09 36 34 64 75 70 20 36 34 3e 6e 20 31 20 O..64dup 64>n 1
74f0: 61 6e 64 20 30 3d 20 49 46 20 20 36 34 64 72 6f and 0= IF 64dro
7500: 70 20 49 20 75 6e 6c 6f 6f 70 20 20 45 58 49 54 p I unloop EXIT
7510: 20 20 54 48 45 4e 0a 09 36 34 2d 32 2f 0a 20 20 THEN..64-2/.
7520: 20 20 4c 4f 4f 50 20 36 34 64 72 6f 70 20 24 34 LOOP 64drop $4
7530: 30 20 3b 0a 0a 73 63 6f 70 65 7b 20 6d 61 70 63 0 ;..scope{ mapc
7540: 0a 0a 3a 20 72 65 73 65 6e 64 23 2b 20 28 20 61 ..: resend#+ ( a
7550: 64 64 72 20 2d 2d 20 6e 20 29 0a 20 20 20 20 64 ddr -- n ). d
7560: 65 73 74 2d 72 61 64 64 72 20 2d 20 61 64 64 72 est-raddr - addr
7570: 3e 36 34 20 64 61 74 61 2d 72 65 73 65 6e 64 23 >64 data-resend#
7580: 20 40 20 2b 20 7b 20 61 64 64 72 20 7d 0a 20 20 @ + { addr }.
7590: 20 20 72 6e 67 38 20 24 33 46 20 61 6e 64 20 7b rng8 $3F and {
75a0: 20 72 20 7d 0a 20 20 20 20 61 64 64 72 20 6c 65 r }. addr le
75b0: 2d 36 34 40 20 72 20 36 34 72 6f 72 20 36 34 66 -64@ r 64ror 64f
75c0: 66 7a 3c 20 72 20 2b 20 24 33 46 20 61 6e 64 20 fz< r + $3F and
75d0: 74 6f 20 72 0a 20 20 20 20 36 34 23 31 20 72 20 to r. 64#1 r
75e0: 36 34 6c 73 68 69 66 74 20 61 64 64 72 20 6c 65 64lshift addr le
75f0: 2d 36 34 40 20 36 34 6f 72 0a 20 20 20 20 5c 20 -64@ 64or. \
7600: 74 69 6d 65 6f 75 74 28 20 2e 22 20 72 65 73 65 timeout( ." rese
7610: 6e 64 23 3a 20 22 20 61 64 64 72 20 64 61 74 61 nd#: " addr data
7620: 2d 72 65 73 65 6e 64 23 20 40 20 64 75 70 20 68 -resend# @ dup h
7630: 65 78 2e 20 2d 20 68 65 78 2e 20 36 34 64 75 70 ex. - hex. 64dup
7640: 20 78 36 34 2e 20 63 72 20 29 0a 20 20 20 20 61 x64. cr ). a
7650: 64 64 72 20 6c 65 2d 36 34 21 20 0a 20 20 20 20 ddr le-64! .
7660: 72 20 3b 0a 0a 3a 20 72 65 73 65 6e 64 23 3f 20 r ;..: resend#?
7670: 28 20 6f 66 66 20 61 64 64 72 20 75 20 2d 2d 20 ( off addr u --
7680: 6e 20 29 0a 20 20 20 20 30 20 72 6f 74 20 32 73 n ). 0 rot 2s
7690: 77 61 70 20 5c 20 63 6f 75 6e 74 20 61 64 64 72 wap \ count addr
76a0: 20 6f 66 66 20 75 0a 20 20 20 20 62 6f 75 6e 64 off u. bound
76b0: 73 20 64 65 73 74 2d 73 69 7a 65 20 61 64 64 72 s dest-size addr
76c0: 3e 62 69 74 73 20 74 75 63 6b 20 75 6d 69 6e 20 >bits tuck umin
76d0: 3e 72 20 75 6d 69 6e 20 72 3e 20 5c 20 6c 69 6d >r umin r> \ lim
76e0: 69 74 73 0a 20 20 20 20 36 34 73 20 64 61 74 61 its. 64s data
76f0: 2d 72 65 73 65 6e 64 23 20 40 20 2b 20 73 77 61 -resend# @ + swa
7700: 70 0a 20 20 20 20 36 34 73 20 64 61 74 61 2d 72 p. 64s data-r
7710: 65 73 65 6e 64 23 20 40 20 2b 20 73 77 61 70 20 esend# @ + swap
7720: 3f 44 4f 0a 09 64 75 70 20 63 40 20 24 34 30 20 ?DO..dup c@ $40
7730: 75 3c 20 49 46 0a 09 20 20 20 20 64 75 70 20 63 u< IF.. dup c
7740: 40 20 3e 72 20 36 34 23 31 20 72 3e 20 36 34 6c @ >r 64#1 r> 64l
7750: 73 68 69 66 74 0a 09 20 20 20 20 49 20 6c 65 2d shift.. I le-
7760: 36 34 40 0a 09 20 20 20 20 5c 20 36 34 6f 76 65 64@.. \ 64ove
7770: 72 20 36 34 69 6e 76 65 72 74 20 36 34 6f 76 65 r 64invert 64ove
7780: 72 20 36 34 61 6e 64 20 49 20 6c 65 2d 36 34 21 r 64and I le-64!
7790: 20 5c 20 61 63 6b 20 6f 6e 6c 79 20 6f 6e 63 65 \ ack only once
77a0: 21 0a 09 20 20 20 20 36 34 61 6e 64 20 36 34 2d !.. 64and 64-
77b0: 30 3d 20 49 46 20 5c 20 63 68 65 63 6b 20 69 66 0= IF \ check if
77c0: 20 68 61 64 20 62 65 65 6e 20 7a 65 72 6f 20 61 had been zero a
77d0: 6c 72 65 61 64 79 0a 09 09 74 69 6d 65 6f 75 74 lready...timeout
77e0: 28 20 2e 22 20 72 65 73 65 6e 64 23 20 75 6e 6d ( ." resend# unm
77f0: 61 74 63 68 3a 20 22 0a 09 09 49 20 64 61 74 61 atch: "...I data
7800: 2d 72 65 73 65 6e 64 23 20 40 20 64 75 70 20 68 -resend# @ dup h
7810: 65 78 2e 20 2d 20 68 65 78 2e 0a 09 09 64 75 70 ex. - hex....dup
7820: 20 63 40 20 68 65 78 2e 20 49 20 6c 65 2d 36 34 c@ hex. I le-64
7830: 40 20 78 36 34 2e 20 63 72 20 29 0a 09 09 32 64 @ x64. cr )...2d
7840: 72 6f 70 20 30 20 55 4e 4c 4f 4f 50 20 20 45 58 rop 0 UNLOOP EX
7850: 49 54 0a 09 20 20 20 20 54 48 45 4e 20 20 73 77 IT.. THEN sw
7860: 61 70 20 31 2b 20 73 77 61 70 0a 09 54 48 45 4e ap 1+ swap..THEN
7870: 20 20 31 2b 0a 20 20 20 20 38 20 2b 4c 4f 4f 50 1+. 8 +LOOP
7880: 20 20 64 72 6f 70 20 3b 0a 0a 7d 73 63 6f 70 65 drop ;..}scope
7890: 0a 0a 3a 20 73 65 6e 64 2d 64 58 20 28 20 61 64 ..: send-dX ( ad
78a0: 64 72 20 6e 20 2d 2d 20 29 20 2b 73 65 6e 64 58 dr n -- ) +sendX
78b0: 32 0a 20 20 20 20 6f 76 65 72 20 64 61 74 61 2d 2. over data-
78c0: 6d 61 70 20 2e 6d 61 70 63 3a 72 65 73 65 6e 64 map .mapc:resend
78d0: 23 2b 20 73 65 74 2d 64 65 73 74 23 0a 20 20 20 #+ set-dest#.
78e0: 20 3e 73 65 6e 64 20 20 61 63 6b 40 20 2e 62 61 >send ack@ .ba
78f0: 6e 64 77 69 64 74 68 2b 20 20 73 65 6e 64 2d 64 ndwidth+ send-d
7900: 61 74 61 2d 70 61 63 6b 65 74 20 3b 0a 0a 46 6f ata-packet ;..Fo
7910: 72 77 61 72 64 20 61 64 64 72 3e 73 6f 63 6b 20 rward addr>sock
7920: 5c 20 75 73 65 73 20 6c 6f 63 61 6c 73 0a 46 6f \ uses locals.Fo
7930: 72 77 61 72 64 20 70 75 6e 63 68 2d 72 65 70 6c rward punch-repl
7940: 79 0a 46 6f 72 77 61 72 64 20 6e 65 77 2d 61 64 y.Forward new-ad
7950: 64 72 0a 0a 3a 20 73 65 6e 64 2d 70 75 6e 63 68 dr..: send-punch
7960: 20 28 20 61 64 64 72 20 75 20 2d 2d 20 61 64 64 ( addr u -- add
7970: 72 20 75 20 29 0a 20 20 20 20 63 68 65 63 6b 2d r u ). check-
7980: 61 64 64 72 31 20 30 3d 20 49 46 20 20 32 64 72 addr1 0= IF 2dr
7990: 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 op EXIT THEN.
79a0: 20 20 20 74 65 6d 70 2d 61 64 64 72 20 72 65 74 temp-addr ret
79b0: 2d 61 64 64 72 20 24 31 30 20 6d 6f 76 65 0a 20 -addr $10 move.
79c0: 20 20 20 69 6e 73 65 72 74 2d 61 64 64 72 65 73 insert-addres
79d0: 73 20 72 65 74 2d 61 64 64 72 20 69 6e 73 2d 64 s ret-addr ins-d
79e0: 65 73 74 0a 20 20 20 20 6e 61 74 28 20 74 69 63 est. nat( tic
79f0: 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 73 65 ks .ticks ." se
7a00: 6e 64 20 70 75 6e 63 68 20 74 6f 3a 20 22 20 72 nd punch to: " r
7a10: 65 74 2d 61 64 64 72 20 2e 61 64 64 72 2d 70 61 et-addr .addr-pa
7a20: 74 68 20 63 72 20 29 0a 20 20 20 20 32 64 75 70 th cr ). 2dup
7a30: 20 73 65 6e 64 2d 63 58 20 3b 0a 0a 69 6e 20 6e send-cX ;..in n
7a40: 65 74 32 6f 20 3a 20 70 75 6e 63 68 20 28 20 61 et2o : punch ( a
7a50: 64 64 72 20 75 20 6f 3a 63 6f 6e 6e 65 63 74 69 ddr u o:connecti
7a60: 6f 6e 20 2d 2d 20 29 0a 20 20 20 20 6f 20 49 46 on -- ). o IF
7a70: 0a 09 6e 65 77 2d 61 64 64 72 20 70 75 6e 63 68 ..new-addr punch
7a80: 2d 61 64 64 72 73 20 3e 73 74 61 63 6b 0a 20 20 -addrs >stack.
7a90: 20 20 45 4c 53 45 20 20 32 64 72 6f 70 20 20 54 ELSE 2drop T
7aa0: 48 45 4e 20 3b 0a 0a 3a 20 70 75 6e 63 68 2d 77 HEN ;..: punch-w
7ab0: 72 61 70 20 28 20 78 74 20 2d 2d 20 29 0a 20 20 rap ( xt -- ).
7ac0: 20 20 72 65 74 75 72 6e 2d 61 64 64 72 65 73 73 return-address
7ad0: 20 24 31 30 20 24 6d 61 6b 65 20 7b 20 77 5e 20 $10 $make { w^
7ae0: 72 65 74 20 7d 20 63 61 74 63 68 0a 20 20 20 20 ret } catch.
7af0: 72 65 74 20 24 40 20 72 65 74 75 72 6e 2d 61 64 ret $@ return-ad
7b00: 64 72 65 73 73 20 24 31 30 20 73 6d 6f 76 65 0a dress $10 smove.
7b10: 20 20 20 20 72 65 74 20 24 66 72 65 65 20 74 68 ret $free th
7b20: 72 6f 77 20 3b 0a 0a 3a 20 70 69 6e 67 73 20 28 row ;..: pings (
7b30: 20 6f 3a 63 6f 6e 6e 65 63 74 69 6f 6e 20 2d 2d o:connection --
7b40: 20 29 0a 20 20 20 20 5c 47 20 70 69 6e 67 20 61 ). \G ping a
7b50: 6c 6c 20 61 64 64 72 65 73 73 65 73 20 28 77 68 ll addresses (wh
7b60: 79 20 65 78 63 65 70 74 20 74 68 65 20 66 69 72 y except the fir
7b70: 73 74 20 6f 6e 65 3f 29 0a 20 20 20 20 5b 3a 20 st one?). [:
7b80: 70 75 6e 63 68 2d 61 64 64 72 73 20 24 40 20 62 punch-addrs $@ b
7b90: 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 20 20 49 ounds ?DO.. I
7ba0: 20 40 20 5b 27 5d 20 70 69 6e 67 2d 61 64 64 72 @ ['] ping-addr
7bb0: 31 20 61 64 64 72 3e 73 6f 63 6b 0a 09 63 65 6c 1 addr>sock..cel
7bc0: 6c 20 2b 4c 4f 4f 50 20 3b 5d 20 70 75 6e 63 68 l +LOOP ;] punch
7bd0: 2d 77 72 61 70 20 3b 0a 0a 3a 20 70 75 6e 63 68 -wrap ;..: punch
7be0: 73 20 28 20 61 64 64 72 20 75 20 6f 3a 63 6f 6e s ( addr u o:con
7bf0: 6e 65 63 74 69 6f 6e 20 2d 2d 20 29 0a 20 20 20 nection -- ).
7c00: 20 5c 47 20 73 65 6e 64 20 61 20 72 65 70 6c 79 \G send a reply
7c10: 20 74 6f 20 61 6c 6c 20 61 64 64 72 65 73 73 65 to all addresse
7c20: 73 0a 20 20 20 20 5b 3a 20 70 75 6e 63 68 2d 61 s. [: punch-a
7c30: 64 64 72 73 20 24 40 20 62 6f 75 6e 64 73 20 3f ddrs $@ bounds ?
7c40: 44 4f 0a 09 20 20 20 20 49 20 40 20 5b 27 5d 20 DO.. I @ [']
7c50: 73 65 6e 64 2d 70 75 6e 63 68 20 61 64 64 72 3e send-punch addr>
7c60: 73 6f 63 6b 0a 09 63 65 6c 6c 20 2b 4c 4f 4f 50 sock..cell +LOOP
7c70: 20 3b 5d 20 70 75 6e 63 68 2d 77 72 61 70 20 32 ;] punch-wrap 2
7c80: 64 72 6f 70 20 3b 0a 0a 5c 20 73 65 6e 64 20 63 drop ;..\ send c
7c90: 68 75 6e 6b 0a 0a 5c 20 62 72 61 6e 63 68 6c 65 hunk..\ branchle
7ca0: 73 73 20 76 65 72 73 69 6f 6e 20 75 73 69 6e 67 ss version using
7cb0: 20 66 6c 6f 61 74 69 6e 67 20 70 6f 69 6e 74 0a floating point.
7cc0: 0a 3a 20 73 65 6e 64 2d 73 69 7a 65 20 28 20 75 .: send-size ( u
7cd0: 20 2d 2d 20 6e 20 29 0a 20 20 20 20 6d 69 6e 2d -- n ). min-
7ce0: 73 69 7a 65 20 75 6d 61 78 20 6d 61 78 64 61 74 size umax maxdat
7cf0: 61 20 75 6d 69 6e 20 31 2d 0a 20 20 20 20 5b 20 a umin 1-. [
7d00: 6d 69 6e 2d 73 69 7a 65 20 32 2f 20 32 2f 20 73 min-size 2/ 2/ s
7d10: 3e 66 20 31 2f 66 20 5d 20 46 4c 69 74 65 72 61 >f 1/f ] FLitera
7d20: 6c 20 66 6d 2a 0a 20 20 20 20 7b 20 66 5e 20 3c l fm*. { f^ <
7d30: 73 69 7a 65 2d 6c 62 3e 20 7d 20 20 3c 73 69 7a size-lb> } <siz
7d40: 65 2d 6c 62 3e 20 36 20 2b 20 63 40 20 34 20 72 e-lb> 6 + c@ 4 r
7d50: 73 68 69 66 74 20 3b 0a 0a 36 34 56 61 72 69 61 shift ;..64Varia
7d60: 62 6c 65 20 6c 61 73 74 2d 74 69 63 6b 73 0a 0a ble last-ticks..
7d70: 73 63 6f 70 65 7b 20 6d 61 70 63 0a 0a 3a 20 74 scope{ mapc..: t
7d80: 73 2d 74 69 63 6b 73 21 20 28 20 61 64 64 72 20 s-ticks! ( addr
7d90: 2d 2d 20 29 0a 20 20 20 20 61 64 64 72 3e 74 73 -- ). addr>ts
7da0: 20 64 65 73 74 2d 74 69 6d 65 73 74 61 6d 70 73 dest-timestamps
7db0: 20 2b 20 3e 72 20 6c 61 73 74 2d 74 69 63 6b 73 + >r last-ticks
7dc0: 20 36 34 40 20 72 3e 0a 20 20 20 20 64 75 70 20 64@ r>. dup
7dd0: 36 34 40 20 36 34 2d 30 3d 20 49 46 20 20 36 34 64@ 64-0= IF 64
7de0: 21 20 20 45 58 49 54 20 20 54 48 45 4e 20 20 36 ! EXIT THEN 6
7df0: 34 6f 6e 20 36 34 64 72 6f 70 20 31 20 70 61 63 4on 64drop 1 pac
7e00: 6b 65 74 73 32 20 2b 21 20 3b 0a 5c 20 73 65 74 kets2 +! ;.\ set
7e10: 20 64 6f 75 62 6c 65 2d 75 73 65 64 20 74 69 63 double-used tic
7e20: 6b 73 20 74 6f 20 2d 31 20 74 6f 20 69 6e 64 69 ks to -1 to indi
7e30: 63 61 74 65 20 75 6e 6b 6f 77 6e 20 74 69 6d 69 cate unkown timi
7e40: 6e 67 20 72 65 6c 61 74 69 6f 6e 73 68 69 70 0a ng relationship.
7e50: 0a 7d 73 63 6f 70 65 0a 0a 69 6e 20 6e 65 74 32 .}scope..in net2
7e60: 6f 20 3a 20 73 65 6e 64 2d 74 69 63 6b 20 28 20 o : send-tick (
7e70: 61 64 64 72 20 2d 2d 20 29 0a 20 20 20 20 64 61 addr -- ). da
7e80: 74 61 2d 6d 61 70 20 77 69 74 68 20 6d 61 70 63 ta-map with mapc
7e90: 0a 20 20 20 20 64 65 73 74 2d 72 61 64 64 72 20 . dest-raddr
7ea0: 2d 20 64 75 70 20 64 65 73 74 2d 73 69 7a 65 20 - dup dest-size
7eb0: 75 3c 0a 20 20 20 20 49 46 20 20 74 73 2d 74 69 u<. IF ts-ti
7ec0: 63 6b 73 21 20 20 45 4c 53 45 20 20 64 72 6f 70 cks! ELSE drop
7ed0: 20 20 54 48 45 4e 20 20 65 6e 64 77 69 74 68 20 THEN endwith
7ee0: 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 70 72 ;..in net2o : pr
7ef0: 65 70 2d 73 65 6e 64 20 28 20 61 64 64 72 20 75 ep-send ( addr u
7f00: 20 64 65 73 74 20 2d 2d 20 61 64 64 72 20 6e 20 dest -- addr n
7f10: 6c 65 6e 20 29 0a 20 20 20 20 73 65 74 2d 64 65 len ). set-de
7f20: 73 74 20 20 6f 76 65 72 20 20 6e 65 74 32 6f 3a st over net2o:
7f30: 73 65 6e 64 2d 74 69 63 6b 0a 20 20 20 20 73 65 send-tick. se
7f40: 6e 64 2d 73 69 7a 65 20 6d 69 6e 2d 73 69 7a 65 nd-size min-size
7f50: 20 6f 76 65 72 20 6c 73 68 69 66 74 20 3b 0a 0a over lshift ;..
7f60: 5c 20 73 79 6e 63 68 72 6f 6e 6f 75 73 20 73 65 \ synchronous se
7f70: 6e 64 69 6e 67 0a 0a 3a 20 64 61 74 61 2d 74 6f nding..: data-to
7f80: 2d 73 65 6e 64 3f 20 28 20 2d 2d 20 66 6c 61 67 -send? ( -- flag
7f90: 20 29 0a 20 20 20 20 72 65 73 65 6e 64 3f 20 64 ). resend? d
7fa0: 61 74 61 2d 74 61 69 6c 3f 20 6f 72 20 3b 0a 0a ata-tail? or ;..
7fb0: 69 6e 20 6e 65 74 32 6f 20 3a 20 72 65 73 65 6e in net2o : resen
7fc0: 64 20 28 20 2d 2d 20 61 64 64 72 20 6e 20 29 0a d ( -- addr n ).
7fd0: 20 20 20 20 72 65 73 65 6e 64 24 40 20 72 65 73 resend$@ res
7fe0: 65 6e 64 2d 64 65 73 74 20 6e 65 74 32 6f 3a 70 end-dest net2o:p
7ff0: 72 65 70 2d 73 65 6e 64 20 2f 72 65 73 65 6e 64 rep-send /resend
8000: 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 73 ;..in net2o : s
8010: 65 6e 64 20 28 20 2d 2d 20 61 64 64 72 20 6e 20 end ( -- addr n
8020: 29 0a 20 20 20 20 64 61 74 61 2d 74 61 69 6c 40 ). data-tail@
8030: 20 64 61 74 61 2d 64 65 73 74 20 6e 65 74 32 6f data-dest net2o
8040: 3a 70 72 65 70 2d 73 65 6e 64 20 2f 74 61 69 6c :prep-send /tail
8050: 20 3b 0a 0a 3a 20 3f 74 6f 67 67 6c 65 2d 61 63 ;..: ?toggle-ac
8060: 6b 20 28 20 2d 2d 20 29 0a 20 20 20 20 64 61 74 k ( -- ). dat
8070: 61 2d 74 6f 2d 73 65 6e 64 3f 20 30 3d 20 49 46 a-to-send? 0= IF
8080: 0a 09 5b 20 72 65 73 65 6e 64 2d 74 6f 67 67 6c ..[ resend-toggl
8090: 65 23 20 61 63 6b 2d 74 6f 67 67 6c 65 23 20 6f e# ack-toggle# o
80a0: 72 20 5d 4c 20 6f 75 74 66 6c 61 67 20 78 6f 72 r ]L outflag xor
80b0: 21 0a 09 6e 65 76 65 72 20 61 63 6b 40 20 2e 6e !..never ack@ .n
80c0: 65 78 74 2d 74 69 63 6b 20 36 34 21 0a 20 20 20 ext-tick 64!.
80d0: 20 54 48 45 4e 20 3b 0a 0a 69 6e 20 6e 65 74 32 THEN ;..in net2
80e0: 6f 20 3a 20 73 65 6e 64 2d 63 68 75 6e 6b 20 28 o : send-chunk (
80f0: 20 2d 2d 20 29 20 20 2b 63 68 75 6e 6b 0a 20 20 -- ) +chunk.
8100: 20 20 61 63 6b 2d 73 74 61 74 65 20 63 40 20 6f ack-state c@ o
8110: 75 74 66 6c 61 67 20 6f 72 21 0a 20 20 20 20 62 utflag or!. b
8120: 75 72 73 74 73 23 20 31 2d 20 64 61 74 61 2d 62 ursts# 1- data-b
8130: 32 62 20 40 20 3d 20 49 46 20 64 61 74 61 2d 74 2b @ = IF data-t
8140: 61 69 6c 3f 20 45 4c 53 45 20 72 65 73 65 6e 64 ail? ELSE resend
8150: 3f 20 30 3d 20 54 48 45 4e 0a 20 20 20 20 49 46 ? 0= THEN. IF
8160: 20 20 6e 65 74 32 6f 3a 73 65 6e 64 20 20 45 4c net2o:send EL
8170: 53 45 20 20 6e 65 74 32 6f 3a 72 65 73 65 6e 64 SE net2o:resend
8180: 20 20 54 48 45 4e 0a 20 20 20 20 3f 74 6f 67 67 THEN. ?togg
8190: 6c 65 2d 61 63 6b 20 73 65 6e 64 2d 64 58 20 3b le-ack send-dX ;
81a0: 0a 0a 3a 20 62 61 6e 64 77 69 64 74 68 3f 20 28 ..: bandwidth? (
81b0: 20 2d 2d 20 66 6c 61 67 20 29 0a 20 20 20 20 74 -- flag ). t
81c0: 69 63 6b 65 72 20 36 34 40 20 36 34 64 75 70 20 icker 64@ 64dup
81d0: 6c 61 73 74 2d 74 69 63 6b 73 20 36 34 21 20 6e last-ticks 64! n
81e0: 65 78 74 2d 74 69 63 6b 20 36 34 40 20 36 34 2d ext-tick 64@ 64-
81f0: 20 36 34 2d 30 3e 3d 0a 20 20 20 20 66 6c 79 62 64-0>=. flyb
8200: 75 72 73 74 73 20 40 20 30 3e 20 61 6e 64 20 20 ursts @ 0> and
8210: 3b 0a 0a 5c 20 61 73 79 6e 63 68 72 6f 6e 6f 75 ;..\ asynchronou
8220: 73 20 73 65 6e 64 69 6e 67 0a 0a 62 65 67 69 6e s sending..begin
8230: 2d 73 74 72 75 63 74 75 72 65 20 63 68 75 6e 6b -structure chunk
8240: 73 2d 73 74 72 75 63 74 0a 66 69 65 6c 64 3a 20 s-struct.field:
8250: 63 68 75 6e 6b 2d 63 6f 6e 74 65 78 74 0a 66 69 chunk-context.fi
8260: 65 6c 64 3a 20 63 68 75 6e 6b 2d 63 6f 75 6e 74 eld: chunk-count
8270: 0a 65 6e 64 2d 73 74 72 75 63 74 75 72 65 0a 0a .end-structure..
8280: 56 61 72 69 61 62 6c 65 20 63 68 75 6e 6b 73 0a Variable chunks.
8290: 56 61 72 69 61 62 6c 65 20 63 68 75 6e 6b 73 2b Variable chunks+
82a0: 0a 43 72 65 61 74 65 20 63 68 75 6e 6b 2d 61 64 .Create chunk-ad
82b0: 64 65 72 20 63 68 75 6e 6b 73 2d 73 74 72 75 63 der chunks-struc
82c0: 74 20 61 6c 6c 6f 74 0a 30 20 56 61 6c 75 65 20 t allot.0 Value
82d0: 73 65 6e 64 65 72 2d 74 61 73 6b 20 20 20 5c 20 sender-task \
82e0: 61 73 79 6e 63 68 72 6f 6e 6f 75 73 20 73 65 6e asynchronous sen
82f0: 64 65 72 20 74 68 72 65 61 64 20 28 75 6e 75 73 der thread (unus
8300: 65 64 29 0a 30 20 56 61 6c 75 65 20 72 65 63 65 ed).0 Value rece
8310: 69 76 65 72 2d 74 61 73 6b 20 5c 20 72 65 63 65 iver-task \ rece
8320: 69 76 65 72 20 74 68 72 65 61 64 0a 30 20 56 61 iver thread.0 Va
8330: 6c 75 65 20 74 69 6d 65 6f 75 74 2d 74 61 73 6b lue timeout-task
8340: 20 20 5c 20 66 6f 72 20 68 61 6e 64 6c 69 6e 67 \ for handling
8350: 20 74 69 6d 65 6f 75 74 73 0a 30 20 56 61 6c 75 timeouts.0 Valu
8360: 65 20 71 75 65 72 79 2d 74 61 73 6b 20 20 20 20 e query-task
8370: 5c 20 66 6f 72 20 62 61 63 6b 67 72 6f 75 6e 64 \ for background
8380: 20 71 75 65 72 69 65 73 20 69 6e 69 74 69 61 74 queries initiat
8390: 65 64 20 69 6e 20 6f 74 68 65 72 20 74 61 73 6b ed in other task
83a0: 73 0a 0a 3a 20 2e 30 64 65 70 74 68 20 28 20 2d s..: .0depth ( -
83b0: 2d 20 29 20 3c 77 61 72 6e 3e 20 22 53 74 61 63 - ) <warn> "Stac
83c0: 6b 20 73 68 6f 75 6c 64 20 61 6c 77 61 79 73 20 k should always
83d0: 62 65 20 65 6d 70 74 79 21 22 20 74 79 70 65 20 be empty!" type
83e0: 63 72 20 3c 64 65 66 61 75 6c 74 3e 20 3b 0a 3a cr <default> ;.:
83f0: 20 21 21 30 64 65 70 74 68 21 21 20 28 20 2d 2d !!0depth!! ( --
8400: 20 29 20 5d 5d 20 64 65 70 74 68 20 49 46 20 20 ) ]] depth IF
8410: 2e 30 64 65 70 74 68 20 7e 7e 62 74 20 63 6c 65 .0depth ~~bt cle
8420: 61 72 73 74 61 63 6b 20 20 54 48 45 4e 20 5b 5b arstack THEN [[
8430: 20 3b 20 69 6d 6d 65 64 69 61 74 65 0a 3a 20 65 ; immediate.: e
8440: 76 65 6e 74 2d 6c 6f 6f 70 27 20 28 20 2d 2d 20 vent-loop' ( --
8450: 29 20 20 42 45 47 49 4e 20 20 73 74 6f 70 20 20 ) BEGIN stop
8460: 21 21 30 64 65 70 74 68 21 21 20 20 41 47 41 49 !!0depth!! AGAI
8470: 4e 20 3b 0a 3a 20 63 72 65 61 74 65 2d 71 75 65 N ;.: create-que
8480: 72 79 2d 74 61 73 6b 20 28 20 2d 2d 20 29 0a 20 ry-task ( -- ).
8490: 20 20 20 5b 27 5d 20 65 76 65 6e 74 2d 6c 6f 6f ['] event-loo
84a0: 70 27 20 31 20 6e 65 74 32 6f 2d 74 61 73 6b 20 p' 1 net2o-task
84b0: 74 6f 20 71 75 65 72 79 2d 74 61 73 6b 20 3b 0a to query-task ;.
84c0: 3a 20 3f 71 75 65 72 79 2d 74 61 73 6b 20 28 20 : ?query-task (
84d0: 2d 2d 20 74 61 73 6b 20 29 0a 20 20 20 20 71 75 -- task ). qu
84e0: 65 72 79 2d 74 61 73 6b 20 30 3d 20 49 46 20 20 ery-task 0= IF
84f0: 63 72 65 61 74 65 2d 71 75 65 72 79 2d 74 61 73 create-query-tas
8500: 6b 20 20 54 48 45 4e 20 20 71 75 65 72 79 2d 74 k THEN query-t
8510: 61 73 6b 20 3b 0a 0a 3a 20 64 6f 2d 73 65 6e 64 ask ;..: do-send
8520: 2d 63 68 75 6e 6b 73 20 28 20 2d 2d 20 29 20 64 -chunks ( -- ) d
8530: 61 74 61 2d 74 6f 2d 73 65 6e 64 3f 20 30 3d 20 ata-to-send? 0=
8540: 3f 45 58 49 54 0a 20 20 20 20 5b 3a 20 63 68 75 ?EXIT. [: chu
8550: 6e 6b 73 20 24 40 20 62 6f 75 6e 64 73 20 3f 44 nks $@ bounds ?D
8560: 4f 0a 09 20 20 49 20 63 68 75 6e 6b 2d 63 6f 6e O.. I chunk-con
8570: 74 65 78 74 20 40 20 6f 20 3d 20 49 46 0a 09 20 text @ o = IF..
8580: 20 20 20 20 20 55 4e 4c 4f 4f 50 20 20 45 58 49 UNLOOP EXI
8590: 54 0a 09 20 20 54 48 45 4e 0a 20 20 20 20 20 20 T.. THEN.
85a0: 63 68 75 6e 6b 73 2d 73 74 72 75 63 74 20 2b 4c chunks-struct +L
85b0: 4f 4f 50 0a 20 20 20 20 20 20 6f 20 63 68 75 6e OOP. o chun
85c0: 6b 2d 61 64 64 65 72 20 63 68 75 6e 6b 2d 63 6f k-adder chunk-co
85d0: 6e 74 65 78 74 20 21 0a 20 20 20 20 20 20 30 20 ntext !. 0
85e0: 63 68 75 6e 6b 2d 61 64 64 65 72 20 63 68 75 6e chunk-adder chun
85f0: 6b 2d 63 6f 75 6e 74 20 21 0a 20 20 20 20 20 20 k-count !.
8600: 63 68 75 6e 6b 2d 61 64 64 65 72 20 63 68 75 6e chunk-adder chun
8610: 6b 73 2d 73 74 72 75 63 74 20 63 68 75 6e 6b 73 ks-struct chunks
8620: 20 24 2b 21 20 3b 5d 0a 20 20 20 20 72 65 73 69 $+! ;]. resi
8630: 7a 65 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 6f ze-sema c-sectio
8640: 6e 0a 20 20 20 20 74 69 63 6b 65 72 20 36 34 40 n. ticker 64@
8650: 20 61 63 6b 40 20 2e 74 69 63 6b 73 2d 69 6e 69 ack@ .ticks-ini
8660: 74 20 3b 0a 0a 3a 20 6f 2d 63 68 75 6e 6b 73 20 t ;..: o-chunks
8670: 28 20 2d 2d 20 29 0a 20 20 20 20 5b 3a 20 63 68 ( -- ). [: ch
8680: 75 6e 6b 73 20 24 40 20 62 6f 75 6e 64 73 20 3f unks $@ bounds ?
8690: 44 4f 0a 09 20 20 20 20 49 20 63 68 75 6e 6b 2d DO.. I chunk-
86a0: 63 6f 6e 74 65 78 74 20 40 20 6f 20 3d 20 49 46 context @ o = IF
86b0: 0a 09 09 63 68 75 6e 6b 73 20 49 20 63 68 75 6e ...chunks I chun
86c0: 6b 73 2d 73 74 72 75 63 74 20 64 65 6c 24 6f 6e ks-struct del$on
86d0: 65 0a 09 09 75 6e 6c 6f 6f 70 20 63 68 75 6e 6b e...unloop chunk
86e0: 73 20 6e 65 78 74 24 20 3f 44 4f 20 4e 4f 50 45 s next$ ?DO NOPE
86f0: 20 30 0a 09 20 20 20 20 45 4c 53 45 20 20 63 68 0.. ELSE ch
8700: 75 6e 6b 73 2d 73 74 72 75 63 74 20 20 54 48 45 unks-struct THE
8710: 4e 20 20 2b 4c 4f 4f 50 20 3b 5d 0a 20 20 20 20 N +LOOP ;].
8720: 72 65 73 69 7a 65 2d 73 65 6d 61 20 63 2d 73 65 resize-sema c-se
8730: 63 74 69 6f 6e 20 3b 0a 0a 65 76 65 6e 74 3a 20 ction ;..event:
8740: 3a 3e 73 65 6e 64 2d 63 68 75 6e 6b 73 20 28 20 :>send-chunks (
8750: 6f 20 2d 2d 20 29 20 2e 64 6f 2d 73 65 6e 64 2d o -- ) .do-send-
8760: 63 68 75 6e 6b 73 20 3b 0a 0a 69 6e 20 6e 65 74 chunks ;..in net
8770: 32 6f 20 3a 20 73 65 6e 64 2d 63 68 75 6e 6b 73 2o : send-chunks
8780: 20 20 73 65 6e 64 65 72 2d 74 61 73 6b 20 30 3d sender-task 0=
8790: 20 49 46 20 20 64 6f 2d 73 65 6e 64 2d 63 68 75 IF do-send-chu
87a0: 6e 6b 73 20 20 45 58 49 54 20 20 54 48 45 4e 0a nks EXIT THEN.
87b0: 20 20 20 20 3c 65 76 65 6e 74 20 6f 20 65 6c 69 <event o eli
87c0: 74 2c 20 3a 3e 73 65 6e 64 2d 63 68 75 6e 6b 73 t, :>send-chunks
87d0: 20 73 65 6e 64 65 72 2d 74 61 73 6b 20 65 76 65 sender-task eve
87e0: 6e 74 3e 20 3b 0a 0a 3a 20 63 68 75 6e 6b 2d 63 nt> ;..: chunk-c
87f0: 6f 75 6e 74 2b 20 28 20 63 6f 75 6e 74 65 72 20 ount+ ( counter
8800: 2d 2d 20 29 0a 20 20 20 20 64 75 70 20 40 0a 20 -- ). dup @.
8810: 20 20 20 64 75 70 20 30 3d 20 49 46 0a 09 61 63 dup 0= IF..ac
8820: 6b 2d 74 6f 67 67 6c 65 23 20 61 63 6b 2d 73 74 k-toggle# ack-st
8830: 61 74 65 20 78 6f 72 63 21 0a 09 61 63 6b 2d 72 ate xorc!..ack-r
8840: 65 73 65 6e 64 73 23 0a 09 61 63 6b 2d 72 65 73 esends#..ack-res
8850: 65 6e 64 7e 20 61 63 6b 2d 73 74 61 74 65 20 63 end~ ack-state c
8860: 40 20 78 6f 72 20 72 65 73 65 6e 64 2d 74 6f 67 @ xor resend-tog
8870: 67 6c 65 23 20 61 6e 64 20 30 3c 3e 20 2b 0a 09 gle# and 0<> +..
8880: 30 20 6d 61 78 20 64 75 70 20 74 6f 20 61 63 6b 0 max dup to ack
8890: 2d 72 65 73 65 6e 64 73 23 0a 09 30 3d 20 49 46 -resends#..0= IF
88a0: 20 20 61 63 6b 2d 72 65 73 65 6e 64 7e 20 61 63 ack-resend~ ac
88b0: 6b 2d 73 74 61 74 65 20 63 40 20 72 65 73 65 6e k-state c@ resen
88c0: 64 2d 74 6f 67 67 6c 65 23 20 69 6e 76 65 72 74 d-toggle# invert
88d0: 20 61 6e 64 20 6f 72 0a 09 20 20 20 20 61 63 6b and or.. ack
88e0: 2d 73 74 61 74 65 20 63 21 20 20 61 63 6b 40 20 -state c! ack@
88f0: 2e 66 6c 79 62 75 72 73 74 73 20 40 20 74 6f 20 .flybursts @ to
8900: 61 63 6b 2d 72 65 73 65 6e 64 73 23 20 20 54 48 ack-resends# TH
8910: 45 4e 0a 09 2d 31 20 61 63 6b 40 20 2e 66 6c 79 EN..-1 ack@ .fly
8920: 62 75 72 73 74 73 20 2b 21 20 62 75 72 73 74 73 bursts +! bursts
8930: 28 20 2e 22 20 62 75 72 73 74 73 3a 20 22 20 61 ( ." bursts: " a
8940: 63 6b 40 20 2e 66 6c 79 62 75 72 73 74 73 20 3f ck@ .flybursts ?
8950: 20 61 63 6b 40 20 2e 66 6c 79 62 75 72 73 74 20 ack@ .flyburst
8960: 3f 20 63 72 20 29 0a 09 61 63 6b 40 20 2e 66 6c ? cr )..ack@ .fl
8970: 79 62 75 72 73 74 73 20 40 20 30 3c 3d 20 49 46 ybursts @ 0<= IF
8980: 0a 09 20 20 20 20 62 75 72 73 74 73 28 20 2e 6f .. bursts( .o
8990: 20 2e 22 20 6e 6f 20 62 75 72 73 74 73 20 69 6e ." no bursts in
89a0: 20 66 6c 69 67 68 74 20 22 20 61 63 6b 40 20 2e flight " ack@ .
89b0: 6e 73 2f 62 75 72 73 74 20 3f 20 64 61 74 61 2d ns/burst ? data-
89c0: 74 61 69 6c 40 20 73 77 61 70 20 68 65 78 2e 20 tail@ swap hex.
89d0: 68 65 78 2e 20 63 72 20 29 0a 09 54 48 45 4e 0a hex. cr )..THEN.
89e0: 20 20 20 20 54 48 45 4e 0a 20 20 20 20 74 69 63 THEN. tic
89f0: 6b 2d 69 6e 69 74 20 3d 20 49 46 20 20 6f 66 66 k-init = IF off
8a00: 20 20 45 4c 53 45 20 20 31 20 73 77 61 70 20 2b ELSE 1 swap +
8a10: 21 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 73 65 6e ! THEN ;..: sen
8a20: 64 2d 61 2d 63 68 75 6e 6b 20 28 20 63 68 75 6e d-a-chunk ( chun
8a30: 6b 20 2d 2d 20 66 6c 61 67 20 29 20 20 3e 72 0a k -- flag ) >r.
8a40: 20 20 20 20 64 61 74 61 2d 62 32 62 20 40 20 30 data-b2b @ 0
8a50: 3c 3d 20 49 46 0a 09 61 63 6b 40 20 2e 62 61 6e <= IF..ack@ .ban
8a60: 64 77 69 64 74 68 3f 20 64 75 70 20 20 49 46 0a dwidth? dup IF.
8a70: 09 20 20 20 20 62 32 62 2d 74 6f 67 67 6c 65 23 . b2b-toggle#
8a80: 20 61 63 6b 2d 73 74 61 74 65 20 78 6f 72 63 21 ack-state xorc!
8a90: 0a 09 20 20 20 20 62 75 72 73 74 73 23 20 31 2d .. bursts# 1-
8aa0: 20 64 61 74 61 2d 62 32 62 20 21 0a 09 54 48 45 data-b2b !..THE
8ab0: 4e 0a 20 20 20 20 45 4c 53 45 0a 09 2d 31 20 64 N. ELSE..-1 d
8ac0: 61 74 61 2d 62 32 62 20 2b 21 20 20 74 72 75 65 ata-b2b +! true
8ad0: 0a 20 20 20 20 54 48 45 4e 0a 20 20 20 20 64 75 . THEN. du
8ae0: 70 20 49 46 20 20 72 40 20 63 68 75 6e 6b 2d 63 p IF r@ chunk-c
8af0: 6f 75 6e 74 2b 20 20 6e 65 74 32 6f 3a 73 65 6e ount+ net2o:sen
8b00: 64 2d 63 68 75 6e 6b 0a 09 64 61 74 61 2d 62 32 d-chunk..data-b2
8b10: 62 20 40 20 30 3c 3d 20 49 46 20 20 61 63 6b 40 b @ 0<= IF ack@
8b20: 20 2e 62 75 72 73 74 2d 65 6e 64 20 20 54 48 45 .burst-end THE
8b30: 4e 20 20 74 69 6d 65 6f 75 74 28 20 27 2e 27 20 N timeout( '.'
8b40: 65 6d 69 74 20 29 20 20 54 48 45 4e 0a 20 20 20 emit ) THEN.
8b50: 20 72 64 72 6f 70 20 20 31 20 63 68 75 6e 6b 73 rdrop 1 chunks
8b60: 2b 20 2b 21 20 3b 0a 0a 3a 20 2e 6e 6f 73 65 6e + +! ;..: .nosen
8b70: 64 20 28 20 2d 2d 20 29 20 61 63 6b 40 20 3e 6f d ( -- ) ack@ >o
8b80: 20 2e 22 20 64 6f 6e 65 2c 20 22 20 20 34 20 73 ." done, " 4 s
8b90: 65 74 2d 70 72 65 63 69 73 69 6f 6e 0a 20 20 20 et-precision.
8ba0: 20 2e 6f 20 2e 22 20 72 61 74 65 3a 20 22 20 6e .o ." rate: " n
8bb0: 73 2f 62 75 72 73 74 20 40 20 73 3e 66 20 74 69 s/burst @ s>f ti
8bc0: 63 6b 2d 69 6e 69 74 20 63 68 75 6e 6b 2d 70 32 ck-init chunk-p2
8bd0: 20 6c 73 68 69 66 74 20 73 3e 66 20 31 65 39 20 lshift s>f 1e9
8be0: 66 2a 20 66 73 77 61 70 20 66 2f 20 66 65 2e 20 f* fswap f/ fe.
8bf0: 63 72 0a 20 20 20 20 2e 6f 20 2e 22 20 73 6c 61 cr. .o ." sla
8c00: 63 6b 3a 20 22 20 6d 69 6e 2d 73 6c 61 63 6b 20 ck: " min-slack
8c10: 36 34 40 20 75 36 34 2e 20 6d 61 78 2d 73 6c 61 64@ u64. max-sla
8c20: 63 6b 20 36 34 40 20 75 36 34 2e 20 63 72 0a 20 ck 64@ u64. cr.
8c30: 20 20 20 2e 6f 20 2e 22 20 72 74 64 65 6c 61 79 .o ." rtdelay
8c40: 3a 20 22 20 72 74 64 65 6c 61 79 20 36 34 40 20 : " rtdelay 64@
8c50: 75 36 34 2e 20 63 72 20 6f 3e 0a 20 20 20 20 64 u64. cr o>. d
8c60: 61 74 61 2d 6d 61 70 20 77 69 74 68 20 6d 61 70 ata-map with map
8c70: 63 0a 20 20 20 20 2e 22 20 44 61 74 61 20 68 20 c. ." Data h
8c80: 62 20 74 3a 20 22 20 64 65 73 74 2d 68 65 61 64 b t: " dest-head
8c90: 20 68 65 78 2e 20 64 65 73 74 2d 62 61 63 6b 20 hex. dest-back
8ca0: 68 65 78 2e 20 64 65 73 74 2d 74 61 69 6c 20 68 hex. dest-tail h
8cb0: 65 78 2e 20 63 72 0a 20 20 20 20 65 6e 64 77 69 ex. cr. endwi
8cc0: 74 68 20 3b 0a 0a 3a 20 73 65 6e 64 2d 63 68 75 th ;..: send-chu
8cd0: 6e 6b 73 2d 61 73 79 6e 63 20 28 20 2d 2d 20 66 nks-async ( -- f
8ce0: 6c 61 67 20 29 0a 20 20 20 20 63 68 75 6e 6b 73 lag ). chunks
8cf0: 20 24 40 20 64 75 70 20 30 3d 20 49 46 20 20 6e $@ dup 0= IF n
8d00: 69 70 20 20 45 58 49 54 20 20 54 48 45 4e 0a 20 ip EXIT THEN.
8d10: 20 20 20 63 68 75 6e 6b 73 2b 20 40 20 63 68 75 chunks+ @ chu
8d20: 6e 6b 73 2d 73 74 72 75 63 74 20 2a 20 73 61 66 nks-struct * saf
8d30: 65 2f 73 74 72 69 6e 67 0a 20 20 20 20 49 46 0a e/string. IF.
8d40: 09 64 75 70 20 63 68 75 6e 6b 2d 63 6f 6e 74 65 .dup chunk-conte
8d50: 78 74 20 40 20 3e 6f 20 72 64 72 6f 70 0a 09 63 xt @ >o rdrop..c
8d60: 68 75 6e 6b 2d 63 6f 75 6e 74 0a 09 64 61 74 61 hunk-count..data
8d70: 2d 74 6f 2d 73 65 6e 64 3f 20 49 46 0a 09 20 20 -to-send? IF..
8d80: 20 20 73 65 6e 64 2d 61 2d 63 68 75 6e 6b 0a 09 send-a-chunk..
8d90: 45 4c 53 45 0a 09 20 20 20 20 64 72 6f 70 20 6d ELSE.. drop m
8da0: 73 67 28 20 2e 6e 6f 73 65 6e 64 20 29 0a 09 20 sg( .nosend )..
8db0: 20 20 20 5b 3a 20 63 68 75 6e 6b 73 20 63 68 75 [: chunks chu
8dc0: 6e 6b 73 2b 20 40 20 63 68 75 6e 6b 73 2d 73 74 nks+ @ chunks-st
8dd0: 72 75 63 74 20 2a 20 63 68 75 6e 6b 73 2d 73 74 ruct * chunks-st
8de0: 72 75 63 74 20 24 64 65 6c 20 3b 5d 0a 09 20 20 ruct $del ;]..
8df0: 20 20 72 65 73 69 7a 65 2d 73 65 6d 61 20 63 2d resize-sema c-
8e00: 73 65 63 74 69 6f 6e 0a 09 20 20 20 20 66 61 6c section.. fal
8e10: 73 65 0a 09 54 48 45 4e 0a 20 20 20 20 45 4c 53 se..THEN. ELS
8e20: 45 20 20 64 72 6f 70 20 63 68 75 6e 6b 73 2b 20 E drop chunks+
8e30: 6f 66 66 20 66 61 6c 73 65 20 20 54 48 45 4e 20 off false THEN
8e40: 3b 0a 0a 3a 20 6e 65 78 74 2d 63 68 75 6e 6b 2d ;..: next-chunk-
8e50: 74 69 63 6b 20 28 20 2d 2d 20 74 69 63 6b 20 29 tick ( -- tick )
8e60: 0a 20 20 20 20 36 34 23 2d 31 20 63 68 75 6e 6b . 64#-1 chunk
8e70: 73 20 24 40 20 62 6f 75 6e 64 73 20 3f 44 4f 0a s $@ bounds ?DO.
8e80: 09 49 20 63 68 75 6e 6b 2d 63 6f 6e 74 65 78 74 .I chunk-context
8e90: 20 40 20 2e 61 63 6b 40 20 2e 6e 65 78 74 2d 74 @ .ack@ .next-t
8ea0: 69 63 6b 20 36 34 40 20 36 34 75 6d 69 6e 0a 20 ick 64@ 64umin.
8eb0: 20 20 20 63 68 75 6e 6b 73 2d 73 74 72 75 63 74 chunks-struct
8ec0: 20 2b 4c 4f 4f 50 20 3b 0a 0a 3a 20 73 65 6e 64 +LOOP ;..: send
8ed0: 2d 61 6e 6f 74 68 65 72 2d 63 68 75 6e 6b 20 28 -another-chunk (
8ee0: 20 2d 2d 20 66 6c 61 67 20 29 20 20 66 61 6c 73 -- flag ) fals
8ef0: 65 20 20 30 20 3e 72 20 20 21 74 69 63 6b 73 0a e 0 >r !ticks.
8f00: 20 20 20 20 42 45 47 49 4e 20 20 42 45 47 49 4e BEGIN BEGIN
8f10: 20 20 64 72 6f 70 20 73 65 6e 64 2d 63 68 75 6e drop send-chun
8f20: 6b 73 2d 61 73 79 6e 63 20 64 75 70 20 20 57 48 ks-async dup WH
8f30: 49 4c 45 20 20 72 64 72 6f 70 20 30 20 3e 72 20 ILE rdrop 0 >r
8f40: 20 52 45 50 45 41 54 0a 09 63 68 75 6e 6b 73 2b REPEAT..chunks+
8f50: 20 40 20 30 3d 20 49 46 20 20 72 3e 20 31 2b 20 @ 0= IF r> 1+
8f60: 3e 72 20 20 54 48 45 4e 0a 20 20 20 20 72 40 20 >r THEN. r@
8f70: 32 20 75 3e 3d 20 20 55 4e 54 49 4c 20 20 72 64 2 u>= UNTIL rd
8f80: 72 6f 70 20 3b 0a 0a 3a 20 73 65 6e 64 2d 61 6e rop ;..: send-an
8f90: 79 74 68 69 6e 67 3f 20 28 20 2d 2d 20 66 6c 61 ything? ( -- fla
8fa0: 67 20 29 20 20 63 68 75 6e 6b 73 20 24 40 6c 65 g ) chunks $@le
8fb0: 6e 20 30 3e 20 3b 0a 0a 5c 20 72 65 77 69 6e 64 n 0> ;..\ rewind
8fc0: 20 62 75 66 66 65 72 20 74 6f 20 73 65 6e 64 20 buffer to send
8fd0: 66 75 72 74 68 65 72 20 70 61 63 6b 65 74 73 0a further packets.
8fe0: 0a 73 63 6f 70 65 7b 20 6d 61 70 63 0a 0a 3a 6e .scope{ mapc..:n
8ff0: 6f 6e 61 6d 65 20 28 20 6f 3a 6d 61 70 20 2d 2d oname ( o:map --
9000: 20 29 20 64 65 73 74 2d 73 69 7a 65 20 61 64 64 ) dest-size add
9010: 72 3e 74 73 20 0a 20 20 20 20 64 65 73 74 2d 74 r>ts . dest-t
9020: 69 6d 65 73 74 61 6d 70 73 20 6f 76 65 72 20 65 imestamps over e
9030: 72 61 73 65 0a 20 20 20 20 64 61 74 61 2d 72 65 rase. data-re
9040: 73 65 6e 64 23 20 40 20 73 77 61 70 20 24 46 46 send# @ swap $FF
9050: 20 66 69 6c 6c 20 3b 0a 64 61 74 61 2d 63 6c 61 fill ;.data-cla
9060: 73 73 20 74 6f 20 72 65 77 69 6e 64 2d 74 69 6d ss to rewind-tim
9070: 65 73 74 61 6d 70 73 0a 3a 6e 6f 6e 61 6d 65 20 estamps.:noname
9080: 28 20 6f 3a 6d 61 70 20 2d 2d 20 29 20 64 65 73 ( o:map -- ) des
9090: 74 2d 73 69 7a 65 20 61 64 64 72 3e 74 73 0a 20 t-size addr>ts.
90a0: 20 20 20 64 65 73 74 2d 74 69 6d 65 73 74 61 6d dest-timestam
90b0: 70 73 20 6f 76 65 72 20 65 72 61 73 65 20 3b 0a ps over erase ;.
90c0: 72 64 61 74 61 2d 63 6c 61 73 73 20 74 6f 20 72 rdata-class to r
90d0: 65 77 69 6e 64 2d 74 69 6d 65 73 74 61 6d 70 73 ewind-timestamps
90e0: 0a 0a 3a 20 72 65 77 69 6e 64 2d 74 73 2d 70 61 ..: rewind-ts-pa
90f0: 72 74 69 61 6c 20 28 20 6f 6c 64 2d 62 61 63 6b rtial ( old-back
9100: 20 6e 65 77 2d 62 61 63 6b 20 61 64 64 72 20 6f new-back addr o
9110: 3a 6d 61 70 20 2d 2d 20 29 0a 20 20 20 20 7b 20 :map -- ). {
9120: 61 64 64 72 20 7d 20 61 64 64 72 3e 74 73 20 73 addr } addr>ts s
9130: 77 61 70 20 61 64 64 72 3e 74 73 20 55 2b 44 4f wap addr>ts U+DO
9140: 0a 09 49 20 49 27 20 66 69 78 2d 74 73 73 69 7a ..I I' fix-tssiz
9150: 65 09 7b 20 6c 65 6e 20 7d 20 61 64 64 72 20 2b e.{ len } addr +
9160: 20 6c 65 6e 20 65 72 61 73 65 0a 20 20 20 20 6c len erase. l
9170: 65 6e 20 2b 4c 4f 4f 50 20 3b 0a 3a 6e 6f 6e 61 en +LOOP ;.:nona
9180: 6d 65 20 28 20 6f 6c 64 2d 62 61 63 6b 20 6e 65 me ( old-back ne
9190: 77 2d 62 61 63 6b 20 6f 3a 6d 61 70 20 2d 2d 20 w-back o:map --
91a0: 29 0a 20 20 20 20 32 64 75 70 20 64 61 74 61 2d ). 2dup data-
91b0: 72 65 73 65 6e 64 23 20 40 20 72 65 77 69 6e 64 resend# @ rewind
91c0: 2d 74 73 2d 70 61 72 74 69 61 6c 0a 20 20 20 20 -ts-partial.
91d0: 32 64 75 70 20 64 65 73 74 2d 74 69 6d 65 73 74 2dup dest-timest
91e0: 61 6d 70 73 20 72 65 77 69 6e 64 2d 74 73 2d 70 amps rewind-ts-p
91f0: 61 72 74 69 61 6c 0a 20 20 20 20 72 65 67 65 6e artial. regen
9200: 2d 69 76 73 2d 70 61 72 74 20 3b 0a 64 61 74 61 -ivs-part ;.data
9210: 2d 63 6c 61 73 73 20 74 6f 20 72 65 77 69 6e 64 -class to rewind
9220: 2d 70 61 72 74 69 61 6c 0a 3a 6e 6f 6e 61 6d 65 -partial.:noname
9230: 20 28 20 6f 6c 64 2d 62 61 63 6b 20 6e 65 77 2d ( old-back new-
9240: 62 61 63 6b 20 6f 3a 6d 61 70 20 2d 2d 20 29 0a back o:map -- ).
9250: 20 20 20 20 32 64 75 70 20 61 63 6b 62 69 74 73 2dup ackbits
9260: 2d 65 72 61 73 65 0a 20 20 20 20 32 64 75 70 20 -erase. 2dup
9270: 64 65 73 74 2d 74 69 6d 65 73 74 61 6d 70 73 20 dest-timestamps
9280: 72 65 77 69 6e 64 2d 74 73 2d 70 61 72 74 69 61 rewind-ts-partia
9290: 6c 0a 20 20 20 20 72 65 67 65 6e 2d 69 76 73 2d l. regen-ivs-
92a0: 70 61 72 74 20 3b 0a 72 64 61 74 61 2d 63 6c 61 part ;.rdata-cla
92b0: 73 73 20 74 6f 20 72 65 77 69 6e 64 2d 70 61 72 ss to rewind-par
92c0: 74 69 61 6c 0a 0a 7d 73 63 6f 70 65 0a 0a 69 6e tial..}scope..in
92d0: 20 6e 65 74 32 6f 20 3a 20 72 65 77 69 6e 64 2d net2o : rewind-
92e0: 73 65 6e 64 65 72 2d 70 61 72 74 69 61 6c 20 28 sender-partial (
92f0: 20 6e 65 77 2d 62 61 63 6b 20 2d 2d 20 29 0a 20 new-back -- ).
9300: 20 20 20 64 61 74 61 2d 6d 61 70 20 77 69 74 68 data-map with
9310: 20 6d 61 70 63 20 64 65 73 74 2d 62 61 63 6b 20 mapc dest-back
9320: 75 6d 61 78 20 64 65 73 74 2d 62 61 63 6b 20 6f umax dest-back o
9330: 76 65 72 20 72 65 77 69 6e 64 2d 70 61 72 74 69 ver rewind-parti
9340: 61 6c 0a 09 64 65 73 74 2d 62 61 63 6b 20 6f 76 al..dest-back ov
9350: 65 72 20 72 65 77 69 6e 64 2d 72 65 73 65 6e 64 er rewind-resend
9360: 20 74 6f 20 64 65 73 74 2d 62 61 63 6b 0a 20 20 to dest-back.
9370: 20 20 65 6e 64 77 69 74 68 20 3b 0a 0a 5c 20 73 endwith ;..\ s
9380: 65 70 61 72 61 74 65 20 74 68 72 65 61 64 20 66 eparate thread f
9390: 6f 72 20 6c 6f 61 64 69 6e 67 20 61 6e 64 20 73 or loading and s
93a0: 61 76 69 6e 67 2e 2e 2e 0a 0a 69 6e 20 6e 65 74 aving.....in net
93b0: 32 6f 20 3a 20 73 61 76 65 20 7b 20 74 61 69 6c 2o : save { tail
93c0: 20 2d 2d 20 7d 0a 20 20 20 20 64 61 74 61 2d 72 -- }. data-r
93d0: 6d 61 70 20 3f 64 75 70 2d 49 46 0a 09 2e 6d 61 map ?dup-IF...ma
93e0: 70 63 3a 64 65 73 74 2d 62 61 63 6b 20 7b 20 6f pc:dest-back { o
93f0: 6c 64 62 61 63 6b 20 7d 0a 09 6f 6c 64 62 61 63 ldback }..oldbac
9400: 6b 20 74 61 69 6c 20 6e 65 74 32 6f 3a 73 70 69 k tail net2o:spi
9410: 74 20 7b 20 62 61 63 6b 20 7d 0a 09 64 61 74 61 t { back }..data
9420: 2d 72 6d 61 70 20 77 69 74 68 20 6d 61 70 63 0a -rmap with mapc.
9430: 09 20 20 20 20 6f 6c 64 62 61 63 6b 20 62 61 63 . oldback bac
9440: 6b 20 72 65 77 69 6e 64 2d 70 61 72 74 69 61 6c k rewind-partial
9450: 20 20 62 61 63 6b 20 74 6f 20 64 65 73 74 2d 62 back to dest-b
9460: 61 63 6b 0a 09 20 20 20 20 64 65 73 74 2d 72 65 ack.. dest-re
9470: 71 20 49 46 20 20 62 61 63 6b 20 64 6f 2d 73 6c q IF back do-sl
9480: 75 72 70 20 21 20 20 54 48 45 4e 0a 09 65 6e 64 urp ! THEN..end
9490: 77 69 74 68 0a 20 20 20 20 54 48 45 4e 20 3b 0a with. THEN ;.
94a0: 0a 44 65 66 65 72 20 64 6f 2d 74 72 61 63 6b 2d .Defer do-track-
94b0: 73 65 65 6b 0a 0a 65 76 65 6e 74 3a 20 3a 3e 73 seek..event: :>s
94c0: 61 76 65 20 28 20 74 61 69 6c 20 6f 20 2d 2d 20 ave ( tail o --
94d0: 29 20 20 2e 6e 65 74 32 6f 3a 73 61 76 65 20 3b ) .net2o:save ;
94e0: 0a 65 76 65 6e 74 3a 20 3a 3e 73 61 76 65 26 64 .event: :>save&d
94f0: 6f 6e 65 20 28 20 74 61 69 6c 20 6f 20 2d 2d 20 one ( tail o --
9500: 29 0a 20 20 20 20 3e 6f 20 6e 65 74 32 6f 3a 73 ). >o net2o:s
9510: 61 76 65 20 73 79 6e 63 2d 64 6f 6e 65 2d 78 74 ave sync-done-xt
9520: 20 6f 3e 20 3b 0a 65 76 65 6e 74 3a 20 3a 3e 63 o> ;.event: :>c
9530: 6c 6f 73 65 2d 61 6c 6c 20 28 20 6f 20 2d 2d 20 lose-all ( o --
9540: 29 0a 20 20 20 20 2e 6e 65 74 32 6f 3a 63 6c 6f ). .net2o:clo
9550: 73 65 2d 61 6c 6c 20 3b 0a 0a 30 20 56 61 6c 75 se-all ;..0 Valu
9560: 65 20 66 69 6c 65 2d 74 61 73 6b 0a 0a 3a 20 63 e file-task..: c
9570: 72 65 61 74 65 2d 66 69 6c 65 2d 74 61 73 6b 20 reate-file-task
9580: 28 20 2d 2d 20 29 0a 20 20 20 20 5b 27 5d 20 65 ( -- ). ['] e
9590: 76 65 6e 74 2d 6c 6f 6f 70 27 20 31 20 6e 65 74 vent-loop' 1 net
95a0: 32 6f 2d 74 61 73 6b 20 74 6f 20 66 69 6c 65 2d 2o-task to file-
95b0: 74 61 73 6b 20 3b 0a 3a 20 3f 66 69 6c 65 2d 74 task ;.: ?file-t
95c0: 61 73 6b 20 28 20 2d 2d 20 66 69 6c 65 2d 74 61 ask ( -- file-ta
95d0: 73 6b 20 29 0a 20 20 20 20 66 69 6c 65 2d 74 61 sk ). file-ta
95e0: 73 6b 20 30 3d 20 49 46 20 20 63 72 65 61 74 65 sk 0= IF create
95f0: 2d 66 69 6c 65 2d 74 61 73 6b 20 20 54 48 45 4e -file-task THEN
9600: 0a 20 20 20 20 66 69 6c 65 2d 74 61 73 6b 20 3b . file-task ;
9610: 0a 69 6e 20 6e 65 74 32 6f 20 3a 20 73 61 76 65 .in net2o : save
9620: 26 20 28 20 2d 2d 20 29 0a 20 20 20 20 73 79 6e & ( -- ). syn
9630: 63 66 69 6c 65 28 20 64 61 74 61 2d 72 6d 61 70 cfile( data-rmap
9640: 20 2e 6d 61 70 63 3a 64 65 73 74 2d 74 61 69 6c .mapc:dest-tail
9650: 20 6e 65 74 32 6f 3a 73 61 76 65 20 29 65 6c 73 net2o:save )els
9660: 65 28 0a 20 20 20 20 64 61 74 61 2d 72 6d 61 70 e(. data-rmap
9670: 20 2e 6d 61 70 63 3a 64 65 73 74 2d 74 61 69 6c .mapc:dest-tail
9680: 20 65 6c 69 74 2c 0a 20 20 20 20 6f 20 65 6c 69 elit,. o eli
9690: 74 2c 20 3a 3e 73 61 76 65 20 3f 66 69 6c 65 2d t, :>save ?file-
96a0: 74 61 73 6b 20 65 76 65 6e 74 3e 20 29 20 3b 0a task event> ) ;.
96b0: 69 6e 20 6e 65 74 32 6f 20 3a 20 73 61 76 65 26 in net2o : save&
96c0: 64 6f 6e 65 20 28 20 2d 2d 20 29 0a 20 20 20 20 done ( -- ).
96d0: 73 79 6e 63 66 69 6c 65 28 20 64 61 74 61 2d 72 syncfile( data-r
96e0: 6d 61 70 20 2e 6d 61 70 63 3a 64 65 73 74 2d 74 map .mapc:dest-t
96f0: 61 69 6c 20 6e 65 74 32 6f 3a 73 61 76 65 20 73 ail net2o:save s
9700: 79 6e 63 2d 64 6f 6e 65 2d 78 74 20 29 65 6c 73 ync-done-xt )els
9710: 65 28 0a 20 20 20 20 64 61 74 61 2d 72 6d 61 70 e(. data-rmap
9720: 20 2e 6d 61 70 63 3a 64 65 73 74 2d 74 61 69 6c .mapc:dest-tail
9730: 20 65 6c 69 74 2c 0a 20 20 20 20 6f 20 65 6c 69 elit,. o eli
9740: 74 2c 20 3a 3e 73 61 76 65 26 64 6f 6e 65 20 3f t, :>save&done ?
9750: 66 69 6c 65 2d 74 61 73 6b 20 65 76 65 6e 74 7c file-task event|
9760: 20 29 20 3b 0a 0a 5c 20 73 63 68 65 64 75 6c 65 ) ;..\ schedule
9770: 20 64 65 6c 61 79 65 64 20 65 76 65 6e 74 73 0a delayed events.
9780: 0a 6f 62 6a 65 63 74 20 63 6c 61 73 73 0a 36 34 .object class.64
9790: 66 69 65 6c 64 3a 20 71 75 65 75 65 2d 74 69 6d field: queue-tim
97a0: 65 73 74 61 6d 70 0a 66 69 65 6c 64 3a 20 71 75 estamp.field: qu
97b0: 65 75 65 2d 6a 6f 62 0a 64 65 66 65 72 3a 20 71 eue-job.defer: q
97c0: 75 65 75 65 2d 78 74 0a 65 6e 64 2d 63 6c 61 73 ueue-xt.end-clas
97d0: 73 20 71 75 65 75 65 2d 63 6c 61 73 73 0a 71 75 s queue-class.qu
97e0: 65 75 65 2d 63 6c 61 73 73 20 3e 6f 73 69 7a 65 eue-class >osize
97f0: 20 40 20 43 6f 6e 73 74 61 6e 74 20 71 75 65 75 @ Constant queu
9800: 65 2d 73 74 72 75 63 74 0a 0a 56 61 72 69 61 62 e-struct..Variab
9810: 6c 65 20 71 75 65 75 65 0a 71 75 65 75 65 2d 63 le queue.queue-c
9820: 6c 61 73 73 20 3e 6f 73 69 7a 65 20 40 20 62 75 lass >osize @ bu
9830: 66 66 65 72 3a 20 71 75 65 75 65 2d 61 64 64 65 ffer: queue-adde
9840: 72 20 20 0a 0a 3a 20 61 64 64 2d 71 75 65 75 65 r ..: add-queue
9850: 20 28 20 78 74 20 75 73 20 2d 2d 20 29 0a 20 20 ( xt us -- ).
9860: 20 20 74 69 63 6b 65 72 20 36 34 40 20 2b 20 20 ticker 64@ +
9870: 6f 20 71 75 65 75 65 2d 61 64 64 65 72 20 3e 6f o queue-adder >o
9880: 20 71 75 65 75 65 2d 6a 6f 62 20 21 20 20 71 75 queue-job ! qu
9890: 65 75 65 2d 74 69 6d 65 73 74 61 6d 70 20 36 34 eue-timestamp 64
98a0: 21 0a 20 20 20 20 69 73 20 71 75 65 75 65 2d 78 !. is queue-x
98b0: 74 20 20 6f 20 71 75 65 75 65 2d 73 74 72 75 63 t o queue-struc
98c0: 74 20 71 75 65 75 65 20 24 2b 21 20 6f 3e 20 3b t queue $+! o> ;
98d0: 0a 0a 3a 20 65 76 61 6c 2d 71 75 65 75 65 20 28 ..: eval-queue (
98e0: 20 2d 2d 20 29 0a 20 20 20 20 71 75 65 75 65 20 -- ). queue
98f0: 24 40 6c 65 6e 20 30 3d 20 3f 45 58 49 54 20 20 $@len 0= ?EXIT
9900: 74 69 63 6b 65 72 20 36 34 40 0a 20 20 20 20 71 ticker 64@. q
9910: 75 65 75 65 20 24 40 20 62 6f 75 6e 64 73 20 3f ueue $@ bounds ?
9920: 44 4f 20 20 49 20 3e 6f 0a 09 36 34 64 75 70 20 DO I >o..64dup
9930: 71 75 65 75 65 2d 74 69 6d 65 73 74 61 6d 70 20 queue-timestamp
9940: 36 34 40 20 36 34 75 3e 20 49 46 0a 09 20 20 20 64@ 64u> IF..
9950: 20 61 64 64 72 20 71 75 65 75 65 2d 78 74 20 40 addr queue-xt @
9960: 20 71 75 65 75 65 2d 6a 6f 62 20 40 20 2e 65 78 queue-job @ .ex
9970: 65 63 75 74 65 20 6f 3e 0a 09 20 20 20 20 71 75 ecute o>.. qu
9980: 65 75 65 20 49 20 71 75 65 75 65 2d 73 74 72 75 eue I queue-stru
9990: 63 74 20 64 65 6c 24 6f 6e 65 0a 09 20 20 20 20 ct del$one..
99a0: 75 6e 6c 6f 6f 70 20 71 75 65 75 65 20 6e 65 78 unloop queue nex
99b0: 74 24 20 3f 44 4f 20 20 4e 4f 50 45 20 30 0a 09 t$ ?DO NOPE 0..
99c0: 45 4c 53 45 20 20 6f 3e 20 20 71 75 65 75 65 2d ELSE o> queue-
99d0: 73 74 72 75 63 74 20 20 54 48 45 4e 0a 20 20 20 struct THEN.
99e0: 20 2b 4c 4f 4f 50 20 20 36 34 64 72 6f 70 20 3b +LOOP 64drop ;
99f0: 0a 0a 5c 20 70 6f 6c 6c 20 6c 6f 6f 70 0a 0a 3a ..\ poll loop..:
9a00: 20 70 72 65 70 2d 65 76 73 6f 63 6b 73 20 28 20 prep-evsocks (
9a10: 2d 2d 20 29 0a 20 20 20 20 65 70 69 70 65 72 20 -- ). epiper
9a20: 40 20 20 20 20 66 69 6c 65 6e 6f 20 50 4f 4c 4c @ fileno POLL
9a30: 49 4e 20 70 6f 6c 6c 66 64 73 20 66 64 73 21 2b IN pollfds fds!+
9a40: 20 64 72 6f 70 20 31 20 74 6f 20 70 6f 6c 6c 66 drop 1 to pollf
9a50: 64 23 20 3b 0a 0a 3a 20 63 6c 65 61 72 2d 65 76 d# ;..: clear-ev
9a60: 65 6e 74 73 20 28 20 2d 2d 20 29 20 20 70 6f 6c ents ( -- ) pol
9a70: 6c 66 64 73 0a 20 20 20 20 70 6f 6c 6c 66 64 23 lfds. pollfd#
9a80: 20 30 20 44 4f 20 20 30 20 6f 76 65 72 20 72 65 0 DO 0 over re
9a90: 76 65 6e 74 73 20 77 21 20 20 70 6f 6c 6c 66 64 vents w! pollfd
9aa0: 20 2b 20 20 4c 4f 4f 50 20 20 64 72 6f 70 20 3b + LOOP drop ;
9ab0: 0a 0a 3a 20 74 69 6d 65 6f 75 74 21 20 28 20 2d ..: timeout! ( -
9ac0: 2d 20 29 0a 20 20 20 20 73 65 6e 64 65 72 2d 74 - ). sender-t
9ad0: 61 73 6b 20 64 75 70 20 49 46 20 20 75 70 40 20 ask dup IF up@
9ae0: 3d 20 20 45 4c 53 45 20 20 30 3d 20 20 54 48 45 = ELSE 0= THE
9af0: 4e 20 20 49 46 0a 09 6e 65 78 74 2d 63 68 75 6e N IF..next-chun
9b00: 6b 2d 74 69 63 6b 20 36 34 64 75 70 20 36 34 23 k-tick 64dup 64#
9b10: 2d 31 20 36 34 3d 20 30 3d 20 3e 72 20 74 69 63 -1 64= 0= >r tic
9b20: 6b 65 72 20 36 34 40 20 36 34 2d 20 36 34 64 75 ker 64@ 64- 64du
9b30: 70 20 36 34 2d 30 3e 3d 20 72 3e 20 6f 72 0a 09 p 64-0>= r> or..
9b40: 49 46 20 20 20 20 36 34 23 30 20 36 34 6d 61 78 IF 64#0 64max
9b50: 20 70 6f 6c 6c 2d 74 69 6d 65 6f 75 74 23 20 6e poll-timeout# n
9b60: 3e 36 34 20 36 34 6d 69 6e 20 36 34 3e 64 0a 09 >64 64min 64>d..
9b70: 45 4c 53 45 20 20 36 34 64 72 6f 70 20 70 6f 6c ELSE 64drop pol
9b80: 6c 2d 74 69 6d 65 6f 75 74 23 20 30 20 20 54 48 l-timeout# 0 TH
9b90: 45 4e 0a 20 20 20 20 45 4c 53 45 20 20 70 6f 6c EN. ELSE pol
9ba0: 6c 2d 74 69 6d 65 6f 75 74 23 20 30 20 20 54 48 l-timeout# 0 TH
9bb0: 45 4e 20 20 70 74 69 6d 65 6f 75 74 20 32 21 20 EN ptimeout 2!
9bc0: 3b 0a 0a 3a 20 6d 61 78 2d 74 69 6d 65 6f 75 74 ;..: max-timeout
9bd0: 21 20 28 20 2d 2d 20 29 20 70 6f 6c 6c 2d 74 69 ! ( -- ) poll-ti
9be0: 6d 65 6f 75 74 23 20 30 20 70 74 69 6d 65 6f 75 meout# 0 ptimeou
9bf0: 74 20 32 21 20 3b 0a 0a 3a 20 3e 70 6f 6c 6c 20 t 2! ;..: >poll
9c00: 28 20 61 64 64 72 20 75 20 2d 2d 20 66 6c 61 67 ( addr u -- flag
9c10: 20 29 20 5c 20 70 72 65 70 2d 73 6f 63 6b 73 0a ) \ prep-socks.
9c20: 5b 49 46 44 45 46 5d 20 70 70 6f 6c 6c 0a 20 20 [IFDEF] ppoll.
9c30: 20 20 70 74 69 6d 65 6f 75 74 20 30 20 70 70 6f ptimeout 0 ppo
9c40: 6c 6c 20 30 3e 0a 5b 45 4c 53 45 5d 0a 20 20 20 ll 0>.[ELSE].
9c50: 20 70 74 69 6d 65 6f 75 74 20 32 40 20 23 31 30 ptimeout 2@ #10
9c60: 30 30 20 2a 20 73 77 61 70 20 23 31 30 30 30 30 00 * swap #10000
9c70: 30 30 20 2f 20 2b 20 70 6f 6c 6c 20 30 3e 0a 5b 00 / + poll 0>.[
9c80: 54 48 45 4e 5d 20 2b 77 61 69 74 0a 3b 0a 0a 3a THEN] +wait.;..:
9c90: 20 77 61 69 74 2d 73 65 6e 64 20 28 20 2d 2d 20 wait-send ( --
9ca0: 66 6c 61 67 20 29 0a 20 20 20 20 28 20 63 6c 65 flag ). ( cle
9cb0: 61 72 2d 65 76 65 6e 74 73 20 29 20 20 74 69 6d ar-events ) tim
9cc0: 65 6f 75 74 21 20 20 70 6f 6c 6c 66 64 73 20 70 eout! pollfds p
9cd0: 6f 6c 6c 66 64 23 20 3e 70 6f 6c 6c 20 3b 0a 0a ollfd# >poll ;..
9ce0: 3a 20 70 6f 6c 6c 2d 73 6f 63 6b 20 28 20 2d 2d : poll-sock ( --
9cf0: 20 66 6c 61 67 20 29 0a 20 20 20 20 65 76 61 6c flag ). eval
9d00: 2d 71 75 65 75 65 20 20 77 61 69 74 2d 73 65 6e -queue wait-sen
9d10: 64 20 3b 0a 0a 55 73 65 72 20 74 72 79 2d 72 65 d ;..User try-re
9d20: 61 64 73 0a 34 20 56 61 6c 75 65 20 74 72 79 2d ads.4 Value try-
9d30: 72 65 61 64 23 0a 0a 3a 20 72 65 61 64 2d 61 2d read#..: read-a-
9d40: 70 61 63 6b 65 74 34 2f 36 20 28 20 2d 2d 20 61 packet4/6 ( -- a
9d50: 64 64 72 20 75 20 29 0a 20 20 20 20 70 6f 6c 6c ddr u ). poll
9d60: 66 64 73 20 5b 20 70 6f 6c 6c 66 64 20 72 65 76 fds [ pollfd rev
9d70: 65 6e 74 73 20 5d 4c 20 2b 20 77 40 20 50 4f 4c ents ]L + w@ POL
9d80: 4c 49 4e 20 61 6e 64 20 49 46 20 20 74 72 79 2d LIN and IF try-
9d90: 72 65 61 64 73 20 6f 66 66 0a 09 64 6f 2d 62 6c reads off..do-bl
9da0: 6f 63 6b 20 72 65 61 64 2d 61 2d 70 61 63 6b 65 ock read-a-packe
9db0: 74 0a 09 28 20 30 20 70 6f 6c 6c 66 64 73 20 5b t..( 0 pollfds [
9dc0: 20 70 6f 6c 6c 66 64 20 72 65 76 65 6e 74 73 20 pollfd revents
9dd0: 5d 4c 20 2b 20 77 21 20 29 20 2b 72 65 63 20 45 ]L + w! ) +rec E
9de0: 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 5b 49 XIT THEN. [I
9df0: 46 44 45 46 5d 20 6e 6f 2d 68 79 62 72 69 64 0a FDEF] no-hybrid.
9e00: 09 70 6f 6c 6c 66 64 73 20 5b 20 70 6f 6c 6c 66 .pollfds [ pollf
9e10: 64 20 32 2a 20 72 65 76 65 6e 74 73 20 5d 4c 20 d 2* revents ]L
9e20: 2b 20 77 40 20 50 4f 4c 4c 49 4e 20 61 6e 64 20 + w@ POLLIN and
9e30: 49 46 20 20 74 72 79 2d 72 65 61 64 73 20 6f 66 IF try-reads of
9e40: 66 0a 09 20 20 20 20 64 6f 2d 62 6c 6f 63 6b 20 f.. do-block
9e50: 72 65 61 64 2d 61 2d 70 61 63 6b 65 74 34 0a 09 read-a-packet4..
9e60: 20 20 20 20 28 20 30 20 70 6f 6c 6c 66 64 73 20 ( 0 pollfds
9e70: 5b 20 70 6f 6c 6c 66 64 20 32 2a 20 72 65 76 65 [ pollfd 2* reve
9e80: 6e 74 73 20 5d 4c 20 2b 20 77 21 20 29 20 2b 72 nts ]L + w! ) +r
9e90: 65 63 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 ec EXIT THEN.
9ea0: 20 20 5b 54 48 45 4e 5d 0a 20 20 20 20 74 72 79 [THEN]. try
9eb0: 2d 72 65 61 64 23 20 74 72 79 2d 72 65 61 64 73 -read# try-reads
9ec0: 20 21 20 20 30 20 30 20 3b 0a 0a 3a 20 72 65 61 ! 0 0 ;..: rea
9ed0: 64 2d 65 76 65 6e 74 20 28 20 2d 2d 20 29 0a 20 d-event ( -- ).
9ee0: 20 20 20 70 6f 6c 6c 66 64 73 20 72 65 76 65 6e pollfds reven
9ef0: 74 73 20 77 40 20 50 4f 4c 4c 49 4e 20 61 6e 64 ts w@ POLLIN and
9f00: 20 49 46 0a 09 3f 65 76 65 6e 74 73 20 20 5c 20 IF..?events \
9f10: 30 20 70 6f 6c 6c 66 64 73 20 72 65 76 65 6e 74 0 pollfds revent
9f20: 73 20 77 21 0a 20 20 20 20 54 48 45 4e 20 3b 0a s w!. THEN ;.
9f30: 0a 3a 20 74 72 79 2d 72 65 61 64 2d 70 61 63 6b .: try-read-pack
9f40: 65 74 2d 77 61 69 74 20 28 20 2d 2d 20 61 64 64 et-wait ( -- add
9f50: 72 20 75 20 2f 20 30 20 30 20 29 0a 20 20 20 20 r u / 0 0 ).
9f60: 5b 64 65 66 69 6e 65 64 5d 20 6e 6f 2d 68 79 62 [defined] no-hyb
9f70: 72 69 64 20 28 20 5b 64 65 66 69 6e 65 64 5d 20 rid ( [defined]
9f80: 64 61 72 77 69 6e 20 29 20 5b 20 28 20 6f 72 20 darwin ) [ ( or
9f90: 29 20 30 3d 20 5d 20 5b 49 46 5d 0a 09 74 72 79 ) 0= ] [IF]..try
9fa0: 2d 72 65 61 64 23 20 74 72 79 2d 72 65 61 64 73 -read# try-reads
9fb0: 20 40 20 3f 44 4f 0a 09 20 20 20 20 64 6f 6e 27 @ ?DO.. don'
9fc0: 74 2d 62 6c 6f 63 6b 20 72 65 61 64 2d 61 2d 70 t-block read-a-p
9fd0: 61 63 6b 65 74 0a 09 20 20 20 20 64 75 70 20 49 acket.. dup I
9fe0: 46 20 20 75 6e 6c 6f 6f 70 20 20 2b 72 65 63 20 F unloop +rec
9ff0: 20 45 58 49 54 20 20 54 48 45 4e 20 20 32 64 72 EXIT THEN 2dr
a000: 6f 70 0a 09 4c 4f 4f 50 0a 20 20 20 20 5b 54 48 op..LOOP. [TH
a010: 45 4e 5d 0a 20 20 20 20 70 6f 6c 6c 2d 73 6f 63 EN]. poll-soc
a020: 6b 20 49 46 20 72 65 61 64 2d 61 2d 70 61 63 6b k IF read-a-pack
a030: 65 74 34 2f 36 20 72 65 61 64 2d 65 76 65 6e 74 et4/6 read-event
a040: 20 45 4c 53 45 20 30 20 30 20 54 48 45 4e 20 3b ELSE 0 0 THEN ;
a050: 0a 0a 34 20 56 61 6c 75 65 20 73 65 6e 64 73 23 ..4 Value sends#
a060: 0a 34 20 56 61 6c 75 65 20 73 65 6e 64 62 73 23 .4 Value sendbs#
a070: 0a 31 36 20 56 61 6c 75 65 20 72 65 63 76 73 23 .16 Value recvs#
a080: 20 5c 20 62 61 6c 61 6e 63 65 20 72 65 63 65 69 \ balance recei
a090: 76 65 20 61 6e 64 20 73 65 6e 64 0a 56 61 72 69 ve and send.Vari
a0a0: 61 62 6c 65 20 72 65 63 76 66 6c 61 67 20 20 72 able recvflag r
a0b0: 65 63 76 66 6c 61 67 20 6f 66 66 0a 0a 5b 64 65 ecvflag off..[de
a0c0: 66 69 6e 65 64 5d 20 6e 6f 2d 68 79 62 72 69 64 fined] no-hybrid
a0d0: 20 28 20 5b 64 65 66 69 6e 65 64 5d 20 64 61 72 ( [defined] dar
a0e0: 77 69 6e 20 6f 72 20 29 20 5b 49 46 5d 0a 20 20 win or ) [IF].
a0f0: 20 20 27 20 74 72 79 2d 72 65 61 64 2d 70 61 63 ' try-read-pac
a100: 6b 65 74 2d 77 61 69 74 20 61 6c 69 61 73 20 72 ket-wait alias r
a110: 65 61 64 2d 61 2d 70 61 63 6b 65 74 3f 20 28 20 ead-a-packet? (
a120: 2d 2d 20 61 64 64 72 20 75 20 29 0a 5b 45 4c 53 -- addr u ).[ELS
a130: 45 5d 0a 20 20 20 20 3a 20 72 65 61 64 2d 61 2d E]. : read-a-
a140: 70 61 63 6b 65 74 3f 20 28 20 2d 2d 20 61 64 64 packet? ( -- add
a150: 72 20 75 20 29 0a 09 64 6f 6e 27 74 2d 62 6c 6f r u )..don't-blo
a160: 63 6b 20 72 65 61 64 2d 61 2d 70 61 63 6b 65 74 ck read-a-packet
a170: 20 64 75 70 20 49 46 20 20 31 20 72 65 63 76 66 dup IF 1 recvf
a180: 6c 61 67 20 2b 21 20 20 54 48 45 4e 20 3b 0a 5b lag +! THEN ;.[
a190: 54 48 45 4e 5d 0a 0a 3a 20 73 65 6e 64 2d 72 65 THEN]..: send-re
a1a0: 61 64 2d 70 61 63 6b 65 74 20 28 20 2d 2d 20 61 ad-packet ( -- a
a1b0: 64 64 72 20 75 20 29 0a 20 20 20 20 72 65 63 76 ddr u ). recv
a1c0: 73 23 20 72 65 63 76 66 6c 61 67 20 40 20 3e 20 s# recvflag @ >
a1d0: 49 46 20 20 72 65 61 64 2d 61 2d 70 61 63 6b 65 IF read-a-packe
a1e0: 74 3f 20 64 75 70 20 3f 45 58 49 54 20 20 32 64 t? dup ?EXIT 2d
a1f0: 72 6f 70 20 20 54 48 45 4e 0a 20 20 20 20 72 65 rop THEN. re
a200: 63 76 66 6c 61 67 20 6f 66 66 0a 20 20 20 20 23 cvflag off. #
a210: 30 2e 20 73 65 6e 64 62 73 23 20 30 20 44 4f 0a 0. sendbs# 0 DO.
a220: 09 32 64 72 6f 70 20 20 73 65 6e 64 2d 61 6e 79 .2drop send-any
a230: 74 68 69 6e 67 3f 0a 09 73 65 6e 64 73 23 20 30 thing?..sends# 0
a240: 20 3f 44 4f 0a 09 20 20 20 20 30 3d 20 49 46 20 ?DO.. 0= IF
a250: 20 74 72 79 2d 72 65 61 64 2d 70 61 63 6b 65 74 try-read-packet
a260: 2d 77 61 69 74 0a 09 09 64 75 70 20 49 46 20 20 -wait...dup IF
a270: 55 4e 4c 4f 4f 50 20 20 55 4e 4c 4f 4f 50 20 20 UNLOOP UNLOOP
a280: 45 58 49 54 20 20 54 48 45 4e 20 20 32 64 72 6f EXIT THEN 2dro
a290: 70 20 20 54 48 45 4e 0a 09 20 20 20 20 73 65 6e p THEN.. sen
a2a0: 64 2d 61 6e 6f 74 68 65 72 2d 63 68 75 6e 6b 20 d-another-chunk
a2b0: 20 4c 4f 4f 50 20 20 64 72 6f 70 0a 20 20 20 20 LOOP drop.
a2c0: 72 65 61 64 2d 61 2d 70 61 63 6b 65 74 3f 20 64 read-a-packet? d
a2d0: 75 70 20 3f 4c 45 41 56 45 20 4c 4f 4f 50 20 3b up ?LEAVE LOOP ;
a2e0: 0a 0a 3a 20 73 65 6e 64 2d 6c 6f 6f 70 20 28 20 ..: send-loop (
a2f0: 2d 2d 20 29 0a 20 20 20 20 73 65 6e 64 2d 61 6e -- ). send-an
a300: 79 74 68 69 6e 67 3f 0a 20 20 20 20 42 45 47 49 ything?. BEGI
a310: 4e 20 20 30 3d 20 49 46 20 20 20 77 61 69 74 2d N 0= IF wait-
a320: 73 65 6e 64 20 64 72 6f 70 20 72 65 61 64 2d 65 send drop read-e
a330: 76 65 6e 74 20 20 54 48 45 4e 0a 09 21 21 30 64 vent THEN..!!0d
a340: 65 70 74 68 21 21 20 73 65 6e 64 2d 61 6e 6f 74 epth!! send-anot
a350: 68 65 72 2d 63 68 75 6e 6b 20 20 41 47 41 49 4e her-chunk AGAIN
a360: 20 3b 0a 0a 3a 20 63 72 65 61 74 65 2d 73 65 6e ;..: create-sen
a370: 64 65 72 2d 74 61 73 6b 20 28 20 2d 2d 20 29 0a der-task ( -- ).
a380: 20 20 20 20 5b 3a 20 20 5c 20 2e 22 20 63 72 65 [: \ ." cre
a390: 61 74 65 64 20 73 65 6e 64 65 72 20 74 61 73 6b ated sender task
a3a0: 20 22 20 75 70 40 20 68 65 78 2e 20 63 72 0a 09 " up@ hex. cr..
a3b0: 70 72 65 70 2d 65 76 73 6f 63 6b 73 20 73 65 6e prep-evsocks sen
a3c0: 64 2d 6c 6f 6f 70 20 3b 5d 20 31 20 6e 65 74 32 d-loop ;] 1 net2
a3d0: 6f 2d 74 61 73 6b 20 74 6f 20 73 65 6e 64 65 72 o-task to sender
a3e0: 2d 74 61 73 6b 20 3b 0a 0a 46 6f 72 77 61 72 64 -task ;..Forward
a3f0: 20 68 61 6e 64 6c 65 2d 62 65 61 63 6f 6e 0a 46 handle-beacon.F
a400: 6f 72 77 61 72 64 20 68 61 6e 64 6c 65 2d 62 65 orward handle-be
a410: 61 63 6f 6e 2b 68 61 73 68 0a 0a 3a 20 61 64 64 acon+hash..: add
a420: 2d 73 6f 75 72 63 65 20 28 20 2d 2d 20 29 0a 20 -source ( -- ).
a430: 20 20 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 sockaddr< ale
a440: 6e 20 40 20 69 6e 73 65 72 74 2d 61 64 64 72 65 n @ insert-addre
a450: 73 73 20 69 6e 62 75 66 20 69 6e 73 2d 73 6f 75 ss inbuf ins-sou
a460: 72 63 65 20 3b 0a 0a 3a 20 6e 65 78 74 2d 70 61 rce ;..: next-pa
a470: 63 6b 65 74 20 28 20 2d 2d 20 61 64 64 72 20 75 cket ( -- addr u
a480: 20 29 0a 20 20 20 20 73 65 6e 64 65 72 2d 74 61 ). sender-ta
a490: 73 6b 20 30 3d 20 49 46 20 20 73 65 6e 64 2d 72 sk 0= IF send-r
a4a0: 65 61 64 2d 70 61 63 6b 65 74 20 20 45 4c 53 45 ead-packet ELSE
a4b0: 20 20 74 72 79 2d 72 65 61 64 2d 70 61 63 6b 65 try-read-packe
a4c0: 74 2d 77 61 69 74 20 20 54 48 45 4e 0a 20 20 20 t-wait THEN.
a4d0: 20 64 75 70 20 6d 69 6e 70 61 63 6b 65 74 23 20 dup minpacket#
a4e0: 75 3e 3d 20 49 46 0a 09 28 20 6e 61 74 28 20 2e u>= IF..( nat( .
a4f0: 22 20 70 61 63 6b 65 74 20 66 72 6f 6d 3a 20 22 " packet from: "
a500: 20 73 6f 63 6b 61 64 64 72 3c 20 61 6c 65 6e 20 sockaddr< alen
a510: 40 20 2e 61 64 64 72 65 73 73 20 63 72 20 29 0a @ .address cr ).
a520: 09 6f 76 65 72 20 70 61 63 6b 65 74 2d 73 69 7a .over packet-siz
a530: 65 20 74 75 63 6b 20 75 3c 0a 09 68 65 61 64 65 e tuck u<..heade
a540: 72 28 20 7e 7e 20 21 21 73 69 7a 65 21 21 20 29 r( ~~ !!size!! )
a550: 65 6c 73 65 28 20 49 46 20 20 32 64 72 6f 70 20 else( IF 2drop
a560: 30 20 30 20 45 58 49 54 20 20 54 48 45 4e 20 29 0 0 EXIT THEN )
a570: 0a 09 2b 6e 65 78 74 0a 09 45 58 49 54 0a 20 20 ..+next..EXIT.
a580: 20 20 45 4c 53 45 0a 09 68 61 6e 64 6c 65 2d 62 ELSE..handle-b
a590: 65 61 63 6f 6e 2b 68 61 73 68 20 20 20 30 20 30 eacon+hash 0 0
a5a0: 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a 30 20 56 . THEN ;..0 V
a5b0: 61 6c 75 65 20 64 75 6d 70 2d 66 64 0a 0a 5c 20 alue dump-fd..\
a5c0: 69 6e 20 6e 65 74 32 6f 20 3a 20 74 69 6d 65 6f in net2o : timeo
a5d0: 75 74 20 28 20 74 69 63 6b 73 20 2d 2d 20 29 20 ut ( ticks -- )
a5e0: 5c 20 70 72 69 6e 74 20 77 68 79 20 74 68 65 72 \ print why ther
a5f0: 65 20 69 73 20 6e 6f 74 68 69 6e 67 20 74 6f 20 e is nothing to
a600: 73 65 6e 64 0a 5c 20 20 20 20 20 61 63 6b 40 20 send.\ ack@
a610: 2e 3e 66 6c 79 62 75 72 73 74 20 6e 65 74 32 6f .>flyburst net2o
a620: 3a 73 65 6e 64 2d 63 68 75 6e 6b 73 0a 5c 20 20 :send-chunks.\
a630: 20 20 20 74 69 6d 65 6f 75 74 28 20 2e 22 20 74 timeout( ." t
a640: 69 6d 65 6f 75 74 3f 20 22 20 2e 74 69 63 6b 73 imeout? " .ticks
a650: 20 73 70 61 63 65 0a 5c 20 20 20 20 20 72 65 73 space.\ res
a660: 65 6e 64 3f 20 2e 20 64 61 74 61 2d 74 61 69 6c end? . data-tail
a670: 3f 20 2e 20 64 61 74 61 2d 68 65 61 64 3f 20 2e ? . data-head? .
a680: 20 66 73 74 61 74 65 73 20 2e 0a 5c 20 20 20 20 fstates ..\
a690: 20 63 68 75 6e 6b 73 2b 20 3f 20 61 63 6b 40 20 chunks+ ? ack@
a6a0: 2e 62 61 6e 64 77 69 64 74 68 3f 20 2e 20 6e 65 .bandwidth? . ne
a6b0: 78 74 2d 63 68 75 6e 6b 2d 74 69 63 6b 20 2e 74 xt-chunk-tick .t
a6c0: 69 63 6b 73 20 63 72 0a 5c 20 20 20 20 20 64 61 icks cr.\ da
a6d0: 74 61 2d 72 6d 61 70 20 40 20 77 69 74 68 20 6d ta-rmap @ with m
a6e0: 61 70 63 20 64 61 74 61 2d 61 63 6b 62 69 74 73 apc data-ackbits
a6f0: 20 40 20 64 65 73 74 2d 73 69 7a 65 20 61 64 64 @ dest-size add
a700: 72 3e 62 79 74 65 73 20 64 75 6d 70 20 65 6e 64 r>bytes dump end
a710: 77 69 74 68 0a 5c 20 20 20 20 20 29 65 6c 73 65 with.\ )else
a720: 28 20 36 34 64 72 6f 70 20 29 20 3b 0a 0a 5c 20 ( 64drop ) ;..\
a730: 74 69 6d 65 6f 75 74 20 68 61 6e 64 6c 69 6e 67 timeout handling
a740: 0a 0a 23 31 30 2e 30 30 30 2e 30 30 30 2e 30 30 ..#10.000.000.00
a750: 30 20 64 3e 36 34 20 36 34 56 61 6c 75 65 20 74 0 d>64 64Value t
a760: 69 6d 65 6f 75 74 2d 6d 61 78 23 20 5c 20 31 30 imeout-max# \ 10
a770: 73 20 6d 61 78 69 6d 75 6d 20 74 69 6d 65 6f 75 s maximum timeou
a780: 74 0a 23 31 30 30 2e 30 30 30 2e 30 30 30 20 64 t.#100.000.000 d
a790: 3e 36 34 20 36 34 56 61 6c 75 65 20 74 69 6d 65 >64 64Value time
a7a0: 6f 75 74 2d 6d 69 6e 23 20 5c 20 31 30 30 6d 73 out-min# \ 100ms
a7b0: 20 6d 69 6e 69 6d 75 6d 20 74 69 6d 65 6f 75 74 minimum timeout
a7c0: 0a 0a 53 65 6d 61 20 74 69 6d 65 6f 75 74 2d 73 ..Sema timeout-s
a7d0: 65 6d 61 0a 56 61 72 69 61 62 6c 65 20 74 69 6d ema.Variable tim
a7e0: 65 6f 75 74 2d 74 61 73 6b 73 0a 0a 3a 20 73 71 eout-tasks..: sq
a7f0: 32 2a 2a 20 28 20 36 34 6e 20 6e 20 2d 2d 20 36 2** ( 64n n -- 6
a800: 34 6e 27 20 29 0a 20 20 20 20 64 75 70 20 31 20 4n' ). dup 1
a810: 61 6e 64 20 3e 72 20 32 2f 20 36 34 6c 73 68 69 and >r 2/ 64lshi
a820: 66 74 20 72 3e 20 49 46 20 20 36 34 64 75 70 20 ft r> IF 64dup
a830: 36 34 2d 32 2f 20 36 34 2b 20 20 54 48 45 4e 20 64-2/ 64+ THEN
a840: 3b 0a 3a 20 3e 74 69 6d 65 6f 75 74 20 28 20 36 ;.: >timeout ( 6
a850: 34 6e 20 6e 20 2d 2d 20 36 34 6e 20 29 0a 20 20 4n n -- 64n ).
a860: 20 20 3e 72 20 36 34 2d 32 2a 20 74 69 6d 65 6f >r 64-2* timeo
a870: 75 74 2d 6d 69 6e 23 20 36 34 6d 61 78 20 72 3e ut-min# 64max r>
a880: 20 73 71 32 2a 2a 20 74 69 6d 65 6f 75 74 2d 6d sq2** timeout-m
a890: 61 78 23 20 36 34 6d 69 6e 20 3b 0a 3a 20 2b 6e ax# 64min ;.: +n
a8a0: 65 78 74 2d 74 69 6d 65 6f 75 74 73 20 28 20 2d ext-timeouts ( -
a8b0: 2d 20 74 69 6d 65 6f 75 74 20 29 0a 20 20 20 20 - timeout ).
a8c0: 72 74 64 65 6c 61 79 20 36 34 40 20 74 69 6d 65 rtdelay 64@ time
a8d0: 6f 75 74 73 20 40 20 3e 74 69 6d 65 6f 75 74 20 outs @ >timeout
a8e0: 74 69 63 6b 73 20 36 34 2b 20 3b 0a 3a 20 2b 74 ticks 64+ ;.: +t
a8f0: 69 6d 65 6f 75 74 73 20 28 20 2d 2d 20 74 69 6d imeouts ( -- tim
a900: 65 6f 75 74 20 29 20 0a 20 20 20 20 2b 6e 65 78 eout ) . +nex
a910: 74 2d 74 69 6d 65 6f 75 74 73 20 31 20 74 69 6d t-timeouts 1 tim
a920: 65 6f 75 74 73 20 2b 21 20 28 20 40 20 2e 22 20 eouts +! ( @ ."
a930: 54 4f 20 69 6e 63 3a 20 22 20 2e 20 63 72 20 29 TO inc: " . cr )
a940: 20 3b 0a 3a 20 2b 74 69 6d 65 6f 75 74 30 20 28 ;.: +timeout0 (
a950: 20 2d 2d 20 74 69 6d 65 6f 75 74 20 29 0a 20 20 -- timeout ).
a960: 20 20 72 74 64 65 6c 61 79 20 36 34 40 20 74 69 rtdelay 64@ ti
a970: 63 6b 65 72 20 36 34 40 20 36 34 2b 20 3b 0a 3a cker 64@ 64+ ;.:
a980: 20 30 74 69 6d 65 6f 75 74 20 28 20 2d 2d 20 29 0timeout ( -- )
a990: 0a 20 20 20 20 30 20 61 63 6b 40 20 2e 74 69 6d . 0 ack@ .tim
a9a0: 65 6f 75 74 73 20 21 40 20 20 49 46 20 20 74 69 eouts !@ IF ti
a9b0: 6d 65 6f 75 74 2d 74 61 73 6b 20 77 61 6b 65 20 meout-task wake
a9c0: 20 54 48 45 4e 0a 20 20 20 20 61 63 6b 40 20 2e THEN. ack@ .
a9d0: 2b 6e 65 78 74 2d 74 69 6d 65 6f 75 74 73 20 6e +next-timeouts n
a9e0: 65 78 74 2d 74 69 6d 65 6f 75 74 20 36 34 21 20 ext-timeout 64!
a9f0: 3b 0a 0a 3a 20 6f 2b 74 69 6d 65 6f 75 74 20 28 ;..: o+timeout (
aa00: 20 2d 2d 20 29 20 20 30 74 69 6d 65 6f 75 74 0a -- ) 0timeout.
aa10: 20 20 20 20 74 69 6d 65 6f 75 74 28 20 2e 22 20 timeout( ."
aa20: 2b 74 69 6d 65 6f 75 74 3a 20 22 20 6f 20 68 65 +timeout: " o he
aa30: 78 2e 20 2e 22 20 74 61 73 6b 3a 20 22 20 74 61 x. ." task: " ta
aa40: 73 6b 23 20 3f 20 61 64 64 72 20 74 69 6d 65 6f sk# ? addr timeo
aa50: 75 74 2d 78 74 20 40 20 2e 6e 61 6d 65 20 63 72 ut-xt @ .name cr
aa60: 20 29 0a 20 20 20 20 5b 3a 20 74 69 6d 65 6f 75 ). [: timeou
aa70: 74 2d 74 61 73 6b 73 20 24 40 20 62 6f 75 6e 64 t-tasks $@ bound
aa80: 73 20 3f 44 4f 20 20 49 20 40 20 6f 20 3d 20 49 s ?DO I @ o = I
aa90: 46 0a 09 20 20 20 20 20 20 55 4e 4c 4f 4f 50 20 F.. UNLOOP
aaa0: 20 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 EXIT THEN.
aab0: 20 20 63 65 6c 6c 20 2b 4c 4f 4f 50 0a 20 20 20 cell +LOOP.
aac0: 20 20 20 6f 20 7b 20 77 5e 20 74 69 6d 65 6f 75 o { w^ timeou
aad0: 74 2d 6f 20 7d 20 20 74 69 6d 65 6f 75 74 2d 6f t-o } timeout-o
aae0: 20 63 65 6c 6c 20 74 69 6d 65 6f 75 74 2d 74 61 cell timeout-ta
aaf0: 73 6b 73 20 24 2b 21 20 3b 5d 0a 20 20 20 20 74 sks $+! ;]. t
ab00: 69 6d 65 6f 75 74 2d 73 65 6d 61 20 63 2d 73 65 imeout-sema c-se
ab10: 63 74 69 6f 6e 20 20 74 69 6d 65 6f 75 74 2d 74 ction timeout-t
ab20: 61 73 6b 20 77 61 6b 65 20 3b 0a 3a 20 6f 2d 74 ask wake ;.: o-t
ab30: 69 6d 65 6f 75 74 20 28 20 2d 2d 20 29 0a 20 20 imeout ( -- ).
ab40: 20 20 30 74 69 6d 65 6f 75 74 20 20 74 69 6d 65 0timeout time
ab50: 6f 75 74 28 20 2e 22 20 2d 74 69 6d 65 6f 75 74 out( ." -timeout
ab60: 3a 20 22 20 6f 20 68 65 78 2e 20 2e 22 20 74 61 : " o hex. ." ta
ab70: 73 6b 3a 20 22 20 74 61 73 6b 23 20 3f 20 63 72 sk: " task# ? cr
ab80: 20 29 0a 20 20 20 20 5b 3a 20 6f 20 74 69 6d 65 ). [: o time
ab90: 6f 75 74 2d 74 61 73 6b 73 20 64 65 6c 24 63 65 out-tasks del$ce
aba0: 6c 6c 20 3b 5d 20 74 69 6d 65 6f 75 74 2d 73 65 ll ;] timeout-se
abb0: 6d 61 20 63 2d 73 65 63 74 69 6f 6e 20 3b 0a 0a ma c-section ;..
abc0: 3a 20 3e 6e 65 78 74 2d 74 69 6d 65 6f 75 74 20 : >next-timeout
abd0: 28 20 2d 2d 20 29 20 20 61 63 6b 40 20 2e 2b 74 ( -- ) ack@ .+t
abe0: 69 6d 65 6f 75 74 73 20 6e 65 78 74 2d 74 69 6d imeouts next-tim
abf0: 65 6f 75 74 20 36 34 21 20 3b 0a 3a 20 36 34 6d eout 64! ;.: 64m
ac00: 69 6e 3f 20 28 20 61 20 62 20 2d 2d 20 6d 69 6e in? ( a b -- min
ac10: 20 66 6c 61 67 20 29 0a 20 20 20 20 36 34 6f 76 flag ). 64ov
ac20: 65 72 20 36 34 6f 76 65 72 20 36 34 3c 20 49 46 er 64over 64< IF
ac30: 20 20 36 34 64 72 6f 70 20 66 61 6c 73 65 20 20 64drop false
ac40: 45 4c 53 45 20 20 36 34 6e 69 70 20 74 72 75 65 ELSE 64nip true
ac50: 20 20 54 48 45 4e 20 3b 0a 3a 20 6e 65 78 74 2d THEN ;.: next-
ac60: 74 69 6d 65 6f 75 74 3f 20 28 20 2d 2d 20 74 69 timeout? ( -- ti
ac70: 6d 65 20 63 6f 6e 74 65 78 74 20 29 20 5b 3a 20 me context ) [:
ac80: 30 20 7b 20 63 74 78 20 7d 20 6d 61 78 2d 69 6e 0 { ctx } max-in
ac90: 74 36 34 0a 20 20 20 20 74 69 6d 65 6f 75 74 2d t64. timeout-
aca0: 74 61 73 6b 73 20 24 40 20 62 6f 75 6e 64 73 20 tasks $@ bounds
acb0: 3f 44 4f 0a 09 49 20 40 20 2e 6e 65 78 74 2d 74 ?DO..I @ .next-t
acc0: 69 6d 65 6f 75 74 20 36 34 40 20 36 34 6d 69 6e imeout 64@ 64min
acd0: 3f 20 49 46 20 20 49 20 40 20 74 6f 20 63 74 78 ? IF I @ to ctx
ace0: 20 20 54 48 45 4e 0a 20 20 20 20 63 65 6c 6c 20 THEN. cell
acf0: 2b 4c 4f 4f 50 20 20 63 74 78 20 3b 5d 20 74 69 +LOOP ctx ;] ti
ad00: 6d 65 6f 75 74 2d 73 65 6d 61 20 63 2d 73 65 63 meout-sema c-sec
ad10: 74 69 6f 6e 20 3b 0a 3a 20 3f 74 69 6d 65 6f 75 tion ;.: ?timeou
ad20: 74 20 28 20 2d 2d 20 63 6f 6e 74 65 78 74 2f 30 t ( -- context/0
ad30: 20 29 0a 20 20 20 20 74 69 63 6b 65 72 20 36 34 ). ticker 64
ad40: 40 20 6e 65 78 74 2d 74 69 6d 65 6f 75 74 3f 20 @ next-timeout?
ad50: 3e 72 20 36 34 2d 20 36 34 2d 30 3e 3d 20 72 3e >r 64- 64-0>= r>
ad60: 20 61 6e 64 20 3b 0a 0a 3a 20 2d 74 69 6d 65 6f and ;..: -timeo
ad70: 75 74 20 20 20 20 20 20 5b 27 5d 20 6e 6f 2d 74 ut ['] no-t
ad80: 69 6d 65 6f 75 74 20 20 69 73 20 74 69 6d 65 6f imeout is timeo
ad90: 75 74 2d 78 74 20 6f 2d 74 69 6d 65 6f 75 74 20 ut-xt o-timeout
ada0: 3b 0a 0a 5c 20 68 61 6e 64 6c 69 6e 67 20 6c 61 ;..\ handling la
adb0: 73 74 20 70 61 63 6b 65 74 73 0a 0a 62 65 67 69 st packets..begi
adc0: 6e 2d 73 74 72 75 63 74 75 72 65 20 6c 61 73 74 n-structure last
add0: 2d 70 61 63 6b 65 74 0a 20 20 20 20 36 34 76 61 -packet. 64va
ade0: 6c 75 65 3a 20 6c 70 2d 61 64 64 72 0a 20 20 20 lue: lp-addr.
adf0: 20 36 34 76 61 6c 75 65 3a 20 6c 70 2d 74 69 6d 64value: lp-tim
ae00: 65 0a 20 20 20 20 24 76 61 6c 75 65 3a 20 6c 70 e. $value: lp
ae10: 24 0a 65 6e 64 2d 73 74 72 75 63 74 75 72 65 0a $.end-structure.
ae20: 0a 6c 61 73 74 2d 70 61 63 6b 65 74 20 62 75 66 .last-packet buf
ae30: 66 65 72 3a 20 6c 61 73 74 2d 70 61 63 6b 65 74 fer: last-packet
ae40: 2d 64 65 73 63 0a 0a 56 61 72 69 61 62 6c 65 20 -desc..Variable
ae50: 6c 61 73 74 2d 70 61 63 6b 65 74 73 0a 0a 53 65 last-packets..Se
ae60: 6d 61 20 6c 70 2d 73 65 6d 61 0a 0a 3a 20 6c 61 ma lp-sema..: la
ae70: 73 74 2d 70 61 63 6b 65 74 21 20 28 20 2d 2d 20 st-packet! ( --
ae80: 29 0a 20 20 20 20 75 6e 68 61 6e 64 6c 65 64 28 ). unhandled(
ae90: 20 2e 22 20 6c 61 73 74 20 70 61 63 6b 65 74 20 ." last packet
aea0: 40 22 20 64 65 73 74 2d 61 64 64 72 20 36 34 40 @" dest-addr 64@
aeb0: 20 78 36 34 2e 20 63 72 20 29 0a 20 20 20 20 6f x64. cr ). o
aec0: 75 74 62 75 66 20 64 75 70 20 70 61 63 6b 65 74 utbuf dup packet
aed0: 2d 73 69 7a 65 20 6c 61 73 74 2d 70 61 63 6b 65 -size last-packe
aee0: 74 2d 64 65 73 63 20 74 6f 20 6c 70 24 0a 20 20 t-desc to lp$.
aef0: 20 20 64 65 73 74 2d 61 64 64 72 20 36 34 40 20 dest-addr 64@
af00: 6c 61 73 74 2d 70 61 63 6b 65 74 2d 64 65 73 63 last-packet-desc
af10: 20 74 6f 20 6c 70 2d 61 64 64 72 0a 20 20 20 20 to lp-addr.
af20: 74 69 63 6b 73 20 6c 61 73 74 2d 70 61 63 6b 65 ticks last-packe
af30: 74 2d 64 65 73 63 20 74 6f 20 6c 70 2d 74 69 6d t-desc to lp-tim
af40: 65 0a 20 20 20 20 5b 3a 20 6c 61 73 74 2d 70 61 e. [: last-pa
af50: 63 6b 65 74 2d 64 65 73 63 20 6c 61 73 74 2d 70 cket-desc last-p
af60: 61 63 6b 65 74 20 6c 61 73 74 2d 70 61 63 6b 65 acket last-packe
af70: 74 73 20 24 2b 21 20 3b 5d 0a 20 20 20 20 6c 70 ts $+! ;]. lp
af80: 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 6f 6e 0a -sema c-section.
af90: 20 20 20 20 6c 61 73 74 2d 70 61 63 6b 65 74 2d last-packet-
afa0: 64 65 73 63 20 61 64 64 72 20 6c 70 24 20 6f 66 desc addr lp$ of
afb0: 66 20 3b 0a 0a 3a 20 6c 61 73 74 2d 70 61 63 6b f ;..: last-pack
afc0: 65 74 3f 20 28 20 61 64 64 72 20 2d 2d 20 66 6c et? ( addr -- fl
afd0: 61 67 20 29 0a 20 20 20 20 5b 3a 20 6c 61 73 74 ag ). [: last
afe0: 2d 70 61 63 6b 65 74 73 20 24 40 20 62 6f 75 6e -packets $@ boun
aff0: 64 73 20 55 2b 44 4f 0a 09 20 20 36 34 64 75 70 ds U+DO.. 64dup
b000: 20 49 20 6c 70 2d 61 64 64 72 20 36 34 3d 20 49 I lp-addr 64= I
b010: 46 0a 09 20 20 20 20 20 20 75 6e 68 61 6e 64 6c F.. unhandl
b020: 65 64 28 20 2e 22 20 72 65 73 65 6e 64 20 6c 61 ed( ." resend la
b030: 73 74 20 70 61 63 6b 65 74 20 40 22 20 36 34 64 st packet @" 64d
b040: 75 70 20 78 36 34 2e 20 63 72 20 29 0a 09 20 20 up x64. cr )..
b050: 20 20 20 20 49 20 6c 70 24 20 6f 76 65 72 20 30 I lp$ over 0
b060: 20 73 77 61 70 20 70 61 63 6b 65 74 2d 72 6f 75 swap packet-rou
b070: 74 65 20 64 72 6f 70 20 73 65 6e 64 2d 61 2d 70 te drop send-a-p
b080: 61 63 6b 65 74 20 3f 6d 73 67 73 69 7a 65 0a 09 acket ?msgsize..
b090: 20 20 20 20 20 20 36 34 64 72 6f 70 20 74 72 75 64drop tru
b0a0: 65 20 75 6e 6c 6f 6f 70 20 20 45 58 49 54 0a 09 e unloop EXIT..
b0b0: 20 20 54 48 45 4e 0a 20 20 20 20 20 20 6c 61 73 THEN. las
b0c0: 74 2d 70 61 63 6b 65 74 20 2b 4c 4f 4f 50 20 20 t-packet +LOOP
b0d0: 36 34 64 72 6f 70 20 66 61 6c 73 65 20 3b 5d 20 64drop false ;]
b0e0: 6c 70 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 6f lp-sema c-sectio
b0f0: 6e 20 3b 0a 0a 3a 20 6c 61 73 74 2d 70 61 63 6b n ;..: last-pack
b100: 65 74 2d 74 6f 73 20 28 20 2d 2d 20 29 0a 20 20 et-tos ( -- ).
b110: 20 20 74 69 63 6b 73 20 63 6f 6e 6e 65 63 74 2d ticks connect-
b120: 74 69 6d 65 6f 75 74 23 20 36 34 2d 0a 20 20 20 timeout# 64-.
b130: 20 5b 3a 20 6c 61 73 74 2d 70 61 63 6b 65 74 73 [: last-packets
b140: 20 24 40 20 62 6f 75 6e 64 73 20 55 2b 44 4f 0a $@ bounds U+DO.
b150: 09 20 20 36 34 64 75 70 20 49 20 6c 70 2d 74 69 . 64dup I lp-ti
b160: 6d 65 20 36 34 75 3e 20 49 46 0a 09 20 20 20 20 me 64u> IF..
b170: 20 20 49 20 61 64 64 72 20 6c 70 24 20 24 66 72 I addr lp$ $fr
b180: 65 65 0a 09 20 20 45 4c 53 45 0a 09 20 20 20 20 ee.. ELSE..
b190: 20 20 6c 61 73 74 2d 70 61 63 6b 65 74 73 20 30 last-packets 0
b1a0: 20 49 20 6c 61 73 74 2d 70 61 63 6b 65 74 73 20 I last-packets
b1b0: 24 40 20 64 72 6f 70 20 2d 20 24 64 65 6c 0a 09 $@ drop - $del..
b1c0: 20 20 20 20 20 20 36 34 64 72 6f 70 20 75 6e 6c 64drop unl
b1d0: 6f 6f 70 20 20 45 58 49 54 0a 09 20 20 54 48 45 oop EXIT.. THE
b1e0: 4e 0a 20 20 20 20 20 20 6c 61 73 74 2d 70 61 63 N. last-pac
b1f0: 6b 65 74 20 2b 4c 4f 4f 50 20 20 36 34 64 72 6f ket +LOOP 64dro
b200: 70 20 20 73 22 20 22 20 6c 61 73 74 2d 70 61 63 p s" " last-pac
b210: 6b 65 74 73 20 24 21 20 3b 5d 0a 20 20 20 20 6c kets $! ;]. l
b220: 70 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 6f 6e p-sema c-section
b230: 20 3b 0a 0a 5c 20 68 61 6e 64 6c 69 6e 67 20 70 ;..\ handling p
b240: 61 63 6b 65 74 73 0a 0a 46 6f 72 77 61 72 64 20 ackets..Forward
b250: 63 6d 64 2d 65 78 65 63 20 28 20 61 64 64 72 20 cmd-exec ( addr
b260: 75 20 2d 2d 20 29 0a 0a 3a 20 21 21 3c 6f 72 64 u -- )..: !!<ord
b270: 65 72 3f 20 20 20 28 20 6e 20 2d 2d 20 29 20 20 er? ( n -- )
b280: 64 75 70 20 63 2d 73 74 61 74 65 20 40 20 75 3e dup c-state @ u>
b290: 20 20 21 21 69 6e 76 2d 6f 72 64 65 72 21 21 20 !!inv-order!!
b2a0: 63 2d 73 74 61 74 65 20 6f 72 21 20 3b 0a 3a 20 c-state or! ;.:
b2b0: 21 21 3e 6f 72 64 65 72 3f 20 20 20 28 20 6e 20 !!>order? ( n
b2c0: 2d 2d 20 29 20 20 64 75 70 20 63 2d 73 74 61 74 -- ) dup c-stat
b2d0: 65 20 40 20 75 3c 3d 20 21 21 69 6e 76 2d 6f 72 e @ u<= !!inv-or
b2e0: 64 65 72 21 21 20 63 2d 73 74 61 74 65 20 6f 72 der!! c-state or
b2f0: 21 20 3b 0a 3a 20 21 21 3e 3d 6f 72 64 65 72 3f ! ;.: !!>=order?
b300: 20 20 20 28 20 6e 20 2d 2d 20 29 20 20 64 75 70 ( n -- ) dup
b310: 20 63 2d 73 74 61 74 65 20 40 20 6f 76 65 72 20 c-state @ over
b320: 31 2d 20 69 6e 76 65 72 74 20 61 6e 64 20 75 3c 1- invert and u<
b330: 20 21 21 69 6e 76 2d 6f 72 64 65 72 21 21 20 63 !!inv-order!! c
b340: 2d 73 74 61 74 65 20 6f 72 21 20 3b 0a 3a 20 21 -state or! ;.: !
b350: 21 3c 3e 6f 72 64 65 72 3f 20 20 20 28 20 6e 31 !<>order? ( n1
b360: 20 6e 32 20 2d 2d 20 29 20 20 64 75 70 20 3e 72 n2 -- ) dup >r
b370: 0a 20 20 20 20 63 2d 73 74 61 74 65 20 40 20 2d . c-state @ -
b380: 72 6f 74 20 73 77 61 70 20 77 69 74 68 69 6e 20 rot swap within
b390: 21 21 69 6e 76 2d 6f 72 64 65 72 21 21 20 72 3e !!inv-order!! r>
b3a0: 20 63 2d 73 74 61 74 65 20 6f 72 21 20 3b 0a 3a c-state or! ;.:
b3b0: 20 21 21 3c 3e 3d 6f 72 64 65 72 3f 20 20 20 28 !!<>=order? (
b3c0: 20 6e 31 20 6e 32 20 2d 2d 20 29 20 20 64 75 70 n1 n2 -- ) dup
b3d0: 20 3e 72 20 31 2b 0a 20 20 20 20 63 2d 73 74 61 >r 1+. c-sta
b3e0: 74 65 20 40 20 2d 72 6f 74 20 73 77 61 70 20 77 te @ -rot swap w
b3f0: 69 74 68 69 6e 20 21 21 69 6e 76 2d 6f 72 64 65 ithin !!inv-orde
b400: 72 21 21 20 72 3e 20 63 2d 73 74 61 74 65 20 6f r!! r> c-state o
b410: 72 21 20 3b 0a 0a 55 73 65 72 20 72 65 6d 6f 74 r! ;..User remot
b420: 65 3f 0a 0a 3a 20 68 61 6e 64 6c 65 2d 63 6d 64 e?..: handle-cmd
b430: 30 20 28 20 2d 2d 20 29 20 5c 20 68 61 6e 64 6c 0 ( -- ) \ handl
b440: 65 20 70 61 63 6b 65 74 20 74 6f 20 61 64 64 72 e packet to addr
b450: 65 73 73 20 30 0a 20 20 20 20 63 6d 64 30 28 20 ess 0. cmd0(
b460: 2e 74 69 6d 65 20 2e 22 20 68 61 6e 64 6c 65 20 .time ." handle
b470: 63 6d 64 30 20 22 20 73 6f 63 6b 61 64 64 72 3c cmd0 " sockaddr<
b480: 20 61 6c 65 6e 20 40 20 2e 61 64 64 72 65 73 73 alen @ .address
b490: 20 63 72 20 29 0a 20 20 20 20 30 20 3e 6f 20 72 cr ). 0 >o r
b4a0: 64 72 6f 70 20 72 65 6d 6f 74 65 3f 20 6f 6e 20 drop remote? on
b4b0: 5c 20 61 64 64 72 65 73 73 20 30 20 68 61 73 20 \ address 0 has
b4c0: 6e 6f 20 6a 6f 62 20 63 6f 6e 74 65 78 74 21 0a no job context!.
b4d0: 20 20 20 20 69 6e 62 75 66 30 2d 64 65 63 72 79 inbuf0-decry
b4e0: 70 74 20 30 3d 20 49 46 0a 09 69 6e 76 61 6c 69 pt 0= IF..invali
b4f0: 64 28 20 2e 22 20 69 6e 76 61 6c 69 64 20 70 61 d( ." invalid pa
b500: 63 6b 65 74 20 74 6f 20 30 22 20 63 72 20 29 20 cket to 0" cr )
b510: 45 58 49 54 20 20 54 48 45 4e 0a 20 20 20 20 61 EXIT THEN. a
b520: 64 64 2d 73 6f 75 72 63 65 20 20 3e 72 65 74 2d dd-source >ret-
b530: 61 64 64 72 0a 20 20 20 20 76 61 6c 69 64 61 74 addr. validat
b540: 65 64 20 6f 66 66 20 20 20 20 20 5c 20 77 65 20 ed off \ we
b550: 68 61 76 65 20 6e 6f 20 76 61 6c 69 64 61 74 65 have no validate
b560: 64 20 65 6e 63 72 79 70 74 69 6f 6e 2c 20 6f 6e d encryption, on
b570: 6c 79 20 61 6e 6f 6e 79 6d 6f 75 73 0a 20 20 20 ly anonymous.
b580: 20 64 6f 2d 6b 65 79 70 61 64 20 73 65 63 2d 66 do-keypad sec-f
b590: 72 65 65 20 5c 20 6e 6f 20 6b 65 79 20 65 78 63 ree \ no key exc
b5a0: 68 61 6e 67 65 20 6d 61 79 20 68 61 76 65 20 68 hange may have h
b5b0: 61 70 70 65 6e 65 64 0a 20 20 20 20 24 65 72 72 appened. $err
b5c0: 6f 72 2d 69 64 20 24 6f 66 66 20 20 20 20 5c 20 or-id $off \
b5d0: 6e 6f 20 65 72 72 6f 72 20 69 64 20 73 6f 20 66 no error id so f
b5e0: 61 72 0a 20 20 20 20 73 74 61 74 65 6c 65 73 73 ar. stateless
b5f0: 23 20 6f 75 74 66 6c 61 67 20 21 20 20 74 6d 70 # outflag ! tmp
b600: 2d 70 65 72 6d 20 6f 66 66 0a 20 20 20 20 69 6e -perm off. in
b610: 62 75 66 20 70 61 63 6b 65 74 2d 64 61 74 61 20 buf packet-data
b620: 63 6d 64 2d 65 78 65 63 0a 20 20 20 20 75 70 64 cmd-exec. upd
b630: 61 74 65 2d 63 64 6d 61 70 20 20 6e 65 74 32 6f ate-cdmap net2o
b640: 3a 75 70 64 61 74 65 2d 6b 65 79 20 20 72 65 6d :update-key rem
b650: 6f 74 65 3f 20 6f 66 66 20 3b 0a 0a 73 63 6f 70 ote? off ;..scop
b660: 65 7b 20 6d 61 70 63 0a 0a 3a 20 68 61 6e 64 6c e{ mapc..: handl
b670: 65 2d 64 61 74 61 20 28 20 61 64 64 72 20 2d 2d e-data ( addr --
b680: 20 29 20 70 61 72 65 6e 74 20 3e 6f 20 20 6f 20 ) parent >o o
b690: 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 20 20 to connection.
b6a0: 20 20 6d 73 67 28 20 2e 22 20 48 61 6e 64 6c 65 msg( ." Handle
b6b0: 20 64 61 74 61 20 22 20 69 6e 62 75 66 20 68 64 data " inbuf hd
b6c0: 72 66 6c 61 67 73 20 62 65 2d 75 77 40 20 68 65 rflags be-uw@ he
b6d0: 78 2e 20 2e 22 20 74 6f 20 61 64 64 72 3a 20 22 x. ." to addr: "
b6e0: 20 69 6e 62 75 66 20 6d 61 70 61 64 64 72 20 6c inbuf mapaddr l
b6f0: 65 2d 36 34 40 20 68 65 78 2e 20 63 72 20 29 0a e-64@ hex. cr ).
b700: 20 20 20 20 3e 72 20 69 6e 62 75 66 20 70 61 63 >r inbuf pac
b710: 6b 65 74 2d 64 61 74 61 20 72 3e 20 73 77 61 70 ket-data r> swap
b720: 20 6d 6f 76 65 0a 20 20 20 20 2b 69 6e 6d 6f 76 move. +inmov
b730: 65 20 61 63 6b 2d 78 74 20 2b 61 63 6b 20 30 74 e ack-xt +ack 0t
b740: 69 6d 65 6f 75 74 20 6f 3e 20 3b 0a 27 20 68 61 imeout o> ;.' ha
b750: 6e 64 6c 65 2d 64 61 74 61 20 72 64 61 74 61 2d ndle-data rdata-
b760: 63 6c 61 73 73 20 74 6f 20 68 61 6e 64 6c 65 0a class to handle.
b770: 27 20 64 72 6f 70 20 64 61 74 61 2d 63 6c 61 73 ' drop data-clas
b780: 73 20 74 6f 20 68 61 6e 64 6c 65 0a 0a 3a 20 68 s to handle..: h
b790: 61 6e 64 6c 65 2d 63 6d 64 20 28 20 61 64 64 72 andle-cmd ( addr
b7a0: 20 2d 2d 20 29 20 20 70 61 72 65 6e 74 20 3e 6f -- ) parent >o
b7b0: 0a 20 20 20 20 6d 73 67 28 20 2e 22 20 48 61 6e . msg( ." Han
b7c0: 64 6c 65 20 63 6f 6d 6d 61 6e 64 20 74 6f 20 61 dle command to a
b7d0: 64 64 72 3a 20 22 20 69 6e 62 75 66 20 6d 61 70 ddr: " inbuf map
b7e0: 61 64 64 72 20 6c 65 2d 36 34 40 20 78 36 34 2e addr le-64@ x64.
b7f0: 20 63 72 20 29 0a 20 20 20 20 6f 75 74 66 6c 61 cr ). outfla
b800: 67 20 6f 66 66 20 20 77 61 69 74 2d 74 61 73 6b g off wait-task
b810: 20 40 20 30 3d 20 72 65 6d 6f 74 65 3f 20 21 0a @ 0= remote? !.
b820: 20 20 20 20 24 65 72 72 6f 72 2d 69 64 20 24 6f $error-id $o
b830: 66 66 20 20 20 20 5c 20 6e 6f 20 65 72 72 6f 72 ff \ no error
b840: 20 69 64 20 73 6f 20 66 61 72 0a 20 20 20 20 6d id so far. m
b850: 61 78 64 61 74 61 20 6e 65 67 61 74 65 20 61 6e axdata negate an
b860: 64 20 3e 72 20 69 6e 62 75 66 20 70 61 63 6b 65 d >r inbuf packe
b870: 74 2d 64 61 74 61 20 72 40 20 73 77 61 70 20 64 t-data r@ swap d
b880: 75 70 20 3e 72 20 6d 6f 76 65 0a 20 20 20 20 72 up >r move. r
b890: 3e 20 72 3e 20 73 77 61 70 20 63 6d 64 2d 65 78 > r> swap cmd-ex
b8a0: 65 63 0a 20 20 20 20 6f 20 49 46 20 20 63 6c 6f ec. o IF clo
b8b0: 73 69 6e 67 3f 20 20 49 46 20 20 6c 61 73 74 2d sing? IF last-
b8c0: 70 61 63 6b 65 74 21 20 20 54 48 45 4e 20 20 6f packet! THEN o
b8d0: 3e 20 20 45 4c 53 45 20 20 72 64 72 6f 70 20 20 > ELSE rdrop
b8e0: 54 48 45 4e 0a 20 20 20 20 72 65 6d 6f 74 65 3f THEN. remote?
b8f0: 20 6f 66 66 20 3b 0a 27 20 68 61 6e 64 6c 65 2d off ;.' handle-
b900: 63 6d 64 20 72 63 6f 64 65 2d 63 6c 61 73 73 20 cmd rcode-class
b910: 74 6f 20 68 61 6e 64 6c 65 0a 27 20 64 72 6f 70 to handle.' drop
b920: 20 63 6f 64 65 2d 63 6c 61 73 73 20 74 6f 20 68 code-class to h
b930: 61 6e 64 6c 65 0a 0a 3a 20 2e 69 6e 76 2d 70 61 andle..: .inv-pa
b940: 63 6b 65 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 cket ( -- ).
b950: 2e 22 20 69 6e 76 61 6c 69 64 20 70 61 63 6b 65 ." invalid packe
b960: 74 20 74 6f 20 22 0a 20 20 20 20 64 65 73 74 2d t to ". dest-
b970: 61 64 64 72 20 36 34 40 20 6f 20 49 46 20 20 64 addr 64@ o IF d
b980: 65 73 74 2d 76 61 64 64 72 20 36 34 2d 20 20 54 est-vaddr 64- T
b990: 48 45 4e 20 20 78 36 34 2e 0a 20 20 20 20 2e 22 HEN x64.. ."
b9a0: 20 73 69 7a 65 20 22 20 6d 69 6e 2d 73 69 7a 65 size " min-size
b9b0: 20 69 6e 62 75 66 20 63 40 20 64 61 74 61 73 69 inbuf c@ datasi
b9c0: 7a 65 23 20 61 6e 64 20 6c 73 68 69 66 74 20 68 ze# and lshift h
b9d0: 65 78 2e 20 63 72 20 3b 0a 0a 7d 73 63 6f 70 65 ex. cr ;..}scope
b9e0: 0a 0a 3a 20 68 61 6e 64 6c 65 2d 64 65 73 74 20 ..: handle-dest
b9f0: 28 20 61 64 64 72 20 6d 61 70 20 2d 2d 20 29 20 ( addr map -- )
ba00: 5c 20 68 61 6e 64 6c 65 20 70 61 63 6b 65 74 20 \ handle packet
ba10: 74 6f 20 76 61 6c 69 64 20 64 65 73 74 69 6e 61 to valid destina
ba20: 74 69 6f 6e 73 0a 20 20 20 20 74 69 63 6b 65 72 tions. ticker
ba30: 20 36 34 40 20 20 61 63 6b 40 20 2e 72 65 63 76 64@ ack@ .recv
ba40: 2d 74 69 63 6b 20 36 34 21 20 5c 20 74 69 6d 65 -tick 64! \ time
ba50: 20 73 74 61 6d 70 20 6f 66 20 61 72 72 69 76 61 stamp of arriva
ba60: 6c 0a 20 20 20 20 64 75 70 20 3e 72 20 69 6e 62 l. dup >r inb
ba70: 75 66 2d 64 65 63 72 79 70 74 20 30 3d 20 49 46 uf-decrypt 0= IF
ba80: 0a 09 69 6e 76 61 6c 69 64 28 20 72 3e 20 2e 6d ..invalid( r> .m
ba90: 61 70 63 3a 2e 69 6e 76 2d 70 61 63 6b 65 74 20 apc:.inv-packet
baa0: 64 72 6f 70 20 29 65 6c 73 65 28 20 72 64 72 6f drop )else( rdro
bab0: 70 20 64 72 6f 70 20 29 20 45 58 49 54 0a 20 20 p drop ) EXIT.
bac0: 20 20 54 48 45 4e 0a 20 20 20 20 61 64 64 2d 73 THEN. add-s
bad0: 6f 75 72 63 65 20 20 3e 72 65 74 2d 61 64 64 72 ource >ret-addr
bae0: 0a 20 20 20 20 63 72 79 70 74 2d 76 61 6c 20 76 . crypt-val v
baf0: 61 6c 69 64 61 74 65 64 20 21 20 5c 20 6f 6b 2c alidated ! \ ok,
bb00: 20 77 65 20 68 61 76 65 20 61 20 76 61 6c 69 64 we have a valid
bb10: 61 74 65 64 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a ated connection.
bb20: 20 20 20 20 72 3e 20 77 69 74 68 20 6d 61 70 63 r> with mapc
bb30: 20 68 61 6e 64 6c 65 20 6f 20 49 46 20 20 65 6e handle o IF en
bb40: 64 77 69 74 68 20 20 45 4c 53 45 20 20 72 64 72 dwith ELSE rdr
bb50: 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 3a 20 68 61 op THEN ;..: ha
bb60: 6e 64 6c 65 2d 70 61 63 6b 65 74 20 28 20 2d 2d ndle-packet ( --
bb70: 20 29 20 5c 20 68 61 6e 64 6c 65 20 6c 6f 63 61 ) \ handle loca
bb80: 6c 20 70 61 63 6b 65 74 0a 20 20 20 20 3e 64 65 l packet. >de
bb90: 73 74 2d 61 64 64 72 20 2b 64 65 73 74 61 0a 20 st-addr +desta.
bba0: 20 20 20 64 65 73 74 2d 66 6c 61 67 73 20 31 2b dest-flags 1+
bbb0: 20 63 40 20 73 74 61 74 65 6c 65 73 73 23 20 61 c@ stateless# a
bbc0: 6e 64 20 20 49 46 0a 09 68 61 6e 64 6c 65 2d 63 nd IF..handle-c
bbd0: 6d 64 30 0a 20 20 20 20 45 4c 53 45 0a 09 69 6e md0. ELSE..in
bbe0: 62 75 66 20 62 6f 64 79 2d 73 69 7a 65 20 63 68 buf body-size ch
bbf0: 65 63 6b 2d 64 65 73 74 20 64 75 70 20 30 3d 20 eck-dest dup 0=
bc00: 49 46 0a 09 20 20 20 20 64 72 6f 70 20 20 64 65 IF.. drop de
bc10: 73 74 2d 61 64 64 72 20 36 34 40 20 6c 61 73 74 st-addr 64@ last
bc20: 2d 70 61 63 6b 65 74 3f 20 30 3d 20 49 46 0a 09 -packet? 0= IF..
bc30: 09 75 6e 68 61 6e 64 6c 65 64 28 20 2e 22 20 75 .unhandled( ." u
bc40: 6e 68 61 6e 64 6c 65 64 20 70 61 63 6b 65 74 20 nhandled packet
bc50: 74 6f 3a 20 22 20 64 65 73 74 2d 61 64 64 72 20 to: " dest-addr
bc60: 36 34 40 20 78 36 34 2e 20 63 72 20 29 0a 09 20 64@ x64. cr )..
bc70: 20 20 20 54 48 45 4e 20 20 45 58 49 54 20 20 54 THEN EXIT T
bc80: 48 45 4e 20 2b 64 65 73 74 0a 09 68 61 6e 64 6c HEN +dest..handl
bc90: 65 2d 64 65 73 74 0a 20 20 20 20 54 48 45 4e 20 e-dest. THEN
bca0: 3b 0a 0a 3a 20 72 6f 75 74 65 2d 70 61 63 6b 65 ;..: route-packe
bcb0: 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 61 64 64 t ( -- ). add
bcc0: 2d 73 6f 75 72 63 65 0a 20 20 20 20 69 6e 62 75 -source. inbu
bcd0: 66 20 3e 72 20 72 40 20 67 65 74 2d 64 65 73 74 f >r r@ get-dest
bce0: 20 72 6f 75 74 65 3e 61 64 64 72 65 73 73 20 49 route>address I
bcf0: 46 0a 09 72 6f 75 74 65 28 20 2e 22 20 72 6f 75 F..route( ." rou
bd00: 74 65 20 74 6f 3a 20 22 20 73 6f 63 6b 61 64 64 te to: " sockadd
bd10: 72 3e 20 61 6c 65 6e 20 40 20 2e 61 64 64 72 65 r> alen @ .addre
bd20: 73 73 20 73 70 61 63 65 0a 09 69 6e 62 75 66 20 ss space..inbuf
bd30: 64 65 73 74 69 6e 61 74 69 6f 6e 20 2e 61 64 64 destination .add
bd40: 72 2d 70 61 74 68 20 63 72 20 29 0a 09 72 40 20 r-path cr )..r@
bd50: 64 75 70 20 70 61 63 6b 65 74 2d 73 69 7a 65 20 dup packet-size
bd60: 73 65 6e 64 2d 61 2d 70 61 63 6b 65 74 20 30 3c send-a-packet 0<
bd70: 0a 09 49 46 20 20 2e 22 20 66 61 69 6c 65 64 20 ..IF ." failed
bd80: 74 6f 20 73 65 6e 64 20 66 72 6f 6d 3a 20 22 20 to send from: "
bd90: 73 6f 63 6b 61 64 64 72 3c 20 64 75 70 20 3e 61 sockaddr< dup >a
bda0: 6c 65 6e 20 2e 61 64 64 72 65 73 73 0a 09 20 20 len .address..
bdb0: 20 20 2e 22 20 20 74 6f 3a 20 22 20 73 6f 63 6b ." to: " sock
bdc0: 61 64 64 72 3e 20 61 6c 65 6e 20 40 20 2e 61 64 addr> alen @ .ad
bdd0: 64 72 65 73 73 20 63 72 20 74 72 75 65 20 3f 69 dress cr true ?i
bde0: 6f 72 20 20 54 48 45 4e 0a 20 20 20 20 54 48 45 or THEN. THE
bdf0: 4e 20 20 72 64 72 6f 70 20 3b 0a 0a 5c 20 64 69 N rdrop ;..\ di
be00: 73 70 6f 73 65 20 63 6f 6e 74 65 78 74 0a 0a 3a spose context..:
be10: 20 75 6e 6c 69 6e 6b 2d 63 74 78 20 28 20 6e 65 unlink-ctx ( ne
be20: 78 74 20 68 69 74 20 70 74 72 20 2d 2d 20 29 0a xt hit ptr -- ).
be30: 20 20 20 20 6e 65 78 74 2d 63 6f 6e 74 65 78 74 next-context
be40: 20 40 20 6f 20 63 6f 6e 74 65 78 74 73 0a 20 20 @ o contexts.
be50: 20 20 42 45 47 49 4e 20 20 32 64 75 70 20 40 20 BEGIN 2dup @
be60: 3c 3e 20 57 48 49 4c 45 20 20 40 20 64 75 70 20 <> WHILE @ dup
be70: 2e 6e 65 78 74 2d 63 6f 6e 74 65 78 74 20 73 77 .next-context sw
be80: 61 70 20 30 3d 20 55 4e 54 49 4c 0a 09 32 64 72 ap 0= UNTIL..2dr
be90: 6f 70 20 64 72 6f 70 20 45 58 49 54 20 20 54 48 op drop EXIT TH
bea0: 45 4e 20 20 6e 69 70 20 21 20 3b 0a 3a 20 75 6e EN nip ! ;.: un
beb0: 67 72 6f 75 70 2d 63 74 78 20 28 20 2d 2d 20 29 group-ctx ( -- )
bec0: 0a 20 20 20 20 6d 73 67 2d 67 72 6f 75 70 23 20 . msg-group#
bed0: 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 [: cell+ $@ drop
bee0: 20 63 65 6c 6c 2b 20 2e 6d 73 67 3a 70 65 65 72 cell+ .msg:peer
bef0: 73 5b 5d 20 6f 20 73 77 61 70 20 64 65 6c 24 63 s[] o swap del$c
bf00: 65 6c 6c 20 3b 5d 20 23 6d 61 70 20 3b 0a 0a 44 ell ;] #map ;..D
bf10: 65 66 65 72 20 65 78 74 72 61 2d 64 69 73 70 6f efer extra-dispo
bf20: 73 65 20 27 20 6e 6f 6f 70 20 69 73 20 65 78 74 se ' noop is ext
bf30: 72 61 2d 64 69 73 70 6f 73 65 0a 0a 69 6e 20 6e ra-dispose..in n
bf40: 65 74 32 6f 20 3a 20 64 69 73 70 6f 73 65 2d 63 et2o : dispose-c
bf50: 6f 6e 74 65 78 74 20 28 20 6f 3a 61 64 64 72 20 ontext ( o:addr
bf60: 2d 2d 20 6f 3a 61 64 64 72 20 29 0a 20 20 20 20 -- o:addr ).
bf70: 5b 3a 20 63 6d 64 28 20 2e 22 20 44 69 73 70 6f [: cmd( ." Dispo
bf80: 73 69 6e 67 20 63 6f 6e 74 65 78 74 2e 2e 2e 20 sing context...
bf90: 22 20 6f 20 68 65 78 2e 20 63 72 20 29 0a 20 20 " o hex. cr ).
bfa0: 20 20 20 20 74 69 6d 65 6f 75 74 28 20 2e 22 20 timeout( ."
bfb0: 44 69 73 70 6f 73 69 6e 67 20 63 6f 6e 74 65 78 Disposing contex
bfc0: 74 2e 2e 2e 20 22 20 6f 20 68 65 78 2e 20 2e 22 t... " o hex. ."
bfd0: 20 74 61 73 6b 3a 20 22 20 74 61 73 6b 23 20 3f task: " task# ?
bfe0: 20 63 72 20 29 0a 20 20 20 20 20 20 6f 2d 74 69 cr ). o-ti
bff0: 6d 65 6f 75 74 20 6f 2d 63 68 75 6e 6b 73 20 65 meout o-chunks e
c000: 78 74 72 61 2d 64 69 73 70 6f 73 65 0a 20 20 20 xtra-dispose.
c010: 20 20 20 64 61 74 61 2d 72 6d 61 70 20 49 46 20 data-rmap IF
c020: 20 23 30 2e 20 64 61 74 61 2d 72 6d 61 70 20 2e #0. data-rmap .
c030: 6d 61 70 63 3a 64 65 73 74 2d 76 61 64 64 72 20 mapc:dest-vaddr
c040: 3e 64 65 73 74 2d 6d 61 70 20 32 21 20 20 54 48 >dest-map 2! TH
c050: 45 4e 0a 20 20 20 20 20 20 65 6e 64 2d 6d 61 70 EN. end-map
c060: 73 20 73 74 61 72 74 2d 6d 61 70 73 20 44 4f 20 s start-maps DO
c070: 20 49 20 40 20 3f 64 75 70 2d 49 46 20 2e 6d 61 I @ ?dup-IF .ma
c080: 70 63 3a 66 72 65 65 2d 64 61 74 61 20 54 48 45 pc:free-data THE
c090: 4e 20 20 63 65 6c 6c 20 2b 4c 4f 4f 50 0a 20 20 N cell +LOOP.
c0a0: 20 20 20 20 65 6e 64 2d 73 74 72 69 6e 67 73 20 end-strings
c0b0: 73 74 61 72 74 2d 73 74 72 69 6e 67 73 20 44 4f start-strings DO
c0c0: 20 20 49 20 24 6f 66 66 20 20 20 20 20 20 63 65 I $off ce
c0d0: 6c 6c 20 2b 4c 4f 4f 50 0a 20 20 20 20 20 20 65 ll +LOOP. e
c0e0: 6e 64 2d 73 65 63 72 65 74 73 20 73 74 61 72 74 nd-secrets start
c0f0: 2d 73 65 63 72 65 74 73 20 44 4f 20 20 49 20 73 -secrets DO I s
c100: 65 63 2d 66 72 65 65 20 20 63 65 6c 6c 20 2b 4c ec-free cell +L
c110: 4f 4f 50 0a 20 20 20 20 20 20 66 73 74 61 74 65 OOP. fstate
c120: 2d 66 72 65 65 0a 20 20 20 20 20 20 5c 20 65 72 -free. \ er
c130: 61 73 65 20 63 72 79 70 74 6f 20 6b 65 79 73 0a ase crypto keys.
c140: 20 20 20 20 20 20 6c 6f 67 2d 63 6f 6e 74 65 78 log-contex
c150: 74 20 40 20 3f 64 75 70 2d 49 46 20 20 2e 64 69 t @ ?dup-IF .di
c160: 73 70 6f 73 65 20 20 54 48 45 4e 0a 20 20 20 20 spose THEN.
c170: 20 20 61 63 6b 2d 63 6f 6e 74 65 78 74 20 40 20 ack-context @
c180: 3f 64 75 70 2d 49 46 0a 09 20 20 3e 6f 20 74 69 ?dup-IF.. >o ti
c190: 6d 69 6e 67 2d 73 74 61 74 20 24 6f 66 66 20 74 ming-stat $off t
c1a0: 72 61 63 6b 2d 74 69 6d 69 6e 67 20 24 6f 66 66 rack-timing $off
c1b0: 20 64 69 73 70 6f 73 65 20 6f 3e 0a 20 20 20 20 dispose o>.
c1c0: 20 20 54 48 45 4e 0a 20 20 20 20 20 20 6d 73 67 THEN. msg
c1d0: 69 6e 67 2d 63 6f 6e 74 65 78 74 20 40 20 3f 64 ing-context @ ?d
c1e0: 75 70 2d 49 46 20 20 2e 64 69 73 70 6f 73 65 20 up-IF .dispose
c1f0: 20 54 48 45 4e 0a 20 20 20 20 20 20 75 6e 6c 69 THEN. unli
c200: 6e 6b 2d 63 74 78 20 20 75 6e 67 72 6f 75 70 2d nk-ctx ungroup-
c210: 63 74 78 0a 20 20 20 20 20 20 65 6e 64 2d 73 65 ctx. end-se
c220: 6d 61 73 20 73 74 61 72 74 2d 73 65 6d 61 73 20 mas start-semas
c230: 44 4f 20 20 49 20 70 74 68 72 65 61 64 5f 6d 75 DO I pthread_mu
c240: 74 65 78 5f 64 65 73 74 72 6f 79 20 64 72 6f 70 tex_destroy drop
c250: 0a 20 20 20 20 20 20 31 20 70 74 68 72 65 61 64 . 1 pthread
c260: 2d 6d 75 74 65 78 65 73 20 2b 4c 4f 4f 50 0a 20 -mutexes +LOOP.
c270: 20 20 20 20 20 64 69 73 70 6f 73 65 20 20 30 20 dispose 0
c280: 74 6f 20 63 6f 6e 6e 65 63 74 69 6f 6e 0a 20 20 to connection.
c290: 20 20 20 20 63 6d 64 28 20 2e 22 20 64 69 73 70 cmd( ." disp
c2a0: 6f 73 65 64 22 20 63 72 20 29 20 3b 5d 20 66 69 osed" cr ) ;] fi
c2b0: 6c 65 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 6f le-sema c-sectio
c2c0: 6e 20 3b 0a 0a 65 76 65 6e 74 3a 20 3a 3e 64 69 n ;..event: :>di
c2d0: 73 70 6f 73 65 2d 63 6f 6e 74 65 78 74 20 28 20 spose-context (
c2e0: 6f 20 2d 2d 20 29 20 20 2e 6e 65 74 32 6f 3a 64 o -- ) .net2o:d
c2f0: 69 73 70 6f 73 65 2d 63 6f 6e 74 65 78 74 20 3b ispose-context ;
c300: 0a 0a 5c 20 6c 6f 6f 70 73 20 66 6f 72 20 73 65 ..\ loops for se
c310: 72 76 65 72 20 61 6e 64 20 63 6c 69 65 6e 74 0a rver and client.
c320: 0a 38 20 63 65 6c 6c 73 20 31 2d 20 43 6f 6e 73 .8 cells 1- Cons
c330: 74 61 6e 74 20 6d 61 78 72 65 71 75 65 73 74 23 tant maxrequest#
c340: 0a 0a 3a 20 6e 65 78 74 2d 72 65 71 75 65 73 74 ..: next-request
c350: 20 28 20 2d 2d 20 6e 20 29 0a 20 20 20 20 31 20 ( -- n ). 1
c360: 64 75 70 20 72 65 71 75 65 73 74 23 20 2b 21 40 dup request# +!@
c370: 20 6d 61 78 72 65 71 75 65 73 74 23 20 61 6e 64 maxrequest# and
c380: 20 74 75 63 6b 20 6c 73 68 69 66 74 20 72 65 71 tuck lshift req
c390: 6d 61 73 6b 20 6f 72 21 0a 20 20 20 20 72 65 71 mask or!. req
c3a0: 75 65 73 74 28 20 2e 22 20 52 65 71 75 65 73 74 uest( ." Request
c3b0: 20 61 64 64 65 64 3a 20 22 20 64 75 70 20 2e 20 added: " dup .
c3c0: 2e 22 20 6f 20 22 20 6f 20 68 65 78 2e 20 2e 22 ." o " o hex. ."
c3d0: 20 74 61 73 6b 3a 20 22 20 74 61 73 6b 23 20 3f task: " task# ?
c3e0: 20 63 72 20 29 20 3b 0a 0a 3a 20 70 61 63 6b 65 cr ) ;..: packe
c3f0: 74 2d 65 76 65 6e 74 20 28 20 2d 2d 20 29 0a 20 t-event ( -- ).
c400: 20 20 20 6e 65 78 74 2d 70 61 63 6b 65 74 20 21 next-packet !
c410: 74 69 63 6b 73 20 6e 69 70 20 30 3d 20 3f 45 58 ticks nip 0= ?EX
c420: 49 54 20 20 69 6e 62 75 66 20 72 6f 75 74 65 3f IT inbuf route?
c430: 0a 20 20 20 20 49 46 20 20 72 6f 75 74 65 2d 70 . IF route-p
c440: 61 63 6b 65 74 20 20 45 4c 53 45 20 20 68 61 6e acket ELSE han
c450: 64 6c 65 2d 70 61 63 6b 65 74 20 20 54 48 45 4e dle-packet THEN
c460: 20 3b 0a 0a 3a 20 63 6c 65 61 6e 2d 72 65 71 75 ;..: clean-requ
c470: 65 73 74 20 28 20 6e 20 2d 2d 20 29 0a 20 20 20 est ( n -- ).
c480: 20 31 20 6f 76 65 72 20 6c 73 68 69 66 74 20 69 1 over lshift i
c490: 6e 76 65 72 74 20 72 65 71 6d 61 73 6b 20 61 6e nvert reqmask an
c4a0: 64 21 0a 20 20 20 20 72 65 71 75 65 73 74 28 20 d!. request(
c4b0: 2e 22 20 52 65 71 75 65 73 74 20 63 6f 6d 70 6c ." Request compl
c4c0: 65 74 65 64 3a 20 22 20 2e 20 2e 22 20 6f 20 22 eted: " . ." o "
c4d0: 20 6f 20 68 65 78 2e 20 2e 22 20 74 61 73 6b 3a o hex. ." task:
c4e0: 20 22 20 74 61 73 6b 23 20 3f 20 63 72 0a 20 20 " task# ? cr.
c4f0: 20 20 29 65 6c 73 65 28 20 64 72 6f 70 20 29 20 )else( drop )
c500: 3b 0a 0a 3a 20 72 71 64 40 20 28 20 6e 20 2d 2d ;..: rqd@ ( n --
c510: 20 78 74 20 29 0a 20 20 20 20 30 20 73 77 61 70 xt ). 0 swap
c520: 20 72 71 64 2d 78 74 73 20 24 5b 5d 20 21 40 20 rqd-xts $[] !@
c530: 3f 64 75 70 2d 30 3d 2d 49 46 20 20 5b 27 5d 20 ?dup-0=-IF [']
c540: 63 6c 65 61 6e 2d 72 65 71 75 65 73 74 20 20 54 clean-request T
c550: 48 45 4e 20 3b 0a 0a 3a 20 72 71 64 21 20 28 20 HEN ;..: rqd! (
c560: 78 74 20 2d 2d 20 29 0a 20 20 20 20 5c 47 20 73 xt -- ). \G s
c570: 74 6f 72 65 20 72 65 71 75 65 73 74 0a 20 20 20 tore request.
c580: 20 72 65 71 75 65 73 74 23 20 40 20 72 71 64 2d request# @ rqd-
c590: 78 74 73 20 24 5b 5d 20 21 20 3b 0a 3a 20 72 71 xts $[] ! ;.: rq
c5a0: 64 3f 20 28 20 78 74 20 2d 2d 20 29 0a 20 20 20 d? ( xt -- ).
c5b0: 20 5c 47 20 73 74 6f 72 65 20 72 65 71 75 65 73 \G store reques
c5c0: 74 20 69 66 20 6e 6f 20 62 65 74 74 65 72 20 69 t if no better i
c5d0: 73 20 61 76 61 69 6c 61 62 6c 65 0a 20 20 20 20 s available.
c5e0: 72 65 71 75 65 73 74 23 20 40 20 72 71 64 2d 78 request# @ rqd-x
c5f0: 74 73 20 24 5b 5d 20 64 75 70 20 40 20 49 46 20 ts $[] dup @ IF
c600: 20 32 64 72 6f 70 20 20 45 4c 53 45 20 20 21 20 2drop ELSE !
c610: 20 54 48 45 4e 20 3b 0a 0a 65 76 65 6e 74 3a 20 THEN ;..event:
c620: 3a 3e 72 65 71 75 65 73 74 20 28 20 6e 20 6f 20 :>request ( n o
c630: 2d 2d 20 29 20 3e 6f 20 6d 61 78 72 65 71 75 65 -- ) >o maxreque
c640: 73 74 23 20 61 6e 64 0a 20 20 20 20 64 75 70 20 st# and. dup
c650: 72 71 64 40 20 72 65 71 75 65 73 74 28 20 2e 22 rqd@ request( ."
c660: 20 72 65 71 75 65 73 74 20 78 74 3a 20 22 20 64 request xt: " d
c670: 75 70 20 2e 6e 61 6d 65 20 63 72 20 29 20 20 65 up .name cr ) e
c680: 78 65 63 75 74 65 0a 20 20 20 20 72 65 71 6d 61 xecute. reqma
c690: 73 6b 20 40 20 30 3d 20 49 46 20 20 72 65 71 75 sk @ 0= IF requ
c6a0: 65 73 74 28 20 2e 22 20 52 65 6d 6f 76 65 20 74 est( ." Remove t
c6b0: 69 6d 65 6f 75 74 22 20 63 72 20 29 20 2d 74 69 imeout" cr ) -ti
c6c0: 6d 65 6f 75 74 0a 20 20 20 20 45 4c 53 45 20 20 meout. ELSE
c6d0: 72 65 71 75 65 73 74 28 20 2e 22 20 54 69 6d 65 request( ." Time
c6e0: 6f 75 74 20 72 65 6d 61 69 6e 73 3a 20 22 20 72 out remains: " r
c6f0: 65 71 6d 61 73 6b 20 40 20 68 65 78 2e 20 63 72 eqmask @ hex. cr
c700: 20 29 20 54 48 45 4e 20 20 6f 3e 20 3b 0a 65 76 ) THEN o> ;.ev
c710: 65 6e 74 3a 20 3a 3e 74 69 6d 65 6f 75 74 20 28 ent: :>timeout (
c720: 20 6f 20 2d 2d 20 29 0a 20 20 20 20 74 69 6d 65 o -- ). time
c730: 6f 75 74 28 20 2e 22 20 52 65 71 75 65 73 74 20 out( ." Request
c740: 74 69 6d 65 64 20 6f 75 74 22 20 66 6f 72 74 68 timed out" forth
c750: 3a 63 72 20 29 0a 20 20 20 20 3e 6f 20 30 20 72 :cr ). >o 0 r
c760: 65 71 6d 61 73 6b 20 21 40 20 3e 72 20 2d 74 69 eqmask !@ >r -ti
c770: 6d 65 6f 75 74 20 72 3e 20 6f 3e 20 6d 73 67 28 meout r> o> msg(
c780: 20 2e 22 20 52 65 71 75 65 73 74 20 74 69 6d 65 ." Request time
c790: 64 20 6f 75 74 22 20 63 72 20 29 0a 20 20 20 20 d out" cr ).
c7a0: 30 3c 3e 20 21 21 74 69 6d 65 6f 75 74 21 21 20 0<> !!timeout!!
c7b0: 3b 0a 65 76 65 6e 74 3a 20 3a 3e 74 68 72 6f 77 ;.event: :>throw
c7c0: 20 28 20 65 72 72 6f 72 20 2d 2d 20 29 20 74 68 ( error -- ) th
c7d0: 72 6f 77 20 3b 0a 0a 3a 20 74 69 6d 65 6f 75 74 row ;..: timeout
c7e0: 2d 65 78 70 69 72 65 64 3f 20 28 20 2d 2d 20 66 -expired? ( -- f
c7f0: 6c 61 67 20 29 0a 20 20 20 20 61 63 6b 40 20 2e lag ). ack@ .
c800: 74 69 6d 65 6f 75 74 73 20 40 20 6d 61 78 2d 74 timeouts @ max-t
c810: 69 6d 65 6f 75 74 73 20 3e 3d 20 3b 0a 3a 20 70 imeouts >= ;.: p
c820: 75 73 68 2d 74 69 6d 65 6f 75 74 20 28 20 6f 3a ush-timeout ( o:
c830: 63 6f 6e 6e 65 63 74 69 6f 6e 20 2d 2d 20 29 0a connection -- ).
c840: 20 20 20 20 74 69 6d 65 6f 75 74 2d 65 78 70 69 timeout-expi
c850: 72 65 64 3f 20 77 61 69 74 2d 74 61 73 6b 20 40 red? wait-task @
c860: 20 61 6e 64 20 20 3f 64 75 70 2d 49 46 0a 09 6f and ?dup-IF..o
c870: 20 65 6c 69 74 2c 20 3a 3e 74 69 6d 65 6f 75 74 elit, :>timeout
c880: 20 65 76 65 6e 74 3e 20 20 54 48 45 4e 20 3b 0a event> THEN ;.
c890: 0a 3a 20 72 65 71 75 65 73 74 2d 74 69 6d 65 6f .: request-timeo
c8a0: 75 74 20 28 20 2d 2d 20 29 0a 20 20 20 20 3f 74 ut ( -- ). ?t
c8b0: 69 6d 65 6f 75 74 20 3f 64 75 70 2d 49 46 20 20 imeout ?dup-IF
c8c0: 3e 6f 20 72 64 72 6f 70 0a 09 74 69 6d 65 6f 75 >o rdrop..timeou
c8d0: 74 28 20 2e 22 20 64 6f 20 74 69 6d 65 6f 75 74 t( ." do timeout
c8e0: 3a 20 22 20 6f 20 68 65 78 2e 20 61 64 64 72 20 : " o hex. addr
c8f0: 74 69 6d 65 6f 75 74 2d 78 74 20 40 20 2e 6e 61 timeout-xt @ .na
c900: 6d 65 20 63 72 20 29 0a 09 74 69 6d 65 6f 75 74 me cr )..timeout
c910: 2d 78 74 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a -xt. THEN ;..
c920: 5c 20 62 65 61 63 6f 6e 73 0a 5c 20 55 44 50 20 \ beacons.\ UDP
c930: 63 6f 6e 6e 65 63 74 69 6f 6e 73 20 74 68 72 6f connections thro
c940: 75 67 68 20 61 20 4e 41 54 20 63 6c 6f 73 65 20 ugh a NAT close
c950: 61 66 74 65 72 20 74 69 6d 65 6f 75 74 2c 0a 5c after timeout,.\
c960: 20 74 79 70 69 63 61 6c 6c 79 20 61 66 74 65 72 typically after
c970: 20 61 20 6d 69 6e 75 74 65 20 6f 72 20 73 6f 2e a minute or so.
c980: 0a 5c 20 54 6f 20 6b 65 65 70 20 63 6f 6e 6e 65 .\ To keep conne
c990: 63 74 69 6f 6e 73 20 61 6c 69 76 65 2c 20 79 6f ctions alive, yo
c9a0: 75 20 68 61 76 65 20 74 6f 20 73 65 6e 64 20 61 u have to send a
c9b0: 20 22 62 65 61 63 6f 6e 22 20 61 20 62 69 74 20 "beacon" a bit
c9c0: 62 65 66 6f 72 65 0a 5c 20 74 68 65 20 63 6f 6e before.\ the con
c9d0: 6e 65 63 74 69 6f 6e 20 77 6f 75 6c 64 20 65 78 nection would ex
c9e0: 70 69 72 65 20 74 6f 20 72 65 66 72 65 73 68 20 pire to refresh
c9f0: 74 68 65 20 4e 41 54 20 77 69 6e 64 6f 77 2e 0a the NAT window..
ca00: 5c 20 62 65 61 63 6f 6e 73 20 61 72 65 20 73 65 \ beacons are se
ca10: 6e 64 20 72 65 67 75 6c 61 72 6c 79 20 72 65 67 nd regularly reg
ca20: 61 72 64 6c 65 73 73 20 69 66 20 79 6f 75 20 68 ardless if you h
ca30: 61 76 65 20 61 6e 79 20 6f 74 68 65 72 20 74 72 ave any other tr
ca40: 61 66 66 69 63 2c 0a 5c 20 62 65 63 61 75 73 65 affic,.\ because
ca50: 20 74 68 61 74 27 73 20 65 61 73 69 65 72 20 74 that's easier t
ca60: 6f 20 64 6f 2e 0a 5c 20 62 65 61 63 6f 6e 73 20 o do..\ beacons
ca70: 61 72 65 20 6f 6e 65 2d 62 79 74 65 20 70 61 63 are one-byte pac
ca80: 6b 65 74 73 2c 20 77 69 74 68 20 41 53 43 49 49 kets, with ASCII
ca90: 20 63 68 61 72 61 63 74 65 72 73 20 74 6f 20 73 characters to s
caa0: 61 79 20 77 68 61 74 20 74 68 65 79 20 6d 65 61 ay what they mea
cab0: 6e 0a 0a 23 35 30 2e 30 30 30 2e 30 30 30 2e 30 n..#50.000.000.0
cac0: 30 30 20 64 3e 36 34 20 36 34 56 61 6c 75 65 20 00 d>64 64Value
cad0: 62 65 61 63 6f 6e 2d 74 69 63 6b 73 23 20 5c 20 beacon-ticks# \
cae0: 35 30 73 20 62 65 61 63 6f 6e 20 74 69 63 6b 20 50s beacon tick
caf0: 72 61 74 65 0a 23 32 2e 30 30 30 2e 30 30 30 2e rate.#2.000.000.
cb00: 30 30 30 20 64 3e 36 34 20 36 34 56 61 6c 75 65 000 d>64 64Value
cb10: 20 62 65 61 63 6f 6e 2d 73 68 6f 72 74 2d 74 69 beacon-short-ti
cb20: 63 6b 73 23 20 5c 20 32 73 20 73 68 6f 72 74 20 cks# \ 2s short
cb30: 62 65 61 63 6f 6e 20 74 69 63 6b 20 72 61 74 65 beacon tick rate
cb40: 0a 0a 68 61 73 68 3a 20 62 65 61 63 6f 6e 73 23 ..hash: beacons#
cb50: 20 5c 20 64 65 73 74 69 6e 61 74 69 6f 6e 73 20 \ destinations
cb60: 74 6f 20 73 65 6e 64 20 62 65 61 63 6f 6e 73 20 to send beacons
cb70: 74 6f 0a 56 61 72 69 61 62 6c 65 20 6e 65 65 64 to.Variable need
cb80: 2d 62 65 61 63 6f 6e 23 20 6e 65 65 64 2d 62 65 -beacon# need-be
cb90: 61 63 6f 6e 23 20 6f 6e 20 5c 20 74 72 75 65 20 acon# on \ true
cba0: 69 66 20 6e 65 65 64 73 20 61 20 68 61 73 68 20 if needs a hash
cbb0: 66 6f 72 20 74 68 65 20 3f 20 62 65 61 63 6f 6e for the ? beacon
cbc0: 0a 0a 3a 20 6e 65 78 74 2d 62 65 61 63 6f 6e 20 ..: next-beacon
cbd0: 28 20 2d 2d 20 36 34 74 69 63 6b 20 29 0a 20 20 ( -- 64tick ).
cbe0: 20 20 36 34 23 2d 31 20 62 65 61 63 6f 6e 73 23 64#-1 beacons#
cbf0: 20 5b 3a 20 63 65 6c 6c 2b 20 24 40 20 64 72 6f [: cell+ $@ dro
cc00: 70 20 36 34 40 20 36 34 75 6d 69 6e 20 3b 5d 20 p 64@ 64umin ;]
cc10: 23 6d 61 70 20 3b 0a 0a 3a 20 73 65 6e 64 2d 62 #map ;..: send-b
cc20: 65 61 63 6f 6e 73 20 28 20 2d 2d 20 29 20 21 74 eacons ( -- ) !t
cc30: 69 63 6b 73 0a 20 20 20 20 62 65 61 63 6f 6e 73 icks. beacons
cc40: 23 20 5b 3a 20 64 75 70 20 24 40 20 7b 20 62 61 # [: dup $@ { ba
cc50: 64 64 72 20 75 20 7d 20 63 65 6c 6c 2b 20 24 40 ddr u } cell+ $@
cc60: 20 64 72 6f 70 20 7b 20 62 65 61 63 6f 6e 20 7d drop { beacon }
cc70: 0a 09 62 65 61 63 6f 6e 20 36 34 40 20 74 69 63 ..beacon 64@ tic
cc80: 6b 65 72 20 36 34 40 20 36 34 75 3c 3d 20 49 46 ker 64@ 64u<= IF
cc90: 0a 09 20 20 20 20 62 65 61 63 6f 6e 28 20 74 69 .. beacon( ti
cca0: 63 6b 73 20 2e 74 69 63 6b 73 20 2e 22 20 20 73 cks .ticks ." s
ccb0: 65 6e 64 20 62 65 61 63 6f 6e 20 74 6f 3a 20 22 end beacon to: "
ccc0: 20 62 61 64 64 72 20 75 20 2e 61 64 64 72 65 73 baddr u .addres
ccd0: 73 20 29 0a 09 20 20 20 20 74 69 63 6b 65 72 20 s ).. ticker
cce0: 36 34 40 20 62 65 61 63 6f 6e 2d 73 68 6f 72 74 64@ beacon-short
ccf0: 2d 74 69 63 6b 73 23 20 36 34 2b 20 62 65 61 63 -ticks# 64+ beac
cd00: 6f 6e 20 36 34 21 0a 09 20 20 20 20 6e 65 74 32 on 64!.. net2
cd10: 6f 2d 73 6f 63 6b 0a 09 20 20 20 20 62 65 61 63 o-sock.. beac
cd20: 6f 6e 20 36 34 27 2b 20 40 20 3f 64 75 70 2d 49 on 64'+ @ ?dup-I
cd30: 46 0a 09 09 2e 62 65 61 63 6f 6e 2d 68 61 73 68 F....beacon-hash
cd40: 20 24 40 20 62 65 61 63 6f 6e 28 20 2e 22 20 20 $@ beacon( ."
cd50: 68 61 73 68 3a 20 22 20 32 64 75 70 20 38 35 74 hash: " 2dup 85t
cd60: 79 70 65 20 29 0a 09 20 20 20 20 45 4c 53 45 0a ype ).. ELSE.
cd70: 09 09 73 22 20 3f 22 0a 09 20 20 20 20 54 48 45 ..s" ?".. THE
cd80: 4e 0a 09 20 20 20 20 62 65 61 63 6f 6e 28 20 63 N.. beacon( c
cd90: 72 20 29 0a 09 20 20 20 20 30 20 62 61 64 64 72 r ).. 0 baddr
cda0: 20 75 20 73 65 6e 64 74 6f 20 64 72 6f 70 20 2b u sendto drop +
cdb0: 73 65 6e 64 0a 09 54 48 45 4e 0a 09 3b 5d 20 23 send..THEN..;] #
cdc0: 6d 61 70 20 3b 0a 0a 3a 20 62 65 61 63 6f 6e 3f map ;..: beacon?
cdd0: 20 28 20 2d 2d 20 29 0a 20 20 20 20 6e 65 78 74 ( -- ). next
cde0: 2d 62 65 61 63 6f 6e 20 74 69 63 6b 65 72 20 36 -beacon ticker 6
cdf0: 34 40 20 36 34 75 3c 3d 20 49 46 20 20 73 65 6e 4@ 64u<= IF sen
ce00: 64 2d 62 65 61 63 6f 6e 73 20 20 54 48 45 4e 20 d-beacons THEN
ce10: 3b 0a 0a 3a 20 2b 62 65 61 63 6f 6e 20 28 20 73 ;..: +beacon ( s
ce20: 6f 63 6b 61 64 64 72 20 6c 65 6e 20 78 74 20 2d ockaddr len xt -
ce30: 2d 20 29 0a 20 20 20 20 3e 72 20 74 69 63 6b 73 - ). >r ticks
ce40: 20 62 65 61 63 6f 6e 2d 73 68 6f 72 74 2d 74 69 beacon-short-ti
ce50: 63 6b 73 23 20 36 34 2b 20 6f 20 72 3e 20 7b 20 cks# 64+ o r> {
ce60: 36 34 5e 20 64 65 73 74 20 77 5e 20 6f 62 6a 20 64^ dest w^ obj
ce70: 77 5e 20 78 74 20 7d 0a 20 20 20 20 62 65 61 63 w^ xt }. beac
ce80: 6f 6e 28 20 2e 22 20 61 64 64 20 62 65 61 63 6f on( ." add beaco
ce90: 6e 3a 20 22 20 32 64 75 70 20 2e 61 64 64 72 65 n: " 2dup .addre
cea0: 73 73 20 2e 22 20 20 27 20 22 20 78 74 20 40 20 ss ." ' " xt @
ceb0: 2e 6e 61 6d 65 20 63 72 20 29 0a 20 20 20 20 32 .name cr ). 2
cec0: 64 75 70 20 62 65 61 63 6f 6e 73 23 20 23 40 20 dup beacons# #@
ced0: 64 30 3d 20 49 46 0a 09 64 65 73 74 20 31 20 36 d0= IF..dest 1 6
cee0: 34 73 20 63 65 6c 6c 2b 20 63 65 6c 6c 2b 20 32 4s cell+ cell+ 2
cef0: 73 77 61 70 20 62 65 61 63 6f 6e 73 23 20 23 21 swap beacons# #!
cf00: 0a 20 20 20 20 45 4c 53 45 0a 09 6f 62 6a 20 32 . ELSE..obj 2
cf10: 20 63 65 6c 6c 73 20 6c 61 73 74 23 20 63 65 6c cells last# cel
cf20: 6c 2b 20 24 2b 21 20 32 64 72 6f 70 0a 20 20 20 l+ $+! 2drop.
cf30: 20 54 48 45 4e 20 3b 0a 0a 3a 20 6f 2d 62 65 61 THEN ;..: o-bea
cf40: 63 6f 6e 20 28 20 2d 2d 20 29 0a 20 20 20 20 62 con ( -- ). b
cf50: 65 61 63 6f 6e 28 20 2e 22 20 72 65 6d 6f 76 65 eacon( ." remove
cf60: 20 62 65 61 63 6f 6e 73 3a 20 22 20 6f 20 68 65 beacons: " o he
cf70: 78 2e 20 63 72 20 29 0a 20 20 20 20 62 65 61 63 x. cr ). beac
cf80: 6f 6e 73 23 20 5b 3a 20 7b 20 62 75 63 6b 65 74 ons# [: { bucket
cf90: 20 7d 20 62 75 63 6b 65 74 20 63 65 6c 6c 2b 20 } bucket cell+
cfa0: 24 40 20 31 20 36 34 73 20 2f 73 74 72 69 6e 67 $@ 1 64s /string
cfb0: 20 62 6f 75 6e 64 73 20 3f 44 4f 0a 09 20 20 20 bounds ?DO..
cfc0: 20 49 20 40 20 6f 20 3d 20 49 46 0a 09 09 62 75 I @ o = IF...bu
cfd0: 63 6b 65 74 20 63 65 6c 6c 2b 20 49 20 6f 76 65 cket cell+ I ove
cfe0: 72 20 24 40 20 64 72 6f 70 20 2d 20 32 20 63 65 r $@ drop - 2 ce
cff0: 6c 6c 73 20 24 64 65 6c 20 20 4c 45 41 56 45 20 lls $del LEAVE
d000: 20 54 48 45 4e 0a 09 32 20 63 65 6c 6c 73 20 2b THEN..2 cells +
d010: 4c 4f 4f 50 0a 09 62 75 63 6b 65 74 20 63 65 6c LOOP..bucket cel
d020: 6c 2b 20 24 40 6c 65 6e 20 38 20 3d 20 49 46 0a l+ $@len 8 = IF.
d030: 09 20 20 20 20 62 75 63 6b 65 74 20 24 6f 66 66 . bucket $off
d040: 20 62 75 63 6b 65 74 20 63 65 6c 6c 2b 20 24 6f bucket cell+ $o
d050: 66 66 0a 09 54 48 45 4e 0a 20 20 20 20 3b 5d 20 ff..THEN. ;]
d060: 23 6d 61 70 20 3b 0a 0a 3a 20 62 65 61 63 6f 6e #map ;..: beacon
d070: 73 2d 6e 6f 77 21 20 28 20 2d 2d 20 29 0a 20 20 s-now! ( -- ).
d080: 20 20 74 69 63 6b 73 20 62 65 61 63 6f 6e 73 23 ticks beacons#
d090: 20 5b 3a 20 3e 72 20 36 34 64 75 70 20 72 3e 20 [: >r 64dup r>
d0a0: 63 65 6c 6c 2b 20 24 40 20 64 72 6f 70 20 36 34 cell+ $@ drop 64
d0b0: 21 20 3b 5d 20 23 6d 61 70 0a 20 20 20 20 36 34 ! ;] #map. 64
d0c0: 64 72 6f 70 20 3b 0a 0a 3a 6e 6f 6e 61 6d 65 20 drop ;..:noname
d0d0: 6f 2d 62 65 61 63 6f 6e 20 64 65 66 65 72 73 20 o-beacon defers
d0e0: 65 78 74 72 61 2d 64 69 73 70 6f 73 65 20 3b 20 extra-dispose ;
d0f0: 69 73 20 65 78 74 72 61 2d 64 69 73 70 6f 73 65 is extra-dispose
d100: 0a 0a 3a 20 67 65 6e 2d 62 65 61 63 6f 6e 2d 68 ..: gen-beacon-h
d110: 61 73 68 20 28 20 2d 2d 20 68 61 73 68 20 75 20 ash ( -- hash u
d120: 29 0a 20 20 20 20 64 65 73 74 2d 30 6b 65 79 20 ). dest-0key
d130: 73 65 63 40 20 22 62 65 61 63 6f 6e 22 20 6b 65 sec@ "beacon" ke
d140: 79 65 64 2d 68 61 73 68 23 31 32 38 20 32 2f 20 yed-hash#128 2/
d150: 3b 0a 0a 3a 20 61 64 64 2d 62 65 61 63 6f 6e 20 ;..: add-beacon
d160: 28 20 6e 65 74 32 6f 61 64 64 72 20 78 74 20 2d ( net2oaddr xt -
d170: 2d 20 29 0a 20 20 20 20 3e 72 20 72 6f 75 74 65 - ). >r route
d180: 3e 61 64 64 72 65 73 73 20 49 46 0a 09 73 6f 63 >address IF..soc
d190: 6b 61 64 64 72 3e 20 61 6c 65 6e 20 40 20 72 40 kaddr> alen @ r@
d1a0: 20 2b 62 65 61 63 6f 6e 0a 09 6f 20 49 46 0a 09 +beacon..o IF..
d1b0: 20 20 20 20 73 22 20 3f 22 20 62 65 61 63 6f 6e s" ?" beacon
d1c0: 2d 68 61 73 68 20 24 21 20 20 67 65 6e 2d 62 65 -hash $! gen-be
d1d0: 61 63 6f 6e 2d 68 61 73 68 20 62 65 61 63 6f 6e acon-hash beacon
d1e0: 2d 68 61 73 68 20 24 2b 21 0a 09 54 48 45 4e 0a -hash $+!..THEN.
d1f0: 20 20 20 20 54 48 45 4e 20 20 72 64 72 6f 70 20 THEN rdrop
d200: 3b 0a 3a 20 72 65 74 2b 62 65 61 63 6f 6e 20 28 ;.: ret+beacon (
d210: 20 2d 2d 20 29 20 20 72 65 74 2d 61 64 64 72 20 -- ) ret-addr
d220: 62 65 40 20 5b 27 5d 20 32 64 72 6f 70 20 61 64 be@ ['] 2drop ad
d230: 64 2d 62 65 61 63 6f 6e 20 3b 0a 0a 5c 20 74 69 d-beacon ;..\ ti
d240: 6d 65 6f 75 74 20 6c 6f 6f 70 0a 0a 3a 20 65 76 meout loop..: ev
d250: 65 6e 74 2d 73 65 6e 64 20 28 20 2d 2d 20 29 0a ent-send ( -- ).
d260: 20 20 20 20 6f 20 49 46 20 20 77 61 69 74 2d 74 o IF wait-t
d270: 61 73 6b 20 40 20 3f 71 75 65 72 79 2d 74 61 73 ask @ ?query-tas
d280: 6b 20 6f 76 65 72 20 73 65 6c 65 63 74 20 65 76 k over select ev
d290: 65 6e 74 3e 20 30 20 3e 6f 20 72 64 72 6f 70 20 ent> 0 >o rdrop
d2a0: 20 54 48 45 4e 20 3b 0a 0a 23 31 30 30 30 30 30 THEN ;..#100000
d2b0: 30 30 20 43 6f 6e 73 74 61 6e 74 20 77 61 74 63 00 Constant watc
d2c0: 68 2d 74 69 6d 65 6f 75 74 23 20 5c 20 31 30 6d h-timeout# \ 10m
d2d0: 73 20 74 69 6d 65 6f 75 74 20 63 68 65 63 6b 20 s timeout check
d2e0: 69 6e 74 65 72 76 61 6c 0a 23 31 30 2e 30 30 30 interval.#10.000
d2f0: 30 30 30 30 30 30 20 64 3e 36 34 20 36 34 43 6f 000000 d>64 64Co
d300: 6e 73 74 61 6e 74 20 6d 61 78 2d 74 69 6d 65 6f nstant max-timeo
d310: 75 74 23 20 5c 20 31 30 73 20 73 6c 65 65 70 2c ut# \ 10s sleep,
d320: 20 6e 6f 20 6d 6f 72 65 0a 0a 5b 49 46 44 45 46 no more..[IFDEF
d330: 5d 20 61 6e 64 72 6f 69 64 0a 20 20 20 20 61 6c ] android. al
d340: 73 6f 20 6a 6e 69 0a 20 20 20 20 36 34 56 61 72 so jni. 64Var
d350: 69 61 62 6c 65 20 6f 6c 64 2d 62 65 61 63 6f 6e iable old-beacon
d360: 20 36 34 23 2d 31 20 6f 6c 64 2d 62 65 61 63 6f 64#-1 old-beaco
d370: 6e 20 36 34 21 0a 20 20 20 20 3a 20 73 65 74 2d n 64!. : set-
d380: 62 65 61 63 6f 6e 2d 61 6c 61 72 6d 20 28 20 62 beacon-alarm ( b
d390: 65 61 63 6f 6e 2d 74 69 63 6b 20 2d 2d 20 29 0a eacon-tick -- ).
d3a0: 09 36 34 64 75 70 20 6f 6c 64 2d 62 65 61 63 6f .64dup old-beaco
d3b0: 6e 20 36 34 40 20 36 34 3d 20 49 46 20 20 36 34 n 64@ 64= IF 64
d3c0: 64 72 6f 70 20 20 45 58 49 54 20 20 54 48 45 4e drop EXIT THEN
d3d0: 0a 09 36 34 64 75 70 20 6f 6c 64 2d 62 65 61 63 ..64dup old-beac
d3e0: 6f 6e 20 36 34 21 0a 09 36 34 3e 64 20 31 30 30 on 64!..64>d 100
d3f0: 30 30 30 30 20 75 64 2f 6d 6f 64 20 63 6c 61 7a 0000 ud/mod claz
d400: 7a 20 2e 73 65 74 5f 61 6c 61 72 6d 20 64 72 6f z .set_alarm dro
d410: 70 20 3b 0a 20 20 20 20 3a 20 61 6e 64 72 6f 69 p ;. : androi
d420: 64 2d 77 61 6b 65 75 70 20 28 20 30 20 2d 2d 20 d-wakeup ( 0 --
d430: 29 20 64 72 6f 70 0a 09 74 69 6d 65 6f 75 74 2d ) drop..timeout-
d440: 74 61 73 6b 20 3f 64 75 70 2d 49 46 20 20 77 61 task ?dup-IF wa
d450: 6b 65 20 20 54 48 45 4e 20 3b 0a 20 20 20 20 61 ke THEN ;. a
d460: 6c 73 6f 20 61 6e 64 72 6f 69 64 0a 20 20 20 20 lso android.
d470: 27 20 61 6e 64 72 6f 69 64 2d 77 61 6b 65 75 70 ' android-wakeup
d480: 20 69 73 20 61 6e 64 72 6f 69 64 2d 61 6c 61 72 is android-alar
d490: 6d 0a 20 20 20 20 70 72 65 76 69 6f 75 73 20 70 m. previous p
d4a0: 72 65 76 69 6f 75 73 0a 5b 54 48 45 4e 5d 0a 0a revious.[THEN]..
d4b0: 46 6f 72 77 61 72 64 20 73 61 76 65 2d 6d 73 67 Forward save-msg
d4c0: 73 3f 0a 46 6f 72 77 61 72 64 20 6e 65 78 74 2d s?.Forward next-
d4d0: 73 61 76 65 64 2d 6d 73 67 0a 0a 3a 20 3e 6e 65 saved-msg..: >ne
d4e0: 78 74 2d 74 69 63 6b 73 20 28 20 2d 2d 20 29 0a xt-ticks ( -- ).
d4f0: 20 20 20 20 6e 65 78 74 2d 74 69 6d 65 6f 75 74 next-timeout
d500: 3f 20 64 72 6f 70 20 6e 65 78 74 2d 62 65 61 63 ? drop next-beac
d510: 6f 6e 0a 20 20 20 20 5b 49 46 44 45 46 5d 20 61 on. [IFDEF] a
d520: 6e 64 72 6f 69 64 20 36 34 64 75 70 20 73 65 74 ndroid 64dup set
d530: 2d 62 65 61 63 6f 6e 2d 61 6c 61 72 6d 20 5b 54 -beacon-alarm [T
d540: 48 45 4e 5d 0a 20 20 20 20 36 34 75 6d 69 6e 20 HEN]. 64umin
d550: 6e 65 78 74 2d 73 61 76 65 64 2d 6d 73 67 20 36 next-saved-msg 6
d560: 34 75 6d 69 6e 20 74 69 63 6b 73 20 36 34 2d 0a 4umin ticks 64-.
d570: 20 20 20 20 36 34 23 30 20 36 34 6d 61 78 20 6d 64#0 64max m
d580: 61 78 2d 74 69 6d 65 6f 75 74 23 20 36 34 6d 69 ax-timeout# 64mi
d590: 6e 20 5c 20 6c 69 6d 69 74 20 73 6c 65 65 70 20 n \ limit sleep
d5a0: 74 69 6d 65 20 74 6f 20 31 20 73 65 63 6f 6e 64 time to 1 second
d5b0: 73 0a 20 20 20 20 77 61 69 74 28 20 2e 22 20 77 s. wait( ." w
d5c0: 61 69 74 20 66 6f 72 20 22 20 36 34 64 75 70 20 ait for " 64dup
d5d0: 75 36 34 2e 20 2e 22 20 6e 73 22 20 63 72 20 29 u64. ." ns" cr )
d5e0: 20 73 74 6f 70 2d 36 34 6e 73 0a 20 20 20 20 77 stop-64ns. w
d5f0: 61 69 74 28 20 74 69 63 6b 65 72 20 36 34 40 20 ait( ticker 64@
d600: 29 20 21 74 69 63 6b 73 0a 20 20 20 20 77 61 69 ) !ticks. wai
d610: 74 28 20 74 69 63 6b 65 72 20 36 34 40 20 36 34 t( ticker 64@ 64
d620: 73 77 61 70 20 36 34 2d 20 2e 22 20 77 61 69 74 swap 64- ." wait
d630: 65 64 20 66 6f 72 20 22 20 75 36 34 2e 20 2e 22 ed for " u64. ."
d640: 20 6e 73 22 20 63 72 20 29 20 3b 0a 0a 3a 20 74 ns" cr ) ;..: t
d650: 69 6d 65 6f 75 74 2d 6c 6f 6f 70 20 28 20 2d 2d imeout-loop ( --
d660: 20 29 20 5b 49 46 44 45 46 5d 20 61 6e 64 72 6f ) [IFDEF] andro
d670: 69 64 20 6a 6e 69 3a 61 74 74 61 63 68 20 5b 54 id jni:attach [T
d680: 48 45 4e 5d 0a 20 20 20 20 21 74 69 63 6b 73 20 HEN]. !ticks
d690: 20 42 45 47 49 4e 0a 09 3e 6e 65 78 74 2d 74 69 BEGIN..>next-ti
d6a0: 63 6b 73 20 20 20 20 20 21 21 30 64 65 70 74 68 cks !!0depth
d6b0: 21 21 0a 09 62 65 61 63 6f 6e 3f 20 20 20 20 20 !!..beacon?
d6c0: 20 20 20 20 21 21 30 64 65 70 74 68 21 21 0a 09 !!0depth!!..
d6d0: 73 61 76 65 2d 6d 73 67 73 3f 20 20 20 20 20 20 save-msgs?
d6e0: 21 21 30 64 65 70 74 68 21 21 0a 09 72 65 71 75 !!0depth!!..requ
d6f0: 65 73 74 2d 74 69 6d 65 6f 75 74 20 21 21 30 64 est-timeout !!0d
d700: 65 70 74 68 21 21 0a 09 65 76 65 6e 74 2d 73 65 epth!!..event-se
d710: 6e 64 20 20 20 20 20 20 21 21 30 64 65 70 74 68 nd !!0depth
d720: 21 21 0a 09 6c 61 73 74 2d 70 61 63 6b 65 74 2d !!..last-packet-
d730: 74 6f 73 20 21 21 30 64 65 70 74 68 21 21 0a 20 tos !!0depth!!.
d740: 20 20 20 41 47 41 49 4e 20 3b 0a 0a 3a 20 63 72 AGAIN ;..: cr
d750: 65 61 74 65 2d 74 69 6d 65 6f 75 74 2d 74 61 73 eate-timeout-tas
d760: 6b 20 28 20 2d 2d 20 29 20 20 74 69 6d 65 6f 75 k ( -- ) timeou
d770: 74 2d 74 61 73 6b 20 3f 45 58 49 54 0a 20 20 20 t-task ?EXIT.
d780: 20 5b 27 5d 20 74 69 6d 65 6f 75 74 2d 6c 6f 6f ['] timeout-loo
d790: 70 20 31 20 6e 65 74 32 6f 2d 74 61 73 6b 20 74 p 1 net2o-task t
d7a0: 6f 20 74 69 6d 65 6f 75 74 2d 74 61 73 6b 20 3b o timeout-task ;
d7b0: 0a 0a 5c 20 70 61 63 6b 65 74 20 72 65 63 69 76 ..\ packet reciv
d7c0: 65 72 20 74 61 73 6b 0a 0a 3a 20 70 61 63 6b 65 er task..: packe
d7d0: 74 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 20 5c 20 t-loop ( -- ) \
d7e0: 31 20 73 74 69 63 6b 2d 74 6f 2d 63 6f 72 65 0a 1 stick-to-core.
d7f0: 20 20 20 20 42 45 47 49 4e 20 20 70 61 63 6b 65 BEGIN packe
d800: 74 2d 65 76 65 6e 74 20 20 21 21 30 64 65 70 74 t-event !!0dept
d810: 68 21 21 20 20 65 76 65 6e 74 2d 73 65 6e 64 20 h!! event-send
d820: 20 21 21 30 64 65 70 74 68 21 21 20 20 41 47 41 !!0depth!! AGA
d830: 49 4e 20 3b 0a 0a 69 6e 20 6e 65 74 32 6f 20 3a IN ;..in net2o :
d840: 20 72 65 71 75 65 73 74 2d 64 6f 6e 65 20 28 20 request-done (
d850: 6e 20 2d 2d 20 29 20 20 65 6c 69 74 2c 20 6f 20 n -- ) elit, o
d860: 65 6c 69 74 2c 20 3a 3e 72 65 71 75 65 73 74 20 elit, :>request
d870: 3b 0a 0a 3a 20 63 72 65 61 74 65 2d 72 65 63 65 ;..: create-rece
d880: 69 76 65 72 2d 74 61 73 6b 20 28 20 2d 2d 20 29 iver-task ( -- )
d890: 0a 20 20 20 20 5b 27 5d 20 70 61 63 6b 65 74 2d . ['] packet-
d8a0: 6c 6f 6f 70 20 31 20 6e 65 74 32 6f 2d 74 61 73 loop 1 net2o-tas
d8b0: 6b 20 74 6f 20 72 65 63 65 69 76 65 72 2d 74 61 k to receiver-ta
d8c0: 73 6b 20 3b 0a 0a 3a 20 65 76 65 6e 74 2d 6c 6f sk ;..: event-lo
d8d0: 6f 70 2d 74 61 73 6b 20 28 20 2d 2d 20 29 0a 20 op-task ( -- ).
d8e0: 20 20 20 72 65 63 65 69 76 65 72 2d 74 61 73 6b receiver-task
d8f0: 20 30 3d 20 49 46 20 20 63 72 65 61 74 65 2d 72 0= IF create-r
d900: 65 63 65 69 76 65 72 2d 74 61 73 6b 20 20 54 48 eceiver-task TH
d910: 45 4e 20 3b 0a 0a 3a 20 72 65 71 75 65 73 74 73 EN ;..: requests
d920: 2d 3e 30 20 28 20 2d 2d 20 29 20 72 65 71 75 65 ->0 ( -- ) reque
d930: 73 74 28 20 2e 22 20 77 61 69 74 20 72 65 71 6d st( ." wait reqm
d940: 61 73 6b 3d 22 20 6f 20 49 46 20 72 65 71 6d 61 ask=" o IF reqma
d950: 73 6b 20 40 20 68 65 78 2e 20 54 48 45 4e 20 63 sk @ hex. THEN c
d960: 72 20 29 0a 20 20 20 20 42 45 47 49 4e 20 20 73 r ). BEGIN s
d970: 74 6f 70 0a 09 6f 20 49 46 20 20 72 65 71 6d 61 top..o IF reqma
d980: 73 6b 20 40 20 66 69 6c 65 2d 63 6f 75 6e 74 20 sk @ file-count
d990: 40 20 6f 72 20 30 3d 20 28 20 72 65 71 63 6f 75 @ or 0= ( reqcou
d9a0: 6e 74 20 40 20 30 3d 20 61 6e 64 20 29 0a 09 45 nt @ 0= and )..E
d9b0: 4c 53 45 20 20 66 61 6c 73 65 20 20 54 48 45 4e LSE false THEN
d9c0: 0a 20 20 20 20 55 4e 54 49 4c 0a 20 20 20 20 6f . UNTIL. o
d9d0: 20 49 46 20 20 6f 2d 74 69 6d 65 6f 75 74 20 20 IF o-timeout
d9e0: 54 48 45 4e 20 20 72 65 71 75 65 73 74 28 20 2e THEN request( .
d9f0: 22 20 77 61 69 74 20 64 6f 6e 65 22 20 63 72 20 " wait done" cr
da00: 29 20 3b 0a 0a 3a 20 63 6c 69 65 6e 74 2d 6c 6f ) ;..: client-lo
da10: 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 20 21 74 op ( -- ). !t
da20: 69 63 6b 73 0a 20 20 20 20 63 6f 6e 6e 65 63 74 icks. connect
da30: 69 6f 6e 20 3e 6f 0a 20 20 20 20 6f 20 49 46 20 ion >o. o IF
da40: 20 75 70 40 20 77 61 69 74 2d 74 61 73 6b 20 21 up@ wait-task !
da50: 20 20 6f 2b 74 69 6d 65 6f 75 74 20 20 54 48 45 o+timeout THE
da60: 4e 0a 20 20 20 20 65 76 65 6e 74 2d 6c 6f 6f 70 N. event-loop
da70: 2d 74 61 73 6b 20 72 65 71 75 65 73 74 73 2d 3e -task requests->
da80: 30 20 6f 3e 20 3b 0a 0a 3a 20 73 65 72 76 65 72 0 o> ;..: server
da90: 2d 6c 6f 6f 70 20 28 20 2d 2d 20 29 0a 20 20 20 -loop ( -- ).
daa0: 20 30 20 3e 6f 20 72 64 72 6f 70 20 20 42 45 47 0 >o rdrop BEG
dab0: 49 4e 20 20 63 6c 69 65 6e 74 2d 6c 6f 6f 70 20 IN client-loop
dac0: 20 41 47 41 49 4e 20 3b 0a 0a 3a 20 73 65 72 76 AGAIN ;..: serv
dad0: 65 72 2d 6c 6f 6f 70 2d 63 61 74 63 68 20 28 20 er-loop-catch (
dae0: 2d 2d 20 29 0a 20 20 20 20 5b 27 5d 20 73 65 72 -- ). ['] ser
daf0: 76 65 72 2d 6c 6f 6f 70 20 63 61 74 63 68 0a 20 ver-loop catch.
db00: 20 20 20 64 75 70 20 23 2d 32 38 20 3c 3e 20 6f dup #-28 <> o
db10: 76 65 72 20 23 2d 35 36 20 3c 3e 20 61 6e 64 20 ver #-56 <> and
db20: 61 6e 64 20 74 68 72 6f 77 20 3b 0a 0a 5c 20 63 and throw ;..\ c
db30: 6c 69 65 6e 74 2f 73 65 72 76 65 72 20 69 6e 69 lient/server ini
db40: 74 69 61 6c 69 7a 65 72 0a 0a 44 65 66 65 72 20 tializer..Defer
db50: 69 6e 69 74 2d 72 65 73 74 0a 0a 3a 6e 6f 6e 61 init-rest..:nona
db60: 6d 65 20 28 20 70 6f 72 74 20 2d 2d 20 29 20 20 me ( port -- )
db70: 69 6e 69 74 2d 6d 79 6b 65 79 20 69 6e 69 74 2d init-mykey init-
db80: 6d 79 6b 65 79 20 5c 20 67 65 6e 65 72 61 74 65 mykey \ generate
db90: 20 74 77 6f 20 6b 65 79 73 0a 20 20 20 20 6d 79 two keys. my
dba0: 2d 30 6b 65 79 20 40 20 30 3d 20 49 46 20 20 69 -0key @ 0= IF i
dbb0: 6e 69 74 2d 6d 79 30 6b 65 79 20 20 54 48 45 4e nit-my0key THEN
dbc0: 20 20 69 6e 69 74 2d 68 65 61 64 65 72 2d 6b 65 init-header-ke
dbd0: 79 0a 20 20 20 20 5c 20 68 61 73 68 2d 69 6e 69 y. \ hash-ini
dbe0: 74 2d 72 6e 67 0a 20 20 20 20 69 6e 69 74 2d 74 t-rng. init-t
dbf0: 69 6d 65 72 20 6e 65 74 32 6f 2d 73 6f 63 6b 65 imer net2o-socke
dc00: 74 20 69 6e 69 74 2d 72 6f 75 74 65 20 70 72 65 t init-route pre
dc10: 70 2d 73 6f 63 6b 73 0a 20 20 20 20 73 65 6e 64 p-socks. send
dc20: 65 72 28 20 63 72 65 61 74 65 2d 73 65 6e 64 65 er( create-sende
dc30: 72 2d 74 61 73 6b 20 29 20 63 72 65 61 74 65 2d r-task ) create-
dc40: 74 69 6d 65 6f 75 74 2d 74 61 73 6b 20 3b 20 69 timeout-task ; i
dc50: 73 20 69 6e 69 74 2d 72 65 73 74 0a 0a 56 61 72 s init-rest..Var
dc60: 69 61 62 6c 65 20 69 6e 69 74 69 61 6c 69 7a 65 iable initialize
dc70: 64 0a 0a 3a 20 69 6e 69 74 2d 63 6c 69 65 6e 74 d..: init-client
dc80: 20 28 20 2d 2d 20 29 20 20 74 72 75 65 20 69 6e ( -- ) true in
dc90: 69 74 69 61 6c 69 7a 65 64 20 21 40 20 30 3d 20 itialized !@ 0=
dca0: 49 46 0a 09 69 6e 69 74 2d 64 69 72 73 20 20 63 IF..init-dirs c
dcb0: 6f 6e 66 69 67 3a 70 6f 72 74 23 20 40 20 20 69 onfig:port# @ i
dcc0: 6e 69 74 2d 72 65 73 74 20 20 54 48 45 4e 20 3b nit-rest THEN ;
dcd0: 0a 3a 20 69 6e 69 74 2d 73 65 72 76 65 72 20 28 .: init-server (
dce0: 20 2d 2d 20 29 20 20 74 72 75 65 20 69 6e 69 74 -- ) true init
dcf0: 69 61 6c 69 7a 65 64 20 21 40 20 30 3d 20 49 46 ialized !@ 0= IF
dd00: 0a 09 69 6e 69 74 2d 64 69 72 73 20 20 63 6f 6e ..init-dirs con
dd10: 66 69 67 3a 70 6f 72 74 23 20 40 20 6e 65 74 32 fig:port# @ net2
dd20: 6f 2d 70 6f 72 74 20 6f 76 65 72 20 73 65 6c 65 o-port over sele
dd30: 63 74 20 20 69 6e 69 74 2d 72 65 73 74 20 20 54 ct init-rest T
dd40: 48 45 4e 20 3b 0a 0a 5c 20 63 6f 6e 6e 65 63 74 HEN ;..\ connect
dd50: 69 6f 6e 20 63 6f 6f 6b 69 65 73 0a 0a 56 61 72 ion cookies..Var
dd60: 69 61 62 6c 65 20 63 6f 6f 6b 69 65 73 0a 0a 63 iable cookies..c
dd70: 6f 6f 6b 69 65 2d 73 69 7a 65 23 20 62 75 66 66 ookie-size# buff
dd80: 65 72 3a 20 74 6d 70 2d 63 6f 6f 6b 69 65 0a 0a er: tmp-cookie..
dd90: 3a 20 61 64 64 2d 63 6f 6f 6b 69 65 20 28 20 2d : add-cookie ( -
dda0: 2d 20 63 6f 6f 6b 69 65 36 34 20 29 0a 20 20 20 - cookie64 ).
ddb0: 20 5b 3a 20 74 69 63 6b 73 20 36 34 64 75 70 20 [: ticks 64dup
ddc0: 5b 20 74 6d 70 2d 63 6f 6f 6b 69 65 20 2e 63 63 [ tmp-cookie .cc
ddd0: 2d 74 69 6d 65 6f 75 74 20 5d 4c 20 36 34 21 0a -timeout ]L 64!.
dde0: 09 6f 20 5b 20 74 6d 70 2d 63 6f 6f 6b 69 65 20 .o [ tmp-cookie
ddf0: 2e 63 63 2d 63 6f 6e 74 65 78 74 20 5d 4c 20 21 .cc-context ]L !
de00: 0a 09 74 6d 70 2d 63 6f 6f 6b 69 65 20 63 6f 6f ..tmp-cookie coo
de10: 6b 69 65 2d 73 69 7a 65 23 20 20 63 6f 6f 6b 69 kie-size# cooki
de20: 65 73 20 24 2b 21 20 3b 5d 0a 20 20 20 20 72 65 es $+! ;]. re
de30: 73 69 7a 65 2d 73 65 6d 61 20 63 2d 73 65 63 74 size-sema c-sect
de40: 69 6f 6e 20 3b 0a 0a 3a 20 64 6f 2d 3f 63 6f 6f ion ;..: do-?coo
de50: 6b 69 65 20 28 20 63 6f 6f 6b 69 65 20 2d 2d 20 kie ( cookie --
de60: 63 6f 6e 74 65 78 74 20 74 72 75 65 20 2f 20 66 context true / f
de70: 61 6c 73 65 20 29 0a 20 20 20 20 74 69 63 6b 65 alse ). ticke
de80: 72 20 36 34 40 20 63 6f 6e 6e 65 63 74 2d 74 69 r 64@ connect-ti
de90: 6d 65 6f 75 74 23 20 36 34 2d 20 7b 20 36 34 3a meout# 64- { 64:
dea0: 20 74 69 6d 65 6f 75 74 20 7d 0a 20 20 20 20 63 timeout }. c
deb0: 6f 6f 6b 69 65 73 20 24 40 20 62 6f 75 6e 64 73 ookies $@ bounds
dec0: 20 3f 44 4f 0a 09 36 34 64 75 70 20 49 20 2e 63 ?DO..64dup I .c
ded0: 63 2d 74 69 6d 65 6f 75 74 20 36 34 40 20 36 34 c-timeout 64@ 64
dee0: 3d 20 49 46 20 5c 20 69 66 20 77 65 20 68 61 76 = IF \ if we hav
def0: 65 20 61 20 68 69 74 2c 20 75 73 65 20 74 68 61 e a hit, use tha
df00: 74 0a 09 20 20 20 20 36 34 64 72 6f 70 20 49 20 t.. 64drop I
df10: 2e 63 63 2d 63 6f 6e 74 65 78 74 20 40 0a 09 20 .cc-context @..
df20: 20 20 20 49 20 2e 63 63 2d 73 65 63 72 65 74 20 I .cc-secret
df30: 5b 20 74 6d 70 2d 63 6f 6f 6b 69 65 20 2e 63 63 [ tmp-cookie .cc
df40: 2d 73 65 63 72 65 74 20 5d 4c 20 4b 45 59 42 59 -secret ]L KEYBY
df50: 54 45 53 20 6d 6f 76 65 0a 09 20 20 20 20 63 6f TES move.. co
df60: 6f 6b 69 65 73 20 49 20 63 6f 6f 6b 69 65 2d 73 okies I cookie-s
df70: 69 7a 65 23 20 64 65 6c 24 6f 6e 65 20 64 72 6f ize# del$one dro
df80: 70 0a 09 20 20 20 20 75 6e 6c 6f 6f 70 20 20 64 p.. unloop d
df90: 75 70 20 49 46 20 20 74 72 75 65 20 20 54 48 45 up IF true THE
dfa0: 4e 20 20 45 58 49 54 0a 09 54 48 45 4e 0a 09 49 N EXIT..THEN..I
dfb0: 20 2e 63 63 2d 74 69 6d 65 6f 75 74 20 36 34 40 .cc-timeout 64@
dfc0: 20 74 69 6d 65 6f 75 74 20 36 34 75 3c 20 49 46 timeout 64u< IF
dfd0: 0a 09 20 20 20 20 63 6f 6f 6b 69 65 73 20 49 20 .. cookies I
dfe0: 63 6f 6f 6b 69 65 2d 73 69 7a 65 23 20 64 65 6c cookie-size# del
dff0: 24 6f 6e 65 0a 09 20 20 20 20 63 6f 6f 6b 69 65 $one.. cookie
e000: 73 20 6e 65 78 74 24 0a 09 20 20 20 20 75 6e 6c s next$.. unl
e010: 6f 6f 70 20 20 3f 44 4f 20 20 4e 4f 50 45 20 5c oop ?DO NOPE \
e020: 20 74 68 69 73 20 72 65 70 6c 61 63 65 73 20 74 this replaces t
e030: 68 65 20 6c 6f 6f 70 20 76 61 72 69 61 62 6c 65 he loop variable
e040: 73 0a 09 20 20 20 20 30 20 5c 20 77 65 20 72 65 s.. 0 \ we re
e050: 2d 69 74 65 72 61 74 65 20 6f 76 65 72 20 74 68 -iterate over th
e060: 65 20 65 78 61 63 74 6c 79 20 73 61 6d 65 20 69 e exactly same i
e070: 6e 64 65 78 0a 09 45 4c 53 45 0a 09 20 20 20 20 ndex..ELSE..
e080: 63 6f 6f 6b 69 65 2d 73 69 7a 65 23 0a 09 54 48 cookie-size#..TH
e090: 45 4e 0a 20 20 20 20 2b 4c 4f 4f 50 20 20 36 34 EN. +LOOP 64
e0a0: 64 72 6f 70 20 30 20 3b 0a 0a 3a 20 3f 63 6f 6f drop 0 ;..: ?coo
e0b0: 6b 69 65 20 28 20 63 6f 6f 6b 69 65 20 2d 2d 20 kie ( cookie --
e0c0: 63 6f 6e 74 65 78 74 20 74 72 75 65 20 2f 20 66 context true / f
e0d0: 61 6c 73 65 20 29 0a 20 20 20 20 5b 27 5d 20 64 alse ). ['] d
e0e0: 6f 2d 3f 63 6f 6f 6b 69 65 20 72 65 73 69 7a 65 o-?cookie resize
e0f0: 2d 73 65 6d 61 20 63 2d 73 65 63 74 69 6f 6e 20 -sema c-section
e100: 3b 0a 0a 3a 20 63 6f 6f 6b 69 65 3e 63 6f 6e 74 ;..: cookie>cont
e110: 65 78 74 3f 20 28 20 63 6f 6f 6b 69 65 20 2d 2d ext? ( cookie --
e120: 20 63 6f 6e 74 65 78 74 20 74 72 75 65 20 2f 20 context true /
e130: 66 61 6c 73 65 20 29 0a 20 20 20 20 3f 63 6f 6f false ). ?coo
e140: 6b 69 65 20 6f 76 65 72 20 30 3d 20 6f 76 65 72 kie over 0= over
e150: 20 61 6e 64 20 49 46 0a 09 6e 69 70 20 6e 65 74 and IF..nip net
e160: 32 6f 3a 6e 65 77 2d 63 6f 6e 74 65 78 74 20 73 2o:new-context s
e170: 77 61 70 0a 20 20 20 20 54 48 45 4e 20 3b 0a 0a wap. THEN ;..
e180: 3a 20 61 64 6a 75 73 74 2d 74 69 63 6b 73 20 28 : adjust-ticks (
e190: 20 74 69 6d 65 20 2d 2d 20 29 20 20 6f 20 30 3d time -- ) o 0=
e1a0: 20 49 46 20 20 36 34 64 72 6f 70 20 20 45 58 49 IF 64drop EXI
e1b0: 54 20 20 54 48 45 4e 0a 20 20 20 20 72 65 63 76 T THEN. recv
e1c0: 2d 74 69 63 6b 20 36 34 40 20 36 34 2d 20 72 74 -tick 64@ 64- rt
e1d0: 64 65 6c 61 79 20 36 34 40 20 36 34 64 75 70 20 delay 64@ 64dup
e1e0: 36 34 2d 30 3c 3e 20 3e 72 20 36 34 2d 32 2f 0a 64-0<> >r 64-2/.
e1f0: 20 20 20 20 36 34 6f 76 65 72 20 36 34 61 62 73 64over 64abs
e200: 20 36 34 6f 76 65 72 20 36 34 3e 20 72 3e 20 61 64over 64> r> a
e210: 6e 64 20 49 46 0a 09 36 34 2b 20 61 64 6a 75 73 nd IF..64+ adjus
e220: 74 2d 74 69 6d 65 72 28 20 2e 22 20 61 64 6a 75 t-timer( ." adju
e230: 73 74 20 74 69 6d 65 72 3a 20 22 20 36 34 64 75 st timer: " 64du
e240: 70 20 75 36 34 2e 20 66 6f 72 74 68 3a 63 72 20 p u64. forth:cr
e250: 29 0a 09 74 69 63 6b 2d 61 64 6a 75 73 74 20 36 )..tick-adjust 6
e260: 34 21 0a 20 20 20 20 45 4c 53 45 0a 09 36 34 2b 4!. ELSE..64+
e270: 20 61 64 6a 75 73 74 2d 74 69 6d 65 72 28 20 2e adjust-timer( .
e280: 22 20 64 6f 6e 27 74 20 61 64 6a 75 73 74 20 74 " don't adjust t
e290: 69 6d 65 72 3a 20 22 20 36 34 64 75 70 20 75 36 imer: " 64dup u6
e2a0: 34 2e 20 66 6f 72 74 68 3a 63 72 20 29 0a 09 36 4. forth:cr )..6
e2b0: 34 64 72 6f 70 20 20 54 48 45 4e 20 3b 0a 0a 5c 4drop THEN ;..\
e2c0: 20 6c 6f 61 64 20 6e 65 74 32 6f 20 70 6c 75 67 load net2o plug
e2d0: 69 6e 73 3a 20 66 69 72 73 74 20 6f 6e 65 20 77 ins: first one w
e2e0: 69 74 68 20 69 6e 74 65 67 72 61 64 65 64 20 63 ith integraded c
e2f0: 6f 6d 6d 61 6e 64 20 73 70 61 63 65 0a 0a 72 65 ommand space..re
e300: 71 75 69 72 65 20 6e 6f 74 69 66 79 2e 66 73 0a quire notify.fs.
e310: 72 65 71 75 69 72 65 20 63 6d 64 2e 66 73 0a 72 require cmd.fs.r
e320: 65 71 75 69 72 65 20 63 6f 6e 6e 65 63 74 2e 66 equire connect.f
e330: 73 0a 72 65 71 75 69 72 65 20 63 6f 6e 6e 65 63 s.require connec
e340: 74 65 64 2e 66 73 0a 72 65 71 75 69 72 65 20 6c ted.fs.require l
e350: 6f 67 2e 66 73 0a 72 65 71 75 69 72 65 20 6b 65 og.fs.require ke
e360: 79 73 2e 66 73 0a 72 65 71 75 69 72 65 20 61 64 ys.fs.require ad
e370: 64 72 2e 66 73 0a 72 65 71 75 69 72 65 20 64 68 dr.fs.require dh
e380: 74 2e 66 73 0a 72 65 71 75 69 72 65 20 76 61 75 t.fs.require vau
e390: 6c 74 2e 66 73 0a 72 65 71 75 69 72 65 20 6d 73 lt.fs.require ms
e3a0: 67 2e 66 73 0a 72 65 71 75 69 72 65 20 68 65 6c g.fs.require hel
e3b0: 70 65 72 2e 66 73 0a 72 65 71 75 69 72 65 20 71 per.fs.require q
e3c0: 72 2e 66 73 0a 5c 20 72 65 71 75 69 72 65 20 74 r.fs.\ require t
e3d0: 65 72 6d 2e 66 73 0a 72 65 71 75 69 72 65 20 64 erm.fs.require d
e3e0: 76 63 73 2e 66 73 0a 72 65 71 75 69 72 65 20 73 vcs.fs.require s
e3f0: 71 75 69 64 2e 66 73 0a 0a 5c 20 63 6f 6e 66 69 quid.fs..\ confi
e400: 67 75 72 61 74 69 6f 6e 20 73 74 75 66 66 0a 0a guration stuff..
e410: 72 65 71 75 69 72 65 20 64 68 74 72 6f 6f 74 2e require dhtroot.
e420: 66 73 20 5c 20 63 6f 6e 66 69 67 75 72 61 74 69 fs \ configurati
e430: 6f 6e 20 66 6f 72 20 44 48 54 20 72 6f 6f 74 0a on for DHT root.
e440: 0a 5c 20 66 72 65 65 7a 65 20 74 61 62 6c 65 73 .\ freeze tables
e450: 0a 0a 63 6f 6e 74 65 78 74 2d 74 61 62 6c 65 20 ..context-table
e460: 20 20 24 73 61 76 65 0a 0a 5c 20 73 68 6f 77 20 $save..\ show
e470: 70 72 6f 62 6c 65 6d 73 0a 0a 2e 75 6e 72 65 73 problems...unres
e480: 6f 6c 76 65 64 0a 0a 5c 5c 5c 0a 4c 6f 63 61 6c olved..\\\.Local
e490: 20 56 61 72 69 61 62 6c 65 73 3a 0a 66 6f 72 74 Variables:.fort
e4a0: 68 2d 6c 6f 63 61 6c 2d 77 6f 72 64 73 3a 0a 20 h-local-words:.
e4b0: 20 20 20 28 0a 20 20 20 20 20 28 28 22 6e 65 74 (. (("net
e4c0: 32 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 2o:" "+net2o:")
e4d0: 64 65 66 69 6e 69 74 69 6f 6e 2d 73 74 61 72 74 definition-start
e4e0: 65 72 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 6b 65 er (font-lock-ke
e4f0: 79 77 6f 72 64 2d 66 61 63 65 20 2e 20 31 29 0a yword-face . 1).
e500: 20 20 20 20 20 20 22 5b 20 5c 74 5c 6e 5d 22 20 "[ \t\n]"
e510: 74 20 6e 61 6d 65 20 28 66 6f 6e 74 2d 6c 6f 63 t name (font-loc
e520: 6b 2d 66 75 6e 63 74 69 6f 6e 2d 6e 61 6d 65 2d k-function-name-
e530: 66 61 63 65 20 2e 20 33 29 29 0a 20 20 20 20 20 face . 3)).
e540: 28 28 22 36 34 66 69 65 6c 64 3a 22 29 20 6e 6f (("64field:") no
e550: 6e 2d 69 6d 6d 65 64 69 61 74 65 20 28 66 6f 6e n-immediate (fon
e560: 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d 66 61 63 65 t-lock-type-face
e570: 20 2e 20 32 29 0a 20 20 20 20 20 20 22 5b 20 5c . 2). "[ \
e580: 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 28 66 6f t\n]" t name (fo
e590: 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 61 62 6c 65 nt-lock-variable
e5a0: 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 33 29 29 -name-face . 3))
e5b0: 0a 20 20 20 20 20 28 28 22 68 61 73 68 3a 22 29 . (("hash:")
e5c0: 20 6e 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 20 28 non-immediate (
e5d0: 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d 66 font-lock-type-f
e5e0: 61 63 65 20 2e 20 32 29 0a 20 20 20 20 20 20 22 ace . 2). "
e5f0: 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 20 [ \t\n]" t name
e600: 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 61 (font-lock-varia
e610: 62 6c 65 2d 6e 61 6d 65 2d 66 61 63 65 20 2e 20 ble-name-face .
e620: 33 29 29 0a 20 20 20 20 20 28 28 22 77 69 74 68 3)). (("with
e630: 22 29 20 63 6f 6d 70 69 6c 65 2d 6f 6e 6c 79 20 ") compile-only
e640: 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 79 70 65 2d (font-lock-type-
e650: 66 61 63 65 20 2e 20 32 29 0a 20 20 20 20 20 20 face . 2).
e660: 22 5b 20 5c 74 5c 6e 5d 22 20 74 20 6e 61 6d 65 "[ \t\n]" t name
e670: 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 76 61 72 69 (font-lock-vari
e680: 61 62 6c 65 2d 6e 61 6d 65 2d 66 61 63 65 20 2e able-name-face .
e690: 20 33 29 29 0a 20 20 20 20 20 28 28 22 65 6e 64 3)). (("end
e6a0: 77 69 74 68 22 29 20 63 6f 6d 70 69 6c 65 2d 6f with") compile-o
e6b0: 6e 6c 79 20 28 66 6f 6e 74 2d 6c 6f 63 6b 2d 74 nly (font-lock-t
e6c0: 79 70 65 2d 66 61 63 65 20 2e 20 32 29 29 0a 20 ype-face . 2)).
e6d0: 20 20 20 29 0a 66 6f 72 74 68 2d 6c 6f 63 61 6c ).forth-local
e6e0: 2d 69 6e 64 65 6e 74 2d 77 6f 72 64 73 3a 0a 20 -indent-words:.
e6f0: 20 20 20 28 0a 20 20 20 20 28 28 22 6e 65 74 32 (. (("net2
e700: 6f 3a 22 20 22 2b 6e 65 74 32 6f 3a 22 29 20 28 o:" "+net2o:") (
e710: 30 20 2e 20 32 29 20 28 30 20 2e 20 32 29 20 6e 0 . 2) (0 . 2) n
e720: 6f 6e 2d 69 6d 6d 65 64 69 61 74 65 29 0a 20 20 on-immediate).
e730: 20 20 28 28 22 77 69 74 68 22 29 20 28 30 20 2e (("with") (0 .
e740: 20 32 29 20 28 30 20 2e 20 32 29 20 63 6f 6d 70 2) (0 . 2) comp
e750: 69 6c 65 2d 6f 6e 6c 79 29 0a 20 20 20 20 28 28 ile-only). ((
e760: 22 65 6e 64 77 69 74 68 22 29 20 28 2d 32 20 2e "endwith") (-2 .
e770: 20 30 29 20 28 30 20 2e 20 2d 32 29 20 63 6f 6d 0) (0 . -2) com
e780: 70 69 6c 65 2d 6f 6e 6c 79 29 0a 20 20 20 20 29 pile-only). )
e790: 0a 45 6e 64 3a 0a 5b 54 48 45 4e 5d 0a .End:.[THEN].