tar.tal: progress towards creating archive
This commit is contained in:
parent
7dc1b62b7b
commit
9c3cdc0575
101
tar.tal
101
tar.tal
|
|
@ -88,6 +88,11 @@
|
|||
;header .File1/r DEO2
|
||||
.File1/ok DEI2 #0200 EQU2 JMP2r
|
||||
|
||||
@write-header ( -> ok^ )
|
||||
#0200 .File1/len DEO2
|
||||
;header .File1/w DEO2
|
||||
.File1/ok DEI2 #0200 EQU2 JMP2r
|
||||
|
||||
@validate-checksum ( -> ok^ )
|
||||
;header/checksum load-octal6 ( chi* clo* )
|
||||
STH2k SWP2 STH2k SWP2 ( chi* clo* [clo* chi*] )
|
||||
|
|
@ -234,7 +239,9 @@
|
|||
.File1/name DEO2
|
||||
#00 .File1/append DEO
|
||||
;arg/count LDA #02
|
||||
&loop DUP arg/read archive-path INC GTHk ?&loop
|
||||
&loop DUP arg/read ;path-buf SWP2 archive-path ?&ok
|
||||
;failed-to-write print arg/read print #0a18 DEO #01 !exit
|
||||
&ok INC GTHk ?&loop
|
||||
POP2 JMP2r
|
||||
|
||||
&dest-exists ;destination-exists print
|
||||
|
|
@ -262,29 +269,66 @@
|
|||
;long-size .File2/stat DEO2
|
||||
JMP2r
|
||||
|
||||
@archive-dir ( path* -> )
|
||||
POP2 JMP2r
|
||||
@archive-dir ( base* path* -> ok^ )
|
||||
LIT2r =header ( base* path* [h*] )
|
||||
STH2kr LDA LIT "/ NEQ ?&rel-path ( base* path* [h*] )
|
||||
LIT ". STH2kr STA INC2r ( base* path* [h+1*] )
|
||||
&rel-path DUP2 STH2r copy-str0 ( base* path* s1* ; write file name )
|
||||
LIT2 "/ 00 SWP2 STA2 ( base* path* ; terminate dir path with / )
|
||||
;default-d-mode ;header/mode copy-str ( base* path* ; write file permissions )
|
||||
;default-id ;header/owner copy-str ( base* path* ; write file owner )
|
||||
;default-id ;header/group copy-str ( base* path* ; write file group )
|
||||
#0000 #0000 ;scratch ( base* path* hi* lo* addr* )
|
||||
render-octal32 ( base* path* )
|
||||
#000b ;header/size save-octal ( base* path* )
|
||||
;default-mtime ;header/mtime copy-str ( base* path* ; write mtime )
|
||||
LIT "5 ;header/type STA ( base* path* ; write '0' for normal file )
|
||||
save-checksum ?archive-children ( base* path* )
|
||||
POP2 POP2 #00 JMP2r ( not-ok^ )
|
||||
|
||||
@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 )
|
||||
@archive-children ( base* path* -> ok^ )
|
||||
#010e DEO
|
||||
DUP2 .File2/name DEO2 ( path* )
|
||||
#4000 .File2/len DEO2 ( path* )
|
||||
;ls-buf .File2/r DEO2 ( path* )
|
||||
.File2/ok DEI2 DUP2 #4000 EQU2 ?&toobig ( path* size* )
|
||||
#010e DEO POP2 ( path* )
|
||||
;ls-buf #0040 dump-mem ( path* )
|
||||
print #0a18 DEO #01 JMP2r ( ok^ )
|
||||
|
||||
&toobig ;dir-toobig print print
|
||||
#0a18 DEO #01 !exit
|
||||
|
||||
@archive-path ( base* path* -> ok^ )
|
||||
zero-header ( base* path* )
|
||||
( TODO: copy path to base here, replace with base2 )
|
||||
DUP2 path-read-size ( base* path* )
|
||||
;long-size LDA LIT "- EQU ?archive-dir ( base* path* )
|
||||
LIT2r =header ( base* path* [h*] )
|
||||
STH2kr LDA LIT "/ NEQ ?&rel-path ( base* path* [h*] )
|
||||
LIT ". STH2kr STA INC2r ( base* path* [h+1*] )
|
||||
&rel-path STH2r copy-str POP2 ( ; write file name )
|
||||
;default-f-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 )
|
||||
#010e DEO
|
||||
;default-mtime ;header/mtime copy-str ( ; write mtime )
|
||||
LIT "0 ;header/type STA ( ; write '0' for normal file )
|
||||
!save-checksum ( ok^ )
|
||||
|
||||
@save-checksum ( -> )
|
||||
;u-sum compute-sum ( checksum* )
|
||||
;scratch render-octal32 ( )
|
||||
#0006 ;header/checksum save-octal ( )
|
||||
#20 ;header/checksum #0007 ADD2 STA ( )
|
||||
!write-header ( ok^ )
|
||||
|
||||
@ascii-to-digit ( c^ -> n* )
|
||||
#00 SWP DUP #39 GTH #27 MUL SUB #30 SUB JMP2r
|
||||
|
||||
@ascii-to-short ( s* -> n* )
|
||||
#0000 SWP2 LITr c0 ( sum* s* [shift^] )
|
||||
&loop LDAk #30 SUB ( sum0* s* digit^ [shift^] )
|
||||
#00 SWP ( sum0* s* digit* [shift^] )
|
||||
&loop LDAk ascii-to-digit ( sum0* s* digit* [shift^] )
|
||||
STHkr SFT2 ( sum0* s* digit<<shift* [shift^] )
|
||||
ROT2 ADD2 SWP2 ( sum0+digit<<shift* s* [shift^] )
|
||||
STHkr #00 EQU ?&done ( sum1* s* [shift^] )
|
||||
|
|
@ -292,6 +336,7 @@
|
|||
&done POP2 POPr JMP2r ( sum1* )
|
||||
|
||||
@size-to-octal ( -> )
|
||||
;long-size #0008 dump-mem
|
||||
;long-size ascii-to-short ( hi* )
|
||||
;long-size/mid ascii-to-short ( hi* lo* )
|
||||
;scratch ( hi* lo* addr* )
|
||||
|
|
@ -309,7 +354,8 @@
|
|||
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* )
|
||||
( STH2r INC2 JMP2r ) ( addr+11* )
|
||||
POP2r JMP2r
|
||||
|
||||
@short-to-octal ( n* addr* -> n>>15^ addr+5* )
|
||||
byte-to-octal STH2 SWP ( lo>>6^ hi^ [addr+2*] )
|
||||
|
|
@ -334,12 +380,15 @@
|
|||
OVR2 ADD2 SWP2 ( limit=count+s* s* [ffff* h*] )
|
||||
&loop LDAk STH2kr STA ( limit* s* [ffff* h*] ; h<-s )
|
||||
INC2 OVR2r ADD2r GTH2k ?&loop ( limit* s+1* [ffff* h-1*] )
|
||||
POP2 POP2 POP2r POP2r #010e DEO JMP2r ( )
|
||||
POP2 POP2 POP2r POP2r JMP2r ( )
|
||||
|
||||
@copy-str0 ( s* addr* -> s1* )
|
||||
STH2
|
||||
&loop LDAk DUP ?&next POP POP2 STH2r JMP2r
|
||||
&next STH2kr STA INC2 INC2r !&loop
|
||||
|
||||
@copy-str ( s* addr* -> )
|
||||
STH2
|
||||
&loop LDAk DUP ?&next POP POP2 POP2r JMP2r
|
||||
&next STH2kr STA INC2 INC2r !&loop
|
||||
copy-str0 POP2 JMP2r
|
||||
|
||||
( we know header is exactly 512 bytes, an even number )
|
||||
@zero-header ( -> )
|
||||
|
|
@ -550,9 +599,12 @@
|
|||
@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-d-mode "0000755 00
|
||||
@default-f-mode "0000644 00
|
||||
@default-id "0000000 00
|
||||
@default-mtime "07033241577 00
|
||||
@failed-to-write "error: 20 "failed 20 "to 20 "write 20 "file: 20 00
|
||||
@dir-toobig "error: 20 "input 20 "directory 20 "listing 20 "too 20 "large: 20 00
|
||||
|
||||
( load argument parser )
|
||||
~arg.tal
|
||||
|
|
@ -623,14 +675,17 @@
|
|||
&pad $c ( 0x1f4: padding, 12 bytes )
|
||||
&end ( 0x200: end of header )
|
||||
|
||||
( path buffer )
|
||||
|3be8 @path-buf $400
|
||||
|
||||
( small scratch buffer )
|
||||
|77e8 @scratch $10
|
||||
|3fe8 @scratch $10
|
||||
|
||||
( up to 8 bytes for long size )
|
||||
|77f8 @long-size $4 &mid $4
|
||||
|3ff8 @long-size $4 &mid $4
|
||||
|
||||
( buffer for up to 2048 characters of long names/paths )
|
||||
|7800 @long-buf $800
|
||||
|4000 @ls-buf $4000
|
||||
|
||||
( buffer for reading up to 32k bytes of data at a time )
|
||||
|8000 @buffer $8000
|
||||
|
|
|
|||
Loading…
Reference in New Issue