Удаление одинаковых элементов списка - Turbo Pascal

Формулировка задачи:

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

type
  Tinf=integer; 
  List=^TList;  
  TList=record 
    data:TInf;  
    next:List;   
  end;
  
procedure Add(var stek1:List;znach1:TInf);
var
  tmp:List;
  i,n:integer;
 
begin
writeln(' Введите количество элементов списка');
readln(n);
for i:=1 to n do
begin
  new(tmp); 
  tmp^.next:=stek1;  
  readln(znach1);
  tmp^.data:=znach1; 
  stek1:=tmp; 
end;
end;

procedure Print(stek1:List);
begin
  if stek1=nil then 
  begin
    writeln('Стек пуст.');
    exit;
  end;
  while stek1<>nil do 
  begin   
    Write(stek1^.data, ' '); 
    stek1:=stek1^.next  
  end;
  end;

 Procedure delete(var first, second:List);
 Var p1,p2,p3:List;
 begin
  p1:=first; 
  while p1<>nil do
  begin
     p2:=p1^.next;
     while (p2<>nil) do
        if p1^.data<>p2^.data then
        begin
        p2:=p2^.next;
        end
        else
        begin
           p3:=first;
           while p3^.next<>p2 do
                p3:=p3^.next;
           p3^.next:=p2^.next;
           dispose(p2);
           p2:=p3^.next;
        end;
     p1:=p1^.next;
  end;
  end;

var
  Stk,Stk2:List;
  znach:Tinf; 
 
begin
    Add(Stk, znach);
    Print(Stk);
    Add(Stk2, znach);
    Print(Stk2);
    delete(Stk, Stk2);
    Writeln;
    Print(Stk);
    Writeln;
    Print(Stk2);
 end.

Решение задачи: «Удаление одинаковых элементов списка»

Листинг программы

type
  TData=Integer;
  
  PNode=^TNode;
  TNode=record 
    next: PNode; data: TData;  
  end;
 
function Find(p: PNode; e: TData): PNode;
begin
  while (p<>nil) and (p^.data<>e) do p:=p^.next;
  Find:=p;
end;
 
procedure Delete(var p: PNode; q: PNode);
var t: ^PNode; d: PNode;
begin
  t:=@p;
  while t^<>nil do begin
    if Find(q,t^^.data)=nil then t:=@t^^.next
    else begin
      d:=t^; t^:=t^^.next; Dispose(d);
    end;
  end;
end;
 
function NewNode(AData: TData; ANext: PNode): PNode;
var p: PNode;
begin
  New(p); NewNode:=p; p^.data:=AData; p^.next:=ANext;
end;
 
procedure Add(var p: PNode; const s: String);
var
  t: TData;
  n: Integer;
begin
  WriteLn(s);
  Write('Количество элементов: '); ReadLn(n);
  Write('Элементы: ');
  for n:=1 to n do begin
    Read(t); p:=NewNode(t,p);
  end; ReadLn;
end;
 
procedure Show(p: PNode);
begin
  while p<>nil do with p^ do begin
    Write(' ',data); p:=next;
  end; WriteLn;
end;
 
var
  f, s: PNode;
  i: Integer;
begin
  Add(f,'Список 1');
  Add(s,'Список 2');
  Delete(f,s);
  WriteLn('Список 1 без элементов из 2: '); Show(f);
end.

Объяснение кода листинга программы

В функции Find происходит поиск элемента в списке. Функция возвращает указатель на найденный элемент или nil, если элемент не найден.
В процедуре Delete происходит удаление элемента из списка. Если указанный элемент уже был удален, то его память освобождается.
В функции NewNode создается новый узел списка с заданными данными и указателем на следующий узел.
В процедуре Add добавляются элементы в список. Данные элементов считываются с консоли, создаются новые узлы и добавляются в список.
В процедуре Show происходит вывод списка на экран. Каждый элемент выводится пробелом.
В основной программе создаются два списка, добавляются элементы в них, затем удаляются. Выводится список без элементов из другого списка.