program Lr_1;
{Вариант задания: циклический односвязный список с зацикливанием
"через голову".}
Type
  Link = ^Node;
  Node = record
    Next: Link;
    Data: Integer;
   end;
  List = Link;

Var
  choice: Integer;
  item: Integer;
  list1: List;

procedure menu;
{Приглашение к вводу команды}
begin
  Writeln('*************************************************************');
  Writeln('*                 Действие со списком:                                                         *');
  Writeln('* 2 - Добавить узел в хвост                                                                   *');
  Writeln('* 5 - выдача текущего списка на экран                                                  *');
  Writeln('* 0 - Завершить работу (+освобождение памяти)                                    *');
  Writeln('*************************************************************');
  Write('> ');
end;  {menu}

procedure InitList(var L: List);
{Инициализация списка}
begin
  l:=nil;
end;  {InitList}

procedure FreeList(var L: List);
{Освобождение памяти списка}
var
  p: list;
begin
  while L^.next <> link(@L) do
        begin
             p := L;
             L := L^.Next;
             Dispose(p);
        end;
end;  {FreeList}

procedure ShowList(L: List);
var p:list;
begin
  write('Текущий список ');
  p:=l;
  if p = nil then  {Пустой список}
    Write(' ->')
  else
    repeat
      Write(' -> ', p^.Data);
      p := p^.Next;
    until p = link(@l);
  Writeln;
end;  {ShowList}

procedure InTail(var L: List; item: Integer);
{Вставка узла с данными item в хвост списка L}
var
  p, q: Link;
begin
  p := New(Link);
  p^.Next := nil;
  p^.Data := item;
  if L = nil then
    begin
         L := p;
         p^.next:=link(@l);
    end
  else begin
    q := L;
    while q^.Next <> link(@l) do
      q := q^.Next;
      {Теперь q указывает на последний узел}
    p^.Next := q^.next;
    q^.Next := p;
  end;
end;  {InTail}

begin
  {Основная программа}
  InitList(list1);
  repeat
    menu;
    readln(choice);
    case choice of
      0: begin
           FreeList(list1);
           break;
         end;
      2: begin
           Write('Введите добавляемое значение: ');
           Readln(item);
           InTail(list1, item);
         end;
      5: begin
           showlist(list1);
         end;
    else
    end;
  until choice = 0;
end.

    repeat
      Write(' -> ', p^.Data);
      p := p^.Next;
    until p = link(@l);

until P = link(L);

procedure FreeList(var L: List);
var
   p : list;
begin
   while L^.next <> link(L) do // Вот так утечка прекращается
   begin
      p := L;
      L := L^.Next;
      Dispose(p);
   end;
end; {FreeList}

procedure FreeList(var L: List);
var
   p, q : list;
begin
   if L <> nil then // Если список пустой - сразу уходим
   begin
      q := L;
      repeat
         p := q^.next;
         dispose(q);
         q := p;
      until q = L;
      L := nil;
   end;
end; {FreeList}

procedure InTail(var L: List; item: Integer);
var
  p, q: Link;
begin
   p := New(Link);
   p^.Next := nil;
   p^.Data := item;

   if L = nil then
   begin
      L := p;
      p^.next := link(L); // Опять же, не надо работать с адресами !!!
   end
   else
   begin
      q := L;
      while q^.Next <> link(L) do q := q^.Next;
      p^.Next := q^.next;
      q^.Next := p;
   end;
end;  {InTail}

 if L = nil then
   begin
      L := p;
      p^.next := link(L); // Опять же, не надо работать с адресами !!!
   end

program Lr_1;
uses crt;
type
{
   Link будет указателем на элемент списка, имеющий поля
   next и Data. Из подобных элементов и будет строиться "кольцо"

   ListPtr же будет указателем на САМ СПИСОК (у тебя на схеме
   он выглядит именно так: нечто, что указывает на начало кольцевого
   списка)
}
   Link = ^Node;
   Node =
   record
      Next : Link;
      Data : Integer;
   end;
   ListPtr = ^Link;

procedure menu;
begin
  Writeln('*************************************************************');
  Writeln('*                 Действие со списком:                      *');
  Writeln('* 2 - Добавить узел в хвост                                 *');
  Writeln('* 5 - выдача текущего списка на экран                       *');
  Writeln('* 0 - Завершить работу (+освобождение памяти)               *');
  Writeln('*************************************************************');
  Write('> ');
end;  {menu}

{ Инициализация списка: выделим память под этот "аппендикс", но указывать
  он пока ни на что не будет }
procedure InitList(var L: ListPtr);
begin
   new(L);
   L^ := nil;
end;  {InitList}

{ Освобождаем список: Все, как и раньше, но чтобы получить первый полезный
  элемент - обращаемся по адресу, который хранится в "аппендиксе" }
procedure FreeList(var L: ListPtr);
var
   p, q : Link;
begin
   if L^ <> nil then { "аппендикс" на что-то указывает? Тогда удаляем }
   begin
      q := L^; { "Первый" элемент списка }
      repeat
         p := q^.next;
         dispose(q);
         q := p;
      until q = L^; { До тех пор, пока не доберемся до того места, куда указывает L }

      dispose(L); { удаляем сам "аппендикс". Это можно делать и в другом месте }
      L := nil;
   end;
end; {FreeList}

{ Показываем список }
procedure ShowList(L: ListPtr);
var p : Link;
begin
   write('Текущий список ');
   P := L^; { Опять же, начинаем оттуда, куда указывает L }
   if p = nil then Write(' ->')
   else
      repeat
         Write(' -> ', p^.Data);
         p := p^.Next;
      until P = L^;
   Writeln;
end; {ShowList}

{ Добавляем элемент }
procedure InTail(var L: ListPtr; item : Integer);
var
  p, q : Link;
begin
   p := New(Link);  { Память выделяем в любом случае }
   p^.Next := nil;
   p^.Data := item; { Сохраняем данные }

   if L^ = nil then { Список был пуст? }
   begin
      L^ := p; { "Аппендикс" теперь указывает на добавленный элемент }
      p^.next := p; { , а элемент указывает сам на себя }
   end
   else
   begin { Нет, уже что-то добавлялось }
      q := L^;
      { Ищем жлемент, указывающий на "начало" }
      while q^.Next <> L^ do q := q^.Next;
      { И добавляем после него (между ним и "началом") новый элемент }
      p^.Next := q^.next;
      q^.Next := p;
   end;
end; {InTail}

var
   choice: Integer;
   item: Integer;
   list1: ListPtr;

begin
   { Основная программа }
   InitList(list1);
   repeat
      Menu;
      readln(choice);
      case Choice of
         0 : FreeList(list1);
         2 :
         begin
            Write('Введите добавляемое значение: ');
            Readln(item);
            InTail(list1, item);
         end;
         5:
         begin
            showlist(list1);
         end;
      
         else {}
      end { case };
   until choice = 0;
end.

 
program Lr_1;
...
uk=^link;

Var
  choice: Integer;
  item: Integer;
  list1: List;
  ukaz:uk;

procedure menu;
...
end;  {menu}

procedure InitList(var L: List);
{Инициализация списка}
begin
  l:=nil;
end;  {InitList}

procedure FreeList(var L: List);
{Освобождение памяти списка}
var
  p,q: list;
begin
  if l<>nil then
     begin
          q:=l;
          repeat
                 p:=q^.next;
                 dispose(q);
                 q:=p;
          until q=ukaz^;
          l:=nil;
     end;
end;  {FreeList}

procedure ShowList(L: List);
var p:list;
begin
  write('Текущий список ');
  p:=l;
  if p = nil then  {Пустой список}
    Write(' ->')
  else
    repeat
      Write(' -> ', p^.Data);
      p := p^.Next;
    until p = link(l);
  Writeln;
end;  {ShowList}

procedure InTail(var L: List; item: Integer);
{Вставка узла с данными item в хвост списка L}
var
  p, q: Link;
begin
  {p := New(Link);}
  new(p);
  p^.Next := nil;
  p^.Data := item;
  if L = nil then
    begin
         L := p;
         p^.next:=ukaz^;
    end
  else begin
    q := L;
    while q^.Next <> ukaz^ do
      q := q^.Next;
      {Теперь q указывает на последний узел}
    p^.Next := q^.next;
    q^.Next := p;
  end;
end;  {InTail}

begin
  {Основная программа}
  InitList(list1);
  ukaz:=@list1;
  repeat
    menu;
    readln(choice);
    case choice of
      ...