From 9c3cdc05756d8eb222bc006e6ffa43c3f99e82b5 Mon Sep 17 00:00:00 2001 From: d_m Date: Mon, 17 Feb 2025 22:53:28 -0500 Subject: [PATCH] tar.tal: progress towards creating archive --- tar.tal | 101 +++++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 78 insertions(+), 23 deletions(-) diff --git a/tar.tal b/tar.tal index ac0356e..3a9be03 100644 --- a/tar.tal +++ b/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< ) + ;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