publish sketch of tar.tal
This commit is contained in:
parent
268a437b47
commit
6ef07ad84e
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue