692 lines
25 KiB
Tal
692 lines
25 KiB
Tal
( tal.tal )
|
|
( )
|
|
( by d_m )
|
|
( )
|
|
( see https://en.wikipedia.org/wiki/Tar_(computing)#UStar_format )
|
|
( )
|
|
( TODO: )
|
|
( - check for "ustar" header )
|
|
( - handle filename-prefix )
|
|
( - handle 'L' entries )
|
|
( - support creating archives )
|
|
( - arg validation should depend on mode )
|
|
( - better error messages on unsupported files, e.g. symlinks )
|
|
( - better usage message )
|
|
( - support using "-" for stdin/stdout? )
|
|
( - option to ignore symlinks? )
|
|
|
|
( File1 is used to read/write the tar file )
|
|
( File2 is used to read/write files and directories )
|
|
|a0 @File1 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|
|
|b0 @File2 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|
|
|
|
|0100
|
|
;arg-callback ;on-stdin arg/init BRK
|
|
|
|
( exit abnormally )
|
|
@panic ( -> $exit )
|
|
#010e DEO #010f DEO BRK
|
|
|
|
@print-usage ( -> )
|
|
;usage1 print ;usage2 !print
|
|
|
|
( handle all provided command-line arguments )
|
|
@arg-callback ( -> )
|
|
;arg/count LDA
|
|
DUP #00 GTH ?{ POP ;missing-mode !handle-error }
|
|
DUP #01 GTH ?{ POP ;missing-filename !handle-error }
|
|
POP !run
|
|
|
|
@error-toomany ( -> BRK )
|
|
;too-many-arguments !handle-error
|
|
|
|
@error-noinput ( -> BRK )
|
|
;no-input-arguments !handle-error
|
|
|
|
@handle-error ( ;msg -> BRK )
|
|
print print-usage #01 !exit
|
|
|
|
( run the program )
|
|
@run ( -> BRK )
|
|
#01 arg/read .File1/name DEO2
|
|
#00 arg/read LDA
|
|
DUP LIT "c NEQ ?{ POP create-archive #00 !exit }
|
|
DUP LIT "t NEQ ?{ POP list-entries #00 !exit }
|
|
DUP LIT "x NEQ ?{ POP expand-entries #00 !exit }
|
|
POP ;invalid-mode print print-usage #00 !exit
|
|
|
|
( exit normally )
|
|
@exit ( code^ -> BRK )
|
|
#80 ORA #0f DEO BRK
|
|
|
|
( ignore stdin once we've processed the args )
|
|
@on-stdin ( -> BRK )
|
|
BRK
|
|
|
|
( print a null-terminated string )
|
|
@print ( s* -> )
|
|
&loop LDAk ?{ POP2 JMP2r }
|
|
LDAk #18 DEO INC2 !&loop
|
|
|
|
( print up to `len` bytes from string. stops on NUL. )
|
|
@lprint ( s* len* -> )
|
|
OVR2 ADD2 SWP2 ( limit* s* )
|
|
&loop LDAk ?{ !&done } ( limit* s* )
|
|
LDAk #18 DEO INC2 GTH2k ?&loop ( limit* s+1* )
|
|
&done POP2 POP2 JMP2r ( )
|
|
|
|
@print-filename ( -> )
|
|
;header/filename sanitize-path #0064 lprint #0a18 DEO JMP2r
|
|
|
|
@print-long ( hi* lo* -> )
|
|
dump-long #0a18 DEO JMP2r
|
|
|
|
( read 512 bytes of header for the next tar entry. )
|
|
( assumes .File1/name is already set. )
|
|
@read-header ( -> ok^ )
|
|
#0200 .File1/len DEO2
|
|
;header .File1/r DEO2
|
|
.File1/ok DEI2 #0200 EQU2 JMP2r
|
|
|
|
@write-header ( -> ok^ )
|
|
#0200 .File1/len DEO2
|
|
;header .File1/w DEO2
|
|
.File1/ok DEI2 #0200 EQU2 JMP2r
|
|
|
|
@validate-checksum ( -> ok^ )
|
|
;header/checksum load-octal6 ( chi* clo* )
|
|
STH2k SWP2 STH2k SWP2 ( chi* clo* [clo* chi*] )
|
|
;u-sum compute-sum ( chi* clo* uhi* ulo* [clo* chi*] )
|
|
u32-eq ?&ok1 ( [clo* chi*] )
|
|
STH2r STH2r ;s-sum compute-sum ( chi* clo* shi* slo* )
|
|
u32-eq ?&ok2 ( )
|
|
;invalid-checksum print ( ; error message )
|
|
print-filename ( ; filename of affected entry )
|
|
;expected print ( ; "expected: " )
|
|
;header/checksum load-octal6 print-long ( ; expected checksum )
|
|
;found print ( ; "found: " )
|
|
;u-sum compute-sum print-long ( ; found checksum )
|
|
#00 JMP2r ( 0^ )
|
|
&ok1 POP2r POP2r &ok2 #01 JMP2r ( 1^ )
|
|
|
|
( maximum checksum is 0001fe00 but in practice )
|
|
( almost all checksums will fit in 16-bits )
|
|
@compute-sum ( fn* -> sum0* sum1* )
|
|
STH2 ;header/checksum ;header STH2kr JSR2 ( n0* [fn*] )
|
|
#0100 ADD2 ;uheader/end ;header/type STH2r JSR2 ( n1* n2* )
|
|
OVR2 ADD2 GTH2k #00 SWP ( n1* sum* carry* )
|
|
ROT2 POP2 SWP2 JMP2r ( carry* sum* )
|
|
|
|
@u32-eq ( xhi* xlo* yhi* ylo* -> bool^ )
|
|
ROT2 EQU2 STH EQU2 STHr AND JMP2r
|
|
|
|
( return 16-bit checksum )
|
|
( technically it should be 17-bit. for simplicity we'll )
|
|
( just check the lower 16-bits. )
|
|
@u-sum ( limit* start* -> sum* )
|
|
LIT2r 0000 ( limit* start* [sum*] )
|
|
&loop LDAk LITr 00 STH ( limit* start* [sum* n*] )
|
|
ADD2r INC2 GTH2k ?&loop ( limit* pos+1* [sum+n*] )
|
|
POP2 POP2 STH2r JMP2r ( sum* )
|
|
|
|
( similar to unsigned-sum but treats 8-bit ascii differently )
|
|
( mostly only used for compatibility with old tar files )
|
|
@s-sum ( limit* start* -> sum* )
|
|
LIT2r 0000 ( limit* start* [sum*] )
|
|
&loop LDAk ( limit* start* c^ [sum*] )
|
|
DUP #07 SFT #ff MUL SWP STH2 ( limit* start* [sum* n*] )
|
|
ADD2r INC2 GTH2k ?&loop ( limit* pos+1* [sum+n*] )
|
|
POP2 POP2 STH2r JMP2r ( sum* )
|
|
|
|
( list all the entries in the tar archive )
|
|
@list-entries ( -> )
|
|
;arg/count LDA #02 GTH ?error-toomany
|
|
read-header ?{ JMP2r }
|
|
;header/filename LDA ?&non-null
|
|
#800f DEO BRK
|
|
&non-null
|
|
validate-checksum ( )
|
|
;header/type LDA ( type^ )
|
|
DUP #00 EQU ?list-file ( type^ )
|
|
DUP LIT "0 EQU ?list-file ( type^ )
|
|
DUP LIT "5 EQU ?list-dir ( type^ )
|
|
DUP LIT "7 EQU ?list-file ( type^ )
|
|
DUP LIT "x EQU ?list-posix-meta ( type^ )
|
|
!list-unsupported
|
|
|
|
@list-posix-meta ( type^ -> )
|
|
POP
|
|
;header/size load-octal11 STH2 ( s0^ s1* [s2*] )
|
|
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
|
|
print-filename
|
|
;header/size load-octal11 round-up-to-512 skip !list-entries
|
|
|
|
( verbose file entry listing )
|
|
@list-file ( type^ -> )
|
|
POP
|
|
LIT "f #18 DEO #2018 DEO
|
|
;header/size load-octal11 dump-longer #2018 DEO
|
|
print-filename
|
|
;header/size load-octal11 round-up-to-512 skip !list-entries
|
|
|
|
( verbose directory entry listing )
|
|
@list-dir ( 00^ -> )
|
|
POP
|
|
LIT "d #18 DEO #2018 DEO
|
|
;header/size load-octal11 dump-longer #2018 DEO
|
|
print-filename
|
|
!list-entries
|
|
|
|
( expand a .tar archive in the current working directory )
|
|
@expand-entries ( -> )
|
|
;arg/count LDA #02 GTH ?error-toomany
|
|
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^ )
|
|
!expand-unsupported
|
|
|
|
( remove leading / of an absolute path )
|
|
@sanitize-path ( s* -> s1* )
|
|
LDAk LIT "/ NEQ JMP INC2 JMP2r
|
|
|
|
@remainder-512 ( n* -> extra* )
|
|
#01ff AND2 #0200 DUP2 ROT2 SUB2 NEQ2k ?{ POP2 #0000 } NIP2 JMP2r
|
|
|
|
@expand-file ( type^ -> )
|
|
POP
|
|
print-filename
|
|
.File2/name DEO2
|
|
;header/size load-octal11 STH2k write
|
|
STH2r remainder-512 skip-lo !expand-entries
|
|
|
|
@expand-dir ( type^ -> )
|
|
POP
|
|
print-filename
|
|
.File2/name DEO2
|
|
#0004 .File2/len DEO2
|
|
#0001 .File2/w DEO2
|
|
!expand-entries
|
|
|
|
@expand-unsupported ( type^ -> )
|
|
;unsupported print
|
|
#18 DEO LIT2 ": 18 DEO #2018 DEO
|
|
print-filename
|
|
;header/size load-octal11 round-up-to-512 skip !expand-entries
|
|
|
|
@create-archive ( -> )
|
|
;arg/count LDA #03 LTH ?error-noinput
|
|
validate-inputs ?{ print-usage #01 !exit }
|
|
( ; we know that all input files exist )
|
|
#01 arg/read DUP2 path-exists ?&dest-exists
|
|
|
|
.File1/name DEO2
|
|
#00 .File1/append DEO
|
|
;arg/count LDA #02
|
|
&loop DUP arg/read ;path-buf SWP2 archive-path ?&ok
|
|
;failed-to-write print arg/read print #0a18 DEO #01 !exit
|
|
&ok INC GTHk ?&loop
|
|
POP2 JMP2r
|
|
|
|
&dest-exists ;destination-exists print
|
|
print #0a18 DEO print-usage #01 !exit
|
|
|
|
@validate-inputs ( -> ok^ )
|
|
;arg/count LDA #02 LITr 01 ( count^ 2^ [1^] )
|
|
&loop DUP validate-input ( count^ i^ ok1^ [ok0^] )
|
|
STH ANDr INC GTHk ?&loop ( count^ i+1^ [ok2^] )
|
|
POP2 STHr JMP2r ( ok^ )
|
|
|
|
@validate-input ( i^ -> ok^ )
|
|
arg/read DUP2 path-exists ?&ok1
|
|
;missing-input print print #0a18 DEO #00 JMP2r
|
|
&ok1 ;long-size LDA LIT "? NEQ ?&ok2
|
|
;input-toobig print print #0a18 DEO #00 JMP2r
|
|
&ok2 POP2 #01 JMP2r
|
|
|
|
@path-exists ( path* -> )
|
|
path-read-size ;long-size LDA LIT "! NEQ JMP2r
|
|
|
|
@path-read-size ( path* -> )
|
|
.File2/name DEO2
|
|
#0008 .File2/len DEO2
|
|
;long-size .File2/stat DEO2
|
|
JMP2r
|
|
|
|
@archive-dir ( base* path* -> ok^ )
|
|
LIT2r =header ( base* path* [h*] )
|
|
STH2kr LDA LIT "/ NEQ ?&rel-path ( base* path* [h*] )
|
|
LIT ". STH2kr STA INC2r ( base* path* [h+1*] )
|
|
&rel-path DUP2 STH2r copy-str0 ( base* path* s1* ; write file name )
|
|
LIT2 "/ 00 SWP2 STA2 ( base* path* ; terminate dir path with / )
|
|
;default-d-mode ;header/mode copy-str ( base* path* ; write file permissions )
|
|
;default-id ;header/owner copy-str ( base* path* ; write file owner )
|
|
;default-id ;header/group copy-str ( base* path* ; write file group )
|
|
#0000 #0000 ;scratch ( base* path* hi* lo* addr* )
|
|
render-octal32 ( base* path* )
|
|
#000b ;header/size save-octal ( base* path* )
|
|
;default-mtime ;header/mtime copy-str ( base* path* ; write mtime )
|
|
LIT "5 ;header/type STA ( base* path* ; write '0' for normal file )
|
|
save-checksum ?archive-children ( base* path* )
|
|
POP2 POP2 #00 JMP2r ( not-ok^ )
|
|
|
|
@archive-children ( base* path* -> ok^ )
|
|
#010e DEO
|
|
DUP2 .File2/name DEO2 ( path* )
|
|
#4000 .File2/len DEO2 ( path* )
|
|
;ls-buf .File2/r DEO2 ( path* )
|
|
.File2/ok DEI2 DUP2 #4000 EQU2 ?&toobig ( path* size* )
|
|
#010e DEO POP2 ( path* )
|
|
;ls-buf #0040 dump-mem ( path* )
|
|
print #0a18 DEO #01 JMP2r ( ok^ )
|
|
|
|
&toobig ;dir-toobig print print
|
|
#0a18 DEO #01 !exit
|
|
|
|
@archive-path ( base* path* -> ok^ )
|
|
zero-header ( base* path* )
|
|
( TODO: copy path to base here, replace with base2 )
|
|
DUP2 path-read-size ( base* path* )
|
|
;long-size LDA LIT "- EQU ?archive-dir ( base* path* )
|
|
LIT2r =header ( base* path* [h*] )
|
|
STH2kr LDA LIT "/ NEQ ?&rel-path ( base* path* [h*] )
|
|
LIT ". STH2kr STA INC2r ( base* path* [h+1*] )
|
|
&rel-path STH2r copy-str POP2 ( ; write file name )
|
|
;default-f-mode ;header/mode copy-str ( ; write file permissions )
|
|
;default-id ;header/owner copy-str ( ; write file owner )
|
|
;default-id ;header/group copy-str ( ; write file group )
|
|
size-to-octal ( ; write file size )
|
|
;default-mtime ;header/mtime copy-str ( ; write mtime )
|
|
LIT "0 ;header/type STA ( ; write '0' for normal file )
|
|
!save-checksum ( ok^ )
|
|
|
|
@save-checksum ( -> )
|
|
;u-sum compute-sum ( checksum* )
|
|
;scratch render-octal32 ( )
|
|
#0006 ;header/checksum save-octal ( )
|
|
#20 ;header/checksum #0007 ADD2 STA ( )
|
|
!write-header ( ok^ )
|
|
|
|
@ascii-to-digit ( c^ -> n* )
|
|
#00 SWP DUP #39 GTH #27 MUL SUB #30 SUB JMP2r
|
|
|
|
@ascii-to-short ( s* -> n* )
|
|
#0000 SWP2 LITr c0 ( sum* s* [shift^] )
|
|
&loop LDAk ascii-to-digit ( sum0* s* digit* [shift^] )
|
|
STHkr SFT2 ( sum0* s* digit<<shift* [shift^] )
|
|
ROT2 ADD2 SWP2 ( sum0+digit<<shift* s* [shift^] )
|
|
STHkr #00 EQU ?&done ( sum1* s* [shift^] )
|
|
INC2 LITr 40 SUBr !&loop ( sum1* s+1* [shift-64^] )
|
|
&done POP2 POPr JMP2r ( sum1* )
|
|
|
|
@size-to-octal ( -> )
|
|
;long-size #0008 dump-mem
|
|
;long-size ascii-to-short ( hi* )
|
|
;long-size/mid ascii-to-short ( hi* lo* )
|
|
;scratch ( hi* lo* addr* )
|
|
render-octal32 ( )
|
|
#000b ;header/size save-octal ( )
|
|
JMP2r ( )
|
|
|
|
@render-octal32 ( hi* lo* addr* -> )
|
|
short-to-octal STH2 STH ( aaaaaaaa bbbbbbbb [addr+5* 0000000x] )
|
|
#0000 ROT ( aaaaaaaa 00000000 00000000 bbbbbbbb [addr+5* 0000000x] )
|
|
#10 SFT2 ( aaaaaaaa 00000000 0000000b bbbbbbb0 [addr+5* 0000000x] )
|
|
SWP2 #07 SFT2 ( 0000000b bbbbbbb0 0000000a aaaaaaa0 [addr+5* 0000000x] )
|
|
SWP2 STH ( 0000000a aaaaaaa0 0000000b [addr+5* 0000000x bbbbbbb0] )
|
|
ORA ORAr STHr ( 0000000a aaaaaaab bbbbbbbx [addr+5*] )
|
|
STH2r short-to-octal ( 0000000a 0000000z addr+10* )
|
|
STH2 SWP #10 SFT ORA ( 000000az [addr+10*] )
|
|
LIT "0 ADD STH2kr STA ( [addr+10*] )
|
|
( STH2r INC2 JMP2r ) ( addr+11* )
|
|
POP2r JMP2r
|
|
|
|
@short-to-octal ( n* addr* -> n>>15^ addr+5* )
|
|
byte-to-octal STH2 SWP ( lo>>6^ hi^ [addr+2*] )
|
|
DUP #01 AND #20 SFT ROT ORA ( hi^ [[hi&1]<<2]|lo>>6 [addr+2*] )
|
|
LIT "0 ADD STH2kr STA ( hi^ [addr+2*] )
|
|
#01 SFT INC2r ( hi>>1^ [addr+3*] )
|
|
STH2r !byte-to-octal ( hi>>7^ addr+5* )
|
|
|
|
@byte-to-octal ( n^ addr* -> n>>6^ addr+2* )
|
|
STH2 DUP #07 AND LIT "0 ADD ( n^ digit1^ [addr*] )
|
|
STH2kr STA #03 SFT INC2r ( n>>3^ [addr+1*] )
|
|
DUP #07 AND LIT "0 ADD ( n>>3^ digit2^ [addr+1*] )
|
|
STH2kr STA #03 SFT INC2r ( n>>6^ [addr+2*] )
|
|
STH2r JMP2r ( n>>6^ addr+2* )
|
|
|
|
@save-octal ( count* addr* -> )
|
|
LIT2r ffff ( count* addr* [ffff*] )
|
|
OVR2 ADD2 ( count* addr+count* [ffff*] )
|
|
STH2 ( count* [ffff* addr+count*] )
|
|
OVR2r ADD2r ( count* [ffff* h=addr+count-1*] )
|
|
;scratch SWP2 ( s* count* [ffff* h*] )
|
|
OVR2 ADD2 SWP2 ( limit=count+s* s* [ffff* h*] )
|
|
&loop LDAk STH2kr STA ( limit* s* [ffff* h*] ; h<-s )
|
|
INC2 OVR2r ADD2r GTH2k ?&loop ( limit* s+1* [ffff* h-1*] )
|
|
POP2 POP2 POP2r POP2r JMP2r ( )
|
|
|
|
@copy-str0 ( s* addr* -> s1* )
|
|
STH2
|
|
&loop LDAk DUP ?&next POP POP2 STH2r JMP2r
|
|
&next STH2kr STA INC2 INC2r !&loop
|
|
|
|
@copy-str ( s* addr* -> )
|
|
copy-str0 POP2 JMP2r
|
|
|
|
( we know header is exactly 512 bytes, an even number )
|
|
@zero-header ( -> )
|
|
;uheader/end ;header LIT2r 0000
|
|
&loop STH2kr OVR2 STA2 INC2 INC2 GTH2k ?&loop
|
|
POP2r POP2 POP2 JMP2r
|
|
|
|
( writes `n` bytes from File1 to File2 )
|
|
( uses a 32k internal buffer )
|
|
@write ( carry^ hi* lo* -> )
|
|
;write-buf ;write-lo/writer STA2
|
|
write-lo write-hi ?write-4g JMP2r
|
|
|
|
( 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 )
|
|
( only easily work with 2-byte shorts, we first read the lowest )
|
|
( two bytes and skip that much. then, for the higher byte, we can )
|
|
( do two skips of 32k for each unit found. )
|
|
@skip ( carry^ hi* lo* -> )
|
|
;skip-buf ;write-lo/writer STA2
|
|
write-lo write-hi ?write-4g JMP2r
|
|
|
|
@skip-lo ( lo* -> )
|
|
;skip-buf ;write-lo/writer STA2 !write-lo
|
|
|
|
( skips up to 32768 bytes of; limited by the size of buf )
|
|
@skip-buf ( n* -> )
|
|
ORAk ?{ POP2 JMP2r }
|
|
DUP2 .File1/len DEO2
|
|
;buffer .File1/r DEO2
|
|
.File1/ok DEI2 EQU2 ?&ok
|
|
;read-error print !panic
|
|
&ok 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 up to 65536 bytes )
|
|
@write-lo ( lo* -> )
|
|
DUP2 #8001 LTH2 ?{ write-32k #8000 SUB2 } LIT2 [ &writer =write-buf ] JMP2
|
|
|
|
( '0' -> 00 )
|
|
( '1' -> 01 )
|
|
( ... )
|
|
( '7' -> 07 )
|
|
( anything else -> 00 )
|
|
@octal-digit ( char^ -> oct^ )
|
|
LIT "0 SUB DUP #08 LTH ?{ POP #00 } JMP2r
|
|
|
|
( returns values between #00:0000:0000 and #01:ffff:ffff )
|
|
( )
|
|
( octal11 of 77777777777 = #01 #ffff #ffff, max value )
|
|
( octal11 of 37777777777 = #00 #ffff #ffff )
|
|
( octal11 of 00000177777 = #00 #0000 #ffff )
|
|
( octal11 of 00000000377 = #00 #0000 #00ff )
|
|
( octal11 of 00000000000 = #00 #0000 #0000, min value )
|
|
@load-octal11 ( addr* -> carry^ hi* lo* )
|
|
INC2k load-octal10 ( addr* hi* lo* ; load addr+1 )
|
|
STH2 STH2 ( addr* [lo* hi*] )
|
|
LDA octal-digit STH2r STH ( octal^ a^ [lo* b^] )
|
|
#20 SFT #02 SFT2 STHr STH2r ( carry^ hi* lo* )
|
|
JMP2r ( carry^ hi* lo* )
|
|
|
|
( returns values between #0000:0000 and #3fff:ffff )
|
|
( )
|
|
( octal10 of 7777777777 = #3fff #ffff, max value )
|
|
( octal10 of 0000177777 = #0000 #ffff )
|
|
( octal10 of 0000000377 = #0000 #00ff )
|
|
( octal10 of 0000000000 = #0000 #0000, min value )
|
|
@load-octal10 ( addr* -> hi* lo* )
|
|
#0005 OVR2 ADD2 ( addr* addr+5* )
|
|
load-octal5 STH2 ( addr* [cd*] )
|
|
load-octal5 SWPr STHr ( ab* c^ [d^] )
|
|
#10 SFT #01 SFT2 STH SWPr ( a^ b>>1^ [lo*] )
|
|
#10 SFT #01 SFT2 STH2r ( hi* lo* )
|
|
JMP2r ( hi* lo* )
|
|
|
|
( returns values between #0000 #0000 and #0003 #ffff )
|
|
@load-octal6 ( addr* -> hi* lo* )
|
|
STH2k LDA octal-digit ( o^ [addr*] )
|
|
#0001 SFT2 ( o1^ o2^ [addr*] )
|
|
#0000 ROT SWP2 SWP SWP2 ( o1* o2* [addr*] )
|
|
STH2r INC2 load-octal5 ( o1* o2* n* )
|
|
ORA2 JMP2r ( o1* o2|n* )
|
|
|
|
( returns values between #0000 and #7fff )
|
|
( )
|
|
( octal5 of 77777 = #7fff, max value )
|
|
( octal5 of 00377 = #00ff )
|
|
( octal5 of 00000 = #0000, min value )
|
|
@load-octal5 ( addr* -> num* )
|
|
#1000 LIT2r 0000 ( addr* place* [sum*] )
|
|
&loop ( pos* place* [sum*] )
|
|
OVR2 LDA octal-digit ( addr* place* digit^ [sum*] )
|
|
#00 SWP ( addr* place* digit* [sum*] )
|
|
OVR2 MUL2 STH2 ADD2r ( addr* place* [sum2=sum+place*digit*] )
|
|
SWP2 INC2 SWP2 ( addr+1* place* [sum2*] )
|
|
#03 SFT2 ORAk ?&loop ( addr+1* place>>3* [sum2*] )
|
|
POP2 POP2 STH2r JMP2r ( sum2* )
|
|
|
|
( emit 1, 2, 4, or 5 bytes as a decimal number )
|
|
( @emit
|
|
&1+long STH2 STH2 /byte STH2r STH2r
|
|
&long SWP2 /short
|
|
&short SWP /byte
|
|
&byte DUP #04 SFT /char
|
|
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
|
|
JMP2r )
|
|
|
|
( round a given 5-byte size up to multiples of 512 )
|
|
@round-up-to-512 ( carry^ hi* lo* -> chl^** )
|
|
DUP2 #01ff AND2 ORA ?{ JMP2r }
|
|
DUP2 #fe00 GTH2 ?{ #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r }
|
|
POP2 DUP2 #ffff EQU2 ?{ INC2 #0000 JMP2r }
|
|
POP2 INC #0000 #0000 JMP2r
|
|
|
|
( since 4-byte integers are called `long` values, )
|
|
( i'm calling a 5-byte integer a `longer` value. )
|
|
|
|
@dump-longer ( carry^ long** -- )
|
|
STH2 STH2 dump-byte STH2r STH2r ( >> )
|
|
@dump-long ( long** -- )
|
|
SWP2 dump-short ( >> )
|
|
@dump-short ( short* -- )
|
|
SWP dump-byte ( >> )
|
|
@dump-byte ( byte^ -- )
|
|
DUP #04 SFT /hex #0f AND ( >> )
|
|
&hex #30 ADD DUP #39 GTH #27 MUL ADD #18 DEO
|
|
JMP2r
|
|
|
|
@dump-mem ( start* size* -> )
|
|
OVR2 ADD2 SWP2 ( lim* start* )
|
|
LDAk dump-byte INC2 ( lim* start+1* )
|
|
&loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ )
|
|
&ok #2018 DEO LDAk dump-byte INC2 !&loop ( lim^ pos+1^ )
|
|
|
|
@dump-header ( -> )
|
|
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
|
|
;header/filename #0064 dump-mem
|
|
;header/mode #0008 dump-mem
|
|
;header/owner #0008 dump-mem
|
|
;header/group #0008 dump-mem
|
|
;header/size #000c dump-mem
|
|
;header/mtime #000c dump-mem
|
|
;header/checksum #0008 dump-mem
|
|
;header/type #0001 dump-mem
|
|
;header/linkname #0064 dump-mem
|
|
LIT2 "+ 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
|
|
;uheader/ustar #0006 dump-mem
|
|
;uheader/version #0002 dump-mem
|
|
;uheader/owner-name #0020 dump-mem
|
|
;uheader/group-name #0020 dump-mem
|
|
;uheader/major #0008 dump-mem
|
|
;uheader/minor #0008 dump-mem
|
|
;uheader/filename-prefix #009b dump-mem
|
|
;uheader/pad #000c dump-mem
|
|
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
|
|
JMP2r
|
|
|
|
( some handy string constants )
|
|
@usage1 "usage: 20 "uxncli 20 "tar.rom 20 "t|x 20 "TARFILE 0a 00
|
|
@usage2 20 20 20 20 20 20 20 "uxncli 20 "tar.rom 20 "c 20 "TARFILE 20 "FILE1 20 "... 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
|
|
@no-input-arguments "error: 20 "no 20 "input 20 "files 0a 00
|
|
@invalid-mode "error: 20 "invalid 20 "mode 0a 00
|
|
@read-error "error 20 "reading 20 "data 0a 00
|
|
@write-error "error 20 "writing 20 "data 0a 00
|
|
@unsupported "skipped 20 "unsupported 20 "type 20 00
|
|
@meta-too-big "extended 20 "metadata 20 "field 20 "too 20 "big: 20 00
|
|
@invalid-checksum "error: 20 "invalid 20 "checksum 0a 00
|
|
@expected "expected: 20 00
|
|
@found "found: 20 20 20 20 00
|
|
@missing-input "error: 20 "missing 20 "input 20 "file: 20 00
|
|
@input-toobig "error: 20 "input 20 "file 20 "too 20 "large: 20 00
|
|
@destination-exists "error: 20 "destination 20 "already 20 "exists: 20 00
|
|
@default-d-mode "0000755 00
|
|
@default-f-mode "0000644 00
|
|
@default-id "0000000 00
|
|
@default-mtime "07033241577 00
|
|
@failed-to-write "error: 20 "failed 20 "to 20 "write 20 "file: 20 00
|
|
@dir-toobig "error: 20 "input 20 "directory 20 "listing 20 "too 20 "large: 20 00
|
|
|
|
( load argument parser )
|
|
~arg.tal
|
|
|
|
( HEADER DETAILS )
|
|
( )
|
|
( header -- basic v7 tar header )
|
|
( /filename - name of file, null-terminated. if ustar, check prefix )
|
|
( /mode - file permissions, ignored by uxn )
|
|
( /owner - owner ID, ignored by uxn )
|
|
( /group - group ID, ignored by uxn )
|
|
( /size - file size as 11 octal digits. max size is 8GiB. )
|
|
( /mtime - last modification time, ignored by uxn )
|
|
( /checksum - 6 octal digits followed by NUL, then space )
|
|
( /type -- only 0, 5, and 7 are supported )
|
|
( '0' [or NUL] normal file )
|
|
( '1' hard link )
|
|
( '2' symlink )
|
|
( '3' character device )
|
|
( '4' block device )
|
|
( '5' directory )
|
|
( '6' fifo )
|
|
( '7' contiguous file -- treat as normal file )
|
|
( 'g' global extended header with metadata; POSIX.1-2001 )
|
|
( 'x' extended header with metadata for next file; POSIX.1-2001 )
|
|
( 'A' solaris ACL )
|
|
( 'D' gnu dump dir )
|
|
( 'E' solaris extended attrs )
|
|
( 'I' inode metadata )
|
|
( 'K' this entry's data is the long link location of next file, null-terminated? )
|
|
( 'L' this entry's data is the long filename of next file, null-terminated )
|
|
( 'M' continuation file )
|
|
( 'N' old gnu for long names )
|
|
( 'S' sparse files )
|
|
( 'V' tape/volume header )
|
|
( 'X' extended attrs, sun )
|
|
( /linkname -- for hardlinks, the file containing the linked data )
|
|
( uheader -- ustar header, found in v7 padding bytes )
|
|
( /ustar -- ustar indiciator, should be "ustar " )
|
|
( /version -- ustar version )
|
|
( /owner-name -- owner name string, ignored by uxn )
|
|
( /group-name -- group name string, ignored by uxn )
|
|
( /major -- major device number, ignored by uxn )
|
|
( /minor -- minor device number, ignored by uxn )
|
|
( /filename-prefix -- if non-null, true path is prefix+"/"+filename )
|
|
( )
|
|
( the v7 header is always 512 bytes even if ustar indicator is absent. )
|
|
|
|
@header
|
|
&filename $64 ( 0x00: filename, string, 100 byte )
|
|
&mode $8 ( 0x64: mode, octal-1, 8 bytes )
|
|
&owner $8 ( 0x6c: owner, octal-1, 8 bytes )
|
|
&group $8 ( 0x74: group, octal-1, 8 bytes )
|
|
&size $c ( 0x7c: size, octal-1, 12 bytes )
|
|
&mtime $c ( 0x88: mtime, octal-1, 12 bytes )
|
|
&checksum $8 ( 0x94: checksum, octal-2, 8 bytes )
|
|
&type $1 ( 0x9c: file type, 1 byte )
|
|
&linkname $64 ( 0x9d: linked filename, string, 100 bytes )
|
|
( >> )
|
|
@uheader
|
|
&ustar $6 ( 0x101: ustar indicator, non-terminated string, 6 bytes, "ustar " )
|
|
&version $2 ( 0x107: ustar version, non-terminated string, 2 bytes )
|
|
&owner-name $20 ( 0x109: owner name, string, 32 bytes )
|
|
&group-name $20 ( 0x129: group name, string, 32 bytes )
|
|
&major $8 ( 0x149: device major number, octal? )
|
|
&minor $8 ( 0x151: device minor number, octal? )
|
|
&filename-prefix $9b ( 0x159: prefix before filename, string, 155 bytes )
|
|
&pad $c ( 0x1f4: padding, 12 bytes )
|
|
&end ( 0x200: end of header )
|
|
|
|
( path buffer )
|
|
|3be8 @path-buf $400
|
|
|
|
( small scratch buffer )
|
|
|3fe8 @scratch $10
|
|
|
|
( up to 8 bytes for long size )
|
|
|3ff8 @long-size $4 &mid $4
|
|
|
|
( buffer for up to 2048 characters of long names/paths )
|
|
|4000 @ls-buf $4000
|
|
|
|
( buffer for reading up to 32k bytes of data at a time )
|
|
|8000 @buffer $8000
|