Односвязный список: не работает процедура удаления последнего элемента

program plisf;
uses crt;
  type adrcel=^celula;
       celula=record
       info:integer;
       urm:adrcel;
  end;
  var p:adrcel;
      f:text;
      c:char;
procedure creare;
    var r,v:adrcel;
    begin
    assign(f,'real.txt');
    reset(f);
    while not eof(f) do
    begin
    new(r);
    read(f,r^.info);
    r^.urm:=nil;
    if p=nil then begin
    p:=r; v:=r end
    else  begin v^.urm:=r; v:=r;
    end; end; end;
 
procedure afishare;
      var r:adrcel;
      begin
      r:=p;
      while R^.urm<>nil do begin
      write(r^.info);
      r:=r^.urm;
      end;
      writeln;
      end;
 
procedure sterg_prim;
var r:adrcel;
begin
r:=p;
p:=p^.urm;
dispose(r);
end;
 
procedure sterg_ultim;
var r,v:adrcel;
begin
r:=p;
while v^.urm<>nil do
begin
r:=r^.urm;
v:=r^.urm;
r^.urm:=v^.urm;
dispose(r);
end;end;
 
begin
clrscr;
p:=nil;
repeat
writeln('=====MENIU=====');
writeln('c-Crearea Listei Din Fisier');
writeln('a-Afisarea Listei La Ecran');
writeln('e-Excludere Primului Element');
writeln('t-Stergerea Ultimului Element');
writeln('s-Iesirea');
writeln('Introdu optiunea:');
readln(c);
case c of
'c':creare;
'a':afishare;
'e':sterg_prim;
't':sterg_ultim;
's':
else writeln('Optiune inexistenta!');
end;
until c='s';
end.

program plisf;
var 
head:adrcel;//..указатель на голову списка
current:adrcel;//на текущий элемент
f:text;
c:char;

head:=nil; current:=nil;

procedure afishare (current , head:adrcel);
begin
      current:=head;
      while current^.urm<>nil do 
      begin
      write(current^.info);
      current:=current^.urm;
      end;
      writeln;
end;

afishare (current , head);