d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tar.tal can list and expand

This commit is contained in:
~d6 2024-09-17 22:34:19 -04:00
parent a206871a07
commit d4562c34a7
1 changed files with 114 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

134
tar.tal
View File

@ -14,10 +14,6 @@
|0100 |0100
;arg-callback ;on-stdin arg/init BRK ;arg-callback ;on-stdin arg/init BRK
( exit normally )
@exit ( code^ -> BRK )
#80 ORA #0f DEO BRK
( exit abnormally ) ( exit abnormally )
@panic ( -> $exit ) @panic ( -> $exit )
#010e DEO #010f DEO BRK #010e DEO #010f DEO BRK
@ -25,16 +21,25 @@
( handle all provided command-line arguments ) ( handle all provided command-line arguments )
@arg-callback ( -> ) @arg-callback ( -> )
;arg/count LDA ;arg/count LDA
DUP #00 EQU ?&missing DUP #00 EQU ?&missing-mode
DUP #01 GTH ?&toomany DUP #01 EQU ?&missing-file
POP !run #02 GTH ?&toomany !run
&missing ;missing-filename !&error &missing-mode ;missing-mode !&error
&missing-file ;missing-filename !&error
&toomany ;too-many-arguments &toomany ;too-many-arguments
&error print ;usage print #01 !exit &error print ;usage print #01 !exit
( run the program ) ( run the program )
@run ( -> BRK ) @run ( -> BRK )
#00 arg/read .File1/name DEO2 list-entries #00 !exit #01 arg/read .File1/name DEO2
#00 arg/read LDA
DUP LIT "t NEQ ?{ list-entries #00 !exit }
DUP LIT "x NEQ ?{ expand-entries #00 !exit }
POP ;invalid-mode print ;usage print #00 !exit
( exit normally )
@exit ( code^ -> BRK )
#80 ORA #0f DEO BRK
( ignore stdin once we've processed the args ) ( ignore stdin once we've processed the args )
@on-stdin ( -> BRK ) @on-stdin ( -> BRK )
@ -71,7 +76,7 @@
DUP LIT "0 EQU ?list-file-v ( type^ ) DUP LIT "0 EQU ?list-file-v ( type^ )
DUP LIT "5 EQU ?list-dir-v ( type^ ) DUP LIT "5 EQU ?list-dir-v ( type^ )
DUP LIT "7 EQU ?list-file-v ( type^ ) DUP LIT "7 EQU ?list-file-v ( type^ )
!list-unsupported ( ) !fail-unsupported ( )
( non-verbose file entry listing ) ( non-verbose file entry listing )
@list-file ( 00^ -> ) @list-file ( 00^ -> )
@ -88,7 +93,7 @@
!list-entries !list-entries
( verbose file entry listing ) ( verbose file entry listing )
@list-file-v ( 00^ -> ) @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
@ -104,33 +109,72 @@
!list-entries !list-entries
( handle unsupported directory entry listing ) ( handle unsupported directory entry listing )
@list-unsupported ( type^ -> ) @fail-unsupported ( type^ -> )
;unsupported print DUP emit/byte #2018 DEO ;unsupported print DUP emit/byte #2018 DEO
LIT2 "[ 18 DEO #18 DEO LIT2 "] 18 DEO LIT2 "[ 18 DEO #18 DEO LIT2 "] 18 DEO
#0a18 DEO #0a18 DEO
dump-header !panic dump-header !panic
( expand a .tar archive in the current working directory )
@expand-entries ( -> )
read-header ?{ JMP2r }
;header/filename LDA ?&non-null
#800f DEO BRK
&non-null
;header/type LDA ( type^ )
DUP #00 EQU ?expand-file ( type^ )
DUP LIT "0 EQU ?expand-file ( type^ )
DUP LIT "5 EQU ?expand-dir ( type^ )
DUP LIT "7 EQU ?expand-file ( type^ )
!fail-unsupported ( )
( remove leading / of an absolute path )
@sanitize-path ( s* -> s1* )
LDAk LIT "/ NEQ JMP INC2 JMP2r
@extra-xyz ( n* -> extra* )
#01ff AND2 #0200 SWP2 SUB2 ORAk ?{ POP2 #0000 } JMP2r
@expand-file ( type^ -> )
POP
;header/filename sanitize-path
DUP2 #0064 lprint #0a18 DEO
.File2/name DEO2
;header/size load-octal11 STH2k write
STH2r extra-xyz skip-lo !expand-entries
@expand-dir ( type^ -> )
POP
;header/filename sanitize-path
DUP2 #0064 lprint #0a18 DEO
.File2/name DEO2
#0004 .File2/len DEO2
;tmp .File2/w DEO2
!expand-entries
@tmp "tmp 0a 00
( TODO write data from memory into the tar file ) ( TODO write data from memory into the tar file )
@write-memory ( filename* size* data* -> ) @z-write-memory ( filename* size* data* -> )
STH2 STH2k write-file-header ( [data* size*] ) STH2 STH2k z-write-file-header ( [data* size*] )
STH2r STH2r write-file-body JMP2r ( ) STH2r STH2r z-write-file-body JMP2r ( )
.File1/len .File1/len
( TODO write out the file header ) ( TODO write out the file header )
@write-file-header ( filename* size* -> ) @z-write-file-header ( filename* size* -> )
SWP2 ;header/filename copy JMP2r SWP2 ;header/filename copy JMP2r
write-size-2 z-write-size-2
( TODO: compute checksum ) ( TODO: compute checksum )
LIT "0 ;header/type STA LIT "0 ;header/type STA
#00 ;header/linkname STA #00 ;header/linkname STA
JMP2r JMP2r
( TODO write file body into archive ) ( TODO write file body into archive )
@write-file-body ( size* data* -> ) @z-write-file-body ( size* data* -> )
SWP2 .File1/len DEO2 .File1/w DEO2 JMP2r SWP2 .File1/len DEO2 .File1/w DEO2 JMP2r
( TODO write file size, limited to 64k ) ( TODO write file size, limited to 64k )
@write-size-2 ( size* -> ) @z-write-size-2 ( size* -> )
;header/size STH2 ( size* [start*] ) ;header/size STH2 ( size* [start*] )
LIT2r 000a ADD2r ( size* [start* last*] ) LIT2r 000a ADD2r ( size* [start* last*] )
&loop ( size* [start* pos*] ) &loop ( size* [start* pos*] )
@ -152,6 +196,53 @@
POP2 POP2r JMP2r POP2 POP2r JMP2r
&ok INC2 INC2r !&loop &ok INC2 INC2r !&loop
( writes `n` bytes from File1 to File2 )
( uses a 32k internal buffer )
@write ( carry^ hi* lo* -> )
write-lo
write-hi
?write-4g JMP2r
( unconditionally write 4GiB, that is 4294967296 bytes )
@write-4g ( -> ) write-2g ( >> )
( unconditionally write 2GiB, that is 2147483648 bytes )
@write-2g ( -> ) #8000 !write-hi
( writes `hi*65536` bytes )
( - 0001 will write 65536 bytes )
( - 0010 will write 1048576 bytes )
( - ffff will write 4294901760 bytes )
@write-hi ( hi* -> )
#0000 SWP2 SUB2 ( -hi* )
&loop ORAk ?&ok POP2 JMP2r ( )
&ok write-64k INC2 !&loop ( -hi+1* )
( writes exactly 65536 bytes )
@write-64k ( -> ) write-32k ( >> )
( writes exactly 32768 bytes )
@write-32k ( -> ) #8000 !write-buf
( write up to 65536 bytes )
@write-lo ( lo* -> )
DUP2 #8001 LTH2 ?{ write-32k #8000 SUB2 } !write-buf
( 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 ) ( 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 ) ( since we can only actually read 32k at a time, and since we can )
@ -316,11 +407,14 @@
JMP2r JMP2r
( some handy string constants ) ( some handy string constants )
@usage "usage: 20 "uxncli 20 "tar.rom 20 "FILENAME 0a 00 @usage "usage: 20 "uxncli 20 "tar.rom 20 "c|t|x 20 "FILENAME 0a 00
@missing-mode "error: 20 "missing 20 "mode 0a 00
@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
@unsupported "unsupported 20 "format 20 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
( load argument parser ) ( load argument parser )
~arg.tal ~arg.tal