tar updates

This commit is contained in:
~d6 2024-12-31 14:34:04 -05:00
parent 966c87a144
commit 48032c123d
1 changed files with 37 additions and 64 deletions

99
tar.tal
View File

@ -82,43 +82,34 @@
#800f DEO BRK #800f DEO BRK
&non-null &non-null
;header/type LDA ( type^ ) ;header/type LDA ( type^ )
DUP #00 EQU ?list-file-v ( type^ ) DUP #00 EQU ?list-file ( type^ )
DUP LIT "0 EQU ?list-file-v ( type^ ) DUP LIT "0 EQU ?list-file ( type^ )
DUP LIT "5 EQU ?list-dir-v ( type^ ) DUP LIT "5 EQU ?list-dir ( type^ )
DUP LIT "7 EQU ?list-file-v ( type^ ) DUP LIT "7 EQU ?list-file ( type^ )
!list-unsupported-v DUP LIT "x EQU ?list-posix-meta ( type^ )
( !fail-unsupported ) ( ) !list-unsupported
( non-verbose file entry listing ) @list-posix-meta ( type^ -> )
@list-file ( 00^ -> )
POP POP
LIT "f #18 DEO #2018 DEO ;header/size load-octal11 STH2 ( s0^ s1* [s2*] )
;header/filename #0064 lprint #0a18 DEO ORA ORA ?&meta-too-big
&meta-too-big
POP2r ;meta-too-big print
;header/size dump-longer #0a18 DEO
!list-unsupported
( verbose file entry listing )
@list-unsupported ( type^ -> )
;unsupported print
#18 DEO #2018 DEO
;header/size load-octal11 dump-longer #2018 DEO
;header/filename sanitize-path
#0064 lprint #0a18 DEO
;header/size load-octal11 round-up-to-512 skip !list-entries ;header/size load-octal11 round-up-to-512 skip !list-entries
( non-verbose directory entry listing )
@list-dir ( 00^ -> )
POP
LIT "d #18 DEO #2018 DEO
;header/filename #0064 lprint #0a18 DEO
!list-entries
( verbose file entry listing ) ( verbose file entry listing )
@list-unsupported-v ( type^ -> ) @list-file ( type^ -> )
( POP )
( LIT "f ) #18 DEO #2018 DEO
;header/size load-octal11 dump-longer #2018 DEO
;header/filename #0064 lprint #0a18 DEO
;header/size load-octal11 round-up-to-512
( dump-header )
;header/size .File2/name DEO2
;header/size load-octal11 STH2k skip
STH2r remainder-512 skip-lo !list-entries
( verbose file entry listing )
@list-file-v ( type^ -> )
POP POP
LIT "f #18 DEO #2018 DEO LIT "f #18 DEO #2018 DEO
;header/size load-octal11 dump-longer #2018 DEO ;header/size load-octal11 dump-longer #2018 DEO
@ -126,20 +117,13 @@
;header/size load-octal11 round-up-to-512 skip !list-entries ;header/size load-octal11 round-up-to-512 skip !list-entries
( verbose directory entry listing ) ( verbose directory entry listing )
@list-dir-v ( 00^ -> ) @list-dir ( 00^ -> )
POP POP
LIT "d #18 DEO #2018 DEO LIT "d #18 DEO #2018 DEO
;header/size load-octal11 dump-longer #2018 DEO ;header/size load-octal11 dump-longer #2018 DEO
;header/filename #0064 lprint #0a18 DEO ;header/filename #0064 lprint #0a18 DEO
!list-entries !list-entries
( handle unsupported directory entry listing )
@fail-unsupported ( type^ -> )
;unsupported print DUP emit/byte #2018 DEO
LIT2 "[ 18 DEO #18 DEO LIT2 "] 18 DEO
#0a18 DEO
dump-header !panic
( expand a .tar archive in the current working directory ) ( expand a .tar archive in the current working directory )
@expand-entries ( -> ) @expand-entries ( -> )
read-header ?{ JMP2r } read-header ?{ JMP2r }
@ -152,7 +136,6 @@
DUP LIT "5 EQU ?expand-dir ( type^ ) DUP LIT "5 EQU ?expand-dir ( type^ )
DUP LIT "7 EQU ?expand-file ( type^ ) DUP LIT "7 EQU ?expand-file ( type^ )
!expand-unsupported !expand-unsupported
( !fail-unsupported ) ( )
( remove leading / of an absolute path ) ( remove leading / of an absolute path )
@sanitize-path ( s* -> s1* ) @sanitize-path ( s* -> s1* )
@ -179,14 +162,11 @@
!expand-entries !expand-entries
@expand-unsupported ( type^ -> ) @expand-unsupported ( type^ -> )
;skipped-unsupported print ;unsupported print
#18 DEO LIT2 ": 18 DEO #2018 DEO #18 DEO LIT2 ": 18 DEO #2018 DEO
;header/filename sanitize-path ;header/filename sanitize-path
DUP2 #0064 lprint #0064 lprint #0a18 DEO
#0a18 DEO ;header/size load-octal11 round-up-to-512 skip !expand-entries
.File2/name DEO2
;header/size load-octal11 round-up-to-512 skip
!expand-entries
( src and dst should be paths ) ( src and dst should be paths )
@compress-entries ( src* dst* -> ) @compress-entries ( src* dst* -> )
@ -311,13 +291,13 @@
POP2 POP2 STH2r JMP2r ( sum2* ) POP2 POP2 STH2r JMP2r ( sum2* )
( emit 1, 2, 4, or 5 bytes as a decimal number ) ( emit 1, 2, 4, or 5 bytes as a decimal number )
@emit ( @emit
&1+long STH2 STH2 /byte STH2r STH2r &1+long STH2 STH2 /byte STH2r STH2r
&long SWP2 /short &long SWP2 /short
&short SWP /byte &short SWP /byte
&byte DUP #04 SFT /char &byte DUP #04 SFT /char
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
JMP2r JMP2r )
( round a given 5-byte size up to multiples of 512 ) ( round a given 5-byte size up to multiples of 512 )
@round-up-to-512 ( carry^ hi* lo* -> chl^** ) @round-up-to-512 ( carry^ hi* lo* -> chl^** )
@ -346,16 +326,6 @@
&loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ ) &loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ )
&ok #2018 DEO LDAk dump-byte INC2 !&loop ( lim^ pos+1^ ) &ok #2018 DEO LDAk dump-byte INC2 !&loop ( lim^ pos+1^ )
@dump-mem0 ( start* size* -> )
#0001 SUB2 OVR2 ADD2 SWP2
&loop GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
LDAk #30 GTH ?{ #2018 DEO INC2 !&loop }
LDAk #18 DEO INC2 ( >> )
&loop2 GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
LDAk #18 DEO INC2 !&loop2
@dump-body1 ( -> )
@dump-header ( -> ) @dump-header ( -> )
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
;header/filename #0064 dump-mem ;header/filename #0064 dump-mem
@ -385,10 +355,10 @@
@missing-filename "error: 20 "missing 20 "filename 0a 00 @missing-filename "error: 20 "missing 20 "filename 0a 00
@too-many-arguments "error: 20 "too 20 "many 20 "arguments 0a 00 @too-many-arguments "error: 20 "too 20 "many 20 "arguments 0a 00
@invalid-mode "error: 20 "invalid 20 "mode 0a 00 @invalid-mode "error: 20 "invalid 20 "mode 0a 00
@unsupported "unsupported 20 "format 20 00
@read-error "error 20 "reading 20 "data 0a 00 @read-error "error 20 "reading 20 "data 0a 00
@write-error "error 20 "writing 20 "data 0a 00 @write-error "error 20 "writing 20 "data 0a 00
@skipped-unsupported "skipped 20 "unsupported 20 "type 20 00 @unsupported "skipped 20 "unsupported 20 "type 20 00
@meta-too-big "extended 20 "metadata 20 "field 20 "too 20 "big: 20 00
( load argument parser ) ( load argument parser )
~arg.tal ~arg.tal
@ -459,8 +429,11 @@
&pad $c ( 0x1f4: padding, 12 bytes ) &pad $c ( 0x1f4: padding, 12 bytes )
&end ( 0x200: end of header ) &end ( 0x200: end of header )
( buffer for up to 4096 characters of long names/paths ) ( up to 8 bytes for long size )
|7000 @long-buf $1000 |77f8 @long-size $8
( buffer for up to 2048 characters of long names/paths )
|7800 @long-buf $800
( buffer for reading up to 32k bytes of data at a time ) ( buffer for reading up to 32k bytes of data at a time )
|8000 @buffer $8000 |8000 @buffer $8000