Remove all the leaves of a binary tree in pascal

I'm trying to implement an algorithm that removes all sheets from a binary tree, that is, nodes that have no children. I can even remove it but I can not leave the "parents" of these nodes with null reference. When I call the function to display the list, it gives infinite loop error because it never reaches nil. Can someone help me? Follow code:

  program arv;

  procedure InsereD(var t:arv; x: integer);
  var p: arv;
  begin
     new(p);
     p^.item:= x;
     p^.dir:= nil;
     p^.esq:= nil;
     if t = nil then t:= p
     else
        if x<t^.item then InsereD(t^.esq, x)
        else InsereD(t^.dir, x);
   end;

        procedure EmOrdem(t:arv);
        begin
            if t<> nil then
            begin
                EmOrdem(t^.esq);
                writeln(t^.item);
                EmOrdem(t^.dir);
            end;
        end;

        procedure removeFolhas(p:arv);
        var v:integer; t:arv;
        begin
            if(p = NIL) then exit;

            removeFolhas(p^.esq);
            if((p^.esq = NIL) AND (p^.dir = NIL)) then
            begin
                t:=p;
                v := p^.item;
                p^.item := 0;
                dispose(t);
                t:=nil;
                writeln('folha ',v,' removida'); 
            end;
            removeFolhas(p^.dir);
        end;


    var t1  : arv;
    begin
        clrscr;
        write('Criando uma arvore. Digite quantos itens serao inseridos: ');
        read(n);
        if (n = 0) then t1:= nil
        else begin
            for i:=1 to n do begin
                write('Digite o ',i,'o numero:');
                readln(x);
                InsereD(t1, x);
                end;
        end;

        writeln('Imprimindo em Ordem:'); //teste de Ordem
        EmOrdem(t1);

        writeln('Removendo folhas:');
        removeFolhas(t1);

        writeln('Imprimindo em Ordem de novo:'); //teste de Ordem
        EmOrdem(t1);
        readln();
    end;