(*
Rozwiazanie korzysta z cyklicznej listy dwukierunkowej z atrapą.
*)
program wp09zad4;

type
    Obiekt = ^Wezel;
    Wezel = record
        znacznik : boolean;
        ob : array ['1' .. '2'] of Obiekt;
        nast, poprz : Obiekt
    end;
    Pula = Obiekt;

var zmienna : array ['a' .. 'z'] of Obiekt;
    wolne, przydzielone : Pula;
    nr, rozmiarHeapu, liczbaObiektow : Integer;
    oznaczony : Boolean;

procedure wyczysc(var p : Pula);
begin
    new(p);
    p^.nast := p;
    p^.poprz := p
end;

function jestPusta(p : Pula) : Boolean;
begin
    jestPusta := (p^.nast = p)
end;

procedure wyjmij(var p : Pula; co : Obiekt);
begin
    co^.poprz^.nast := co^.nast;
    co^.nast^.poprz := co^.poprz
end;

procedure dodajNaKoniec(var p : Pula; co : Obiekt);
begin
    co^.nast := p;
    co^.poprz := p^.poprz;
    p^.poprz^.nast := co;
    p^.poprz := co
end;

procedure usun(p : Pula);
begin
    p^.poprz^.nast := nil;
    while p^.nast <> nil do begin
        p := p^.nast;
        dispose(p^.poprz)
    end;
    dispose(p)
end;

procedure naPoczatek(p : Pula; var co : Obiekt);
begin
    co := p^.nast
end;

procedure naNastepny(p : Pula; var co : Obiekt);
begin
    co := co^.nast
end;

function naKoncu(p : Pula; co : Obiekt) : Boolean;
begin
    naKoncu := p = co
end;

procedure ustawZnacznik(co : Obiekt);
begin
    co^.znacznik := oznaczony
end;

function jestOznaczony(co : Obiekt) : Boolean;
begin
    jestOznaczony := (co^.znacznik = oznaczony)
end;

procedure kasujZnaczniki(var p : Pula);
begin
    oznaczony := not oznaczony
end;

procedure usunZnacznik(co : Obiekt);
begin
    co^.znacznik := not oznaczony
end;

procedure inicjalizuj;
var c : Char;
    kodBledu : Word;
begin
    oznaczony := false;
    for c := 'a' to 'z' do
        zmienna[c] := nil;
    wyczysc(wolne);
    wyczysc(przydzielone);
    if paramCount <> 1 then begin
        writeln('Program oczekuje jednego argumentu');
        halt
    end;
    val(paramStr(1), rozmiarHeapu, kodBledu);
    if kodBledu <> 0 then begin
        writeln('Niepoprawny argument "', paramStr(1), '"');
        halt
    end;
    liczbaObiektow := 0
end;

procedure posprzataj;
begin
    usun(wolne);
    usun(przydzielone)
end;

procedure bladWykonania(komunikat : String);
begin
    writeln('Operacja ', nr, ': ', komunikat);
    posprzataj;
    halt
end;

procedure odsmiec;
var c : Char;
    aktualny : Obiekt;
    zywe : Pula;
    liczbaZywych : Integer;

    procedure obsluz(co : Obiekt);
    begin
        if co <> nil then
            if not jestOznaczony(co) then begin
                wyjmij(przydzielone, co);
                dodajNaKoniec(zywe, co);
                ustawZnacznik(co);
                liczbaZywych := liczbaZywych + 1
            end
    end;

begin
    zywe := wolne;
    liczbaZywych := 0;
    for c := 'a' to 'z' do
        obsluz(zmienna[c]);
    naPoczatek(zywe, aktualny);
    while not naKoncu(zywe, aktualny) do begin
        obsluz(aktualny^.ob['1']);
        obsluz(aktualny^.ob['2']);
        naNastepny(zywe, aktualny)
    end;
    wolne := przydzielone;
    przydzielone := zywe;
    kasujZnaczniki(zywe);
    writeln('Operacja ', nr, ': odsmiecono ', rozmiarHeapu - liczbaZywych)
end;

function przydzielObiekt : Obiekt;
var wynik : Obiekt;
begin
    if liczbaObiektow < rozmiarHeapu then begin
        new(wynik);
        liczbaObiektow := liczbaObiektow + 1
    end else begin
        if jestPusta(wolne) then
            odsmiec;
        if jestPusta(wolne) then
            bladWykonania('brak miejsca w pamieci');
        naPoczatek(wolne, wynik);
        wyjmij(wolne, wynik)
    end;
    usunZnacznik(wynik);
    wynik^.ob['1'] := nil;
    wynik^.ob['2'] := nil;
    dodajNaKoniec(przydzielone, wynik);
    przydzielObiekt := wynik
end;

procedure wykonaj;
var s : String;
    i : Integer;
begin
    nr := 0;
    readln(s);
    while s <> '' do begin
        nr := nr + 1;
        for i := 2 to length(s) do
            if s[i] = '^' then
                if zmienna[s[i - 1]] = nil then
                    bladWykonania('brak obiektu');
        case length(s) of
            6  : {new(?)}
                zmienna[s[5]] := przydzielObiekt;
            11 : {new(?^.ob?)}
                zmienna[s[5]]^.ob[s[10]] := przydzielObiekt;
            4  : {?:=?}
                zmienna[s[1]] := zmienna[s[4]];
            9 : {?^.ob?:=? lub ?:=?^.ob?}
                if s[2] = ':' then
                    zmienna[s[1]] := zmienna[s[4]]^.ob[s[9]]
                else
                    zmienna[s[1]]^.ob[s[6]] := zmienna[s[9]];
            14 : {?^.ob?:=?^.ob?}
                zmienna[s[1]]^.ob[s[6]] := zmienna[s[9]]^.ob[s[14]];
            else
                bladWykonania('niepoprawna skladnia')
        end;
        readln(s)
    end
end;

begin
    inicjalizuj;
    wykonaj;
    posprzataj
end.