diff --git a/mksite.sh b/mksite.sh index d6a8ec7..dfed62e 100755 --- a/mksite.sh +++ b/mksite.sh @@ -12,7 +12,7 @@ for NAME in about.txt asma.rom math32.tal test-math32.tal test-math32.py \ alloc.tal test-alloc.tal term.tal term.py cp437.tal term.c \ wave.tal graph.tal arg.tal arg-demo.tal \ deck.tal cards.tal card-sprites.tal mask-sprites.tal \ - testing.tal type-abc.tal \ + testing.tal type-abc.tal tar.tal \ ; do echo "-> $NAME" cp $NAME /var/www/plastic-idolatry.com/html/erik/nxu diff --git a/tar.tal b/tar.tal new file mode 100644 index 0000000..cf127f9 --- /dev/null +++ b/tar.tal @@ -0,0 +1,209 @@ +( 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 + +@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 + +@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 + +@emit5 ( carry^ hi* lo* -> ) + STH2 STH2 emit/byte STH2r STH2r !emit/long + +@emit + &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 + +@read-error "error 20 "reading 20 "data 0a 00 + +( LIKELY BUG: skipping large distances may not work ) + +( skips carry*2^32 + hi*2^16 + lo bytes ) +@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 + +@is-size-32 ( -> bool^ ) + ;header/size LDA LIT "4 LTH JMP2r + +@is-size-16 ( -> bool^ ) + ;header/size LDAk LIT "0 NEQ ?&fail + INC2 LDAk LIT "0 NEQ ?&fail + INC2 LDAk LIT "0 NEQ ?&fail + INC2 LDAk LIT "0 NEQ ?&fail + INC2 LDAk LIT "0 NEQ ?&fail + INC2 LDA LIT "2 LTH JMP2r + &fail POP2 #00 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* ) + +( 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