Check-in [bef65e85ed]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:More work on fetching hashes (untested)
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: bef65e85ede484df2d37a341506463accdaf78ae
User & Date: bernd 2020-05-19 11:07:14
Context
2020-05-19
21:18
More work on better hash object fetching check-in: 4d5f84ca9e user: bernd tags: trunk
11:07
More work on fetching hashes (untested) check-in: bef65e85ed user: bernd tags: trunk
2020-05-18
22:15
Start rewriting fetcher logic check-in: f66c4846a2 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to msg.fs.

605
606
607
608
609
610
611

612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644








645
646
647
648
649
650
651
...
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
    I I' over - x-size  +LOOP  drop ;
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    pk .key-id ." : " perm 64@ 64>n .perms space
; msg-class is msg:perms

event: :>hash-finished { d: hash -- }

    hash fetch-finish# #@ dup IF
	bounds U+DO
	    I @ >r hash r@ execute r> >addr free throw
	cell +LOOP
	last# bucket-off
    ELSE  2drop  THEN
    hash >ihave  hash drop free throw ;

: fetch-queue ( task want# -- )
    0 .pk.host $make { tsk w^ want# w^ pk$ -- }
    want# tsk pk$ [{: tsk pk$ :}l { item }
	item $@ pk$ $@ str= ?EXIT
	item $@ $8 $E pk-connect? IF  +resend +flow-control
	    { | hashs }
	    item cell+ $@ bounds U+DO
		net2o-code expect+slurp $10 blocksize! $A blockalign!
		I' I U+DO
		    I keysize have# $@ dup IF
			0 -rot bounds U+DO
			    I $@ pk$ $@ str= or
			cell +LOOP
		    ELSE  2drop true  THEN
		    IF
			I keysize net2o:copy#
			I keysize save-mem tsk [{: d: hash tsk :}h
			    <event hash e$, :>hash-finished tsk event> ;]
			lastfile@ >o to file-xt o>
			1 +to hashs
		    THEN
		    hashs $10 u>= ?LEAVE
		keysize +LOOP
		end-code| net2o:close-all
	    keysize hashs *  0 to hashs  +LOOP








	    disconnect-me
	THEN ;] #map
    want# #frees
    pk$ $free ;

: fetch>want ( -- want# )
    { | w^ want# }
................................................................................
fetcher-class ' new static-a with-allocater Constant fetcher-prototype
: >fetch# ( addr u -- )
    [:  2dup fetch# #@ d0= IF
	    fetcher-prototype cell- [ fetcher-class >osize @ cell+ ]L
	    2over fetch# #!
	THEN ;] resize-sema c-section  2drop ;

event: :>fetch-queue ( queue[] -- )
    { w^ queue[] } queue[] ['] >fetch# $[]map
    fetch-queue ;

: transmit-queue ( queue -- )
    <event up@ elit, elit, :>fetch-queue ?query-task event> ;

Variable queue?
event: :>queued ( queue -- )
    0 fetch-queue[] !@ queue? off transmit-queue ;







>








|
<
<
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>







 







|

|







605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621




622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
...
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
    I I' over - x-size  +LOOP  drop ;
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    pk .key-id ." : " perm 64@ 64>n .perms space
; msg-class is msg:perms

event: :>hash-finished { d: hash -- }
    hash fetch# #@ IF  cell+ .fetcher:got-it  ELSE  drop  THEN
    hash fetch-finish# #@ dup IF
	bounds U+DO
	    I @ >r hash r@ execute r> >addr free throw
	cell +LOOP
	last# bucket-off
    ELSE  2drop  THEN
    hash >ihave  hash drop free throw ;

: fetch-hashs ( addr u tsk pk$ -- )




    { tsk pk$ | hashs }
    bounds U+DO
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	I' I U+DO
	    false  I keysize have# $@ dup IF
		bounds U+DO
		    I $@ pk$ $@ str= or
		cell +LOOP
	    ELSE  2drop  THEN
	    IF
		I keysize net2o:copy#
		I keysize save-mem tsk [{: d: hash tsk :}h
		    <event hash e$, :>hash-finished tsk event> ;]
		lastfile@ >o to file-xt o>
		1 +to hashs
	    THEN
	    hashs $10 u>= ?LEAVE
	keysize +LOOP
	end-code| net2o:close-all
    keysize hashs *  0 to hashs  +LOOP ;

: fetch-queue ( task want# -- )
    0 .pk.host $make { tsk w^ want# w^ pk$ -- }
    want# tsk pk$ [{: tsk pk$ :}l { item }
	item $@ pk$ $@ str= ?EXIT \ don't fetch from myself
	item $@ $8 $E pk-connect? IF
	    +resend +flow-control
	    item cell+ $@ tsk item fetch-hashs
	    disconnect-me
	THEN ;] #map
    want# #frees
    pk$ $free ;

: fetch>want ( -- want# )
    { | w^ want# }
................................................................................
fetcher-class ' new static-a with-allocater Constant fetcher-prototype
: >fetch# ( addr u -- )
    [:  2dup fetch# #@ d0= IF
	    fetcher-prototype cell- [ fetcher-class >osize @ cell+ ]L
	    2over fetch# #!
	THEN ;] resize-sema c-section  2drop ;

event: :>fetch-queue ( tsk queue[] -- )
    { w^ queue[] } queue[] ['] >fetch# $[]map
    fetch>want fetch-queue ;

: transmit-queue ( queue -- )
    <event up@ elit, elit, :>fetch-queue ?query-task event> ;

Variable queue?
event: :>queued ( queue -- )
    0 fetch-queue[] !@ queue? off transmit-queue ;