procedure SimpleMergeSort (name:string);
var
		k, i, j, kol, tmp:longint;
		a1, a2:string;
		f, f1, f2:text;
begin
	kol := 0;
	assign(f,name);
	assign(f1,'f01.txt');
	assign(f2,'f02.txt');
	{I-}
		reset(f);
	{I+}

    if ioresult<>0 then
		writeln('Blad otwarcia pliku')
	else
	begin
		reset(f);
		while ( not eof(f) ) do
		begin
			readln(f,a1);
			kol:=kol+1;
		end;
		close(f);
	end;
	k := 1;
	while ( k < kol ) do
	begin
		reset(f);
		rewrite(f1);
		rewrite(f2);
		if ( not eof(f) ) then readln(f,a1);
		while ( not eof(f) ) do
		begin
			i:=0;
			while((i < k) and not eof(f)) do
			begin
				writeln(f1,a1);
				readln(f,a1);
				i:=i+1;
			end;
			j:=0;
			while ((j < k) and not eof(f)) do
			begin
				writeln(f2,a1);
				readln(f,a1);
				j:=j+1;
			end;
		end;
		close(f2);
		close(f1);
		close(f);


		rewrite(f);
		reset(f1);
		reset(f2);

		if ( not eof(f1) ) then readln(f1,a1);
		if ( not eof(f2) ) then readln(f2,a2);
		while ( (not eof(f1)) and (not eof(f2))) do
		begin
			i := 0;
			j := 0;
			while ( (i < k) and (j < k) and (not eof(f1)) and (not eof(f2))) do
				begin
					if ( a1 < a2 ) then
					begin
						writeln(f,a1);
						readln(f1,a1);
						i:=i+1;
					end
					else
					begin
						writeln(f,a2);
						readln(f2,a2);
						j:=j+1;
					end;
				end;
				while ( (i < k) and not eof(f1) ) do
				begin
					writeln(f,a1);
					readln(f1,a1);
					i:=i+1;
				end;
				while ( (j < k) and not eof(f2) ) do
				begin
					writeln(f,a2);
					readln(f2,a2);
					j:=j+1;
				end;
			end;
			while ( not eof(f1) ) do
			begin
				writeln(f,a1);
				readln(f1,a1);
			end;
			while ( not eof(f2) ) do
			begin
				writeln(f,a2);
				readln(f2,a2);
			end;
			close(f2);
			close(f1);
			close(f);
			k :=k*2;
		end;
		erase(f1);
		erase(f2);
end;