Циклический односвязный список с зацикливанием через указатель (голову), Задача Опции

[zabludshiy]

Помогите добрые люди разобраться в следующей задаче: заполнить циклический односвязный список с зацикливанием «через голову». Дополнительные операции: a) добавить новый узел в хвост; б) вывести текущий список на экран ... примечание к задаче "Некоторые сложности представляет согласование типов указателей. Например, для инициализации пустого списка не всегда удается просто написать «Head := @Head», это может быть синтаксической ошибкой (в зависимости от настроек компилятора). Более корректно использовать явное преобразование типов: «Head := Link(@Head)». При этом важно, чтобы поле Next было обязательно описано как первое поле записи Node."

Прога получилась следующая:

 
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.

Заполняется без зависаний и выпадающих ошибок, но когда список выводится происходит зацикливание. Не могу понять почему, нигде не могу найти ни ответа ни подобного примера. Помогите кто чем может!!!