program AR;

type
  ByteStream = file of byte;
const
  BITS_IN_REGISTER = 16;
  TOP_VALUE = (1 shl BITS_IN_REGISTER) - 1;
  FIRST_QTR = (TOP_VALUE div 4) + 1;
  HALF = FIRST_QTR * 2;
  THIRD_QTR = FIRST_QTR * 3;
  NO_OF_CHARS = 256;
  EOF_SYMBOL = NO_OF_CHARS + 1;
  NO_OF_SYMBOLS = NO_OF_CHARS + 1;
  MAX_FREQUENCY = (TOP_VALUE div 4);
var
  {таблицы перекодировки}
  index_to_char : array[0..NO_OF_SYMBOLS-1] of byte;
  char_to_index : array[0..NO_OF_CHARS-1] of integer;
  {таблицы частот}
  cum_freq : array[0..NO_OF_SYMBOLS] of integer;
  freq : array[0..NO_OF_SYMBOLS] of integer;
  {регистры границ и кода}
  low, high : longint;
  value : longint;
  {поддержка побитовых операций с файлами}
  bits_to_follow : longint;
  buffer : integer;
  bits_to_go : integer;
  garbage_bits : integer;
  {обрабатываемые файлы}
  InFile, OutFile : ByteStream;

{инициализация адаптивной модели}
procedure start_model;
  var
    i : integer;
  begin
    for i := 0 to NO_OF_CHARS-1 do
      begin
        char_to_index[i] := i+1;
        index_to_char[i+1] := i;
      end;
    for i := 0 to NO_OF_SYMBOLS do
      begin
        freq[i] := 1;
        cum_freq[i] := NO_OF_SYMBOLS - i;
      end;
    freq[0] := 0;
  end;

{обновление модели очередным символом}
procedure update_model( symbol : integer);
  var
    i, ch_i, ch_symbol, cum : integer;
  begin
    if cum_freq[0] = MAX_FREQUENCY then
      begin
        cum := 0;
        for i := NO_OF_SYMBOLS downto 0 do
          begin
            freq[i] := (freq[i]+1) div 2;
            cum_freq[i] := cum;
            Inc(cum,freq[i]);
          end;
      end;
    i := symbol;
    while freq[i] = freq[i-1] do Dec(i);
    if i < symbol then
      begin
        ch_i := index_to_char[i];
        ch_symbol := index_to_char[symbol];
        index_to_char[i] := ch_symbol;
        index_to_char[symbol] := ch_i;
        char_to_index[ch_i] := symbol;
        char_to_index[ch_symbol] := i;
      end;
    Inc(freq[i]);
    while i > 0 do
      begin
        Dec(i);
        Inc(cum_freq[i]);
      end;
  end;

{инициализация побитового ввода}
procedure start_inputing_bits;
  begin
    bits_to_go := 0;
    garbage_bits := 0;
  end;

{ввод очередного бита сжатой информации}
function input_bit : integer;
  var
    t : integer;
    byte_buf : byte absolute buffer;
  begin
    if bits_to_go = 0 then
      begin
      {$I-}
        Read(Infile,byte_buf);
        if IOResult <> 0 then
          begin
            buffer := -1;
            Inc(garbage_bits);
            if garbage_bits > BITS_IN_REGISTER - 2 then
              begin
                Writeln('Ошибка в сжатом файле');
                Halt(255);
              end;
          end;
        bits_to_go := 8;
      {$I+}
      end;
    t := buffer and 1;
    buffer := buffer shr 1;
    Dec(bits_to_go);
    input_bit := t;
  end;

{инициализация побитового вывода}
procedure start_outputing_bits;
  begin
    buffer := 0;
    bits_to_go := 8;
  end;

{вывод очередного бита сжатой информации}
procedure output_bit( bit : integer );
  var
    byte_buf : byte absolute buffer;
  begin
    buffer := buffer shr 1;
    if bit <> 0 then buffer := buffer or $80;
    Dec(bits_to_go);
    if bits_to_go = 0 then
      begin
        Write(OutFile, byte_buf);
        bits_to_go := 8;
      end;
  end;

{очистка побитового вывода}
procedure done_outputing_bits;
  var
    byte_buf : byte;
  begin
    byte_buf := buffer shr bits_to_go;
    Write(OutFile,byte_buf);
  end;

{вывод указанного бита и отложенных ранее}
procedure output_bit_plus_follow( bit : integer);
  begin
    output_bit(bit);
    while bits_to_follow > 0 do
      begin
        output_bit(Ord(not (bit <> 0)));
        Dec(bits_to_follow);
      end
  end;

{инициализация регистров границ и кода перед началом сжатия}
procedure start_encoding;
  begin
    low := 0;
    high := TOP_VALUE;
    bits_to_follow := 0;
  end;

{}
procedure done_encoding;
  begin
    Inc(bits_to_follow);
    if low < FIRST_QTR then output_bit_plus_follow(0)
    else output_bit_plus_follow(1);
  end;

{инициализация регистров перед декодированием}
procedure start_decoding;
  var
    i : integer;
  begin
    value := 0;
    for i := 1 to BITS_IN_REGISTER do value := 2 * value + input_bit;
    low := 0;
    high := TOP_VALUE;
  end;

{кодирование очередного символа}
procedure encode_symbol( symbol : integer);
  var
    range : longint;
  begin
    range := high - low + 1;
    high := low+(range*cum_freq[symbol-1]) div cum_freq[0] - 1;
    low := low+(range*cum_freq[symbol]) div cum_freq[0];
    while true do
      begin
        if high < HALF then output_bit_plus_follow(0)
        else if low >= HALF then
          begin
            output_bit_plus_follow(1);
            Dec(low, HALF);
            Dec(high, HALF);
          end
        else if (low >= FIRST_QTR) and (high < THIRD_QTR) then
          begin
            Inc(bits_to_follow);
            Dec(low, FIRST_QTR);
            Dec(high, FIRST_QTR);
          end
        else break;
        low := 2 * low;
        high := 2 * high + 1;
      end;
  end;

{декодирование очередного символа}
function decode_symbol : integer;
  var
    range : longint;
    cum, symbol : integer;
  begin
    range := high - low + 1;
    cum := ((value - low + 1) * cum_freq[0] - 1) div range;
    symbol := 1;
    while cum_freq[symbol] > cum do Inc(symbol);
    high := low+(range*cum_freq[symbol-1]) div cum_freq[0] - 1;
    low := low+(range*cum_freq[symbol]) div cum_freq[0];
    while true do
      begin
        if high < HALF then
          begin
          end
        else if low >= HALF then
          begin
            Dec(value,HALF);
            Dec(low,HALF);
            Dec(high,HALF);
          end
        else if (low >= FIRST_QTR) and (high < THIRD_QTR) then
          begin
            Dec(value,FIRST_QTR);
            Dec(low,FIRST_QTR);
            Dec(high,FIRST_QTR);
          end
        else break;
        low := 2 * low;
        high := 2 * high + 1;
        value := 2 * value + input_bit;
      end;
    decode_symbol := symbol;
  end;

{собственно адаптивное арифметическое кодирование}
procedure encode( const InName, OutName : string);
  var
    symbol : integer;
    ch : byte;
  begin
    Assign(InFile,InName);
    Assign(OutFile,OutName);
    Reset(Infile); Rewrite(OutFile);
    start_model;
    start_outputing_bits;
    start_encoding;
    while not Eof(Infile) do
      begin
        Read(Infile,ch);
        symbol := char_to_index[ch];
        encode_symbol(symbol);
        update_model(symbol);
      end;
    encode_symbol(EOF_SYMBOL);
    done_encoding;
    done_outputing_bits;
    Close(InFile); Close(OutFile);
  end;

{собственно адаптивное арифметическое декодирование}
procedure decode( const InName, OutName : string);
  var
    symbol : integer;
    ch : byte;
  begin
    Assign(InFile,InName);
    Assign(OutFile,OutName);
    Reset(Infile); Rewrite(OutFile);
    start_model;
    start_inputing_bits;
    start_decoding;
    while true do
      begin
        symbol := decode_symbol;
        if symbol = EOF_SYMBOL then break;
        ch := index_to_char[symbol];
        Write(OutFile,ch);
        update_model(symbol);
      end;
    Close(InFile); Close(OutFile);
  end;

begin
  if ParamCount <> 3 then
    begin
      Writeln;
      Writeln('Usage: ar e|d infile outfile');
      Writeln;
      Halt(1);
    end;
  if (ParamStr(1) = 'e') or (ParamStr(1) = 'E') then
    encode(ParamStr(2),ParamStr(3))
  else if (ParamStr(1) = 'd') or (ParamStr(1) = 'D') then
    decode(ParamStr(2),ParamStr(3));
  Halt(0);
end.