From d4562c34a75067aa547ae23fb365ef81bc02e011 Mon Sep 17 00:00:00 2001 From: d_m Date: Tue, 17 Sep 2024 22:34:19 -0400 Subject: [PATCH] tar.tal can list and expand --- tar.tal | 134 +++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 114 insertions(+), 20 deletions(-) diff --git a/tar.tal b/tar.tal index 2dde03f..e306951 100644 --- a/tar.tal +++ b/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