Написал процедуру для однонаправленного списка. Помогите, пожалуйста, найти ошибку (не работает, видимо, зацикливается)
Код:
type
Uk = ^rec;
rec = record
x: integer;
adr: Uk;
end;
var
f1: Text;
procedure DINAMO;
var
p1, p2, p3, PP_A, PP_B, first_A, first_B: uk; {//указатели для работы со списком}
ka, kb: integer;
procedure SOZDANIEDINAMO(var first: Uk; txtname:string);
begin
clrscr; {//очистка экрана после предыдущих действий}
Assign(f1, txtname);
Reset(f1);
first := nil; {//запоминаем первый элемент}
while not seekeof(f1) do {//выполняем до конца файла}
begin
new(p1); {//выделяем память под элемент}
read(f1, p1^.x); {//считываем из текстового файла в элемент число}
if first = nil then first := p1 else p2^.adr := p1;
{//в первый раз укажем, что теперь первый элемент - это только что созданный элемент}
{//в последующие разы указываем адрес для элемента P2 - ссылаемся на P1}
p2 := p1; {//а элемент P1 переименовываем в P2, для последующего повторения действий}
end;
p2^.adr := nil; {//завершаем список}
end;
procedure VIVODDINAMO(first: uk; txt: string);
begin
writeln(txt); {//параметр, который будет описывать выводимый тип информации}
p1 := first; {//указываем на первый элемент}
while p1 <> nil do {//пробегаем до конца списка}
begin
write(p1^.x, ' '); {//и каждый раз выводим число из элемента}
p1 := p1^.adr; {//и сразу же переходим к следующему элементу}
end;
writeln;
end;
procedure Proc(var spis1, spis2: uk; pr: boolean; var ka: integer);
procedure AddElem(var spis1: Uk; znach1: integer);
var
tmp: Uk;
begin
tmp := spis1;
while tmp^.adr <> nil do
tmp := tmp^.adr; {ставим tmp на последний элемент списка}
new(p3);
p3^.x := znach1;
p3^.adr := tmp^.adr;
tmp^.adr := p3;
tmp := p3^.adr;
writeln('add');
end;
procedure DelElem(var spis1: Uk; tmp: Uk);
var
tmpi: Uk;
begin
if (spis1 = nil) or (tmp = nil) then
exit;
if tmp = spis1 then
begin
spis1 := tmp^.adr;
dispose(tmp);
end
else
begin
tmpi := spis1;
while tmpi^.adr <> tmp do
tmpi := tmpi^.adr;
tmpi^.adr := tmp^.adr;
dispose(tmp);
end;
writeln('del');
end;
begin
writeln('start proc');
p1 := spis1;
while (p1^.adr <> nil) do
begin
if (p1^.x mod 2 = 0) = pr then
begin
AddElem(spis2, p1^.x);
DelElem(spis1, p1);
end;
p1 := p1^.adr;{//к следующему элементу}
end;
writeln('obrabotka zavershena');
ka := 0;
p1 := spis1;
while p1^.adr <> nil do
begin
p1 := p1^.adr;
ka := ka + 1;
end;
writeln('kolvo raschitano');
end;
procedure urezaniespiska(var first_A: Uk; ka, kb: integer);
var
j: integer;
begin
writeln('start urezanie spiska');
p1 := first_A;
for j := 1 to (ka - kb) do
begin
first_A := p1^.adr;
dispose(p1);
p1 := first_A;
end;
writeln('stop urezanie spiska');
end;
begin
SOZDANIEDINAMO(first_A, 'curs1.txt');
SOZDANIEDINAMO(first_B, 'curs2.txt');
VIVODDINAMO(first_A, 'spisok A');
VIVODDINAMO(first_B, 'spisok B');
proc(first_A, first_B, true, ka);
proc(first_B, first_A, false, kb);
if ka > kb then urezaniespiska(first_A, ka, kb) else urezaniespiska(first_B,kb,ka);
VIVODDINAMO(first_A, 'spisok A');
VIVODDINAMO(first_B, 'spisok B');
end;