{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
program dearchyvatorius;
  uses hash;
  const max_pagr = 174;
        pagr : array [1..max_pagr] of pagr_string = (
        {$I zodziai.inc}               {visi baziniai Turbo Paskalio ýodýiai}
        duom = 'progr.pak';
        rez = 'progr.kap';
        max_buf = 65000;
        raides = ['0'..'9', 'A'..'Z', 'a'..'z', '_'];
        enter = 13;
        tarpas = 32;
        kablelis = 44;
  type buferis = array [1..max_buf] of byte;
       ilgiai = array [0..max_buf div 2] of byte;
  var fin, fout : file;
      buf : ^buferis;
      hl,                           {saugomi baziniai Turbo Paskalio ýodýiai}
      sar : hash_lentele;      {saugomi nauji ýodýiai bei simboliù kratiniai}
      il : ilgiai;    {saugo naujù ýodýiù ilgius, kad bûtù greitesnó paie÷ka}
      dydis, kiek : word;               {nearchyvuoto/archyvuoto failo dydis}
      kelintas,      {i÷saugoma, kiek naujù ýodýiù ir raidýiù kratiniù rasta}
      laipsnis : word;{rodo, uý kokõ dvejeto laipsnõ yra maýesnis "kelintas"}
      bitais : byte;            {rodo, kiek bitù uýima skaißius - "kelintas"}
      dabar : word;        {rodo, kelintÝ baitÝ i÷ buferio reikia archyvuoti}
      suarch : string;              {saugoma suarchyvuota informacija bitais}
  procedure isimink_zodi (var hl : hash_lentele; s : string);
  {õsimena ýodõ arba simboliù kratinõ, jei tikrai nóra jo sutikñs anksßiau}
    var nr : integer;
  begin {isimink_zodi}
    nr := hash_numeris (hl, s);
    if nr <> -1
      then exit;
    hash_pridek (hl, s, kelintas);
    il[kelintas] := length (s);
    if il[kelintas] > max_ilg
      then il[kelintas] := 1;
    inc (kelintas);
    if kelintas = laipsnis
      then
        begin
          laipsnis := laipsnis * 2;
          inc (bitais);
        end;
  end; {isimink_zodi}
  procedure paimk_bitu (var sk : word; kiek : byte);
  {i÷ buferio paima nurodytÝ kiekõ bitù ir juos paverßia õ skaißiù}
    var i, baitas : byte;
        tmp : string;
  begin {paimk_bitu}
    while kiek > length (suarch) do
      begin
        baitas := buf^[dabar];
        inc (dabar);
        tmp := '';
        for i := 1 to 8 do
          begin
            tmp := chr (baitas and 1) + tmp;
            baitas := baitas shr 1;
          end;
        suarch := suarch + tmp;
      end;
    sk := 0;
    for i := 1 to kiek do
      sk := sk shl 1 + ord (suarch[i]);
    delete (suarch, 1, kiek);
  end; {paimk_bitu}
  procedure isnagrinek (s : string);
  {i÷ nekoduotos eilutós istraukia zodzius ir simboliu kratinius, kurie
  gali kartotis vóliau}
    var zod : string;
        ilg : byte;
  begin
    while s <> '' do
      begin
        if (s[1] = #13) or (s = ' ')
          then delete (s, 1, 2);
        ilg := 1;
        while (ilg <= length (s)) and not (s[ilg] in raides) and
              (s[ilg] <> #13) and ((s[ilg] <> ' ') or ((s[ilg] = ' ') and
              ((ilg + 1 <= length (s)) and (s[ilg + 1] <> ' ')) or
              (ilg = length (s)))) do
          inc (ilg);
        dec (ilg);
        if ilg > 1
          then
            begin
              zod := copy (s, 1, ilg);
              delete (s, 1, ilg);
              isimink_zodi (sar, zod);
            end
          else delete (s, 1, ilg);
        ilg := 1;
        while (ilg <= length (s)) and (s[ilg] in raides) do
          inc (ilg);
        dec (ilg);
        if ilg > 1
          then
            begin
              zod := copy (s, 1, ilg);
              delete (s, 1, ilg);
              isimink_zodi (sar, zod);
            end
          else delete (s, 1, ilg);
      end;
  end;
  procedure isarchyvuok;
    var jau,                     {rodo kiek baitù kol kas gauta i÷archyvavus}
        sk, ilg, nr : word;
        i : byte;
        nearch : string;
        tmp_sar : sarasas;
  begin {isarchyvuok}
    hash_paruosk (hl);
    for i := 1 to max_pagr do
      hash_pridek (hl, pagr[i], i);

    kelintas := 0;
    bitais := 1;
    laipsnis := 2;
    hash_paruosk (sar);

    suarch := '';
    dabar := 1;
    jau := 0;
    paimk_bitu (sk, 2);
    while jau < dydis do
      case sk of
        0: begin
             paimk_bitu (sk, 1);
             if sk = 0
               then paimk_bitu (ilg, 7)
               else ilg := 1;
             nearch := '';
             for i := 1 to ilg do
               begin
                 paimk_bitu (sk, 8);
                 nearch := nearch + chr (sk);
               end;
             paimk_bitu (sk, 2);
             case sk of
               1: nearch := nearch + ' ';
               2: nearch := nearch + ',';
               3: nearch := nearch + #13#10;
             end;
             ilg := length (nearch);
             blockwrite (fout, nearch[1], ilg);
             paimk_bitu (sk, 2);
             if sk = 1
               then delete (nearch, ilg, 1);
             isnagrinek (nearch);
             inc (jau, ilg);
           end;
        1: begin
             paimk_bitu (sk, 5);
             inc (sk);
             nearch := ' ';
             for i := 1 to sk do
               nearch := nearch + ' ';
             blockwrite (fout, nearch[1], sk);
             inc (jau, sk);
             paimk_bitu (sk, 2);
           end;
        2: begin
             paimk_bitu (sk, 8);
             nearch := pagr[sk];
             paimk_bitu (sk, 2);
             case sk of
               1: nearch := nearch + ' ';
               2: nearch := nearch + ',';
               3: nearch := nearch + #13#10;
             end;
             ilg := length (nearch);
             blockwrite (fout, nearch[1], ilg);
             inc (jau, ilg);
             paimk_bitu (sk, 2);
           end;
        3: begin
             paimk_bitu (nr, bitais);
             ilg := il[nr];
             tmp_sar := sar[ilg];
             while tmp_sar^.nr <> nr do
               tmp_sar := tmp_sar^.kitas;
             nearch := tmp_sar^.st;
             paimk_bitu (sk, 2);
             case sk of
               1: nearch := nearch + ' ';
               2: nearch := nearch + ',';
               3: nearch := nearch + #13#10;
             end;
             ilg := length (nearch);
             blockwrite (fout, nearch[1], ilg);
             inc (jau, ilg);
             paimk_bitu (sk, 2);
           end;
      end;

    hash_isvalyk (hl);
    hash_isvalyk (sar);
  end; {isarchyvuok}
begin
  new (buf);
  assign (fin, duom);
  reset (fin, 1);
  blockread (fin, dydis, sizeof (dydis));
  blockread (fin, buf^, max_buf, kiek);
  close (fin);
  assign (fout, rez);
  rewrite (fout, 1);
  isarchyvuok;
  close (fout);
  dispose (buf);
end.