separate (Tar)
procedure Write (Files : Name := "";
                 Archive : Name := Tar.Tape;
                 Record_Size : Positive := Tar.Tblock;
                 Records_Per_Block : Positive := 8;
                 Swap_Bytes : Boolean := False) is

    Source_File : Dio.File_Type;
    Target_File : Block_Buffer.Buffer_Type;
    Buffer : System.Byte_String (1 .. Record_Size);
    Zeroes : constant System.Byte_String (1 .. Record_Size) := (others => 0);

    procedure Write_Header (Name : String; Length : Natural) is
        Header : Tar_Header.Header := Tar_Header.Default;
        Buffer : System.Byte_String (1 .. Record_Size);
    begin
        Bounded_String.Copy (Header.Name, Name);
        Header.Size := Tar_Header.Long (Length);
        Tar_Header.Put (Header, Buffer);
        Block_Buffer.Write (Target_File, Buffer);
    end Write_Header;

    procedure Write_One_File (Source_Name : String) is
        Count : Natural;
    begin
        Dio.Open (Source_File, Dio.In_File, Source_Name);
        declare
            Unix_Name : constant String :=
               Naming.To_Unix_Name (Dio.Name (Source_File));
            File_Bytes : Natural := 0;
            Pad_Count : Natural;
        begin
            Write_Header (Unix_Name, Length (Source_Name));
            while not Dio.End_Of_File (Source_File) loop
                Dio.Read (Source_File, Buffer, Count);
                exit when Count <= 0;
                Block_Buffer.Write (Target_File, Buffer (1 .. Count));
                File_Bytes := File_Bytes + Count;
            end loop;
            Pad_Count := Record_Size - (File_Bytes mod Record_Size);
            if Pad_Count in 1 .. Record_Size - 1 then
                Block_Buffer.Write (Target_File, Zeroes (1 .. Pad_Count));
            end if;
            Log.Put_Line (Source_Name & " => " & Unix_Name & ";" &
                          Natural'Image (File_Bytes) & " bytes",
                          Profile.Positive_Msg);
        end;
        Dio.Close (Source_File);
    end Write_One_File;

begin
    Block_Buffer.Open (Target_File, Dio.Out_File, Archive,
                       Record_Size, Records_Per_Block, Swap_Bytes);

    declare
        Iter : Directory.Naming.Iterator;
        Status : Directory.Naming.Name_Status;
        Version : Directory.Version;
        Error : Directory.Error_Status;
    begin
        Directory.Naming.Resolve (Iter, Files, Status);
        case Status is
            when Directory.Naming.Successful =>
                while not Directory.Naming.Done (Iter) loop
                    Directory.Naming.Get_Version (Iter, Version, Error);
                    case Error is
                        when Directory.Successful =>
                            Write_One_File
                               (Directory.Naming.Unique_Full_Name (Version));
                            Directory.Naming.Next (Iter);
                        when others =>
                            Log.Put_Line ("Get_Version failed.",
                                          Profile.Error_Msg);
                    end case;
                end loop;
            when others =>
                Log.Put_Line ("Directory.Naming.Resolve failed (" &
                              Image (Status) & ")", Profile.Error_Msg);
        end case;
    end;

    Block_Buffer.Write (Target_File, Zeroes); -- end-of-tape marker
    Block_Buffer.Close (Target_File);
exception
    when others =>
        Block_Buffer.Close (Target_File);
        raise;
end Write;