{Процедура Push.
Предназначена для сохранения символа сс в массиве Stack. Увеличивает указатель вершины стека StackHead и помещает переданный символ в соответствующий элемент массива. Зачем нужна - см. ниже }

Procedure Push(cc: char);
Begin
  Inc(StackHead);
  Stack[StackHead] := cc;
End;

{Функция Pор.
Возвращает последний символ, сохраненный в массиве Stack и уменьшает указатель вершины стека. Зачем нужна - см. ниже }

Function Pop: char;
Begin
  Pop := Stack[StackHead];
  Dec(StackHead);
End;

{Функция GetMask.
Выбирает из сетки кроссворда текущую маску слова для заданного гнезда. Содержит проверку, не вылезло ли наше гнездо за пределы сетки. Между нами говоря, проверка эта непонятно зачем нужна:
1) Гнезда по определению не должны никуда вылезать.
2) Если гнездо вылезло, то функция вернет константу NOTEQ_SYMBOL. Но дело в том, что это все равно больше нигде не проверяется. Так что пользы в том никакой.
3) Вместо if (...) and (...) следовало бы if (...) or (...). 
Спокойно можно эту проверку вырезать. Вот этот кусок:
    if (G.X + G.Len-1 > CW_SIZE_X) and (G.Y + G.Len-1 > CW_SIZE_Y) then
       begin
         Result := NOTEQ_SYMBOL;
         Exit;
       end;
}

function GetMask(G : TGnezdo;CW_SIZE_X,CW_SIZE_y:integer) : TWord;
var Ch : Byte; Result : TWord;
begin
    Result := ''; {Обнуляем строку результата}

    {А не вылезло ли гнездо?}
    if (G.X + G.Len-1 > CW_SIZE_X) and (G.Y + G.Len-1 > CW_SIZE_Y) then
       begin
         Result := NOTEQ_SYMBOL; {если вылезло, возвращаем NOTEQ_SYMBOL}
         Exit; 
       end;

    {Выбираем из сетки символы маски и накапливаем их в строке результата}

    for Ch := 1 to G.Len do
      if G.flHoriz then
      Result := Result + CW[G.X, G.Y + Ch-1]
      else
      Result := Result + CW[G.X + Ch-1, G.Y];

    GetMask := Result; {возвращаем сформированную маску}
  end;

{Функция IsMaskOk.
Проверяет, соответсвует ли строка Wrd маске Мск.}

function IsMaskOk(Msk, Wrd : TWord) : Boolean;
var Ch : Byte;
begin
 {Если длина слова совпадает с длиной маски, временно предположим, что все в порядке}
 if Length(Msk) = Length(Wrd) then IsMaskOk := TRUE 
 {А если длины не совпадают, тогда вернем FALSE}
 else 
  begin 
    IsMaskOk := FALSE; 
    Exit; 
 end;

{Теперь проверяем посимвольно.}
 for Ch := 1 to Length(Wrd) do
{Если очередной символ маски не пробел, и при этом он не совпадает с соответствующим символом заданного слова, возвращаем FALSE}
   if (Msk[Ch] <> SPACE_SYMBOL) and (Msk[Ch] <> Wrd[Ch]) then
      begin
        IsMaskOk := FALSE; {Break;}
        Exit;
      end;
{Если же посимвольное сравнение прошло успешно, возвращаем присвоенное ранее TRUE}
end;

{Функция Already.
Проверяет, не было ли слово Wrd уже использовано в кроссворде. Все уже использованные слова хранятся в массиве Used, а их число = UsedNum}

Function Already(Wrd: TWord): boolean;
var i: word;
begin
  For i:=1 to UsedNum do
      If Wrd = Used[i] then { нашли совпадение! }
         begin
           Already := true; 
           Exit;
         end;

  Already := false; { совпадений не нашли }
end;

{Процедура SetWord.
Вписывает слово Wrd в гнездо G, точнее, не в гнездо, а в сетку кроссворда в позиции заданного гнезда}

procedure SetWord(G : TGnezdo;Wrd : TWord);
var Ch : Byte;
begin
  {Вносим слово в массив ранее использованных слов}
  Inc(UsedNum);
  Used[UsedNum] := Wrd;

  {Посимвольно вписываем слово в сетку кроссворда с учетом ориентации}
  for Ch := 1 to G.Len do
    if G.flHoriz then
      begin
         {Сохраняем в стеке символ, который СЕЙЧАС записан в клетке [G.X, G.Y + Ch-1]}
         Push(CW[G.X, G.Y + Ch-1]);
         {Записываем на его место очередной символ слова}
         CW[G.X, G.Y + Ch-1] := Wrd[Ch];
      end
    else
      begin
         Push(CW[G.X + Ch-1, G.Y]);
         CW[G.X + Ch-1, G.Y] := Wrd[Ch];
      end;
end;

{Процедура UnSetWord.
Вычеркивает из сетки кроссворда слово, ранее вписанное в гнездо G. Кстати, я тут у себя ошибочку нашел...}

procedure UnSetWord(G : TGnezdo);
var Ch : Byte;
begin
  { Dec(UsedNum);         это не нужно}

  { а вот тут у меня косяк! Возвращать символы в сетку надо в обратном порядке! }

  { for Ch := 1 to G.Len do  - НЕПРАВИЛЬНО }
    for Ch := G.Len downto 1 do { - ПРАВИЛЬНО }
    if G.flHoriz then
      begin
         {Возвращаем в сетку кроссворда из стека тот символ, который там ранее был}
         CW[G.X, G.Y + Ch-1] := Pop;
      end
    else
      begin
         CW[G.X + Ch-1, G.Y] := Pop;
      end;
end;

{Тут вроде бы ясно}
procedure OpenWordBase(FName : string); 
begin 
  Assign(Fwbase, FName); 
  Reset(Fwbase); 
end;

procedure CloseWordBase; 
begin 
  Close(Fwbase); 
end;

{Функция GetNextWord.
Считывает из словаря очередное ранее не использованное слово длины l. Если таких слов больше нет, возвращает строку '-1'}

function GetNextWord(l: byte) : TWord;
var F : Text; s : string;
begin
  While not EoF(Fwbase) do
    begin
      readln(Fwbase,s);
      {Если слово ранее не использовано, и его длина совпадает}
      If (not Already(s)) and (Length(s)=l) then
         begin
           GetNextWord := s; { выдать его на-гора }
           Exit;
         end;
    end;

  GetNextWord := '-1'; {подходящих слов не нашли...}
end;

{Рекурсивная функция Arbeit. Пытается подобрать подходящее слово для гнезда с номером GNum. Если на очередном шаге слово подошло, переходим к следующему гнезду, и так до упора. Если следующее слово не вписалось, меняем текущее и опять пробуем следующее. Если на очередном шаге подходящих слов так и не нашлось, возвращаем FALSE. Если на самом первом уровне обнаруживается, что подходящих слов нет, это значит, что кроксворд не сложился. Тогда мы полностью выходим из рекурсии, то есть зависания не произойдет. Другое дело, что эта ситуация грамотно не обрабатывается в меню. Надо как-то так:
procedure   Vivod(var cw1:TCW);
begin
  if Arbeit(1,n,cw) then 
     begin
      все в порядке
      DrawCw(cw,n);
     end
  else
     begin
      не стряслось!
      DrawKaraul;
     end;
end;
}
Function Arbeit(GNum : Byte; n:integer; var cw1:TCW): boolean;
var Msk, Wrd : TWord;
    StartBasePosition, OldUsedNum : Word;
    flNoWord ,flag: Boolean;
begin
    {q - общее число гнезд. Если GNum > q, это значит, 
     что все имеющиеся гнезда уже заполнены, то есть достигнут нижний уровень
    рекурсии. Ура!}

    If GNum > q Then
    begin
      Arbeit := true;
      Exit;
    end;

    { flag :=false; Эта строка уже лишняя. ф топку ее. }

    Msk := GetMask(Gnezdo[GNum],n,n); {определяем текущую маску}

    { flNoWord := FALSE;  Эта строка тоже лишняя. и ее ф топку. }

    {Запоминаем текущий размер массива использованных слов}
    OldUsedNum := UsedNum;

    repeat
      Reset(Fwbase); {переходим в начало словаря. 
        На каждом шаге рекурсии словарь просматривается с начала.}

      {ищем в словаре очередное подходящее слово}
      repeat
        Wrd := GetNextWord(Gnezdo[GNum].len);
      until IsMaskOk(Msk, Wrd) or (Wrd = '-1');

        if Wrd <> '-1' then  {то есть подходящее слово нашли}
        begin
          {Пихаем его в кроссворд}
          SetWord(Gnezdo[GNum], Wrd);

          { Переходим к следующему гнезду }
          If Arbeit(GNum+1,n,cw) Then {Если и следующее гнездо удалось заполнить}
             begin {это значит, что у нас все на мази.}
               Arbeit := true; {о чем мы и сообщаем вышестоящим инстанциям}
               Exit;
             end
          {следующее слово не вписалось, а значит, и текущее придется отправить на помойку}
          else UnSetWord(Gnezdo[GNum]);
        end
        else {подходящих слов больше нет. Не судьба! 
              То есть на этом шаге словарь просмотрен до конца.}
        begin
          Arbeit := false;
          {Восстанавливаем ранее запомненный размер массива уже использованных слов,
           то есть оставляем за бортом все слова, которые были использованы на этом 
           и всех последующих шагах рекурсии. Теперь их можно будет опять пробовать.}
          UsedNum := OldUsedNum;
          Exit;
        end;
     until false;
end;