Переписать содержимое исходного текстового файла в файл-результат_2 - Turbo Pascal

{ В полной аналогии }
program task;
type
    list = ^chain;
    chain = record
        item: char;
        next: list
    end;
var
    t1, t2: text;
    l: list;
    spacecount: integer;
    c: char;
    flag, ok: boolean;
    
function makelist( var t: text; var l: list; 
    var spacecount: integer; flag: boolean ): boolean;
{ Формирую список из букв слова. Значение функции - true, если слово
  имеет одинаковые первую и последнюю латинскую букву. В переменной 
  spacecount -  количество пробелов перед словом. В переменной flag - 
  false, если указатель установлен на начало строки и true иначе }
var
    q: list;
    count: integer;
    c1, c2: char;
begin
    c1 := ' ';
    c2 := ' ';
    if flag then
        if c = ' ' then spacecount := spacecount + 1;
    if not eoln( t ) then begin
        read( t, c );
        while ( c = ' ' ) and not eoln( t ) do begin
            read( t,c );
            spacecount := spacecount + 1;
        end;
        if c = ' ' then spacecount := spacecount + 1;
        if c <> ' ' then begin
            if ( c >= 'a' ) and ( c <= 'z' ) then begin
                c1 := c;
                c2 := c;
            end;
            new( l );
            l^.item := c;
            l^.next := nil;
            q := l;
            while not eoln( t ) and ( c <> ' ' )  do begin
                read( t, c );
                if ( c >= 'a' ) and ( c <= 'z' ) then begin
                    if ( c1 = ' ' ) then c1 := c;
                    c2 := c;    
                end;
                if c <> ' ' then begin
                    new( q^.next );
                    q := q^.next;
                    q^.item := c;
                    q^.next := nil
                end;
            end;
        end;
        makelist := c1 = c2;
    end
    else
        makelist := false;
end;
 
procedure writelisttofile( var t: text; l: list; ok: boolean );
{ Переписываю слово в файл t2 согласно условию }
var
    c: char;
begin
    if l <> nil then begin
        if ok then begin
            c := l^.item;
            c := chr( ord( 'A' ) - ord ( 'a' ) + ord( c ) );
            write( t, c );
            l := l^.next;
            if l <> nil then begin
                while l^.next <> nil do begin
                    write( t, l^.item );
                    l := l^.next;
                end;
                c := l^.item;
                c := chr( ord( 'A' ) - ord ( 'a' ) + ord( c ) );
                write( t, c );
            end;
        end
        else begin
            write( t, l^.item );
            l := l^.next;
            while l <> nil do begin
                write( t, l^.item );
                l := l^.next;
            end;
        end;
    end;
end;
 
procedure writespace( var t: text; n: integer );
begin
    while n <> 0 do begin
        write( t, ' ' );
        n := n - 1;
    end;
end;
 
procedure deletelist( var l: list );
begin
    if l <> nil then begin
        deletelist( l^.next );
        dispose( l );
        l := nil;
    end;
end;
    
begin
assign( t1, 'u: t1.txt' );
assign( t2, 'u: t2.txt' );
reset( t1 );
rewrite( t2 );
l := nil;
spacecount := 0;
flag := false;
while not eof( t1 ) do begin
    ok := makelist( t1, l, spacecount, flag );
    flag := true;
    writespace( t2, spacecount );
    writelisttofile( t2, l, ok );
    deletelist( l );
    if eoln( t1 ) then begin
        flag := false;
        readln( t1 );
        writeln( t2 );
    end;
    spacecount := 0;
end;
close( t1 );
close( t2 );
end.