{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
program archyvatorius;
  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.pas';
        rez = 'progr.pak';
        max_buf = 65000;
        raides = ['0'..'9', 'A'..'Z', 'a'..'z', '_'];
        enter = 13;
        tarpas = 32;
        kablelis = 44;
  type buferis = array [1..max_buf] 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}
      dydis : word;                                {nearchyvuoto failo dydis}
      saug,           {ßia saugoma informacija, kuriÝ reikia õrasyti õ failÝ}
      isn : byte;              {kiek bitù uýimta saugomos informacijos baite}
      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}
      i : word;
  procedure isimink_zodi (var hl : hash_lentele; s : string);
  {õsimena naujai sutiktÝ ýodõ ar simboliù kratinõ}
  begin {isimink_zodi}
    hash_pridek (hl, s, kelintas);
    inc (kelintas);
    if kelintas = laipsnis
      then
        begin
          laipsnis := laipsnis * 2;
          inc (bitais);
        end;
  end; {isimink_zodi}
  procedure padek_bitu (s : string);
  {i÷saugo suarchyvuotÝ informacijÝ, kuri pateikiama bitù eilute}
    var i : byte;
  begin {padek_bitu}
    for i := 1 to length (s) do
      begin
        saug := saug shl 1 + (ord (s[i]) - 48);
        inc (isn);
        if isn = 8
          then
            begin
              blockwrite (fout, saug, 1);
              saug := 0;
              isn := 0;
            end;
      end;
  end; {padek_bitu}
  procedure padek_skaiciu (sk : word; bitu : byte);
  {i÷saugo suarchyvuotÝ informacijÝ, kuri pateikiama kaip skaißius ir
  nurodoma keliais bitais jõ reikia uýkoduoti}
  begin {padek_skaiciu}
    while bitu + isn >= 8 do
      begin
        saug := saug shl (8 - isn) + byte (sk shr (bitu + isn - 8));
        blockwrite (fout, saug, 1);
        sk := sk shl (24 - bitu - isn) shr (24 - bitu - isn);
        bitu := bitu + isn - 8;
        saug := 0;
        isn := 0;
      end;
    saug := saug shl bitu + sk;
    isn := isn + bitu;
  end; {padek_skaiciu}
  procedure padek_eilute (s : string);
  {i÷saugo suarchyvuotÝ informacijÝ, kuri pateikiama kaip simboliù eilutó}
    var i, simb : byte;
  begin {padek_eilute}
    for i := 1 to length (s) do
      begin
        simb := ord (s[i]);
        saug := saug shl (8 - isn) + simb shr isn;
        blockwrite (fout, saug, 1);
        saug := byte (simb shl (8 - isn)) shr (8 - isn);
      end;
  end; {padek_eilute}
  procedure padek_nearch (var nearch : string);
  {i÷saugo nearchyvuotos informacijos eilutñ}
    var ilg, gale : byte;
  begin {padek_nearch}
    if nearch = ' '
      then
        begin
          padek_bitu ('0100000');
          nearch := '';
          exit;
        end;
    ilg := length (nearch);
    gale := ord (nearch[ilg]);
    if gale in [tarpas, kablelis, enter]
      then delete (nearch, ilg, 1);
    padek_bitu ('00');
    ilg := length (nearch);
    if ilg = 1
      then padek_bitu ('1')
      else
        begin
          padek_bitu ('0');
          padek_skaiciu (ilg, 7);
        end;
    padek_eilute (nearch);
    case gale of
      tarpas: padek_bitu ('01');
      kablelis: padek_bitu ('10');
      enter: padek_bitu ('11');
      else padek_bitu ('00');
    end;
    nearch := '';
  end; {padek_nearch}
  procedure koduok_tarpus (var nearch : string);
  {suarchyvuoja i÷ eilós einanßius tarpus}
    var kiek : byte;
  begin {koduok_tarpus}
    kiek := 0;
    inc (dabar);
    while (dabar < dydis) and (buf^[dabar] = tarpas) and (kiek < 31) do
      begin
        inc (dabar);
        inc (kiek);
      end;
    if kiek > 0
      then
        begin
          if nearch <> ''
            then
              begin
                dec (kiek);
                nearch := nearch + ' ';
                padek_nearch (nearch);
              end;
          padek_bitu ('01');
          padek_skaiciu (kiek, 5);
        end
      else nearch := nearch + ' ';
  end; {koduok_tarpus}
  procedure pabaik_zodi;
  {jeigu po archyvuotos informacijos eina tarpas, kablelis arba eilutós
  pabaigos simboliai, jie uýkoduojami tik dviem bitais!}
  begin {pabaik_zodi}
    case buf^[dabar] of
      tarpas: begin
                padek_bitu ('01');
                inc (dabar);
              end;
      kablelis: begin
                  padek_bitu ('10');
                  inc (dabar);
                end;
      enter: begin
               padek_bitu ('11');
               inc (dabar, 2);
             end;
      else padek_bitu ('00');
    end;
  end; {pabaik_zodi}
  procedure koduok_zodi (var nearch : string);
  {bando suarchyvuoti ýodõ, susidedanti i÷ raidýiù ir skaitmenù}
    var zod : string;
        ilg : byte;
        nr : integer;
  begin {koduok_zodi}
    zod := '';
    while chr(buf^[dabar]) in raides do
      begin
        zod := zod + chr (buf^[dabar]);
        inc (dabar);
      end;
    ilg := length (zod);
    if ilg > 1
      then
        begin
          nr := hash_numeris (hl, zod);
          if nr <> -1
            then
              begin
                if nearch <> ''
                  then padek_nearch (nearch);
                padek_bitu ('10');
                padek_skaiciu (nr, 8);
                pabaik_zodi;
              end
            else
              begin
                nr := hash_numeris (sar, zod);
                if nr <> -1
                  then
                    begin
                      if nearch <> ''
                        then padek_nearch (nearch);
                      padek_bitu ('11');
                      padek_skaiciu (nr, bitais);
                      pabaik_zodi;
                    end
                  else
                    begin
                      nearch := nearch + zod;
                      isimink_zodi (sar, zod);
                    end;
              end;
        end
      else nearch := nearch + zod;
  end; {koduok_zodi}
  procedure koduok_nezodi (var nearch : string);
  {bando suarchyvuoti simboliù kratinõ}
    var nezod : string;
        nr : integer;
  begin {koduok_nezodi}
    nezod := '';
    while (dabar <= dydis) and not (chr (buf^[dabar]) in raides) and
          (buf^[dabar] <> enter) and ((buf^[dabar] <> tarpas) or
          ((buf^[dabar] = tarpas) and (dabar + 1 <= dydis) and
           (buf^[dabar + 1] <> tarpas))) do
      begin
        nezod := nezod + chr (buf^[dabar]);
        inc (dabar);
      end;
    if nearch = ' '
      then
        begin
          nezod := ' ' + nezod;
          nearch := '';
        end;
    if length (nezod) > 1
      then
        begin
          nr := hash_numeris (sar, nezod);
          if nr <> -1
            then
              begin
                if nearch <> ''
                  then padek_nearch (nearch);
                padek_bitu ('11');
                padek_skaiciu (nr, bitais);
                pabaik_zodi;
              end
            else
              begin
                nearch := nearch + nezod;
                isimink_zodi (sar, nezod);
              end;
        end
      else nearch := nearch + nezod;
  end; {koduok_nezodi}
  procedure archyvuok;
    var nearch : string;                   {saugoma nearchyvuota informacija}
        i : byte;
  begin {archyvuok}
    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);

    saug := 0;
    isn := 0;
    dabar := 1;

    nearch := '';
    while dabar <= dydis do
      begin
        while buf^[dabar] = tarpas do
          koduok_tarpus (nearch);
        koduok_zodi (nearch);
        koduok_nezodi (nearch);
        if buf^[dabar] = enter
          then
            begin
              nearch := nearch + #13;
              padek_nearch (nearch);
              inc (dabar, 2);
            end;
      end;
    if nearch <> ''
      then padek_nearch (nearch);
    if isn > 0
      then
        begin
          saug := saug shl (8 - isn);
          blockwrite (fout, saug, 1);
        end;

    hash_isvalyk (hl);
    hash_isvalyk (sar);
  end; {archyvuok}
begin
  new (buf);
  assign (fin, duom);
  reset (fin, 1);
  fillchar (buf^, max_buf, 0);
  blockread (fin, buf^, max_buf, dydis);
  close (fin);
  for i := 1 to dydis do
    if chr (buf^[i]) in ['A'..'Z']
      then inc (buf^[i], 32);
  assign (fout, rez);
  rewrite (fout, 1);
  blockwrite (fout, dydis, sizeof (dydis));
  archyvuok;
  close (fout);
  dispose (buf);
end.