correctly compute and validate checksums

tar.tal

@@ -43,8 +43,8 @@
 @run ( -> BRK )
     #01 arg/read .File1/name DEO2
     #00 arg/read LDA
-    DUP LIT "t NEQ ?{ list-entries #00 !exit }
+    DUP LIT "t NEQ ?{ POP list-entries #00 !exit }
-    DUP LIT "x NEQ ?{ expand-entries #00 !exit }
+    DUP LIT "x NEQ ?{ POP expand-entries #00 !exit }
     POP ;invalid-mode print ;usage print #00 !exit
 
 ( exit normally )
@@ -67,20 +67,73 @@
     LDAk #18 DEO INC2 GTH2k ?&loop ( limit* s+1* )
     &done POP2 POP2 JMP2r          ( )
 
+@print-filename ( -> )
+    ;header/filename sanitize-path #0064 lprint #0a18 DEO JMP2r
+
+@print-long ( hi* lo* -> )
+    dump-long #0a18 DEO JMP2r
+
 ( read 512 bytes of header for the next tar entry. )
 ( assumes .File1/name is already set. )
 @read-header ( -> ok^ )
     #0200 .File1/len DEO2
     ;header .File1/r DEO2
-    ( TODO validate checksum )
     .File1/ok DEI2 #0200 EQU2 JMP2r
 
+@validate-checksum ( -> ok^ )
+    ;header/checksum load-octal6            ( chi* clo* )
+    STH2k SWP2 STH2k SWP2                   ( chi* clo* [clo* chi*] )
+    ;u-sum compute-sum                      ( chi* clo* uhi* ulo* [clo* chi*] )
+    u32-eq ?&ok1                            ( [clo* chi*] )
+    STH2r STH2r ;s-sum compute-sum          ( chi* clo* shi* slo* )
+    u32-eq ?&ok2                            ( )
+    ;invalid-checksum print                 ( ; error message )
+    print-filename                          ( ; filename of affected entry )
+    ;expected print                         ( ; "expected: " )
+    ;header/checksum load-octal6 print-long ( ; expected checksum )
+    ;found print                            ( ; "found:    " )
+    ;u-sum compute-sum print-long           ( ; found checksum )
+    #00 JMP2r                               ( 0^ )
+    &ok1 POP2r POP2r &ok2 #01 JMP2r         ( 1^ )
+
+( maximum checksum is 0001fe00 but in practice )
+( almost all checksums will fit in 16-bits )
+@compute-sum ( fn* -> sum0* sum1* )
+    STH2 ;header/checksum ;header STH2kr JSR2       ( n0* [fn*] )
+    #0100 ADD2 ;uheader/end ;header/type STH2r JSR2 ( n1* n2* )
+    OVR2 ADD2 GTH2k #00 SWP                         ( n1* sum* carry* )
+    ROT2 POP2 SWP2 JMP2r                            ( carry* sum* )
+
+@u32-eq ( xhi* xlo* yhi* ylo* -> bool^ )
+    ROT2 EQU2 STH EQU2 STHr AND JMP2r
+
+( return 16-bit checksum )
+( technically it should be 17-bit. for simplicity we'll )
+( just check the lower 16-bits. )
+@u-sum ( limit* start* -> sum* )
+    LIT2r 0000                  ( limit* start* [sum*] )
+    &loop LDAk LITr 00 STH      ( limit* start* [sum* n*] )
+    ADD2r INC2 GTH2k ?&loop     ( limit* pos+1* [sum+n*] )
+    POP2 POP2 STH2r JMP2r       ( sum* )
+
+( similar to unsigned-sum but treats 8-bit ascii differently )
+( mostly only used for compatibility with old tar files )
+@s-sum ( limit* start* -> sum* )
+    LIT2r 0000                   ( limit* start* [sum*] )
+    &loop LDAk                   ( limit* start* c^ [sum*] )
+    DUP #07 SFT #ff MUL SWP STH2 ( limit* start* [sum* n*] )
+    ADD2r INC2 GTH2k ?&loop      ( limit* pos+1* [sum+n*] )
+    POP2 POP2 STH2r JMP2r        ( sum* )
+
+
+
 ( list all the entries in the tar archive )
 @list-entries ( -> )
     read-header ?{ JMP2r }
     ;header/filename LDA ?&non-null
     #800f DEO BRK
     &non-null
+    validate-checksum         ( )
     ;header/type LDA          ( type^ )
     DUP #00    EQU ?list-file ( type^ )
     DUP LIT "0 EQU ?list-file ( type^ )
@@ -104,8 +157,7 @@
     ;unsupported print
     #18 DEO #2018 DEO
     ;header/size load-octal11 dump-longer #2018 DEO
-    ;header/filename sanitize-path
+    print-filename
-    #0064 lprint #0a18 DEO
     ;header/size load-octal11 round-up-to-512 skip !list-entries
 
 ( verbose file entry listing )
@@ -113,7 +165,7 @@
     POP
     LIT "f #18 DEO #2018 DEO
     ;header/size load-octal11 dump-longer #2018 DEO
-    ;header/filename #0064 lprint #0a18 DEO
+    print-filename
     ;header/size load-octal11 round-up-to-512 skip !list-entries
 
 ( verbose directory entry listing )
@@ -121,7 +173,7 @@
     POP
     LIT "d #18 DEO #2018 DEO
     ;header/size load-octal11 dump-longer #2018 DEO
-    ;header/filename #0064 lprint #0a18 DEO
+    print-filename
     !list-entries
 
 ( expand a .tar archive in the current working directory )
@@ -146,16 +198,14 @@
 
 @expand-file ( type^ -> )
     POP
-    ;header/filename sanitize-path
+    print-filename
-    DUP2 #0064 lprint #0a18 DEO
     .File2/name DEO2
     ;header/size load-octal11 STH2k write
     STH2r remainder-512 skip-lo !expand-entries
 
 @expand-dir ( type^ -> )
     POP
-    ;header/filename sanitize-path
+    print-filename
-    DUP2 #0064 lprint #0a18 DEO
     .File2/name DEO2
     #0004 .File2/len DEO2
     #0001 .File2/w DEO2
@@ -164,8 +214,7 @@
 @expand-unsupported ( type^ -> )
     ;unsupported print
     #18 DEO LIT2 ": 18 DEO #2018 DEO
-    ;header/filename sanitize-path
+    print-filename
-    #0064 lprint #0a18 DEO
     ;header/size load-octal11 round-up-to-512 skip !expand-entries
 
 ( src and dst should be paths )
@@ -275,6 +324,14 @@
     #10 SFT #01 SFT2 STH2r      ( hi* lo* )
     JMP2r                       ( hi* lo* )
 
+( returns values between #0000 #0000 and #0003 #ffff )
+@load-octal6 ( addr* -> hi* lo* )
+    STH2k LDA octal-digit   ( o^ [addr*] )
+    #0001 SFT2              ( o1^ o2^ [addr*] )
+    #0000 ROT SWP2 SWP SWP2 ( o1* o2* [addr*] )
+    STH2r INC2 load-octal5  ( o1* o2* n* )
+    ORA2 JMP2r              ( o1* o2|n* )
+
 ( returns values between #0000 and #7fff )
 ( )
 ( octal5 of 77777 = #7fff, max value )
@@ -359,6 +416,9 @@
 @write-error "error 20 "writing 20 "data 0a 00
 @unsupported "skipped 20 "unsupported 20 "type 20 00
 @meta-too-big "extended 20 "metadata 20 "field 20 "too 20 "big: 20 00
+@invalid-checksum "error: 20 "invalid 20 "checksum 0a 00
+@expected "expected: 20 00
+@found "found: 20 20 20 20 00
 
 ( load argument parser )
 ~arg.tal