unsigned g95_init_options(unsigned argc, const char *argv[]) {
memset(&g95_option, '\0', sizeof(g95_option));
g95_option.fixed_line_length = 72;
g95_option.form = FORM_UNKNOWN;
g95_option.q_kind = g95_default_double_kind();
g95_option.l1 = g95_default_logical_kind();
g95_option.max_frame_size = 250000;
g95_option.symbol_len = G95_MAX_SYMBOL_LEN;
g95_option.cpp = -1;
g95_option.short_circuit = 1;
g95_option.traditional = 1;
g95_option.globals = 1;
g95_option.no_backslash = HAVE_WINDOWS;
argc = 0;
argv = NULL;
#ifdef IN_GCC
flag_errno_math = 0;
#endif
#if STD_F
g95_option.fmode = 96;
g95_option.symbol_len = 31;
set_Wall();
g95_option.tr15581 = 1;
g95_option.bounds_check = 1;
g95_option.real_init = REAL_INIT_NAN;
g95_option.trace = TRACE_FULL;
#endif
return CL_F95;
}
int g95_handle_arg(size_t scode, const char *arg, int value) {
enum opt_code code;
int r;
r = 1;
code = (enum opt_code) scode;
if (code == N_OPTS)
return 1;
switch(code) {
case OPT_arch:
break;
case OPT_cpp:
g95_option.cpp = value;
break;
case OPT_D:
g95_define_cpp_macro((char *) arg, 1);
break;
case OPT_d8:
g95_option.default_integer = 8;
g95_option.r_value = 8;
break;
case OPT_E:
g95_option.preprocess_only = value;
break;
case OPT_fbackslash:
g95_option.no_backslash = !value;
break;
case OPT_fbounds_check:
g95_option.bounds_check = value;
break;
case OPT_fc_binding:
g95_option.c_binding = value;
break;
case OPT_fcase_upper:
g95_option.case_upper = value;
break;
case OPT_fdollar_ok:
g95_option.dollar = value;
break;
case OPT_fd_comment:
g95_option.d_comment = value;
break;
case OPT_fendian_:
if (strcasecmp(arg, "big") == 0)
g95_option.endian = 1;
else if (strcasecmp(arg, "little") == 0)
g95_option.endian = 2;
else
g95_fatal_error("Bad value for -fendian");
break;
case OPT_ffixed_form:
g95_option.form = FORM_FIXED;
break;
case OPT_ffixed_line_length_80:
g95_option.fixed_line_length = 80;
break;
case OPT_ffixed_line_length_132:
g95_option.fixed_line_length = 132;
break;
case OPT_ffree_form:
g95_option.form = FORM_FREE;
break;
case OPT_ffree_line_length_huge:
g95_option.huge_line = 1;
break;
case OPT_fimplicit_none:
g95_option.implicit_none = value;
break;
case OPT_fintrinsic_extensions:
g95_option.intrinsic_extensions = value;
break;
case OPT_fintrinsic_extensions_:
g95_option.intrinsic_extensions = 1;
g95_option.intrinsics = (char *) arg;
break;
case OPT_fleading_underscore:
g95_option.leading_underscore = value;
flag_leading_underscore = !value;
break;
case OPT_max_frame_size_:
g95_option.max_frame_size = value;
break;
case OPT_fmod_:
module_path(arg);
add_path(arg);
break;
case OPT_fmodule_private:
g95_option.module_access_private = value;
break;
case OPT_fmultiple_save:
g95_option.multiple_save = value;
break;
case OPT_fone_error:
g95_option.one_error = value;
break;
case OPT_fonetrip:
g95_option.onetrip = value;
break;
case OPT_freal_loops:
g95_option.real_loops = value;
break;
case OPT_fpack_derived:
g95_option.pack_derived = value;
break;
case OPT_fqkind_:
g95_option.q_kind = atoi(arg);
if (g95_validate_kind(BT_REAL, g95_option.q_kind) < 0)
g95_fatal_error("Argument to -fqkind isn't a valid real kind");
break;
case OPT_fsecond_underscore:
g95_option.no_second_underscore = !value;
break;
case OPT_fshort_circuit:
g95_option.short_circuit = value;
break;
case OPT_fsloppy_char:
g95_option.sloppy_char = value;
break;
case OPT_fstatic:
g95_option.static_var = value;
break;
case OPT_fsyntax:
g95_option.verbose = value;
break;
case OPT_ftrace_:
if (strcasecmp(arg, "none") == 0)
g95_option.trace = TRACE_NONE;
else if (strcasecmp(arg, "frame") == 0)
g95_option.trace = TRACE_FRAME;
else if (strcasecmp(arg, "full") == 0)
g95_option.trace = TRACE_FULL;
else
g95_fatal_error("Bad value for -ftrace");
break;
case OPT_ftr15581:
g95_option.tr15581 = value;
break;
case OPT_finteger_:
g95_option.integer_init = 1;
g95_option.integer_value = atoi(arg);
break;
case OPT_flogical_:
if (strcasecmp(arg, "none") == 0)
g95_option.logical_init = LOGICAL_INIT_NONE;
else if (strcasecmp(arg, "true") == 0)
g95_option.logical_init = LOGICAL_INIT_TRUE;
else if (strcasecmp(arg, "false") == 0)
g95_option.logical_init = LOGICAL_INIT_FALSE;
else
g95_fatal_error("Bad value for -flogical");
break;
case OPT_freal_:
if (strcasecmp(arg, "none") == 0)
g95_option.real_init = REAL_INIT_NONE;
else if (strcasecmp(arg, "zero") == 0)
g95_option.real_init = REAL_INIT_ZERO;
else if (strcasecmp(arg, "nan") == 0)
g95_option.real_init = REAL_INIT_NAN;
else if (strcasecmp(arg, "inf") == 0)
g95_option.real_init = REAL_INIT_PLUS_INF;
else if (strcasecmp(arg, "+inf") == 0)
g95_option.real_init = REAL_INIT_PLUS_INF;
else if (strcasecmp(arg, "-inf") == 0)
g95_option.real_init = REAL_INIT_MINUS_INF;
else
g95_fatal_error("Bad value for -freal");
break;
case OPT_fpointer_:
if (strcasecmp(arg, "none") == 0)
g95_option.pointer_init = POINTER_INIT_NONE;
else if (strcasecmp(arg, "null") == 0)
g95_option.pointer_init = POINTER_INIT_NULL;
else if (strcasecmp(arg, "invalid") == 0)
g95_option.pointer_init = POINTER_INIT_INVALID;
else
g95_fatal_error("Bad value for -fpointer");
break;
case OPT_fround_:
if (strcasecmp(arg, "nearest") == 0)
g95_option.round = ROUND_NEAREST;
else if (strcasecmp(arg, "plus") == 0)
g95_option.round = ROUND_PLUS;
else if (strcasecmp(arg, "minus") == 0)
g95_option.round = ROUND_MINUS;
else if (strcasecmp(arg, "zero") == 0)
g95_option.round = ROUND_ZERO;
else
g95_fatal_error("Bad value for -fround");
break;
case OPT_fzero:
g95_option.zero_init = value;
break;
case OPT_funderscoring:
g95_option.no_underscoring = !value;
break;
case OPT_I:
add_path(arg);
break;
case OPT_i4:
g95_option.default_integer = 4;
break;
case OPT_i8:
g95_option.default_integer = 8;
break;
case OPT_include:
break;
case OPT_M:
g95_option.deps = 1;
break;
case OPT_r4:
g95_option.r_value = 4;
break;
case OPT_r8:
g95_option.r_value = 8;
break;
case OPT_r10:
#if !defined(FPU_387) && !defined(FPU_SSE)
g95_fatal_error("r10 option not supported on this platform");
#endif
g95_option.r_value = 10;
break;
case OPT_r16:
g95_option.r_value = 16;
break;
case OPT_no_cpp:
g95_option.cpp = !value;
break;
case OPT_std_F:
g95_option.fmode = 96;
g95_option.symbol_len = 31;
break;
case OPT_std_f2003:
g95_option.fmode = 2003;
g95_option.symbol_len = 63;
break;
case OPT_std_f95:
g95_option.fmode = 95;
g95_option.symbol_len = 31;
break;
case OPT_traditional:
g95_option.traditional = 1;
break;
case OPT_nontraditional:
g95_option.traditional = 0;
break;
case OPT_U:
g95_define_cpp_macro((char *) arg, 0);
break;
case OPT_Wall:
set_Wall();
break;
case OPT_Werror:
g95_option.werror = value;
break;
case OPT_Werror_:
set_error_list(arg);
break;
case OPT_Wglobals:
g95_option.globals = value;
break;
case OPT_Wimplicit_interface:
g95_option.implicit_interface = value;
break;
case OPT_Wimplicit_none:
g95_option.implicit_none = value;
break;
case OPT_Wline_truncation:
g95_option.line_truncation = value;
break;
case OPT_Wmissing_intent:
g95_option.missing_intent = value;
break;
case OPT_Wno_:
set_nowarn(arg);
break;
case OPT_Wobsolescent:
g95_option.obsolescent = value;
break;
case OPT_Wprecision_loss:
g95_option.prec_loss = value;
break;
case OPT_Wuninitialized:
g95_option.uninit = value;
g95_option.uninit = 0; /* Disabled for now. */
warn_uninitialized = 2;
break;
case OPT_Wunused_label:
g95_option.unused_label = value;
break;
case OPT_Wunused_internal_procs:
g95_option.unused_internal_procs = value;
break;
case OPT_Wunused_module_vars:
g95_option.unused_module_vars = value;
break;
case OPT_Wunused_module_procs:
g95_option.unused_module_procs = value;
break;
case OPT_Wunused_parameter:
g95_option.unused_parameter = value;
break;
case OPT_Wunused_target:
g95_option.unused_target = value;
break;
case OPT_Wunused_types:
g95_option.unused_types = value;
break;
case OPT_Wunused_vars:
g95_option.unused_vars = value;
break;
case OPT_Wunset_vars:
g95_option.unset_vars = value;
break;
default:
r = 0;
break;
}
return r;
}
int
gfc_handle_option (size_t scode, const char *arg, int value)
{
int result = 1;
enum opt_code code = (enum opt_code) scode;
/* Ignore file names. */
if (code == N_OPTS)
return 1;
if (gfc_cpp_handle_option (scode, arg, value) == 1)
return 1;
switch (code)
{
default:
result = 0;
break;
case OPT_Wall:
set_Wall (value);
break;
case OPT_Waliasing:
gfc_option.warn_aliasing = value;
break;
case OPT_Wampersand:
gfc_option.warn_ampersand = value;
break;
case OPT_Warray_temporaries:
gfc_option.warn_array_temp = value;
break;
case OPT_Wcharacter_truncation:
gfc_option.warn_character_truncation = value;
break;
case OPT_Wconversion:
gfc_option.warn_conversion = value;
break;
case OPT_Wimplicit_interface:
gfc_option.warn_implicit_interface = value;
break;
case OPT_Wline_truncation:
gfc_option.warn_line_truncation = value;
break;
case OPT_Wreturn_type:
warn_return_type = value;
break;
case OPT_Wsurprising:
gfc_option.warn_surprising = value;
break;
case OPT_Wtabs:
gfc_option.warn_tabs = value;
break;
case OPT_Wunderflow:
gfc_option.warn_underflow = value;
break;
case OPT_Wintrinsic_shadow:
gfc_option.warn_intrinsic_shadow = value;
break;
case OPT_Walign_commons:
gfc_option.warn_align_commons = value;
break;
case OPT_fall_intrinsics:
gfc_option.flag_all_intrinsics = 1;
break;
case OPT_fautomatic:
gfc_option.flag_automatic = value;
break;
case OPT_fallow_leading_underscore:
gfc_option.flag_allow_leading_underscore = value;
break;
case OPT_fbackslash:
gfc_option.flag_backslash = value;
break;
case OPT_fbacktrace:
gfc_option.flag_backtrace = value;
break;
case OPT_fcheck_array_temporaries:
gfc_option.flag_check_array_temporaries = value;
break;
case OPT_fdump_core:
gfc_option.flag_dump_core = value;
break;
case OPT_fcray_pointer:
gfc_option.flag_cray_pointer = value;
break;
case OPT_ff2c:
gfc_option.flag_f2c = value;
break;
case OPT_fdollar_ok:
gfc_option.flag_dollar_ok = value;
break;
case OPT_fexternal_blas:
gfc_option.flag_external_blas = value;
break;
case OPT_fblas_matmul_limit_:
gfc_option.blas_matmul_limit = value;
break;
case OPT_fd_lines_as_code:
gfc_option.flag_d_lines = 1;
break;
case OPT_fd_lines_as_comments:
gfc_option.flag_d_lines = 0;
break;
case OPT_fdump_parse_tree:
gfc_option.dump_parse_tree = value;
break;
case OPT_ffixed_form:
gfc_option.source_form = FORM_FIXED;
break;
case OPT_ffixed_line_length_none:
gfc_option.fixed_line_length = 0;
break;
case OPT_ffixed_line_length_:
if (value != 0 && value < 7)
gfc_fatal_error ("Fixed line length must be at least seven.");
gfc_option.fixed_line_length = value;
break;
case OPT_ffree_form:
gfc_option.source_form = FORM_FREE;
break;
case OPT_fopenmp:
gfc_option.flag_openmp = value;
break;
case OPT_ffree_line_length_none:
gfc_option.free_line_length = 0;
break;
case OPT_ffree_line_length_:
if (value != 0 && value < 4)
gfc_fatal_error ("Free line length must be at least three.");
gfc_option.free_line_length = value;
break;
case OPT_funderscoring:
gfc_option.flag_underscoring = value;
break;
case OPT_fsecond_underscore:
gfc_option.flag_second_underscore = value;
break;
case OPT_static_libgfortran:
#ifndef HAVE_LD_STATIC_DYNAMIC
gfc_fatal_error ("-static-libgfortran is not supported in this "
"configuration");
#endif
break;
case OPT_fimplicit_none:
gfc_option.flag_implicit_none = value;
break;
case OPT_fintrinsic_modules_path:
gfc_add_include_path (arg, false, false);
gfc_add_intrinsic_modules_path (arg);
break;
case OPT_fmax_array_constructor_:
gfc_option.flag_max_array_constructor = value > 65535 ? value : 65535;
break;
case OPT_fmax_errors_:
gfc_option.max_errors = value;
break;
case OPT_fmax_stack_var_size_:
gfc_option.flag_max_stack_var_size = value;
break;
case OPT_fmodule_private:
gfc_option.flag_module_private = value;
break;
case OPT_frange_check:
gfc_option.flag_range_check = value;
break;
case OPT_fpack_derived:
gfc_option.flag_pack_derived = value;
break;
case OPT_frepack_arrays:
gfc_option.flag_repack_arrays = value;
break;
case OPT_fpreprocessed:
gfc_option.flag_preprocessed = value;
break;
case OPT_fmax_identifier_length_:
if (value > GFC_MAX_SYMBOL_LEN)
gfc_fatal_error ("Maximum supported identifier length is %d",
GFC_MAX_SYMBOL_LEN);
gfc_option.max_identifier_length = value;
break;
case OPT_fdefault_integer_8:
gfc_option.flag_default_integer = value;
break;
case OPT_fdefault_real_8:
gfc_option.flag_default_real = value;
break;
case OPT_fdefault_double_8:
gfc_option.flag_default_double = value;
break;
case OPT_finit_local_zero:
gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
gfc_option.flag_init_integer_value = 0;
gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
gfc_option.flag_init_character_value = (char)0;
break;
case OPT_finit_logical_:
if (!strcasecmp (arg, "false"))
gfc_option.flag_init_logical = GFC_INIT_LOGICAL_FALSE;
else if (!strcasecmp (arg, "true"))
gfc_option.flag_init_logical = GFC_INIT_LOGICAL_TRUE;
else
gfc_fatal_error ("Unrecognized option to -finit-logical: %s",
arg);
break;
case OPT_finit_real_:
if (!strcasecmp (arg, "zero"))
gfc_option.flag_init_real = GFC_INIT_REAL_ZERO;
else if (!strcasecmp (arg, "nan"))
gfc_option.flag_init_real = GFC_INIT_REAL_NAN;
else if (!strcasecmp (arg, "inf"))
gfc_option.flag_init_real = GFC_INIT_REAL_INF;
else if (!strcasecmp (arg, "-inf"))
gfc_option.flag_init_real = GFC_INIT_REAL_NEG_INF;
else
gfc_fatal_error ("Unrecognized option to -finit-real: %s",
arg);
break;
case OPT_finit_integer_:
gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
gfc_option.flag_init_integer_value = atoi (arg);
break;
case OPT_finit_character_:
if (value >= 0 && value <= 127)
{
gfc_option.flag_init_character = GFC_INIT_CHARACTER_ON;
gfc_option.flag_init_character_value = (char)value;
}
else
gfc_fatal_error ("The value of n in -finit-character=n must be "
"between 0 and 127");
break;
case OPT_I:
gfc_add_include_path (arg, true, false);
break;
case OPT_J:
gfc_handle_module_path_options (arg);
break;
case OPT_fsign_zero:
gfc_option.flag_sign_zero = value;
break;
case OPT_ffpe_trap_:
gfc_handle_fpe_trap_option (arg);
break;
case OPT_std_f95:
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77;
gfc_option.warn_std = GFC_STD_F95_OBS;
gfc_option.max_continue_fixed = 19;
gfc_option.max_continue_free = 39;
gfc_option.max_identifier_length = 31;
gfc_option.warn_ampersand = 1;
gfc_option.warn_tabs = 0;
break;
case OPT_std_f2003:
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
| GFC_STD_F2003 | GFC_STD_F95;
gfc_option.warn_std = GFC_STD_F95_OBS;
gfc_option.max_identifier_length = 63;
gfc_option.warn_ampersand = 1;
gfc_option.warn_tabs = 0;
break;
case OPT_std_f2008:
gfc_option.allow_std = GFC_STD_F95_OBS | GFC_STD_F77
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F2008;
gfc_option.warn_std = GFC_STD_F95_OBS;
gfc_option.max_identifier_length = 63;
gfc_option.warn_ampersand = 1;
gfc_option.warn_tabs = 0;
break;
case OPT_std_gnu:
set_default_std_flags ();
break;
case OPT_std_legacy:
set_default_std_flags ();
gfc_option.warn_std = 0;
break;
case OPT_Wintrinsics_std:
gfc_option.warn_intrinsics_std = value;
break;
case OPT_fshort_enums:
gfc_option.fshort_enums = 1;
break;
case OPT_fconvert_little_endian:
gfc_option.convert = GFC_CONVERT_LITTLE;
break;
case OPT_fconvert_big_endian:
gfc_option.convert = GFC_CONVERT_BIG;
break;
case OPT_fconvert_native:
gfc_option.convert = GFC_CONVERT_NATIVE;
break;
case OPT_fconvert_swap:
gfc_option.convert = GFC_CONVERT_SWAP;
break;
case OPT_frecord_marker_4:
gfc_option.record_marker = 4;
break;
case OPT_frecord_marker_8:
gfc_option.record_marker = 8;
break;
case OPT_fmax_subrecord_length_:
if (value > MAX_SUBRECORD_LENGTH)
gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
MAX_SUBRECORD_LENGTH);
gfc_option.max_subrecord_length = value;
break;
case OPT_frecursive:
gfc_option.flag_recursive = 1;
break;
case OPT_falign_commons:
gfc_option.flag_align_commons = value;
break;
}
return result;
}
