Динамические структуры данных. Надо найти причину ошибки программа не запускается

Program Schitalka;
Type
   Children = ^Child;
   Child = record
   Data : integer;
   Next : Children;
end;
Var
   Circl, p, Temp : Children;
   i, j, NumName : integer;
   text : string;
Function NumSlov(Var S : string) : integer;
Var
   i, d : integer;
Begin
   d := 0;
   i := 1;
   while i < Length(S) do
begin
while S[i] = ' ' do
   Inc(i);
while S[i] <> ' ' do
   Inc(i);
   d := d+1;
end;
  if S[Length(S)] = ''
then
    d := d-1;
    NumSlov := d;
End;
Procedure AddName(Var Old, Young : Children);
Begin
  Young^.Next := Old;
  Young^.Prev := Old^.Prev;
  Old^.Prev^.Next := Young;
  Old^.Prev := Young;
End;
Procedure DeleteName(Var Old : Children);
Begin
  Old^.Next^.Prev := Old^.Prev;
  Old^.Prev^.Next := Old^.Next;
 End;
 Begin
  new(Circl);
  Circl^.Next := Circl;
  Circl^.Prev := Circl;
  Circl^.Name := '';
  writeln('Считалка');
  writeln('Введите текст считалки >');
  readln(text);
  writeln('Сколько человек в кругу? >');
  readln(NumName); 
  if NumName>0
    then
begin
write('Введите ',i,'-е имя: ');
  new(p);
   readln(p^.name);
  temp := head^.next;
  while temp <> head do
  temp := temp^.next;
   AddName(temp, p);
end;
 for i := 1 to NumName-1 do
begin
  temp := head;
 for j := 1 to NumSlov(text) do
begin
    temp := temp^.next;
    if temp^.name = ''
    then
    temp :=temp^.next;
end;
    writeln(temp^.name, '- вышел');
    deleteName(temp);
end;
    writeln(head^.next^.name, '- остался');
End.

   Child = record
   Data : integer;
   Next : Children;
end;