nxu/tar.tal

301 lines
8.9 KiB
Tal

( tal.tal )
( )
( by d_m )
( )
( currently only supports listing the contents of tar files )
( File1 is used to read the tar file )
( File2 is used to 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 ( code^ -> BRK )
#80 ORA #0f DEO BRK
@arg-callback ( -> )
;arg/count LDA
DUP #00 EQU ?&missing
DUP #01 GTH ?&toomany
POP !run
&missing ;missing-filename !&error
&toomany ;too-many-arguments
&error print ;usage print #01 !exit
@run ( -> )
#00 arg/read .File1/name DEO2 list #00 !exit
@on-stdin ( -> BRK ) BRK
@usage "usage: 20 "uxncli 20 "tar.rom 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
@unsupported "unsupported 20 "format 20 00
@panic ( -> $exit )
#010e DEO #010f DEO BRK
@print ( s* -> )
&loop LDAk #00 EQU ,&eof JCN
LDAk #18 DEO INC2 ,&loop JMP
&eof POP2 JMP2r
@read-header ( -> ok^ )
( assume .File1/name was already written )
#0200 .File1/len DEO2
;header .File1/r DEO2
.File1/ok DEI2 #0200 EQU2 JMP2r
@list ( -> )
read-header ?&ok JMP2r &ok
( dump-header )
;header/filename LDA ?&non-null
#800f DEO BRK
&non-null
;header/type LDA ( type^ )
DUP #00 EQU ?list-file-v ( )
DUP LIT "0 EQU ?list-file-v ( )
DUP LIT "5 EQU ?list-dir-v ( )
!list-unsupported ( )
@list-file ( 00^ -> )
POP
LIT "f #18 DEO #2018 DEO
;header/filename print #0a18 DEO
;header/size load-octal11 round-up-to-512 skip !list
@list-dir ( 00^ -> )
POP
LIT "d #18 DEO #2018 DEO
;header/filename print #0a18 DEO
!list
@list-file-v ( 00^ -> )
POP
LIT "f #18 DEO #2018 DEO
( ;header/mode #0008 dump-mem0 )
( ;header/owner #0008 dump-mem0 )
( ;header/group #0008 dump-mem0 )
( ;header/size #000b dump-mem0 )
( ;header/mtime #000b dump-mem0 )
;header/size load-octal11 dump-longer #2018 DEO
;header/filename print #0a18 DEO
;header/size load-octal11 round-up-to-512 skip !list
@list-dir-v ( 00^ -> )
POP
LIT "d #18 DEO #2018 DEO
( ;header/mode #0008 dump-mem0 )
( ;header/owner #0008 dump-mem0 )
( ;header/group #0008 dump-mem0 )
( ;header/size #000b dump-mem0 )
( ;header/mtime #000b dump-mem0 )
;header/size load-octal11 dump-longer #2018 DEO
;header/filename print #0a18 DEO
!list
@list-unsupported ( type^ -> )
;unsupported print emit/byte #0a18 DEO !panic
!list
( 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 ( )
.File1/len
@write-file-header ( filename* size* -> )
SWP2 ;header/filename copy JMP2r
write-size-2
( TODO: checksum )
LIT "0 ;header/type STA
#00 ;header/linkname STA
JMP2r
@write-file-body ( size* data* -> )
SWP2 .File1/len DEO2 .File1/w DEO2 JMP2r
@mod ( x* y* -> x%y* )
DIV2k MUL2 SUB2 JMP2r
@write-size-2 ( size* -> )
;header/size STH2 ( size* [start*] )
LIT2r 000a ADD2r ( size* [start* last*] )
&loop ( size* [start* pos*] )
LTH2kr STHr ?&done ( size* [start* pos*] )
DUP2 #0007 AND2 ( size* size%8* [start* pos*] )
NIP LIT "0 ADD ( size* octal^ [start* pos*] )
STH2kr STA ( size* [start* pos*] )
#03 SFT2 ( size/8* [start* pos*] )
LIT2 0001 SUB2 !&loop ( size/8* [start* pos-1*] )
&done ( zero* [start* pos*] )
POP2 POP2r POP2r JMP2r ( )
@copy ( src* dst* -> )
STH2
&loop
LDAk DUP STH2kr STA2 ?&ok
POP2 POP2r JMP2r
&ok INC2 INC2r !&loop
@read-error "error 20 "reading 20 "data 0a 00
( skips n bytes, specified as a 5-byte integer )
@skip ( carry^ hi* lo* -> )
skip-lo ( carry^ hi* )
skip-hi ( carry^ )
?skip-4g JMP2r ( )
@skip-4g ( -> ) skip-2g ( fall-through )
@skip-2g ( -> ) #8000 !skip-hi
( skips hi*2^16 bytes )
@skip-hi ( hi* -> )
#0000 SWP2 SUB2 ( -hi* )
&loop ORAk ?&ok POP2 JMP2r ( )
&ok skip-64k INC2 !&loop ( -hi+1* )
@skip-64k ( -> ) skip-32k ( fall-through )
@skip-32k ( -> ) #8000 !skip-buf
@skip-lo ( lo* -> )
DUP2 #8000 GTH2 ?&double !skip-buf
&double #8000 SUB2 skip-buf !skip-32k
( skips lo bytes )
@skip-buf ( lo* -> )
ORAk ?&non-zero POP2 JMP2r &non-zero
DUP2 .File1/len DEO2
;buffer .File1/r DEO2
.File1/ok DEI2 EQU2 ?&ok
;read-error print !panic
&ok JMP2r
@octal-digit ( char^ -> oct^ )
LIT "0 LTHk ?&zero SUB JMP2r &zero POP2 #00 JMP2r
( returns values between #00:0000:0000 and #01:ffff:ffff )
@load-octal11 ( addr* -> carry^ hi* lo* )
INC2k load-octal10 ( addr* hi* lo* ; load addr+1 )
STH2 STH2 ( addr* [lo* hi*] )
LDA ( LIT "0 SUB ) 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 )
@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 and #7fff )
@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 JSR STH2r STH2r
&long SWP2 ,&short JSR
&short SWP ,&byte JSR
&byte DUP #04 SFT ,&char JSR
&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
@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-mem0 ( start* size* -> )
#0001 SUB2 OVR2 ADD2 SWP2
&loop GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
LDAk #30 GTH ?{ #2018 DEO INC2 !&loop }
LDAk #18 DEO INC2 ( >> )
&loop2 GTH2k ?{ NIP2 LDA #18 DEO #2018 DEO JMP2r }
LDAk #18 DEO INC2 !&loop2
@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
LIT2 "s 18 DEO #2018 DEO
;header/size load-octal11 dump-longer #0a18 DEO
LIT2 "t 18 DEO #2018 DEO
;header/size load-octal11 round-up-to-512 dump-longer #0a18 DEO
LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO
JMP2r
( header/size is 11 octal digits; 12th digit is NUL )
( octal 77777777777 = #01 #ffff #ffff )
( octal 37777777777 = #ffff #ffff )
( octal 00000177777 = #ffff )
( octal 00000000377 = #ff )
( octal 00000000000 = #00 )
( header/type -- only 0 and 5 are supported )
( '0' normal file; also could be NUL )
( '1' hard link )
( '2' symlink )
( '3' character device )
( '4' block device )
( '5' directory )
( '6' fifo )
( '7' contiguous file )
( header is always exactly 512 bytes )
@header
&filename $64
&mode $8 ( octal )
&owner $8 ( octal )
&group $8 ( octal )
&size $c ( octal )
&mtime $c ( octal )
&checksum $8
&type $1 ( item type )
&linkname $64
( load argument parser )
~arg.tal
( buffer for reading up to 32k bytes of data )
|8000 @buffer $8000