{De la tastatura se citesc  numere intregi diferite de zero.
 Se cere sa se creeze doua liste, una a numerelor negative,
 iar alta - a numerelor pozitive}
Program Tema_2_3_Probl_5;

type Lista = ^Celula;
     Celula = record  {O celula din lista}
       Info: Integer; {Continutul celulei}
       Urm:  Lista;   {Adresa urmatoarei celule}
     end;

var L1, L2: Lista;   {L - baza listei}

procedure Citeste;
var R, P, Q: Lista;
    i: Integer;
begin
  new(L1); new(L2);
  P := L1; Q := L2; {P si Q indica ultima celula din lista, corespunzator}
  writeln('Scrie o lista de nr intregi nenule (0 termina citirea):');
  writeln;
  repeat
    new(R);           {Alocarea memoriei pentru o noua celula}
    readln(R^.Info);  {Popularea celulei cu informatie citita de la tastiera}
    if R^.Info > 0 then begin
      P^.Urm := R;     {Atasam celula R la lista L1}
      P := R;          {R este ultima celula din L1}
    end else
    if R^.Info < 0 then begin
      Q^.Urm := R;     {Atasam celula R la lista L2}
      Q := R;          {Trecerea la urmatoarea celula}
    end else
    begin {P^.Info = 0}
       Dispose(R); {Eliminam R}
       P^.Urm := nil;       {Marcam sfarsitul listei L1}
       Q^.Urm := nil;       {Marcam sfarsitul listei L2}
       {Prima celula din fiecare lista nu contine nimic, de aceea se elimina}
       R := L1^.Urm; Dispose(L1); L1 := R;
       R := L2^.Urm; Dispose(L2); L2 := R;
       Break;     {Listele au fost create}
    end;
  until false;
end;

procedure Scrie(var L: Lista);  {Afisarea listei}
var P: Lista;
begin
  P := L;  {Inceputul listei}
  while P <> nil do  {Pana nu se ajunge la sfarsitul listei}
    with P^ do begin
      Writeln(Info); {Afisarea informatiei din celula}
      P := Urm;      {Trecerea la urmatorul element}
    end;
end;

procedure Distruge(var L: Lista);  {Distrugerea listei}
var P: Lista;
begin
  while L <> nil do
    with L^ do begin
      P := Urm;   {Salvarea adresei celulei urmatoare}
      Dispose(L); {Eliberarea memoriei ocupate de celula curenta}
      L := P;     {Trecerea la urmatoarea celula}
    end;
end;

begin
  writeln;  writeln;
  Citeste;

  writeln('----------------------------------');
  writeln('Numerele pozitive:');
  Scrie(L1);

  writeln('----------------------------------');
  writeln('Numerele negative:');
  Scrie(L2);

  Distruge(L1);
  Distruge(L2);

  readln;
end.