Сортировка стека.

program Project1;
 
const
  //Глубина стека. Т. е. максимальное количество элементов,
  //которое может поместиться в стек.
  StSizeMax = 30;
 
type
  //Тип, описывающий стек.
  TStack = record
    //Указатель вершины стека. Это индекс последнего добавленного элемента.
    Pnt : Integer;
    //Контейнер данных стека.
    Data : array[1..StSizeMax] of Integer;
  end;
 
//Добавить в стек элемент.
function StackPush(var aStack : TStack; const aNum : Integer) : Boolean;
begin
  StackPush := False;
  with aStack do begin
    if Pnt < High(Data) then begin
      //Индекс добавляемого элемента.
      Inc(Pnt);
      //Добавляем элемент в массив (т. е. в стек).
      Data[Pnt] := aNum;
      StackPush := True;
    end;
  end;
end;
 
//Взять из стека элемент.
function StackPop(var aStack : TStack; var aNum : Integer) : Boolean;
begin
  StackPop := False;
  with aStack do begin
    if Pnt >= Low(Data) then begin
      aNum := Data[Pnt];
      Dec(Pnt);
      StackPop := True;
    end;
  end;
end;
 
const
  //Будем работать с M элементами стеков.
  M = 10;
 
var
  St1, St2 : TStack;
  i, j, k, Num1, Num2 : Integer;
  F : Boolean;
begin
  //Инициализация стеков.
  St1.Pnt := 0;
  St2.Pnt := 0;
 
  //Заливаем в первый стек исходные данные.
  Randomize;
  for i := 1 to M do StackPush(St1, Random(20)); //StackPush(St1, i);
 
  //Распечатываем содержимое первого стека. Применяем переливания.
  Writeln('Содержимое первого стека:');
  while StackPop(St1, Num1) do begin
    StackPush(St2, Num1);
    Writeln(Num1);
  end;
  //Возвращаем значения в первый стек.
  while StackPop(St2, Num1) do StackPush(St1, Num1);
 
  //Сортировка стека St1 по неубыванию в направлении от вершины - ко дну.
  //Метод сортировки - пузырьковая.
  j := M;
  repeat
    F := False;
    Dec(j);
    //Берём очередной элемент из первого стека. Записываем его в Num1.
    StackPop(St1, Num1);
    //Далее делаем так. Берём ещё один элемент из первого стека, записываем
    //его в Num2. Сравниваем Num1 и Num2, и наименьшее значение пишем во
    //второй стек. Оставшееся значение помещаем в Num1.
    //Продолжаем выполнять эту операцию до достижения дна первого стека.
    for k := 1 to j do begin
      StackPop(St1, Num2);
      if Num1 <= Num2 then begin
        StackPush(St2, Num1);
        Num1 := Num2;
      end else begin
        StackPush(St2, Num2);
        F := True;
      end;
    end;
 
    //Переливаем значения обратно: из второго стека - в первый стек.
    //Записываем в первый стек зачение, оставшееся в Num1.
    StackPush(St1, Num1);
    //Записываем в первый стек из второго стека все остальные элементы.
    while StackPop(St2, Num1) do StackPush(St1, Num1);
  until not F;
 
  //Распечатываем значения из первого стека.
  Writeln('Содержимое первого стека после сортировки:');
  while StackPop(St1, Num1) do Writeln(Num1);
 
  Readln;
end.