tar.tal can list and expand

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 #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
     &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* -> )
+@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
 
 ( 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