uses crt;
Type
    point = ^MyWord;
    MyWord = record
           ch: char;
         next: point
  end;
var
   digits: set of ord('0')..ord('9');
   slovo:point;
   c:char;
   i:integer;
{---------------------------------------------------------------------------}
procedure Print (first: point);
Var r: point;
begin
    R:= first;
    While r<>nil do
       begin
           Write (r^.ch);
           R:=r^.Next
       end;
  writeln
end;
{---------------------------------------------------------------------------}
procedure Vvod(var first:point);
var r, last:point;
begin
    first:= nil; last := nil;

    writeln('HA6EPuTE C/\OBO C "." HA KOHCE ');
    while r^.ch <> '.' do
       begin
           new(r);
           r^.next := nil;
           read(r^.ch);

          if first = nil then first := r
          else last^.next := r;

          last := r
       end
end;
{----------------------------------------------------------------------------}
Procedure insert_before (Var q: point; x: char);
Var r: point;
Begin
  New(r);
  r^.Next:=q^.Next;
  q^.Next:=r;
  r^.ch:=q^.ch;
  q^.ch:=x
end;
{----------------------------------------------------------------------------}
Procedure Finish(first:point);
var r,temp:point;

begin
    r := first;
    repeat
        case r^.ch of
           'a'..'z', 'A'..'Z':insert_before(r,r^.ch);
        else   r:=r^.next;
        end;
    until r = nil
end;

begin
    clrscr;
    vvod(slovo);
    writeln('Start word:');
    print(slovo);
    Finish(slovo);
    writeln('Finish word:');
    print(slovo);
    readkey
end.

Procedure insert_before (Var q: point; x: char);
Var r: point;
Begin
  New(r);{здесь ошибка Heap overflow error}

procedure Vvod(var first:point);{исправленный вариант ввода}
var r, last:point;
begin
    first:= nil; last := nil;

    writeln('HABEPuTE C/\OBO C "." HA KOHCE ');
  repeat
      new( r );
      r^.next := nil;
      read(r^.ch);

      if first = nil then first := r
      else last^.next := r;

      last := r;
  until r^.ch = '.';

end;

Procedure Finish(first:point);
var r,temp:point;
begin
     r := first;
     repeat
         temp:=r;
         case r^.ch of
               'a'..'z','A'..'Z': begin insert(r,r^.ch); r:=r^.next^.next end;
        else  
                r:=r^.next;
        end;
    until r = nil;
end;