Check-in [d28b8a6dcf]
Not logged in

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

Overview
Comment:use local tail/back for n2o:spit
Timelines: family | ancestors | trunk | closed
Files: files | file ages | folders
SHA1: d28b8a6dcf099d049566ff1b386f407bc78e877b
User & Date: bernd 2017-09-24 00:19:20
Context
2017-09-24
00:19
use local tail/back for n2o:spit Closed-Leaf check-in: d28b8a6dcf user: bernd tags: trunk, closed
2017-09-23
00:06
rewind partial for sender check-in: f193c94ee2 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to net2o-crypt.fs.

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
    keccak#max negate and c:prng
    2r> dup IF
	keccak#max addr dest-ivsrest$ $!len  dest-ivsrest$ c:prng
	rest+
    THEN  2drop ;

: regen-ivs-part ( new-back old-back -- )
    [: c:key@ >r
	dest-ivsgen kalign
	regen( ." regen-ivs-part " dest-back hex. over hex. dup c:key# .nnb cr )
	c:key!
	U+DO
	    I I' fix-size dup { len }
	    addr>keys >r addr>keys >r dest-ivs$ r> safe/string r> umin
	    rest-prng
	len +LOOP
	regen( ." regen-ivs-part' " dest-ivsgen kalign c:key# .nnb cr )
	r> c:key! ;] regen-sema c-section ;







<
|
<
<







274
275
276
277
278
279
280

281


282
283
284
285
286
287
288
    keccak#max negate and c:prng
    2r> dup IF
	keccak#max addr dest-ivsrest$ $!len  dest-ivsrest$ c:prng
	rest+
    THEN  2drop ;

: regen-ivs-part ( new-back old-back -- )

    [: c:key@ >r dest-ivsgen kalign c:key!


	U+DO
	    I I' fix-size dup { len }
	    addr>keys >r addr>keys >r dest-ivs$ r> safe/string r> umin
	    rest-prng
	len +LOOP
	regen( ." regen-ivs-part' " dest-ivsgen kalign c:key# .nnb cr )
	r> c:key! ;] regen-sema c-section ;

Changes to net2o-file.fs.

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364

365
366
367
368
369
370
371
372
    r@ @ id>addr nip 0<= IF  r@ off  THEN  rdrop ;

: fstates ( -- n )  file-state $@len cell/ ;

: fstate-off ( -- )  file-state @ 0= ?EXIT
    file-state $@ bounds ?DO  I @ .dispose  cell +LOOP
    file-state $free ;
: n2o:save-block ( id -- delta )
    rdata-back@ file( over data-rmap .mapc:dest-raddr - >r
    2 pick dup >r id>addr? .fs-seek 64@ #10 64rshift 64>n >r )
    rot id>addr? .fs-write dup /back
    file( dup IF ." file write: "
    r> r> . hex. r> hex. dup hex. residualwrite @ hex. forth:cr
    ELSE  rdrop rdrop rdrop  THEN ) ;

\ careful: must follow exactly the same logic as slurp (see below)

: n2o:spit { tail back -- }
    back tail u< 0= ?EXIT fstates 0= ?EXIT
    slurp( ." spit: " rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr )
    back tail [: { back tail } +calc fstates 0 { states fails }
	BEGIN  back tail u<  WHILE
		write-file# @ n2o:save-block dup >blockalign +to back

		IF 0 ELSE fails 1+ residualwrite off THEN to fails
		residualwrite @ 0= IF
		    write-file# file+ blocksize @ residualwrite !  THEN
	    fails states u>= UNTIL
	THEN
	msg( ." Write end" cr ) +file
	fails states u>= IF  max/back  THEN \ if all files are done, align
    ;] file-sema c-section







|
|
|
|

|
|




|


|

|
>
|







341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
    r@ @ id>addr nip 0<= IF  r@ off  THEN  rdrop ;

: fstates ( -- n )  file-state $@len cell/ ;

: fstate-off ( -- )  file-state @ 0= ?EXIT
    file-state $@ bounds ?DO  I @ .dispose  cell +LOOP
    file-state $free ;
: n2o:save-block ( back tail id -- delta )
    { id } rdata-fix file( over data-rmap .mapc:dest-raddr - >r
    id id>addr? .fs-seek 64@ #10 64rshift 64>n >r )
    id id>addr? .fs-write dup /back
    file( dup IF ." file write: "
    r> id . hex. r> hex. dup hex. residualwrite @ hex. forth:cr
    ELSE  rdrop rdrop  THEN ) ;

\ careful: must follow exactly the same logic as slurp (see below)

: n2o:spit { tail back -- }
    back tail u>= ?EXIT fstates 0= ?EXIT
    slurp( ." spit: " rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
    write-file# ? residualwrite @ hex. forth:cr )
    tail back [: { tail back } +calc fstates 0 { states fails }
	BEGIN  back tail u<  WHILE
		back tail write-file# @ n2o:save-block dup
		IF    >blockalign +to back 0
		ELSE  drop fails 1+ residualwrite off THEN to fails
		residualwrite @ 0= IF
		    write-file# file+ blocksize @ residualwrite !  THEN
	    fails states u>= UNTIL
	THEN
	msg( ." Write end" cr ) +file
	fails states u>= IF  max/back  THEN \ if all files are done, align
    ;] file-sema c-section

Changes to net2o.fs.

598
599
600
601
602
603
604




605
606
607
608
609
610
611
....
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
    dest-head dest-back dest-size + fix-size raddr+ endwith
    residualread @ umin ;
: rdata-back@ ( -- addr u )
    \G you can write from this, also a block at a time
    data-rmap with mapc
    dest-back dest-tail fix-size raddr+ endwith
    residualwrite @ umin ;




: data-tail@ ( -- addr u )
    \G you can send from this - as long as you stay block aligned
    data-map with mapc
    dest-raddr dest-tail dest-head fix-size' endwith ;

: data-head? ( -- flag )
    \G return true if there is space to read data in
................................................................................
    dest-timestamps over erase
    data-resend# @ swap $FF fill ;
data-class to rewind-timestamps
:noname ( o:map -- ) dest-size addr>ts
    dest-timestamps over erase ;
rdata-class to rewind-timestamps

: rewind-ts-partial ( new-back old-back back addr o:map -- )
    { addr } swap addr>ts swap addr>ts U+DO
	I I' fix-tssize	{ len } addr + len erase
    len +LOOP ;
:noname ( new-back old-back o:map -- )
    2dup data-resend# @ rewind-ts-partial
    2dup dest-timestamps rewind-ts-partial
    regen-ivs-part ;







>
>
>
>







 







|







598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
....
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
    dest-head dest-back dest-size + fix-size raddr+ endwith
    residualread @ umin ;
: rdata-back@ ( -- addr u )
    \G you can write from this, also a block at a time
    data-rmap with mapc
    dest-back dest-tail fix-size raddr+ endwith
    residualwrite @ umin ;
: rdata-fix ( back tail -- addr u )
    \G you can write from this, also a block at a time
    data-rmap with mapc fix-size raddr+ endwith
    residualwrite @ umin ;
: data-tail@ ( -- addr u )
    \G you can send from this - as long as you stay block aligned
    data-map with mapc
    dest-raddr dest-tail dest-head fix-size' endwith ;

: data-head? ( -- flag )
    \G return true if there is space to read data in
................................................................................
    dest-timestamps over erase
    data-resend# @ swap $FF fill ;
data-class to rewind-timestamps
:noname ( o:map -- ) dest-size addr>ts
    dest-timestamps over erase ;
rdata-class to rewind-timestamps

: rewind-ts-partial ( new-back old-back addr o:map -- )
    { addr } swap addr>ts swap addr>ts U+DO
	I I' fix-tssize	{ len } addr + len erase
    len +LOOP ;
:noname ( new-back old-back o:map -- )
    2dup data-resend# @ rewind-ts-partial
    2dup dest-timestamps rewind-ts-partial
    regen-ivs-part ;