clean up write/skip

This commit is contained in:
~d6 2024-09-18 21:07:42 -04:00
parent 7b75c65087
commit 873ced6cbf
1 changed files with 42 additions and 66 deletions

108
tar.tal
View File

@ -158,12 +158,48 @@
#0001 .File2/w DEO2 #0001 .File2/w DEO2
!expand-entries !expand-entries
( src and dst should be paths )
@compress-entries ( src* dst* -> )
POP2 POP2 JMP2r
( writes `n` bytes from File1 to File2 ) ( writes `n` bytes from File1 to File2 )
( uses a 32k internal buffer ) ( uses a 32k internal buffer )
@write ( carry^ hi* lo* -> ) @write ( carry^ hi* lo* -> )
write-lo ;write-buf ;write-lo/writer STA2
write-hi write-lo write-hi ?write-4g JMP2r
?write-4g JMP2r
( writes up to 32768 bytes of; limited by the size of buf )
@write-buf ( n* -> )
ORAk ?{ POP2 JMP2r } ( n* )
DUP2 .File1/len DEO2 ( n* )
;buffer .File1/r DEO2 ( n* )
DUP2 .File1/ok DEI2 EQU2 ?&ok ( n* )
POP2 ;read-error print !panic ( )
&ok ( n* )
DUP2 .File2/len DEO2 ( n* )
;buffer .File2/w DEO2 ( n* )
.File2/ok DEI2 EQU2 ?&ok2 ( )
;write-error print !panic ( )
&ok2 JMP2r ( )
( skips `n` bytes forward in File1, specified as a 5-byte integer )
( )
( since we can only actually read 32k at a time, and since we can )
( only easily work with 2-byte shorts, we first read the lowest )
( two bytes and skip that much. then, for the higher byte, we can )
( do two skips of 32k for each unit found. )
@skip ( carry^ hi* lo* -> )
;skip-buf ;write-lo/writer STA2
write-lo write-hi ?write-4g JMP2r
( skips up to 32768 bytes of; limited by the size of buf )
@skip-buf ( n* -> )
ORAk ?{ POP2 JMP2r }
DUP2 .File1/len DEO2
;buffer .File1/r DEO2
.File1/ok DEI2 EQU2 ?&ok
;read-error print !panic
&ok JMP2r
( unconditionally write 4GiB, that is 4294967296 bytes ) ( unconditionally write 4GiB, that is 4294967296 bytes )
@write-4g ( -> ) write-2g ( >> ) @write-4g ( -> ) write-2g ( >> )
@ -184,71 +220,11 @@
@write-64k ( -> ) write-32k ( >> ) @write-64k ( -> ) write-32k ( >> )
( writes exactly 32768 bytes ) ( writes exactly 32768 bytes )
@write-32k ( -> ) #8000 !write-buf @write-32k ( -> ) #8000 ( >> )
( write up to 65536 bytes ) ( write up to 65536 bytes )
@write-lo ( lo* -> ) @write-lo ( lo* -> )
DUP2 #8001 LTH2 ?{ write-32k #8000 SUB2 } !write-buf DUP2 #8001 LTH2 ?{ write-32k #8000 SUB2 } LIT2 [ &writer =write-buf ] JMP2
( writes up to 32768 bytes of; limited by the size of buf )
@write-buf ( n* -> )
ORAk ?{ POP2 JMP2r } ( n* )
DUP2 .File1/len DEO2 ( n* )
;buffer .File1/r DEO2 ( n* )
DUP2 .File1/ok DEI2 EQU2 ?&ok ( n* )
POP2 ;read-error print !panic ( )
&ok ( n* )
DUP2 .File2/len DEO2 ( n* )
;buffer .File2/w DEO2 ( n* )
.File2/ok DEI2 EQU2 ?&ok2 ( )
;write-error print !panic ( )
&ok2 JMP2r ( )
( skips `n` bytes forward in File1, specified as a 5-byte integer )
( )
( since we can only actually read 32k at a time, and since we can )
( only easily work with 2-byte shorts, we first read the lowest )
( two bytes and skip that much. then, for the higher byte, we can )
( do two skips of 32k for each unit found. )
@skip ( carry^ hi* lo* -> )
skip-lo ( carry^ hi* )
skip-hi ( carry^ )
?skip-4g JMP2r ( )
( unconditionally skip 4GiB, that is 4294967296 bytes )
@skip-4g ( -> ) skip-2g ( >> )
( unconditionally skip 2GiB, that is 2147483648 bytes )
@skip-2g ( -> ) #8000 !skip-hi
( skips `hi*65536` bytes )
( - 0001 will skip 65536 bytes )
( - 0010 will skip 1048576 bytes )
( - ffff will skip 4294901760 bytes )
@skip-hi ( hi* -> )
#0000 SWP2 SUB2 ( -hi* )
&loop ORAk ?&ok POP2 JMP2r ( )
&ok skip-64k INC2 !&loop ( -hi+1* )
( skips exactly 65536 bytes )
@skip-64k ( -> ) skip-32k ( >> )
( skips exactly 32768 bytes )
@skip-32k ( -> ) #8000 !skip-buf
( skip up to 65536 bytes )
@skip-lo ( lo* -> )
DUP2 #8001 LTH2 ?{ skip-32k #8000 SUB2 } !skip-buf
( skips up to 32768 bytes of; limited by the size of buf )
@skip-buf ( n* -> )
ORAk ?&non-zero POP2 JMP2r &non-zero
DUP2 .File1/len DEO2
;buffer .File1/r DEO2
.File1/ok DEI2 EQU2 ?&ok
;read-error print !panic
&ok JMP2r
( '0' -> 00 ) ( '0' -> 00 )
( '1' -> 01 ) ( '1' -> 01 )
@ -256,7 +232,7 @@
( '7' -> 07 ) ( '7' -> 07 )
( anything else -> 00 ) ( anything else -> 00 )
@octal-digit ( char^ -> oct^ ) @octal-digit ( char^ -> oct^ )
LIT "0 LTHk ?&zero SUB JMP2r &zero POP2 #00 JMP2r LIT "0 SUB DUP #08 LTH ?{ POP #00 } JMP2r
( returns values between #00:0000:0000 and #01:ffff:ffff ) ( returns values between #00:0000:0000 and #01:ffff:ffff )
( ) ( )