 : typeflag-X ( header -- ) unknown-typeflag ;
 
 : (parse-tar) ( -- )
-    512 read 
-    global [ dup hexdump. flush ] bind
-    [
+    block-size read dup length 512 = [
         parse-tar-header
-        ! global [ dup tar-header-name [ print flush ] when* ] bind 
-        dup tar-header-typeflag
+        dup typeflag>>
         {
             { 0 [ typeflag-0 ] }
             { CHAR: 0 [ typeflag-0 ] }
-            { CHAR: 1 [ typeflag-1 ] }
+            ! { CHAR: 1 [ typeflag-1 ] }
             { CHAR: 2 [ typeflag-2 ] }
-            { CHAR: 3 [ typeflag-3 ] }
-            { CHAR: 4 [ typeflag-4 ] }
+            ! { CHAR: 3 [ typeflag-3 ] }
+            ! { CHAR: 4 [ typeflag-4 ] }
             { CHAR: 5 [ typeflag-5 ] }
-            { CHAR: 6 [ typeflag-6 ] }
-            { CHAR: 7 [ typeflag-7 ] }
+            ! { CHAR: 6 [ typeflag-6 ] }
+            ! { CHAR: 7 [ typeflag-7 ] }
             { CHAR: g [ typeflag-g ] }
-            { CHAR: x [ typeflag-x ] }
-            { CHAR: A [ typeflag-A ] }
-            { CHAR: D [ typeflag-D ] }
-            { CHAR: E [ typeflag-E ] }
-            { CHAR: I [ typeflag-I ] }
-            { CHAR: K [ typeflag-K ] }
-            { CHAR: L [ typeflag-L ] }
-            { CHAR: M [ typeflag-M ] }
-            { CHAR: N [ typeflag-N ] }
-            { CHAR: S [ typeflag-S ] }
-            { CHAR: V [ typeflag-V ] }
-            { CHAR: X [ typeflag-X ] }
-            [ unknown-typeflag ]
-        } case
-        ! dup tar-header-size zero? [
-            ! out-stream get [ dispose ] when
-            ! out-stream off
-            ! drop
-        ! ] [
-            ! dup tar-header-name
-            ! dup parent-dir base-dir prepend-path
-            ! global [ dup [ . flush ] when* ] bind 
-            ! make-directories <file-writer>
-            ! out-stream set
-            ! read-tar-blocks
-        ! ] if
-        (parse-tar)
-    ] when* ;
+            ! { CHAR: x [ typeflag-x ] }
+            ! { CHAR: A [ typeflag-A ] }
+            ! { CHAR: D [ typeflag-D ] }
+            ! { CHAR: E [ typeflag-E ] }
+            ! { CHAR: I [ typeflag-I ] }
+            ! { CHAR: K [ typeflag-K ] }
+            ! { CHAR: L [ typeflag-L ] }
+            ! { CHAR: M [ typeflag-M ] }
+            ! { CHAR: N [ typeflag-N ] }
+            ! { CHAR: S [ typeflag-S ] }
+            ! { CHAR: V [ typeflag-V ] }
+            ! { CHAR: X [ typeflag-X ] }
+            { f [ drop ] }
+        } case (parse-tar)
+    ] [
+        drop
+    ] if ;
 
-: parse-tar ( path -- obj )
-    binary [
-        "resource:tar-test" base-dir set
-        global [ nl nl nl "Starting to parse .tar..." print flush ] bind
-        global [ "Expanding to: " write base-dir get . flush ] bind
-        (parse-tar)
-    ] with-file-writer ;
+: parse-tar ( path -- )
+    normalize-path dup parent-directory base-dir [
+         binary [ (parse-tar) ] with-file-reader
+    ] with-variable ;


! Long file name
: typeflag-L ( header -- )
    <string-writer> [ read-data-blocks ] keep
    >string [ zero? ] right-trim filename set
    global [ "long filename: " write filename get . flush ] bind
    filename get tar-append-path make-directories ;

! Multi volume continuation entry
: typeflag-M ( header -- ) unknown-typeflag ;

: typeflag-9 ( header -- ) unknown-typeflag ;

! Global POSIX header
: typeflag-g ( header -- ) typeflag-0 ;

! Extended POSIX header
: typeflag-x ( header -- ) unknown-typeflag ;
