d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

tar.tal: progress towards creating archive

This commit is contained in:
~d6 2025-02-17 22:53:28 -05:00
parent 7dc1b62b7b
commit 9c3cdc0575
1 changed files with 78 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
tar.tal
View File

@ -88,6 +88,11 @@
;header .File1/r DEO2 ;header .File1/r DEO2
.File1/ok DEI2 #0200 EQU2 JMP2r .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^ ) @validate-checksum ( -> ok^ )
;header/checksum load-octal6 ( chi* clo* ) ;header/checksum load-octal6 ( chi* clo* )
STH2k SWP2 STH2k SWP2 ( chi* clo* [clo* chi*] ) STH2k SWP2 STH2k SWP2 ( chi* clo* [clo* chi*] )
@ -234,7 +239,9 @@
.File1/name DEO2 .File1/name DEO2
#00 .File1/append DEO #00 .File1/append DEO
;arg/count LDA #02 ;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 POP2 JMP2r
&dest-exists ;destination-exists print &dest-exists ;destination-exists print
@ -262,29 +269,66 @@
;long-size .File2/stat DEO2 ;long-size .File2/stat DEO2
JMP2r JMP2r
@archive-dir ( path* -> ) @archive-dir ( base* path* -> ok^ )
POP2 JMP2r 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* -> ) @archive-children ( base* path* -> ok^ )
zero-header DUP2 path-read-size ( path* ) #010e DEO
;long-size LDA LIT "- EQU ?archive-dir ( path* ) DUP2 .File2/name DEO2 ( path* )
LIT2r =header ( path* [h*] ) #4000 .File2/len DEO2 ( path* )
STH2kr LDA LIT "/ NEQ ?&rel-path ( path* [h*] ) ;ls-buf .File2/r DEO2 ( path* )
LIT ". STH2kr STA INC2r ( path* [h+1*] ) .File2/ok DEI2 DUP2 #4000 EQU2 ?&toobig ( path* size* )
&rel-path STH2r copy-str ( ; write file name ) #010e DEO POP2 ( path* )
;default-mode ;header/mode copy-str ( ; write file permissions ) ;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/owner copy-str ( ; write file owner )
;default-id ;header/group copy-str ( ; write file group ) ;default-id ;header/group copy-str ( ; write file group )
size-to-octal ( ; write file size ) size-to-octal ( ; write file size )
#010e DEO
;default-mtime ;header/mtime copy-str ( ; write mtime ) ;default-mtime ;header/mtime copy-str ( ; write mtime )
LIT "0 ;header/type STA ( ; write '0' for normal file ) LIT "0 ;header/type STA ( ; write '0' for normal file )
!save-checksum ( ok^ )
@save-checksum ( -> )
;u-sum compute-sum ( 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* ) @ascii-to-short ( s* -> n* )
#0000 SWP2 LITr c0 ( sum* s* [shift^] ) #0000 SWP2 LITr c0 ( sum* s* [shift^] )
&loop LDAk #30 SUB ( sum0* s* digit^ [shift^] ) &loop LDAk ascii-to-digit ( sum0* s* digit* [shift^] )
#00 SWP ( sum0* s* digit* [shift^] )
STHkr SFT2 ( sum0* s* digit<<shift* [shift^] ) STHkr SFT2 ( sum0* s* digit<<shift* [shift^] )
ROT2 ADD2 SWP2 ( sum0+digit<<shift* s* [shift^] ) ROT2 ADD2 SWP2 ( sum0+digit<<shift* s* [shift^] )
STHkr #00 EQU ?&done ( sum1* s* [shift^] ) STHkr #00 EQU ?&done ( sum1* s* [shift^] )
@ -292,6 +336,7 @@
&done POP2 POPr JMP2r ( sum1* ) &done POP2 POPr JMP2r ( sum1* )
@size-to-octal ( -> ) @size-to-octal ( -> )
;long-size #0008 dump-mem
;long-size ascii-to-short ( hi* ) ;long-size ascii-to-short ( hi* )
;long-size/mid ascii-to-short ( hi* lo* ) ;long-size/mid ascii-to-short ( hi* lo* )
;scratch ( hi* lo* addr* ) ;scratch ( hi* lo* addr* )
@ -309,7 +354,8 @@
STH2r short-to-octal ( 0000000a 0000000z addr+10* ) STH2r short-to-octal ( 0000000a 0000000z addr+10* )
STH2 SWP #10 SFT ORA ( 000000az [addr+10*] ) STH2 SWP #10 SFT ORA ( 000000az [addr+10*] )
LIT "0 ADD STH2kr STA ( [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* ) @short-to-octal ( n* addr* -> n>>15^ addr+5* )
byte-to-octal STH2 SWP ( lo>>6^ hi^ [addr+2*] ) byte-to-octal STH2 SWP ( lo>>6^ hi^ [addr+2*] )
@ -334,12 +380,15 @@
OVR2 ADD2 SWP2 ( limit=count+s* s* [ffff* h*] ) OVR2 ADD2 SWP2 ( limit=count+s* s* [ffff* h*] )
&loop LDAk STH2kr STA ( limit* s* [ffff* h*] ; h<-s ) &loop LDAk STH2kr STA ( limit* s* [ffff* h*] ; h<-s )
INC2 OVR2r ADD2r GTH2k ?&loop ( limit* s+1* [ffff* h-1*] ) 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* -> ) @copy-str ( s* addr* -> )
STH2 copy-str0 POP2 JMP2r
&loop LDAk DUP ?&next POP POP2 POP2r JMP2r
&next STH2kr STA INC2 INC2r !&loop
( we know header is exactly 512 bytes, an even number ) ( we know header is exactly 512 bytes, an even number )
@zero-header ( -> ) @zero-header ( -> )
@ -550,9 +599,12 @@
@missing-input "error: 20 "missing 20 "input 20 "file: 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 @input-toobig "error: 20 "input 20 "file 20 "too 20 "large: 20 00
@destination-exists "error: 20 "destination 20 "already 20 "exists: 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-id "0000000 00
@default-mtime "07033241577 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 ) ( load argument parser )
~arg.tal ~arg.tal
@ -623,14 +675,17 @@
&pad $c ( 0x1f4: padding, 12 bytes ) &pad $c ( 0x1f4: padding, 12 bytes )
&end ( 0x200: end of header ) &end ( 0x200: end of header )
( path buffer )
|3be8 @path-buf $400
( small scratch buffer ) ( small scratch buffer )
|77e8 @scratch $10 |3fe8 @scratch $10
( up to 8 bytes for long size ) ( 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 ) ( 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 ) ( buffer for reading up to 32k bytes of data at a time )
|8000 @buffer $8000 |8000 @buffer $8000