UNIT xxx_processor_unit;
INTERFACE
USES base, object, dictionary, scanner;
type xxx_processor_handle_t  = pointer;

procedure xxx_processor_open
                (var handle    : xxx_processor_handle_t;
                 dic_file      : path_name_t);

procedure xxx_processor_use
                (handle        : xxx_processor_handle_t;
                 in_path_name,
                 out_path_name : path_name_t;
                 var error_code: Integer);

procedure xxx_processor_close
                (handle        : xxx_processor_handle_t);


IMPLEMENTATION
const
  apostr            = chr (39);
  newline           = chr (10);
  token_min         =  0;
  token_empty       =  0;
  token_max_keyword =  9;
  token_finish      = 10;
  token_symbol      = 11;
  token_value       = 12;
  token_max         = 13;

type
  token_range_t     = 0..13;
  token_set_t       = set of token_range_t;
  
  appl_handle_p_t   = ^appl_handle_t;
  appl_handle_t     = record
                        scan_handle  : scan_handle_t;
                        wpar         : obj_param_t;
                        dictionary   : path_name_t;
                      end;
  

procedure xxx_processor_open
                (var handle    : xxx_processor_handle_t;
                 dic_file      : path_name_t);
var appl_handle: appl_handle_p_t;
procedure add_data (s: dic_sym); var index: dic_indx; dummy: boolean;
  begin dummy:= dic_sym2indx (appl_handle^.wpar.dic_handle_data, s, index, create) end;
  begin
    new (appl_handle);
    handle:= appl_handle;
    with appl_handle^ do
      begin
        open_scan_new (scan_handle);
        dictionary:= dic_file;
        dic_new (wpar.dic_handle_symbol, true); def_scan_dic (scan_handle, wpar.dic_handle_symbol,[symbol_const]);
        dic_new (wpar.dic_handle_value, true);  def_scan_dic (scan_handle, wpar.dic_handle_value, [Integer_const,real_const,text1_const]);
        if length (dictionary) <> 0 then DIC_READ (wpar.dic_handle_symbol, dictionary);
        dic_new (wpar.dic_handle_data, true);
        add_data {  1}  ('<MAIN>');
        add_data {  2}  ('  ');
        add_data {  3}  ('<DEF> base_pgm ');
        add_data {  4}  ('<DEF> pgm ');
        add_data {  5}  ('<DEF> unit ');
        add_data {  6}  ('  </DEF>');
        add_data {  7}  ('</MAIN>');
        add_data {  8}  ('    <SEL> const_list ');
        add_data {  9}  ('=');
        add_data { 10}  ('</SEL>');
        add_data { 11}  ('    <SEL> code_list ');
        add_data { 12}  ('=:');
        
        def_alphabet
              (scan_handle,
               ' ',
               'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz',
               'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_$0123456789',
               '0123456789',
               'aAbBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTuUvVwWxXyYzZ');
        def_quoting (scan_handle, '/*', '*/', comment_const);
        def_quoting (scan_handle, '(*', '*)', comment_const);
        def_quoting (scan_handle, '"', '"', text1_const);
        def_quoting (scan_handle, '''', '''', text1_const);
        def_keyword (scan_handle, 'base_program program unit ; const = { := }');
        with wpar do
          begin
            max_line_length := 110;
            output_buffer   := '';
            leader          := apostr;
            trailler        := apostr;
          end
      end
  end;


procedure xxx_processor_close
                (handle        : xxx_processor_handle_t);
var appl_handle: appl_handle_p_t;
  begin
    appl_handle:= handle;
    with appl_handle^ do
      begin
        if length (dictionary) <> 0 then DIC_WRITE (wpar.dic_handle_symbol, dictionary);
        scan_close (scan_handle);
        dic_dispose      (wpar.dic_handle_symbol);
        dic_dispose      (wpar.dic_handle_value);
        dic_dispose      (wpar.dic_handle_data);
      end;
    dispose (appl_handle);
    obj_release_pool;
  end;


procedure xxx_processor_use
                (handle        : xxx_processor_handle_t;
                 in_path_name,
                 out_path_name : path_name_t;
                 var error_code: Integer);
var
  appl_handle   : appl_handle_p_t;
  term          : dic_indx;
  index_fin     : dic_indx;
  index_fin1    : dic_indx;
  index_sym     : dic_indx;
  index_sym1    : dic_indx;
  index_val     : dic_indx;
  index_val1    : dic_indx;
  term_val_type : value_t;
  term_val_type1: value_t;
  last_token    : token_t;
  err_free      : boolean;
  
  chn_CC, chn_BB, chn_AA: obj_handle_t; {global channels}
  
procedure write_error (ts: token_set_t);
var tr: token_range_t;
  begin
    write (StdErr, 'Error: ');
    if token_symbol in ts then write (StdErr, 'Symbol') else
    if token_finish in ts then write (StdErr, 'EOF') else
    if token_value  in ts then write (StdErr, 'value')
      else for tr:=0 to token_max do if tr in ts then write (StdErr, tr:1,' ');
    write (StdErr, ' expected');
    write_diagn (appl_handle^.scan_handle);
    abort ('');
    err_free:= false;
  end;

procedure out_channel (var channel: obj_handle_t);
begin if err_free then obj_write (channel, appl_handle^.wpar) end;

procedure app_symbol (var channel: obj_handle_t);
begin if err_free then obj_add_dic_sym (channel, index_sym) end;

procedure app_value (var channel: obj_handle_t);
  begin
    if err_free then
      begin
        with appl_handle^ do case term_val_type of
          not_value, comment_const, include_const, keyword_const, symbol_const :;
          Integer_const : obj_add_dic_int  (channel, index_val);
          real_const    : obj_add_dic_real (channel, index_val);
          text1_const, text2_const, text3_const, text4_const
                        : obj_add_dic_txt  (channel, index_val);
          otherwise abort ('Fatal Data Type') end;
      end
  end;

procedure app_data (var chn: obj_handle_t; index: dic_indx);
begin if err_free then obj_add_dic_dat (chn, index) end;

procedure ack_keyword (kw: dic_indx);
  begin
    if err_free then
      begin
        if term=kw
          then with appl_handle^ do
            begin
              index_fin     := index_fin1;
              index_sym     := index_sym1;
              index_val     := index_val1;
              term_val_type := term_val_type1;
              last_token:= next_token (scan_handle, term);
              case last_token of
                finish : begin index_fin1:= term; term:=token_finish end;
                symbol : begin index_sym1:= term; term:=token_symbol end;
                value  : begin index_val1:= term; term:=token_value; term_val_type1:= value_type (scan_handle) end;
                keyword: ;
                otherwise abort ('Fatal token') end;
            end
          else write_error ([kw])
      end
  end;

PROCEDURE bnf_body; forward;
PROCEDURE bnf_decl; forward;
PROCEDURE bnf_program; forward;

PROCEDURE bnf_body;
begin
if err_free then
  begin
    ack_keyword (7);
    app_data (chn_AA, 11);
    while term=11 do
      begin
        ack_keyword (token_symbol);
        app_symbol (chn_AA);
        ack_keyword (8);
        app_data (chn_AA, 12);
        ack_keyword (token_value);
        app_value (chn_AA);
        ack_keyword (4);
      end;
    ack_keyword (9);
    app_data (chn_AA, 10);
    obj_add_chr (chn_AA, newline);
  end
end;

PROCEDURE bnf_decl;
begin
if err_free then
  begin
    ack_keyword (5);
    app_data (chn_AA, 8);
    while term=11 do
      begin
        ack_keyword (token_symbol);
        app_symbol (chn_AA);
        ack_keyword (6);
        app_data (chn_AA, 9);
        ack_keyword (token_value);
        app_value (chn_AA);
        ack_keyword (4);
      end;
    app_data (chn_AA, 10);
    obj_add_chr (chn_AA, newline);
  end
end;

PROCEDURE bnf_program;
begin
if err_free then
  begin
    app_data (chn_AA, 1);
    obj_add_chr (chn_AA, newline);
    app_data (chn_AA, 2);
    case term of
      3:
        begin
          ack_keyword (3);
          ack_keyword (token_symbol);
          app_data (chn_AA, 5);
        end;
      2:
        begin
          ack_keyword (2);
          ack_keyword (token_symbol);
          app_data (chn_AA, 4);
        end;
      1:
        begin
          ack_keyword (1);
          ack_keyword (token_symbol);
          app_data (chn_AA, 3);
        end;
      otherwise write_error ([0]) end;
    ack_keyword (4);
    app_symbol (chn_AA);
    obj_add_chr (chn_AA, newline);
    bnf_decl;
    bnf_body;
    app_data (chn_AA, 6);
    obj_add_chr (chn_AA, newline);
    app_data (chn_AA, 7);
    obj_add_chr (chn_AA, newline);
    out_channel (chn_AA);
    obj_delete (chn_AA);
  end
end;

begin
  err_free      := true;
  appl_handle   := handle;
  index_fin1    := 9999;
  index_sym1    := 0;
  index_val1    := 0;
  term_val_type1:= not_value;
  with appl_handle^ do
    begin
      def_file (scan_handle, in_path_name);            {giving the input file}
      last_token:= next_token (scan_handle, term); {read the first token of input file}
      case last_token of
        finish : begin index_fin1:= term; term:=token_finish end;
        symbol : begin index_sym1:= term; term:=token_symbol end;
        value  : begin index_val1:= term; term:=token_value; term_val_type1:= value_type (scan_handle) end;
        keyword: ;
        otherwise abort ('Fatal token') end;
      index_fin     := index_fin1;
      index_sym     := index_sym1;
      index_val     := index_val1;
      term_val_type := term_val_type1;
      with wpar do
        begin
          out_bin:= false;
          assign (f, out_path_name);
          rewrite (f);
        end
    end;
  chn_CC:= nil;
  chn_BB:= nil;
  chn_AA:= nil;
  bnf_program;
  if (last_token<>finish) or (index_fin1<>ord (end_of_input)) then write_error ([ord(finish)]);
  obj_delete (chn_CC);
  obj_delete (chn_BB);
  obj_delete (chn_AA);
  with appl_handle^.wpar do 
    begin
      if length (output_buffer)<>0 then writeln (f, output_buffer);
      output_buffer :='';
      close (f);
    end;
  error_code:= ord (not err_free);
end;
  {here we could do some initializing actions at start}
END.