progress on creating archives
This commit is contained in:
parent
7640bce419
commit
4a0a3e2627
112
tar.tal
112
tar.tal
|
|
@ -227,8 +227,109 @@
|
|||
|
||||
@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 archive-path 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 ( path* -> )
|
||||
POP2 JMP2r
|
||||
|
||||
@archive-path ( path* -> )
|
||||
zero-header DUP2 path-read-size ( path* )
|
||||
;long-size LDA LIT "- EQU ?archive-dir ( path* )
|
||||
LIT2r =header ( path* [h*] )
|
||||
STH2kr LDA LIT "/ NEQ ?&rel-path ( path* [h*] )
|
||||
LIT ". STH2kr STA INC2r ( path* [h+1*] )
|
||||
&rel-path STH2r copy-str ( ; write file name )
|
||||
;default-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 )
|
||||
;u-sum compute-sum ( checksum* )
|
||||
|
||||
@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* )
|
||||
|
||||
@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* )
|
||||
|
||||
@size-to-octal ( -> )
|
||||
;long-size LDA2 ( hi* )
|
||||
;long-size/mid LDA2 ( hi* lo* )
|
||||
;scratch render-octal32 ( )
|
||||
#000b ;header/size !save-octal ( )
|
||||
|
||||
@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* )
|
||||
|
||||
@save-octal ( count* addr* -> )
|
||||
LIT2r ffff ( [ffff*] )
|
||||
OVR2 ADD2 STH2 OVR2r ADD2r ( count* [ffff* addr+count-1*] )
|
||||
;scratch SWP2 OVR2 ADD2 SWP2 ( limit* s* [ffff* h*] )
|
||||
&loop LDAk STH2kr STA ( limit* s* [ffff* h*] )
|
||||
INC2 OVR2r ADD2r GTH2k ?&loop ( limit* s+1* [ffff* h-1*] )
|
||||
|
||||
@copy-str ( s* addr* -> addr+n* )
|
||||
STH2
|
||||
&loop LDAk DUP ?&next POP STH2r INC2 JMP2r
|
||||
&next STH2kr STA INC2 INC2r !&loop
|
||||
|
||||
( 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* -> )
|
||||
|
|
@ -429,6 +530,12 @@
|
|||
@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-mode "0000755 00
|
||||
@default-id "0000000 00
|
||||
@default-mtime "07033241577 00
|
||||
|
||||
( load argument parser )
|
||||
~arg.tal
|
||||
|
|
@ -499,8 +606,11 @@
|
|||
&pad $c ( 0x1f4: padding, 12 bytes )
|
||||
&end ( 0x200: end of header )
|
||||
|
||||
( small scratch buffer )
|
||||
|77e8 @scratch $10
|
||||
|
||||
( up to 8 bytes for long size )
|
||||
|77f8 @long-size $8
|
||||
|77f8 @long-size $4 &mid $4
|
||||
|
||||
( buffer for up to 2048 characters of long names/paths )
|
||||
|7800 @long-buf $800
|
||||
|
|
|
|||
Loading…
Reference in New Issue