Program Stek;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе стека}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент}
  end;

{Процедура добавляющая элемент в стек}
procedure AddElem(var stek1:List;znach1:TInf);
var
  tmp:List;
begin
  GetMem(tmp,sizeof(TList)); {выделяем в памяти место для нового элемента}
  tmp^.next:=stek1;  {указатель на следующий элемент "направляем" на вершину стека}
  tmp^.data:=znach1; {добавляем к элементу данные}
  stek1:=tmp; {вершина стека изменилась, надо перенести и указатели на неё}
end;

{Процедура вывода стека}
procedure Print(stek1:List);
begin
  if stek1=nil then {проверка на пустоту стека}
  begin
    writeln('Стек пуст.');
    exit;
  end;
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;

{Процедура освобождения памяти занятой стеком}
Procedure FreeStek(stek1:List);
var
  tmp:List;
begin
  while stek1<>nil do {пока stek1 не станет указывать в "пустоту" делать}
  begin
    tmp:=stek1; {указатель tmp направим на вершину стека}
    stek1:=stek1^.next; {вершину стека перенесём на следующий за данной вершиной элемент}
    FreeMem(tmp,SizeOf(Tlist)); {освободим память занятую под старую вершину}
  end;
end;

{Процедура сортировки "пузырьком" с изменением только данных}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist)); {выделяем память для рабочего "буфера" обмена}
  rab:=nach; {рабочая ссылка, становимся на вершину стека}
  while rab<>nil do {пока мы не дойдём до конца стека делать}
  begin
    tmp:=rab^.next; {перейдём на следующий элемент}
    while tmp<>nil do {пока не конец стека делать}
    begin
      if tmp^.data<rab^.data then {проверяем следует ли менять элементы}
      begin
        tmps:=tmp^.data; {стандартная замена в 3 операции}
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next {переход к следующему элементу}
    end;
    rab:=rab^.next {переход к следующему элементу}
  end
end;

var
  Spis:List;
  znach, n, i:integer;
begin
  Spis:=nil;
  write('n=');
  read(n);
  for i:=1 to n do
  begin
      read(znach);
      AddElem(Spis,znach);
  end;

  Print(Spis);
  writeln;
  SortBublInf(Spis);
  writeln;
  Print(Spis);
  FreeStek(Spis); //освобождение памяти

  readkey;
end.