стек в делфи

[pizhon1]

сформировать из элементов стека, меньших минимального элемента очереди, новый стек. нахожу минимальный элемент, а вот новый стек не формируется. подскажите как сделать правильно

program Project1;

{$APPTYPE CONSOLE}
uses
  SysUtils;
const max=1000;
  type och = record
     first,last:integer;
     elem: array [1..max] of integer;
     end;
      stack = record
               top: word;
               max:integer;
               elem: array [1..max] of integer;
               end;

procedure nullOch(var o:och);
 begin
  o.first:=1;
  o.last:=max;
 end;
 
function addone_o (i:integer):integer;
begin
 addone_o := i mod max + 1 ;
end;

function empty_o (o:och):boolean;
begin
 empty_o := addone_o (o.last) = o.first;
end;
 
procedure put_o (x: integer; var o: och);
begin
 if addone_o (addone_o (o.last)) = o.first then writeln('overflow')else
 begin
  o.last:=addone_o(o.last);
  o.elem[o.last]:=x;
 end;
end;

procedure take_o (var x: integer; var o:och);
begin
 if empty_o(o) then writeln('empty')
 else
 begin
  x := o.elem[o.first];
  o.first := addone_o (o.first);
 end;
end;

procedure show_o(var o:och);
var i:integer;
begin
 for i:=1 to o.last do write(o.elem[i], ' ');
end;



  procedure null(var s:stack);
 begin
  s.top:=max+1;
 end;

function empty(s:stack): boolean;
 begin
  empty:=s.top=max+1;
 end;

procedure push (x:integer; var s:stack);
 begin
  if s.top=1 then  writeln ( 'stack overflow' )  else
  begin
   dec(s.top);
   s.elem[s.top]:=x;
  end;
 end;

procedure pop (var x:integer; var s : stack);
  begin
   if empty(s) then writeln('empty') else
    begin
     x:=s.elem[s.top];
     inc(s.top);
    end;
  end;

procedure show_s(var s:stack);
 var i,k:integer; p:stack;
begin
  p:=s;
  null(p);
  dec(p.top);
 while p.elem[p.top]<>0 do
 begin
  write(p.elem[p.top], ' ');
  dec(p.top);
 end;
end;
    procedure minoch(o:och; var min:integer);
 begin
   min:=o.elem[o.last]; o.first:=o.last-1;
   while o.first <> 0 do
    begin
     if min >= o.elem[o.first] then min:=o.elem[o.first];
     dec(o.first);
    end;
end;
   procedure men(s:stack; var s1:stack; x:integer);
 begin
  s.top:=max;
  while s.elem[s.top] <> 0 do
   begin
    if s.elem[s.top] < x then push(s.elem[s.top],s1);
    dec(s.top);
   end;
 end;
  var o,oo:och; s,s1:stack; n_o,o_o,i,min,ch,k,l:integer;
begin
 randomize;
 write('razmer steka = ');
 readln(n_o);
 write('razmer ocheredi = ');
 readln(o_o); writeln;
 null(s);
 nulloch(o);
 writeln ( 'stek :');
  for i:=1 to n_o do push(random(20)+1,s);
   show_s(s); writeln;writeln;writeln ( 'ochered:');
    for i:=1 to o_o do put_o(random(20)+1,o);
    show_o(o); minoch(oo,min); writeln;
     writeln('Minimalnii element och: ',min);
     men(s,s1,min);
     writeln;writeln('stek:');
     show_s(s1);
     readln;
end.