Из двух стеков равной длины с вещественными числами создать один стек с квадратами значений элементов исходных стеков

type
 
  TPElem = ^TElem;
  TElem = record
    Data : Integer;
    PNext : TPElem;
  end;
 
procedure StackPush(var aPStack, aPElem : TPElem);
begin
  aPElem^.PNext := aPStack;
  aPStack := aPElem;
end;
 
function StackPop(var aPStack, aPElem : TPElem) : Boolean;
begin
  Result := False;
  if aPStack = nil then Exit;
  aPElem := aPStack;
  aPStack := aPElem^.PNext;
  Result := True;
end;
 
procedure StackFree(var aPStack : TPElem);
var
  PDel : TPElem;
begin
  while aPStack <> nil do begin
    PDel := aPStack;
    aPStack := aPStack^.PNext;
    Dispose(PDel);
  end;
end;
 
const
  M = 10;
var
  PSt1, PSt2, PSt3, PElem : TPElem;
  i, NumMax, NumMin : Integer;
  S : String;
begin
  repeat
   
    PSt1 := nil;
    PSt2 := nil;
    PSt3 := nil;
    
    for i := 1 to M do begin
      New(PElem);
   PElem^.Data := random(100)-50; 
      StackPush(PSt1, PElem);
    end;
    
    Writeln('Содержимое первого стека:');
   while StackPop(PSt1, PElem) do begin
      StackPush(PSt3, PElem);
      Write(PElem^.Data,',');
    end;
    Writeln;
    while StackPop(PSt3, PElem) do StackPush(PSt1, PElem);
  for i := 1 to M do begin
      New(PElem);
    PElem^.Data := random(100)-50; 
     StackPush(PSt2, PElem);
    end;
    //Распечатка и переливание из второго стека в третий стек.
    Writeln('Содержимое второго стека:');
    while StackPop(PSt2, PElem) do begin
        StackPush(PSt1, PElem);
        Write(PElem^.Data,',');
    end;
       while StackPop(PSt1, PElem) do begin
      if PElem^.Data > 0 then StackPush(PSt3, PElem); 
      end;
    Writeln;
   //Переливаем элементы из третьего стека обратно - во второй стек.
    while StackPop(PSt3, PElem) do StackPush(PSt2, PElem);
 //Третий стек.
    //Переливаем из второго стека в третий только те элементы,
    //которые не равны минимальному.
    while StackPop(PSt2, PElem) do begin
      if PElem^.Data > 0 then StackPush(PSt3, PElem);
    end;
  //Распечатка элементов третьего стека.
    //При этом, стек очищается.
    Writeln('Содержимое третьего стека:');
    i := 0;
    while StackPop(PSt3, PElem) do begin
      Inc(i);
      if i > 1 then Write(', ');
      Write(PElem^.Data);
    end;
    Writeln;
    while StackPop(PSt3, PElem) do begin
      if PElem^.Data < 0 then StackPush(PSt1, PElem);
    end;
    while StackPop(PSt3, PElem) do begin
      if PElem^.Data > 0 then StackPush(PSt2, PElem);
    end;
     //Удаление стеков из памяти.
    StackFree(PSt1);
    StackFree(PSt2);
    StackFree(PSt3);
    Readln(S);
  until S <> '';
end.