tar.tal can list and expand
This commit is contained in:
parent
a206871a07
commit
d4562c34a7
134
tar.tal
134
tar.tal
|
|
@ -14,10 +14,6 @@
|
|||
|0100
|
||||
;arg-callback ;on-stdin arg/init BRK
|
||||
|
||||
( exit normally )
|
||||
@exit ( code^ -> BRK )
|
||||
#80 ORA #0f DEO BRK
|
||||
|
||||
( exit abnormally )
|
||||
@panic ( -> $exit )
|
||||
#010e DEO #010f DEO BRK
|
||||
|
|
@ -25,16 +21,25 @@
|
|||
( handle all provided command-line arguments )
|
||||
@arg-callback ( -> )
|
||||
;arg/count LDA
|
||||
DUP #00 EQU ?&missing
|
||||
DUP #01 GTH ?&toomany
|
||||
POP !run
|
||||
&missing ;missing-filename !&error
|
||||
DUP #00 EQU ?&missing-mode
|
||||
DUP #01 EQU ?&missing-file
|
||||
#02 GTH ?&toomany !run
|
||||
&missing-mode ;missing-mode !&error
|
||||
&missing-file ;missing-filename !&error
|
||||
&toomany ;too-many-arguments
|
||||
&error print ;usage print #01 !exit
|
||||
|
||||
( run the program )
|
||||
@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 )
|
||||
@on-stdin ( -> BRK )
|
||||
|
|
@ -71,7 +76,7 @@
|
|||
DUP LIT "0 EQU ?list-file-v ( type^ )
|
||||
DUP LIT "5 EQU ?list-dir-v ( type^ )
|
||||
DUP LIT "7 EQU ?list-file-v ( type^ )
|
||||
!list-unsupported ( )
|
||||
!fail-unsupported ( )
|
||||
|
||||
( non-verbose file entry listing )
|
||||
@list-file ( 00^ -> )
|
||||
|
|
@ -88,7 +93,7 @@
|
|||
!list-entries
|
||||
|
||||
( verbose file entry listing )
|
||||
@list-file-v ( 00^ -> )
|
||||
@list-file-v ( type^ -> )
|
||||
POP
|
||||
LIT "f #18 DEO #2018 DEO
|
||||
;header/size load-octal11 dump-longer #2018 DEO
|
||||
|
|
@ -104,33 +109,72 @@
|
|||
!list-entries
|
||||
|
||||
( handle unsupported directory entry listing )
|
||||
@list-unsupported ( type^ -> )
|
||||
@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-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 )
|
||||
@write-memory ( filename* size* data* -> )
|
||||
STH2 STH2k write-file-header ( [data* size*] )
|
||||
STH2r STH2r write-file-body JMP2r ( )
|
||||
@z-write-memory ( filename* size* data* -> )
|
||||
STH2 STH2k z-write-file-header ( [data* size*] )
|
||||
STH2r STH2r z-write-file-body JMP2r ( )
|
||||
.File1/len
|
||||
|
||||
( TODO write out the file header )
|
||||
@write-file-header ( filename* size* -> )
|
||||
@z-write-file-header ( filename* size* -> )
|
||||
SWP2 ;header/filename copy JMP2r
|
||||
write-size-2
|
||||
z-write-size-2
|
||||
( TODO: compute checksum )
|
||||
LIT "0 ;header/type STA
|
||||
#00 ;header/linkname STA
|
||||
JMP2r
|
||||
|
||||
( 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
|
||||
|
||||
( TODO write file size, limited to 64k )
|
||||
@write-size-2 ( size* -> )
|
||||
@z-write-size-2 ( size* -> )
|
||||
;header/size STH2 ( size* [start*] )
|
||||
LIT2r 000a ADD2r ( size* [start* last*] )
|
||||
&loop ( size* [start* pos*] )
|
||||
|
|
@ -152,6 +196,53 @@
|
|||
POP2 POP2r JMP2r
|
||||
&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 )
|
||||
( )
|
||||
( since we can only actually read 32k at a time, and since we can )
|
||||
|
|
@ -316,11 +407,14 @@
|
|||
JMP2r
|
||||
|
||||
( 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
|
||||
@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
|
||||
@read-error "error 20 "reading 20 "data 0a 00
|
||||
@write-error "error 20 "writing 20 "data 0a 00
|
||||
|
||||
( load argument parser )
|
||||
~arg.tal
|
||||
|
|
|
|||
Loading…
Reference in New Issue