[Alan85]

Принципиально не верно стек сделан - последний элемент должен хранить адрес предыдущего т.е. 1<-2<-3<-4... а тут 1->2->3->4. Поэтому после выдавливания последнего элемента указатель last теряется... - адреса 3 элемента не найдет (если только перебором от 1 до 3).
Вот как подправил я:

Код:

procedure Build (var S: tStack; D: tData); {первоначальное заполнение стека}
var
   f: text;
   p: tPtr;
begin
   assign (f,'stack.txt');
   reset (f);
   S.First := nil;
   S.Last := nil;
   while not eof(f) do begin
      New(p);
      readln (f, D);
      p^.data := D;
      if S.First = nil then begin
      	S.First := p; s.last:=p  end
      else
      begin
       p^.next := s.last;
       S.Last := p;
      end;
   end;

   close(f);
end;

procedure Echo (var S: tStack); {вывод стека на экран}
var
	p: tPtr;
begin
   {p^ := S.Last^;}
   while S.last <> s.first do begin
      Pop (S, D);
      write (D,' ');
  //    Echo (S);
   end;
 Pop (S, D);
 write (D,' ');
end;

Но это стирает стек - полностью его выталкивает, поэтому для отображения не верно все же