Code coverage for lisaac.li


///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Compiler                               //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   This program is free software: you can redistribute it and/or modify    //
//   it under the terms of the GNU General Public License as published by    //
//   the Free Software Foundation, either version 3 of the License, or       //
//   (at your option) any later version.                                     //
//                                                                           //
//   This program is distributed in the hope that it will be useful,         //
//   but WITHOUT ANY WARRANTY; without even the implied warranty of          //
//   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           //
//   GNU General Public License for more details.                            //
//                                                                           //
//   You should have received a copy of the GNU General Public License       //
//   along with this program.  If not, see <http://www.gnu.org/licenses/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header

  + name      := LISAAC;

  - copyright := "2003-2007 Benoit Sonntag";

  - author   := "Sonntag Benoit (sonntag@icps.u-strasbg.fr)";
  - comment  := "The main prototype";

  // Top 5 memory record :
  // 1 - LOCAL         (>20MB) (il fo Aliaser les tmp !)
  // 2 - READ_LOCAL    (15MB)
  // 3 - LIST          (13MB) (En baisse => a retester.)
  // 4 - PROTOTYPE_CST (10MB)
  // 5 - WRITE_LOCAL   (10MB)

Section Inherit

  - parent_any:ANY := ANY;

Section Public

  - show_help <-
  (
    COMMON.command_line_header "Compiler".print;
    begin_usage.print;
    LIP_CODE.print_usage;
    COMMON.command_line_footer.print;
  )
;

  - show_version <-
  (
    COMMON.command_line_header "Compiler".print;
    COMMON.print_info;
    COMMON.command_line_footer.print;
  )
;

Section Private

  - output_name     :STRING_CONSTANT;
  - output_extension:STRING_CONSTANT;

  - input_name:STRING_CONSTANT;

  //
  // Command.
  //

  - begin_usage: STRING_CONSTANT :=
  "Usage:                                                          \n\
  \  lisaac [<lip_file.lip>] [<input_file[.li]>] {<Options>}       \n\
  \                                                                \n\
  \  Note: without <lip_file> the nearest `make.lip' file is       \n\
  \        interpreted.                                            \n\
  \                                                                \n\
  \Options:                                                        \n";


  - display_usage <-
  (
    show_help;
    die_with_code exit_failure_code;
  )
;

  //
  // Options.
  //

  - read_options <-
  ( + cmd:STRING;
    + j,i:INTEGER;
    + f:POINTER;
    + lip_ok:BOOLEAN;
    + s:LIP_SLOT_CODE;
    + t:STRING_CONSTANT;
    + arg:LIP_CONSTANT;
    + is_path_list:BOOLEAN;
    + hook_after_load_lip :{};

    hook_after_load_lip := {};

    // Default value.
    is_ansi := TRUE;
    // Read argument.
    j := 1;
    {j > COMMAND_LINE.upper}.until_do {
      cmd := COMMAND_LINE.item j;
      (cmd.item 1='-').if {
        //
        // Lecture des options :
        //
        ((cmd.count >= 3) && {cmd.item 2 = '-'}).if {
          (cmd.item 3)
          .when 'v' then {
            verbose_level := 1;
          }

          .when 'p' then {
            is_path_list := TRUE;
          }

          .when 'r' then {
            is_readable := TRUE;
          }

          .when 'g' then {
            is_readable := is_graph := TRUE;
          }
;
        }
 else {
          (lip_ok).if_false {
            load_lip "make.lip";
            hook_after_load_lip.value;
            lip_ok := TRUE;
          }
;
          string_tmp.copy cmd;
          string_tmp.remove_first 1;
          string_tmp.replace_all '-' with '_';
          s := LIP_CODE.get_method (ALIAS_STR.get string_tmp);
          ((s = NULL) || {s.section != ALIAS_STR.section_public}).if {
            "ERROR: Option `".print;
            cmd.print;
            "' not found.\n".print;
            display_usage;
          }
;
          (s.argument != NULL).if {
            j := j + 1;
            (j > COMMAND_LINE.upper).if {
              "ERROR: For option `".print;
              cmd.print;
              "', argument needed.\n".print;
              display_usage;
            }
;
            cmd := COMMAND_LINE.item j;
            t := s.argument.value.name;
            arg := NULL;
            (t = ALIAS_STR.prototype_boolean).if {
              cmd.to_upper;
              (cmd ~= "TRUE").if {
                arg := LIP_BOOLEAN.get TRUE;
              }
.elseif {cmd ~= "FALSE"} then {
                arg := LIP_BOOLEAN.get FALSE;
              }
;
            }
.elseif {t = ALIAS_STR.prototype_integer} then {
              (cmd.is_integer).if {
                arg := LIP_INTEGER.get (cmd.to_integer);
              }
;
            }
 else {
              arg := LIP_STRING.get (ALIAS_STR.get cmd);
            }
;
            (arg = NULL).if {
              "ERROR: Incorrect type for `".print;
              cmd.print;
              "' argument.\n".print;
              display_usage;
            }
;
          }
 else {
            arg := NULL;
          }
;
          (s.run_with arg).if_false {
            "ERROR: Invalid argument.\n".print;
            display_usage;
          }
;
        }
;
      }
 else {
        //
        // Input name & Current Directory.
        //
        (cmd.has_suffix ".lip").if {
          // .lip
          (lip_ok).if {
            "ERROR: Put options after `".print;
            cmd.print;
            "'.".print;
            display_usage;
          }
;
          load_lip cmd;
          hook_after_load_lip.value;
          lip_ok := TRUE;
        }
 else {
          // .li
          (input_name != NULL).if {
            display_usage;
          }
;
          // Remove extension and replace '\'
          string_tmp.copy (COMMAND_LINE.item j);
          string_tmp.replace_all '\\' with '/';
          i := last_index_str (string_tmp,'.');
          (i > string_tmp.lower).if {
            string_tmp.remove_last (string_tmp.upper-i+1);
          }
;
          input_name := ALIAS_STR.get (string_tmp);
          hook_after_load_lip := {
            LIP_CODE.put_string input_name to (ALIAS_STR.slot_input_file);
            LIP_CODE.put_string input_name to (ALIAS_STR.slot_output_file);
          }
;
          // get dirname
          i := last_index_str (string_tmp,'/');
          (i < string_tmp.lower).if {
            string_tmp.copy "./";
          }
 else {
            string_tmp.remove_last (string_tmp.upper-i);
          }
;
          input_path := ALIAS_STR.get (string_tmp);
        }
;
      }
;
      j := j+1;
    }
;
    (lip_ok).if_false {
      load_lip "make.lip" in input_path;
      hook_after_load_lip.value;
    }
;

    LIP_CODE.call_front_end;

    (is_path_list).if {
      string_tmp.clear;
      (path_file.lower).to (path_file.upper) do { n:INTEGER;
        string_tmp.append (path_file.item n);
        string_tmp.add_last '\n';
      }
;
      (! FS_MIN.make_file "current_path.txt").if {
        STD_ERROR.put_string "Error: File `current_path.txt' is not created !\n";
        die_with_code exit_failure_code;
      }
;
      f := FS_MIN.open_write "current_path.txt";
      FS_MIN.write f with string_tmp size (string_tmp.count);
      FS_MIN.close f;
      die_with_code 0;
    }
;

    // Loading variable.
    input_name         := LIP_CODE.get_string  (ALIAS_STR.slot_input_file);
    output_name        := LIP_CODE.get_string  (ALIAS_STR.slot_output_file);
    output_extension   := LIP_CODE.get_string  (ALIAS_STR.slot_output_extension);
    debug_level_option := LIP_CODE.get_integer (ALIAS_STR.slot_debug_level);
    debug_with_code    := LIP_CODE.get_boolean (ALIAS_STR.slot_debug_with_code);
    is_all_warning     := LIP_CODE.get_boolean (ALIAS_STR.slot_is_all_warning);
    is_optimization    := LIP_CODE.get_boolean (ALIAS_STR.slot_is_optimization);
    inline_level       := LIP_CODE.get_integer (ALIAS_STR.slot_inline_level);
    is_statistic       := LIP_CODE.get_boolean (ALIAS_STR.slot_is_statistic);
    is_quiet           := LIP_CODE.get_boolean (ALIAS_STR.slot_is_quiet);
    is_library         := LIP_CODE.get_boolean (ALIAS_STR.slot_is_library);
    is_coverage        := LIP_CODE.get_boolean (ALIAS_STR.slot_is_coverage);
    //
    ((input_name = NULL) || {input_name.is_empty}).if {
      "ERROR: `input_file' is empty.\n".print;
      display_usage;
    }
;
    // Separate path (string_tmp) and file (string_tmp2)
    string_tmp.copy input_name;
    string_tmp2.copy string_tmp;
    i := last_index_str (string_tmp,'/');
    (i < string_tmp.lower).if {
      string_tmp.copy "./";
    }
 else {
      string_tmp.remove_last (string_tmp.upper-i);
      string_tmp2.remove_first i;
    }
;
    LIP_CALL.load_directory (ALIAS_STR.get string_tmp) is_recursive FALSE;
    //
    string_tmp.copy (path_file.last);
    i := last_index_str (string_tmp,'/');
    string_tmp.remove_last (string_tmp.upper-i);
    input_path := ALIAS_STR.get string_tmp;
    input_name := ALIAS_STR.get string_tmp2;
    //
    ((output_name = NULL) || {output_name.is_empty}).if {
      (input_path = NULL).if {
        string_tmp.clear;
      }
 else {
        string_tmp.copy input_path;
      }
;
      string_tmp.append input_name;
      output_name := ALIAS_STR.get string_tmp;
      LIP_CODE.put_string output_name to (ALIAS_STR.slot_output_file);
    }
;
    ((output_extension = NULL) || {output_extension.is_empty}).if {
      (is_java).if {
        output_extension := ALIAS_STR.extension_java;
      }
 else {
        output_extension := ALIAS_STR.extension_c;
      }
;
      LIP_CODE.put_string output_extension to (ALIAS_STR.slot_output_extension);
    }
;
    LIP_CODE.init_path_file FALSE;
  )
;

  - put_trace_code buf:STRING <-
  ( + proto:PROTOTYPE;

    ((debug_level_option != 0) || {CALL_NULL.is_necessary}).if {
      title "DEBUG MANAGER" in buf;

      (is_java).if {
        buf.append
        "private static void print_string(String str) \n\
        \{ \n\
        \  System.out.print(str);\n\
        \}\n\
        \\n";
      }
 else {
        buf.append
        "int print_string(char *str) \n\
        \{ \n\
        \  while (*str!=0) {\n\
        \    print_char(*str); \n\
        \    str++; \n\
        \  };\n\
        \  return(0);\n\
        \}\n\
        \\n";
      }
;
    }
;

    (debug_level_option != 0).if {
      buf.append "char *trace[";
      buf.append (PROTOTYPE.prototype_list.count.to_string);
      buf.append "]={\n";
      (PROTOTYPE.prototype_list.lower).to (PROTOTYPE.prototype_list.upper-1) do {
        j:INTEGER;
        proto := PROTOTYPE.prototype_list.item j;
        buf.append "  \"";
        buf.append (proto.name);
        buf.append " (";
        proto.append_filename buf;
        buf.append ")\",\n";
      }
;
      proto := PROTOTYPE.prototype_list.last;
      buf.append "  \"";
      buf.append (proto.name);
      buf.append " (";
      proto.append_filename buf;
      buf.append ")\"\n};\n\n";

      //
      // Source Code.
      //

      (debug_with_code).if {
        + src:HASHED_DICTIONARY(STRING,UINTEGER_32);
        + key:UINTEGER_32;

        title "SOURCE LINE REFERENCE" in output_decl;

        buf.append
        "struct __source {\n\
        \  unsigned int pos;\n\
        \  char *line;\n\
        \} __src[";
        src := PUSH.source_line;
        src.count.append_in buf;
        buf.append "]={\n";
        (src.lower).to (src.upper) do { j:INTEGER;
          key := src.key j;
          output_decl.append "#define L";
          key.append_in output_decl;
          output_decl.add_last ' ';
          (j-1).append_in output_decl;
          output_decl.add_last '\n';
          //
          buf.append "  {";
          key.append_in buf;
          buf.append ",\"";
          buf.append (src.item j);
          buf.append "\"},\n";
        }
;
        buf.remove (buf.upper - 1);
        buf.append "};\n\n";
      }
;

      //
      // Signal manager.
      //

      (is_ansi).if {
        buf.append
        "/* Unix Signal manager: */\n\
        \void interrupt_signal(int sig)  \n\
        \{                               \n\
        \  lisaac_stack_print(top_context);     \n\
        \  print_string(\"User interrupt.\\n\"); \n\
        \  die_with_code(1);                     \n\
        \}                                       \n\n";
      }
;

      //
      // Stack manager.
      //

      buf.append
      "void lisaac_push_first(_____CONTEXT *path,unsigned long code)\n\
      \{ \n";
      (debug_level_option = 20).if {
        buf.append
        "  _____CONTEXT *cur,loop;\n\
        \  cur = top_context; \n\
        \  while ((cur != (void *)0) && (cur != path)) cur = cur->back; \n\
        \  if (cur == path) {\n\
        \    loop.back = top_context;\n\
        \    loop.code = code; \n\
        \    lisaac_stack_print(&loop);\n\
        \    print_string(\"COMPILER: Debug context looping detected !\\n\");\n\
        \    die_with_code(1);\n\
        \  };\n";
      }
;
      buf.append
      "  path->back  = top_context;\n\
      \  path->code  = code;\n\
      \  top_context = path;\n\
      \} \n\
      \  \n\
      \void lisaac_push(_____CONTEXT *path,unsigned long code)\n\
      \{ \n\
      \  path->code  = code;\n\
      \  top_context = path;\n\
      \} \n\
      \  \n\
      \void lisaac_stack_print(_____CONTEXT *up)      \n\
      \{ _____CONTEXT *back,*next;             \n\
      \  int j;                                      \n\
      \  next = (void *)0;                          \n\
      \  while (up != (void *)0) {                  \n\
      \    back = up -> back;                       \n\
      \    up -> back = next;                       \n\
      \    next = up;                               \n\
      \    up = back;                               \n\
      \  };                                         \n\
      \  print_string(\"\\n============== BOTTOM ==============\\n\"); \n\
      \  while (next != (void *)0) {                \n";
      (debug_with_code).if {
        buf.append
        "    print_string(\"Line #\");                           \n\
        \    print_integer(__src[next->code].pos >> 17);         \n\
        \    print_string(\" Column #\");                        \n\
        \    print_integer((__src[next->code].pos >> 9) & 0xFF); \n\
        \    print_string(\" in \");                             \n\
        \    print_string(trace[__src[next->code].pos & 0x1FF]); \n\
        \    print_string(\".\\n\");                             \n\
\ if ((__src[next->code].pos & 0x1FF) != 0) { \n\
        \    print_string(__src[next->code].line);               \n\
        \    print_char('\\n');                                  \n\
        \    for (j=0;j < ((__src[next->code].pos >> 9) & 0xFF);j++) {\n\
        \      if (__src[next->code].line[j]=='\\t') print_char('\\t');\n\
        \      else print_char(' ');\n\
        \    };                                                  \n\
        \    print_char('^');    \n\
        \    print_char('\\n');   \n\
\ }; \n";

      }
 else {
        buf.append
        "    print_string(\"Line #\");                \n\
        \    print_integer(next->code >> 17);         \n\
        \    print_string(\" Column #\");          \n\
        \    print_integer((next->code >> 9) & 0xFF); \n\
        \    print_string(\" in \");               \n\
        \    print_string(trace[next->code & 0x1FF]); \n\
        \    print_string(\".\\n\");                  \n";
      }
;
      buf.append
      "    next = next -> back;                     \n\
      \  };                                         \n\
      \  print_string(\"================ TOP ===============\\n\"); \n\
      \  top_context = (void *)0;                   \n\
      \}                                            \n\
      \ \n\
      \void print_integer(unsigned short n) \n\
      \{ unsigned short val;                \n\
      \  char car;                          \n\
      \  car = (n % 10) + '0';              \n\
      \  val = n / 10;                      \n\
      \  if (val != 0) print_integer(val);  \n\
      \  print_char(car);                   \n\
      \} \n\n";
    }
;
    is_coverage.if {
      buf.append "char *__lisaac_proto_file_names[";
      buf.append (PROTOTYPE.prototype_list.count.to_string);
      buf.append "]={\n";
      (PROTOTYPE.prototype_list.lower).to (PROTOTYPE.prototype_list.upper-1) do {
        j:INTEGER;
        proto := PROTOTYPE.prototype_list.item j;
        buf.append "  \"";
        buf.append (proto.filename);
        buf.append "\",\n";
      }
;
      proto := PROTOTYPE.prototype_list.last;
      buf.append "  \"";
      buf.append (proto.filename);
      buf.append "\"\n};\n\n";
      title "CODE COVERAGE HOOKS" in buf;
      buf.append "static int lisaac_coverage_block_info_length = ";
      COV_INSTR.count.append_in output_code;
      buf.append ";\nstatic struct { \n\
        \  int proto_index;\n\
        \  int start_line;\n\
        \  int start_col;\n\
        \  int stop_line;\n\
        \  int stop_col;\n\
        \} lisaac_coverage_block_info[";
      COV_INSTR.count.append_in output_code;
      buf.append "]={\n";
      COV_INSTR.lower.to (COV_INSTR.upper) do { i:INTEGER;
        + instr:COV_INSTR;
        + p1, p2 :POSITION;
        instr := COV_INSTR.item i;
        (instr != NULL).if {
          p1 := instr.position;
          p2 := instr.last_position;
          buf.append "  {";
          p1.prototype.index.append_in buf;
          buf.append ", ";
          p1.line.append_in buf;
          buf.append ", ";
          p1.column.append_in buf;
          buf.append ", ";
          p2.line.append_in buf;
          buf.append ", ";
          p2.column.append_in buf;
          buf.append "},\n";
        }
 else {
          buf.append "  {0, 0, 0, 0, 0} /* instr = NULL */,\n";
        }
;
      }
;
      buf.remove_last 2;
      buf.append "\n};\n\n";
      buf.append
        "static void lisaac_coverage_exit()\n\
        \{\n\
        \  int current_proto = -1;\n\
        \  int i;\n\
        \  \n\
        \  \n\
        \  FILE* f = fopen(lisaac_coverage_file, \"a\");\n\
        \  for (i = 0; i < lisaac_coverage_block_info_length; ++i)\n\
        \  {\n\
        \    if (current_proto != lisaac_coverage_block_info[i].proto_index)\n\
        \    {\n\
        \      current_proto = lisaac_coverage_block_info[i].proto_index;\n\
        \      fprintf (f, \"FILE:%s\\n\", __lisaac_proto_file_names[current_proto]);\n\
        \    }\n\
        \    fprintf (f, \"COVERAGE:%d:%d:%d:%d:%d\\n\",\n\
        \      lisaac_coverage_table[i],\n\
        \      lisaac_coverage_block_info[i].start_line,\n\
        \      lisaac_coverage_block_info[i].start_col,\n\
        \      lisaac_coverage_block_info[i].stop_line,\n\
        \      lisaac_coverage_block_info[i].stop_col);\n\
        \  }\n\
        \  fflush(f);\n\
        \  fclose(f);\n\
        \}\n\
        \\n";
    }
;
  )
;

  - load_main_object <-
  ( + type_gen:FAST_ARRAY(ITM_TYPE_MONO);
    + itm_type_character:ITM_TYPE_MONO;
    + itm_type_n_a_character:ITM_TYPE_MONO;

    // NULL, VOID, CONTEXT
    TYPE_NULL.make_null;
    TYPE_VOID.make_void;
    TYPE_CONTEXT.make_context;
    TYPE_ID.make_type_id; // Pas utile !
    // Other prototype.
    type_true    := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_true)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_false   := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_false)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_boolean := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_boolean)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_integer := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_integer)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_real    := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_real)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_integer_32 := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_integer_32)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_uinteger_32 := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_uinteger_32)
    style (ALIAS_STR.keyword_expanded).to_run_for NULL.raw;
    type_string_constant := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_string_constant)
    .to_run_for NULL.raw;
    itm_type_character   := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_character)
    style (ALIAS_STR.keyword_expanded);
    type_character := itm_type_character.to_run_for NULL.raw;
    type_block     := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_block).to_run_for NULL.raw;
    //
    type_pointer   := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_pointer).to_run_for NULL.raw;
    // NATIVE_ARRAY(CHARACTER)
    type_gen  := ALIAS_ARRAY(ITM_TYPE_MONO).new;
    type_gen.add_last itm_type_character;
    type_gen  := ALIAS_ARRAY(ITM_TYPE_MONO).alias type_gen;
    itm_type_n_a_character := ITM_TYPE_GENERIC.get (ALIAS_STR.prototype_native_array)
    style NULL with type_gen;
    type_n_a_character := itm_type_n_a_character.to_run_for NULL.raw;
    // NATIVE_ARRAY[NATIVE_ARRAY(CHARACTER)]
    type_gen  := ALIAS_ARRAY(ITM_TYPE_MONO).new;
    type_gen.add_last itm_type_n_a_character;
    type_gen  := ALIAS_ARRAY(ITM_TYPE_MONO).alias type_gen;
    type_n_a_n_a_character := ITM_TYPE_GENERIC.get (ALIAS_STR.prototype_native_array)
    style NULL with type_gen.to_run_for NULL.raw;
    // Input.
    string_tmp.copy input_name;
    string_tmp.to_upper;
    type_input   := ITM_TYPE_SIMPLE.get (ALIAS_STR.get string_tmp).to_run_for NULL.raw;
    //
    (debug_level_option != 0).if {
      // Load for `print_char' and `die_with_code'
      ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_system_io).to_run_for NULL;
    }
;
    ? {type_input != NULL};
  )
;

  - print msg:STRING_CONSTANT stat n:INTEGER for t:INTEGER <-
  ( + pour_mil:INTEGER;

    (t != 0).if {
      STD_ERROR.put_string msg;
      pour_mil := `(int)((1000./ @t * @n))`:INTEGER;
      STD_ERROR.put_integer (pour_mil/10);
      STD_ERROR.put_character '.';
      STD_ERROR.put_integer (pour_mil%10);
      STD_ERROR.put_string "% (";
      STD_ERROR.put_integer n;
      STD_ERROR.put_character '/';
      STD_ERROR.put_integer t;
      STD_ERROR.put_string ")\n";
    }
;
  )
;

Section Public

  - tab:FAST_ARRAY(INTEGER) := FAST_ARRAY(INTEGER).create 128;
  - tab_null:FAST_ARRAY(INTEGER) := FAST_ARRAY(INTEGER).create 128;

  //
  // Creation.
  //

  - main <-
  ( + file_output:POINTER;
    //+ entry:ENTRY;
    + begin_time,end_time:UINTEGER_64;
    + time:INTEGER;
    + txt:STRING;
    + s:LIP_SLOT_CODE;
    + f:POINTER;
    + tmp,tmp2:INTEGER;

    ALIAS_STR.make;

    begin_time := SYSTEM.get_universal_time;

    //
    // Load Environment.
    //
    read_options;
    is_coverage.if {
      output_coverage := STRING.create_from_string
        "# CODE:BEGIN_LINE:COL:END_LINE:COL:FILENAME\n";
    }
;
    is_verbose.if {
      string_tmp.copy "\ninput  file: ";
      string_tmp.append input_name;
      string_tmp.append ".li\noutput file: ";
      string_tmp.append output_name;
      string_tmp.append output_extension;
      string_tmp.append "\npath directory :\n";
      path_file.lower.to (path_file.upper) do { j:INTEGER;
        string_tmp.append "  ";
        string_tmp.append (path_file.item j);
        string_tmp.add_last '\n';
      }
;
      string_tmp.print;
    }
;

    //
    // Header C
    //
    (is_java).if {
      output_decl.copy "// Java code generated by Lisaac compiler (www.lisaac.org) //\n\n";
      output_decl.append "class ";
      output_decl.append input_name;
      output_decl.append " {\n";
      output_decl.append "private static String arg[];\n";
    }
 else {
      output_decl.copy "/* C code generated by Lisaac compiler (www.lisaac.org) */\n\n";

      // Large file headers
      output_decl.append
      "#define _LARGE_FILE_API\n\
      \#define _LARGEFILE_SOURCE\n\
      \#define _LARGEFILE64_SOURCE\n";

      // ANSI argument command.
      (debug_level_option != 0).if {
        output_decl.append "#include <signal.h>\n";
      }
;
      is_coverage.if {
        output_decl.append "#include <stdio.h>\n";
        output_decl.append "#include <stdlib.h>\n";
      }
;
      output_decl.append
      "int arg_count;\n\
      \char **arg_vector;\n";
    }
;

    // External.
    title "EXTERNAL" in output_decl;

    //
    // Load prototype constant.
    //
    load_main_object;

    // Compilation.
    type_input.prototype.depend;

    // Type / Struct.
    title "TYPE" in output_decl;

    (is_java).if {
      output_decl.append
      "/* Generic Object */\n\
      \class ___OBJ {\n\
      \  int __id;\n\
      \};\n\n";
    }
 else {
      output_decl.append
      "/* Generic Object */\n\
      \struct ___OBJ {\n\
      \  unsigned int __id;\n\
      \};\n\n";
    }
;
    title "GLOBAL" in output_glob;

    // Function header.
    title "FUNCTION HEADER" in output_code;

    // Debug source code.
    (is_java).if_false {
      (debug_level_option != 0).if {
        output_code.append "/* Debug Manager */\n";
        (is_ansi).if {
          output_code.append "void interrupt_signal(int sig);\n";
        }
;
        output_code.append
        "void lisaac_stack_print(_____CONTEXT *up);\n\
        \void lisaac_push_first(_____CONTEXT *path,unsigned long code);\n\
        \void lisaac_push(_____CONTEXT *path,unsigned long code);\n\
        \void print_integer(unsigned short n);\n";
      }
;
    }
;

    // Coverage
    is_coverage.if {
      output_code.append "\
        \\n/* Code Coverage Hooks */\n\
        \static unsigned int  lisaac_coverage_table[";
      COV_INSTR.count.append_in output_code;
      output_code.append "];\n\
        \static const char   *lisaac_coverage_file = \"";
      output_code.append output_name;
      output_code.append ".cov\";\n\
        \static void lisaac_coverage_exit();\n\
        \\n";
    }
;

    // Extern source code.
    output_code.append "/* Source code */\n";
    PROFIL_LIST.genere_handler output_code;

    // Source code.
    title "SOURCE CODE" in output_code;

    (is_library).if {
      output_code.append "int init(int argc,char **argv)\n";
    }
 else {
      (is_java).if {
        output_code.append "public static void main(String parg[])\n";
      }
 else {
        output_code.append "int main(int argc,char **argv)\n";
      }
;
    }
;
    output_code.append "{\n";
    is_coverage.if {
      output_code.append
       "  if (atexit(lisaac_coverage_exit)) {\n\
       \    fprintf(stderr, \"cannot set code coverage exit function\\n\");\n\
       \    exit(EXIT_FAILURE);\n\
       \  }\n";
    }
;
    indent.append "  ";

    profil_current := NULL;
    list_main.genere_extern output_code;

    (is_java).if_false {
      output_code.append "  return(0);\n";
    }
;
    indent.remove_last 2;
    output_code.append indent;
    output_code.append "}\n\n";

    PROFIL_LIST.genere output_code;

    TYPE.genere_all_struct;
    (is_java).if_false {
      output_decl.append "\nvoid *table_type[";
      TYPE.id_counter_without_type.append_in output_decl;
      output_decl.append "];\n";
    }
;

    // String Constant.

    // Trace code.
    put_trace_code output_code;

    (is_java).if {
      output_code.append "\n} // End class MAIN\n";
    }
;

    //
    // Saving File Output.
    //
    string_tmp.copy output_name;
    string_tmp.append output_extension;
    (! FS_MIN.make_file string_tmp).if {
      STD_ERROR.put_string "Error: File ";
      STD_ERROR.put_string string_tmp;
      STD_ERROR.put_string " is not created !\n";
      die_with_code exit_failure_code;
    }
;

    file_output := FS_MIN.open_write string_tmp;
    FS_MIN.write file_output with output_decl size (output_decl.count);
    FS_MIN.write file_output with output_glob size (output_glob.count);
    (STRING_CST.output_count != 0).if {
      txt := STRING_CST.output;
      FS_MIN.write file_output with txt size (txt.count);
    }
;
    FS_MIN.write file_output with output_code size (output_code.count);
    FS_MIN.close file_output;

    is_coverage.if {
      + current_proto :PROTOTYPE;
      + k:INTEGER;
      string_tmp2.clear;
      k := ITM_LIST.coverage_all_lists.lower;
      {k < ITM_LIST.coverage_all_lists.upper}.while_do {
        + p1, p2 :POSITION;
        p1 := ITM_LIST.coverage_all_lists.item (k);
        p2 := ITM_LIST.coverage_all_lists.item (k+1);
        ? { p1.prototype = p2.prototype };
        (p1.prototype != current_proto).if {
          current_proto := p1.prototype;
          string_tmp2.append "FILE:";
          string_tmp2.append (current_proto.filename);
          string_tmp2.add_last '\n';
        }
;
        string_tmp2.append "LIST:";
        p1.line.append_in string_tmp2;
        string_tmp2.add_last ':';
        p1.column.append_in string_tmp2;
        string_tmp2.add_last ':';
        p2.line.append_in string_tmp2;
        string_tmp2.add_last ':';
        p2.column.append_in string_tmp2;
        string_tmp2.add_last '\n';
        k := k + 2;
      }
;
      string_tmp.copy output_name;
      string_tmp.append ".cov";
      (! FS_MIN.make_file string_tmp).if {
        STD_ERROR.put_string "Error: File ";
        STD_ERROR.put_string string_tmp;
        STD_ERROR.put_string " is not created !\n";
        die_with_code exit_failure_code;
      }
;
      f := FS_MIN.open_write string_tmp;
      FS_MIN.write f with string_tmp2 size (string_tmp2.count);
      FS_MIN.close f;
    }
;

    (is_graph).if {
      + p:PROFIL;
      (PROFIL_LIST.profil_list.lower).to (PROFIL_LIST.profil_list.upper) do { j:INTEGER;
        p := PROFIL_LIST.profil_list.item j;
        (p.external_present).if {
          p.set_external_present FALSE;
          p.propagation_external;
        }
;
      }
;
      //
      output_code.copy "digraph G {\n";
      profil_main.genere_graph output_code;
      (PROFIL_LIST.profil_list.lower).to (PROFIL_LIST.profil_list.upper) do { j:INTEGER;
        PROFIL_LIST.profil_list.item j.genere_graph output_code;
      }
;
      output_code.append "}\n";
      f := FS_MIN.open_write "graph.txt";
      FS_MIN.write f with output_code size (output_code.count);
      FS_MIN.close f;
    }
;
    //
    end_time := SYSTEM.get_universal_time;
    (is_quiet).if_false {
      STD_ERROR.put_string " => ";
      time := (end_time - begin_time).to_integer;
      (time >= 120).if {
        STD_ERROR.put_integer (time/60);
        STD_ERROR.put_string " minutes, ";
        time := time % 60;
      }
;
      STD_ERROR.put_integer time;
      STD_ERROR.put_string " second(s).\n";
      //
      (POSITION.nb_warning != 0).if {
        STD_ERROR.put_string " => ";
        STD_ERROR.put_integer (POSITION.nb_warning);
        STD_ERROR.put_string " warning(s).\n";
      }
;
    }
;
    (is_statistic).if {
      STD_ERROR.put_string "  Local counter        : ";
      STD_ERROR.put_integer (LIST.local_counter);
      STD_ERROR.put_string "\n";
      STD_ERROR.put_string "  Context counter      : ";
      STD_ERROR.put_integer (LIST.context_counter);
      STD_ERROR.put_string "\n";
      print "  Null call score      : " stat null_counter for late_binding_counter;
      print "  Polymorphic call     : " stat polymorphic_counter for late_binding_counter;
      //
      print "  Recursivity function : "
      stat (PROFIL.counter_recursivity_function) for (PROFIL.counter_function);
      //
      (is_optimization).if {
        "  Invariant loop score : ".print; count_invariant.print; '\n'.print;
      }
;
      //
      "Type set size vs argument number:\n".print;
      tmp2 := 0;
      (PROFIL.nb_arg_size_type.lower).to (PROFIL.nb_arg_size_type.upper) do { i:INTEGER;
        tmp := PROFIL.nb_arg_size_type.item i;
        (tmp != 0).if {
          "  For a type set of ".print;
          i.print;
          " types, the number's argument is ".print;
          tmp.print;
          tmp2 := tmp2 + tmp;
          '\n'.print;
        }
;
      }
;
      "  Total: ".print;
      tmp2.print;
      '\n'.print;
      //
      "Number's function vs polymorphic argument's number:\n".print;
      (PROFIL.nb_func_arg.lower1).to (PROFIL.nb_func_arg.upper1) do { nb_arg:INTEGER;
        " For a function with ".print;
        nb_arg.print;
        " arguments:\n".print;
        tmp2 := 0;
        (PROFIL.nb_func_arg.lower2).to (PROFIL.nb_func_arg.upper2) do { nb_arg_poly:INTEGER;
          tmp := PROFIL.nb_func_arg.item (nb_arg,nb_arg_poly);
          (tmp != 0).if {
            "    ".print;
            tmp.print;
            " functions with ".print;
            nb_arg_poly.print;
            " arguments polymorphics.\n".print;
            tmp2 := tmp2 + tmp;
          }
;
        }
;
        "    Total: ".print;
        tmp2.print;
        '\n'.print;
      }
;

      (TYPE_GENERIC.paper_list.lower).to (TYPE_GENERIC.paper_list.upper) do { i:INTEGER;
        + var:VARIABLE;
        + t:TYPES;
        + idx:INTEGER;
        var := TYPE_GENERIC.paper_list.item i.native_array_variable;
        t := var.type_set;
        ((var.is_static) || {t.count = 0}).if {
          tab.put (tab.item 0+1) to 0;
        }
 else {
          idx := t.count;
          tab.put (tab.item idx+1) to idx;
          (t.first = TYPE_NULL).if {
            tab_null.put (tab_null.item idx+1) to idx;
          }
;
        }
;
      }
;
      "TAB:\n".print;
      (tab.lower).to (tab.upper) do { i:INTEGER;
        (tab.item i != 0).if {
          i.print; '='.print; tab.item i.print; '\n'.print;
        }
;
      }
;
      "TAB NULL:\n".print;
      (tab_null.lower).to (tab_null.upper) do { i:INTEGER;
        (tab_null.item i != 0).if {
          i.print; '='.print; tab_null.item i.print; '\n'.print;
        }
;
      }
;

      /*
      // Counter on '==' and '!='
      "\nCounter on '==' and '!=':".print;
      "\nParser counter       : ".print;
      count_equal_parse.print;
      "\nLive counter         : ".print;
      count_equal_live.print;
      "\nCreate counter       : ".print;
      count_equal_creat.print;
      "\nRemove counter       : ".print;
      count_equal_remov.print;
      "\nGenerate counter     : ".print;
      count_equal_gener.print;
      '\n'.print;
      "\nConstant counter     : ".print;
      count_equal_const.print;
      "\na = a counter        : ".print;
      count_equal_ident.print;
      "\nNULL = NULL counter  : ".print;
      count_equal_null.print;
      "\nIntersection counter : ".print;
      count_equal_inter.print;
      '\n'.print;
      // native_array:
      "\nNATIVE_ARRAY expanded       : ".print;
      count_na_expanded.print;
      "\nNATIVE_ARRAY with NULL      : ".print;
      count_na_null.print;
      "\nNATIVE_ARRAY without NULL   : ".print;
      count_na_not_null.print;
      "\nNATIVE_ARRAY with monomorph : ".print;
      count_na_mono.print;
      "\nNATIVE_ARRAY allways NULL   : ".print;
      count_na_always_null.print;
      '\n'.print;
      // local:
      "\nLocal expanded       : ".print;
      count_local_expanded.print;
      "\nLocal with NULL      : ".print;
      count_local_null.print;
      "\nLocal without NULL   : ".print;
      count_local_not_null.print;
      "\nLocal with monomorph : ".print;
      count_local_mono.print;
      "\nLocal allways NULL   : ".print;
      count_local_always_null.print;
      '\n'.print;
      // switch:
      "\nswitch          : ".print;
      count_switch.print;
      "\nswitch merging  : ".print;
      count_switch_merging.print;
      '\n'.print;
      */
    }
;

    /*
    PROFIL.list_cpa.lower.to (PROFIL.list_cpa.upper) do { i:INTEGER;
      PROFIL.list_cpa.item i.print;
      '\n'.print;
    };
    */
    /*
    "LOCAL : type set size\n".print;
    (LIST.stat_local.lower).to (LIST.stat_local.upper) do { i:INTEGER;
      (LIST.stat_local.item i != 0).if {
        i.print; '='.print;
        LIST.stat_local.item i.print;
        '\n'.print;
      };
    };
    "LOCAL : type set size with NULL\n".print;
    (LIST.stat_local_null.lower).to (LIST.stat_local_null.upper) do { i:INTEGER;
      (LIST.stat_local_null.item i != 0).if {
        i.print; '='.print;
        LIST.stat_local_null.item i.print;
        '\n'.print;
      };
    };
    "GLOBAL : type set size\n".print;
    (TYPE.stat_global.lower).to (TYPE.stat_global.upper) do { i:INTEGER;
      (TYPE.stat_global.item i != 0).if {
        i.print; '='.print;
        TYPE.stat_global.item i.print;
        '\n'.print;
      };
    };
    "GLOBAL : type set size with NULL\n".print;
    (TYPE.stat_global_null.lower).to (TYPE.stat_global_null.upper) do { i:INTEGER;
      (TYPE.stat_global_null.item i != 0).if {
        i.print; '='.print;
        TYPE.stat_global_null.item i.print;
        '\n'.print;
      };
    };
    "SLOT : type set size\n".print;
    (TYPE.stat_slot.lower).to (TYPE.stat_slot.upper) do { i:INTEGER;
      (TYPE.stat_slot.item i != 0).if {
        i.print; '='.print;
        TYPE.stat_slot.item i.print;
        '\n'.print;
      };
    };
    "SLOT : type set size with NULL\n".print;
    (TYPE.stat_slot_null.lower).to (TYPE.stat_slot_null.upper) do { i:INTEGER;
      (TYPE.stat_slot_null.item i != 0).if {
        i.print; '='.print;
        TYPE.stat_slot_null.item i.print;
        '\n'.print;
      };
    };
    */

    //
    // Execute finality command (front end).
    //
    // Executing `front_end':
    LIP_CODE.put_boolean is_cop to (ALIAS_STR.slot_is_cop);
    s := LIP_CODE.get_method (ALIAS_STR.slot_back_end);
    (s = NULL).if {
      "Warning: Slot `back_end' not found in *.lip file.\n".print;
    }
 else {
      s.run_with NULL;
    }
;
  )
;