From 4a0a3e262797c8e708081c4a45bd964a5b0900c5 Mon Sep 17 00:00:00 2001 From: d_m Date: Fri, 14 Feb 2025 00:15:07 -0500 Subject: [PATCH] progress on creating archives --- tar.tal | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 111 insertions(+), 1 deletion(-) diff --git a/tar.tal b/tar.tal index 658c76e..58c74cc 100644 --- a/tar.tal +++ b/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