program g;
type       slovo= string;
 
           link	= ^kom;   {начало создания списка}
           kom	= record
            ini  : slovo;
            next : link;
	         end;           {конец создания списка}
 
 var sl:slovo; i,nnn:integer;
    L:link;
 
 
procedure del(var n : link; num:integer);
{данная процедура удаляет из списка "n" элемент под номером "num" }
var
   neo, ind : link;
   i	    : integer;
begin
   if n<>nil then begin
   if num=1 then begin
      neo:=n;
      n:=n^.next;
      dispose(neo);
   end
   else begin
      i:=0;
      ind:=n;
      while (i<>num-2) and (ind^.next<>nil) do begin
	 i:=i+1;
	 ind:=ind^.next;
      end;
      if ind^.next<>nil then begin
	 neo:=ind^.next;
	 ind^.next:=neo^.next;
	 dispose(neo);
      end;
   end;
   end;
end; {КОНЕЦ процедуры del }
{****************************************}
procedure add(var n : link; x:slovo; num:integer);
{данная процедура добавляет в список "n" элемент "x" на порядковое место "num" }
var
   neo, ind : link;
   i	    : integer;
begin
   new(neo);
   neo^.ini:=x;
   if n=nil then begin
      n:= neo;
      neo^.next:=nil;
   end
   else if num=1 then begin
      neo^.next:=n;
      n:= neo;
   end
   else begin
      i:=0;
      ind:= n;
      while (i<>num-2) and (ind^.next<>nil) do begin
	 i:= i+1;
	 ind:= ind^.next;
      end;
      neo^.next:=ind^.next;
      ind^.next:= neo;
   end;
end; {КОНЕЦ процедуры add }
{******************************************}
procedure veiwnaob(n : link);
{процедура ПЕРЕВАРАЧИВАЮЩАЯ список "n"}
var
   ind : link;
   i,bb   : integer;
   mmm:array[1..1000] of string [10];
begin
   ind:=n;
   i:=0;
   if ind=nil then writeln ('List is empty')
   else begin
 
      while ind<>nil do begin
	 i:=i+1;
   mmm[i]:=ind^.ini; {записываем все элементы списка В МАССИВ}
	 ind:=ind^.next;
      end;
   end;
         bb:=0;
   for i:=nnn downto 1 do  {идём по массиву с ВВЕРХУ  ВНИЗ}
    begin inc(bb);del(L,bb); {удаляем из исходного массива старые элементы}
    add(L,mmm[i],bb); end;  {и записываем новые}
end; {КОНЕЦ veiwnaob }
{******************************************}
procedure veiw(n : link);
{процедура выводящая весь список на экран}
var
   ind : link;
   i   : integer;
begin
   ind:=n;
   i:=0;
   if ind=nil then writeln ('List is empty')
   else begin
      writeln; writeln('The list is');
      while ind<>nil do begin
	 i:=i+1;
	 writeln(i,')  ',ind^.ini);
	 ind:=ind^.next;
      end;
   end;
end; {конец  veiw }
{******************************************}
 
begin
write('Vvedite kol-vo slov v spiske: '); readln(nnn); {считываем размер списка}
writeln('Vvedite sam SPISOK L: ');
for i:=1 to nnn do begin
write(i,' slovo= '); readln(sl); add(L,sl,i); end; {считываем сам список}
 
veiwnaob(L);  {переворачиваем список}
veiw(L);      {выводим исходный список на экран}
readln; readln;
end.