( 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
    ;header/filename LDA ?&non-null
    #800f DEO BRK
    &non-null
    ;header/type LDA            ( type^ )
    DUP #00    EQU ?list-file   ( )
    DUP LIT "0 EQU ?list-file   ( )
    DUP LIT "5 EQU ?list-dir    ( )
    !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-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 DUP2 LTH ?&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* )
    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* -> )
    DUP2 #fe00 GTH2 ?&round-hi
    #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r
    &round-hi
    POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r
    &round-carry
    POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r
    &overflow #0000 DIV

( 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