xref: /dports/lang/seed7/seed7/prg/s7c.sd7

(********************************************************************)
(*                                                                  *)
(*  s7c.sd7       Seed7 compiler - Compiles Seed7 to C              *)
(*  Copyright (C) 1990 - 1994, 2004 - 2021  Thomas Mertes           *)
(*                                                                  *)
(*  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 2 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, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ message "Compiling the compiler ...";
$ include "seed7_05.s7i";
  include "stdio.s7i";
  include "osfiles.s7i";
  include "scanstri.s7i";
  include "unicode.s7i";
  include "bigint.s7i";
  include "float.s7i";
  include "math.s7i";
  include "bytedata.s7i";
  include "bin64.s7i";
  include "keybd.s7i";
  include "progs.s7i";
  include "shell.s7i";
  include "cc_conf.s7i";
  include "inifile.s7i";
  include "comp/config.s7i";
  include "comp/type.s7i";
  include "comp/expr.s7i";
  include "comp/debug.s7i";
  include "comp/destr.s7i";
  include "comp/create.s7i";
  include "comp/copy.s7i";
  include "comp/expr_utl.s7i";
  include "comp/stat.s7i";
  include "comp/inline.s7i";
  include "comp/const.s7i";
  include "comp/literal.s7i";
  include "comp/intrange.s7i";
  include "comp/error.s7i";
  include "comp/library.s7i";
  include "comp/action.s7i";

const string: temp_marker is "/* Seed7 compiler temp file */";

const boolean: SHOW_STATISTIC is FALSE;

const type: option_hash is hash [string] string;

var option_hash: compiler_option is option_hash.value;
var boolean: compileLibrary is FALSE;

var array string: libraryDirs is 0 times "";

var reference: main_object is NIL;
var file: c_prog is STD_NULL;

var integer: countDeclarations is 0;
var expr_type: global_init is expr_type.value;

const type: globalInitHash is hash [reference] string;

var globalInitHash: globalInitalisations is globalInitHash.EMPTY_HASH;

const type: interface_hash is hash [type] array type;
const type: enum_literal_hash is hash [type] element_number_hash;
const type: act_to_form_param_hash is hash [reference] reference;
const type: params_added_hash is hash [reference] act_to_form_param_hash;
const type: setOfCategory is set of category;
const type: setOfString is set of string;
const type: funcparam_data_hash is hash [reference] string;
const type: element_repeat_count_hash is hash [reference] integer;
const type: stringLengthHash is hash [integer] integer;
const type: lengthToStriNumHash is hash [integer] array integer;
const type: profiledFunctionsHash is hash [integer] reference;

var boolean_type_hash: generic_cpy_declared is boolean_type_hash.EMPTY_HASH;
var boolean_type_hash: generic_create_declared is boolean_type_hash.EMPTY_HASH;
var boolean_type_hash: generic_destr_declared is boolean_type_hash.EMPTY_HASH;
var boolean_type_hash: generic_cmp_declared is boolean_type_hash.EMPTY_HASH;
var boolean_obj_hash: return_ref_to_value is boolean_obj_hash.EMPTY_HASH;
var boolean_obj_hash: function_declared is boolean_obj_hash.EMPTY_HASH;
var boolean_obj_hash: function_var_declared is boolean_obj_hash.EMPTY_HASH;
var ref_list: dynamic_functions is ref_list.EMPTY;
var interface_hash: interfaceOfType is interface_hash.EMPTY_HASH;
var enum_literal_hash: enum_literal is enum_literal_hash.EMPTY_HASH;
var params_added_hash: params_added is params_added_hash.EMPTY_HASH;
var boolean_obj_hash: definedActualFuncParams is boolean_obj_hash.EMPTY_HASH;
var funcparam_data_hash: funcparam_data is funcparam_data_hash.EMPTY_HASH;
var funcparam_data_hash: funcparam_reference is funcparam_data_hash.EMPTY_HASH;
var element_repeat_count_hash: element_repeat_count is element_repeat_count_hash.EMPTY_HASH;
var profiledFunctionsHash: profiledFunctions is profiledFunctionsHash.value;


const func boolean: isFuncParamData (in reference: currExpr) is
  return currExpr in funcparam_data;


const proc: count_declarations (inout expr_type: c_expr) is func

  begin
    incr(countDeclarations);
    c_expr.expr &:= "/* ";
    c_expr.expr &:= str(countDeclarations);
    c_expr.expr &:= " */\n";
    write(OUT, countDeclarations);
    write(OUT, "\r");
    flush(OUT);
  end func;


const proc: process_generic_cpy_declaration (in type: object_type,
    inout expr_type: c_expr) is func

  begin
    if object_type not in generic_cpy_declared then
      process_cpy_declaration(object_type, c_expr);
      c_expr.expr &:= "static void generic_cpy_";
      c_expr.expr &:= str(typeNumber(object_type));
      c_expr.expr &:= " (genericType *a, const genericType b)\n";
      c_expr.expr &:= "{\n";
      process_cpy_call(object_type,
          "((const_rtlObjectType *) a)->value." & raw_type_value(object_type),
          "((const_rtlObjectType *) &b)->value." & raw_type_value(object_type),
          c_expr.expr);
      c_expr.expr &:= ";\n";
      c_expr.expr &:= "}\n\n";
      generic_cpy_declared @:= [object_type] TRUE;
    end if;
  end func;


const proc: process_generic_create_declaration (in type: object_type,
    inout expr_type: c_expr) is func

  begin
    if object_type not in generic_create_declared then
      process_create_declaration(object_type, c_expr);
      c_expr.expr &:= "static genericType generic_create_";
      c_expr.expr &:= str(typeNumber(object_type));
      c_expr.expr &:= " (const genericType b)\n";
      c_expr.expr &:= "{\n";
      c_expr.expr &:= "rtlObjectType result;\n";
      c_expr.expr &:= "result.value.";
      c_expr.expr &:= raw_type_value(object_type);
      c_expr.expr &:= "=";
      process_create_call(object_type,
          "((const_rtlObjectType *) &b)->value." & raw_type_value(object_type),
          c_expr.expr);
      c_expr.expr &:= ";\n";
      c_expr.expr &:= "return result.value.genericValue;\n";
      c_expr.expr &:= "}\n\n";
      generic_create_declared @:= [object_type] TRUE;
    end if;
  end func;


const proc: process_generic_destr_declaration (in type: object_type,
    inout expr_type: c_expr) is func

  begin
    if object_type not in generic_destr_declared then
      process_destr_declaration(object_type, c_expr);
      c_expr.expr &:= "static void generic_destr_";
      c_expr.expr &:= str(typeNumber(object_type));
      c_expr.expr &:= " (const genericType b)\n";
      c_expr.expr &:= "{\n";
      process_destr_call(object_type,
          "((const_rtlObjectType *) &b)->value." & raw_type_value(object_type),
          c_expr.expr);
      c_expr.expr &:= "}\n\n";
      generic_destr_declared @:= [object_type] TRUE;
    end if;
  end func;


const proc: process_generic_cmp_declaration (in reference: function,
    in type: object_type, inout expr_type: c_expr) is func

  begin
    if object_type not in generic_cmp_declared then
      process_cpy_declaration(object_type, c_expr);
      c_expr.expr &:= "static intType generic_cmp_";
      c_expr.expr &:= str(typeNumber(object_type));
      c_expr.expr &:= " (const genericType a, const genericType b)\n";
      c_expr.expr &:= "{\n";
      c_expr.expr &:= "return o_";
      create_name(function, c_expr.expr);
      c_expr.expr &:= "(((const_rtlObjectType *) &a)->value.";
      c_expr.expr &:= raw_type_value(object_type);
      c_expr.expr &:= ", ((const_rtlObjectType *) &b)->value.";
      c_expr.expr &:= raw_type_value(object_type);
      c_expr.expr &:= ");\n";
      c_expr.expr &:= "}\n\n";
      generic_cmp_declared @:= [object_type] TRUE;
    end if;
  end func;


const proc: process_big_create_call (in bigInteger: number, inout string: expr) is func

  begin
    if number = 0_ then
      incr(countOptimizations);
      expr &:= "bigZero(); /* 0_ */\n";
    else
      expr &:= "bigCreate(";
      expr &:= bigIntegerLiteral(number);
      expr &:= ");\n";
    end if;
  end func;


const proc: process_str_create_call (in string: stri, inout string: expr) is func

  local
    var char: ch is ' ';
    var integer: index is 2;
  begin
    if stri = "" then
      incr(countOptimizations);
      expr &:= "strEmpty(); /* \"\" */\n";
    elsif length(stri) = 1 then
      incr(countOptimizations);
      expr &:= "chrStr(";
      expr &:= charLiteral(stri[1]);
      expr &:= "); /* ";
      expr &:= literal(stri);
      expr &:= " */\n";
    else
      ch := stri[1];
      while index <= length(stri) and ch = stri[index] do
        incr(index);
      end while;
      if index > length(stri) then
        incr(countOptimizations);
        if ch = '\0;' then
          expr &:= "strZero(";
        else
          expr &:= "strChMult(";
          expr &:= charLiteral(ch);
          expr &:= ", ";
        end if;
        expr &:= integerLiteral(length(stri));
        expr &:= ");\n";
      else
        expr &:= "strCreate(";
        expr &:= stringLiteral(stri);
        expr &:= ");\n";
      end if;
    end if;
  end func;


const proc: getAnyParamToTempAssigns (in expr_type: c_param, inout expr_type: c_expr) is func

  begin
    if c_param.result_expr <> "" then
      c_expr.temp_decls &:= c_param.result_decl;
      c_expr.temp_frees &:= c_param.result_free;
      c_expr.temp_to_null &:= c_param.result_to_null;
      c_expr.temp_assigns &:= c_param.result_intro;
      c_expr.temp_assigns &:= c_param.result_expr;
      c_expr.temp_assigns &:= c_param.result_finish;
    else
      c_expr.temp_assigns &:= c_param.expr;
    end if;
  end func;


const proc: getAnyParamToTempAssigns (in reference: aParam, inout expr_type: c_expr) is func

  local
    var category: exprCategory is category.value;
    var reference: paramValue is NIL;
    var string: variableName is "";
    var expr_type: c_param is expr_type.value;
  begin
    prepareAnyParamTemporarys(aParam, c_param, c_expr);
    if aParam not in funcparam_data and
        not isFunc(getType(aParam)) and
        aParam in inlineParam and
        inlineParam[aParam][1].paramValue <> NIL then
      paramValue := inlineParam[aParam][1].paramValue;
      exprCategory := category(paramValue);
      if not isVar(paramValue) and
          (exprCategory = INTOBJECT or
           exprCategory = FLOATOBJECT or
           exprCategory = CHAROBJECT or
           exprCategory = STRIOBJECT or
           exprCategory = BSTRIOBJECT) then
        incr(c_expr.temp_num);
        variableName := "tmp_" & str(c_expr.temp_num);
        c_expr.temp_decls &:= type_name(getType(paramValue));
        c_expr.temp_decls &:= " ";
        c_expr.temp_decls &:= variableName;
        c_expr.temp_decls &:= ";\n";
        c_expr.temp_assigns &:= "(";
        c_expr.temp_assigns &:= variableName;
        c_expr.temp_assigns &:= "=";
        getAnyParamToTempAssigns(c_param, c_expr);
        c_expr.temp_assigns &:= ", &";
        c_expr.temp_assigns &:= variableName;
        c_expr.temp_assigns &:= ")";
      else
        c_expr.temp_assigns &:= "&(";
        getAnyParamToTempAssigns(c_param, c_expr);
        c_expr.temp_assigns &:= ")";
      end if;
    else
      c_expr.temp_assigns &:= "&(";
      getAnyParamToTempAssigns(c_param, c_expr);
      c_expr.temp_assigns &:= ")";
    end if;
  end func;


const func string: enum_value (in reference: current_object) is func

  result
    var string: enumValue is "";
  local
    var type: enum_type is void;
    var string: object_name is "";
  begin
    enum_type := getType(current_object);
    if enum_type in typeCategory and typeCategory[enum_type] = BOOLOBJECT then
      object_name := str(current_object);
      if object_name = "FALSE" then
        enumValue := "0/*FALSE*/";
      elsif object_name = "TRUE" then
        enumValue := "1/*TRUE*/";
      end if;
    else
      enumValue := "/*" & str(current_object) & "*/";
      if enum_type in enum_literal and
          current_object in enum_literal[enum_type] then
        enumValue &:= str(enum_literal[enum_type][current_object]);
      else
        enumValue &:= str(objNumber(current_object));
      end if;
    end if;
  end func;


const proc: reference_value (in reference: current_value,
    inout expr_type: c_expr) is func

  begin
    if current_value = NIL then
      c_expr.expr &:= "NULL";
    else
      c_expr.expr &:= "&(";
      process_expr(current_value, c_expr);
      c_expr.expr &:= ")";
    end if;
  end func;


const proc: ref_list_value (in ref_list: current_value,
    inout expr_type: c_expr) is func

  local
    var reference: element is NIL;
    var boolean: first_element is TRUE;
  begin
    if length(current_value) = 0 then
      c_expr.expr &:= "NULL";
    else
      c_expr.expr &:= "{";
      for element range current_value do
        if first_element then
          first_element := FALSE;
        else
          c_expr.expr &:= ", ";
        end if;
        c_expr.expr &:= "&(";
        process_expr(element, c_expr);
        c_expr.expr &:= ")";
      end for;
      c_expr.expr &:= "}";
    end if;
  end func;


const func string: getExprValue (in reference: current_expression, attr string) is func
  result
    var string: exprValue is "";
  local
    var reference: evaluated_expression is NIL;
  begin
    if category(current_expression) = STRIOBJECT then
      exprValue := getValue(current_expression, string);
    else
      evaluated_expression := evaluate(prog, current_expression);
      if evaluated_expression <> NIL then
        exprValue := getValue(evaluated_expression, string);
      end if;
    end if;
  end func;


const func boolean: isPointerParam (in reference: a_param) is
  return category(a_param) = REFPARAMOBJECT and
        (not valueIsAtHeap(a_param) or isVar(a_param));


const func boolean: isCopyParam (in reference: a_param) is
  return category(a_param) = VALUEPARAMOBJECT and
        valueIsAtHeap(a_param);


const func boolean: isInOutParam (in reference: a_param) is
  return category(a_param) = REFPARAMOBJECT and isVar(a_param);


const func boolean: canTakeAddress (in reference: an_expression) is func

  result
    var boolean: canTakeAddress is TRUE;
  local
    var category: exprCategory is category.value;
    var string: action_name is "";
  begin
    exprCategory := category(an_expression);
    if (exprCategory = INTOBJECT or
        exprCategory = CHAROBJECT or
        exprCategory = CONSTENUMOBJECT or
        exprCategory = FLOATOBJECT) and
        not isVar(an_expression) then
      canTakeAddress := FALSE;
    end if;
    if isFunc(getType(an_expression)) then
      canTakeAddress := FALSE;
    end if;
    if exprCategory = CALLOBJECT then
      if category(getValue(an_expression, ref_list)[1]) = ACTOBJECT then
        action_name := str(getValue(getValue(an_expression, ref_list)[1], ACTION));
        if  action_name = "ARR_IDX" or
            action_name = "SCT_SELECT" then
          canTakeAddress := TRUE;
        end if;
      end if;
    end if;
  end func;


const proc: process_constenumobject (in reference: function, in ref_list: params,
    inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "/*constenumobject*/";
    noop_params(formalParams(function), params, c_expr);
  end func;


const func boolean: param_list_okay (in ref_list: formal_params) is func

  result
    var boolean: okay is TRUE;
  local
    var reference: obj is NIL;
    var category: paramCategory is category.value;
  begin
    for obj range formal_params do
      paramCategory := category(obj);
      if paramCategory <> SYMBOLOBJECT and paramCategory <> TYPEOBJECT then
        if isFunc(getType(obj)) then
          okay := FALSE;
        end if;
      end if;
    end for;
  end func;


const func boolean: containsFunctionCall (in reference: function,
    in reference: current_expression) is func

  result
    var boolean: containsCall is FALSE;
  local
    var category: exprCategory is category.value;
    var ref_list: params is ref_list.EMPTY;
    var reference: currentFunction is NIL;
    var integer: paramNum is 0;
  begin
    exprCategory := category(current_expression);
    if exprCategory = MATCHOBJECT or exprCategory = CALLOBJECT then
      params := getValue(current_expression, ref_list);
      currentFunction := params[1];
      if currentFunction = function then
        containsCall := TRUE;
      else
        paramNum := 2;
        while paramNum <= length(params) and not containsCall do
          containsCall := containsFunctionCall(function, params[paramNum]);
          incr(paramNum);
        end while;
      end if;
    elsif exprCategory = BLOCKOBJECT then
      containsCall := current_expression = function;
    end if;
  end func;


const func boolean: recursiveFunctionCall (in reference: function,
    in reference: current_expression) is func

  result
    var boolean: recursiveCall is FALSE;
  local
    var reference: obj is NIL;
  begin
    recursiveCall := containsFunctionCall(function, current_expression);
    if not recursiveCall then
      for obj range localConsts(function) do
        if not recursiveCall and category(obj) = BLOCKOBJECT then
          recursiveCall := containsFunctionCall(function, body(obj));
        end if;
      end for;
    end if;
  end func;


const func boolean: identical_values (in reference: object1, in reference: object2) is func

  result
    var boolean: isIdentical is FALSE;
  local
    var reference: element1 is NIL;
    var ref_list: element_list2 is ref_list.EMPTY;
    var integer: index2 is 0;
  begin
    case category(object1) of
      when {INTOBJECT}:
        isIdentical := getValue(object1, integer) = getValue(object2, integer);
      when {BIGINTOBJECT}:
        isIdentical := getValue(object1, bigInteger) = getValue(object2, bigInteger);
      when {CHAROBJECT}:
        isIdentical := getValue(object1, char) = getValue(object2, char);
      when {STRIOBJECT}:
        isIdentical := getValue(object1, string) = getValue(object2, string);
      when {BSTRIOBJECT}:
        isIdentical := getValue(object1, bstring) = getValue(object2, bstring);
      when {SETOBJECT}:
        isIdentical := getValue(object1, bitset) = getValue(object2, bitset);
      when {FLOATOBJECT}:
        isIdentical := getValue(object1, float) = getValue(object2, float);
      when {REFOBJECT}:
        isIdentical := getValue(object1, reference) = getValue(object2, reference);
      when {FILEOBJECT}:
        isIdentical := getValue(object1, clib_file) = getValue(object2, clib_file);
      when {CONSTENUMOBJECT, VARENUMOBJECT}:
        isIdentical := getValue(object1, reference) = getValue(object2, reference);
      when {ARRAYOBJECT}:
        if arrayMinIdx(object1) = arrayMinIdx(object2) and
            arrayMaxIdx(object1) = arrayMaxIdx(object2) then
          isIdentical := TRUE;
          element_list2 := arrayToList(object2);
          index2 := 1;
          for element1 range arrayToList(object1) until not isIdentical do
            isIdentical := identical_values(element1, element_list2[index2]);
            incr(index2);
          end for;
        end if;
      when {STRUCTOBJECT}:
        isIdentical := TRUE;
        element_list2 := structToList(object2);
        index2 := 1;
        for element1 range structToList(object1) until not isIdentical do
          isIdentical := identical_values(element1, element_list2[index2]);
          incr(index2);
        end for;
    end case;
  end func;


const func boolean: canUseArrTimes (in type: objectType, in reference: arrayValue,
    inout reference: repeatedElement) is func

  result
    var boolean: canUseArrTimes is FALSE;
  local
    var type: elementType is void;
    var ref_list: array_list is ref_list.EMPTY;
    var reference: element is NIL;
    var reference: previous_element is NIL;
    var integer: repeat_count is 1;
  begin
    if objectType in array_element then
      elementType := array_element[objectType];
      if elementType in typeCategory and
          typeCategory[elementType] in simpleValueType then
        array_list := arrayToList(arrayValue);
        for element range array_list do
          if previous_element <> NIL then
            if identical_values(previous_element, element) then
              incr(repeat_count);
            end if;
          end if;
          previous_element := element;
        end for;
        if repeat_count = succ(arrayMaxIdx(arrayValue) - arrayMinIdx(arrayValue)) then
          canUseArrTimes := TRUE;
          repeatedElement := array_list[1];
        end if;
      end if;
    end if;
  end func;


const proc: assignArrayValue (in type: objectType, in reference: arrayValue,
    inout expr_type: c_declaration) is func

  local
    var integer: arraySize is 0;
    var reference: repeatedElement is NIL;
    var string: variableName is "";
    var string: param_value is "";
  begin
    arraySize := succ(arrayMaxIdx(arrayValue) - arrayMinIdx(arrayValue));
    if evaluate_const_expr >= 2 and
        arrayMinIdx(arrayValue) > arrayMaxIdx(arrayValue) then
      if FALSE and inlineFunctions then
        incr(c_declaration.temp_num);
        variableName := "new_arr" <& c_declaration.temp_num;
        c_declaration.temp_decls &:= ";\n";
        c_declaration.temp_decls &:= "arrayType ";
        c_declaration.temp_decls &:= variableName;
        c_declaration.temp_assigns &:= "(";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= " = (arrayType) malloc(sizeof(struct rtlArrayStruct) - sizeof(rtlObjectType)), (unlikely(";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= " == NULL) ? ";
        c_declaration.temp_assigns &:= "intRaiseError(MEMORY_ERROR) ";
        c_declaration.temp_assigns &:= ": 0), ";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= "->min_position = ";
        c_declaration.temp_assigns &:= integerLiteral(arrayMinIdx(arrayValue));
        c_declaration.temp_assigns &:= ", ";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= "->max_position = ";
        c_declaration.temp_assigns &:= integerLiteral(arrayMaxIdx(arrayValue));
        c_declaration.temp_assigns &:= ", ";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= ");\n";
      else
        c_declaration.temp_assigns &:= "arrMalloc(";
        c_declaration.temp_assigns &:= integerLiteral(arrayMinIdx(arrayValue));
        c_declaration.temp_assigns &:= ", ";
        c_declaration.temp_assigns &:= integerLiteral(arrayMaxIdx(arrayValue));
        c_declaration.temp_assigns &:= ");\n";
      end if;
    elsif evaluate_const_expr >= 2 and
        canUseArrTimes(objectType, arrayValue, repeatedElement) and
        category(repeatedElement) = INTOBJECT then
      if getValue(repeatedElement, integer) = 0 then
        incr(c_declaration.temp_num);
        variableName := "new_arr" <& c_declaration.temp_num;
        c_declaration.temp_decls &:= ";\n";
        c_declaration.temp_decls &:= "arrayType ";
        c_declaration.temp_decls &:= variableName;
        c_declaration.temp_assigns &:= "(";
        c_declaration.temp_assigns &:= variableName;
        if inlineFunctions and
            arrayMinIdx(arrayValue) >= -100000000 and arrayMinIdx(arrayValue) <= 100000000 and
            arraySize <= 100000000 then
          # The indices are okay and the size given to malloc() will not overflow.
          c_declaration.temp_assigns &:= " = (arrayType) malloc(sizeof(struct rtlArrayStruct) + ";
          c_declaration.temp_assigns &:= integerLiteral(pred(arraySize));
          c_declaration.temp_assigns &:= " * sizeof(rtlObjectType)), (unlikely(";
          c_declaration.temp_assigns &:= variableName;
          c_declaration.temp_assigns &:= " == NULL) ? ";
          c_declaration.temp_assigns &:= "intRaiseError(MEMORY_ERROR) ";
          c_declaration.temp_assigns &:= ": 0), ";
          c_declaration.temp_assigns &:= variableName;
          c_declaration.temp_assigns &:= "->min_position = ";
          c_declaration.temp_assigns &:= integerLiteral(arrayMinIdx(arrayValue));
          c_declaration.temp_assigns &:= ", ";
          c_declaration.temp_assigns &:= variableName;
          c_declaration.temp_assigns &:= "->max_position = ";
          c_declaration.temp_assigns &:= integerLiteral(arrayMaxIdx(arrayValue));
        else
          # Use arrMalloc(), as it has detailed checks for indices and array size.
          c_declaration.temp_assigns &:= " = arrMalloc(";
          c_declaration.temp_assigns &:= integerLiteral(arrayMinIdx(arrayValue));
          c_declaration.temp_assigns &:= ", ";
          c_declaration.temp_assigns &:= integerLiteral(arrayMaxIdx(arrayValue));
          c_declaration.temp_assigns &:= ")";
        end if;
        c_declaration.temp_assigns &:= ", memset(";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= "->arr, 0, ";
        c_declaration.temp_assigns &:= integerLiteral(arraySize);
        c_declaration.temp_assigns &:= " * sizeof(rtlObjectType)), ";
        c_declaration.temp_assigns &:= variableName;
        c_declaration.temp_assigns &:= ");\n";
      else
        c_declaration.temp_assigns &:= "arrTimes(";
        c_declaration.temp_assigns &:= integerLiteral(arrayMinIdx(arrayValue));
        c_declaration.temp_assigns &:= ", ";
        c_declaration.temp_assigns &:= integerLiteral(arrayMaxIdx(arrayValue));
        c_declaration.temp_assigns &:= ", (genericType)(";
        c_declaration.temp_assigns &:= integerLiteral(getValue(repeatedElement, integer));
        c_declaration.temp_assigns &:= "));\n";
      end if;
    else
      if arrayValue not in const_table then
        const_table @:= [arrayValue] length(const_table);
      end if;
      process_create_declaration(objectType, global_c_expr);
      param_value := "arr[";
      param_value &:= str(const_table[arrayValue]);
      param_value &:= "]";
      process_create_call(objectType,
          param_value, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= ";\n";
    end if;
  end func;


const proc: process_local_declaration (in reference: current_object, in var reference: object_value,
    inout expr_type: c_expr) is func

  local
    var type: objectType is void;
    var category: valueCategory is category.value;
    var expr_type: c_declaration is expr_type.value;
    var expr_type: c_value is expr_type.value;
    var string: param_name is "";
    var string: param_value is "";
  begin
    c_declaration.temp_num := c_expr.temp_num;
    valueCategory := category(object_value);
    objectType := getType(current_object);
    if objectType = getType(object_value) and objectType not in typeCategory then
      typeCategory @:= [objectType] valueCategory;
    end if;
    declare_type_if_necessary(objectType, global_c_expr);
    c_declaration.temp_decls &:= diagnosticLine(current_object);
    c_declaration.temp_decls &:= type_name(objectType);
    c_declaration.temp_decls &:= " o_";
    create_name(current_object, c_declaration.temp_decls);
    if objectType in typeCategory and typeCategory[objectType] = INTERFACEOBJECT then
      if valueCategory = INTERFACEOBJECT then
        object_value := interfaceToStruct(object_value);
        valueCategory := category(object_value);
      end if;
      if isVar(object_value) then
        c_declaration.temp_assigns &:= diagnosticLine(current_object);
        c_declaration.temp_assigns &:= "o_";
        create_name(current_object, c_declaration.temp_assigns);
        c_declaration.temp_assigns &:= "=itfCreate(o_";
        create_name(object_value, c_declaration.temp_assigns);
        c_declaration.temp_assigns &:= "/* ";
        c_declaration.temp_assigns &:= str(valueCategory);
        c_declaration.temp_assigns &:= " */);\n";
      else
        if object_value not in const_table then
          const_table @:= [object_value] length(const_table);
        end if;
        c_declaration.temp_assigns &:= diagnosticLine(current_object);
        c_declaration.temp_assigns &:= "o_";
        create_name(current_object, c_declaration.temp_assigns);
        c_declaration.temp_assigns &:= "=(";
        c_declaration.temp_assigns &:= type_name(objectType);
        c_declaration.temp_assigns &:= ")(itfCreate(itf[";
        c_declaration.temp_assigns &:= str(const_table[object_value]);
        c_declaration.temp_assigns &:= "]));\n";
      end if;
      process_destr_declaration(objectType, global_c_expr);
      param_name := "o_";
      create_name(current_object, param_name);
      process_destr_call(objectType, param_name, c_declaration.temp_frees);
    elsif valueCategory = TYPEOBJECT then
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= typeLiteral(getValue(object_value, type));
    elsif valueCategory = INTOBJECT then
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= str(getValue(object_value, integer));
    elsif valueCategory = BIGINTOBJECT then
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=";
      process_big_create_call(getValue(object_value, bigInteger), c_declaration.temp_assigns);
      c_declaration.temp_frees &:= "bigDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = CHAROBJECT then
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= charLiteral(getValue(object_value, char));
    elsif valueCategory = FLOATOBJECT then
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= floatLiteral(getValue(object_value, float));
    elsif valueCategory = STRIOBJECT then
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=";
      process_str_create_call(getValue(object_value, string), c_declaration.temp_assigns);
      c_declaration.temp_frees &:= "strDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = BSTRIOBJECT then
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=bstCreate(";
      c_declaration.temp_assigns &:= bstriLiteral(getValue(object_value, bstring));
      c_declaration.temp_assigns &:= ");\n";
      c_declaration.temp_frees &:= "bstDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = SETOBJECT then
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=setCreate(";
      c_declaration.temp_assigns &:= bitsetLiteral(getValue(object_value, bitset));
      c_declaration.temp_assigns &:= ");\n";
      c_declaration.temp_frees &:= "setDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = REFOBJECT then
      c_declaration.temp_decls &:= "=";
      reference_value(getValue(object_value, reference), c_value);
      c_declaration.temp_decls &:= c_value.expr;
    elsif valueCategory = REFLISTOBJECT then
      c_declaration.temp_decls &:= "=";
      ref_list_value(getValue(object_value, ref_list), c_value);
      c_declaration.temp_decls &:= c_value.expr;
      c_declaration.temp_frees &:= "rflDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = FILEOBJECT then
      c_declaration.temp_decls &:= "=&";
      c_declaration.temp_decls &:= lower(literal(getValue(object_value, clib_file)));
      c_declaration.temp_decls &:= "FileRecord";
      c_declaration.temp_frees &:= "filDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = SOCKETOBJECT then
      c_declaration.temp_decls &:= "=-1";
    elsif valueCategory = POLLOBJECT then
      c_declaration.temp_decls &:= "=NULL";
    elsif valueCategory = ARRAYOBJECT then
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=";
      assignArrayValue(objectType, object_value, c_declaration);
      process_destr_declaration(objectType, global_c_expr);
      param_name := "o_";
      create_name(current_object, param_name);
      process_destr_call(objectType, param_name, c_declaration.temp_frees);
    elsif valueCategory = STRUCTOBJECT then
      if object_value not in const_table then
        const_table @:= [object_value] length(const_table);
      end if;
      process_create_declaration(objectType, global_c_expr);
      process_destr_declaration(objectType, global_c_expr);
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=";
      param_value := "sct[";
      param_value &:= str(const_table[object_value]);
      param_value &:= "]";
      process_create_call(objectType,
          param_value, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= ";\n";
      param_name := "o_";
      create_name(current_object, param_name);
      process_destr_call(objectType, param_name, c_declaration.temp_frees);
    elsif valueCategory = HASHOBJECT then
      if length(hashKeysToList(object_value)) = 0 then
        process_destr_declaration(objectType, global_c_expr);
        incr(countOptimizations);
        c_declaration.temp_assigns &:= diagnosticLine(current_object);
        c_declaration.temp_assigns &:= "o_";
        create_name(current_object, c_declaration.temp_assigns);
        c_declaration.temp_assigns &:= "=hshEmpty();\n";
      else
        if object_value not in const_table then
          const_table @:= [object_value] length(const_table);
        end if;
        process_create_declaration(objectType, global_c_expr);
        process_destr_declaration(objectType, global_c_expr);
        c_declaration.temp_assigns &:= diagnosticLine(current_object);
        c_declaration.temp_assigns &:= "o_";
        create_name(current_object, c_declaration.temp_assigns);
        c_declaration.temp_assigns &:= "=";
        param_value := "hsh[";
        param_value &:= str(const_table[object_value]);
        param_value &:= "]";
        process_create_call(objectType,
            param_value, c_declaration.temp_assigns);
        c_declaration.temp_assigns &:= ";\n";
      end if;
      param_name := "o_";
      create_name(current_object, param_name);
      process_destr_call(objectType, param_name, c_declaration.temp_frees);
    elsif valueCategory = INTERFACEOBJECT then
      if object_value not in const_table then
        const_table @:= [object_value] length(const_table);
      end if;
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=itf[";
      c_declaration.temp_assigns &:= str(const_table[object_value]);
      c_declaration.temp_assigns &:= "];\n";
      process_destr_declaration(objectType, global_c_expr);
      param_name := "o_";
      create_name(current_object, param_name);
      process_destr_call(objectType, param_name, c_declaration.temp_frees);
    elsif valueCategory = WINOBJECT then
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= "o_";
      create_name(current_object, c_declaration.temp_assigns);
      c_declaration.temp_assigns &:= "=drwCreate(";
      c_declaration.temp_assigns &:= windowLiteral(getValue(object_value, PRIMITIVE_WINDOW));
      c_declaration.temp_assigns &:= ");\n";
      c_declaration.temp_frees &:= "drwDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = PROCESSOBJECT then
      c_declaration.temp_decls &:= "=NULL";
      c_declaration.temp_frees &:= "pcsDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = PROGOBJECT then
      c_declaration.temp_decls &:= "=NULL";
      c_declaration.temp_frees &:= "prgDestr(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = DATABASEOBJECT then
      c_declaration.temp_decls &:= "=NULL";
      c_declaration.temp_frees &:= "sqlDestrDb(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = SQLSTMTOBJECT then
      c_declaration.temp_decls &:= "=NULL";
      c_declaration.temp_frees &:= "sqlDestrStmt(o_";
      create_name(current_object, c_declaration.temp_frees);
      c_declaration.temp_frees &:= ");\n";
    elsif valueCategory = CONSTENUMOBJECT then
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= enum_value(getValue(object_value, reference));
    elsif valueCategory = VARENUMOBJECT then
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= enum_value(getValue(object_value, reference));
    elsif valueCategory = ENUMLITERALOBJECT then
      c_declaration.temp_decls &:= "=o_";
      create_name(object_value, c_declaration.temp_decls);
    elsif valueCategory = CALLOBJECT then
      param_name := "o_";
      create_name(current_object, param_name);
      c_value.temp_num := c_declaration.temp_num;
      getTemporaryToResultExpr(object_value, c_value);
      c_declaration.temp_num := c_value.temp_num;
      c_expr.temp_decls   &:= c_value.temp_decls;
      c_expr.temp_assigns &:= c_value.temp_assigns;
      c_expr.temp_frees   &:= c_value.temp_frees;
      c_expr.temp_to_null &:= c_value.temp_to_null;
      c_declaration.temp_assigns &:= diagnosticLine(current_object);
      c_declaration.temp_assigns &:= param_name;
      c_declaration.temp_assigns &:= "=(";
      c_declaration.temp_assigns &:= type_name(objectType);
      c_declaration.temp_assigns &:= ")(";
      c_declaration.temp_assigns &:= c_value.result_expr;
      c_declaration.temp_assigns &:= ");\n";
      process_destr_declaration(objectType, global_c_expr);
      process_destr_call(objectType, param_name, c_declaration.temp_frees);
    elsif valueCategory = BLOCKOBJECT then
      create_name(object_value, objNumber(object_value), param_name);
      c_value.temp_num := c_declaration.temp_num;
      processFuncValue(param_name, objectType, object_value, c_value);
      c_declaration.temp_num := c_value.temp_num;
      c_declaration.temp_decls &:= "=";
      c_declaration.temp_decls &:= c_value.expr;
      c_expr.temp_decls   &:= c_value.temp_decls;
      c_expr.temp_assigns &:= c_value.temp_assigns;
      c_expr.temp_frees   &:= c_value.temp_frees;
      c_expr.temp_to_null &:= c_value.temp_to_null;
      function_declared @:= [object_value] TRUE;
      function_var_declared @:= [current_object] TRUE;
    elsif valueCategory = ACTOBJECT then
      c_declaration.temp_decls &:= "=NULL";
    else
      c_declaration.temp_decls &:= "/* ";
      c_declaration.temp_decls &:= str(valueCategory);
      c_declaration.temp_decls &:= " */";
    end if;
    c_declaration.temp_decls &:= ";\n";
    c_expr.temp_num := c_declaration.temp_num;
    c_expr.temp_decls   &:= c_declaration.temp_decls;
    c_expr.temp_assigns &:= c_declaration.temp_assigns;
    c_expr.temp_frees   &:= c_declaration.temp_frees;
    c_expr.temp_to_null &:= c_declaration.temp_to_null;
  end func;


const proc: process_local_var_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: objects is ref_list.EMPTY;
    var reference: obj is NIL;
  begin
    objects := localVars(current_object);
    for obj range objects do
      process_local_declaration(obj, getValue(obj, reference), c_expr);
    end for;
  end func;


const proc: determineDataForActualFuncParam (in reference: current_expression,
    inout ref_list: data_list) is func

  local
    var category: paramCategory is category.value;
    var ref_list: params is ref_list.EMPTY;
    var reference: aParam is NIL;
  begin
    paramCategory := category(current_expression);
    if paramCategory = MATCHOBJECT or paramCategory = CALLOBJECT then
      params := getValue(current_expression, ref_list);
      for aParam range params do
        determineDataForActualFuncParam(aParam, data_list);
      end for;
    elsif paramCategory = LOCALVOBJECT or
          paramCategory = VALUEPARAMOBJECT or
          paramCategory = REFPARAMOBJECT or
          paramCategory = RESULTOBJECT then
      if current_expression not in data_list then
        data_list &:= make_list(current_expression);
      end if;
    end if;
  end func;


const func ref_list: determineDataForActualFuncParam (in reference: current_expression) is func

  result
    var ref_list: data_list is ref_list.EMPTY;
  begin
    determineDataForActualFuncParam(current_expression, data_list);
  end func;


const proc: defineFunctype (in string: valueName, in reference: actual_param,
    in ref_list: data_list, inout expr_type: c_expr) is func
  local
    var reference: dataItem is NIL;
    var string: data_value is "";
  begin
    c_expr.expr &:= "typedef struct {\n";
    c_expr.expr &:= type_name(resultType(getType(actual_param)));
    c_expr.expr &:= " (*func) (void *data_";
    c_expr.expr &:= valueName;
    c_expr.expr &:= ");\n";
    c_expr.expr &:= "struct {\n";
    for dataItem range data_list do
      if not isVar(dataItem) then
        c_expr.expr &:= "const ";
        if useConstPrefix(dataItem) then
          c_expr.expr &:= "const_";
        end if;
      end if;
      c_expr.expr &:= type_name(getType(dataItem));
      if isFunc(getType(dataItem)) then
        c_expr.expr &:= " data_";
      else
        c_expr.expr &:= " *data_";
      end if;
      create_name(dataItem, c_expr.expr);
      c_expr.expr &:= ";\n";
      if isFunc(getType(dataItem)) then
        data_value := "((functype_";
        data_value &:= valueName;
        data_value &:= " *) data_";
        data_value &:= valueName;
        data_value &:= ")->data.data_";
        create_name(dataItem, data_value);
        data_value &:= "->func(((functype_";
        data_value &:= valueName;
        data_value &:= " *) data_";
        data_value &:= valueName;
        data_value &:= ")->data.data_";
        create_name(dataItem, data_value);
        data_value &:= ")";
        if getType(dataItem) = proctype then
          data_value &:= ";\n";
        end if;
      else
        data_value := "*((functype_";
        data_value &:= valueName;
        data_value &:= " *) data_";
        data_value &:= valueName;
        data_value &:= ")->data.data_";
        create_name(dataItem, data_value);
      end if;
      funcparam_data @:= [dataItem] data_value;
      data_value := "((functype_";
      data_value &:= valueName;
      data_value &:= " *) data_";
      data_value &:= valueName;
      data_value &:= ")->data.data_";
      create_name(dataItem, data_value);
      funcparam_reference @:= [dataItem] data_value;
    end for;
    c_expr.expr &:= "} data;\n";
    c_expr.expr &:= "} functype_";
    c_expr.expr &:= valueName;
    c_expr.expr &:= ";\n\n";
  end func;


const proc: defineActualFuncParam (in type: resultType, in string: valueName,
    in reference: actual_param, in ref_list: data_list, inout expr_type: c_expr) is func

  local
    var funcparam_data_hash: funcparam_data_backup is funcparam_data_hash.EMPTY_HASH;
    var funcparam_data_hash: funcparam_reference_backup is funcparam_data_hash.EMPTY_HASH;
    var expr_type: c_func_body is expr_type.value;
  begin
    funcparam_data_backup := funcparam_data;
    funcparam_reference_backup := funcparam_reference;
    if data_list <> ref_list.EMPTY then
      defineFunctype(valueName, actual_param, data_list, c_expr);
    end if;
    c_expr.expr &:= "static ";
    c_expr.expr &:= type_name(resultType);
    c_expr.expr &:= " func_";
    c_expr.expr &:= valueName;
    c_expr.expr &:= " (void *data_";
    c_expr.expr &:= valueName;
    c_expr.expr &:= ")\n";
    c_expr.expr &:= "{\n";
    c_func_body.demand := REQUIRE_RESULT;
    if category(actual_param) = BLOCKOBJECT then
      process_call_by_name_expr(body(actual_param), c_func_body);
    else
      process_call_by_name_expr(actual_param, c_func_body);
    end if;
    appendWithDiagnostic(c_func_body.temp_decls, c_expr);
    appendWithDiagnostic(c_func_body.temp_assigns, c_expr);
    if getType(actual_param) = proctype then
      c_expr.expr &:= c_func_body.expr;
      appendWithDiagnostic(c_func_body.temp_frees, c_expr);
    else
      if c_func_body.temp_frees <> "" then
        c_expr.expr &:= type_name(resultType);
        c_expr.expr &:= " result=";
      else
        c_expr.expr &:= diagnosticLine(actual_param);
        c_expr.expr &:= "return ";
      end if;
      if c_func_body.result_expr <> "" then
        c_expr.expr &:= c_func_body.result_expr;
      elsif valueIsAtHeap(resultType) then
        process_create_declaration(resultType, global_c_expr);
        process_create_call(resultType, c_func_body.expr, c_expr.expr);
      else
        c_expr.expr &:= c_func_body.expr;
      end if;
      c_expr.expr &:= ";\n";
      if c_func_body.temp_frees <> "" then
        appendWithDiagnostic(c_func_body.temp_frees, c_expr);
        c_expr.expr &:= "return result;\n";
      end if;
    end if;
    c_expr.expr &:= "}\n\n";
    funcparam_data := funcparam_data_backup;
    funcparam_reference := funcparam_reference_backup;
  end func;


const proc: defineFuncValue (in string: valueName, in type: genericFuncType,
    in ref_list: data_list, inout expr_type: c_expr) is func

  local
    var reference: dataItem is NIL;
  begin
    incr(c_expr.temp_num);
    if data_list <> ref_list.EMPTY then
      c_expr.temp_decls &:= "functype_";
      c_expr.temp_decls &:= valueName;
    else
      c_expr.temp_decls &:= "struct_";
      c_expr.temp_decls &:= type_name(genericFuncType);
    end if;
    c_expr.temp_decls &:= " funcvalue_";
    c_expr.temp_decls &:= valueName;
    c_expr.temp_decls &:= ";\n\n";
    c_expr.temp_assigns &:= "funcvalue_";
    c_expr.temp_assigns &:= valueName;
    c_expr.temp_assigns &:= ".func = func_";
    c_expr.temp_assigns &:= valueName;
    c_expr.temp_assigns &:= ";\n";
    for dataItem range data_list do
      c_expr.temp_assigns &:= "funcvalue_";
      c_expr.temp_assigns &:= valueName;
      c_expr.temp_assigns &:= ".data.data_";
      create_name(dataItem, c_expr.temp_assigns);
      c_expr.temp_assigns &:= " = ";
      if isFunc(getType(dataItem)) then
        c_expr.temp_assigns &:= "o_";
        create_name(dataItem, c_expr.temp_assigns);
      else
        getAnyParamToTempAssigns(dataItem, c_expr);
      end if;
      c_expr.temp_assigns &:= ";\n";
    end for;
  end func;


const proc: callActualFuncParam (in string: valueName, in type: genericFuncType,
    in ref_list: data_list, inout expr_type: c_expr) is func

  begin
    if data_list <> ref_list.EMPTY then
      c_expr.expr &:= "(";
      c_expr.expr &:= type_name(genericFuncType);
      c_expr.expr &:= " *)(";
    end if;
    c_expr.expr &:= "&funcvalue_";
    c_expr.expr &:= valueName;
    if data_list <> ref_list.EMPTY then
      c_expr.expr &:= ")";
    end if;
  end func;


const proc: processFuncValue (in string: valueName, in type: genericFuncType,
    in reference: closure, inout expr_type: c_expr) is func

  local
    var ref_list: data_list is ref_list.EMPTY;
    var expr_type: function_c_expr is expr_type.value;
  begin
    declare_type_if_necessary(genericFuncType, global_c_expr);
    data_list := determineDataForActualFuncParam(closure);
    if closure not in definedActualFuncParams then
      function_c_expr.currentFile := file(closure);
      function_c_expr.currentLine := line(closure);
      defineActualFuncParam(resultType(genericFuncType), valueName, closure,
                            data_list, function_c_expr);
      global_c_expr.expr  &:= function_c_expr.temp_decls;
      global_init.expr    &:= function_c_expr.temp_assigns;
      global_c_expr.expr  &:= function_c_expr.expr;
      definedActualFuncParams @:= [closure] TRUE;
    end if;
    defineFuncValue(valueName, genericFuncType, data_list, c_expr);
    if data_list <> ref_list.EMPTY then
      c_expr.expr &:= "(";
      c_expr.expr &:= type_name(genericFuncType);
      c_expr.expr &:= ")(";
    end if;
    c_expr.expr &:= "&funcvalue_";
    c_expr.expr &:= valueName;
    if data_list <> ref_list.EMPTY then
      c_expr.expr &:= ")";
    end if;
  end func;


const proc: processFuncParam (in reference: formal_param,
    in reference: actual_param, inout expr_type: c_expr) is func

  local
    var string: valueName is "";
  begin
    create_name(formal_param, objNumber(actual_param), valueName);
    processFuncValue(valueName, getType(formal_param), actual_param, c_expr);
  end func;


const proc: call_params (in ref_list: formal_params,
    in ref_list: actual_params, inout expr_type: c_expr) is func

  local
    var integer: number is 0;
    var reference: formal_param is NIL;
    var reference: actual_param is NIL;
    var category: paramCategory is category.value;
    var boolean: first_element is TRUE;
    var integer: temp_num is 0;
  begin
#    for number range 1 to length(formal_params) do
    for number range 1 to length(actual_params) do
      formal_param := formal_params[number];
      actual_param := actual_params[number];
      paramCategory := category(formal_param);
      if paramCategory <> SYMBOLOBJECT then
        if paramCategory = TYPEOBJECT then
          c_expr.expr &:= "/* attr t_";
          c_expr.expr &:= str(typeNumber(getValue(formal_param, type)));
          c_expr.expr &:= " ";
          c_expr.expr &:= str(getValue(formal_param, type));
          c_expr.expr &:= "*/ ";
        elsif getType(formal_param) <> voidtype then
          if first_element then
            first_element := FALSE;
          else
            c_expr.expr &:= ", ";
          end if;
          if isPointerParam(formal_param) then
            if category(actual_param) = REFPARAMOBJECT then
              if actual_param in inlineParam and
                  inlineParam[actual_param][1].paramNum <> 0 then
                c_expr.expr &:= "par_";
                c_expr.expr &:= str(inlineParam[actual_param][1].paramNum);
                c_expr.expr &:= "_";
              end if;
              if actual_param in funcparam_reference then
                c_expr.expr &:= funcparam_reference[actual_param];
              else
                c_expr.expr &:= "o_";
                create_name(actual_param, c_expr.expr);
              end if;
            elsif category(actual_param) = MATCHOBJECT then
              if getValue(actual_param, ref_list)[1] in function_var_declared then
                c_expr.expr &:= "o_";
                create_name(getValue(actual_param, ref_list)[1], c_expr.expr);
              else
                processFuncParam(formal_param, actual_param, c_expr);
              end if;
            elsif category(actual_param) = BLOCKOBJECT then
              if actual_param in function_var_declared then
                c_expr.expr &:= "o_";
                create_name(actual_param, c_expr.expr);
              else
                processFuncParam(formal_param, actual_param, c_expr);
              end if;
            elsif category(actual_param) = LOCALVOBJECT and
                actual_param in function_var_declared then
              c_expr.expr &:= "o_";
              create_name(actual_param, c_expr.expr);
            elsif canTakeAddress(actual_param) then
              c_expr.expr &:= "&(";
              process_expr(actual_param, c_expr);
              c_expr.expr &:= ")";
            else
              c_expr.expr &:= "/* ";
              c_expr.expr &:= str(category(actual_param));
              c_expr.expr &:= " */";
              incr(c_expr.temp_num);
              temp_num := c_expr.temp_num;
              c_expr.temp_decls &:= type_name(getExprResultType(actual_param));
              c_expr.temp_decls &:= " tmp_";
              c_expr.temp_decls &:= str(temp_num);
              c_expr.temp_decls &:= ";\n";
              c_expr.expr &:= "(tmp_";
              c_expr.expr &:= str(temp_num);
              c_expr.expr &:= "=(";
              c_expr.expr &:= type_name(getExprResultType(actual_param));
              c_expr.expr &:= ")(";
              getAnyParamToExpr(actual_param, c_expr);
              c_expr.expr &:= "), &tmp_";
              c_expr.expr &:= str(temp_num);
              c_expr.expr &:= ")";
            end if;
          else
            getAnyParamToExpr(actual_param, c_expr);
          end if;
        end if;
      end if;
    end for;
  end func;


const proc: process_prototype_declaration (in reference: current_object,
    inout expr_type: c_expr) is forward;


const proc: process_const_func_call (in reference: function,
    in ref_list: actual_params, inout expr_type: c_expr) is func

  local
    var type: function_type is void;
    var type: result_type is void;
    var ref_list: formal_params is ref_list.EMPTY;
    var expr_type: c_params is expr_type.value;
  begin
    if function not in prototype_declared then
      process_prototype_declaration(function, global_c_expr);
      prototype_declared @:= [function] TRUE;
    end if;
    function_type := getType(function);
    result_type := resultType(function_type);
    formal_params := formalParams(function);
    if valueIsAtHeap(result_type) and
        not isVarfunc(function_type) and
        function not in return_ref_to_value then
      prepare_typed_result(result_type, c_expr);
      c_expr.result_expr := "o_";
      create_name(function, c_expr.result_expr);
      c_expr.result_expr &:= "(";
      c_params.temp_num := c_expr.temp_num;
      call_params(formal_params, actual_params, c_params);
      c_expr.temp_num := c_params.temp_num;
      c_expr.temp_decls &:= c_params.temp_decls;
      c_expr.temp_assigns &:= c_params.temp_assigns;
      c_expr.temp_frees &:= c_params.temp_frees;
      c_expr.temp_to_null &:= c_params.temp_to_null;
      c_expr.result_expr &:= c_params.expr;
      c_expr.result_expr &:= ")";
    elsif result_type = voidtype then
      c_params.temp_num := c_expr.temp_num;
      call_params(formal_params, actual_params, c_params);
      c_expr.temp_num := c_params.temp_num;
      if c_params.temp_decls <> "" or c_params.temp_assigns <> "" then
        setDiagnosticLine(c_expr);
        c_expr.expr &:= "{\n";
        appendWithDiagnostic(c_params.temp_decls, c_expr);
        appendWithDiagnostic(c_params.temp_assigns, c_expr);
      end if;
      setDiagnosticLine(c_expr);
      if isVarfunc(function_type) then
        c_expr.expr &:= "*o_";
      else
        c_expr.expr &:= "o_";
      end if;
      create_name(function, c_expr.expr);
      c_expr.expr &:= "(";
      c_expr.expr &:= c_params.expr;
      c_expr.expr &:= ")";
      c_expr.expr &:= ";\n";
      if c_params.temp_decls <> "" or c_params.temp_assigns <> "" then
        appendWithDiagnostic(c_params.temp_frees, c_expr);
        setDiagnosticLine(c_expr);
        c_expr.expr &:= "}\n";
      end if;
    else
      if isVarfunc(function_type) then
        c_expr.expr &:= "*o_";
      else
        c_expr.expr &:= "o_";
      end if;
      create_name(function, c_expr.expr);
      c_expr.expr &:= "(";
      call_params(formal_params, actual_params, c_expr);
      c_expr.expr &:= ")";
    end if;
  end func;


const proc: process_func_call (in reference: function,
    in ref_list: actual_params, inout expr_type: c_expr) is func

  local
    var type: result_type is void;
  begin
    if isVar(function) then
      if getType(function) = proctype then
        setDiagnosticLine(c_expr);
      end if;
      result_type := resultType(getType(function));
      if valueIsAtHeap(result_type) then
        prepare_typed_result(result_type, c_expr);
        c_expr.result_expr &:= "o_";
        create_name(function, c_expr.result_expr);
        c_expr.result_expr &:= "->func(o_";
        create_name(function, c_expr.result_expr);
        c_expr.result_expr &:= ")";
      else
        c_expr.expr &:= "o_";
        create_name(function, c_expr.expr);
        c_expr.expr &:= "->func(o_";
        create_name(function, c_expr.expr);
        c_expr.expr &:= ")";
        if getType(function) = proctype then
          c_expr.expr &:= ";\n";
        end if;
      end if;
    else
      process_const_func_call(function, actual_params, c_expr);
    end if;
  end func;


const proc: process_call (in reference: current_expression, inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var reference: function is NIL;
    var category: functionCategory is category.value;
    var reference: result_object is NIL;
    var reference: obj is NIL;
    var boolean: first_element is TRUE;
  begin
    c_expr.currentFile := file(current_expression);
    c_expr.currentLine := line(current_expression);
    params := getValue(current_expression, ref_list);
    function := params[1];
    params := params[2 ..];
    functionCategory := category(function);
    # c_expr.expr &:= "/* process_call ";
    # c_expr.expr &:= str(current_expression);
    # c_expr.expr &:= " ";
    # c_expr.expr &:= str(function);
    # c_expr.expr &:= " */";
    if functionCategory = ACTOBJECT then
      process_action(function, params, c_expr);
    elsif functionCategory = BLOCKOBJECT then
      result_object := resultVar(function);
      if function in function_declared or result_object <> NIL then
        process_func_call(function, params, c_expr);
      else
        process_inline(function, params, c_expr);
      end if;
    elsif functionCategory = LOCALVOBJECT then
      process_func_call(function, params, c_expr);
    elsif functionCategory = CONSTENUMOBJECT then
      (* process_constenumobject(function, params, c_expr); *)
      process_expr(function, c_expr);
    elsif functionCategory = REFPARAMOBJECT then
      if isFunc(getType(function)) or
          isVarfunc(getType(function)) then
        if function in inlineParam then
          process_inline_param(function, c_expr);
        else
          if getType(function) = proctype then
            setDiagnosticLine(c_expr);
          end if;
          c_expr.expr &:= "o_";
          create_name(function, c_expr.expr);
          c_expr.expr &:= "->func(o_";
          create_name(function, c_expr.expr);
          c_expr.expr &:= ")";
          if getType(function) = proctype then
            c_expr.expr &:= ";\n";
          end if;
        end if;
      else
        process_expr(function, c_expr);
      end if;
    elsif functionCategory = VALUEPARAMOBJECT or
          functionCategory = INTOBJECT or
          functionCategory = BIGINTOBJECT or
          functionCategory = FLOATOBJECT or
          functionCategory = CHAROBJECT or
          functionCategory = STRIOBJECT or
          functionCategory = BSTRIOBJECT or
          functionCategory = ARRAYOBJECT or
          functionCategory = HASHOBJECT or
          functionCategory = SETOBJECT or
          functionCategory = STRUCTOBJECT or
          functionCategory = INTERFACEOBJECT or
          functionCategory = WINOBJECT or
          functionCategory = PROCESSOBJECT or
          functionCategory = PROGOBJECT or
          functionCategory = DATABASEOBJECT or
          functionCategory = SQLSTMTOBJECT or
          functionCategory = ENUMLITERALOBJECT or
          functionCategory = TYPEOBJECT then
      process_expr(function, c_expr);
    elsif functionCategory = REFOBJECT then
      c_expr.expr &:= "o_";
      create_name(function, c_expr.expr);
    elsif functionCategory = REFLISTOBJECT then
      c_expr.expr &:= "o_";
      create_name(function, c_expr.expr);
    elsif functionCategory = FORWARDOBJECT then
      error(FORWARD_CALLED, current_expression, function);
    else
      c_expr.expr &:= "/*[ ";
      c_expr.expr &:= str(functionCategory);
      c_expr.expr &:= " ]*/";
      c_expr.expr &:= "o_";
      create_name(function, c_expr.expr);
      c_expr.expr &:= "(";
      for obj range params do
        if category(obj) <> SYMBOLOBJECT then
          if first_element then
            first_element := FALSE;
          else
            c_expr.expr &:= ", ";
          end if;
          process_expr(obj, c_expr);
        end if;
      end for;
      c_expr.expr &:= ")";
    end if;
  end func;


const proc: process_match (in reference: current_expression, inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var reference: function is NIL;
    var category: functionCategory is category.value;
    var reference: result_object is NIL;
    var reference: obj is NIL;
    var boolean: first_element is TRUE;
  begin
    c_expr.currentFile := file(current_expression);
    c_expr.currentLine := line(current_expression);
    # c_expr.expr &:= "/* process_match ";
    # c_expr.expr &:= str(current_expression);
    # c_expr.expr &:= " */";
    params := getValue(current_expression, ref_list);
    function := params[1];
    params := params[2 ..];
    functionCategory := category(function);
    if functionCategory = ACTOBJECT then
      global_c_expr.expr &:= "objRefType ";
      global_c_expr.expr &:= lower(str(getValue(function, ACTION)));
      global_c_expr.expr &:= " (listType arguments);\n";
      c_expr.expr &:= "&";
      c_expr.expr &:= lower(str(getValue(function, ACTION)));
    elsif functionCategory = BLOCKOBJECT then
      c_expr.expr &:= "o_";
      create_name(function, c_expr.expr);
    else
      raise RANGE_ERROR;
      c_expr.expr &:= "/*[ ";
      c_expr.expr &:= str(functionCategory);
      c_expr.expr &:= " ]*/";
      c_expr.expr &:= "o_";
      create_name(function, c_expr.expr);
      c_expr.expr &:= "(";
      for obj range params do
        if category(obj) <> SYMBOLOBJECT then
          if first_element then
            first_element := FALSE;
          else
            c_expr.expr &:= ", ";
          end if;
          process_expr(obj, c_expr);
        end if;
      end for;
      c_expr.expr &:= ")";
    end if;
  end func;


const proc: optimize_constant_expressions (inout reference: current_expression,
    inout expr_type: c_expr) is func

  local
    var reference: evaluated_expression is NIL;
  begin
    if evaluate_const_expr = 3 and isConstantExpr(current_expression) then
      block
        evaluated_expression := evaluate(prog, current_expression);
        if evaluated_expression <> NIL and evaluated_expression <> current_expression then
          incr(countEvaluations);
          c_expr.expr &:= "/* evaluate ";
          if category(getValue(current_expression, ref_list)[1]) = ACTOBJECT then
            c_expr.expr &:= str(getValue(getValue(current_expression, ref_list)[1], ACTION));
          elsif category(getValue(current_expression, ref_list)[1]) = BLOCKOBJECT then
            c_expr.expr &:= "o_";
            create_name2(getValue(current_expression, ref_list)[1], c_expr.expr);
          end if;
          c_expr.expr &:= " */ ";
          current_expression := evaluated_expression;
          if category(current_expression) = VARENUMOBJECT then
            current_expression := getValue(current_expression, reference);
          else
            setVar(current_expression, FALSE);
          end if;
        end if;
      exception
        catch NUMERIC_ERROR:  c_expr.expr &:= "/* NUMERIC_ERROR */ "; # noop;
        catch OVERFLOW_ERROR: c_expr.expr &:= "/* OVERFLOW_ERROR */ "; # noop;
        catch RANGE_ERROR:    c_expr.expr &:= "/* RANGE_ERROR */ "; # noop;
        catch INDEX_ERROR:    c_expr.expr &:= "/* INDEX_ERROR */ "; # noop;
        catch FILE_ERROR:     c_expr.expr &:= "/* FILE_ERROR */ "; # noop;
        catch DATABASE_ERROR: c_expr.expr &:= "/* DATABASE_ERROR */ "; # noop;
      end block;
    end if;
  end func;


const proc: process_expr (in var reference: current_expression, inout expr_type: c_expr) is func

  local
    var category: exprCategory is category.value;
  begin
    optimize_constant_expressions(current_expression, c_expr);
    exprCategory := category(current_expression);
    if exprCategory = MATCHOBJECT then
      process_match(current_expression, c_expr);
    elsif exprCategory = CALLOBJECT then
      process_call(current_expression, c_expr);
    elsif exprCategory = BLOCKOBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
      if not isVar(current_expression) then
        c_expr.expr &:= "()";
        if resultType(getType(current_expression)) = voidtype then
          c_expr.expr &:= ";\n";
        end if;
      end if;
    elsif exprCategory = ACTOBJECT then
      global_c_expr.expr &:= "objRefType ";
      global_c_expr.expr &:= lower(str(getValue(current_expression, ACTION)));
      global_c_expr.expr &:= " (listType arguments);\n";
      c_expr.expr &:= "&";
      c_expr.expr &:= lower(str(getValue(current_expression, ACTION)));
    elsif exprCategory = LOCALVOBJECT then
      if current_expression in funcparam_data then
        c_expr.expr &:= funcparam_data[current_expression];
      else
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      end if;
    elsif exprCategory = VALUEPARAMOBJECT then
      if current_expression in funcparam_data then
        c_expr.expr &:= funcparam_data[current_expression];
      elsif current_expression in inlineParam and
          inlineParam[current_expression][1].paramValue <> NIL then
        process_expr(inlineParam[current_expression][1].paramValue, c_expr);
      else
        if current_expression in inlineParam and
            inlineParam[current_expression][1].paramNum <> 0 then
          c_expr.expr &:= "par_";
          c_expr.expr &:= str(inlineParam[current_expression][1].paramNum);
          c_expr.expr &:= "_";
        end if;
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      end if;
    elsif exprCategory = REFPARAMOBJECT then
      if current_expression in funcparam_data then
        c_expr.expr &:= funcparam_data[current_expression];
      elsif isFunc(getType(current_expression)) or
          isVarfunc(getType(current_expression)) then
        if current_expression in inlineParam then
          process_inline_param(current_expression, c_expr);
        else
          if getType(current_expression) = proctype then
            setDiagnosticLine(c_expr);
          end if;
          c_expr.expr &:= "o_";
          create_name(current_expression, c_expr.expr);
          c_expr.expr &:= "->func(o_";
          create_name(current_expression, c_expr.expr);
          c_expr.expr &:= ")";
          if getType(current_expression) = proctype then
            c_expr.expr &:= ";\n";
          end if;
        end if;
      elsif current_expression in inlineParam and
          inlineParam[current_expression][1].paramValue <> NIL then
        process_expr(inlineParam[current_expression][1].paramValue, c_expr);
      else
        if isPointerParam(current_expression) then
          c_expr.expr &:= "*";
        end if;
        if current_expression in inlineParam and
            inlineParam[current_expression][1].paramNum <> 0 then
          c_expr.expr &:= "par_";
          c_expr.expr &:= str(inlineParam[current_expression][1].paramNum);
          c_expr.expr &:= "_";
        end if;
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      end if;
    elsif exprCategory = RESULTOBJECT then
      if current_expression in funcparam_data then
        c_expr.expr &:= funcparam_data[current_expression];
      else
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      end if;
    elsif exprCategory = TYPEOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= typeLiteral(getValue(current_expression, type));
      end if;
    elsif exprCategory = INTOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= integerLiteral(getValue(current_expression, integer));
      end if;
    elsif exprCategory = BIGINTOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= bigIntegerLiteral(getValue(current_expression, bigInteger));
      end if;
    elsif exprCategory = FLOATOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= floatLiteral(getValue(current_expression, float));
      end if;
    elsif exprCategory = CHAROBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= charLiteral(getValue(current_expression, char));
      end if;
    elsif exprCategory = STRIOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= stringLiteral(getValue(current_expression, string));
      end if;
    elsif exprCategory = BSTRIOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= bstriLiteral(getValue(current_expression, bstring));
      end if;
    elsif exprCategory = SETOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= "(";
        c_expr.expr &:= type_name(getType(current_expression));
        c_expr.expr &:= ")(";
        c_expr.expr &:= bitsetLiteral(getValue(current_expression, bitset));
        c_expr.expr &:= ")";
      end if;
    elsif exprCategory = REFOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if getValue(current_expression, reference) = NIL then
          c_expr.expr &:= "NULL";
        else
          c_expr.expr &:= "&(";
          process_expr(getValue(current_expression, reference), c_expr);
          c_expr.expr &:= ")";
        end if;
      end if;
    elsif exprCategory = REFLISTOBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
    elsif exprCategory = ARRAYOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if current_expression not in const_table then
          const_table @:= [current_expression] length(const_table);
        end if;
        c_expr.expr &:= "arr[";
        c_expr.expr &:= str(const_table[current_expression]);
        c_expr.expr &:= "]";
      end if;
    elsif exprCategory = STRUCTOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if current_expression not in const_table then
          const_table @:= [current_expression] length(const_table);
        end if;
        c_expr.expr &:= "sct[";
        c_expr.expr &:= str(const_table[current_expression]);
        c_expr.expr &:= "]";
      end if;
    elsif exprCategory = HASHOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if current_expression not in const_table then
          const_table @:= [current_expression] length(const_table);
        end if;
        c_expr.expr &:= "hsh[";
        c_expr.expr &:= str(const_table[current_expression]);
        c_expr.expr &:= "]";
      end if;
    elsif exprCategory = INTERFACEOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if current_expression not in const_table then
          const_table @:= [current_expression] length(const_table);
        end if;
        c_expr.expr &:= "itf[";
        c_expr.expr &:= str(const_table[current_expression]);
        c_expr.expr &:= "]";
      end if;
    elsif exprCategory = FILEOBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
    elsif exprCategory = SOCKETOBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
    elsif exprCategory = POLLOBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
    elsif exprCategory = WINOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= windowLiteral(getValue(current_expression, PRIMITIVE_WINDOW));
      end if;
    elsif exprCategory = PROCESSOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if getValue(current_expression, process) = process.EMPTY then
          c_expr.expr &:= "/*process.EMPTY*/NULL";
        else
          c_expr.expr &:= "o_";
          create_name(current_expression, c_expr.expr);
        end if;
      end if;
    elsif exprCategory = PROGOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        if getValue(current_expression, program) = program.EMPTY then
          c_expr.expr &:= "/*program.EMPTY*/NULL";
        else
          c_expr.expr &:= "o_";
          create_name(current_expression, c_expr.expr);
        end if;
      end if;
    elsif exprCategory = DATABASEOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= "/*database.value*/NULL";
      end if;
    elsif exprCategory = SQLSTMTOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= "/*sqlStatement.value*/NULL";
      end if;
    elsif exprCategory = CONSTENUMOBJECT then
      if isVar(current_expression) then
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      else
        c_expr.expr &:= enum_value(getValue(current_expression, reference));
      end if;
    elsif exprCategory = VARENUMOBJECT then
      if current_expression in funcparam_data then
        c_expr.expr &:= funcparam_data[current_expression];
      else
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      end if;
    elsif exprCategory = ENUMLITERALOBJECT then
      if getType(current_expression) = voidtype then
        c_expr.expr &:= "/* empty */\n";
      else
        c_expr.expr &:= "o_";
        create_name(current_expression, c_expr.expr);
      end if;
    elsif exprCategory = EXPROBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
    elsif exprCategory = SYMBOLOBJECT then
      c_expr.expr &:= "/* SYMBOLOBJECT ";
      c_expr.expr &:= str(current_expression);
      c_expr.expr &:= " */";
    else
      c_expr.expr &:= "/* ";
      c_expr.expr &:= str(exprCategory);
      c_expr.expr &:= " */";
    end if;
  end func;


const proc: process_call_by_name_expr (in var reference: current_expression, inout expr_type: c_expr) is func

  local
    var reference: evaluated_expression is NIL;
    var category: exprCategory is category.value;
  begin
    exprCategory := category(current_expression);
    if exprCategory = MATCHOBJECT then
      process_call(current_expression, c_expr);
    elsif exprCategory = LOCALVOBJECT then
      if isFunc(getType(current_expression)) or
          isVarfunc(getType(current_expression)) then
        process_func_call(current_expression, ref_list.EMPTY, c_expr);
      else
        process_expr(current_expression, c_expr);
      end if;
    elsif exprCategory = BLOCKOBJECT then
      c_expr.expr &:= "o_";
      create_name(current_expression, c_expr.expr);
      if not isVar(current_expression) then
        c_expr.expr &:= "()";
        if resultType(getType(current_expression)) = voidtype then
          c_expr.expr &:= ";\n";
        end if;
      end if;
    elsif exprCategory = ACTOBJECT then
      c_expr.expr &:= "/* process_call_by_name_expr ACTOBJECT ";
      c_expr.expr &:= str(getValue(current_expression, ACTION));
      c_expr.expr &:= " */";
      process_action(current_expression, ref_list.EMPTY, c_expr);
    else
      process_expr(current_expression, c_expr);
    end if;
  end func;


const proc: declare_types_of_params (in ref_list: formal_params, inout expr_type: c_expr) is func

  local
    var reference: formal_param is NIL;
    var category: paramCategory is category.value;
  begin
    for formal_param range formal_params do
      paramCategory := category(formal_param);
      if paramCategory <> SYMBOLOBJECT and paramCategory <> TYPEOBJECT then
        declare_type_if_necessary(getType(formal_param), c_expr);
      end if;
    end for;
  end func;


const proc: process_param_declaration (in reference: formal_param, inout expr_type: c_expr) is func

  local
    var type: param_type is void;
    var string: param_name is "";
  begin
    param_type := getType(formal_param);
    if isPointerParam(formal_param) then
      if isFunc(param_type) or isVarfunc(param_type) then
        c_expr.expr &:= type_name(param_type);
        c_expr.expr &:= " o_";
        create_name(formal_param, c_expr.expr);
      else
        if not isVar(formal_param) then
          c_expr.expr &:= "const ";
        end if;
        c_expr.expr &:= type_name(param_type);
        c_expr.expr &:= " *const o_";
        create_name(formal_param, c_expr.expr);
      end if;
    elsif isCopyParam(formal_param) then
      create_name(formal_param, param_name);
      c_expr.expr &:= "const ";
      if useConstPrefix(formal_param) then
        c_expr.expr &:= "const_";
      end if;
      c_expr.expr &:= type_name(param_type);
      c_expr.expr &:= " value_o_";
      c_expr.expr &:= param_name;
      if not isVar(formal_param) and useConstPrefix(param_type) then
        c_expr.temp_decls &:= "const_";
      end if;
      c_expr.temp_decls &:= type_name(param_type);
      c_expr.temp_decls &:= " o_";
      c_expr.temp_decls &:= param_name;
      c_expr.temp_decls &:= ";\n";
      c_expr.temp_assigns &:= "o_";
      c_expr.temp_assigns &:= param_name;
      c_expr.temp_assigns &:= "=";
      process_create_declaration(param_type, global_c_expr);
      process_create_call(param_type,
          "value_o_" & param_name, c_expr.temp_assigns);
      c_expr.temp_assigns &:= ";\n";
      process_destr_declaration(param_type, global_c_expr);
      process_destr_call(param_type,
          "o_" & param_name, c_expr.temp_frees);
    else
      if not isVar(formal_param) then
        c_expr.expr &:= "const ";
        if useConstPrefix(formal_param) then
          c_expr.expr &:= "const_";
        end if;
      end if;
      c_expr.expr &:= type_name(param_type);
      c_expr.expr &:= " o_";
      create_name(formal_param, c_expr.expr);
    end if;
  end func;


const proc: process_param_list_declaration (in ref_list: formal_params, inout expr_type: c_expr) is func

  local
    var reference: formal_param is NIL;
    var category: paramCategory is category.value;
    var boolean: first_element is TRUE;
  begin
    for formal_param range formal_params do
      paramCategory := category(formal_param);
      if paramCategory <> SYMBOLOBJECT then
        if paramCategory = TYPEOBJECT then
          c_expr.expr &:= "/* attr t_";
          c_expr.expr &:= str(typeNumber(getValue(formal_param, type)));
          c_expr.expr &:= " ";
          c_expr.expr &:= str(getValue(formal_param, type));
          c_expr.expr &:= "*/ ";
        elsif getType(formal_param) <> voidtype then
          if first_element then
            first_element := FALSE;
          else
            c_expr.expr &:= ", ";
          end if;
          process_param_declaration(formal_param, c_expr);
        end if;
      end if;
    end for;
    if first_element then
      c_expr.expr &:= "void";
    end if;
  end func;


const proc: process_result_declaration (in reference: result_object,
    in var reference: result_init, inout expr_type: c_expr) is func

  local
    var reference: evaluatedExpr is NIL;
  begin
    if result_object <> NIL then
      if evaluate_const_expr >= 2 and isConstant(result_init) then
        block
          evaluatedExpr := evaluate(prog, result_init);
          if evaluatedExpr <> NIL then
            incr(countEvaluations);
            result_init := evaluatedExpr;
          end if;
        exception
          catch NUMERIC_ERROR:  noop;
          catch OVERFLOW_ERROR: noop;
          catch RANGE_ERROR:    noop;
          catch INDEX_ERROR:    noop;
          catch FILE_ERROR:     noop;
          catch DATABASE_ERROR: noop;
        end block;
      end if;
      process_local_declaration(result_object, result_init, c_expr);
    end if;
  end func;


const proc: process_return (in reference: result_object,
    inout expr_type: c_expr) is func

  begin
    if result_object <> NIL then
      c_expr.expr &:= "return o_";
      create_name(result_object, c_expr.expr);
      c_expr.expr &:= ";\n";
    end if;
  end func;


const proc: process_return_value (in reference: function,
    in type: result_type, in expr_type: c_func_body,
    inout expr_type: c_expr) is func

  begin
    if isVarfunc(getType(function)) then
      c_expr.expr &:= "&(";
      if c_func_body.result_expr <> "" then
        c_expr.expr &:= c_func_body.result_expr;
      else
        c_expr.expr &:= c_func_body.expr;
      end if;
    else
      c_expr.expr &:= "(";
      if c_func_body.result_expr <> "" then
        c_expr.expr &:= c_func_body.result_expr;
      else
        if function in prototype_declared then
          process_create_declaration(result_type, global_c_expr);
          process_create_call(result_type, c_func_body.expr, c_expr.expr);
        else
          if valueIsAtHeap(result_type) then
            return_ref_to_value @:= [function] TRUE;
            c_expr.expr &:= "/*ref_to_value*/ ";
          end if;
          c_expr.expr &:= c_func_body.expr;
        end if;
      end if;
    end if;
    c_expr.expr &:= ")";
  end func;


const proc: process_local_consts (in reference: function,
    inout expr_type: c_expr) is forward;


const proc: process_const_func_declaration (in reference: function,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_local_consts is expr_type.value;
    var expr_type: c_param_list is expr_type.value;
    var expr_type: c_result is expr_type.value;
    var expr_type: c_local_vars is expr_type.value;
    var expr_type: c_func_body is expr_type.value;
    var type: function_type is void;
    var type: result_type is void;
    var ref_list: param_list is ref_list.EMPTY;
    var reference: result_object is NIL;
    var reference: result_init is NIL;
  begin
    function_type := getType(function);
    result_type := resultType(function_type);
    param_list := formalParams(function);
    result_object := resultVar(function);
    if param_list_okay(param_list) or
        recursiveFunctionCall(function, body(function)) or
        result_object <> NIL then
      # Try to process the function declaration always.
      # The variable write_object_declaration is used to
      # decide if the function declaration should be written
      function_declared @:= [function] TRUE;
      declare_types_of_params(param_list, global_c_expr);
      c_local_consts.currentFile := c_expr.currentFile;
      c_local_consts.currentLine := c_expr.currentLine;
      process_local_consts(function, c_local_consts);
      global_c_expr.expr  &:= c_local_consts.temp_decls;
      global_init.expr    &:= c_local_consts.temp_assigns;
      global_c_expr.expr  &:= c_local_consts.expr;
      c_expr.expr &:= diagnosticLine(function);
      c_expr.expr &:= "static ";
      c_expr.expr &:= type_name(result_type);
      if isVarfunc(getType(function)) then
        c_expr.expr &:= " /*varfunc*/ *o_";
      else
        c_expr.expr &:= " o_";
      end if;
      create_name(function, c_expr.expr);
      c_expr.expr &:= " (";
      process_param_list_declaration(param_list, c_param_list);
      c_expr.expr &:= c_param_list.expr;
      c_expr.expr &:= ")\n";
      c_expr.expr &:= "{\n";
      if function_type <> proctype and result_object = NIL then
        if isFunctionCallingSpecialAction(function) then
          write_object_declaration := FALSE;
        end if;
        c_func_body.demand := REQUIRE_RESULT;
        currentProfiledFunction := function;
        process_expr(body(function), c_func_body);
        if c_param_list.temp_decls <> "" or c_func_body.temp_decls <> "" or
            trace_function or profile_function then
          c_expr.currentFile := file(body(function));
          c_expr.currentLine := line(body(function));
          setDiagnosticLine(c_expr);
          c_expr.expr &:= type_name(result_type);
          if isVarfunc(getType(function)) then
            c_expr.expr &:= " *result;\n";
          else
            c_expr.expr &:= " result;\n";
          end if;
          appendWithDiagnostic(c_param_list.temp_decls, c_expr);
          appendWithDiagnostic(c_func_body.temp_decls, c_expr);
          if trace_function then
            c_expr.expr &:= "printf(\"-> ";
            create_name(function, c_expr.expr);
            c_expr.expr &:= "\\n\");\n";
            c_expr.expr &:= "fflush(stdout);\n";
          end if;
          if profile_function then
            profiledFunctions @:= [objNumber(function)] function;
            c_expr.expr &:= "profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].count++;\n";
            c_expr.expr &:= "if (profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].depth == 0) {\n";
            c_expr.expr &:= "  profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].time -= timMicroSec();\n";
            c_expr.expr &:= "}\n";
            c_expr.expr &:= "profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].depth++;\n";
          end if;
          appendWithDiagnostic(c_param_list.temp_assigns, c_expr);
          appendWithDiagnostic(c_func_body.temp_assigns, c_expr);
          setDiagnosticLine(c_expr);
          c_expr.expr &:= "result=(";
          c_expr.expr &:= type_name(result_type);
          if isVarfunc(getType(function)) then
            c_expr.expr &:= " *";
          end if;
          c_expr.expr &:= ")(";
          process_return_value(function, result_type, c_func_body, c_expr);
          c_expr.expr &:= ");\n";
          appendWithDiagnostic(c_param_list.temp_frees, c_expr);
          appendWithDiagnostic(c_func_body.temp_frees, c_expr);
          if profile_function then
            c_expr.expr &:= "profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].depth--;\n";
            c_expr.expr &:= "if (profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].depth == 0) {\n";
            c_expr.expr &:= "  profile[";
            c_expr.expr &:= str(objNumber(function));
            c_expr.expr &:= "].time += timMicroSec();\n";
            c_expr.expr &:= "}\n";
          end if;
          if trace_function then
            c_expr.expr &:= "printf(\"<- ";
            create_name(function, c_expr.expr);
            c_expr.expr &:= "\\n\");\n";
            c_expr.expr &:= "fflush(stdout);\n";
          end if;
          setDiagnosticLine(c_expr);
          c_expr.expr &:= "return result;\n";
        else
          c_expr.expr &:= diagnosticLine(body(function));
          c_expr.expr &:= "return (";
          c_expr.expr &:= type_name(result_type);
          if isVarfunc(getType(function)) then
            c_expr.expr &:= " *";
          end if;
          c_expr.expr &:= ")(";
          process_return_value(function, result_type, c_func_body, c_expr);
          c_expr.expr &:= ");\n";
        end if;
      else
        result_init := resultInitValue(function);
        c_result.temp_num := c_expr.temp_num;
        process_result_declaration(result_object, result_init, c_result);
        c_local_vars.temp_num := c_result.temp_num;
        process_local_var_declaration(function, c_local_vars);
        c_expr.temp_num := c_local_vars.temp_num;
        currentProfiledFunction := function;
        process_expr(body(function), c_func_body);
        c_expr.currentFile := file(function);
        c_expr.currentLine := line(function);
        appendWithDiagnostic(c_param_list.temp_decls, c_expr);
        c_expr.expr &:= c_result.temp_decls;
        c_expr.expr &:= c_local_vars.temp_decls;
        appendWithDiagnostic(c_func_body.temp_decls, c_expr);
        if trace_function then
          c_expr.expr &:= "printf(\"-> ";
          create_name(function, c_expr.expr);
          c_expr.expr &:= "\\n\");\n";
          c_expr.expr &:= "fflush(stdout);\n";
        end if;
        if profile_function then
          profiledFunctions @:= [objNumber(function)] function;
          c_expr.expr &:= "profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].count++;\n";
          c_expr.expr &:= "if (profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].depth == 0) {\n";
          c_expr.expr &:= "  profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].time -= timMicroSec();\n";
          c_expr.expr &:= "}\n";
          c_expr.expr &:= "profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].depth++;\n";
        end if;
        appendWithDiagnostic(c_param_list.temp_assigns, c_expr);
        c_expr.expr &:= c_result.temp_assigns;
        c_expr.expr &:= c_local_vars.temp_assigns;
        appendWithDiagnostic(c_func_body.temp_assigns, c_expr);
        c_expr.expr &:= c_func_body.expr;
        appendWithDiagnostic(c_param_list.temp_frees, c_expr);
        appendWithDiagnostic(c_local_vars.temp_frees, c_expr);
        appendWithDiagnostic(c_func_body.temp_frees, c_expr);
        if profile_function then
          c_expr.expr &:= "profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].depth--;\n";
          c_expr.expr &:= "if (profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].depth == 0) {\n";
          c_expr.expr &:= "  profile[";
          c_expr.expr &:= str(objNumber(function));
          c_expr.expr &:= "].time += timMicroSec();\n";
          c_expr.expr &:= "}\n";
        end if;
        if trace_function then
          c_expr.expr &:= "printf(\"<- ";
          create_name(function, c_expr.expr);
          c_expr.expr &:= "\\n\");\n";
          c_expr.expr &:= "fflush(stdout);\n";
        end if;
        process_return(result_object, c_expr);
      end if;
      c_expr.expr &:= "}\n";
      c_expr.expr &:= noDiagnosticLine;
      c_expr.expr &:= "\n";
      if write_object_declaration then
        prototype_declared @:= [function] TRUE;
        count_declarations(c_expr);
      else
        excl(function_declared, function);
        c_expr.expr &:= "/* declare inline o_";
        create_name2(function, c_expr.expr);
        c_expr.expr &:= "*/\n\n";
      end if;
    else
      c_expr.expr &:= "/* declare inline o_";
      create_name2(function, c_expr.expr);
      c_expr.expr &:= "*/\n\n";
    end if;
  end func;


const proc: process_library_initialisation (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var string: libraryName is "";
  begin
    libraryName := name(prog);
    c_expr.expr &:= "void init_";
    c_expr.expr &:= libraryName;
    c_expr.expr &:= " (void)\n";
    c_expr.expr &:= "{\n";
    c_expr.expr &:= "init_values();\n";
    c_expr.expr &:= "init_globals();\n";
    c_expr.expr &:= "}\n";
    c_expr.expr &:= "\n";
    prototype_declared @:= [current_object] TRUE;
    count_declarations(c_expr);
  end func;


const proc: process_main_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_local_vars is expr_type.value;
    var expr_type: c_func_body is expr_type.value;
    var string: main_prolog is "";
    var string: main_epilog is "";
  begin
    if category(current_object) = BLOCKOBJECT then
      function_declared @:= [current_object] TRUE;
      process_local_consts(current_object, c_expr);
      c_local_vars.temp_num := c_expr.temp_num;
      process_local_var_declaration(current_object, c_local_vars);
      currentProfiledFunction := main_object;
      c_func_body.temp_num := c_local_vars.temp_num;
      process_expr(body(current_object), c_func_body);
      c_expr.temp_num := c_func_body.temp_num;
    elsif category(current_object) = ACTOBJECT then
      currentProfiledFunction := main_object;
      c_func_body.temp_num := c_local_vars.temp_num;
      process_expr(current_object, c_func_body);
      c_expr.temp_num := c_func_body.temp_num;
    end if;
    c_expr.currentFile := file(current_object);
    c_expr.currentLine := line(current_object);
    if ccConf.USE_WMAIN then
      main_prolog := "int wmain (int argc, wchar_t **argv)\n";
    elsif ccConf.USE_WINMAIN then
      main_prolog := "int WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance, char *lpCmdLine, int nShowCmd)\n";
    else
      main_prolog := "int main (int argc, char **argv)\n";
    end if;
    main_prolog &:= "\n";
    main_prolog &:= "{\n";
    main_prolog &:= "int fail_value;\n";
    main_prolog &:= "catch_stack_pos = 0;\n";
    main_prolog &:= "max_catch_stack = 128;\n";
    if trace_function then
      main_prolog &:= "printf(\"-> main\\n\");\n";
      main_prolog &:= "fflush(stdout);\n";
    end if;
    if profile_function then
      main_prolog &:= "initProfile();\n";
      profiledFunctions @:= [objNumber(main_object)] main_object;
      main_prolog &:= "profile[";
      main_prolog &:= str(objNumber(main_object));
      main_prolog &:= "].count++;\n";
      main_prolog &:= "if (profile[";
      main_prolog &:= str(objNumber(main_object));
      main_prolog &:= "].depth == 0) {\n";
      main_prolog &:= "  profile[";
      main_prolog &:= str(objNumber(main_object));
      main_prolog &:= "].time -= timMicroSec();\n";
      main_prolog &:= "}\n";
      main_prolog &:= "profile[";
      main_prolog &:= str(objNumber(main_object));
      main_prolog &:= "].depth++;\n";
    end if;
    main_prolog &:= "catch_stack = (catch_type *)(malloc(max_catch_stack * sizeof(catch_type)));\n";
    main_prolog &:= "if ((fail_value = do_setjmp(catch_stack[catch_stack_pos])) == 0) {\n";
    main_prolog &:= "setupStack();\n";
    main_prolog &:= "setupRand();\n";
    main_prolog &:= "setupFiles();\n";
    if ccConf.USE_WINMAIN then
      main_prolog &:= "arg_v = getArgv(0, NULL, &arg_0, &programName, &programPath);\n";
    else
      main_prolog &:= "arg_v = getArgv(argc, argv, &arg_0, &programName, &programPath);\n";
    end if;
    main_prolog &:= "setupFloat();\n";
    main_prolog &:= "setupBig();\n";
    main_prolog &:= "init_values();\n";
    main_prolog &:= "setupSignalHandlers(1, " <& ord(trace_signal) <&  ", " <&
                                         ord(ccConf.OVERFLOW_SIGNAL <> "") <&
                                         ", 1, NULL);\n";
    main_prolog &:= "init_globals();\n";
    main_prolog &:= "{\n";

    if ccConf.USE_WINMAIN then
      c_expr.expr &:= "typedef struct {\n";
      c_expr.expr &:= "    int dummy;\n";
      c_expr.expr &:= "  } HINSTANCE__;\n";
      c_expr.expr &:= "typedef HINSTANCE__* HINSTANCE;\n";
      c_expr.expr &:= "\n";
    end if;
    appendWithDiagnostic(main_prolog, c_expr);
    c_expr.expr &:= c_local_vars.temp_decls;
    appendWithDiagnostic(c_func_body.temp_decls, c_expr);
    c_expr.expr &:= c_local_vars.temp_assigns;
    appendWithDiagnostic(c_func_body.temp_assigns, c_expr);
    c_expr.expr &:= c_func_body.expr;
    appendWithDiagnostic(c_local_vars.temp_frees, c_expr);
    appendWithDiagnostic(c_func_body.temp_frees, c_expr);
    c_expr.expr &:= "}\n";
    c_expr.expr &:= global_init.temp_frees;

    if profile_function then
      main_epilog &:= "profile[";
      main_epilog &:= str(objNumber(main_object));
      main_epilog &:= "].depth--;\n";
      main_epilog &:= "if (profile[";
      main_epilog &:= str(objNumber(main_object));
      main_epilog &:= "].depth == 0) {\n";
      main_epilog &:= "  profile[";
      main_epilog &:= str(objNumber(main_object));
      main_epilog &:= "].time += timMicroSec();\n";
      main_epilog &:= "}\n";
      main_epilog &:= "{\n";
      main_epilog &:= "  FILE *profile_file;\n";
      main_epilog &:= "  int index;\n";
      main_epilog &:= "  profile_file = fopen(\"profile_out\", \"wb\");\n";
      main_epilog &:= "  if (profile_file != NULL) {\n";
      main_epilog &:= "    qsort(profile, profile_size, sizeof(struct profileElement),\n";
      main_epilog &:= "          cmpProfileElement);\n";
      main_epilog &:= "    fprintf(profile_file, \"usecs\\tcalls\\tplace\\tname\\n\");\n";
      main_epilog &:= "    for (index = 0; index < profile_size; index++) {\n";
      main_epilog &:= "      if (profile[index].count != 0) {\n";
      main_epilog &:= "        if (profile[index].depth == 0) {\n";
      main_epilog &:= "          fprintf(profile_file, \"%ld\\t%ld\\t%s(%lu)\\t%s\\n\",\n";
      main_epilog &:= "                  (long) profile[index].time, (long) profile[index].count,\n";
      main_epilog &:= "                  profile[index].file, (long unsigned) profile[index].line,\n";
      main_epilog &:= "                  profile[index].name);\n";
      main_epilog &:= "        } else {\n";
      main_epilog &:= "          fprintf(profile_file, \"*%ld\\t%ld\\t%s(%lu)\\t%s\\n\",\n";
      main_epilog &:= "                  (long) (profile[index].time + timMicroSec()), (long) profile[index].count,\n";
      main_epilog &:= "                  profile[index].file, (long unsigned) profile[index].line,\n";
      main_epilog &:= "                  profile[index].name);\n";
      main_epilog &:= "        }\n";
      main_epilog &:= "      }\n";
      main_epilog &:= "    }\n";
      main_epilog &:= "    fclose(profile_file);\n";
      main_epilog &:= "  }\n";
      main_epilog &:= "}\n";
    end if;
    if trace_function then
      main_epilog &:= "printf(\"<- main\\n\");\n";
      main_epilog &:= "fflush(stdout);\n";
    end if;
    main_epilog &:= "return 0;\n";
    main_epilog &:= "} else {\n";
    main_epilog &:= "  printf(\"\\n*** Uncaught exception \");\n";
    main_epilog &:= "  if (fail_value >= 0 && fail_value < sizeof(exception_name) / sizeof(char *)) {\n";
    main_epilog &:= "    printf(\"%s\", exception_name[fail_value]);\n";
    main_epilog &:= "  } else {\n";
    main_epilog &:= "    printf(\"%d\", fail_value);\n";
    main_epilog &:= "  }\n";
    main_epilog &:= "  printf(\" raised\");\n";
    main_epilog &:= "  if (error_file != NULL) {\n";
    main_epilog &:= "    printf(\" at %s(%d)\", error_file, error_line);\n";
    main_epilog &:= "  }\n";
    main_epilog &:= "  printf(\"\\n\");\n";
    if databaseLibraryUsed then
      main_epilog &:= "  if (fail_value == 6 /*DATABASE_ERROR*/) {\n";
      main_epilog &:= "    striType message;\n";
      main_epilog &:= "    message = sqlErrMessage();\n";
      main_epilog &:= "    printf(\"\\nMessage from the DATABASE_ERROR exception:\\n\");\n";
      if consoleLibraryUsed then
        main_epilog &:= "    conWrite(message);\n";
      else
        main_epilog &:= "    ut8Write(&stdoutFileRecord, message);\n";
      end if;
      main_epilog &:= "    printf(\"\\n\");\n";
      main_epilog &:= "    strDestr(message);\n";
      main_epilog &:= "  }\n";
    end if;
    main_epilog &:= "  return 1;\n";
    main_epilog &:= "}\n";
    main_epilog &:= "}\n";

    appendWithDiagnostic(main_epilog, c_expr);
    c_expr.expr &:= noDiagnosticLine;
    c_expr.expr &:= "\n";
    prototype_declared @:= [current_object] TRUE;
    count_declarations(c_expr);
  end func;


const proc: process_var_func_declaration (in reference: function,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_value is expr_type.value;
    var string: valueName is "";
  begin
    declare_type_if_necessary(getType(function), global_c_expr);
    create_name(function, objNumber(function), valueName);
    processFuncValue(valueName, getType(function), function, c_value);
    c_expr.expr &:= c_value.temp_decls;
    global_init.expr &:= diagnosticLine(function);
    global_init.expr &:= c_value.temp_assigns;
    c_expr.expr &:= type_name(getType(function));
    c_expr.expr &:= " o_";
    create_name(function, c_expr.expr);
    c_expr.expr &:= " = ";
    c_expr.expr &:= c_value.expr;
    c_expr.expr &:= ";\n\n";
    function_declared @:= [function] TRUE;
    function_var_declared @:= [function] TRUE;
  end func;


const proc: process_func_declaration (in reference: function,
    inout expr_type: c_expr) is func

  begin
    if isVar(function) then
      process_var_func_declaration(function, c_expr);
    else
      process_const_func_declaration(function, c_expr);
    end if;
  end func;


const proc: process_prototype_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_param_list is expr_type.value;
    var type: current_type is void;
    var type: result_type is void;
    var ref_list: param_list is ref_list.EMPTY;
  begin
    current_type := getType(current_object);
    if isFunc(current_type) or isVarfunc(current_type) then
      result_type := resultType(current_type);
      param_list := formalParams(current_object);
      function_declared @:= [current_object] TRUE;
      declare_types_of_params(param_list, global_c_expr);
      c_expr.expr &:= "static ";
      c_expr.expr &:= type_name(result_type);
      if isVarfunc(current_type) then
        c_expr.expr &:= " *o_";
      else
        c_expr.expr &:= " o_";
      end if;
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= " (";
      process_param_list_declaration(param_list, c_param_list);
      c_expr.expr &:= c_param_list.expr;
      c_expr.expr &:= ");\n\n";
    else
      c_expr.expr &:= "extern ";
      c_expr.expr &:= type_name(current_type);
      c_expr.expr &:= " o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
    end if;
  end func;


const proc: process_forward_declaration (in reference: fwd_ref,
    inout expr_type: c_expr) is func

  local
    var reference: function is NIL;
  begin
    function := getValue(fwd_ref, reference);
    if function not in prototype_declared then
      process_prototype_declaration(function, c_expr);
      prototype_declared @:= [function] TRUE;
    end if;
  end func;


const proc: process_type_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var type: aType is void;
  begin
    if isVar(current_object) then
      c_expr.expr &:= "typeType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=";
      global_init.expr &:= typeLiteral(getValue(current_object, type));
      global_init.expr &:= ";\n";
    else
      aType := getValue(current_object, type);
      declare_type_if_necessary(aType, c_expr);
    end if;
    count_declarations(c_expr);
  end func;


const proc: process_int_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "intType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=";
      c_expr.expr &:= integerLiteral(getValue(current_object, integer));
      c_expr.expr &:= ";\n\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_bigint_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "bigIntType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=";
      process_big_create_call(getValue(current_object, bigInteger), global_init.expr);
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_char_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "charType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=";
      c_expr.expr &:= charLiteral(getValue(current_object, char));
      c_expr.expr &:= ";\n\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_stri_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "striType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=";
      process_str_create_call(getValue(current_object, string), global_init.expr);
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_bstri_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "bstriType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=bstCreate(";
      global_init.expr &:= bstriLiteral(getValue(current_object, bstring));
      global_init.expr &:= ");\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_float_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "floatType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=";
      c_expr.expr &:= floatLiteral(getValue(current_object, float));
      c_expr.expr &:= ";\n\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: action_address (in reference: function, inout expr_type: c_expr) is func

  local
    var ACTION: current_action is action "PRC_NOOP";
    var string: action_name is "";
    var type: object_type is void;
  begin
    current_action := getValue(function, ACTION);
    action_name := str(current_action);
    if action_name = "ARR_CPY" then
      object_type := getType(formalParams(function)[1]);
      process_generic_cpy_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_cpy_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "ARR_CREATE" then
      object_type := getType(formalParams(function)[1]);
      typeCategory @:= [object_type] ARRAYOBJECT;
      process_generic_create_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_create_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "ARR_DESTR" then
      object_type := getType(formalParams(function)[1]);
      process_generic_destr_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_destr_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "BIG_CMP" then
      c_expr.expr &:= "&bigCmpGeneric";
    elsif action_name = "BIG_CPY" then
      c_expr.expr &:= "&bigCpyGeneric";
    elsif action_name = "BIG_CREATE" then
      c_expr.expr &:= "&bigCreateGeneric";
    elsif action_name = "BIG_DESTR" then
      c_expr.expr &:= "&bigDestrGeneric";
    elsif action_name = "BIN_CMP" then
      c_expr.expr &:= "&uintCmpGeneric";
    elsif action_name = "BLN_CPY" then
      c_expr.expr &:= "&genericCpy";
    elsif action_name = "BLN_CREATE" then
      c_expr.expr &:= "&genericCreate";
    elsif action_name = "BST_CMP" then
      c_expr.expr &:= "&bstCmpGeneric";
    elsif action_name = "BST_CPY" then
      c_expr.expr &:= "&bstCpyGeneric";
    elsif action_name = "BST_CREATE" then
      c_expr.expr &:= "&bstCreateGeneric";
    elsif action_name = "BST_DESTR" then
      c_expr.expr &:= "&bstDestrGeneric";
    elsif action_name = "CHR_CMP" then
      c_expr.expr &:= "&chrCmpGeneric";
    elsif action_name = "CHR_CPY" then
      c_expr.expr &:= "&genericCpy";
    elsif action_name = "CHR_CREATE" then
      c_expr.expr &:= "&genericCreate";
    elsif action_name = "DRW_CMP" then
      c_expr.expr &:= "&ptrCmpGeneric";
    elsif action_name = "DRW_CPY" then
      c_expr.expr &:= "&drwCpyGeneric";
    elsif action_name = "DRW_CREATE" then
      c_expr.expr &:= "&drwCreateGeneric";
    elsif action_name = "DRW_DESTR" then
      c_expr.expr &:= "&drwDestrGeneric";
    elsif action_name = "ENU_CPY" then
      c_expr.expr &:= "&genericCpy";
    elsif action_name = "ENU_CREATE" then
      c_expr.expr &:= "&genericCreate";
    elsif action_name = "FIL_CPY" then
      c_expr.expr &:= "&filCpyGeneric";
    elsif action_name = "FIL_CREATE" then
      c_expr.expr &:= "&filCreateGeneric";
    elsif action_name = "FIL_DESTR" then
      c_expr.expr &:= "&filDestrGeneric";
    elsif action_name = "FLT_CMP" then
      c_expr.expr &:= "&fltCmpGeneric";
    elsif action_name = "FLT_CPY" then
      c_expr.expr &:= "&fltCpyGeneric";
    elsif action_name = "FLT_CREATE" then
      c_expr.expr &:= "&genericCreate";
    elsif action_name = "GEN_DESTR" then
      c_expr.expr &:= "&genericDestr";
    elsif action_name = "INT_CMP" then
      c_expr.expr &:= "&intCmpGeneric";
    elsif action_name = "INT_CPY" then
      c_expr.expr &:= "&genericCpy";
    elsif action_name = "INT_CREATE" then
      c_expr.expr &:= "&genericCreate";
    elsif action_name = "ITF_CMP" then
      c_expr.expr &:= "&ptrCmpGeneric";
    elsif action_name = "ITF_CPY" then
      object_type := getType(formalParams(function)[1]);
      process_generic_cpy_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_cpy_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "ITF_CREATE" then
      c_expr.expr &:= "&itfCreateGeneric";
    elsif action_name = "ITF_DESTR" then
      object_type := getType(formalParams(function)[1]);
      process_generic_destr_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_destr_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "PCS_CMP" then
      c_expr.expr &:= "&pcsCmpGeneric";
    elsif action_name = "PCS_CPY" then
      c_expr.expr &:= "&pcsCpyGeneric";
    elsif action_name = "PCS_CREATE" then
      c_expr.expr &:= "&pcsCreateGeneric";
    elsif action_name = "PCS_DESTR" then
      c_expr.expr &:= "&pcsDestrGeneric";
    elsif action_name = "PRC_NOOP" then
      c_expr.expr &:= "&prcNoop";
    elsif action_name = "REF_CMP" then
      c_expr.expr &:= "&ptrCmpGeneric";
    elsif action_name = "REF_CPY" then
      c_expr.expr &:= "&ptrCpyGeneric";
    elsif action_name = "REF_CREATE" then
      c_expr.expr &:= "&ptrCreateGeneric";
    elsif action_name = "RFL_CMP" then
      c_expr.expr &:= "&rflCmpGeneric";
    elsif action_name = "RFL_CPY" then
      c_expr.expr &:= "&rflCpyGeneric";
    elsif action_name = "RFL_CREATE" then
      c_expr.expr &:= "&rflCreateGeneric";
    elsif action_name = "RFL_DESTR" then
      c_expr.expr &:= "&rflDestrGeneric";
    elsif action_name = "SCT_CPY" then
      object_type := getType(formalParams(function)[1]);
      process_generic_cpy_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_cpy_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "SCT_CREATE" then
      object_type := getType(formalParams(function)[1]);
      typeCategory @:= [object_type] STRUCTOBJECT;
      process_generic_create_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_create_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "SCT_DESTR" then
      object_type := getType(formalParams(function)[1]);
      process_generic_destr_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_destr_";
      c_expr.expr &:= str(typeNumber(object_type));
    elsif action_name = "SET_CMP" then
      c_expr.expr &:= "&setCmpGeneric";
    elsif action_name = "SET_CPY" then
      c_expr.expr &:= "&setCpyGeneric";
    elsif action_name = "SET_CREATE" then
      c_expr.expr &:= "&setCreateGeneric";
    elsif action_name = "SET_DESTR" then
      c_expr.expr &:= "&setDestrGeneric";
    elsif action_name = "SQL_CMP_DB" then
      c_expr.expr &:= "&ptrCmpGeneric";
    elsif action_name = "SQL_CPY_DB" then
      c_expr.expr &:= "&sqlCpyDbGeneric";
    elsif action_name = "SQL_CREATE_DB" then
      c_expr.expr &:= "&sqlCreateDbGeneric";
    elsif action_name = "SQL_DESTR_DB" then
      c_expr.expr &:= "&sqlDestrDbGeneric";
    elsif action_name = "SQL_CMP_STMT" then
      c_expr.expr &:= "&ptrCmpGeneric";
    elsif action_name = "SQL_CPY_STMT" then
      c_expr.expr &:= "&sqlCpyStmtGeneric";
    elsif action_name = "SQL_CREATE_STMT" then
      c_expr.expr &:= "&sqlCreateStmtGeneric";
    elsif action_name = "SQL_DESTR_STMT" then
      c_expr.expr &:= "&sqlDestrStmtGeneric";
    elsif action_name = "STR_CMP" then
      c_expr.expr &:= "&strCmpGeneric";
    elsif action_name = "STR_CPY" then
      c_expr.expr &:= "&strCpyGeneric";
    elsif action_name = "STR_CREATE" then
      c_expr.expr &:= "&strCreateGeneric";
    elsif action_name = "STR_DESTR" then
      c_expr.expr &:= "&strDestrGeneric";
    elsif action_name = "TYP_CMP" then
      c_expr.expr &:= "&typCmpGeneric";
    elsif action_name = "TYP_CPY" then
      c_expr.expr &:= "&ptrCpyGeneric";
    elsif action_name = "TYP_CREATE" then
      c_expr.expr &:= "&ptrCreateGeneric";
    elsif action_name = "TYP_DESTR" then
      c_expr.expr &:= "&genericDestr";
    else
      c_expr.expr &:= "NULL /* ACTOBJECT { ";
      c_expr.expr &:= action_name;
      c_expr.expr &:= " }*/";
    end if;
  end func;


const proc: block_address (in reference: function, inout expr_type: c_expr) is func

  local
    var ref_list: formal_params is ref_list.EMPTY;
    var reference: formal_param is NIL;
    var type: object_type is void;
    var boolean: address_written is FALSE;
  begin
    formal_params := formalParams(function);
    if length(formal_params) = 3 and category(formal_params[2]) = SYMBOLOBJECT and
        str(formal_params[2]) = ":=" then
      formal_param := formal_params[1];
      object_type := getType(formal_param);
      process_generic_cpy_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_cpy_";
      c_expr.expr &:= str(typeNumber(object_type));
      address_written := TRUE;
    elsif length(formal_params) = 3 and category(formal_params[2]) = SYMBOLOBJECT and
        str(formal_params[2]) = "::=" then
      formal_param := formal_params[1];
      object_type := getType(formal_param);
      process_generic_create_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_create_";
      c_expr.expr &:= str(typeNumber(object_type));
      address_written := TRUE;
    elsif length(formal_params) = 2 and category(formal_params[2]) = SYMBOLOBJECT and
        str(formal_params[2]) = "destroy" then
      formal_param := formal_params[1];
      object_type := getType(formal_param);
      process_generic_destr_declaration(object_type, global_c_expr);
      c_expr.expr &:= "&generic_destr_";
      c_expr.expr &:= str(typeNumber(object_type));
      address_written := TRUE;
    elsif length(formal_params) = 3 and category(formal_params[3]) = SYMBOLOBJECT and
        str(formal_params[3]) = "compare" then
      formal_param := formal_params[1];
      object_type := getType(formal_param);
      process_generic_cmp_declaration(function, object_type, global_c_expr);
      c_expr.expr &:= "&generic_cmp_";
      c_expr.expr &:= str(typeNumber(object_type));
      address_written := TRUE;
    end if;
    if not address_written then
      c_expr.expr &:= "&o_";
      create_name(function, c_expr.expr);
    end if;
  end func;


const proc: object_address (in reference: curr_expr, inout expr_type: c_expr) is func

  local
    var category: exprCategory is category.value;
  begin
    if curr_expr = NIL then
      c_expr.expr &:= "NULL";
    else
      exprCategory := category(curr_expr);
      if exprCategory = ACTOBJECT then
        action_address(curr_expr, c_expr);
      elsif exprCategory = BLOCKOBJECT then
        block_address(curr_expr, c_expr);
      else
        c_expr.expr &:= "/* ";
        c_expr.expr &:= str(exprCategory);
        c_expr.expr &:= " */";
        block
          c_expr.expr &:= "&(";
          process_expr(curr_expr, c_expr);
          c_expr.expr &:= ")";
        exception
          catch RANGE_ERROR:
            c_expr.expr &:= "/*RANGE_ERROR*/";
            writeln("] ");
            TRACE(curr_expr);
            writeln;
        end block;
      end if;
    end if;
  end func;


const proc: process_reference_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    (* if isVar(current_object) then *)
      c_expr.expr &:= "/* ";
      c_expr.expr &:= type_name2(getType(current_object));
      c_expr.expr &:= " */ ";
      if useFunctype(current_object) then
        c_expr.expr &:= "intfunctype o_";
      else
        c_expr.expr &:= "objRefType o_";
      end if;
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=";
      if useFunctype(current_object) then
        c_expr.expr &:= "(intfunctype)(";
      else
        c_expr.expr &:= "(objRefType)(";
      end if;
      object_address(getValue(current_object, reference), c_expr);
      c_expr.expr &:= ");\n\n";
      function_pointer_declared @:= [current_object] TRUE;
      count_declarations(c_expr);
    (* end if; *)
  end func;


const proc: process_ref_list_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: refListValue is ref_list.EMPTY;
    var integer: index is 0;
  begin
    refListValue := getValue(current_object, ref_list);
    for index range length(refListValue) downto 1 do
      c_expr.expr &:= "struct listStruct rec_";
      c_expr.expr &:= str(objNumber(current_object));
      c_expr.expr &:= "_";
      c_expr.expr &:= str(index);
      c_expr.expr &:= "={";
      if index = length(refListValue) then
        c_expr.expr &:= "NULL";
      else
        c_expr.expr &:= "&rec_";
        c_expr.expr &:= str(objNumber(current_object));
        c_expr.expr &:= "_";
        c_expr.expr &:= str(succ(index));
      end if;
      c_expr.expr &:= ", (objRefType) &(";
      process_expr(refListValue[index], c_expr);
      c_expr.expr &:= ")};\n";
    end for;
    c_expr.expr &:= "\n";
    c_expr.expr &:= type_name(getType(current_object));
    c_expr.expr &:= " o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= "=";
    if length(refListValue) = 0 then
      c_expr.expr &:= "NULL";
    else
      c_expr.expr &:= "&rec_";
      c_expr.expr &:= str(objNumber(current_object));
      c_expr.expr &:= "_1";
    end if;
    c_expr.expr &:= ";\n\n";
    count_declarations(c_expr);
  end func;


const proc: process_file_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "fileType o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= "=&";
    c_expr.expr &:= lower(literal(getValue(current_object, clib_file)));
    c_expr.expr &:= "FileRecord;\n\n";
    count_declarations(c_expr);
  end func;


const proc: process_socket_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "socketType o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= " = (socketType) -1;\n\n";
    count_declarations(c_expr);
  end func;


const proc: process_poll_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "pollType o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= ";\n\n";
    count_declarations(c_expr);
  end func;


const proc: process_array_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var string: param_value is "";
  begin
    typeCategory @:= [getType(current_object)] ARRAYOBJECT;
    if isVar(current_object) then
      c_expr.expr &:= type_name(getType(current_object));
      c_expr.expr &:= " o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      if current_object not in const_table then
        const_table @:= [current_object] length(const_table);
      end if;
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=";
      param_value := "(";
      param_value &:= type_name(getType(current_object));
      param_value &:= ")(arr[";
      param_value &:= str(const_table[current_object]);
      param_value &:= "])";
      process_create_declaration(getType(current_object), global_c_expr);
      process_create_call(getType(current_object),
          param_value, global_init.expr);
      global_init.expr &:= ";\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_hash_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var string: param_value is "";
  begin
    typeCategory @:= [getType(current_object)] HASHOBJECT;
    c_expr.expr &:= type_name(getType(current_object));
    c_expr.expr &:= " o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= ";\n\n";
    if current_object not in const_table then
      const_table @:= [current_object] length(const_table);
    end if;
    global_init.expr &:= diagnosticLine(current_object);
    global_init.expr &:= "o_";
    create_name(current_object, global_init.expr);
    global_init.expr &:= "=";
    param_value := "(";
    param_value &:= type_name(getType(current_object));
    param_value &:= ")(hsh[";
    param_value &:= str(const_table[current_object]);
    param_value &:= "])";
    if isVar(current_object) then
      process_create_declaration(getType(current_object), global_c_expr);
      process_create_call(getType(current_object),
          param_value, global_init.expr);
    else
      global_init.expr &:= param_value;
    end if;
    global_init.expr &:= ";\n";
    count_declarations(c_expr);
  end func;


const proc: process_set_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= type_name(getType(current_object));
      c_expr.expr &:= " o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=setCreate(";
      global_init.expr &:= bitsetLiteral(getValue(current_object, bitset));
      global_init.expr &:= ");\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_struct_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var string: param_value is "";
    var string: init_expr is "";
  begin
    declare_type_if_necessary(getType(current_object), c_expr);
    c_expr.expr &:= type_name(getType(current_object));
    c_expr.expr &:= " o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= ";\n\n";
    if current_object not in const_table then
      const_table @:= [current_object] length(const_table);
    end if;
    init_expr &:= diagnosticLine(current_object);
    init_expr &:= "o_";
    create_name(current_object, init_expr);
    init_expr &:= "=";
    param_value := "(";
    param_value &:= type_name(getType(current_object));
    param_value &:= ")(sct[";
    param_value &:= str(const_table[current_object]);
    param_value &:= "])";
    if isVar(current_object) then
      process_create_declaration(getType(current_object), global_c_expr);
      process_create_call(getType(current_object),
          param_value, init_expr);
    else
      init_expr &:= param_value;
    end if;
    init_expr &:= ";\n";
    if current_object in globalInitalisations then
      globalInitalisations @:= [current_object] globalInitalisations[current_object] & init_expr;
    else
      globalInitalisations @:= [current_object] init_expr;
    end if;
    count_declarations(c_expr);
  end func;


const proc: process_interface_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var reference: object_value is NIL;
    var category: valueCategory is category.value;
  begin
    c_expr.expr &:= type_name(getType(current_object));
    c_expr.expr &:= " o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= ";\n\n";
    object_value := interfaceToStruct(current_object);
    valueCategory := category(object_value);
    if current_object not in const_table then
      const_table @:= [current_object] length(const_table);
    end if;
    global_init.expr &:= diagnosticLine(current_object);
    global_init.expr &:= "o_";
    create_name(current_object, global_init.expr);
    global_init.expr &:= "=(";
    global_init.expr &:= type_name(getType(current_object));
    global_init.expr &:= ")(itfCreate(itf[";
    global_init.expr &:= str(const_table[current_object]);
    global_init.expr &:= "]));\n";
    count_declarations(c_expr);
  end func;


const proc: process_win_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "winType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= ";\n\n";
      global_init.expr &:= diagnosticLine(current_object);
      global_init.expr &:= "o_";
      create_name(current_object, global_init.expr);
      global_init.expr &:= "=drwCreate(";
      global_init.expr &:= windowLiteral(getValue(current_object, PRIMITIVE_WINDOW));
      global_init.expr &:= ");\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_process_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "processType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=NULL;\n\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_prog_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) then
      c_expr.expr &:= "progType o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=NULL;\n\n";
      count_declarations(c_expr);
    end if;
  end func;


const proc: process_enum_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  begin
    if isVar(current_object) or not isFunc(getType(current_object)) then
      if getType(current_object) = voidtype then
        c_expr.expr &:= "/* do not declare void variable or constant o_";
        create_name2(current_object, c_expr.expr);
        c_expr.expr &:= " */\n\n";
      else
        if not isVar(current_object) then
          c_expr.expr &:= "const ";
        end if;
        declare_type_if_necessary(getType(current_object), c_expr);
        c_expr.expr &:= type_name(getType(current_object));
        c_expr.expr &:= " o_";
        create_name(current_object, c_expr.expr);
        c_expr.expr &:= "=";
        c_expr.expr &:= enum_value(getValue(current_object, reference));
        c_expr.expr &:= ";\n\n";
      end if;
    end if;
    count_declarations(c_expr);
  end func;


const proc: process_enum_literal_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var type: enum_type is void;
  begin
    enum_type := getType(current_object);
    if enum_type = voidtype then
      c_expr.expr &:= "/* do not declare: void o_4_empty */\n\n";
    else
      if enum_type not in enum_literal then
        enum_literal @:= [enum_type] element_number_hash.EMPTY_HASH;
      end if;
      if current_object not in enum_literal[enum_type] then
        enum_literal[enum_type] @:= [current_object] length(enum_literal[enum_type]);
      end if;
      c_expr.expr &:= "const ";
      declare_type_if_necessary(enum_type, c_expr);
      c_expr.expr &:= type_name(enum_type);
      c_expr.expr &:= " o_";
      create_name(current_object, c_expr.expr);
      c_expr.expr &:= "=";
      c_expr.expr &:= enum_value(current_object);
      c_expr.expr &:= ";\n\n";
    end if;
    count_declarations(c_expr);
  end func;


const proc: print_parameter_list (in ref_list: formal_params,
    inout expr_type: c_expr) is func

  local
    var reference: formal_param is NIL;
    var category: paramCategory is category.value;
    var boolean: first_element is TRUE;
    var type: param_type is void;
    var type: implementationType is void;
  begin
    for formal_param range formal_params do
      paramCategory := category(formal_param);
      if paramCategory <> SYMBOLOBJECT then
        if first_element then
          first_element := FALSE;
        else
          c_expr.expr &:= " printf(\", \");\n";
        end if;
        param_type := getType(formal_param);
        if param_type in implements then
          c_expr.expr &:= " /*# ";
          for implementationType range implements[param_type] do
            c_expr.expr &:= type_name2(implementationType);
            c_expr.expr &:= "  ";
          end for;
          c_expr.expr &:= " */ ";
        end if;
        c_expr.expr &:= "printf(";
        c_expr.expr &:= c_literal(str(paramCategory) & " ");
        c_expr.expr &:= "); ";
        if param_type in typeCategory then
          case typeCategory[param_type] of
            when {INTOBJECT}:
              c_expr.expr &:= "printf(\"intType \"); ";
              c_expr.expr &:= "printf(\"%ld\", ";
            when {FLOATOBJECT}:
              c_expr.expr &:= "printf(\"floatType \"); ";
              c_expr.expr &:= "printf(\"%f\", ";
            when {CHAROBJECT}:
              c_expr.expr &:= "printf(\"charType \"); ";
              c_expr.expr &:= "printf(\"%c\", ";
            when {STRIOBJECT}:
              c_expr.expr &:= "printf(\"striType \"); ";
              c_expr.expr &:= "filPrint(";
            when {TYPEOBJECT}:
              c_expr.expr &:= "printf(\"typeType \"); ";
              c_expr.expr &:= "printf(\"%X\", ";
            otherwise:
              c_expr.expr &:= "printf(\"";
              c_expr.expr &:= type_name(param_type);
              c_expr.expr &:= " \"); ";
              c_expr.expr &:= "printf(\"%X\", ";
          end case;
        else
          c_expr.expr &:= "printf(\"";
          c_expr.expr &:= type_name(param_type);
          c_expr.expr &:= " \"); ";
          c_expr.expr &:= "printf(\"%X\", ";
        end if;
        if isPointerParam(formal_param) then
          c_expr.expr &:= "(o_";
          create_name(formal_param, c_expr.expr);
          c_expr.expr &:= "?*o_";
          create_name(formal_param, c_expr.expr);
          c_expr.expr &:= ":0)";
        else
          c_expr.expr &:= "o_";
          create_name(formal_param, c_expr.expr);
        end if;
        c_expr.expr &:= ");";
      end if;
    end for;
  end func;


const proc: process_dynamic_parameter_list (in reference: function,
    in ref_list: actual_params, inout expr_type: c_expr) is func

  local
    var ref_list: formal_params is ref_list.EMPTY;
    var reference: formal_param is NIL;
    var reference: actual_param is NIL;
    var category: formalCategory is category.value;
    var category: paramCategory is category.value;
    var boolean: first_element is TRUE;
    var integer: number is 0;
  begin
    formal_params := formalParams(function);
    for number range 1 to length(formal_params) do
      formal_param := formal_params[number];
      actual_param := actual_params[number];
      formalCategory := category(formal_param);
      paramCategory := category(actual_param);
      if paramCategory <> SYMBOLOBJECT and
          formalCategory <> SYMBOLOBJECT then
        if formalCategory = TYPEOBJECT then
          c_expr.expr &:= "/* attr t_";
          c_expr.expr &:= str(typeNumber(getValue(formal_param, type)));
          c_expr.expr &:= " ";
          c_expr.expr &:= str(getValue(formal_param, type));
          c_expr.expr &:= "*/ ";
        else
          if first_element then
            first_element := FALSE;
          else
            c_expr.expr &:= ", ";
          end if;
          if not isVar(actual_param) and isInOutParam(formal_param) then
            c_expr.expr &:= "/* SHOULD NOT HAPPEN &o_";
            create_name(actual_param, c_expr.expr);
            c_expr.expr &:= " */";
          elsif isPointerParam(actual_param) = isPointerParam(formal_param) then
            c_expr.expr &:= "o_";
            create_name(actual_param, c_expr.expr);
          elsif isPointerParam(actual_param) and not isPointerParam(formal_param) then
            c_expr.expr &:= "*o_";
            create_name(actual_param, c_expr.expr);
          else # if isVar(actual_param) or not isInOutParam(formal_param) then
            c_expr.expr &:= "&o_";
            create_name(actual_param, c_expr.expr);
          end if;
        end if;
      end if;
    end for;
  end func;


const proc: process_dynamic_function_call (in reference: function,
    in ref_list: actual_params, in reference: interface_object, inout expr_type: c_expr) is func

  local
    var expr_type: resultExpr is expr_type.value;
  begin
    resultExpr.currentFile := file(interface_object);
    resultExpr.currentLine := line(interface_object);
    resultExpr.expr &:= "o_";
    create_name(function, resultExpr.expr);
    resultExpr.expr &:= "(";
    process_dynamic_parameter_list(function, actual_params, resultExpr);
    resultExpr.expr &:= ")";
    if function in return_ref_to_value then
      c_expr.expr &:= "/* copy ref_to_value */ ";
      process_create_declaration(resultType(getType(interface_object)), global_c_expr);
      process_create_call(resultType(getType(interface_object)),
          resultExpr.expr, c_expr.expr);
    else
      c_expr.expr &:= resultExpr.expr;
    end if;
    c_expr.temp_decls &:= resultExpr.temp_decls;
    c_expr.temp_assigns &:= resultExpr.temp_assigns;
    c_expr.temp_frees &:= resultExpr.temp_frees;
    c_expr.temp_to_null &:= resultExpr.temp_to_null;
  end func;


const proc: process_dynamic_action_call (in reference: function,
    in ref_list: actual_params, in reference: interface_object, inout expr_type: c_expr) is func

  local
    var expr_type: c_action_expr is expr_type.value;
  begin
    # c_expr.expr &:= "/* ";
    # c_expr.expr &:= str(getValue(function, ACTION));
    # c_expr.expr &:= " */ ";
    c_action_expr.currentFile := file(interface_object);
    c_action_expr.currentLine := line(interface_object);
    c_action_expr.temp_num := c_expr.temp_num;
    process_action(function, actual_params, c_action_expr);
    c_expr.temp_num := c_action_expr.temp_num;
    c_expr.temp_decls &:= c_action_expr.temp_decls;
    c_expr.temp_assigns &:= c_action_expr.temp_assigns;
    c_expr.temp_frees &:= c_action_expr.temp_frees;
    c_expr.temp_to_null &:= c_action_expr.temp_to_null;
    if c_action_expr.result_expr <> "" then
      c_expr.expr &:= c_action_expr.result_expr;
    else
      if isVarfunc(getType(interface_object)) or
          getType(interface_object) = proctype then
        c_expr.expr &:= c_action_expr.expr;
      else
        c_expr.expr &:= "/* copy ref_to_value */ ";
        process_create_declaration(resultType(getType(interface_object)), global_c_expr);
        process_create_call(resultType(getType(interface_object)),
            c_action_expr.expr, c_expr.expr);
      end if;
    end if;
  end func;


const proc: process_dynamic_call (in reference: function,
    in ref_list: actual_params, in reference: interface_object,
    inout expr_type: c_expr) is func

  local
    var category: objectCategory is category.value;
    var expr_type: resultExpr is expr_type.value;
  begin
    if function <> NIL then
      c_expr.expr &:= diagnosticLine(interface_object);
      objectCategory := category(function);
      if objectCategory = BLOCKOBJECT then
        if resultType(getType(interface_object)) <> voidtype then
          c_expr.expr &:= "return ";
        end if;
        if function in function_declared or resultVar(function) <> NIL then
          process_dynamic_function_call(function, actual_params, interface_object, c_expr);
        else
          process_inline(function, actual_params, c_expr);
        end if;
        c_expr.expr &:= ";\n";
      elsif objectCategory = ACTOBJECT then
        if resultType(getType(interface_object)) <> voidtype then
          c_expr.expr &:= "return ";
          if isVarfunc(getType(interface_object)) then
            c_expr.expr &:= "&(";
          end if;
        end if;
        process_dynamic_action_call(function, actual_params, interface_object, c_expr);
        if resultType(getType(interface_object)) <> voidtype then
          if isVarfunc(getType(interface_object)) then
            c_expr.expr &:= ")";
          end if;
          c_expr.expr &:= ";\n";
        end if;
      elsif objectCategory = INTOBJECT or
          objectCategory = BIGINTOBJECT or
          objectCategory = FLOATOBJECT or
          objectCategory = CHAROBJECT or
          objectCategory = STRIOBJECT or
          objectCategory = BSTRIOBJECT or
          objectCategory = ARRAYOBJECT or
          objectCategory = STRUCTOBJECT or
          objectCategory = SETOBJECT or
          objectCategory = WINOBJECT or
          objectCategory = PROCESSOBJECT or
          objectCategory = CONSTENUMOBJECT then
        c_expr.expr &:= "return ";
        getAnyParamToExpr(function, resultExpr);
        process_create_declaration(getType(function), global_c_expr);
        process_create_call(getType(function),
            resultExpr.expr, c_expr.expr);
        c_expr.expr &:= ";\n";
      else
        c_expr.expr &:= "/* ";
        c_expr.expr &:= str(objectCategory);
        c_expr.expr &:= " */\n";
      end if;
    else
      c_expr.expr &:= "/* NOT FOUND */\n";
      c_expr.expr &:= diagnosticLine(interface_object);
      c_expr.expr &:= "raiseError(ACTION_ERROR);\n";
    end if;
  end func;


const proc: process_dynamic_condition (in reference: current_object,
    inout ref_list: formal_params, in var integer: paramNum,
    inout expr_type: c_expr) is forward;


const proc: process_dynamic_param_implements (in reference: current_object,
    inout ref_list: formal_params, in var integer: paramNum,
    in type: param_type, inout expr_type: c_expr) is func

  local
    var reference: formal_param is NIL;
    var type: implementationType is void;
    var bitset: usedCaseLabels is {};
  begin
    formal_param := formal_params[paramNum];
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "switch (((interfaceType) ";
    if isPointerParam(formal_param) then
      c_expr.expr &:= "*o_";
    else
      c_expr.expr &:= "o_";
    end if;
    create_name(formal_param, c_expr.expr);
    c_expr.expr &:= ")->type_num) {\n";
    for implementationType range implements[param_type] do
      if typeNumber(implementationType) not in usedCaseLabels then
        c_expr.expr &:= "case ";
        c_expr.expr &:= str(typeNumber(implementationType));
        c_expr.expr &:= "/*";
        c_expr.expr &:= str(implementationType);
        c_expr.expr &:= "*/";
        c_expr.expr &:= ":\n";
        setType(formal_params[paramNum], implementationType);
        process_dynamic_condition(current_object,
            formal_params, paramNum, c_expr);
        setType(formal_params[paramNum], param_type);
        c_expr.expr &:= diagnosticLine(current_object);
        c_expr.expr &:= "break;\n";
        incl(usedCaseLabels, typeNumber(implementationType));
      end if;
    end for;
    c_expr.expr &:= "default:\n";
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "raiseError(ACTION_ERROR);\n";
    (*
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "printf(\"type_num=%d\\n\", ";
    if isPointerParam(formal_param) then
      c_expr.expr &:= "((interfaceType) *o_";
    else
      c_expr.expr &:= "((interfaceType) o_";
    end if;
    create_name(formal_param, c_expr.expr);
    c_expr.expr &:= ")->type_num);\n";
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "printf(\"o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= "(\");\n";
    c_expr.expr &:= diagnosticLine(current_object);
    print_parameter_list(formal_params, c_expr);
    c_expr.expr &:= "printf(\")\\n\");\n";
    *)
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "break;\n";
    c_expr.expr &:= "}\n";
  end func;


const proc: process_dynamic_param_enumeration (in reference: current_object,
    inout ref_list: formal_params, in var integer: paramNum,
    in type: param_type, inout expr_type: c_expr) is func

  local
    var reference: formal_param is NIL;
    var number_element_hash: enumsByIntValue is number_element_hash.value;
    var integer: intValueOfEnum is 0;
    var reference: enumLiteral is NIL;
    var reference: backupParam is NIL;
  begin
    formal_param := formal_params[paramNum];
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "switch (";
    if isPointerParam(formal_param) then
      c_expr.expr &:= "*o_";
      create_name(formal_param, c_expr.expr);
    else
      c_expr.expr &:= "o_";
      create_name(formal_param, c_expr.expr);
    end if;
    c_expr.expr &:= ") {\n";
    enumsByIntValue := flip(enum_literal[param_type]);
    # Sort by integer values to always produce the same C code
    for intValueOfEnum range sort(keys(enumsByIntValue)) do
      c_expr.expr &:= diagnosticLine(current_object);
      c_expr.expr &:= "case ";
      c_expr.expr &:= str(intValueOfEnum);
      c_expr.expr &:= ": {\n";
      # If the enums are correct there will only be one per integer value
      enumLiteral := enumsByIntValue[intValueOfEnum][1];
      backupParam := formal_params[paramNum];
      formal_params @:= [paramNum] enumLiteral;
      process_dynamic_condition(current_object,
          formal_params, paramNum, c_expr);
      formal_params @:= [paramNum] backupParam;
      c_expr.expr &:= diagnosticLine(current_object);
      c_expr.expr &:= "} break;\n";
    end for;
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "default: {\n";
    c_expr.expr &:= diagnosticLine(current_object);
    c_expr.expr &:= "raiseError(ACTION_ERROR);\n";
    (*
    c_expr.expr &:= "printf(\"literal_num=%d\\n\", ";
    if isPointerParam(formal_param) then
      c_expr.expr &:= "*o_";
      create_name(formal_param, c_expr.expr);
    else
      c_expr.expr &:= "o_";
      create_name(formal_param, c_expr.expr);
    end if;
    c_expr.expr &:= ");\n";
    c_expr.expr &:= "printf(\"o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= "(\");\n";
    print_parameter_list(formal_params, c_expr);
    c_expr.expr &:= "printf(\")\\n\");\n";
    *)
    c_expr.expr &:= "} break;\n";
    c_expr.expr &:= "}\n";
  end func;


const proc: process_dynamic_condition (in reference: current_object,
    inout ref_list: formal_params, in var integer: paramNum,
    inout expr_type: c_expr) is func

  local
    var reference: formal_param is NIL;
    var category: paramCategory is category.value;
    var type: param_type is void;
    var ref_list: param_list is ref_list.EMPTY;
    var reference: matched_object is NIL;
  begin
    incr(paramNum);
    if paramNum <= length(formal_params) then
      formal_param := formal_params[paramNum];
      paramCategory := category(formal_param);
      if paramCategory <> SYMBOLOBJECT then
        param_type := getType(formal_param);
        if param_type in implements then
          process_dynamic_param_implements(current_object,
              formal_params, paramNum, param_type, c_expr);
        elsif param_type in enum_literal then
          process_dynamic_param_enumeration(current_object,
              formal_params, paramNum, param_type, c_expr);
        else
          process_dynamic_condition(current_object,
              formal_params, paramNum, c_expr);
        end if;
      else
        process_dynamic_condition(current_object,
            formal_params, paramNum, c_expr);
      end if;
    else
      param_list := formal_params;
      matched_object := match(prog, param_list);
      (*
      if matched_object = NIL then
        c_expr.expr &:= "printf(\"NOT FOUND:\\n\");\n";
        for formal_param range formal_params do
          paramCategory := category(formal_param);
          if paramCategory <> SYMBOLOBJECT then
            param_type := getType(formal_param);
            if param_type in implements then
              c_expr.expr &:= "printf(\"type_num=%d\\n\", ";
              if isPointerParam(formal_param) then
                c_expr.expr &:= "((interfaceType) *o_";
              else
                c_expr.expr &:= "((interfaceType) o_";
              end if;
              create_name(formal_param, c_expr.expr);
              c_expr.expr &:= ")->type_num);\n";
            elsif param_type in enum_literal then
              c_expr.expr &:= "printf(\"literal_num=%d\\n\", ";
              if isPointerParam(formal_param) then
                c_expr.expr &:= "*o_";
              else
                c_expr.expr &:= "o_";
              end if;
              create_name(formal_param, c_expr.expr);
              c_expr.expr &:= ");\n";
            else
              c_expr.expr &:= "printf(\"other param_type\\n\");\n";
            end if;
          else
            c_expr.expr &:= "printf(\"" <& striToUtf8(str(formal_param)) <& "\\n\");\n";
          end if;
        end for;
      end if;
      *)
      process_dynamic_call(matched_object, formal_params, current_object, c_expr);
    end if;
  end func;


const proc: process_dynamic_decision (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_param_list is expr_type.value;
    var expr_type: c_func_body is expr_type.value;
    var type: object_type is void;
    var type: result_type is void;
    var ref_list: param_list is ref_list.EMPTY;
  begin
    object_type := getType(current_object);
    if isFunc(object_type) or isVarfunc(object_type) then
      result_type := resultType(object_type);
      if result_type not in typeCategory or typeCategory[result_type] <> TYPEOBJECT then
        declare_types_of_params(param_list, global_c_expr);
        c_expr.expr &:= diagnosticLine(current_object);
        c_expr.expr &:= "/* DYNAMIC */ static ";
        c_expr.expr &:= type_name(result_type);
        if isVarfunc(object_type) then
          c_expr.expr &:= " *o_";
        else
          c_expr.expr &:= " o_";
        end if;
        create_name(current_object, c_expr.expr);
        param_list := formalParams(current_object);
        c_expr.expr &:= " (";
        process_param_list_declaration(param_list, c_param_list);
        c_expr.expr &:= c_param_list.expr;
        c_expr.expr &:= ")\n";
        c_expr.expr &:= diagnosticLine(current_object);
        c_expr.expr &:= "{\n";
        process_dynamic_condition(current_object,
            param_list, 0, c_func_body);
        appendWithDiagnostic(c_param_list.temp_decls, c_expr);
        appendWithDiagnostic(c_func_body.temp_decls, c_expr);
        c_expr.expr &:= c_param_list.temp_assigns;
        appendWithDiagnostic(c_func_body.temp_assigns, c_expr);
        c_expr.expr &:= c_func_body.expr;
        appendWithDiagnostic(c_param_list.temp_frees, c_expr);
        appendWithDiagnostic(c_func_body.temp_frees, c_expr);
        c_expr.expr &:= diagnosticLine(current_object);
        c_expr.expr &:= "}\n\n";
      end if;
    end if;
  end func;


const proc: process_dynamic_decisions (inout expr_type: c_expr) is func

  local
    var reference: current_object is NIL;
  begin
    for current_object range dynamic_functions do
      process_dynamic_decision(current_object, c_expr);
    end for;
  end func;


const proc: process_dynamic_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_param_list is expr_type.value;
    var type: object_type is void;
    var type: result_type is void;
    var ref_list: param_list is ref_list.EMPTY;
  begin
    object_type := getType(current_object);
    if isFunc(object_type) or isVarfunc(object_type) then
      result_type := resultType(object_type);
      if result_type not in typeCategory or typeCategory[result_type] <> TYPEOBJECT then
        dynamic_functions &:= make_list(current_object);
        declare_types_of_params(param_list, global_c_expr);
        c_expr.expr &:= "/* DYNAMIC */ static ";
        c_expr.expr &:= type_name(result_type);
        if isVarfunc(object_type) then
          c_expr.expr &:= " *o_";
        else
          c_expr.expr &:= " o_";
        end if;
        create_name(current_object, c_expr.expr);
        param_list := formalParams(current_object);
        c_expr.expr &:= " (";
        process_param_list_declaration(param_list, c_param_list);
        c_expr.expr &:= c_param_list.expr;
        c_expr.expr &:= ");\n";
        prototype_declared @:= [current_object] TRUE;
      end if;
    end if;
  end func;


const proc: process_hashcode (in reference: current_object, inout expr_type: c_expr) is func

  local
    var ref_list: param_list is ref_list.EMPTY;
    var reference: expression is NIL;
  begin
    param_list := make_list(current_object);
    param_list &:= make_list(syobject(prog, "hashCode"));
    expression := matchExpr(prog, param_list);
    # TRACE_REF(expression);
    setCategory(expression, CALLOBJECT);
    process_expr(expression, c_expr);
  end func;


const func reference: keyCreateObj (in type: hash_type) is func

  result
    var reference: keyCreate is NIL;
  local
    var ref_list: param_list is ref_list.EMPTY;
  begin
    param_list := make_list(typeObject(hash_type));
    param_list &:= make_list(syobject(prog, "."));
    param_list &:= make_list(syobject(prog, "keyCreate"));
    keyCreate := match(prog, param_list);
    keyCreate := getValue(keyCreate, reference);
  end func;


const func reference: keyCompareObj (in type: hash_type) is func

  result
    var reference: keyCompare is NIL;
  local
    var ref_list: param_list is ref_list.EMPTY;
  begin
    param_list := make_list(typeObject(hash_type));
    param_list &:= make_list(syobject(prog, "."));
    param_list &:= make_list(syobject(prog, "keyCompare"));
    keyCompare := match(prog, param_list);
    keyCompare := getValue(keyCompare, reference);
  end func;


const func reference: dataCreateObj (in type: hash_type) is func

  result
    var reference: dataCreate is NIL;
  local
    var ref_list: param_list is ref_list.EMPTY;
  begin
    param_list := make_list(typeObject(hash_type));
    param_list &:= make_list(syobject(prog, "."));
    param_list &:= make_list(syobject(prog, "dataCreate"));
    dataCreate := match(prog, param_list);
    dataCreate := getValue(dataCreate, reference);
  end func;


const func reference: dataCopyObj (in type: hash_type) is func

  result
    var reference: dataCopy is NIL;
  local
    var ref_list: param_list is ref_list.EMPTY;
  begin
    param_list := make_list(typeObject(hash_type));
    param_list &:= make_list(syobject(prog, "."));
    param_list &:= make_list(syobject(prog, "dataCopy"));
    dataCopy := match(prog, param_list);
    dataCopy := getValue(dataCopy, reference);
  end func;


const proc: process_arr_cpy_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: base_type is void;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      copyFunction @:= [object_type] current_object;
      typeCategory @:= [object_type] ARRAYOBJECT;
      base_type := base_type(object_type);
      if base_type <> void then
        if object_type not in array_element then
          array_element @:= [object_type] base_type;
        end if;
        if base_type not in array_type then
          array_type @:= [base_type] object_type;
        end if;
      end if;
    end if;
  end func;


const proc: process_arr_create_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: base_type is void;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      createFunction @:= [object_type] current_object;
      typeCategory @:= [object_type] ARRAYOBJECT;
      base_type := base_type(object_type);
      if base_type <> void then
        if object_type not in array_element then
          array_element @:= [object_type] base_type;
        end if;
        if base_type not in array_type then
          array_type @:= [base_type] object_type;
        end if;
      end if;
    end if;
  end func;


const proc: process_arr_destr_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: base_type is void;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      destrFunction @:= [object_type] current_object;
      typeCategory @:= [object_type] ARRAYOBJECT;
      base_type := base_type(object_type);
      if base_type <> void then
        if object_type not in array_element then
          array_element @:= [object_type] base_type;
        end if;
        if base_type not in array_type then
          array_type @:= [base_type] object_type;
        end if;
      end if;
    end if;
  end func;


const proc: process_arr_gen_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: result_type is void;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      result_type := resultType(getType(current_object));
      if object_type not in array_type then
        array_type @:= [object_type] result_type;
      end if;
      if result_type not in array_element then
        array_element @:= [result_type] object_type;
      end if;
      c_expr.expr &:= "/* ACTION ARR_GEN for type ";
      c_expr.expr &:= type_name2(result_type);
      c_expr.expr &:= " element is ";
      c_expr.expr &:= type_name2(object_type);
      c_expr.expr &:= " */\n\n";
    end if;
  end func;


const proc: process_arr_idx_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: result_type is void;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      result_type := resultType(getType(current_object));
      if object_type not in array_element then
        array_element @:= [object_type] result_type;
      end if;
      if result_type not in array_type then
        array_type @:= [result_type] object_type;
      end if;
      c_expr.expr &:= "/* ACTION ARR_IDX for type ";
      c_expr.expr &:= type_name2(object_type);
      c_expr.expr &:= " element is ";
      c_expr.expr &:= type_name2(result_type);
      c_expr.expr &:= " */\n\n";
    end if;
  end func;


const proc: process_arr_times_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var string: diagnosticLine is "";
    var ref_list: params is ref_list.EMPTY;
    var type: result_type is void;
    var type: object_type is void;
  begin
    diagnosticLine := diagnosticLine(current_object);
    params := formalParams(current_object);
    if length(params) >= 3 then
      object_type := getType(params[3]);
      result_type := resultType(getType(current_object));
      if object_type in typeCategory and
          typeCategory[object_type] in simpleValueType then
        c_expr.expr &:= "/* times_";
        c_expr.expr &:= str(typeNumber(result_type));
        c_expr.expr &:= " not defined because arrTimes() is used instead. */\n";
      else
        process_create_declaration(object_type, c_expr);
        c_expr.expr &:= diagnosticLine;
        # c_expr.expr &:= type_name(result_type);
        c_expr.expr &:= "static arrayType times_";
        c_expr.expr &:= str(typeNumber(result_type));
        c_expr.expr &:= " (intType n, const ";
        if useConstPrefix(object_type) then
          c_expr.expr &:= "const_";
        end if;
        c_expr.expr &:= type_name(object_type);
        c_expr.expr &:= " b)\n";
        c_expr.expr &:= diagnosticLine;
        prototype_declared @:= [current_object] TRUE;
        c_expr.expr &:= "{\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "arrayType a;\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "memSizeType i;\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "a=arrMalloc(1, n);\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "for (i = 0; i < (memSizeType)(n); i++) {\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "a->arr[i]";
        c_expr.expr &:= select_value_from_rtlObjectStruct(object_type);
        c_expr.expr &:= "=";
        process_create_call(object_type, "b", c_expr.expr);
        c_expr.expr &:= ";\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "}\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "return a;\n";
        c_expr.expr &:= diagnosticLine;
        c_expr.expr &:= "}\n";
        c_expr.expr &:= noDiagnosticLine;
        c_expr.expr &:= "\n";
      end if;
    end if;
  end func;


const proc: defineParam1TypeCategory (in reference: current_object,
    in category: param1Category) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: param1Type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      param1Type := getType(params[1]);
      typeCategory @:= [param1Type] param1Category;
    end if;
  end func;


const proc: addImplementationToInterface (in type: implementationType, in type: interfaceType) is func

  begin
    if interfaceType in implements then
      implements[interfaceType] &:= implementationType;
    else
      implements @:= [interfaceType] [] (implementationType);
    end if;
    if implementationType in interfaceOfType then
      interfaceOfType[implementationType] &:= interfaceType;
    else
      interfaceOfType @:= [implementationType] [] (interfaceType);
    end if;
  end func;


const proc: process_itf_cpy2_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: interfaceType is void;
    var type: implementationType is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      interfaceType := getType(params[1]);
      implementationType := getType(params[3]);
      addImplementationToInterface(implementationType, interfaceType);
      c_expr.expr &:= "/* itf_cpy2: ";
      c_expr.expr &:= type_name2(interfaceType);
      c_expr.expr &:= " := ";
      c_expr.expr &:= type_name2(implementationType);
      c_expr.expr &:= " */\n";
    end if;
  end func;


const proc: process_itf_next_file_declaration (in reference: current_object) is func

  local
    var type: object_type is void;
  begin
    object_type := getType(current_object);
    if isFunc(object_type) or isVarfunc(object_type) then
      fileInterfaceType := resultType(object_type);
    end if;
  end func;


const proc: process_hsh_cpy_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: hash_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      hash_type := getType(params[1]);
      copyFunction @:= [hash_type] current_object;
      typeCategory @:= [hash_type] HASHOBJECT;
    end if;
  end func;


const proc: process_hsh_create_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      createFunction @:= [object_type] current_object;
      typeCategory @:= [object_type] HASHOBJECT;
    end if;
  end func;


const proc: process_hsh_destr_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      object_type := getType(params[1]);
      destrFunction @:= [object_type] current_object;
      typeCategory @:= [object_type] HASHOBJECT;
    end if;
  end func;


const proc: addStructElem (in type: structType, in type: elemType, in reference: elementOfStruct) is func

  local
    var integer: elementIndex is 0;
    var element_idx_hash: element_index is element_idx_hash.EMPTY_HASH;
  begin
    if structType in struct_element_idx then
      elementIndex := struct_size[structType];
      struct_element_idx[structType] @:= [elementOfStruct] elementIndex;
      struct_element_type[structType] &:= elemType;
      struct_element[structType] &:= elementOfStruct;
      struct_size @:= [structType] succ(elementIndex);
    else
      struct_size @:= [structType] 1;
      element_index @:= [elementOfStruct] 0;
      struct_element_idx @:= [structType] element_index;
      struct_element_type @:= [structType] [0] elemType;
      struct_element @:= [structType] [0] elementOfStruct;
    end if;
  end func;


const proc: process_sct_cpy_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: sct_type is void;
    var type: meta_type is void;
    var type: interfaceType is void;
    var integer: structIndex is 0;
  begin
    params := formalParams(current_object);
    if length(params) >= 1 then
      sct_type := getType(params[1]);
      copyFunction @:= [sct_type] current_object;
      typeCategory @:= [sct_type] STRUCTOBJECT;
      if isDerived(sct_type) then
        meta_type := meta(sct_type);
        if meta_type in struct_element_idx then
          for structIndex range 0 to pred(struct_size[meta_type]) do
            addStructElem(sct_type, struct_element_type[meta_type][structIndex],
                          struct_element[meta_type][structIndex]);
          end for;
        end if;
        if meta_type in interfaceOfType then
          for interfaceType range interfaceOfType[meta_type] do
            addImplementationToInterface(sct_type, interfaceType);
          end for;
        end if;
      end if;
    end if;
  end func;


const proc: process_sct_create_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    object_type := getType(params[1]);
    createFunction @:= [object_type] current_object;
    typeCategory @:= [object_type] STRUCTOBJECT;
  end func;


const proc: process_sct_destr_declaration (in reference: current_object) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: object_type is void;
  begin
    params := formalParams(current_object);
    object_type := getType(params[1]);
    destrFunction @:= [object_type] current_object;
    typeCategory @:= [object_type] STRUCTOBJECT;
  end func;


const proc: process_sct_select_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: elemType is void;
    var type: structType is void;
    var reference: elementOfStruct is NIL;
  begin
    params := formalParams(current_object);
    if length(params) >= 3 and not isVar(params[1]) then
      structType := getType(params[1]);
      elementOfStruct := params[3];
      elemType := resultType(getType(current_object));
      addStructElem(structType, elemType, elementOfStruct);
      c_expr.expr &:= "/* struct element ";
      c_expr.expr &:= type_name2(elemType);
      c_expr.expr &:= " ** ";
      c_expr.expr &:= type_name2(structType);
      c_expr.expr &:= "->o_";
      create_name2(elementOfStruct, c_expr.expr);
      c_expr.expr &:= " = ";
      c_expr.expr &:= str(struct_element_idx[structType][elementOfStruct]);
      c_expr.expr &:= " */\n";
    end if;
  end func;


const proc: process_ref_select_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var type: elemType is void;
    var type: structType is void;
    var reference: elementOfStruct is NIL;
  begin
    params := formalParams(current_object);
    if length(params) >= 3 and not isVar(params[1]) then
      structType := getType(params[1]);
      elementOfStruct := params[3];
      elemType := resultType(getType(current_object));
      addStructElem(structType, elemType, elementOfStruct);
      c_expr.expr &:= "/* ref struct element ";
      c_expr.expr &:= type_name2(elemType);
      c_expr.expr &:= " ** ";
      c_expr.expr &:= type_name2(structType);
      c_expr.expr &:= "->o_";
      create_name2(elementOfStruct, c_expr.expr);
      c_expr.expr &:= " = ";
      c_expr.expr &:= str(struct_element_idx[structType][elementOfStruct]);
      c_expr.expr &:= " */\n";
    end if;
  end func;


const proc: process_var_action_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_value is expr_type.value;
    var string: valueName is "";
  begin
    create_name(current_object, objNumber(current_object), valueName);
    processFuncValue(valueName, getType(current_object), current_object, c_value);
    c_expr.expr &:= c_value.temp_decls;
    global_init.expr &:= diagnosticLine(current_object);
    global_init.expr &:= c_value.temp_assigns;
    c_expr.expr &:= type_name(getType(current_object));
    c_expr.expr &:= " o_";
    create_name(current_object, c_expr.expr);
    c_expr.expr &:= " = ";
    c_expr.expr &:= c_value.expr;
    c_expr.expr &:= ";\n\n";
    function_declared @:= [current_object] TRUE;
  end func;


const proc: process_action_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var ACTION: current_action is action "PRC_NOOP";
    var string: action_name is "";
  begin
    if isVar(current_object) then
      process_var_action_declaration(current_object, c_expr);
    else
      current_action := getValue(current_object, ACTION);
      action_name := str(current_action);
      if action_name = "PRC_DYNAMIC" then
        process_dynamic_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "ACT_CPY" then
        defineParam1TypeCategory(current_object, ACTOBJECT);
        count_declarations(c_expr);
      elsif action_name = "ARR_CPY" then
        process_arr_cpy_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "ARR_CREATE" then
        process_arr_create_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "ARR_DESTR" then
        process_arr_destr_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "ARR_GEN" then
        process_arr_gen_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "ARR_IDX" then
        process_arr_idx_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "ARR_TIMES" then
        process_arr_times_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "BIG_CPY" or action_name = "BIG_CREATE" then
        defineParam1TypeCategory(current_object, BIGINTOBJECT);
        count_declarations(c_expr);
      elsif action_name = "BLN_CPY" then
        defineParam1TypeCategory(current_object, BOOLOBJECT);
        count_declarations(c_expr);
      elsif action_name = "BST_CPY" or action_name = "BST_CREATE" then
        defineParam1TypeCategory(current_object, BSTRIOBJECT);
        count_declarations(c_expr);
      elsif action_name = "DRW_CPY" or action_name = "DRW_CREATE" then
        defineParam1TypeCategory(current_object, WINOBJECT);
        count_declarations(c_expr);
      elsif action_name = "PCS_CPY" or action_name = "PCS_CREATE" then
        defineParam1TypeCategory(current_object, PROCESSOBJECT);
        count_declarations(c_expr);
      elsif action_name = "ENU_CPY" then
        defineParam1TypeCategory(current_object, ENUMOBJECT);
        count_declarations(c_expr);
      elsif action_name = "FIL_CPY" or action_name = "FIL_CREATE" then
        defineParam1TypeCategory(current_object, FILEOBJECT);
        count_declarations(c_expr);
      elsif action_name = "FLT_CPY" or action_name = "FLT_CREATE" then
        defineParam1TypeCategory(current_object, FLOATOBJECT);
        count_declarations(c_expr);
      elsif action_name = "HSH_CPY" then
        process_hsh_cpy_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "HSH_CREATE" then
        process_hsh_create_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "HSH_DESTR" then
        process_hsh_destr_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "INT_CPY" or action_name = "INT_CREATE" then
        defineParam1TypeCategory(current_object, INTOBJECT);
        count_declarations(c_expr);
      elsif action_name = "ITF_CPY" then
        defineParam1TypeCategory(current_object, INTERFACEOBJECT);
        count_declarations(c_expr);
      elsif action_name = "ITF_CPY2" then
        process_itf_cpy2_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "POL_CPY" or action_name = "POL_CREATE" then
        defineParam1TypeCategory(current_object, POLLOBJECT);
        count_declarations(c_expr);
      elsif action_name = "POL_NEXT_FILE" then
        process_itf_next_file_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "PRG_CPY" or action_name = "PRG_CREATE" then
        defineParam1TypeCategory(current_object, PROGOBJECT);
        count_declarations(c_expr);
      elsif action_name = "REF_CPY" or action_name = "REF_CREATE" then
        defineParam1TypeCategory(current_object, REFOBJECT);
        count_declarations(c_expr);
      elsif action_name = "REF_SELECT" then
        process_ref_select_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "RFL_CPY" or action_name = "RFL_CREATE" then
        defineParam1TypeCategory(current_object, REFLISTOBJECT);
        count_declarations(c_expr);
      elsif action_name = "SCT_CPY" then
        process_sct_cpy_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "SCT_CREATE" then
        process_sct_create_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "SCT_DESTR" then
        process_sct_destr_declaration(current_object);
        count_declarations(c_expr);
      elsif action_name = "SCT_SELECT" then
        process_sct_select_declaration(current_object, c_expr);
        count_declarations(c_expr);
      elsif action_name = "SET_CPY" or action_name = "SET_CREATE" then
        defineParam1TypeCategory(current_object, SETOBJECT);
        count_declarations(c_expr);
      elsif action_name = "SOC_CPY" or action_name = "SOC_CREATE" then
        defineParam1TypeCategory(current_object, SOCKETOBJECT);
        count_declarations(c_expr);
      elsif action_name = "SQL_CPY_DB" or action_name = "SQL_CREATE_DB" then
        defineParam1TypeCategory(current_object, DATABASEOBJECT);
        count_declarations(c_expr);
      elsif action_name = "SQL_CPY_STMT" or action_name = "SQL_CREATE_STMT" then
        defineParam1TypeCategory(current_object, SQLSTMTOBJECT);
        count_declarations(c_expr);
(*
      else
        c_expr.expr &:= "/* ACTION ";
        c_expr.expr &:= action_name;
        c_expr.expr &:= " */";
*)
      end if;
    end if;
  end func;


const proc: process_object_declaration (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var category: objectCategory is category.value;
  begin
    objectCategory := category(current_object);
    if current_object = main_object then
      if category(current_object) = FORWARDOBJECT then
        process_library_initialisation(current_object, c_expr);
      else
        process_main_declaration(current_object, c_expr);
      end if;
    elsif objectCategory = BLOCKOBJECT then
      process_func_declaration(current_object, c_expr);
    elsif objectCategory = TYPEOBJECT then
      process_type_declaration(current_object, c_expr);
    elsif objectCategory = INTOBJECT then
      process_int_declaration(current_object, c_expr);
    elsif objectCategory = BIGINTOBJECT then
      process_bigint_declaration(current_object, c_expr);
    elsif objectCategory = CHAROBJECT then
      process_char_declaration(current_object, c_expr);
    elsif objectCategory = STRIOBJECT then
      process_stri_declaration(current_object, c_expr);
    elsif objectCategory = BSTRIOBJECT then
      process_bstri_declaration(current_object, c_expr);
    elsif objectCategory = FLOATOBJECT then
      process_float_declaration(current_object, c_expr);
    elsif objectCategory = REFOBJECT then
      process_reference_declaration(current_object, c_expr);
    elsif objectCategory = REFLISTOBJECT then
      process_ref_list_declaration(current_object, c_expr);
    elsif objectCategory = FILEOBJECT then
      process_file_declaration(current_object, c_expr);
    elsif objectCategory = SOCKETOBJECT then
      process_socket_declaration(current_object, c_expr);
    elsif objectCategory = POLLOBJECT then
      process_poll_declaration(current_object, c_expr);
    elsif objectCategory = ARRAYOBJECT then
      process_array_declaration(current_object, c_expr);
    elsif objectCategory = HASHOBJECT then
      process_hash_declaration(current_object, c_expr);
    elsif objectCategory = SETOBJECT then
      process_set_declaration(current_object, c_expr);
    elsif objectCategory = STRUCTOBJECT then
      process_struct_declaration(current_object, c_expr);
    elsif objectCategory = INTERFACEOBJECT then
      process_interface_declaration(current_object, c_expr);
    elsif objectCategory = WINOBJECT then
      process_win_declaration(current_object, c_expr);
    elsif objectCategory = PROCESSOBJECT then
      process_process_declaration(current_object, c_expr);
    elsif objectCategory = PROGOBJECT then
      process_prog_declaration(current_object, c_expr);
    elsif objectCategory = CONSTENUMOBJECT then
      process_enum_declaration(current_object, c_expr);
    elsif objectCategory = VARENUMOBJECT then
      process_enum_declaration(current_object, c_expr);
    elsif objectCategory = ENUMLITERALOBJECT then
      process_enum_literal_declaration(current_object, c_expr);
    elsif objectCategory = ACTOBJECT then
      process_action_declaration(current_object, c_expr);
    elsif objectCategory = FWDREFOBJECT then
      process_forward_declaration(current_object, c_expr);
    else
      c_expr.expr &:= "/* ";
      c_expr.expr &:= str(objectCategory);
      c_expr.expr &:= ": ";
      create_name2(current_object, c_expr.expr);
      c_expr.expr &:= " */\n";
    end if;
  end func;


const proc: replaceLocalsFromOutside (in reference: local_function,
    inout reference: current_expression, in ref_list: local_objects,
    inout ref_list: additional_act_params, inout ref_list: additional_form_params) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var integer: paramNum is 0;
    var reference: aParam is NIL;
    var category: paramCategory is category.value;
    var reference: formalRefParam is NIL;
  begin
    params := getValue(current_expression, ref_list);
    for paramNum range 2 to length(params) do
      aParam := params[paramNum];
      paramCategory := category(aParam);
      if paramCategory = MATCHOBJECT or paramCategory = CALLOBJECT then
        replaceLocalsFromOutside(local_function, aParam, local_objects,
            additional_act_params, additional_form_params);
      elsif paramCategory = LOCALVOBJECT or
            paramCategory = VALUEPARAMOBJECT or
            paramCategory = REFPARAMOBJECT or
            paramCategory = RESULTOBJECT then
        if aParam not in local_objects then
          if aParam in additional_act_params then
            formalRefParam := additional_form_params[pos(additional_act_params, aParam)];
          elsif local_function in params_added and
              aParam in params_added[local_function] then
            formalRefParam := params_added[local_function][aParam];
          else
            additional_act_params &:= make_list(aParam);
            formalRefParam := alloc(aParam);
            setCategory(formalRefParam, REFPARAMOBJECT);
            additional_form_params &:= make_list(formalRefParam);
          end if;
          params @:= [paramNum] formalRefParam;
        end if;
      end if;
    end for;
    setValue(current_expression, params);
  end func;


const proc: changeCallsOfLocalFunction (inout reference: current_expression,
    in reference: local_function, in ref_list: additional_params) is func

  local
    var ref_list: params is ref_list.EMPTY;
    var integer: paramNum is 0;
    var reference: aParam is NIL;
    var category: paramCategory is category.value;
  begin
    params := getValue(current_expression, ref_list);
    for paramNum range 2 to length(params) do
      aParam := params[paramNum];
      paramCategory := category(aParam);
      if paramCategory = MATCHOBJECT or paramCategory = CALLOBJECT then
        changeCallsOfLocalFunction(aParam, local_function, additional_params);
      elsif aParam = local_function then
        aParam := alloc(aParam);
        setCategory(aParam, MATCHOBJECT);
        setValue(aParam, make_list(params[paramNum]) & additional_params);
        params @:= [paramNum] aParam;
        setValue(current_expression, params);
      end if;
    end for;
    if params[1] = local_function then
      params &:= additional_params;
      setValue(current_expression, params);
    end if;
  end func;


const proc: changeCallsFromSubFunctions (in reference: parent_function,
    in reference: local_function, in ref_list: additional_params) is func

  local
    var reference: parent_body is NIL;
    var reference: obj is NIL;
  begin
    if parent_function <> local_function then
      parent_body := body(parent_function);
      changeCallsOfLocalFunction(parent_body, local_function, additional_params);
    end if;
    for obj range localConsts(parent_function) do
      if category(obj) = BLOCKOBJECT then
        changeCallsFromSubFunctions(obj, local_function, additional_params);
      end if;
    end for;
  end func;


const proc: adjustParamsToAdd (in reference: local_function,
    inout ref_list: additional_act_params, inout ref_list: additional_form_params) is func

  local
    var integer: paramNum is 0;
    var reference: actParam is NIL;
    var reference: formParam is NIL;
  begin
    if length(additional_act_params) <> 0 then
      if local_function not in params_added then
        params_added @:= [local_function] act_to_form_param_hash.value;
      end if;
      paramNum := 1;
      while paramNum <= length(additional_act_params) do
        actParam := additional_act_params[paramNum];
        if actParam in params_added[local_function] then
          additional_act_params := additional_act_params[.. pred(paramNum)] &
                                   additional_act_params[succ(paramNum) ..];
          additional_form_params := additional_form_params[.. pred(paramNum)] &
                                    additional_form_params[succ(paramNum) ..];
        else
          incr(paramNum);
        end if;
      end while;
      for paramNum range 1 to length(additional_act_params) do
        actParam := additional_act_params[paramNum];
        formParam := additional_form_params[paramNum];
        if actParam not in params_added[local_function] then
          params_added[local_function] @:= [actParam] formParam;
        end if;
      end for;
    end if;
  end func;


const func boolean: fixLocalFunction (in reference: parent_function,
    in reference: local_function) is func

  result
    var boolean: fix_done is FALSE;
  local
    var reference: body_expression is NIL;
    var category: bodyCategory is category.value;
    var ref_list: local_objects is ref_list.EMPTY;
    var ref_list: additional_act_params is ref_list.EMPTY;
    var ref_list: additional_form_params is ref_list.EMPTY;
  begin
    body_expression := body(local_function);
    bodyCategory := category(body_expression);
    if bodyCategory = MATCHOBJECT or bodyCategory = CALLOBJECT then
      local_objects := formalParams(local_function) & localVars(local_function) &
          make_list(resultVar(local_function));
      replaceLocalsFromOutside(local_function, body_expression, local_objects,
          additional_act_params, additional_form_params);
      adjustParamsToAdd(local_function, additional_act_params, additional_form_params);
      if length(additional_act_params) <> 0 then
        setFormalParams(local_function, formalParams(local_function) & additional_form_params);
        changeCallsOfLocalFunction(body_expression, local_function, additional_form_params);
        changeCallsFromSubFunctions(parent_function, local_function, additional_act_params);
        fix_done := TRUE;
      end if;
    end if;
  end func;


const proc: processLocalFunctions (in reference: current_object) is func

  local
    var ref_list: objects is ref_list.EMPTY;
    var reference: obj is NIL;
    var boolean: fix_done is FALSE;
  begin
    objects := localConsts(current_object);
    repeat
      fix_done := FALSE;
      for obj range objects do
        if category(obj) = BLOCKOBJECT then
          processLocalFunctions(obj);
          if fixLocalFunction(current_object, obj) then
            fix_done := TRUE;
          end if;
        end if;
      end for;
    until not fix_done;
  end func;


const proc: addTypeCategoryForLocalVars (in reference: function) is func

  local
    var ref_list: objects is ref_list.EMPTY;
    var reference: obj is NIL;
    var reference: object_value is NIL;
    var type: objectType is void;
    var category: valueCategory is category.value;
  begin
    objects := localVars(function);
    for obj range objects do
      object_value := getValue(obj, reference);
      valueCategory := category(object_value);
      objectType := getType(obj);
      if objectType = getType(object_value) and objectType not in typeCategory then
        typeCategory @:= [objectType] valueCategory;
      end if;
    end for;
  end func;


const proc: process_local_consts (in reference: function,
    inout expr_type: c_expr) is func

  local
    var ref_list: objects is ref_list.EMPTY;
    var reference: obj is NIL;
  begin
    addTypeCategoryForLocalVars(function);
    processLocalFunctions(function);
    objects := localConsts(function);
    for obj range objects do
      if category(obj) <> FWDREFOBJECT then
        declare_type_if_necessary(getType(obj), global_c_expr);
      end if;
      process_object_declaration(obj, c_expr);
    end for;
  end func;


const proc: process_object (in reference: current_object) is func

  local
    var expr_type: c_expr is expr_type.value;
  begin
    write_object_declaration := TRUE;
    process_object_declaration(current_object, c_expr);
    write(c_prog, global_c_expr.expr);
    if write_object_declaration then
      # writeln(c_prog, "/* " <& countDeclarations <& " */");
      write(c_prog, c_expr.expr);
(*
    else
      write(c_prog, "#ifdef WRITE_OBJECT_DECLARATION\n");
      write(c_prog, c_expr.expr);
      write(c_prog, "#endif\n");
*)
    end if;
    flush(c_prog);
    global_c_expr := expr_type.value;
  end func;


const proc: process_library_import_object (in reference: current_object) is func

  local
    var expr_type: c_expr is expr_type.value;
  begin
    process_object_declaration(current_object, c_expr);
    global_c_expr := expr_type.value;
  end func;


const proc: write_file_head is func

  begin
    writeln(c_prog, temp_marker);
    writeln(c_prog, "#include <stdlib.h>");
    writeln(c_prog, "#include <stdio.h>");
    writeln(c_prog, "#include <string.h>");
    writeln(c_prog, "#include <math.h>");
    writeln(c_prog, "#include <setjmp.h>");
    writeln(c_prog, "#include <signal.h>");
    writeln(c_prog, "typedef short int          int16Type;");
    writeln(c_prog, "typedef unsigned short int uint16Type;");
    writeln(c_prog, "typedef " <& ccConf.INT32TYPE <& " int32Type;");
    writeln(c_prog, "typedef " <& ccConf.UINT32TYPE <& " uint32Type;");
    writeln(c_prog, "typedef " <& ccConf.INT64TYPE <& " int64Type;");
    writeln(c_prog, "typedef " <& ccConf.UINT64TYPE <& " uint64Type;");
    if ccConf.INT128TYPE <> "" then
      writeln(c_prog, "typedef " <& ccConf.INT128TYPE <& " int128Type;");
      writeln(c_prog, "typedef " <& ccConf.UINT128TYPE <& " uint128Type;");
    end if;
    if ccConf.TWOS_COMPLEMENT_INTTYPE then
      writeln(c_prog, "#define INT32TYPE_MIN ((int32Type) -2147483648" <&
          ccConf.INT32TYPE_LITERAL_SUFFIX <& ")");
    else
      writeln(c_prog, "#define INT32TYPE_MIN             (-2147483647" <&
          ccConf.INT32TYPE_LITERAL_SUFFIX <& ")");
    end if;
    writeln(c_prog, "#define INT32TYPE_MAX               2147483647" <&
        ccConf.INT32TYPE_LITERAL_SUFFIX);
    if ccConf.INTTYPE_SIZE = 64 then
      writeln(c_prog, "#define INTTYPE_DECIMAL_SIZE 20");
      writeln(c_prog, "typedef int64Type intType;");
      writeln(c_prog, "typedef uint64Type uintType;");
      if ccConf.INT128TYPE <> "" then
        writeln(c_prog, "typedef int128Type doubleIntType;");
        writeln(c_prog, "typedef uint128Type doubleUintType;");
        writeln(c_prog, "#define inIntTypeRange(num) ((doubleIntType) (intType) (num) == (num))");
      end if;
    elsif ccConf.INTTYPE_SIZE = 32 then
      writeln(c_prog, "#define INTTYPE_DECIMAL_SIZE 11");
      writeln(c_prog, "typedef int32Type intType;");
      writeln(c_prog, "typedef uint32Type uintType;");
      writeln(c_prog, "typedef int64Type doubleIntType;");
      writeln(c_prog, "typedef uint64Type doubleUintType;");
      writeln(c_prog, "#define inIntTypeRange(num) ((doubleIntType) (intType) (num) == (num))");
    end if;
    writeln(c_prog, "typedef " <& ccConf.BOOLTYPE <& " boolType;");
    writeln(c_prog, "typedef int enumType;");
    if ccConf.FLOATTYPE_DOUBLE then
      writeln(c_prog, "typedef double floatType;");
    else
      writeln(c_prog, "typedef float floatType;");
    end if;
    writeln(c_prog, "typedef uint32Type charType;");
    writeln(c_prog, "typedef int32Type scharType;");
    writeln(c_prog, "typedef uint32Type strElemType;");
    writeln(c_prog, "typedef uintType bitSetType;");
    writeln(c_prog, "typedef uint" <& ccConf.POINTER_SIZE <& "Type memSizeType;");
    writeln(c_prog, "typedef FILE *cFileType;");
    writeln(c_prog, "typedef unsigned char *ustriType;");
    writeln(c_prog, "typedef const unsigned char *const_ustriType;");
    writeln(c_prog, "typedef struct striStruct {");
    writeln(c_prog, "  memSizeType size;");
    if ccConf.WITH_STRI_CAPACITY then
      writeln(c_prog, "  memSizeType capacity;");
    end if;
    if ccConf.ALLOW_STRITYPE_SLICES then
      writeln(c_prog, "  strElemType *mem;");
      writeln(c_prog, "  strElemType  mem1[1];");
    else
      writeln(c_prog, "  strElemType mem[1];");
    end if;
    writeln(c_prog, "} *striType;");
    writeln(c_prog, "typedef const struct striStruct  *const_striType;");
    writeln(c_prog, "#define SIZ_STRI(len) ((sizeof(struct striStruct) - sizeof(strElemType)) + (len) * sizeof(strElemType))");
    writeln(c_prog, "typedef struct bstriStruct {");
    writeln(c_prog, "  memSizeType size;");
    if ccConf.ALLOW_BSTRITYPE_SLICES then
      writeln(c_prog, "  unsigned char *mem;");
      writeln(c_prog, "  unsigned char  mem1[1];");
    else
      writeln(c_prog, "  unsigned char mem[1];");
    end if;
    writeln(c_prog, "} *bstriType;");
    writeln(c_prog, "typedef const struct bstriStruct  *const_bstriType;");
    writeln(c_prog, "typedef struct fileStruct {");
    writeln(c_prog, "  cFileType cFile;");
    writeln(c_prog, "  uintType usage_count;");
    writeln(c_prog, "} *fileType;");
    writeln(c_prog, "typedef const struct fileStruct  *const_fileType;");
    writeln(c_prog, "typedef struct setStruct {");
    writeln(c_prog, "  intType min_position;");
    writeln(c_prog, "  intType max_position;");
    writeln(c_prog, "  bitSetType bitset[1];");
    writeln(c_prog, "} *setType;");
    writeln(c_prog, "typedef const struct setStruct  *const_setType;");
    writeln(c_prog, "typedef struct {");
    writeln(c_prog, "  int dummy;");
    writeln(c_prog, "} bigIntRecord;");
    writeln(c_prog, "typedef bigIntRecord *bigIntType;");
    writeln(c_prog, "typedef const bigIntRecord *const_bigIntType;");
    writeln(c_prog, "typedef struct pollStruct {");
    writeln(c_prog, "  int dummy;");
    writeln(c_prog, "} *pollType;");
    writeln(c_prog, "typedef const struct pollStruct *const_pollType;");
    writeln(c_prog, "typedef struct winStruct {");
    writeln(c_prog, "  uintType usage_count;");
    writeln(c_prog, "} *winType;");
    writeln(c_prog, "typedef const struct winStruct *const_winType;");
    writeln(c_prog, "typedef struct processStruct {");
    writeln(c_prog, "  uintType usage_count;");
    writeln(c_prog, "  fileType stdIn;");
    writeln(c_prog, "  fileType stdOut;");
    writeln(c_prog, "  fileType stdErr;");
    writeln(c_prog, "} *processType;");
    writeln(c_prog, "typedef const struct processStruct *const_processType;");
    writeln(c_prog, "typedef struct databaseStruct {");
    writeln(c_prog, "  uintType usage_count;");
    writeln(c_prog, "} *databaseType;");
    writeln(c_prog, "typedef const struct databaseStruct *const_databaseType;");
    writeln(c_prog, "typedef struct sqlStmtStruct {");
    writeln(c_prog, "  uintType usage_count;");
    writeln(c_prog, "} *sqlStmtType;");
    writeln(c_prog, "typedef const struct sqlStmtStruct *const_sqlStmtType;");
    writeln(c_prog, "typedef struct progStruct {");
    writeln(c_prog, "  uintType usage_count;");
    writeln(c_prog, "} *progType;");
    writeln(c_prog, "typedef const struct progStruct *const_progType;");
    writeln(c_prog, "typedef struct typeStruct *typeType;");
    writeln(c_prog, "typedef const struct typeStruct *const_typeType;");
    writeln(c_prog, "typedef struct rtlArrayStruct *arrayType;");
    writeln(c_prog, "typedef const struct rtlArrayStruct *const_arrayType;");
    writeln(c_prog, "typedef struct rtlHashStruct *hashType;");
    writeln(c_prog, "typedef const struct rtlHashStruct *const_hashType;");
    writeln(c_prog, "typedef struct rtlStructStruct *structType;");
    writeln(c_prog, "typedef const struct rtlStructStruct *const_structType;");
    writeln(c_prog, "typedef struct rtlStructStruct *interfaceType;");
    writeln(c_prog, "typedef const struct rtlStructStruct *const_interfaceType;");
    writeln(c_prog, "typedef struct objectStruct *objRefType;");
    writeln(c_prog, "typedef const struct objectStruct *const_objRefType;");
    writeln(c_prog, "typedef struct listStruct *listType;");
    writeln(c_prog, "typedef const struct listStruct *const_listType;");
    writeln(c_prog, "typedef objRefType (*actType) (listType);");
    writeln(c_prog, "typedef int socketType;");
    writeln(c_prog, "typedef uint" <& ccConf.GENERIC_SIZE <& "Type genericType;");
    writeln(c_prog, "typedef union {");
    writeln(c_prog, "  genericType   genericValue;");
    writeln(c_prog, "  typeType      typeValue;");
    writeln(c_prog, "  boolType      boolValue;");
    writeln(c_prog, "  enumType      enumValue;");
    writeln(c_prog, "  intType       intValue;");
    writeln(c_prog, "  bigIntType    bigIntValue;");
    writeln(c_prog, "  floatType     floatValue;");
    writeln(c_prog, "  charType      charValue;");
    writeln(c_prog, "  striType      striValue;");
    writeln(c_prog, "  bstriType     bstriValue;");
    writeln(c_prog, "  fileType      fileValue;");
    writeln(c_prog, "  socketType    socketValue;");
    writeln(c_prog, "  pollType      pollValue;");
    writeln(c_prog, "  setType       setValue;");
    writeln(c_prog, "  winType       winValue;");
    writeln(c_prog, "  processType   processValue;");
    writeln(c_prog, "  progType      progValue;");
    writeln(c_prog, "  databaseType  databaseValue;");
    writeln(c_prog, "  sqlStmtType   sqlStmtValue;");
    writeln(c_prog, "  arrayType     arrayValue;");
    writeln(c_prog, "  hashType      hashValue;");
    writeln(c_prog, "  structType    structValue;");
    writeln(c_prog, "  interfaceType interfaceValue;");
    writeln(c_prog, "  objRefType    objRefValue;");
    writeln(c_prog, "  listType      listValue;");
    writeln(c_prog, "  actType       actValue;");
    writeln(c_prog, "} rtlValueUnion;");
    writeln(c_prog, "typedef union {");
    writeln(c_prog, "  genericType         genericValue;");
    writeln(c_prog, "  const_typeType      typeValue;");
    writeln(c_prog, "  boolType            boolValue;");
    writeln(c_prog, "  enumType            enumValue;");
    writeln(c_prog, "  intType             intValue;");
    writeln(c_prog, "  const_bigIntType    bigIntValue;");
    writeln(c_prog, "  floatType           floatValue;");
    writeln(c_prog, "  charType            charValue;");
    writeln(c_prog, "  const_striType      striValue;");
    writeln(c_prog, "  const_bstriType     bstriValue;");
    writeln(c_prog, "  fileType            fileValue;");
    writeln(c_prog, "  socketType          socketValue;");
    writeln(c_prog, "  const_pollType      pollValue;");
    writeln(c_prog, "  const_setType       setValue;");
    writeln(c_prog, "  const_winType       winValue;");
    writeln(c_prog, "  const_processType   processValue;");
    writeln(c_prog, "  const_progType      progValue;");
    writeln(c_prog, "  const_arrayType     arrayValue;");
    writeln(c_prog, "  const_hashType      hashValue;");
    writeln(c_prog, "  const_structType    structValue;");
    writeln(c_prog, "  const_interfaceType interfaceValue;");
    writeln(c_prog, "  const_objRefType    objRefValue;");
    writeln(c_prog, "  const_listType      listValue;");
    writeln(c_prog, "  actType             actValue;");
    writeln(c_prog, "} const_rtlValueUnion;");
    writeln(c_prog, "typedef struct rtlObjectStruct {");
    writeln(c_prog, "  rtlValueUnion value;");
    writeln(c_prog, "} rtlObjectType;");
    writeln(c_prog, "typedef const struct rtlObjectStruct const_rtlObjectType;");
    writeln(c_prog, "typedef intType (*intfunctype)();");
    writeln(c_prog, "typedef uint16Type categoryType;");
    writeln(c_prog, "struct objectStruct {");
    writeln(c_prog, "  typeType type_of;");
    writeln(c_prog, "  uint" <& ccConf.POINTER_SIZE <& "Type descriptor;");
    writeln(c_prog, "  rtlValueUnion value;");
    writeln(c_prog, "  categoryType objcategory;");
    writeln(c_prog, "};");
    writeln(c_prog, "struct typeStruct {");
    writeln(c_prog, "  objRefType match_obj;");
    writeln(c_prog, "  typeType meta;");
    writeln(c_prog, "  typeType func_type;");
    writeln(c_prog, "  typeType varfunc_type;");
    writeln(c_prog, "  typeType result_type;");
    writeln(c_prog, "  boolType is_varfunc_type;");
    writeln(c_prog, "  void *interfaces;");
    writeln(c_prog, "  void *name;");
    writeln(c_prog, "};");
    writeln(c_prog, "struct listStruct {");
    writeln(c_prog, "  listType next;");
    writeln(c_prog, "  objRefType obj;");
    writeln(c_prog, "};");
    writeln(c_prog, "struct rtlArrayStruct {");
    writeln(c_prog, "  intType min_position;");
    writeln(c_prog, "  intType max_position;");
    writeln(c_prog, "  rtlObjectType arr[1];");
    writeln(c_prog, "};");
    writeln(c_prog, "struct rtlStructStruct {");
    writeln(c_prog, "  memSizeType usage_count;");
    writeln(c_prog, "  uint32Type type_num;");
    writeln(c_prog, "  rtlObjectType stru[1];");
    writeln(c_prog, "};");
    writeln(c_prog, "typedef struct freeListElemStruct {");
    writeln(c_prog, "  struct freeListElemStruct *next;");
    writeln(c_prog, "} *freeListElemType;");
    writeln(c_prog, "typedef struct rtlHashElemStruct *hashElemType;");
    writeln(c_prog, "typedef const struct rtlHashElemStruct *const_hashElemType;");
    writeln(c_prog, "typedef struct rtlHashElemStruct *const hashElemType_const;");
    writeln(c_prog, "struct rtlHashElemStruct {");
    writeln(c_prog, "  hashElemType next_less;");
    writeln(c_prog, "  hashElemType next_greater;");
    writeln(c_prog, "  rtlObjectType key;");
    writeln(c_prog, "  rtlObjectType data;");
    writeln(c_prog, "};");
    writeln(c_prog, "struct rtlHashStruct {");
    writeln(c_prog, "  unsigned int bits;");
    writeln(c_prog, "  unsigned int mask;");
    writeln(c_prog, "  unsigned int table_size;");
    writeln(c_prog, "  memSizeType size;");
    writeln(c_prog, "  hashElemType table[1];");
    writeln(c_prog, "};");
    writeln(c_prog, "typedef struct hashElemListStruct {");
    writeln(c_prog, "  struct hashElemListStruct *next;");
    writeln(c_prog, "  hashElemType obj;");
    writeln(c_prog, "} *hashElemListType;");
    writeln(c_prog, "typedef union {");
    writeln(c_prog, "  uint32Type bits;");
    writeln(c_prog, "  float aFloat;");
    writeln(c_prog, "} float2BitsUnion;");
    writeln(c_prog, "typedef union {");
    writeln(c_prog, "  uint64Type bits;");
    writeln(c_prog, "  double aDouble;");
    writeln(c_prog, "} double2BitsUnion;");
    writeln(c_prog, "typedef intType (*compareType) (genericType, genericType);");
    writeln(c_prog, "typedef genericType (*createFuncType) (genericType);");
    writeln(c_prog, "typedef void (*destrFuncType) (genericType);");
    writeln(c_prog, "typedef void (*copyFuncType) (genericType *, genericType);");
    writeln(c_prog, "#define bitset_shift " <& log2(ccConf.INTTYPE_SIZE));
    writeln(c_prog, "#define bitset_mask  ((1 << bitset_shift) - 1)");
    if ccConf.RSHIFT_DOES_SIGN_EXTEND then
      writeln(c_prog, "#define bitset_pos(number) ((number)>>bitset_shift)");
    else
      writeln(c_prog, "#define bitset_pos(number) ((number)<0?~(~(number)>>bitset_shift):(number)>>bitset_shift)");
    end if;
    writeln(c_prog, "striType          arg_0;");
    writeln(c_prog, "striType          programName;");
    writeln(c_prog, "striType          programPath;");
    writeln(c_prog, "arrayType         arg_v;");
    if ccConf.ALLOW_STRITYPE_SLICES then
      writeln(c_prog, "extern struct striStruct str[];");
    else
      writeln(c_prog, "extern striType   str[];");
    end if;
    if ccConf.ALLOW_BSTRITYPE_SLICES then
      writeln(c_prog, "extern struct bstriStruct bst[];");
    else
      writeln(c_prog, "extern bstriType  bst[];");
    end if;
    writeln(c_prog, "extern setType          set[];");
    writeln(c_prog, "extern typeType         typ[];");
    writeln(c_prog, "extern double2BitsUnion nanValue[];");
    writeln(c_prog, "bigIntType             *big;");
    writeln(c_prog, "winType                *win;");
    writeln(c_prog, "arrayType              *arr;");
    writeln(c_prog, "structType             *sct;");
    writeln(c_prog, "hashType               *hsh;");
    writeln(c_prog, "interfaceType          *itf;");
    writeln(c_prog, "hashType               *caseLabels;");
    writeln(c_prog, "rtlValueUnion           flt2int;");
    writeln(c_prog, "extern memSizeType hs;");
    writeln(c_prog);
    writeln(c_prog, "static const intType fact[] = {");
    writeln(c_prog, "    1, 1, 2, 6, 24, 120, 720, 5040, 40320,");
    writeln(c_prog, "    362880, 3628800, 39916800, 479001600,");
    if ccConf.INTTYPE_SIZE = 64 then
      writeln(c_prog, "    6227020800, 87178291200, 1307674368000, 20922789888000,");
      writeln(c_prog, "    355687428096000, 6402373705728000, 121645100408832000,");
      writeln(c_prog, "    2432902008176640000");
    end if;
    writeln(c_prog, "  };");
    if ccConf.FLOAT_ZERO_DIV_ERROR then
      writeln(c_prog, "extern const rtlValueUnion f_const[];");
      writeln(c_prog, "#define NOT_A_NUMBER      f_const[0].floatValue");
      writeln(c_prog, "#define POSITIVE_INFINITY f_const[1].floatValue");
      writeln(c_prog, "#define NEGATIVE_INFINITY f_const[2].floatValue");
    else
      writeln(c_prog, "#define NOT_A_NUMBER      ( 0.0 / 0.0)");
      writeln(c_prog, "#define POSITIVE_INFINITY ( 1.0 / 0.0)");
      writeln(c_prog, "#define NEGATIVE_INFINITY (-1.0 / 0.0)");
    end if;
    writeln(c_prog, "extern const floatType negativeZero;");
    writeln(c_prog, "extern struct fileStruct nullFileRecord;");
    writeln(c_prog, "extern struct fileStruct stdinFileRecord;");
    writeln(c_prog, "extern struct fileStruct stdoutFileRecord;");
    writeln(c_prog, "extern struct fileStruct stderrFileRecord;");
    writeln(c_prog, "typedef int errInfoType;");
    writeln(c_prog, "#define OKAY_NO_ERROR   0");
    writeln(c_prog, "#define MEMORY_ERROR    1");
    writeln(c_prog, "#define NUMERIC_ERROR   2");
    writeln(c_prog, "#define OVERFLOW_ERROR  3");
    writeln(c_prog, "#define RANGE_ERROR     4");
    writeln(c_prog, "#define INDEX_ERROR     5");
    writeln(c_prog, "#define FILE_ERROR      6");
    writeln(c_prog, "#define DATABSE_ERROR   7");
    writeln(c_prog, "#define ACTION_ERROR    8");
    writeln(c_prog, "#define CREATE_ERROR    9");
    writeln(c_prog, "#define DESTROY_ERROR  10");
    writeln(c_prog, "#define COPY_ERROR     11");
    writeln(c_prog, "#define IN_ERROR       12");
    writeln(c_prog, "static const char *exception_name[] = {");
    writeln(c_prog, "    \"OKAY_NO_ERROR\",");
    writeln(c_prog, "    \"MEMORY_ERROR\",");
    writeln(c_prog, "    \"NUMERIC_ERROR\",");
    writeln(c_prog, "    \"OVERFLOW_ERROR\",");
    writeln(c_prog, "    \"RANGE_ERROR\",");
    writeln(c_prog, "    \"INDEX_ERROR\",");
    writeln(c_prog, "    \"FILE_ERROR\",");
    writeln(c_prog, "    \"DATABASE_ERROR\",");
    writeln(c_prog, "    \"ACTION_ERROR\",");
    writeln(c_prog, "    \"CREATE_ERROR\",");
    writeln(c_prog, "    \"DESTROY_ERROR\",");
    writeln(c_prog, "    \"COPY_ERROR\",");
    writeln(c_prog, "    \"IN_ERROR\",");
    writeln(c_prog, "  };");
    writeln(c_prog, ccConf.MACRO_DEFS);
    writeln(c_prog, "#define ovfChk(x) unlikely(x)");
    writeln(c_prog, "#define divChk(x) unlikely(x)");
    writeln(c_prog, "#define numChk(x) unlikely(x)");
    writeln(c_prog, "#define idxChk(x) unlikely(x)");
    writeln(c_prog, "#define rngChk(x) unlikely(x)");
    writeln(c_prog, "#define push_stack(stack,elem) \\");
    writeln(c_prog, "{\\");
    writeln(c_prog, "  hashElemListType new_head = (hashElemListType)(malloc(sizeof(struct hashElemListStruct)));\\");
    writeln(c_prog, "  if (new_head == NULL) {\\");
    writeln(c_prog, "    raiseError(MEMORY_ERROR);\\");
    writeln(c_prog, "  } else {\\");
    writeln(c_prog, "    new_head->next = stack;\\");
    writeln(c_prog, "    new_head->obj = elem;\\");
    writeln(c_prog, "    stack = new_head;\\");
    writeln(c_prog, "  }\\");
    writeln(c_prog, "}");
    writeln(c_prog, "#define pop_stack(stack,elem) \\");
    writeln(c_prog, "{\\");
    writeln(c_prog, "  hashElemListType old_head = stack;\\");
    writeln(c_prog, "  if (old_head == NULL) {\\");
    writeln(c_prog, "    elem = NULL;\\");
    writeln(c_prog, "  } else {\\");
    writeln(c_prog, "    stack = old_head->next;\\");
    writeln(c_prog, "    elem = old_head->obj;\\");
    writeln(c_prog, "    free(old_head);\\");
    writeln(c_prog, "  }\\");
    writeln(c_prog, "}");
    if ccConf.HAS_SIGSETJMP then
      writeln(c_prog, "#define do_setjmp(jump_buf) sigsetjmp(jump_buf, 1)");
      writeln(c_prog, "typedef sigjmp_buf catch_type;");
    else
      writeln(c_prog, "#define do_setjmp(jump_buf) setjmp(jump_buf)");
      writeln(c_prog, "typedef jmp_buf catch_type;");
    end if;
    writeln(c_prog, "catch_type *catch_stack;");
    writeln(c_prog, "size_t catch_stack_pos;");
    writeln(c_prog, "size_t max_catch_stack;");
    writeln(c_prog, "const char *error_file = NULL;");
    writeln(c_prog, "int error_line = 0;");
    if profile_function then
      writeln(c_prog, "intType timMicroSec (void);");
      writeln(c_prog, "static unsigned int profile_size;");
      writeln(c_prog, "struct profileElement {");
      writeln(c_prog, "  intType time;");
      writeln(c_prog, "  intType count;");
      writeln(c_prog, "  intType depth;");
      writeln(c_prog, "  char *file;");
      writeln(c_prog, "  intType line;");
      writeln(c_prog, "  char *name;");
      writeln(c_prog, "};");
      writeln(c_prog, "static struct profileElement profile[];");
      writeln(c_prog, "static void initProfile (void);");
      writeln(c_prog, "static int cmpProfileElement (const void *elem1, const void *elem2)");
      writeln(c_prog, "{");
      writeln(c_prog, "  int signumValue;");
      writeln(c_prog, "  if (((struct profileElement *) elem1)->time <");
      writeln(c_prog, "      ((struct profileElement *) elem2)->time) {");
      writeln(c_prog, "    signumValue = 1;");
      writeln(c_prog, "  } else if (((struct profileElement *) elem1)->time >");
      writeln(c_prog, "             ((struct profileElement *) elem2)->time) {");
      writeln(c_prog, "    signumValue = -1;");
      writeln(c_prog, "  } else if (((struct profileElement *) elem1)->count <");
      writeln(c_prog, "             ((struct profileElement *) elem2)->count) {");
      writeln(c_prog, "    signumValue = 1;");
      writeln(c_prog, "  } else if (((struct profileElement *) elem1)->count >");
      writeln(c_prog, "             ((struct profileElement *) elem2)->count) {");
      writeln(c_prog, "    signumValue = -1;");
      writeln(c_prog, "  } else {");
      writeln(c_prog, "    signumValue = strcmp(((struct profileElement *) elem1)->name,");
      writeln(c_prog, "                         ((struct profileElement *) elem2)->name);");
      writeln(c_prog, "  }");
      writeln(c_prog, "  return signumValue;");
      writeln(c_prog, "}");
    end if;
  end func;


const proc: declareExtern (in string: prototype) is func

  begin
    write(c_prog, "extern ");
    if declare_with_extern_c then
      write(c_prog, "\"C\" ");
    end if;
    writeln(c_prog, prototype);
  end func;


const proc: write_prototypes is func

  begin
    act_prototypes(c_prog);
    arr_prototypes(c_prog);
    big_prototypes(c_prog);
    bin_prototypes(c_prog);
    bln_prototypes(c_prog);
    bst_prototypes(c_prog);
    chr_prototypes(c_prog);
    cmd_prototypes(c_prog);
    con_prototypes(c_prog);
    drw_prototypes(c_prog);
    fil_prototypes(c_prog);
    flt_prototypes(c_prog);
    gkb_prototypes(c_prog);
    hsh_prototypes(c_prog);
    int_prototypes(c_prog);
    itf_prototypes(c_prog);
    kbd_prototypes(c_prog);
    pcs_prototypes(c_prog);
    pol_prototypes(c_prog);
    prc_prototypes(c_prog);
    prg_prototypes(c_prog);
    ref_prototypes(c_prog);
    rfl_prototypes(c_prog);
    set_prototypes(c_prog);
    soc_prototypes(c_prog);
    sql_prototypes(c_prog);
    str_prototypes(c_prog);
    tim_prototypes(c_prog);
    typ_prototypes(c_prog);
    ut8_prototypes(c_prog);
    if ccConf.USE_WMAIN then
      declareExtern("arrayType   getArgv (const int, wchar_t *const *const, striType *, striType *, striType *);");
    else
      declareExtern("arrayType   getArgv (const int, char *const *const, striType *, striType *, striType *);");
    end if;
    declareExtern("intType     heapsize (void);");
    declareExtern("void        setupStack (void);");
    declareExtern("void        setupFiles (void);");
    declareExtern("void        setupRand (void);");
    declareExtern("void        setupFloat (void);");
    declareExtern("void        setupBig (void);");
    writeln(c_prog, "static void        prcNoop (void) {}");
    writeln(c_prog, "static void        init_values (void);");
    writeln(c_prog, "static void        init_globals (void);");
    declareExtern("void        initPollOperations (const createFuncType, const destrFuncType);");
    declareExtern("void        genericCpy (genericType *const, const genericType);");
    declareExtern("genericType genericCreate (genericType);");
    declareExtern("void        genericDestr (genericType);");
    declareExtern("intType     ptrCmp (const void *const, const void *const);");
    declareExtern("intType     ptrCmpGeneric (const genericType, const genericType);");
    declareExtern("void        ptrCpyGeneric (genericType *const, const genericType);");
    declareExtern("genericType ptrCreateGeneric (const genericType);");
    writeln(c_prog, "typedef void (*suspendInterprType) (int signalNum);");
    declareExtern("void        setupSignalHandlers (boolType, boolType, boolType, boolType, suspendInterprType);");
    declareExtern("void        triggerSigfpe (void);");
    declareExtern("void        rtlRaiseError (int, const char *, int) NORETURN;");
    writeln(c_prog, "#define raiseError(num) rtlRaiseError(num, __FILE__, __LINE__)");
    writeln(c_prog, "#define intRaiseError(num) (rtlRaiseError(num, __FILE__, __LINE__), 0)");
    writeln(c_prog, "#define bigRaiseError(num) (bigIntType)(rtlRaiseError(num, __FILE__, __LINE__), NULL)");
    writeln(c_prog, "#define strRaiseError(num) (striType)(rtlRaiseError(num, __FILE__, __LINE__), NULL)");
    writeln(c_prog, "#define refRaiseError(num) (objRefType)(rtlRaiseError(num, __FILE__, __LINE__), NULL)");
(*
    declareExtern("intType     enuValue (objRefType a)                         {printf(\"enuValue\\n\");}");
    declareExtern("intType     enuValue (objRefType);");
*)
    if trace_signal then
      writeln(c_prog, "#define filGetc(inFile) filGetcChkCtrlC(inFile)");
      writeln(c_prog, "#define filGets(inFile, length) filGetsChkCtrlC(inFile, length)");
      writeln(c_prog, "#define filHasNext(inFile) filHasNextChkCtrlC(inFile)");
      writeln(c_prog, "#define filLineRead(inFile, terminationChar) filLineReadChkCtrlC(inFile, terminationChar)");
      writeln(c_prog, "#define filWordRead(inFile, terminationChar) filWordReadChkCtrlC(inFile, terminationChar)");
    else
      writeln(c_prog, "#define filGetc(inFile) (unlikely((inFile)->cFile==NULL)?intRaiseError(FILE_ERROR):fgetc((inFile)->cFile))");
    end if;
  end func;


const proc: write_resize_catch_stack is func

  begin
    writeln(c_prog);
    writeln(c_prog);
    writeln(c_prog, "static void resize_catch_stack (void)");
    writeln(c_prog);
    writeln(c_prog, "  {");
    writeln(c_prog, "    catch_type *resized_stack;");
    writeln(c_prog);
    writeln(c_prog, "    max_catch_stack += 128;");
    writeln(c_prog, "    resized_stack = (catch_type *)(realloc(catch_stack, max_catch_stack));");
    writeln(c_prog, "    if (resized_stack == NULL) {");
    writeln(c_prog, "      catch_stack_pos--;");
    writeln(c_prog, "      raiseError(MEMORY_ERROR);");
    writeln(c_prog, "    } else {");
    writeln(c_prog, "      catch_stack = resized_stack;");
    writeln(c_prog, "    }");
    writeln(c_prog, "  }");
    writeln(c_prog);
    writeln(c_prog);
  end func;


const proc: initPollOperations (inout expr_type: c_expr) is func

  begin
    if fileInterfaceType <> void then
      c_expr.expr &:= "initPollOperations((createFuncType)(&itfCreate), ";
      process_destr_declaration(fileInterfaceType, global_c_expr);
      c_expr.expr &:= "(destrFuncType)(&destr_";
      c_expr.expr &:= str(typeNumber(fileInterfaceType));
      c_expr.expr &:= "));\n";
    end if;
  end func;


const func ref_list: determine_multiple_array_elements (in ref_list: array_list) is func

  result
    var ref_list: elements_to_walk is ref_list.EMPTY;
  local
    var reference: element is NIL;
    var reference: previous_element is NIL;
    var reference: repeat_block_element is NIL;
    var integer: repeat_count is 0;
  begin
    for element range array_list do
      if previous_element <> NIL then
        if identical_values(previous_element, element) then
          if repeat_block_element = NIL then
            repeat_block_element := previous_element;
            repeat_count := 2;
          else
            incr(repeat_count);
          end if;
        else
          elements_to_walk &:= make_list(element);
          if repeat_block_element <> NIL then
            element_repeat_count @:= [repeat_block_element] repeat_count;
            repeat_block_element := NIL;
          end if;
        end if;
      else
        elements_to_walk &:= make_list(element);
      end if;
      previous_element := element;
    end for;
    if repeat_block_element <> NIL then
      element_repeat_count @:= [repeat_block_element] repeat_count;
    end if;
  end func;


const proc: walk_const_list (in ref_list: const_list, inout ref_list: sorted_list) is func

  local
    var reference: current_object is NIL;
    var reference: struct_of_interface is NIL;
    var category: objectCategory is category.value;
    var ref_list: elements_to_walk is ref_list.EMPTY;
  begin
    for current_object range const_list do
      objectCategory := category(current_object);
      if objectCategory = BIGINTOBJECT then
        if getValue(current_object, bigInteger) not in bigint_const_table then
          bigint_const_table @:= [getValue(current_object, bigInteger)] length(bigint_const_table);
        end if;
      elsif objectCategory = STRIOBJECT then
        if getValue(current_object, string) not in stri_const_table then
          stri_const_table @:= [getValue(current_object, string)] length(stri_const_table);
        end if;
      elsif objectCategory = BSTRIOBJECT then
        if getValue(current_object, bstring) not in bstri_const_table then
          bstri_const_table @:= [getValue(current_object, bstring)] length(bstri_const_table);
        end if;
      elsif objectCategory = SETOBJECT then
        if getValue(current_object, bitset) not in set_const_table then
          set_const_table @:= [getValue(current_object, bitset)] length(set_const_table);
        end if;
      elsif objectCategory = WINOBJECT then
        if getValue(current_object, PRIMITIVE_WINDOW) not in win_const_table then
          win_const_table @:= [getValue(current_object, PRIMITIVE_WINDOW)] length(win_const_table);
        end if;
      elsif objectCategory = ARRAYOBJECT then
        if current_object not in const_table then
          const_table @:= [current_object] length(const_table);
        end if;
        elements_to_walk := determine_multiple_array_elements(arrayToList(current_object));
        walk_const_list(elements_to_walk, sorted_list);
        sorted_list &:= make_list(current_object);
      elsif objectCategory = STRUCTOBJECT then
        if current_object not in const_table then
          const_table @:= [current_object] length(const_table);
        end if;
        walk_const_list(structToList(current_object), sorted_list);
        sorted_list &:= make_list(current_object);
      elsif objectCategory = HASHOBJECT then
        if current_object not in const_table then
          const_table @:= [current_object] length(const_table);
        end if;
        walk_const_list(hashKeysToList(current_object), sorted_list);
        walk_const_list(hashDataToList(current_object), sorted_list);
        sorted_list &:= make_list(current_object);
      elsif objectCategory = INTERFACEOBJECT then
        if current_object not in const_table then
          const_table @:= [current_object] length(const_table);
        end if;
        struct_of_interface := interfaceToStruct(current_object);
        if struct_of_interface not in const_table then
          const_table @:= [struct_of_interface] length(const_table);
          walk_const_list(structToList(struct_of_interface), sorted_list);
          sorted_list &:= make_list(struct_of_interface);
        elsif const_table[struct_of_interface] >= const_table[current_object] then
          sorted_list &:= make_list(struct_of_interface);
        end if;
        sorted_list &:= make_list(current_object);
      elsif objectCategory = MATCHOBJECT or objectCategory = ACTOBJECT or
          objectCategory = BLOCKOBJECT then
        if current_object not in const_table then
          const_table @:= [current_object] length(const_table);
        end if;
        sorted_list &:= make_list(current_object);
      end if;
    end for;
  end func;


const proc: prepare_func_literal (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var expr_type: c_value is expr_type.value;
    var string: valueName is "";
  begin
    create_name(current_object, objNumber(current_object), valueName);
    processFuncValue(valueName, getType(current_object), current_object, c_value);
    global_c_expr.expr &:= c_value.temp_decls;
    global_init.expr &:= diagnosticLine(current_object);
    global_init.expr &:= c_value.temp_assigns;
    function_declared @:= [current_object] TRUE;
  end func;


const proc: process_func_literal (in reference: current_object,
    inout expr_type: c_expr) is func

  local
    var string: valueName is "";
  begin
    create_name(current_object, objNumber(current_object), valueName);
    c_expr.expr &:= "&funcvalue_";
    c_expr.expr &:= valueName;
  end func;


const proc: process_pollData_literal (in var pollData: aPollData,
    inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "polEmpty()";
  end func;


const proc: init_const_value (in reference: current_object, inout expr_type: c_expr) is func

  local
    var category: objectCategory is category.value;
  begin
    objectCategory := category(current_object);
    if objectCategory = INTOBJECT then
      c_expr.expr &:= ".value.intValue=";
      c_expr.expr &:= integerLiteral(getValue(current_object, integer));
    elsif objectCategory = BIGINTOBJECT then
      c_expr.expr &:= ".value.bigIntValue=";
      c_expr.expr &:= bigIntegerLiteral(getValue(current_object, bigInteger));
    elsif objectCategory = CHAROBJECT then
      c_expr.expr &:= ".value.charValue=";
      c_expr.expr &:= charLiteral(getValue(current_object, char));
    elsif objectCategory = STRIOBJECT then
      c_expr.expr &:= ".value.striValue=";
      c_expr.expr &:= stringLiteral(getValue(current_object, string));
    elsif objectCategory = BSTRIOBJECT then
      c_expr.expr &:= ".value.bstriValue=";
      c_expr.expr &:= bstriLiteral(getValue(current_object, bstring));
    elsif objectCategory = SETOBJECT then
      c_expr.expr &:= ".value.setValue=";
      c_expr.expr &:= bitsetLiteral(getValue(current_object, bitset));
    elsif objectCategory = FLOATOBJECT then
      c_expr.expr &:= ".value.floatValue=";
      c_expr.expr &:= floatLiteral(getValue(current_object, float));
    elsif objectCategory = REFOBJECT then
      c_expr.expr &:= ".value.objRefValue=";
      if getValue(current_object, reference) = NIL then
        c_expr.expr &:= "NULL";
      else
        c_expr.expr &:= "(objRefType)(&(";
        process_expr(getValue(current_object, reference), c_expr);
        c_expr.expr &:= "))";
      end if;
    elsif objectCategory = FILEOBJECT then
      c_expr.expr &:= ".value.fileValue=&";
      c_expr.expr &:= lower(literal(getValue(current_object, clib_file)));
      c_expr.expr &:= "FileRecord";
    elsif objectCategory = SOCKETOBJECT then
      c_expr.expr &:= ".value.intValue=";
      c_expr.expr &:= "-1";
    elsif objectCategory = POLLOBJECT then
      c_expr.expr &:= ".value.pollValue=";
      process_pollData_literal(getValue(current_object, pollData), c_expr);
    elsif objectCategory = WINOBJECT then
      c_expr.expr &:= ".value.winValue=drwCreate(";
      c_expr.expr &:= windowLiteral(getValue(current_object, PRIMITIVE_WINDOW));
      c_expr.expr &:= ")";
    elsif objectCategory = PROCESSOBJECT then
      c_expr.expr &:= ".value.processValue=";
      c_expr.expr &:= "NULL";
    elsif objectCategory = TYPEOBJECT then
      c_expr.expr &:= ".value.typeValue=";
      c_expr.expr &:= typeLiteral(getValue(current_object, type));
    elsif objectCategory = CONSTENUMOBJECT then
      c_expr.expr &:= select_value_from_rtlObjectStruct(
          getType(getValue(current_object, reference)));
      c_expr.expr &:= "=";
      c_expr.expr &:= enum_value(getValue(current_object, reference));
    elsif objectCategory = VARENUMOBJECT then
      c_expr.expr &:= select_value_from_rtlObjectStruct(
          getType(getValue(current_object, reference)));
      c_expr.expr &:= "=";
      c_expr.expr &:= enum_value(getValue(current_object, reference));
    elsif objectCategory = ARRAYOBJECT then
      c_expr.expr &:= ".value.arrayValue=";
      c_expr.expr &:= "arr[";
      c_expr.expr &:= str(const_table[current_object]);
      c_expr.expr &:= "]";
    elsif objectCategory = STRUCTOBJECT then
      c_expr.expr &:= ".value.structValue=";
      c_expr.expr &:= "sct[";
      c_expr.expr &:= str(const_table[current_object]);
      c_expr.expr &:= "]";
    elsif objectCategory = HASHOBJECT then
      c_expr.expr &:= ".value.hashValue=";
      c_expr.expr &:= "hsh[";
      c_expr.expr &:= str(const_table[current_object]);
      c_expr.expr &:= "]";
    elsif objectCategory = INTERFACEOBJECT then
      c_expr.expr &:= ".value.interfaceValue=itfCreate(itf[";
      c_expr.expr &:= str(const_table[current_object]);
      c_expr.expr &:= "])";
    elsif objectCategory = MATCHOBJECT or objectCategory = ACTOBJECT or
        objectCategory = BLOCKOBJECT then
      c_expr.expr &:= ".value.genericValue=";
      process_func_literal(current_object, c_expr);
    else
      c_expr.expr &:= "/* ";
      c_expr.expr &:= str(objectCategory);
      c_expr.expr &:= " */";
    end if;
  end func;


const func string: int32AsFourBytes (in integer: number) is func
  result
    var string: stri is "";
  begin
    if ccConf.LITTLE_ENDIAN_INTTYPE then
      stri := bytes(number, UNSIGNED, LE, 4);
    else
      stri := bytes(number, UNSIGNED, BE, 4);
    end if;
  end func;


const func string: int64AsEightBytes (in integer: number) is func
  result
    var string: stri is "";
  begin
    if ccConf.LITTLE_ENDIAN_INTTYPE then
      stri := bytes(number, UNSIGNED, LE, 8);
    else
      stri := bytes(number, UNSIGNED, BE, 8);
    end if;
  end func;


const func string: int64AsTwoInt32 (in bigInteger: number) is func

  result
    var string: literals is "";
  begin
    if ccConf.LITTLE_ENDIAN_INTTYPE then
      literals := str( number        mod 16#100000000_) &
                  "," &
                  str((number >> 32) mod 16#100000000_) &
                  ",";
    else
      literals := str((number >> 32) mod 16#100000000_) &
                  "," &
                  str( number        mod 16#100000000_) &
                  ",";
    end if;
  end func;


const proc: init_bigint_constants is func

  local
    var bigint_index_hash: bigint_index is bigint_index_hash.EMPTY_HASH;
    var integer: number is 0;
    var bstring: bstri is bstring.value;
  begin
    bigint_index := flip(bigint_const_table);
    for number range sort(keys(bigint_index)) do
      bstri := bStriLe(bigint_index[number][1], TRUE);
      if bstri not in bstri_const_table then
        bstri_const_table @:= [bstri] length(bstri_const_table);
      end if;
      bigint_bstri_table @:= [number] bstri_const_table[bstri];
    end for;
  end func;


const proc: assign_bigint_constants (inout expr_type: c_expr) is func

  local
    var bigint_index_hash: bigint_index is bigint_index_hash.EMPTY_HASH;
    var bigInteger: big1 is bigInteger.value;
    var integer: number is 0;
  begin
    if length(bigint_const_table) = 0 then
      c_expr.expr &:= "big = NULL;\n";
    else
      c_expr.expr &:= "big = (bigIntType *)(malloc(";
      c_expr.expr &:= str(length(bigint_const_table));
      c_expr.expr &:= " * sizeof(bigIntType)));\n";
      bigint_index := flip(bigint_const_table);
      for number range sort(keys(bigint_index)) do
        big1 := bigint_index[number][1];
        c_expr.expr &:= "big[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "]=bigFromBStriLe(";
        if ccConf.ALLOW_BSTRITYPE_SLICES then
          c_expr.expr &:= "&";
        end if;
        c_expr.expr &:= "bst[";
        c_expr.expr &:= str(bigint_bstri_table[number]);
        c_expr.expr &:= "], 1);";
        if bitLength(big1) <= MAX_SHOWN_BIGINT_LITERAL_BITLENGTH then
          c_expr.expr &:= " /* ";
          c_expr.expr &:= str(big1);
          c_expr.expr &:= " */";
        end if;
        c_expr.expr &:= "\n";
      end for;
    end if;
  end func;


const proc: init_win_constants is func

  local
    var win_index_hash: win_index is win_index_hash.EMPTY_HASH;
    var PRIMITIVE_WINDOW: win1 is PRIMITIVE_WINDOW.value;
    var integer: number is 0;
    var integer: line is 0;
    var integer: column is 0;
    var pixel: pix is pixel.value;
    var string: image is "";
    var bstring: bImage is bstring.value;
  begin
    win_index := flip(win_const_table);
    for number range sort(keys(win_index)) do
      win1 := win_index[number][1];
      if width(win1) <> 0 or height(win1) <> 0 then
        bImage := getImage(win1);
        if bImage not in bstri_const_table then
          bstri_const_table @:= [bImage] length(bstri_const_table);
        end if;
        win_bstri_table @:= [number] bstri_const_table[bImage];
      end if;
    end for;
  end func;


const proc: assign_win_constants (inout expr_type: c_expr) is func

  local
    var win_index_hash: win_index is win_index_hash.EMPTY_HASH;
    var PRIMITIVE_WINDOW: win1 is PRIMITIVE_WINDOW.value;
    var integer: number is 0;
  begin
    if length(win_const_table) = 0 then
      c_expr.expr &:= "win = NULL;\n";
    else
      c_expr.expr &:= "win = (winType *)(malloc(";
      c_expr.expr &:= str(length(win_const_table));
      c_expr.expr &:= " * sizeof(winType)));\n";
      win_index := flip(win_const_table);
      for number range sort(keys(win_index)) do
        win1 := win_index[number][1];
        c_expr.expr &:= "win[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "]=";
        if width(win1) = 0 and height(win1) = 0 then
          c_expr.expr &:= "drwEmpty();\n";
        else
          c_expr.expr &:= "drwImage((int32Type *)((";
          if ccConf.ALLOW_BSTRITYPE_SLICES then
            c_expr.expr &:= "&";
          end if;
          c_expr.expr &:= "bst[";
          c_expr.expr &:= str(win_bstri_table[number]);
          c_expr.expr &:= "])->mem), ";
          c_expr.expr &:= str(width(win1));
          c_expr.expr &:= ", ";
          c_expr.expr &:= str(height(win1));
          c_expr.expr &:= ");\n";
        end if;
      end for;
    end if;
  end func;


const proc: write_striChars (in string: striChars, inout expr_type: c_expr) is func
  local
    var integer: countChars is 0;
    var char: ch is ' ';
  begin
    if length(striChars) <> 0 then
      c_expr.expr &:= "static strElemType striChars[";
      c_expr.expr &:= str(length(striChars));
      c_expr.expr &:= "]={\n";
      for ch range striChars do
        c_expr.expr &:= c_literal(ch);
        c_expr.expr &:= ",";
        incr(countChars);
        if countChars = 20 then
          c_expr.expr &:= "\n";
          countChars := 0;
        end if;
      end for;
      c_expr.expr &:= "};\n\n";
    end if;
  end func;


const proc: write_str_table (in stri_index_hash: stri_index,
    in array integer: stringPosition, inout expr_type: c_expr) is func
  local
    var integer: number is 0;
    var string: stri is "";
  begin
    c_expr.expr &:= "struct striStruct str[]={\n";
    if length(stri_const_table) > 0 then
      for number range 0 to pred(length(stri_const_table)) do
        stri := stri_index[number][1];
        c_expr.expr &:= "/* str[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "] */ {";
        c_expr.expr &:= str(length(stri));
        c_expr.expr &:= ",";
        if ccConf.WITH_STRI_CAPACITY then
          c_expr.expr &:= str(length(stri));
          c_expr.expr &:= ",";
        end if;
        if stri = "" then
          c_expr.expr &:= "NULL";
        else
          c_expr.expr &:= "&striChars[";
          c_expr.expr &:= str(pred(stringPosition[number]));
          c_expr.expr &:= "]";
        end if;
        c_expr.expr &:= "},";
        c_expr.expr &:= stringInComment(stri);
        c_expr.expr &:= "\n";
      end for;
    else
      c_expr.expr &:= "/* dummy */ {0,";
      if ccConf.WITH_STRI_CAPACITY then
        c_expr.expr &:= "0,";
      end if;
      c_expr.expr &:= "NULL}";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: init_string_constants_with_slices (in stri_index_hash: stri_index,
    inout expr_type: c_expr) is func

  local
    var stringLengthHash: stringLengths is stringLengthHash.value;
    var lengthToStriNumHash: lengthToStriNum is lengthToStriNumHash.value;
    var array integer: lengthList is 0 times 0;
    var integer: lengthIndex is 0;
    var integer: length is 0;
    var array integer: stringPosition is 0 times 0;
    var integer: number is 0;
    var string: stri is "";
    var integer: combinedStriLength is 0;
    var string: striChars is "";
    var integer: striPos is 0;
    var integer: striIndex is 0;
    var boolean: found is FALSE;
  begin
    stringPosition := [0 .. pred(length(stri_const_table))] times 0;
    for number range 0 to pred(length(stri_const_table)) do
      stringLengths @:= [number] length(stri_index[number][1]);
    end for;
    lengthToStriNum := flip(stringLengths);
    lengthList := sort(keys(lengthToStriNum));
    for lengthIndex range maxIdx(lengthList) downto minIdx(lengthList) do
      length := lengthList[lengthIndex];
      if length in lengthToStriNum then
        for number range lengthToStriNum[length] do
          stri := stri_index[number][1];
          combinedStriLength +:= length(stri);
          striPos := pos(striChars, stri);
          if striPos = 0 then
            found := FALSE;
            if length(striChars) > length(stri) then
              striIndex := rpos(stri, striChars[length(striChars)]);
              while striIndex <> 0 and not found do
                if stri[.. striIndex] = striChars[succ(length(striChars) - striIndex) ..] then
                  stringPosition[number] := succ(length(striChars) - striIndex);
                  striChars &:= stri[succ(striIndex) ..];
                  found := TRUE;
                else
                  striIndex := rpos(stri, striChars[length(striChars)], pred(striIndex));
                end if;
              end while;
            end if;
            if not found then
              stringPosition[number] := succ(length(striChars));
              striChars &:= stri;
            end if;
          else
            stringPosition[number] := striPos;
          end if;
        end for;
      end if;
    end for;
    write_striChars(striChars, c_expr);
    write_str_table(stri_index, stringPosition, c_expr);
    if SHOW_STATISTIC then
      writeln(combinedStriLength <& " chars in all strings");
      writeln(length(striChars) <& " chars in string pool");
      writeln(combinedStriLength - length(striChars) <& " chars of string memory saved");
    end if;
  end func;


const proc: init_string_constants_no_slices (in stri_index_hash: stri_index,
    inout expr_type: c_expr) is func

  local
    var integer: number is 0;
    var string: stri is "";
    var char: ch is ' ';
  begin
    for number range sort(keys(stri_index)) do
      stri := stri_index[number][1];
      c_expr.expr &:= "/* str[";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "] */ static strElemType stri_";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "[]={";
      if ccConf.POINTER_SIZE = 32 then
        c_expr.expr &:= str(length(stri));
        c_expr.expr &:= ",";
        if ccConf.WITH_STRI_CAPACITY then
          c_expr.expr &:= str(length(stri));
          c_expr.expr &:= ",";
        end if;
      elsif ccConf.POINTER_SIZE = 64 then
        c_expr.expr &:= int64AsTwoInt32(bigInteger(length(stri)));
        if ccConf.WITH_STRI_CAPACITY then
          c_expr.expr &:= int64AsTwoInt32(bigInteger(length(stri)));
        end if;
      end if;
      for ch range stri do
        c_expr.expr &:= c_literal(ch);
        c_expr.expr &:= ",";
      end for;
      c_expr.expr &:= "};\n";
    end for;
    c_expr.expr &:= "striType str[]={\n";
    if length(stri_const_table) > 0 then
      for number range sort(keys(stri_index)) do
        stri := stri_index[number][1];
        c_expr.expr &:= "(striType) stri_";
        c_expr.expr &:= str(number);
        c_expr.expr &:= ",";
        c_expr.expr &:= stringInComment(stri);
        c_expr.expr &:= "\n";
      end for;
    else
      c_expr.expr &:= "(striType) NULL";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: init_string_constants (inout expr_type: c_expr) is func

  local
    var stri_index_hash: stri_index is stri_index_hash.EMPTY_HASH;
  begin
    stri_index := flip(stri_const_table);
    if ccConf.ALLOW_STRITYPE_SLICES then
      init_string_constants_with_slices(stri_index, c_expr);
    else
      init_string_constants_no_slices(stri_index, c_expr);
    end if;
  end func;


const proc: write_bstriChars (in string: bstriChars, inout expr_type: c_expr) is func
  local
    var char: ch is ' ';
    var integer: countChars is 0;
  begin
    if length(bstriChars) <> 0 then
      c_expr.expr &:= "static unsigned char bstriChars[/*";
      c_expr.expr &:= str(length(bstriChars));
      c_expr.expr &:= "*/]";
      countChars := 0;
      if ccConf.LIMITED_CSTRI_LITERAL_LEN then
        c_expr.expr &:= "={";
        c_expr.expr &:= "\n";
        for ch range bstriChars do
          c_expr.expr &:= c_literal(ch);
          c_expr.expr &:= ",";
          incr(countChars);
          if countChars = 20 then
            c_expr.expr &:= "\n";
            countChars := 0;
          end if;
        end for;
        c_expr.expr &:= "};\n\n";
      else
        if length(bstriChars) <> 0 then
          c_expr.expr &:= "=";
          for countChars range 1 to length(bstriChars) step 40 do
            c_expr.expr &:= "\n";
            c_expr.expr &:= c_literal(bstriChars[countChars len 40]);
          end for;
        end if;
        c_expr.expr &:= ";\n\n";
      end if;
    end if;
  end func;


const proc: write_bst_table (in bstri_index_hash: bstri_index,
    in array integer: stringPosition, inout expr_type: c_expr) is func
  local
    var integer: number is 0;
    var string: stri is "";
  begin
    c_expr.expr &:= "struct bstriStruct bst[]={\n";
    if length(bstri_const_table) > 0 then
      for number range 0 to pred(length(bstri_const_table)) do
        stri := str(bstri_index[number][1]);
        c_expr.expr &:= "/* bst[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "] */ {";
        c_expr.expr &:= str(length(stri));
        c_expr.expr &:= ",";
        if stri = "" then
          c_expr.expr &:= "NULL";
        else
          c_expr.expr &:= "&bstriChars[";
          c_expr.expr &:= str(pred(stringPosition[number]));
          c_expr.expr &:= "]";
        end if;
        c_expr.expr &:= "},";
        c_expr.expr &:= stringInComment(stri);
        c_expr.expr &:= "\n";
      end for;
    else
      c_expr.expr &:= "/* dummy */ {0,";
      c_expr.expr &:= "NULL}";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: init_bstri_constants_with_slices (in bstri_index_hash: bstri_index,
    inout expr_type: c_expr) is func

  local
    var stringLengthHash: stringLengths is stringLengthHash.value;
    var lengthToStriNumHash: lengthToStriNum is lengthToStriNumHash.value;
    var array integer: lengthList is 0 times 0;
    var integer: lengthIndex is 0;
    var integer: length is 0;
    var array integer: stringPosition is 0 times 0;
    var integer: number is 0;
    var string: stri is "";
    var integer: combinedBStriLength is 0;
    var string: bstriChars is "";
    var integer: striPos is 0;
    var integer: striIndex is 0;
    var boolean: found is FALSE;
  begin
    stringPosition := [0 .. pred(length(bstri_const_table))] times 0;
    for number range 0 to pred(length(bstri_const_table)) do
      stringLengths @:= [number] length(bstri_index[number][1]);
    end for;
    lengthToStriNum := flip(stringLengths);
    lengthList := sort(keys(lengthToStriNum));
    for lengthIndex range maxIdx(lengthList) downto minIdx(lengthList) do
      length := lengthList[lengthIndex];
      if length in lengthToStriNum then
        for number range lengthToStriNum[length] do
          stri := str(bstri_index[number][1]);
          combinedBStriLength +:= length(stri);
          striPos := pos(bstriChars, stri);
          if striPos = 0 then
            found := FALSE;
            if length(bstriChars) > length(stri) then
              striIndex := rpos(stri, bstriChars[length(bstriChars)]);
              while striIndex <> 0 and not found do
                if stri[.. striIndex] = bstriChars[succ(length(bstriChars) - striIndex) ..] then
                  stringPosition[number] := succ(length(bstriChars) - striIndex);
                  bstriChars &:= stri[succ(striIndex) ..];
                  found := TRUE;
                else
                  striIndex := rpos(stri, bstriChars[length(bstriChars)], pred(striIndex));
                end if;
              end while;
            end if;
            if not found then
              stringPosition[number] := succ(length(bstriChars));
              bstriChars &:= stri;
            end if;
          else
            stringPosition[number] := striPos;
          end if;
        end for;
      end if;
    end for;
    write_bstriChars(bstriChars, c_expr);
    write_bst_table(bstri_index, stringPosition, c_expr);
    if SHOW_STATISTIC then
      writeln(combinedBStriLength <& " chars in all bstrings");
      writeln(length(bstriChars) <& " chars in bstring pool");
      writeln(combinedBStriLength - length(bstriChars) <& " chars of bstring memory saved");
    end if;
  end func;


const proc: init_bstri_constants_no_slices (in bstri_index_hash: bstri_index,
    inout expr_type: c_expr) is func

  local
    var bstring: bstri is bstring.value;
    var integer: number is 0;
    var string: lengthAsChars is "";
    var string: stri is "";
    var integer: countChars is 0;
    var char: ch is ' ';
  begin
    for number range sort(keys(bstri_index)) do
      bstri := bstri_index[number][1];
      c_expr.expr &:= "/* bst[";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "] */ static const unsigned char bstri_";
      c_expr.expr &:= str(number);
      if ccConf.POINTER_SIZE = 32 then
        lengthAsChars := int32AsFourBytes(length(bstri));
      elsif ccConf.POINTER_SIZE = 64 then
        lengthAsChars := int64AsEightBytes(length(bstri));
      end if;
      countChars := 0;
      if ccConf.LIMITED_CSTRI_LITERAL_LEN then
        c_expr.expr &:= "[]={";
        for ch range lengthAsChars do
          c_expr.expr &:= c_literal(ch);
          c_expr.expr &:= ",";
        end for;
        c_expr.expr &:= "\n";
        for ch range bstri do
          c_expr.expr &:= c_literal(ch);
          c_expr.expr &:= ",";
          incr(countChars);
          if countChars = 20 then
            c_expr.expr &:= "\n";
            countChars := 0;
          end if;
        end for;
        c_expr.expr &:= "};\n";
      else
        c_expr.expr &:= "[]=";
        c_expr.expr &:= c_literal(lengthAsChars);
        if length(bstri) <> 0 then
          stri := str(bstri);
          for countChars range 1 to length(stri) step 40 do
            c_expr.expr &:= "\n";
            c_expr.expr &:= c_literal(stri[countChars len 40]);
          end for;
        end if;
        c_expr.expr &:= ";\n";
      end if;
    end for;
    c_expr.expr &:= "bstriType bst[]={\n";
    if length(bstri_const_table) > 0 then
      for number range sort(keys(bstri_index)) do
        c_expr.expr &:= "(bstriType) bstri_";
        c_expr.expr &:= str(number);
        c_expr.expr &:= ",\n";
      end for;
    else
      c_expr.expr &:= "(bstriType) NULL";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: init_bstri_constants (inout expr_type: c_expr) is func

  local
    var bstri_index_hash: bstri_index is bstri_index_hash.EMPTY_HASH;
  begin
    bstri_index := flip(bstri_const_table);
    if ccConf.ALLOW_BSTRITYPE_SLICES then
      init_bstri_constants_with_slices(bstri_index, c_expr);
    else
      init_bstri_constants_no_slices(bstri_index, c_expr);
    end if;
  end func;


const proc: init_set_constants (inout expr_type: c_expr) is func

  local
    var set_index_hash: set_index is set_index_hash.EMPTY_HASH;
    var bitset: set1 is EMPTY_SET;
    var integer: min_position is 0;
    var integer: max_position is 0;
    var integer: number is 0;
    var integer: elem_num is 0;
    var integer: columnsFree is 0;
  begin
    set_index := flip(set_const_table);
    for number range sort(keys(set_index)) do
      set1 := set_index[number][1];
      c_expr.expr &:= "/* set[";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "] */ static bitSetType set_";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "[]={";
      if set1 = EMPTY_SET then
        c_expr.expr &:= "0,0,0,";
      else
        min_position := min(set1) mdiv ccConf.INTTYPE_SIZE;
        max_position := max(set1) mdiv ccConf.INTTYPE_SIZE;
        if min_position < 0 then
          c_expr.expr &:= "(bitSetType)";
        end if;
        c_expr.expr &:= str(min_position);
        c_expr.expr &:= ",";
        if max_position < 0 then
          c_expr.expr &:= "(bitSetType)";
        end if;
        c_expr.expr &:= str(max_position);
        c_expr.expr &:= ",";
        columnsFree := 4;
        for elem_num range min_position to max_position do
          if columnsFree = 0 then
            c_expr.expr &:= "\n";
            columnsFree := 6;
          end if;
          c_expr.expr &:= "0x";
          c_expr.expr &:= getBinary(set1, elem_num * ccConf.INTTYPE_SIZE) radix 16 lpad0 16;
          c_expr.expr &:= ",";
          decr(columnsFree);
        end for;
      end if;
      c_expr.expr &:= "};\n";
    end for;
    c_expr.expr &:= "setType set[]={\n";
    if length(set_const_table) > 0 then
      for number range sort(keys(set_index)) do
        c_expr.expr &:= "(setType) set_";
        c_expr.expr &:= str(number);
        c_expr.expr &:= ",\n";
      end for;
    else
      c_expr.expr &:= "(setType) NULL";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: init_type_constants (inout expr_type: c_expr) is func

  local
    var type_index_hash: type_index is type_index_hash.EMPTY_HASH;
    var type: aType is void;
    var integer: number is 0;
  begin
    type_index := flip(type_const_table);
    for number range sort(keys(type_index)) do
      aType := type_index[number][1];
      c_expr.expr &:= "/* typ[";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "] */ static struct typeStruct typ_";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "={";
      c_expr.expr &:= "NULL, NULL, NULL, NULL, NULL, 0, NULL, NULL";
      # c_expr.expr &:= c_literal(aType);
      c_expr.expr &:= "};\n";
    end for;
    c_expr.expr &:= "typeType typ[]={\n";
    if length(type_const_table) > 0 then
      for number range sort(keys(type_index)) do
        aType := type_index[number][1];
        c_expr.expr &:= "&typ_";
        c_expr.expr &:= str(number);
        c_expr.expr &:= ", /* ";
        c_expr.expr &:= type_name2(aType);
        c_expr.expr &:= " */\n";
      end for;
    else
      c_expr.expr &:= "(typeType) NULL";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: init_array_constants (in reference: const_object, inout expr_type: c_expr) is func

  local
    var ref_list: array_list is ref_list.EMPTY;
    var integer: number is 0;
    var integer: elem_num is 0;
    var integer: elem_after_repeat_block is 0;
    var reference: element is NIL;
  begin
    number := const_table[const_object];
    array_list := arrayToList(const_object);
    c_expr.expr &:= "arr[";
    c_expr.expr &:= str(number);
    c_expr.expr &:= "]=arrMalloc(";
    c_expr.expr &:= str(arrayMinIdx(const_object));
    c_expr.expr &:= ", ";
    c_expr.expr &:= str(pred(arrayMinIdx(const_object) + length(array_list)));
    c_expr.expr &:= ");\n";
    elem_num := 0;
    elem_after_repeat_block := 0;
    for element range array_list do
      if element in element_repeat_count then
        c_expr.expr &:= "{\n";
        c_expr.expr &:= "int idx;\n";
        c_expr.expr &:= "for (idx=";
        c_expr.expr &:= str(elem_num);
        c_expr.expr &:= "; idx < ";
        c_expr.expr &:= str(elem_num + element_repeat_count[element]);
        c_expr.expr &:= "; idx++) {\n";
        c_expr.expr &:= "arr[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "]->arr[idx]";
        init_const_value(element, c_expr);
        c_expr.expr &:= ";\n";
        c_expr.expr &:= "}\n";
        c_expr.expr &:= "}\n";
        elem_after_repeat_block := elem_num + element_repeat_count[element];
      elsif elem_num >= elem_after_repeat_block then
        c_expr.expr &:= "arr[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "]->arr[";
        c_expr.expr &:= str(elem_num);
        c_expr.expr &:= "]";
        init_const_value(element, c_expr);
        c_expr.expr &:= ";\n";
      end if;
      incr(elem_num);
    end for;
  end func;


const proc: malloc_struct (in reference: const_object, inout expr_type: c_expr) is func

  local
    var ref_list: struct_list is ref_list.EMPTY;
    var integer: number is 0;
    var integer: elem_num is 0;
    var reference: element is NIL;
  begin
    number := const_table[const_object];
    struct_list := structToList(const_object);
    c_expr.expr &:= "sct[";
    c_expr.expr &:= str(number);
    c_expr.expr &:= "]=(structType)(malloc(sizeof(struct rtlStructStruct) - sizeof(rtlObjectType)";
    if length(struct_list) <> 0 then
      c_expr.expr &:= " +\n  ";
      c_expr.expr &:= str(length(struct_list));
      c_expr.expr &:= " * sizeof(rtlObjectType)";
    end if;
    c_expr.expr &:= "));\n";
  end func;


const proc: init_struct_constants (in reference: const_object, inout expr_type: c_expr) is func

  local
    var ref_list: struct_list is ref_list.EMPTY;
    var integer: number is 0;
    var integer: elem_num is 0;
    var reference: element is NIL;
  begin
    number := const_table[const_object];
    struct_list := structToList(const_object);
    c_expr.expr &:= "sct[";
    c_expr.expr &:= str(number);
    c_expr.expr &:= "]->usage_count=0;\n";
    c_expr.expr &:= "sct[";
    c_expr.expr &:= str(number);
    c_expr.expr &:= "]->type_num=";
    c_expr.expr &:= str(typeNumber(getType(const_object)));
    c_expr.expr &:= "/*";
    c_expr.expr &:= str(getType(const_object));
    c_expr.expr &:= "*/";
    c_expr.expr &:= ";\n";
    elem_num := 1;
    for element range struct_list do
      c_expr.expr &:= "sct[";
      c_expr.expr &:= str(number);
      c_expr.expr &:= "]->stru[";
      c_expr.expr &:= str(pred(elem_num));
      c_expr.expr &:= "]";
      init_const_value(element, c_expr);
      c_expr.expr &:= ";\n";
      incr(elem_num);
    end for;
    if const_object in globalInitalisations then
      c_expr.expr &:= globalInitalisations[const_object];
    end if;
  end func;


const proc: init_hash_constants (in reference: const_object, inout expr_type: c_expr) is func

  local
    var ref_list: hash_key_list is ref_list.EMPTY;
    var ref_list: hash_data_list is ref_list.EMPTY;
    var integer: number is 0;
    var integer: elem_num is 0;
    var reference: key_element is NIL;
    var expr_type: hashcode_expr is expr_type.value;
  begin
    number := const_table[const_object];
    hash_key_list := hashKeysToList(const_object);
    hash_data_list := hashDataToList(const_object);
    c_expr.expr &:= "hsh[";
    c_expr.expr &:= str(number);
    c_expr.expr &:= "]=hshEmpty();\n";
    if length(hash_key_list) <> 0 then
      c_expr.expr &:= "{\n";
      c_expr.expr &:= "rtlObjectType hash_key;\n";
      c_expr.expr &:= "rtlObjectType hash_data;\n";
      elem_num := 1;
      for key_element range hash_key_list do
        c_expr.expr &:= "hash_key";
        init_const_value(key_element, c_expr);
        c_expr.expr &:= ";\n";
        c_expr.expr &:= "hash_data";
        init_const_value(hash_data_list[elem_num], c_expr);
        c_expr.expr &:= ";\n";
        hashcode_expr := expr_type.value;
        setVar(key_element, FALSE);
        process_hashcode(key_element, hashcode_expr);
        if hashcode_expr.temp_decls <> "" then
          c_expr.expr &:= "{\n";
          c_expr.expr &:= hashcode_expr.temp_decls;
          c_expr.expr &:= hashcode_expr.temp_assigns;
        end if;
        c_expr.expr &:= "hshIncl(hsh[";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "], hash_key.value.genericValue, hash_data.value.genericValue, ";
        c_expr.expr &:= hashcode_expr.expr;
        c_expr.expr &:= ", (compareType)(";
        object_address(keyCompareObj(getType(const_object)), c_expr);
        c_expr.expr &:= "), (createFuncType)(";
        object_address(keyCreateObj(getType(const_object)), c_expr);
        c_expr.expr &:= "), (createFuncType)(";
        object_address(dataCreateObj(getType(const_object)), c_expr);
        c_expr.expr &:= "), (copyFuncType)(";
        object_address(dataCopyObj(getType(const_object)), c_expr);
        c_expr.expr &:= "));\n";
        if hashcode_expr.temp_decls <> "" then
          c_expr.expr &:= hashcode_expr.temp_frees;
          c_expr.expr &:= "}\n";
        end if;
        incr(elem_num);
      end for;
      c_expr.expr &:= "}\n";
    end if;
  end func;


const proc: init_interface_constants (in reference: const_object, inout expr_type: c_expr) is func

  local
    var reference: struct_of_interface is NIL;
    var integer: number is 0;
  begin
    number := const_table[const_object];
    struct_of_interface := interfaceToStruct(const_object);
    c_expr.expr &:= "itf[";
    c_expr.expr &:= str(number);
    c_expr.expr &:= "]";
    if isVar(struct_of_interface) and struct_of_interface in globalInitalisations then
      c_expr.expr &:= "=o_";
      create_name(struct_of_interface, c_expr.expr);
    elsif category(struct_of_interface) = STRUCTOBJECT then
      c_expr.expr &:= "=sct[";
      c_expr.expr &:= str(const_table[struct_of_interface]);
      c_expr.expr &:= "]";
    else
      c_expr.expr &:= " /* = ";
      c_expr.expr &:= str(category(struct_of_interface));
      c_expr.expr &:= " */";
    end if;
    c_expr.expr &:= ";\n";
  end func;


const proc: init_nan_constants (inout expr_type: c_expr) is func

  local
    var nan_index_hash: nan_index is nan_index_hash.EMPTY_HASH;
    var integer: number is 0;
    var bin64: bits is bin64(0);
  begin
    c_expr.expr &:= "double2BitsUnion nanValue[] = {\n";
    if length(nan_const_table) > 0 then
      nan_index := flip(nan_const_table);
      for number range sort(keys(nan_index)) do
        bits := nan_index[number][1];
        c_expr.expr &:= "{0x";
        c_expr.expr &:= bits radix 16 lpad0 16;
        c_expr.expr &:= "},\n";
      end for;
    else
      c_expr.expr &:= "{0}";
    end if;
    c_expr.expr &:= "};\n\n";
  end func;


const proc: initCaseLabelsOfWhen (in integer: numOfCaseStmt, in integer: numOfWhenPart,
    in reference: whenLabels, inout expr_type: c_expr) is func

  local
    var ref_list: hash_key_list is ref_list.EMPTY;
    var reference: key_element is NIL;
    var expr_type: hashcode_expr is expr_type.value;
  begin
    hash_key_list := hashKeysToList(whenLabels);
    if length(hash_key_list) <> 0 then
      for key_element range hash_key_list do
        c_expr.expr &:= "hash_key";
        init_const_value(key_element, c_expr);
        c_expr.expr &:= ";\n";
        hashcode_expr := expr_type.value;
        setVar(key_element, FALSE);
        process_hashcode(key_element, hashcode_expr);
        if hashcode_expr.temp_decls <> "" then
          c_expr.expr &:= "{\n";
          c_expr.expr &:= hashcode_expr.temp_decls;
          c_expr.expr &:= hashcode_expr.temp_assigns;
        end if;
        c_expr.expr &:= "hshIncl(caseLabels[";
        c_expr.expr &:= str(numOfCaseStmt);
        c_expr.expr &:= "], hash_key.value.genericValue, ";
        c_expr.expr &:= str(numOfWhenPart);
        c_expr.expr &:= ", ";
        c_expr.expr &:= hashcode_expr.expr;
        c_expr.expr &:= ", (compareType)(";
        object_address(keyCompareObj(getType(whenLabels)), c_expr);
        c_expr.expr &:= "), (createFuncType)(";
        object_address(keyCreateObj(getType(whenLabels)), c_expr);
        c_expr.expr &:= "), (createFuncType)(&genericCreate), (copyFuncType)(&genericCpy));\n";
        if hashcode_expr.temp_decls <> "" then
          c_expr.expr &:= hashcode_expr.temp_frees;
          c_expr.expr &:= "}\n";
        end if;
      end for;
    end if;
  end func;


const proc: initCaseLabelsOfCase (in integer: numOfCaseStmt,
    in array reference: caseWhens, inout expr_type: c_expr) is func

  local
    var integer: numOfWhenPart is 0;
    var reference: whenLabels is NIL;
  begin
    c_expr.expr &:= "caseLabels[";
    c_expr.expr &:= str(numOfCaseStmt);
    c_expr.expr &:= "]=hshEmpty();\n";
    for whenLabels key numOfWhenPart range caseWhens do
      initCaseLabelsOfWhen(numOfCaseStmt, numOfWhenPart, whenLabels, c_expr);
    end for;
  end func;


const proc: initCaseLabels (inout expr_type: c_expr) is func

  local
    var integer: numOfCaseStmt is 0;
  begin
    c_expr.expr &:= "void initCaseLabelsOfSwitch () {\n";
    if length(case_table) <> 0 then
      c_expr.expr &:= "rtlObjectType hash_key;\n";
      c_expr.expr &:= "caseLabels = (hashType *)(malloc(";
      c_expr.expr &:= str(length(case_table));
      c_expr.expr &:= " * sizeof(hashType)));\n";
      for key numOfCaseStmt range case_table do
        initCaseLabelsOfCase(numOfCaseStmt, case_table[numOfCaseStmt], c_expr);
      end for;
    end if;
    c_expr.expr &:= "}\n\n";
  end func;


const proc: init_values (inout expr_type: c_expr) is func

  local
    var const_index_hash: const_index is const_index_hash.EMPTY_HASH;
    var ref_list: sorted_list is ref_list.EMPTY;
    var reference: struct_of_interface is NIL;
    var reference: const_object is NIL;
    var integer: number is 0;
    var ref_list: elements_to_walk is ref_list.EMPTY;
  begin
    const_index := flip(const_table);
    for number range sort(keys(const_index)) do
      const_object := const_index[number][1];
      if category(const_object) = ARRAYOBJECT then
        elements_to_walk := determine_multiple_array_elements(arrayToList(const_object));
        walk_const_list(elements_to_walk, sorted_list);
        sorted_list &:= make_list(const_object);
      elsif category(const_object) = STRUCTOBJECT then
        walk_const_list(structToList(const_object), sorted_list);
        sorted_list &:= make_list(const_object);
      elsif category(const_object) = HASHOBJECT then
        walk_const_list(hashKeysToList(const_object), sorted_list);
        walk_const_list(hashDataToList(const_object), sorted_list);
        sorted_list &:= make_list(const_object);
      elsif category(const_object) = INTERFACEOBJECT then
        if const_object not in const_table then
          const_table @:= [const_object] length(const_table);
        end if;
        struct_of_interface := interfaceToStruct(const_object);
        if struct_of_interface not in const_table then
          const_table @:= [struct_of_interface] length(const_table);
          walk_const_list(structToList(struct_of_interface), sorted_list);
          sorted_list &:= make_list(struct_of_interface);
        elsif const_table[struct_of_interface] >= const_table[const_object] then
          sorted_list &:= make_list(struct_of_interface);
        end if;
        sorted_list &:= make_list(const_object);
      end if;
    end for;
    writeln("after walk_const_list");

    for const_object range sorted_list do
      # writeln(str(category(const_object)) <& ": " <& create_name(const_object));
      if category(const_object) = MATCHOBJECT or category(const_object) = ACTOBJECT or
          category(const_object) = BLOCKOBJECT then
        prepare_func_literal(const_object, c_expr);
      end if;
    end for;

    init_bigint_constants;
    init_win_constants;
    init_string_constants(c_expr);
    init_bstri_constants(c_expr);
    init_set_constants(c_expr);
    init_type_constants(c_expr);

    c_expr.expr &:= "static void init_values (void)\n";
    c_expr.expr &:= "{\n";
    initPollOperations(c_expr);
    assign_bigint_constants(c_expr);
    assign_win_constants(c_expr);
    c_expr.expr &:= "arr = (arrayType *)(malloc(";
    c_expr.expr &:= str(length(const_table));
    c_expr.expr &:= " * sizeof(arrayType)));\n";
    c_expr.expr &:= "sct = (structType *)(arr);\n";
    c_expr.expr &:= "hsh = (hashType *)(arr);\n";
    c_expr.expr &:= "itf = (interfaceType *)(arr);\n";
    for const_object range sorted_list do
      if category(const_object) = STRUCTOBJECT then
        malloc_struct(const_object, c_expr);
      end if;
    end for;
    for const_object range sorted_list do
      if category(const_object) = ARRAYOBJECT then
        init_array_constants(const_object, c_expr);
      elsif category(const_object) = STRUCTOBJECT then
        init_struct_constants(const_object, c_expr);
      elsif category(const_object) = HASHOBJECT then
        init_hash_constants(const_object, c_expr);
      elsif category(const_object) = INTERFACEOBJECT then
        init_interface_constants(const_object, c_expr);
      elsif category(const_object) <> MATCHOBJECT and
            category(const_object) <> ACTOBJECT then
        number := const_table[const_object];
        c_expr.expr &:= "/* const ";
        c_expr.expr &:= str(category(const_object));
        c_expr.expr &:= " [";
        c_expr.expr &:= str(number);
        c_expr.expr &:= "] */\n";
      end if;
    end for;
    c_expr.expr &:= "initCaseLabelsOfSwitch();\n";
    c_expr.expr &:= "}\n\n";
    init_nan_constants(c_expr);
  end func;


const proc: declare_rtlRaiseError (inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "void rtlRaiseError (int fail_value, const char *file_name, int line_number)\n";
    c_expr.expr &:= "{\n";
    if trace_exception then
      c_expr.expr &:= "  int ch;\n";
      c_expr.expr &:= "  if (catch_stack_pos == 0) {\n";
      c_expr.expr &:= "    printf(\"\\n*** Uncaught exception \");\n";
      c_expr.expr &:= "  } else {\n";
      c_expr.expr &:= "    printf(\"\\n*** Caught exception \");\n";
      c_expr.expr &:= "  }\n";
      c_expr.expr &:= "  if (fail_value >= 0 && fail_value < sizeof(exception_name) / sizeof(char *)) {\n";
      c_expr.expr &:= "    printf(\"%s\", exception_name[fail_value]);\n";
      c_expr.expr &:= "  } else {\n";
      c_expr.expr &:= "    printf(\"%d\", fail_value);\n";
      c_expr.expr &:= "  }\n";
      c_expr.expr &:= "  printf(\" raised at %s(%d)\\n\", file_name, line_number);\n";
      c_expr.expr &:= "  printf(\"\\n*** The following commands are possible:\\n\"\n";
      c_expr.expr &:= "         \"  RETURN  Continue\\n\"\n";
      c_expr.expr &:= "         \"  *       Terminate\\n\"\n";
      c_expr.expr &:= "         \"  /       Trigger SIGFPE\\n\");\n";
      c_expr.expr &:= "  ch = fgetc(stdin);\n";
      c_expr.expr &:= "  if (ch == (int) '*') {\n";
      c_expr.expr &:= "    exit(1);\n";
      c_expr.expr &:= "  } else if (ch == (int) '/') {\n";
      c_expr.expr &:= "    triggerSigfpe();\n";
      c_expr.expr &:= "  }\n";
    end if;
    c_expr.expr &:= "  error_file = file_name;\n";
    c_expr.expr &:= "  error_line = line_number;\n";
    if signal_exception then
      c_expr.expr &:= "  if (catch_stack_pos == 0) {\n";
      c_expr.expr &:= "    printf(\"\\n*** Uncaught exception \");\n";
      c_expr.expr &:= "    if (fail_value >= 0 && fail_value < sizeof(exception_name) / sizeof(char *)) {\n";
      c_expr.expr &:= "      printf(\"%s\", exception_name[fail_value]);\n";
      c_expr.expr &:= "    } else {\n";
      c_expr.expr &:= "      printf(\"%d\", fail_value);\n";
      c_expr.expr &:= "    }\n";
      c_expr.expr &:= "    printf(\" raised at %s(%d)\\n\", file_name, line_number);\n";
      c_expr.expr &:= "    triggerSigfpe();\n";
      c_expr.expr &:= "  }\n";
    end if;
    if ccConf.HAS_SIGSETJMP then
      c_expr.expr &:= "  siglongjmp(catch_stack[catch_stack_pos], fail_value);\n";
    else
      c_expr.expr &:= "  longjmp(catch_stack[catch_stack_pos], fail_value);\n";
    end if;
    c_expr.expr &:= "}\n";
    c_expr.expr &:= "\n";
  end func;


const proc: declare_raise_error2 (inout expr_type: c_expr) is func

  begin
    if compilerLibraryUsed then
      writeln(c_prog, "extern boolType interpreter_exception;");
      declareExtern("void interprRaiseError (int, const char *, int);");
    end if;
    c_expr.expr &:= "void raise_error2 (int fail_value, const char *file_name, int line_number)\n";
    c_expr.expr &:= "{\n";
    if compilerLibraryUsed then
      c_expr.expr &:= "  if (interpreter_exception) {\n";
      if trace_exception then
        c_expr.expr &:= "    int ch;\n";
        c_expr.expr &:= "    if (fail_value >= 0 && fail_value < sizeof(exception_name) / sizeof(char *)) {\n";
        c_expr.expr &:= "      printf(\"*** Exception %s\", exception_name[fail_value]);\n";
        c_expr.expr &:= "    } else {\n";
        c_expr.expr &:= "      printf(\"*** Exception %d\", fail_value);\n";
        c_expr.expr &:= "    }\n";
        c_expr.expr &:= "    printf(\" raised at %s(%d)\\n\", file_name, line_number);\n";
        c_expr.expr &:= "    printf(\"\\n*** The following commands are possible:\\n\"\n";
        c_expr.expr &:= "           \"  RETURN  Continue\\n\"\n";
        c_expr.expr &:= "           \"  *       Terminate\\n\"\n";
        c_expr.expr &:= "           \"  /       Trigger SIGFPE\\n\");\n";
        c_expr.expr &:= "    ch = fgetc(stdin);\n";
        c_expr.expr &:= "    if (ch == (int) '*') {\n";
        c_expr.expr &:= "      exit(1);\n";
        c_expr.expr &:= "    } else if (ch == (int) '/') {\n";
        c_expr.expr &:= "      triggerSigfpe();\n";
        c_expr.expr &:= "    }\n";
      end if;
      c_expr.expr &:= "    interprRaiseError(fail_value, file_name, line_number);\n";
      c_expr.expr &:= "  } else {\n";
      c_expr.expr &:= "    rtlRaiseError(fail_value, file_name, line_number);\n";
      c_expr.expr &:= "  }\n";
    else
      c_expr.expr &:= "  rtlRaiseError(fail_value, file_name, line_number);\n";
    end if;
    c_expr.expr &:= "}\n";
    c_expr.expr &:= "\n";
  end func;


const proc: init_globals (inout expr_type: c_expr) is func

  begin
    c_expr.expr &:= "static void init_globals (void)\n";
    c_expr.expr &:= "{\n";
    c_expr.expr &:= global_init.temp_decls;
    c_expr.expr &:= global_init.temp_assigns;
    c_expr.expr &:= global_init.expr;
    c_expr.expr &:= "}\n\n";
  end func;


const proc: process_global_declarations (in program: prog) is func

  local
    var expr_type: c_expr is expr_type.value;
    var type: int_type is void;
    var integer: numObjects is 0;
    var integer: index is 0;
  begin
    if not compDataLibraryUsed then
      declareExtern("intType heapsize (void) {return 0;}");
      declareExtern("typeType refType (objRefType a) {printf(\"refType\\n\"); return NULL;}");
      declareExtern("typeType typValue (objRefType a) {printf(\"typValue\\n\"); return NULL;}");
      writeln(c_prog);
    end if;
    if compDataLibraryUsed and not compilerLibraryUsed then
      declareExtern("striType get_file_name (unsigned int a) {return " <& stringLiteral("") <& ";}");
      declareExtern("const unsigned char *get_file_name_ustri (unsigned int a) {return (unsigned char *) \"?\";}");
      declareExtern("void *get_param_list (const_listType a, int *b) {printf(\"get_param_list\\n\"); return NULL;}");
      writeln(c_prog);
    end if;
    declare_rtlRaiseError(c_expr);
    declare_raise_error2(c_expr);
    process_dynamic_decisions(c_expr);
    declare_missing_create_declarations(c_expr);
    declare_missing_destr_declarations(c_expr);
    initCaseLabels(c_expr);
    init_values(c_expr);
    init_globals(c_expr);
    if profile_function then
      int_type := getValue(sysVar(prog, "integer"), type);
      numObjects := objNumber(alloc(TRUE, int_type, 0));
      writeln(c_prog, "static unsigned int profile_size = " <& numObjects <& ";");
      writeln(c_prog, "static struct profileElement profile[" <& numObjects <& "];");
      writeln(c_prog);
      writeln(c_prog, "static void initProfile (void)");
      writeln(c_prog, "{");
      writeln(c_prog, "  memSizeType index;");
      writeln(c_prog, "  memset(profile, 0, " <& numObjects <& " * sizeof(struct profileElement));");
      writeln(c_prog, "  for (index = 0; index < " <& numObjects <& "; index++) {");
      writeln(c_prog, "    profile[index].file = \"\";");
      writeln(c_prog, "    profile[index].name = \"\";");
      writeln(c_prog, "  }");
      for index range 1 to pred(numObjects) do
        if index in profiledFunctions then
          write(c_prog, "  profile[" <& index <& "].file = " <&
                c_literal(striToUtf8(file(profiledFunctions[index]))) <& ";");
          write(c_prog, " profile[" <& index <& "].line = " <&
                line(profiledFunctions[index]) <& ";");
          writeln(c_prog, " profile[" <& index <& "].name = " <&
                  c_literal(striToUtf8(str(profiledFunctions[index]))) <& ";");
        end if;
      end for;
      writeln(c_prog, "}");
      writeln(c_prog);
    end if;
    write(c_prog, global_c_expr.expr);
    write(c_prog, c_expr.expr);
    count_declarations(c_expr);
  end func;


const proc: init_systypes (in program: prog) is func

  local
    var reference: type_ref is NIL;
    var reference: ref_to_empty is NIL;
    var type: type_type is void;
    var type: int_type is void;
    var type: float_type is void;
    var type: bigint_type is void;
    var type: char_type is void;
    var type: stri_type is void;
  begin
    type_ref := sysVar(prog, "type");
    if type_ref <> NIL then
      type_type := getValue(type_ref, type);
      typeCategory @:= [type_type] TYPEOBJECT;
    end if;
    type_ref := sysVar(prog, "proc");
    if type_ref <> NIL then
      proctype := getValue(type_ref, type);
    end if;
    type_ref := sysVar(prog, "integer");
    if type_ref <> NIL then
      int_type := getValue(type_ref, type);
      typeCategory @:= [int_type] INTOBJECT;
    end if;
    type_ref := sysVar(prog, "bigInteger");
    if type_ref <> NIL then
      bigint_type := getValue(type_ref, type);
      typeCategory @:= [bigint_type] BIGINTOBJECT;
    end if;
    type_ref := sysVar(prog, "float");
    if type_ref <> NIL then
      float_type := getValue(type_ref, type);
      typeCategory @:= [float_type] FLOATOBJECT;
    end if;
    type_ref := sysVar(prog, "char");
    if type_ref <> NIL then
      char_type := getValue(type_ref, type);
      typeCategory @:= [char_type] CHAROBJECT;
    end if;
    type_ref := sysVar(prog, "string");
    if type_ref <> NIL then
      stri_type := getValue(type_ref, type);
      typeCategory @:= [stri_type] STRIOBJECT;
    end if;
    ref_to_empty := sysVar(prog, "empty");
    if ref_to_empty <> NIL then
      voidtype := getType(ref_to_empty);
      typeCategory @:= [voidtype] VOIDOBJECT;
    end if;
  end func;


const func string: temp_name (in string: source) is func
  result
    var string: tempName is "";
  begin
    if rpos(source, "/") = 0 then
      tempName := "tmp_" & source;
    else
      tempName := source[.. rpos(source, "/")] &
          "tmp_" & source[succ(rpos(source, "/")) ..];
    end if;
  end func;


const proc: pass_1 (in string: source, inout program: prog,
    inout boolean: okay) is func

  begin
    if source <> "" then
      writeln("Compiling the program ...");
      if "-g" in compiler_option then
        source_debug_info := compiler_option["-g"] <> "-debug_c";
      end if;
      if "-t" in compiler_option then
        if pos(compiler_option["-t"], 'e') <> 0 then
          trace_exception := TRUE;
        end if;
        if pos(compiler_option["-t"], 'f') <> 0 then
          trace_function := TRUE;
        end if;
        if pos(compiler_option["-t"], 's') <> 0 then
          trace_signal := TRUE;
        end if;
      end if;
      if "-p" in compiler_option then
        profile_function := TRUE;
      end if;
      if "-e" in compiler_option then
        signal_exception := TRUE;
      end if;
      if "-o" in compiler_option and compiler_option["-o"] in {"c0", "c1", "c2", "c3"} then
        evaluate_const_expr := integer(compiler_option["-o"][2 ..]);
      end if;
      setOptimizationSettings(evaluate_const_expr);
      if "-s" in compiler_option then
        if pos(compiler_option["-s"], 'd') <> 0 then
          integer_division_check := FALSE;
        end if;
        if pos(compiler_option["-s"], 'i') <> 0 then
          string_index_check := FALSE;
          bstring_index_check := FALSE;
          array_index_check := FALSE;
          ref_list_index_check := FALSE;
        end if;
        if pos(compiler_option["-s"], 'o') <> 0 then
          integer_overflow_check := FALSE;
        end if;
        if pos(compiler_option["-s"], 'r') <> 0 then
          function_range_check := FALSE;
          conversion_range_check := FALSE;
        end if;
      end if;
      setIntegerDivisionCheck(integer_division_check);
      setIntegerOverflowCheck(integer_overflow_check);
      if "-c" in compiler_option then
        generate_c_plus_plus := compiler_option["-c"] = "++";
        declare_with_extern_c := generate_c_plus_plus;
      end if;
      if "-f" in compiler_option then
        case compiler_option["-f"] of
          when {"lto"}:
            if ccConf.CC_OPT_LINK_TIME_OPTIMIZATION <> "" then
              enable_link_time_optimization := TRUE;
            end if;
          otherwise:
            writeln("*** Ignore unsupported option: -f" <& compiler_option["-f"]);
        end case;
      end if;
      block
        prog := parseFile(source, parseOptions.value, libraryDirs);
      exception
        otherwise:
          prog := program.EMPTY;
      end block;
      if prog = program.EMPTY then
        writeln("*** File " <& literal(source) <& " not found or a memory error occurred.");
        okay := FALSE;
      elsif errorCount(prog) <> 0 then
        write(errorCount(prog) <& " error");
        if errorCount(prog) > 1 then
          write("s");
        end if;
        writeln(" found");
        okay := FALSE;
      end if;
    else
      okay := FALSE;
    end if;
  end func;


const proc: pass_2 (in string: source, in program: prog,
    inout boolean: okay) is func

  local
    var string: temporaryFileName is "";
    var ref_list: globalObjects is ref_list.EMPTY;
    var reference: obj is NIL;
  begin
    if okay then
      main_object := sysVar(prog, "main");
      if main_object <> NIL then
        compileLibrary := category(main_object) = FORWARDOBJECT;
        temporaryFileName := temp_name(source);
        if generate_c_plus_plus then
          temporaryFileName &:= ".cpp";
        else
          temporaryFileName &:= ".c";
        end if;
        # The temporary tmp_*.c file is marked with a temp_marker.
        # The temp_marker is checked, before the file is overwritten.
        c_prog := open(temporaryFileName, "r");
        if c_prog <> STD_NULL then
          if getln(c_prog) <> temp_marker then
            write("*** The file ");
            write(literal(temporaryFileName));
            writeln(" was not created by the compiler.");
            write("*** Remove the file ");
            write(literal(temporaryFileName));
            writeln(" manually and restart the compiler.");
            okay := FALSE;
          end if;
          close(c_prog);
        end if;
        if okay then
          c_prog := open(temporaryFileName, "w");
          if c_prog <> STD_NULL then
            writeln("Generating code ...");
            init_systypes(prog);
            write_file_head;
            write_prototypes;
            write_resize_catch_stack;
            globalObjects := globalObjects(prog);
            if compileLibrary then
              writeln("Compile library");
              for obj range globalObjects do
                if endsWith(path(prog), file(obj)) then
                  process_object(obj);
                else
                  process_library_import_object(obj);
                end if;
              end for;
            else
              for obj range globalObjects do
                process_object(obj);
              end for;
            end if;
            process_global_declarations(prog);
            close(c_prog);
            writeln(countDeclarations  <& " declarations processed");
            writeln(countOptimizations <& " optimizations done");
            if countEvaluations <> 0 then
              writeln(countEvaluations   <& " evaluations done");
            end if;
            if countRangeChecks <> 0 then
              writeln(countRangeChecks   <& " range checks inserted");
            end if;
            if countNoRangeChecks <> 0 then
              writeln(countNoRangeChecks <& " range checks suppressed");
            end if;
            if countIndexChecks <> 0 then
              writeln(countIndexChecks   <& " index checks inserted");
            end if;
            if countNoIndexChecks <> 0 then
              writeln(countNoIndexChecks <& " index checks suppressed");
            end if;
            if countOverflowChecks <> 0 then
              writeln(countOverflowChecks   <& " overflow checks inserted");
            end if;
          else
            write("*** Cannot open temp file ");
            write(literal(temporaryFileName));
            writeln(".");
            okay := FALSE;
          end if;
        end if;
      else
        writeln("*** main not found.");
        okay := FALSE;
      end if;
    end if;
  end func;


const proc: importEnvironment (in string: fileName) is func
  local
    var iniDataType: iniData is iniDataType.value;
    var string: aKey is "";
    var string: aValue is "";
  begin
    iniData := readIniFile(fileName);
    if "" in iniData then
      for aValue key aKey range iniData[""] do
        # writeln(aKey <& "=" <& aValue);
        setenv(aKey, aValue);
      end for;
    else
      writeln("*** C compiler environment file " <& literal(fileName) <& " not found.");
    end if;
  end func;


const proc: appendLibrary (inout array string: options, in string: libraryToAppend) is func
  local
    var string: existingOption is "";
    var boolean: found is FALSE;
  begin
    if libraryToAppend <> "" then
      for existingOption range options until found do
        found := existingOption = libraryToAppend;
      end for;
      if not found then
        options &:= libraryToAppend;
      end if;
    end if;
  end func;


const proc: appendLibrary (inout array string: options, in array string: librariesToAppend) is func
  local
    var string: libraryToAppend is "";
  begin
    for libraryToAppend range librariesToAppend do
      appendLibrary(options, libraryToAppend);
    end for;
  end func;


const proc: logProgram (in string: command, in array string: parameters,
    in string: errorFile) is func

  begin
    write(toShellPath(command) <& " " <& shellParameters(parameters));
    case ccConf.CC_ERROR_FILEDES of
      when {1}:
        write(" " <& ccConf.REDIRECT_FILEDES_1 <& toShellPath(errorFile));
        write(" " <& ccConf.REDIRECT_FILEDES_2 <& ccConf.NULL_DEVICE);
      when {2}:
        write(" " <& ccConf.REDIRECT_FILEDES_2 <& toShellPath(errorFile));
        write(" " <& ccConf.REDIRECT_FILEDES_1 <& ccConf.NULL_DEVICE);
    end case;
    writeln;
    flush(OUT);
  end func;


const proc: execProgramScript (in string: command, in array string: parameters,
    in string: errorFile) is func

  local
    var array string: redirection is 0 times "";
  begin
    logProgram(command, parameters, errorFile);
    case ccConf.CC_ERROR_FILEDES of
      when {1}:
        redirection &:= ccConf.REDIRECT_FILEDES_1 & toShellPath(errorFile);
        redirection &:= ccConf.REDIRECT_FILEDES_2 & ccConf.NULL_DEVICE;
      when {2}:
        redirection &:= ccConf.REDIRECT_FILEDES_2 & toShellPath(errorFile);
        redirection &:= ccConf.REDIRECT_FILEDES_1 & ccConf.NULL_DEVICE;
    end case;
    if length(redirection) = 0 then
      # An CC_ERROR_FILEDES of zero means: Do not redirect.
      cmd_sh(command, shellParameters(parameters));
    else
      cmd_sh(command, shellParameters(parameters) <& " " <& join(redirection, " "));
    end if
  end func;


const proc: execProgram (in string: command, in array string: parameters,
    in string: errorFile) is func

  local
    var file: childStdout is STD_NULL;
    var file: childStderr is STD_NULL;
    var process: aProcess is process.value;
  begin
    logProgram(command, parameters, errorFile);
    case ccConf.CC_ERROR_FILEDES of
      when {1}:
        childStdout := open(errorFile, "w");
        if childStdout = STD_NULL then
          writeln("*** Could not open " <& errorFile);
        end if;
      when {2}:
        childStderr := open(errorFile, "w");
        if childStderr = STD_NULL then
          writeln("*** Could not open " <& errorFile);
        end if;
    end case;
    aProcess := startProcess(commandPath(command), parameters, STD_IN, childStdout, childStderr);
    waitFor(aProcess);
    case ccConf.CC_ERROR_FILEDES of
      when {1}: close(childStdout);
      when {2}: close(childStderr);
    end case;
  end func;


const proc: pass_3 (in string: sourcePath, in string: sourceExtension, in program: prog,
    inout boolean: okay) is func

  local
    var string: s7_lib_dir     is "";
    var string: seed7_lib      is "";
    var string: draw_lib       is "";
    var string: console_lib    is "";
    var string: database_lib   is "";
    var string: comp_data_lib  is "";
    var string: compiler_lib   is "";
    var string: special_lib    is "";
    var string: cwd            is "";
    var string: workDir        is "";
    var string: sourceFile     is "";
    var string: cSourceFile    is "";
    var string: cErrorFile     is "";
    var string: objectFile     is "";
    var string: linkErrFile    is "";
    var string: tempExeFile    is "";
    var string: linkedProgram  is "";
    var string: compile_cmd    is "";
    var array string: compileParams is 0 times "";
    var string: link_cmd       is "";
    var array string: linkParams is 0 times "";
  begin
    if okay then
      writeln("Calling the C compiler ...");
      if ccConf.CC_ENVIRONMENT_INI <> "" then
        importEnvironment(ccConf.CC_ENVIRONMENT_INI);
      end if;
      if "-b" in compiler_option then
        s7_lib_dir := convDosPath(compiler_option["-b"]);
      else
        s7_lib_dir := ccConf.S7_LIB_DIR;
      end if;
      seed7_lib     := s7_lib_dir & "/" & ccConf.SEED7_LIB;
      draw_lib      := s7_lib_dir & "/" & ccConf.DRAW_LIB;
      console_lib   := s7_lib_dir & "/" & ccConf.CONSOLE_LIB;
      database_lib  := s7_lib_dir & "/" & ccConf.DATABASE_LIB;
      comp_data_lib := s7_lib_dir & "/" & ccConf.COMP_DATA_LIB;
      compiler_lib  := s7_lib_dir & "/" & ccConf.COMPILER_LIB;
      special_lib   := s7_lib_dir & "/" & ccConf.SPECIAL_LIB;
      cwd := getcwd();
      if rpos(sourcePath, "/") = 0 then
        sourceFile := sourcePath;
      else
        if rpos(sourcePath, "/") = 1 then
          chdir("/");
        else
          chdir(sourcePath[.. pred(rpos(sourcePath, "/"))]);
        end if;
        workDir := sourcePath[.. rpos(sourcePath, "/")];
        sourceFile := sourcePath[succ(rpos(sourcePath, "/")) ..];
      end if;
      cSourceFile  := "tmp_" & sourceFile;
      if generate_c_plus_plus then
        cSourceFile  &:= ".cpp";
      else
        cSourceFile  &:= ".c";
      end if;
      cErrorFile     := "tmp_" & sourceFile & ".cerrs";
      objectFile     := "tmp_" & sourceFile & ccConf.OBJECT_FILE_EXTENSION;
      linkErrFile    := "tmp_" & sourceFile & ".lerrs";
      tempExeFile    := "tmp_" & sourceFile & ccConf.LINKED_PROGRAM_EXTENSION;
      if sourceExtension = "" and ccConf.LINKED_PROGRAM_EXTENSION = "" then
        linkedProgram :=         sourceFile & "_exe";
      else
        linkedProgram :=         sourceFile & ccConf.LINKED_PROGRAM_EXTENSION;
      end if;
      if fileType(objectFile) = FILE_REGULAR then
        removeFile(objectFile);
      end if;
      if generate_c_plus_plus then
        compile_cmd := ccConf.CPLUSPLUS_COMPILER;
      else
        compile_cmd := ccConf.C_COMPILER;
      end if;
      compileParams &:= ccConf.CC_OPT_NO_WARNINGS;
      if enable_link_time_optimization then
        compileParams &:= ccConf.CC_OPT_LINK_TIME_OPTIMIZATION;
      end if;
      if "-O" in compiler_option then
        case compiler_option["-O"] of
          when {"", "1"}:
            compileParams &:= ccConf.CC_OPT_OPTIMIZE_1;
          when {"2"}:
            compileParams &:= ccConf.CC_OPT_OPTIMIZE_2;
          when {"3"}:
            compileParams &:= ccConf.CC_OPT_OPTIMIZE_3;
          otherwise:
            writeln("*** Ignore unsupported option: -O" <& compiler_option["-O"]);
        end case;
      end if;
      if integer_overflow_check and ccConf.CC_OPT_TRAP_OVERFLOW <> "" then
        compileParams &:= ccConf.CC_OPT_TRAP_OVERFLOW;
      end if;
      if "-g" in compiler_option then
        compileParams &:= ccConf.CC_OPT_DEBUG_INFO;
        if compiler_option["-g"] <> "" and compiler_option["-g"] <> "-debug_c" then
          compileParams &:= compiler_option["-g"];
        end if;
      end if;
      if length(ccConf.CC_FLAGS) <> 0 then
        compileParams &:= ccConf.CC_FLAGS;
      end if;
      compileParams &:= "-c";
      compileParams &:= toOsPath(cSourceFile);
      if ccConf.CALL_C_COMPILER_FROM_SHELL then
        execProgramScript(compile_cmd, compileParams, cErrorFile);
      else
        execProgram(compile_cmd, compileParams, cErrorFile);
      end if;
      if fileType(cErrorFile) = FILE_REGULAR and
          fileSize(cErrorFile) = 0 then
        removeFile(cErrorFile);
      end if;
      if fileType(objectFile) <> FILE_REGULAR then
        if fileType(cErrorFile) = FILE_REGULAR then
          writeln("*** Errors in " <& literal(workDir & cSourceFile) <&
              " - see " <& literal(workDir & cErrorFile));
        elsif ccConf.CC_ERROR_FILEDES not in {1, 2} then
          writeln("*** Compilation terminated");
        else
          writeln("*** Compilation terminated without error messages");
        end if;
        okay := FALSE;
      elsif fileType(cErrorFile) = FILE_REGULAR then
        removeFile(cErrorFile);
      end if;
      if okay then
        if "-g" not in compiler_option then
          removeFile(cSourceFile);
        end if;
        if compilerLibraryUsed then
          drawLibraryUsed := TRUE;
          consoleLibraryUsed := TRUE;
          databaseLibraryUsed := TRUE;
        end if;
        if fileType(seed7_lib) <> FILE_REGULAR then
          writeln("*** Seed7 library " <& literal(seed7_lib) <& " missing");
          okay := FALSE;
        end if;
        if drawLibraryUsed and fileType(draw_lib) <> FILE_REGULAR then
          writeln("*** Draw library " <& literal(draw_lib) <& " missing");
          okay := FALSE;
        end if;
        if consoleLibraryUsed and fileType(console_lib) <> FILE_REGULAR then
          writeln("*** Console library " <& literal(console_lib) <& " missing");
          okay := FALSE;
        end if;
        if databaseLibraryUsed and fileType(database_lib) <> FILE_REGULAR then
          writeln("*** Database library " <& literal(database_lib) <& " missing");
          okay := FALSE;
        end if;
        if compilerLibraryUsed and fileType(compiler_lib) <> FILE_REGULAR then
          writeln("*** Compiler library " <& literal(compiler_lib) <& " missing");
          okay := FALSE;
        end if;
        if compDataLibraryUsed and fileType(comp_data_lib) <> FILE_REGULAR then
          writeln("*** Compiler data library " <& literal(comp_data_lib) <& " missing");
          okay := FALSE;
        end if;
        if ccConf.LINKER_OPT_SPECIAL_LIB <> "" and fileType(special_lib) <> FILE_REGULAR then
          writeln("*** Special library " <& literal(compiler_lib) <& " missing");
          okay := FALSE;
        end if;
        if okay and not compileLibrary then
          if fileType(linkedProgram) = FILE_REGULAR then
            block
              removeFile(linkedProgram);
            exception
              catch FILE_ERROR:
                writeln("*** Cannot remove old executable: " <&
                    literal(linkedProgram));
            end block;
          end if;
          if fileType(linkedProgram) = FILE_ABSENT then
            writeln("Calling the linker ...");
            if generate_c_plus_plus then
              link_cmd := ccConf.CPLUSPLUS_COMPILER;
            else
              link_cmd := ccConf.C_COMPILER;
            end if;
            if enable_link_time_optimization or ccConf.LINKER_OPT_LTO_MANDATORY then
              linkParams &:= ccConf.CC_OPT_LINK_TIME_OPTIMIZATION;
            end if;
            if "-g" in compiler_option then
              if ccConf.LINKER_OPT_DEBUG_INFO <> "" then
                linkParams &:= ccConf.LINKER_OPT_DEBUG_INFO;
              end if;
            else
              if ccConf.LINKER_OPT_NO_DEBUG_INFO <> "" then
                linkParams &:= ccConf.LINKER_OPT_NO_DEBUG_INFO;
              end if;
            end if;
            linkParams &:= ccConf.LINKER_FLAGS;
            if ccConf.LINKER_OPT_OUTPUT_FILE <> "" then
              if endsWith(ccConf.LINKER_OPT_OUTPUT_FILE, " ") then
                linkParams &:= rtrim(ccConf.LINKER_OPT_OUTPUT_FILE);
                linkParams &:= toOsPath(linkedProgram);
              else
                linkParams &:= ccConf.LINKER_OPT_OUTPUT_FILE &
                               toOsPath(linkedProgram);
              end if;
            end if;
            linkParams &:= toOsPath(objectFile);
            if compilerLibraryUsed then
              appendLibrary(linkParams, toOsPath(compiler_lib));
            end if;
            if compDataLibraryUsed then
              appendLibrary(linkParams, toOsPath(comp_data_lib));
            end if;
            if drawLibraryUsed then
              appendLibrary(linkParams, toOsPath(draw_lib));
            end if;
            if consoleLibraryUsed then
              appendLibrary(linkParams, toOsPath(console_lib));
            end if;
            if databaseLibraryUsed then
              appendLibrary(linkParams, toOsPath(database_lib));
            end if;
            appendLibrary(linkParams, toOsPath(seed7_lib));
            if ccConf.LINKER_OPT_SPECIAL_LIB <> "" then
              appendLibrary(linkParams, ccConf.LINKER_OPT_SPECIAL_LIB);
              appendLibrary(linkParams, toOsPath(special_lib));
            end if;
            appendLibrary(linkParams, ccConf.SYSTEM_LIBS);
            if bigintLibraryUsed then
              appendLibrary(linkParams, ccConf.SYSTEM_BIGINT_LIBS);
            end if;
            if consoleLibraryUsed then
              appendLibrary(linkParams, ccConf.SYSTEM_CONSOLE_LIBS);
            end if;
            if databaseLibraryUsed then
              appendLibrary(linkParams, ccConf.SYSTEM_DATABASE_LIBS);
            end if;
            if drawLibraryUsed then
              appendLibrary(linkParams, ccConf.SYSTEM_DRAW_LIBS);
            end if;
            if mathLibraryUsed then
              appendLibrary(linkParams, ccConf.SYSTEM_MATH_LIBS);
            end if;
            if ccConf.CALL_C_COMPILER_FROM_SHELL then
              execProgramScript(link_cmd, linkParams, linkErrFile);
            else
              execProgram(link_cmd, linkParams, linkErrFile);
            end if;
            if ccConf.LINKER_OPT_OUTPUT_FILE = "" and
                fileType(tempExeFile) = FILE_REGULAR then
              moveFile(tempExeFile, linkedProgram);
            end if;
            if fileType(linkedProgram) <> FILE_REGULAR then
              if fileType(linkErrFile) = FILE_REGULAR and
                  fileSize(linkErrFile) = 0 then
                removeFile(linkErrFile);
              end if;
              if fileType(linkErrFile) = FILE_REGULAR then
                writeln("*** Linker errors with " <& literal(workDir & objectFile) <&
                    " - see " <& literal(workDir & linkErrFile));
              elsif ccConf.CC_ERROR_FILEDES not in {1, 2} then
                writeln("*** Linking terminated");
              else
                writeln("*** Linking terminated without error messages");
              end if;
            elsif fileType(linkErrFile) = FILE_REGULAR then
              removeFile(linkErrFile);
            end if;
            if "-g" not in compiler_option then
              removeFile(objectFile);
            end if;
          end if;
        end if;
      end if;
      chdir(cwd);
    end if;
  end func;


const proc: writeHelp is func
  begin
    writeln("usage: s7c [options] source");
    writeln;
    writeln("Options:");
    writeln("  -?   Write Seed7 compiler usage.");
    writeln("  -O and -O2  Tell the C compiler to optimize.");
    writeln("  -b   Specify the directory of the Seed7 runtime libraries (e.g.: -b ../bin).");
    writeln("  -e   Generate code which sends a signal, if an uncaught exception occurs.");
    writeln("       This option allows debuggers to handle uncaught Seed7 exceptions.");
    writeln("  -flto Enable link time optimization.");
    writeln("  -g   Tell the C compiler to generate an executable with debug information.");
    writeln("       This way the debugger will refer to Seed7 source files and line numbers.");
    writeln("       To generate debug information which refers to the temporary C program");
    writeln("       the option -g-debug_c can be used.");
    writeln("  -l   Add a directory to the include library search path (e.g.: -l ../lib).");
    writeln("  -ocn Optimize constants with level n. E.g.: -oc3");
    writeln("       The level n is a digit between 0 and 3:");
    writeln("         0 Do no optimizations with constants.");
    writeln("         1 Use literals and named constants to simplify expressions (default).");
    writeln("         2 Evaluate constant parameter expressions to simplify expressions.");
    writeln("         3 Like -oc2 and additionally evaluate all constant expressions.");
    writeln("  -p   Activate simple function profiling.");
    writeln("  -sx  Suppress checks specified with x. E.g.: -sr or -sro");
    writeln("       The checks x are specified with letters from the following list:");
    writeln("         d Suppress the generation of checks for integer division by zero.");
    writeln("         i Suppress the generation of index checks (e.g. string, array).");
    writeln("         o Suppress the generation of integer overflow checks.");
    writeln("         r Suppress the generation of range checks.");
    writeln("  -tx  Set runtime trace level to x. Where x is a string consisting of:");
    writeln("         e Trace exceptions and handlers");
    writeln("         f Trace functions");
    writeln("         s Trace signals");
    writeln;
  end func;


const proc: main is func

  local
    var integer: index is 0;
    var string: curr_arg is "";
    var string: source is "";
    var string: sourcePath is "";
    var string: sourceExtension is "";
    var boolean: okay is TRUE;

  begin
    OUT := STD_UTF8_OUT;
    writeln("SEED7 COMPILER Version 3.1." <& ccConf.VERSION_REVISION_LEVEL <&
            " Copyright (c) 1990-2021 Thomas Mertes");
    if length(argv(PROGRAM)) = 0 then
      writeln("This is free software; see the source for copying conditions.  There is NO");
      writeln("warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.");
      writeln("S7c is written in the Seed7 programming language");
      writeln("Homepage: http://seed7.sourceforge.net");
      writeln;
      writeln("usage: s7c [options] source");
      writeln;
      writeln("Use  s7c -?  to get more information about s7c.");
      writeln;
    else
      for index range 1 to length(argv(PROGRAM)) do
        curr_arg := argv(PROGRAM)[index];
        if length(curr_arg) >= 2 and curr_arg[1] = '-' then
          if curr_arg in {"-b"} and index < length(argv(PROGRAM)) then
            incr(index);
            compiler_option @:= [curr_arg] argv(PROGRAM)[index];
          elsif curr_arg in {"-l"} and index < length(argv(PROGRAM)) then
            incr(index);
            libraryDirs &:= convDosPath(argv(PROGRAM)[index]);
          elsif curr_arg[.. 2] in {"-?", "-b", "-c", "-e", "-f", "-g", "-o", "-p", "-s", "-t", "-O"} then
            if curr_arg[.. 2] in compiler_option then
              writeln("*** Option " <& curr_arg[.. 2] <&
                      " specified twice. Ignore option: " <& curr_arg);
            else
              compiler_option @:= [curr_arg[.. 2]] curr_arg[3 ..];
            end if;
          else
            writeln("*** Ignore unsupported option: " <& curr_arg);
          end if;
        elsif source = "" then
          source := convDosPath(curr_arg);
        else
          writeln("*** Ignore superfluous parameter: " <& curr_arg);
        end if;
      end for;
      if "-?" in compiler_option then
        writeHelp;
      elsif source = "" then
        writeln("*** Sourcefile missing");
      else
        writeln("Source: " <& source);
        pass_1(source, prog, okay);
        if okay then
          sourcePath := path(prog);
          if  endsWith(sourcePath, ".sd7") or
              endsWith(sourcePath, ".s7i") then
            sourceExtension := sourcePath[length(sourcePath) - 3 ..];
            sourcePath := sourcePath[.. length(sourcePath) - 4];
          end if;
        end if;
        pass_2(sourcePath, prog, okay);
        pass_3(sourcePath, sourceExtension, prog, okay);
      end if;
    end if;
  end func;