Вот, на PascalABC.NET работает, думаю, на Турбе тоже пройдёт))
Type PComp = :stack; stack = record sD:real; pNext:PComp; end;
var pTop:PComp;
Procedure CreateStack(var pTop:PComp); begin New(pTop); pTop:.pNext:=nil end; Procedure push(var pTop:PComp; var sC:real); var pAux:PComp; begin New(pAux); pAux:.pNext:=pTop; pTop:=pAux; pTop:.sD:=sC end; Procedure pop(var pTop:PComp; var sC:real); begin sC:=pTop:.sD; pTop:=pTop:.pNext end;
var i: real; j, k, l: integer;
begin CreateStack(pTop); writeln('Заполните стек числами. Признак конца ввода - 0'); while (true) do begin readln(i); if (i = 0) then break else push(pTop, i); inc(j); end;
for k := 1 to j do begin pop(pTop, i); if (i > 0) then l := l + 1; end;
Type
PComp = :stack;
stack = record
sD:real;
pNext:PComp;
end;
var
pTop:PComp;
Procedure CreateStack(var pTop:PComp);
begin
New(pTop);
pTop:.pNext:=nil
end;
Procedure push(var pTop:PComp; var sC:real);
var
pAux:PComp;
begin
New(pAux);
pAux:.pNext:=pTop;
pTop:=pAux;
pTop:.sD:=sC
end;
Procedure pop(var pTop:PComp; var sC:real);
begin
sC:=pTop:.sD;
pTop:=pTop:.pNext
end;
var
i: real;
j, k, l: integer;
begin
CreateStack(pTop);
writeln('Заполните стек числами. Признак конца ввода - 0');
while (true) do
begin
readln(i);
if (i = 0) then
break
else
push(pTop, i);
inc(j);
end;
for k := 1 to j do
begin
pop(pTop, i);
if (i > 0) then
l := l + 1;
end;
writeln(l);
end.