Динамические списки

[Bapr]

1)переносит в конец непустого списка L1 последний элемент списка L;
2)не переворачивая список, выводит на экран числа в обратном порядке следования чисел в списке L;
3)добавить элемент перед первым положительным числом в списке
Uses crt;
type uk=^chisla;
chisla=record
c:integer;
adr:uk;
d:uk;
end;
var
p1,p2,f11,f22,p3,p4:uk;
f1,f2,f:text;
i: integer;

procedure sozdanie(var f:text;var first:uk);
begin
{I-} reset(f); {I+}
if ioresult <>0 then
begin writeln('faila net');
readkey;
exit;
end;
first:= nil;
while not seekeof(f) do
begin new(p1);
read(f,p1^.c);
if first= nil then first:=p1
else p2^.adr:=p1;
p2:=p1;
end;
p2^.adr:=nil;
end;


procedure vuvod(var first:uk);
begin
p1:=first;
writeln;
while p1<>nil do
begin write (p1^.c:4);
p1:=p1^.adr;
end;
end;

procedure obratnoe(var first:uk);
begin

p3:=nil;
p2:=first;
while p2<>nil do
begin
p1:=first;
while p1^.adr<>p3 do
begin
p1:=p1^.adr
end;
p3:=p1;

write(p1^.c,' ');
p2:=p2^.adr;
end;
end;

procedure dobavka;
begin
p2:=f22;
p4:=nil;
while p2^.adr<>p4 do begin
p3:=p2^.adr;
p2:=p2^.adr;
end;
p1:=f11;
while p1^.adr<>nil do
p1:=p1^.adr;
p1^.adr:=p3;
end;
procedure dobav(first:uk);
var pris:boolean;d:uk;
begin
new(d);
writeln('vvedite novoe znachenie');
readln(d^.c);
d^.adr:=nil;
pris:=true;
p1:=first;
while (p1<>nil) and pris do
if p1^.c>d^.c then
begin
pris:=false;
if p1=first then
begin
d^.adr:=first;
first:=D;
end;
end;
end;
BEGIN clrscr;
assign(f1,'text.txt');
assign(f2,'text1.txt');
writeln('1 spisok');
sozdanie(f1,f11);
vuvod(f11);
writeln;
writeln('2 spisok');
sozdanie(f2,f22);
vuvod(f22);
writeln;
writeln('polychennii');
dobavka;
vuvod(f11);
writeln;
dobav(d);
writeln('perevernytii');
obratnoe(f11);
writeln;
obratnoe(f22);
readkey;
end.

проблема с добавлением элемента перед положительным

[Bapr]

проблема решена +)