From 036077e0aa87c858e966549ab3809594dc9b2259 Mon Sep 17 00:00:00 2001
From: d6 <d_m@plastic-idolatry.com>
Date: Thu, 17 Aug 2023 09:06:23 -0400
Subject: [PATCH] restructure tar.tal

---
 tar.tal | 86 ++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 57 insertions(+), 29 deletions(-)

diff --git a/tar.tal b/tar.tal
index 89eb7b6..06c79e8 100644
--- a/tar.tal
+++ b/tar.tal
@@ -66,15 +66,6 @@
     ;header/size load-octal11
     round-up-to-512 skip !list
 
-@round-up-to-512 ( carry^ hi* lo* -> )
-    DUP2 #fe00 GTH2 ?&round-hi
-    #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r
-    &round-hi
-    POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r
-    &round-carry
-    POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r
-    &overflow #0000 DIV
-
 @list-dir ( 00^ -> )
     POP
     LIT "d #18 DEO #2018 DEO
@@ -85,19 +76,49 @@
     ;unsupported print emit/byte #0a18 DEO !panic
     !list
 
-@emit5 ( carry^ hi* lo* -> )
-    STH2 STH2 emit/byte STH2r STH2r !emit/long
+( write data from memory into the tar file )
+@write-memory ( filename* size* data* -> )
+    STH2 STH2k write-file-header ( [data* size*] )
+    STH2r STH2r write-file-body JMP2r ( )
+    .File1/len
 
-@emit
-    &long SWP2 ,&short JSR
-    &short SWP ,&byte JSR
-    &byte DUP #04 SFT ,&char JSR
-    &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
+@write-file-header ( filename* size* -> )
+    SWP2 ;header/filename copy JMP2r
+    write-size-2
+    ( TODO: checksum )
+    LIT "0 ;header/type STA
+    #00 ;header/linkname STA
     JMP2r
 
+@write-file-body ( size* data* -> )
+    SWP2 .File1/len DEO2 .File1/w DEO2 JMP2r
+
+@mod ( x* y* -> x%y* )
+    DIV2k MUL2 SUB2 JMP2r
+
+@write-size-2 ( size* -> )
+    ;header/size STH2             ( size* [start*] )
+    LIT2r 000a ADD2r              ( size* [start* last*] )
+    &loop                         ( size* [start* pos*] )
+        LTH2kr STHr ?&done        ( size* [start* pos*] )
+        DUP2 #0007 AND2           ( size* size%8* [start* pos*] )
+        NIP LIT "0 ADD            ( size* octal^ [start* pos*] )
+        STH2kr STA                ( size* [start* pos*] )
+        #03 SFT2                  ( size/8* [start* pos*] )
+        LIT2 0001 SUB2 !&loop     ( size/8* [start* pos-1*] )
+    &done                         ( zero* [start* pos*] )
+        POP2 POP2r POP2r JMP2r    ( )
+
+@copy ( src* dst* -> )
+    STH2
+    &loop
+        LDAk DUP STH2kr STA2 ?&ok
+        POP2 POP2r JMP2r
+    &ok INC2 INC2r !&loop
+
 @read-error "error 20 "reading 20 "data 0a 00
 
-( skips carry*2^32 + hi*2^16 + lo bytes )
+( skips n bytes, specified as a 5-byte integer )
 @skip ( carry^ hi* lo* -> )
     skip-lo                     ( carry^ hi* )
     skip-hi                     ( carry^ )
@@ -128,18 +149,6 @@
     ;read-error print !panic
     &ok JMP2r
 
-@is-size-32 ( -> bool^ )
-    ;header/size LDA LIT "4 LTH JMP2r
-
-@is-size-16 ( -> bool^ )
-    ;header/size LDAk LIT "0 NEQ ?&fail
-    INC2         LDAk LIT "0 NEQ ?&fail
-    INC2         LDAk LIT "0 NEQ ?&fail
-    INC2         LDAk LIT "0 NEQ ?&fail
-    INC2         LDAk LIT "0 NEQ ?&fail
-    INC2         LDA  LIT "2 LTH JMP2r
-    &fail POP2 #00 JMP2r
-
 @octal-digit ( char^ -> oct^ )
     LIT "0 DUP2 LTH ?&zero SUB JMP2r &zero POP2 #00 JMP2r
 
@@ -171,6 +180,25 @@
         #03 SFT2 ORAk ?&loop    ( addr+1* place>>3* [sum2*] )
     POP2 POP2 STH2r JMP2r       ( sum2* )
 
+( emit 1, 2, 4, or 5 bytes as a decimal number )
+@emit
+    &1+long STH2 STH2 ,&byte JSR STH2r STH2r
+    &long SWP2 ,&short JSR
+    &short SWP ,&byte JSR
+    &byte DUP #04 SFT ,&char JSR
+    &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
+    JMP2r
+
+( round a given 5-byte size up to multiples of 512 )
+@round-up-to-512 ( carry^ hi* lo* -> )
+    DUP2 #fe00 GTH2 ?&round-hi
+    #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r
+    &round-hi
+    POP2 DUP2 #ffff EQU2 ?&round-carry INC2 #0000 JMP2r
+    &round-carry
+    POP2 DUP #ff EQU ?&overflow INC #0000 #0000 JMP2r
+    &overflow #0000 DIV
+
 ( header/size is 11 octal digits; 12th digit is NUL )
 ( octal 77777777777 = #01 #ffff #ffff )
 ( octal 37777777777 = #ffff #ffff )