Создать список, реализованный в виде стека (Pascal)

program Stack;
    type
        PStackItem=^TStackItem;
        TStackItem=record { Элемент стека }
            Value:integer; { Значение элемента }
            Next :PStackItem; { указатель на следующий }
        end;

    procedure Push(var head:PStackItem; Value:integer);
    { Добавляет элемент в стек }
        var
            tmp:PStackItem;
    begin
        tmp:=new(PStackItem);
        tmp^.Value:=Value;
        tmp^.Next :=head;
        head:=tmp;
    end;
    function Pop(var head:PStackItem):integer;
    { Забирает элемент из стека }
        var
            tmp:PStackItem;
    begin
        if (head <> nil) then begin
            tmp:=head;
            head:=head^.Next;
            Pop:=tmp^.Value;
            Dispose(tmp);
        end
        else
            Pop:=0;
    end;
    function IsEmpty(head:PStackItem):boolean;
    { Проверяет стек на пустоту }
    begin
        IsEmpty:= (head = nil);
    end;
    procedure Clear(var head:PStackItem);
    { Очищает стек }
        var
            tmp:PStackItem;
    begin
        while (head <> nil) do begin
            tmp:=head;
            head:=head^.Next;
            Dispose(tmp);
        end;
    end;
    function Rotate(head:PStackItem):PStackItem;
    { "Переворачивает" стек. Оригинальный стек сохраняется }
        var
            tmp,stk:PStackItem;
    begin
        tmp:=head;
        stk:=nil;
        while (tmp <> nil) do begin
            push(stk,tmp^.Value);
            tmp:=tmp^.Next;
        end;
        Rotate:=stk;
    end;
    procedure PrintStack(head:PStackItem);
    { Печатоет содержимое стека }
        var
            tmp:PStackItem;
    begin
        tmp:=Rotate(head); { Переворачиваем стек для нормального порядка отображения }
        while (not IsEmpty(tmp)) do
            WriteLn(Pop(tmp));
    end;
    var
        stk, newStk:PStackItem;
        Value, num, sum:integer;
begin
    stk:=nil;
    Write('Enter number: '); ReadLn(num);
    WriteLn('Enter Stack(Press CTRL+Z for end of Stack):');
    while (not eof(Input)) do begin
        ReadLn(Value);
        Push(stk, Value);
    end;
    WriteLn('Original Stack:');
    PrintStack(stk);
    newStk:=nil;
    sum:=0;
    while (not IsEmpty(stk)) do begin
        Value:=Pop(stk);
        if (Value > num) then begin
            sum:=sum+Value;
            Push(newStk, Value);
        end;
    end;
    WriteLn('Sum = ', sum);
    WriteLn('Processed Stack:');
    PrintStack(newStk);
    if (not IsEmpty(stk)) then
        Clear(stk);
    if (not IsEmpty(newStk)) then
        Clear(newStk);
    Write('Press [Enter] for exit');
    ReadLn;
end.

Uses CRT;
Type TEl=^El;
     El=Record
           Val: Real;
           Next: TEl;
        end;
Var SS,BP: TEl;

Function ReadZ(Var V: Real): Boolean;Var K: Char;S: String;Code: Integer;
Begin ReadZ:=False;S:='';K:=#0;
   Repeat K:=ReadKey;
      Case K of
              '-': If S='' then begin K:='-';S:=S+K;Write(K);end;
          '.',',': If Pos('.',S)=0 then begin K:='.';S:=S+K;Write(K);end;
         '0'..'9': begin S:=S+K;Write(K);K:=#0;end;
               #8: If S<>'' then begin
                      Delete(S,Length(S),1);
                      GoToXY(WhereX-1,WhereY);Write(' ');
                      GoToXY(WhereX-1,WhereY);
                   end;
          #27,#13: If S<>'' then begin
                      Val(S,V,Code); S:='';WriteLn;
                      ReadZ:=True;K:=#26;
                   end else If K=#27 then K:=#26;
      end;
   Until Ord(K)=26;
End;

Procedure Push(X: Real);Var P: TEl;
Begin New(P); P^.Val:=X; P^.Next:=SS; SS:=P; End;

Procedure StackSort;Var T,N: TEl; B: Real; {Сортировка}
Begin T:=SS;
   While T<> Nil do begin N:=T;
      While N<>Nil do begin
       If N^.Val>T^.Val then begin
        B:=N^.Val; N^.Val:=T^.Val;T^.Val:=B;
       end;
       N:=N^.Next;
      end;
      T:=T^.Next;
   end;
End;

Procedure Show;
Begin BP:=SS;
   While BP<>Nil do begin
      WriteLn(BP^.Val:10:3);
      BP:=BP^.Next;
   end;
End;

Var n: Real;
BEGIN ClrScr; SS:=Nil;
   WriteLn('Введите числа (конец ввода Ctrl+Z или Esc):');
   While ReadZ(n) do Push(n);

   WriteLn('Элементы необработанного стека:');
   Show;

   WriteLn('Логарифмы положительных элементов:');
   BP:=SS;
   While BP<>Nil do begin
     If BP^.Val>0 then Write(Ln(BP^.Val):3:3,'  ');
     BP:=BP^.Next;
   end; WriteLn;

   WriteLn('Элементы отсортированного стека :');
   StackSort;Show; WriteLn;

   Repeat Until KeyPressed;
END.

Uses CRT;
Type TEl=^El;
     El=Record
           Val: Real;
           Next: TEl;
        end;
Var SS,BP: TEl;

Function ReadZ(Var V: Real): Boolean;Var K: Char;S: String;Code: Integer;
Begin ReadZ:=False;S:='';K:=#0;
   Repeat K:=ReadKey;
      Case K of
              '-': If S='' then begin K:='-';S:=S+K;Write(K);end;
          '.',',': If Pos('.',S)=0 then begin K:='.';S:=S+K;Write(K);end;
         '0'..'9': begin S:=S+K;Write(K);K:=#0;end;
               #8: If S<>'' then begin
                      Delete(S,Length(S),1);
                      GoToXY(WhereX-1,WhereY);Write(' ');
                      GoToXY(WhereX-1,WhereY);
                   end;
          #27,#13: If S<>'' then begin
                      Val(S,V,Code); S:='';WriteLn;
                      ReadZ:=True;K:=#26;
                   end else If K=#27 then K:=#26;
      end;
   Until Ord(K)=26;
End;

Procedure Push(X: Real);Var P: TEl;
Begin New(P); P^.Val:=X; P^.Next:=SS; SS:=P; End;

Procedure StackSort;Var T,N: TEl; B: Real; {Сортировка}
Begin T:=SS;
   While T<> Nil do begin N:=T;
      While N<>Nil do begin
       If N^.Val>T^.Val then begin
        B:=N^.Val; N^.Val:=T^.Val;T^.Val:=B;
       end;
       N:=N^.Next;
      end;
      T:=T^.Next;
   end;
End;

Procedure Show;
Begin BP:=SS;
   While BP<>Nil do begin
      WriteLn(BP^.Val:10:3);
      BP:=BP^.Next;
   end;
End;

Var n: Real;
BEGIN ClrScr; SS:=Nil;
   WriteLn('Введите числа (конец ввода Ctrl+Z или Esc):');
   While ReadZ(n) do Push(n);
   WriteLn('Элементы необработанного стека:');
   Show;
   WriteLn('Элементы отсортированного стека :');
   StackSort;Show; WriteLn;

   Repeat Until KeyPressed;
END.

Procedure StackSort; {Сортировка}
    Var
        T, N: TEl;
        B: Real;
Begin
    T:= SS;
    While T <> Nil do begin
        N:= T;
        While N <> Nil do begin
            If N^.Val < T^.Val then begin { !!! }
                B:= N^.Val;
                N^.Val:= T^.Val;
                T^.Val:= B;
            end;
            N:= N^.Next;
        end;
        T:= T^.Next;
    end;
End;