Turbo Pascal Стек

[Dower]

Помогите разобраться с задачей.

Дан указатель P1 на вершину стека (если стек пуст, то P1=NIL). Извлеч из стека все элементы и вывести их значения. Вывести также количество известных элементов N (для пустого стека вывести 0). после извлечения элементов из стека освобождать память которую они занимали.

Вот есть код

uses crt;
type PSTRC=^Strc;
     Strc=record
     inf:integer;
     ptr:Pstrc;
end;
var S1,s2:PSTRC;
    i,k,g,p:integer;
    err:boolean;
    a:array [1..20] of integer;
Procedure Dop(var S:Pstrc;dat:integer);
var nov:Pstrc;
begin
New(nov);
nov^.inf:=dat;
nov^.Ptr:=s;
S:=nov;
end;
Function Ud(var S:Pstrc; var err:boolean):integer;
var old:Pstrc;
begin
 if s<>Nil then
  begin
   old:=S;
   S:=S^.ptr;
   Ud:=old^.inf;
   dispose(old);
   err:=false
  end
 else
  begin
   Ud:=0;
   err:=true
  end
end;
Function Cht(s:PSTRC; var err:boolean):integer;
begin
if s<>Nil then
 begin
  write('inf=',s^.inf:3);
  err:=false;
  Cht:=s^.inf;
 end
else begin
      writeln('stack pust');
      err:=True;
      cht:=0;
     end;
end;
BEGIN
 clrscr;
 i:=1;
 k:=1;
 while k<>0 do
  begin
   readln(k);
   Dop(s1,k);
  end;
 while s1<>Nil do
  begin
   a[i]:=Ud(s1,err);
   inc(i);
  end;
 for k:=i downto 1 do
  dop(s2,a[k]);
 for k:=1 to i do
  writeln(ud(s2,err));
readln;
END.

Не могли бы вы проверить правильность его работы, а то почему то в конце при любом раскладе 0 выводится. И если не трудно хотя бы в общих чертах объясните код.

[phomm]

type
 pnode=^node;
  node=record
    num:integer;
    next:pnode;
    ch : char;
  end;

var ver, t1 : pnode;

procedure stackout(var anum : integer); // вытащить из стека
begin
if ver<>nil  // если верхушка есть
  then begin
  anum := ver^.num;  // то вернуть её номер
  t1 := ver;         // временный узел
  ver := ver^.next;  // текущий узел задать как следующий
  dispose(t1);       // очистить узел
  end
  else showmessage('стек пустой!');
end;


procedure stackin( anum : integer; ach:char); // складывание в стек
begin
if ver=nil                  // если верхушки стека нет
  then begin                // то завести её и задать параметры
  new(ver);
  ver^.next := nil;
  ver^.ch := ach;
  ver^.num := anum;
  end
  else begin                // иначе новые данные записать в новый узел
  new(t1);
  t1^.ch := ach;
  t1^.num := anum;
  t1^.next := ver;      // нынешнюю вершину стека сделать след узлом для созданного
  ver := t1;               // и задать указатель верхушки на созданый узел
  end;
end;

там в стеке кроме номера есть ещё и символ, но можно просто удалить все обращения к нему

сам напишешь вызов данных подпрограмм ? а то у меня в коде они не посредственно не делают заполнение и очистку всего стека, а вызываются по мере необходимости

[Dower]

Спасибо за код.
Хорошо бы если бы вы смогли написать и вызов этих процедур, а то я в программировании не очень понимаю.

[Dower]

АП____________

[Dower]

phomm или кто ни будь, кто понимает, помогите дописать пожалуйста программку.

[phomm]

ну как же по комментариям-то не дойти ?? Ведь не могли же Вам задать задание такое , что Вы не проходили ! Вы должны уже быть в теме ! мало времени значит уделили Вы развитию своего понимания...

вызывается примерно так :

const stacksize = 20
...
var i, tmp : integer;
...
for i := 1 to stacksize
  do stackin(i); // подразумевается, что работу с символом убрали
// теперь в стеке 20 элементов
...
for i := 1 to stacksize
  do begin
  stackout(tmp);
  writeln(tmp); // вывод стека, естественно, цифры пойдут в обратном порядке
  end;

вообще можно сделать извлечение функцией, а не процедурой, но это не особо на что-то влияет

[Dower]

Добавил к первому коду вашу концовку но почему то не работает.

[Dower]

Может я что не так сделал?

[Dower]

Помогите доделать програмку, а то ни как не получается.

[Dower]

Разобрался с программкой теперь все работает. Вот код

uses crt;
type PSTRC=^Strc;
     Strc=record
     inf:integer;
     ptr:Pstrc;
end;
var S1,s2:PSTRC;
    i,k,g,p:integer;
    err:boolean;
    a:array [1..20] of integer;
Procedure Dop(var S:Pstrc;dat:integer);
var nov:Pstrc;
begin
New(nov);
nov^.inf:=dat;
nov^.Ptr:=s;
S:=nov;
end;
Function Ud(var S:Pstrc; var err:boolean):integer;
var old:Pstrc;
begin
 if s<>Nil then
  begin
   old:=S;
   S:=S^.ptr;
   Ud:=old^.inf;
   dispose(old);
   err:=false
  end
 else
  begin
   Ud:=0;
   err:=true
  end
end;
Function Cht(s:PSTRC; var err:boolean):integer;
begin
if s<>Nil then
 begin
  write('inf=',s^.inf:3);
  err:=false;
  Cht:=s^.inf;
 end
else begin
      writeln('stack pust');
      err:=True;
      cht:=0;
     end;
end;
BEGIN
 clrscr;
 i:=0;
 k:=1;
 while k<>0 do
  begin
   readln(k);
   Dop(s1,k);
  end;
  writeln;
 while s1<>Nil do
  begin
   a[i]:=Ud(s1,err);
   inc(i);
  end;
 for k:=i downto 1 do
  dop(s2,a[k]);
 for k:=1 to i do
  writeln(ud(s2,err));
  writeln;
  writeln(i);
readln;
END.

Но здесь используется массив и второй стек (s2). Помогите исправить код так чтобы работало без применения массива и второго стека.