mirror of git://gcc.gnu.org/git/gcc.git
cobol: Implement ENTRY statement; finish removing ascii/ebcdic dichotomy.
The prior set of changes largely eliminated the assumption that the internal codeset was either ascii or ebcdic. These changes remove the last vestiges of that assumption. These changes also implement the COBOL ENTRY statement, which allows a program-id to have more than one externally callable entry point. Since GCC assumes the existence of an ABI that is not, repeat *not* capable of that, it is implemented here by creating a separate function with the name specified by the ENTRY statement. That function sets up global variables which cause control to be transferred to the ENTRY point when the parent function is called re-entrantly, and then executes that call. gcc/cobol/ChangeLog: * genapi.cc (move_tree): Formatting. (parser_enter_file): Incorporate global __gg__entry_label. (enter_program_common): Remove calls to alphabet overrides. (parser_alphabet): Change cbl_alphabet_e handling. (parser_alphabet_use): Likewise. (initialize_the_data): Likewise. (establish_using): Process passed parameters in a subroutine. (parser_division): Remove in-line parameter processing; call establish_using() instead. Check for __gg__entry_label. (parser_file_add): Temporary workaround for charset encoding. (parser_file_open): Likewise. (create_and_call): Push/pop program state around call to external. (parser_entry): Implement new ENTRY statement feature. (mh_source_is_literalN): Formatting. * genapi.h (parser_entry): New ENTRY statement. * gengen.cc (gg_create_goto_pair): Formatting. (gg_goto_label_decl): Remove. * gengen.h (gg_goto_label_decl): Remove. * genutil.cc (internal_codeset_is_ebcdic): Remove. * genutil.h (internal_codeset_is_ebcdic): Remove. * symbols.cc (symbols_alphabet_set): Restrict alphabet scan to program. * symbols.h (is_elementary): Use defined constants instead of explicit 'A'and 'N' libgcobol/ChangeLog: * charmaps.cc (__gg__set_internal_codeset): Eliminate ascii/ebcdic. (__gg__text_conversion_override): Remove. * charmaps.h (enum text_device_t): Eliminate ascii/ebcdic. (enum text_codeset_t): Remove. (__gg__set_internal_codeset): Remove. (__gg__text_conversion_override): Remove. * gfileio.cc: Anticipate cbl_encoding_t fixes. * libgcobol.cc (struct program_state): Incorporate __gg__entry_label. (__gg__pop_program_state): Eliminate unused defines. (__gg__alphabet_use): Eliminate ascii/ebcdic dichotomy. * valconv.cc (__gg__alphabet_create): Likewise.
This commit is contained in:
Robert Dubner
parent
5d110ed194
commit
85750fb8c2
|
|
@ -3774,6 +3774,7 @@ parser_enter_file(const char *filename)
|
|||
SET_VAR_DECL(var_decl_treeplet_4s , SIZE_T_P , "__gg__treeplet_4s" );
|
||||
SET_VAR_DECL(var_decl_nop , INT , "__gg__nop" );
|
||||
SET_VAR_DECL(var_decl_main_called , INT , "__gg__main_called" );
|
||||
SET_VAR_DECL(var_decl_entry_label , VOID_P , "__gg__entry_label" );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -3865,25 +3866,6 @@ enter_program_common(const char *funcname, const char *funcname_)
|
|||
current_function->current_section = NULL;
|
||||
current_function->current_paragraph = NULL;
|
||||
|
||||
// Text conversion must be initialized before the code generated by
|
||||
// parser_symbol_add runs.
|
||||
|
||||
// The text_conversion_override exists both in the library and in the compiler
|
||||
|
||||
__gg__set_internal_codeset(internal_codeset_is_ebcdic());
|
||||
gg_call(VOID,
|
||||
"__gg__set_internal_codeset",
|
||||
internal_codeset_is_ebcdic()
|
||||
? integer_one_node : integer_zero_node,
|
||||
NULL_TREE);
|
||||
|
||||
__gg__text_conversion_override(td_default_e, cs_default_e);
|
||||
gg_call(VOID,
|
||||
"__gg__text_conversion_override",
|
||||
build_int_cst_type(INT, td_default_e),
|
||||
build_int_cst_type(INT, cs_default_e),
|
||||
NULL_TREE);
|
||||
|
||||
gg_call(VOID,
|
||||
"__gg__codeset_figurative_constants",
|
||||
NULL_TREE);
|
||||
|
|
@ -5059,29 +5041,34 @@ parser_alphabet( cbl_alphabet_t& alphabet )
|
|||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
fprintf(stderr, "%s\n", alphabet.name);
|
||||
char *psz = xasprintf(" %s ", alphabet.name);
|
||||
SHOW_PARSE_TEXT(psz);
|
||||
free(psz);
|
||||
switch(alphabet.encoding)
|
||||
{
|
||||
case ASCII_e:
|
||||
fprintf(stderr, "ASCII\n");
|
||||
psz = xasprintf("ASCII");
|
||||
break;
|
||||
case iso646_e:
|
||||
fprintf(stderr, "ISO646\n");
|
||||
psz = xasprintf("ISO646");
|
||||
break;
|
||||
case EBCDIC_e:
|
||||
fprintf(stderr, "EBCDIC\n");
|
||||
psz = xasprintf("EBCDIC");
|
||||
break;
|
||||
case UTF8_e:
|
||||
fprintf(stderr, "UTF8\n");
|
||||
psz = xasprintf("UTF8");
|
||||
break;
|
||||
case custom_encoding_e:
|
||||
fprintf(stderr, "%s\n", alphabet.name);
|
||||
psz = xasprintf("%s", alphabet.name);
|
||||
break;
|
||||
default:
|
||||
{ const char * p = __gg__encoding_iconv_name( alphabet.encoding );
|
||||
fprintf(stderr, "%s\n", p? p : "[unknown]");
|
||||
psz = xasprintf("%s", p? p : "[unknown]");
|
||||
}
|
||||
}
|
||||
SHOW_PARSE_TEXT(" ");
|
||||
SHOW_PARSE_TEXT(psz);
|
||||
free(psz);
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
|
||||
|
|
@ -5122,6 +5109,7 @@ parser_alphabet( cbl_alphabet_t& alphabet )
|
|||
gg_get_address_of(table256),
|
||||
build_int_cst_type(INT, alphabet.low_index),
|
||||
build_int_cst_type(INT, alphabet.high_index),
|
||||
|
||||
NULL_TREE );
|
||||
break;
|
||||
}
|
||||
|
|
@ -5137,26 +5125,31 @@ parser_alphabet_use( cbl_alphabet_t& alphabet )
|
|||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
char *psz = xasprintf(" %s ", alphabet.name);
|
||||
SHOW_PARSE_TEXT(psz);
|
||||
free(psz);
|
||||
switch(alphabet.encoding)
|
||||
{
|
||||
case ASCII_e:
|
||||
fprintf(stderr, "ASCII\n");
|
||||
psz = xasprintf("ASCII");
|
||||
break;
|
||||
case iso646_e:
|
||||
fprintf(stderr, "ISO646\n");
|
||||
psz = xasprintf("ISO646");
|
||||
break;
|
||||
case EBCDIC_e:
|
||||
fprintf(stderr, "EBCDIC\n");
|
||||
psz = xasprintf("EBCDIC");
|
||||
break;
|
||||
case UTF8_e:
|
||||
fprintf(stderr, "UTF8\n");
|
||||
psz = xasprintf("UTF8");
|
||||
break;
|
||||
case custom_encoding_e:
|
||||
fprintf(stderr, "%s\n", alphabet.name);
|
||||
psz = xasprintf("%s", alphabet.name);
|
||||
break;
|
||||
default:
|
||||
gcc_unreachable();
|
||||
}
|
||||
SHOW_PARSE_TEXT(psz);
|
||||
free(psz);
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
|
||||
|
|
@ -5174,6 +5167,7 @@ parser_alphabet_use( cbl_alphabet_t& alphabet )
|
|||
__gg__high_value_character = DEGENERATE_HIGH_VALUE;
|
||||
gg_call(VOID,
|
||||
"__gg__alphabet_use",
|
||||
build_int_cst_type(INT, current_encoding(encoding_display_e)),
|
||||
build_int_cst_type(INT, alphabet.encoding),
|
||||
null_pointer_node,
|
||||
NULL_TREE);
|
||||
|
|
@ -5189,6 +5183,7 @@ parser_alphabet_use( cbl_alphabet_t& alphabet )
|
|||
|
||||
gg_call(VOID,
|
||||
"__gg__alphabet_use",
|
||||
build_int_cst_type(INT, current_encoding(encoding_display_e)),
|
||||
build_int_cst_type(INT, alphabet.encoding),
|
||||
build_int_cst_type(SIZE_T, alphabet_index),
|
||||
NULL_TREE);
|
||||
|
|
@ -6938,6 +6933,7 @@ initialize_the_data()
|
|||
// This is one-time initialization of the libgcobol program state stack
|
||||
gg_call(VOID,
|
||||
"__gg__init_program_state",
|
||||
build_int_cst_type(INT, current_encoding(encoding_display_e)),
|
||||
NULL_TREE);
|
||||
|
||||
__gg__currency_signs = __gg__ct_currency_signs;
|
||||
|
|
@ -6989,211 +6985,20 @@ initialize_the_data()
|
|||
}
|
||||
}
|
||||
|
||||
static
|
||||
void
|
||||
parser_division(cbl_division_t division,
|
||||
cbl_field_t *returning,
|
||||
size_t nusing,
|
||||
establish_using(size_t nusing,
|
||||
cbl_ffi_arg_t args[] )
|
||||
{
|
||||
// This is called when the parser enters a COBOL program DIVISION. See
|
||||
// parser_divide for the arithmetic operation.
|
||||
|
||||
if( mode_syntax_only() ) return;
|
||||
|
||||
// Do this before the SHOW_PARSE; it makes a little more sense when reviewing
|
||||
// the SHOW_PARSE output.
|
||||
if( division == identification_div_e )
|
||||
if( nusing )
|
||||
{
|
||||
initialized_data = false;
|
||||
if( gg_trans_unit.function_stack.size() >= 1 )
|
||||
{
|
||||
// This is a nested program. So, we need to tie off the current
|
||||
// section:
|
||||
leave_paragraph_internal();
|
||||
leave_section_internal();
|
||||
}
|
||||
}
|
||||
|
||||
if( division == environment_div_e )
|
||||
{
|
||||
initialized_data = false;
|
||||
}
|
||||
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
SHOW_PARSE_TEXT(" ")
|
||||
switch(division)
|
||||
{
|
||||
case identification_div_e:
|
||||
SHOW_PARSE_TEXT("IDENTIFICATION")
|
||||
break;
|
||||
case environment_div_e:
|
||||
SHOW_PARSE_TEXT("ENVIRONMENT")
|
||||
break;
|
||||
case data_div_e:
|
||||
SHOW_PARSE_TEXT("DATA")
|
||||
break;
|
||||
case procedure_div_e:
|
||||
SHOW_PARSE_TEXT("PROCEDURE")
|
||||
break;
|
||||
}
|
||||
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
|
||||
if( division == data_div_e )
|
||||
{
|
||||
Analyze();
|
||||
initialize_the_data();
|
||||
}
|
||||
if( division == environment_div_e )
|
||||
{
|
||||
Analyze();
|
||||
initialize_the_data();
|
||||
}
|
||||
else if( division == procedure_div_e )
|
||||
{
|
||||
Analyze();
|
||||
initialize_the_data();
|
||||
|
||||
// Do some symbol table index bookkeeping. current_program_index() is valid
|
||||
// at this point in time:
|
||||
current_function->our_symbol_table_index = current_program_index();
|
||||
|
||||
// We have some housekeeping to do to keep track of the list of functions
|
||||
// accessible by us:
|
||||
|
||||
// For every procedure, we need a variable that points to the list of
|
||||
// available program names.
|
||||
|
||||
// We need a pointer to the array of program names
|
||||
char ach[2*sizeof(cbl_name_t)];
|
||||
sprintf(ach,
|
||||
"..accessible_program_list_" HOST_SIZE_T_PRINT_DEC,
|
||||
(fmt_size_t)current_function->our_symbol_table_index);
|
||||
tree prog_list = gg_define_variable(build_pointer_type(CHAR_P),
|
||||
ach, vs_file_static);
|
||||
|
||||
// Likewise, we need a pointer to the array of pointers to functions:
|
||||
tree function_type =
|
||||
build_varargs_function_type_array( SIZE_T,
|
||||
0, // No parameters yet
|
||||
NULL); // And, hence, no types
|
||||
tree pointer_type = build_pointer_type(function_type);
|
||||
tree constructed_array_type = build_array_type_nelts(pointer_type, 1);
|
||||
sprintf(ach,
|
||||
"..accessible_program_pointers_" HOST_SIZE_T_PRINT_DEC,
|
||||
(fmt_size_t)current_function->our_symbol_table_index);
|
||||
tree prog_pointers = gg_define_variable(
|
||||
build_pointer_type(constructed_array_type),
|
||||
ach,
|
||||
vs_file_static);
|
||||
gg_call(VOID,
|
||||
"__gg__set_program_list",
|
||||
build_int_cst_type(INT, current_function->our_symbol_table_index),
|
||||
gg_get_address_of(prog_list),
|
||||
gg_get_address_of(prog_pointers),
|
||||
NULL_TREE);
|
||||
|
||||
if( gg_trans_unit.function_stack.size() == 1 )
|
||||
{
|
||||
gg_create_goto_pair(&label_list_out_goto,
|
||||
&label_list_out_label);
|
||||
gg_create_goto_pair(&label_list_back_goto,
|
||||
&label_list_back_label);
|
||||
gg_append_statement(label_list_out_goto);
|
||||
gg_append_statement(label_list_back_label);
|
||||
}
|
||||
|
||||
tree globals_are_initialized = gg_declare_variable( INT,
|
||||
"__gg__globals_are_initialized",
|
||||
NULL,
|
||||
vs_external_reference);
|
||||
IF( globals_are_initialized, eq_op, integer_zero_node )
|
||||
{
|
||||
// one-time initialization happens here
|
||||
|
||||
// We need to establish the initial value of the UPSI-1 switch register
|
||||
// We are using IBM's conventions:
|
||||
// https://www.ibm.com/docs/en/zvse/6.2?topic=SSB27H_6.2.0/fa2sf_communicate_appl_progs_via_job_control.html
|
||||
// UPSI 10000110 means that bits 0, 5, and 6 are on, which means that
|
||||
// SW-0, SW-5, and SW-6 are on.
|
||||
gg_call(VOID,
|
||||
"__gg__onetime_initialization",
|
||||
NULL_TREE);
|
||||
|
||||
// And then flag one-time initialization as having been done.
|
||||
gg_assign(globals_are_initialized, integer_one_node);
|
||||
}
|
||||
ELSE
|
||||
ENDIF
|
||||
|
||||
gg_append_statement(current_function->skip_init_label);
|
||||
// This is where we check to see if somebody tried to cancel us
|
||||
tree cancelled = gg_define_int();
|
||||
gg_assign(cancelled,
|
||||
gg_call_expr( INT,
|
||||
"__gg__is_canceled",
|
||||
gg_cast(SIZE_T,
|
||||
current_function->function_address),
|
||||
NULL_TREE));
|
||||
IF( cancelled, ne_op, integer_zero_node )
|
||||
{
|
||||
// Somebody flagged us for CANCEL, which means reinitialization, so we
|
||||
// need to find the _INITIALIZE_PROGRAM section label.
|
||||
|
||||
// gg_printf("Somebody wants to cancel %s\n",
|
||||
// gg_string_literal(current_function->our_unmangled_name),
|
||||
// NULL_TREE);
|
||||
const cbl_label_t *prog = cbl_label_of(symbol_at(current_program_index()));
|
||||
size_t initializer_index = prog->initial_section;
|
||||
cbl_label_t *initializer = cbl_label_of(symbol_at(initializer_index));
|
||||
parser_perform(initializer, true); // true means suppress nexting
|
||||
}
|
||||
ELSE
|
||||
ENDIF
|
||||
|
||||
// RETURNING variables are supposed to be in the linkage section, which
|
||||
// means that we didn't assign any storage to them during
|
||||
// parser_symbol_add(). We do that here.
|
||||
|
||||
// returning also needs to behave like local storage, even though it is
|
||||
// in linkage.
|
||||
|
||||
// This counter is used to help keep track of local variables
|
||||
gg_increment(var_decl_unique_prog_id);
|
||||
if( returning )
|
||||
{
|
||||
parser_local_add(returning);
|
||||
current_function->returning = returning;
|
||||
|
||||
size_t nbytes = 0;
|
||||
tree returning_type = tree_type_from_field_type(returning, nbytes);
|
||||
gg_modify_function_type(current_function->function_decl, returning_type);
|
||||
}
|
||||
|
||||
// Stash the returning variables for use during parser_return()
|
||||
current_function->returning = returning;
|
||||
|
||||
if( gg_trans_unit.function_stack.size() == 1 )
|
||||
{
|
||||
// We are entering a new top-level program, so we need to set
|
||||
// RETURN-CODE to zero
|
||||
gg_assign(var_decl_return_code, build_int_cst_type(SHORT, 0));
|
||||
}
|
||||
|
||||
// The parameters passed to this program might be 64 bits or 128 bits in
|
||||
// length. We establish those lengths based on the types of the target
|
||||
// for each USING.
|
||||
|
||||
for(size_t i=0; i<nusing; i++)
|
||||
{
|
||||
// This code is relevant at compile time. It takes each
|
||||
// expected formal parameter and tacks it onto the end of the
|
||||
// function's arguments chain.
|
||||
|
||||
sprintf(ach, "_p_%s", args[i].refer.field->name);
|
||||
char *ach = xasprintf("_p_%s", args[i].refer.field->name);
|
||||
|
||||
size_t nbytes = 0;
|
||||
tree par_type = tree_type_from_field_type(args[i].refer.field, nbytes);
|
||||
|
|
@ -7210,10 +7015,9 @@ parser_division(cbl_division_t division,
|
|||
par_type = INT128;
|
||||
}
|
||||
chain_parameter_to_function(current_function->function_decl, par_type, ach);
|
||||
free(ach);
|
||||
}
|
||||
|
||||
if( nusing )
|
||||
{
|
||||
// During the call, we saved the parameter_count and an array of variable
|
||||
// lengths. We need to look at those values if, and only if, one or more
|
||||
// of our USING arguments has an OPTIONAL flag or if one of our targets is
|
||||
|
|
@ -7453,6 +7257,205 @@ parser_division(cbl_division_t division,
|
|||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
parser_division(cbl_division_t division,
|
||||
cbl_field_t *returning,
|
||||
size_t nusing,
|
||||
cbl_ffi_arg_t args[] )
|
||||
{
|
||||
// This is called when the parser enters a COBOL program DIVISION. See
|
||||
// parser_divide for the arithmetic operation.
|
||||
|
||||
if( mode_syntax_only() ) return;
|
||||
|
||||
// Do this before the SHOW_PARSE; it makes a little more sense when reviewing
|
||||
// the SHOW_PARSE output.
|
||||
if( division == identification_div_e )
|
||||
{
|
||||
initialized_data = false;
|
||||
if( gg_trans_unit.function_stack.size() >= 1 )
|
||||
{
|
||||
// This is a nested program. So, we need to tie off the current
|
||||
// section:
|
||||
leave_paragraph_internal();
|
||||
leave_section_internal();
|
||||
}
|
||||
}
|
||||
|
||||
if( division == environment_div_e )
|
||||
{
|
||||
initialized_data = false;
|
||||
}
|
||||
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
SHOW_PARSE_TEXT(" ")
|
||||
switch(division)
|
||||
{
|
||||
case identification_div_e:
|
||||
SHOW_PARSE_TEXT("IDENTIFICATION")
|
||||
break;
|
||||
case environment_div_e:
|
||||
SHOW_PARSE_TEXT("ENVIRONMENT")
|
||||
break;
|
||||
case data_div_e:
|
||||
SHOW_PARSE_TEXT("DATA")
|
||||
break;
|
||||
case procedure_div_e:
|
||||
SHOW_PARSE_TEXT("PROCEDURE")
|
||||
break;
|
||||
}
|
||||
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
|
||||
if( division == data_div_e )
|
||||
{
|
||||
Analyze();
|
||||
initialize_the_data();
|
||||
}
|
||||
if( division == environment_div_e )
|
||||
{
|
||||
Analyze();
|
||||
initialize_the_data();
|
||||
}
|
||||
else if( division == procedure_div_e )
|
||||
{
|
||||
Analyze();
|
||||
initialize_the_data();
|
||||
|
||||
// Do some symbol table index bookkeeping. current_program_index() is valid
|
||||
// at this point in time:
|
||||
current_function->our_symbol_table_index = current_program_index();
|
||||
|
||||
// We have some housekeeping to do to keep track of the list of functions
|
||||
// accessible by us:
|
||||
|
||||
// For every procedure, we need a variable that points to the list of
|
||||
// available program names.
|
||||
|
||||
// We need a pointer to the array of program names
|
||||
char ach[2*sizeof(cbl_name_t)];
|
||||
sprintf(ach,
|
||||
"..accessible_program_list_" HOST_SIZE_T_PRINT_DEC,
|
||||
(fmt_size_t)current_function->our_symbol_table_index);
|
||||
tree prog_list = gg_define_variable(build_pointer_type(CHAR_P),
|
||||
ach, vs_file_static);
|
||||
|
||||
// Likewise, we need a pointer to the array of pointers to functions:
|
||||
tree function_type =
|
||||
build_varargs_function_type_array( SIZE_T,
|
||||
0, // No parameters yet
|
||||
NULL); // And, hence, no types
|
||||
tree pointer_type = build_pointer_type(function_type);
|
||||
tree constructed_array_type = build_array_type_nelts(pointer_type, 1);
|
||||
sprintf(ach,
|
||||
"..accessible_program_pointers_" HOST_SIZE_T_PRINT_DEC,
|
||||
(fmt_size_t)current_function->our_symbol_table_index);
|
||||
tree prog_pointers = gg_define_variable(
|
||||
build_pointer_type(constructed_array_type),
|
||||
ach,
|
||||
vs_file_static);
|
||||
gg_call(VOID,
|
||||
"__gg__set_program_list",
|
||||
build_int_cst_type(INT, current_function->our_symbol_table_index),
|
||||
gg_get_address_of(prog_list),
|
||||
gg_get_address_of(prog_pointers),
|
||||
NULL_TREE);
|
||||
|
||||
if( gg_trans_unit.function_stack.size() == 1 )
|
||||
{
|
||||
gg_create_goto_pair(&label_list_out_goto,
|
||||
&label_list_out_label);
|
||||
gg_create_goto_pair(&label_list_back_goto,
|
||||
&label_list_back_label);
|
||||
gg_append_statement(label_list_out_goto);
|
||||
gg_append_statement(label_list_back_label);
|
||||
}
|
||||
|
||||
tree globals_are_initialized = gg_declare_variable( INT,
|
||||
"__gg__globals_are_initialized",
|
||||
NULL,
|
||||
vs_external_reference);
|
||||
IF( globals_are_initialized, eq_op, integer_zero_node )
|
||||
{
|
||||
// one-time initialization happens here
|
||||
|
||||
// We need to establish the initial value of the UPSI-1 switch register
|
||||
// We are using IBM's conventions:
|
||||
// https://www.ibm.com/docs/en/zvse/6.2?topic=SSB27H_6.2.0/fa2sf_communicate_appl_progs_via_job_control.html
|
||||
// UPSI 10000110 means that bits 0, 5, and 6 are on, which means that
|
||||
// SW-0, SW-5, and SW-6 are on.
|
||||
gg_call(VOID,
|
||||
"__gg__onetime_initialization",
|
||||
NULL_TREE);
|
||||
|
||||
// And then flag one-time initialization as having been done.
|
||||
gg_assign(globals_are_initialized, integer_one_node);
|
||||
}
|
||||
ELSE
|
||||
ENDIF
|
||||
|
||||
gg_append_statement(current_function->skip_init_label);
|
||||
// This is where we check to see if somebody tried to cancel us
|
||||
tree cancelled = gg_define_int();
|
||||
gg_assign(cancelled,
|
||||
gg_call_expr( INT,
|
||||
"__gg__is_canceled",
|
||||
gg_cast(SIZE_T,
|
||||
current_function->function_address),
|
||||
NULL_TREE));
|
||||
IF( cancelled, ne_op, integer_zero_node )
|
||||
{
|
||||
// Somebody flagged us for CANCEL, which means reinitialization, so we
|
||||
// need to find the _INITIALIZE_PROGRAM section label.
|
||||
|
||||
// gg_printf("Somebody wants to cancel %s\n",
|
||||
// gg_string_literal(current_function->our_unmangled_name),
|
||||
// NULL_TREE);
|
||||
const cbl_label_t *prog = cbl_label_of(symbol_at(current_program_index()));
|
||||
size_t initializer_index = prog->initial_section;
|
||||
cbl_label_t *initializer = cbl_label_of(symbol_at(initializer_index));
|
||||
parser_perform(initializer, true); // true means suppress nexting
|
||||
}
|
||||
ELSE
|
||||
ENDIF
|
||||
|
||||
// RETURNING variables are supposed to be in the linkage section, which
|
||||
// means that we didn't assign any storage to them during
|
||||
// parser_symbol_add(). We do that here.
|
||||
|
||||
// returning also needs to behave like local storage, even though it is
|
||||
// in linkage.
|
||||
|
||||
// This counter is used to help keep track of local variables
|
||||
gg_increment(var_decl_unique_prog_id);
|
||||
if( returning )
|
||||
{
|
||||
parser_local_add(returning);
|
||||
current_function->returning = returning;
|
||||
|
||||
size_t nbytes = 0;
|
||||
tree returning_type = tree_type_from_field_type(returning, nbytes);
|
||||
gg_modify_function_type(current_function->function_decl, returning_type);
|
||||
}
|
||||
|
||||
// Stash the returning variables for use during parser_return()
|
||||
current_function->returning = returning;
|
||||
|
||||
if( gg_trans_unit.function_stack.size() == 1 )
|
||||
{
|
||||
// We are entering a new top-level program, so we need to set
|
||||
// RETURN-CODE to zero
|
||||
gg_assign(var_decl_return_code, build_int_cst_type(SHORT, 0));
|
||||
}
|
||||
|
||||
// The parameters passed to this program might be 64 bits or 128 bits in
|
||||
// length. We establish those lengths based on the types of the target
|
||||
// for each USING.
|
||||
|
||||
gg_call(VOID,
|
||||
"__gg__pseudo_return_bookmark",
|
||||
|
|
@ -7504,6 +7507,25 @@ parser_division(cbl_division_t division,
|
|||
// logic for backing up one line, which is needed to correctly step through
|
||||
// COBOL code with GDB-COBOL. So, we clear it here.
|
||||
current_location_minus_one_clear();
|
||||
|
||||
// It is at this point that we check to see if the call to this function
|
||||
// is a re-entry because of an ENTRY statement:
|
||||
|
||||
IF( var_decl_entry_label, ne_op, null_pointer_node )
|
||||
{
|
||||
// This is an ENTRY re-entry. The processing of USING variables was
|
||||
// done in parser_entry, so now we jump to the label
|
||||
static tree loc = gg_define_variable(VOID_P, vs_static);
|
||||
gg_assign(loc, var_decl_entry_label);
|
||||
gg_assign(var_decl_entry_label, gg_cast(VOID_P, null_pointer_node));
|
||||
gg_goto(loc);
|
||||
}
|
||||
ELSE
|
||||
{
|
||||
}
|
||||
ENDIF
|
||||
|
||||
establish_using(nusing, args);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -9683,7 +9705,10 @@ parser_file_add(struct cbl_file_t *file)
|
|||
build_int_cst_type(INT, (int)file->optional),
|
||||
build_int_cst_type(SIZE_T, varies.min),
|
||||
build_int_cst_type(SIZE_T, varies.max),
|
||||
build_int_cst_type(INT, (int)file->codeset.encoding),
|
||||
/* Right now, file->codeset.encoding is not being set properly. Remove this
|
||||
comment and fix the following code when that's repaired. */
|
||||
// build_int_cst_type(INT, (int)file->codeset.encoding),
|
||||
build_int_cst_type(INT, current_encoding(encoding_display_e)),
|
||||
build_int_cst_type(INT, (int)file->codeset.alphabet),
|
||||
NULL_TREE);
|
||||
file->var_decl_node = new_var_decl;
|
||||
|
|
@ -13274,7 +13299,9 @@ create_and_call(size_t narg,
|
|||
{
|
||||
// Because no explicit returning value is expected, we just call it. We
|
||||
// expect COBOL routines to set RETURN-CODE when they think it necessary.
|
||||
push_program_state();
|
||||
gg_append_statement(call_expr);
|
||||
pop_program_state();
|
||||
}
|
||||
|
||||
for( size_t i=0; i<narg; i++ )
|
||||
|
|
@ -13482,10 +13509,79 @@ parser_entry_activate( size_t iprog, const cbl_label_t *declarative )
|
|||
assert(iprog == symbol_elem_of(declarative)->program);
|
||||
}
|
||||
|
||||
// Define ENTRY point with alternative LINKAGE
|
||||
static tree entry_goto;
|
||||
static tree entry_label;
|
||||
static tree entry_addr;
|
||||
|
||||
void
|
||||
parser_entry( cbl_field_t */*name*/, size_t /*narg*/, cbl_ffi_arg_t */*args*/ )
|
||||
parser_entry( const cbl_field_t *name, size_t nusing, cbl_ffi_arg_t *args )
|
||||
{
|
||||
// We are implementing the ENTRY statement, which creates an alternative
|
||||
// entry point into the current program-id. There is no actual way to do
|
||||
// that literally. So, we are going to create a separate routine that sets
|
||||
// things up and then calls the current routine with the information it needs
|
||||
// to transfer processing to the ENTRY point.
|
||||
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
SHOW_PARSE_FIELD( " ENTRY ", name)
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
|
||||
// Get the name of the program that contains the ENTRY statement.
|
||||
char *name_of_parent = xstrdup(current_function->our_name);
|
||||
|
||||
// Get the name of the ENTRY point.
|
||||
// cppcheck-suppress nullPointerRedundantCheck
|
||||
char *psz = cobol_name_mangler(name->data.initial);
|
||||
|
||||
// Create a goto/label pair. The label will be set up here; the goto will
|
||||
// be used when we re-enter the containing function:
|
||||
|
||||
gg_create_goto_pair(&entry_goto,
|
||||
&entry_label,
|
||||
&entry_addr);
|
||||
|
||||
// Start creating the ENTRY function.
|
||||
tree function_decl = gg_define_function( VOID,
|
||||
psz,
|
||||
psz,
|
||||
NULL_TREE);
|
||||
free(psz);
|
||||
|
||||
// Modify the default settings for this entry point
|
||||
TREE_ADDRESSABLE(function_decl) = 0;
|
||||
TREE_USED(function_decl) = 0;
|
||||
TREE_NOTHROW(function_decl) = 0;
|
||||
TREE_STATIC(function_decl) = 1;
|
||||
DECL_EXTERNAL (function_decl) = 0;
|
||||
TREE_PUBLIC (function_decl) = 1;
|
||||
DECL_NO_INSTRUMENT_FUNCTION_ENTRY_EXIT(function_decl) = 1;
|
||||
|
||||
// When the ENTRY function point is called, we process its "using"
|
||||
// parameters:
|
||||
establish_using(nusing, args);
|
||||
|
||||
// Put the entry_label into the global variable that will be picked up
|
||||
// when the containing program-id is re-entered:
|
||||
gg_assign(var_decl_entry_label, entry_addr);
|
||||
|
||||
// Get the function address of the containing function.
|
||||
tree gfa = gg_get_function_address(VOID, name_of_parent);
|
||||
free(name_of_parent);
|
||||
|
||||
// Call the containing function
|
||||
gg_append_statement(gg_call_expr_list(VOID,
|
||||
gfa,
|
||||
0,
|
||||
NULL));
|
||||
// We are done with the ENTRY function:
|
||||
gg_finalize_function();
|
||||
|
||||
// Lay down the address of the label that matches var_decl_entry_label;
|
||||
// the containing program-id will jump to this point.
|
||||
gg_append_statement(entry_label);
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
|||
|
|
@ -558,8 +558,9 @@ void parser_call( cbl_refer_t name,
|
|||
|
||||
void parser_entry_activate( size_t iprog, const cbl_label_t *declarative );
|
||||
|
||||
void parser_entry( cbl_field_t *name,
|
||||
size_t narg = 0, cbl_ffi_arg_t args[] = NULL);
|
||||
void parser_entry( const cbl_field_t *name,
|
||||
size_t narg = 0,
|
||||
cbl_ffi_arg_t args[] = NULL);
|
||||
|
||||
bool is_ascending_key(const cbl_refer_t& key);
|
||||
|
||||
|
|
|
|||
|
|
@ -1830,7 +1830,10 @@ gg_build_logical_expression(tree operand_a,
|
|||
}
|
||||
|
||||
void
|
||||
gg_create_goto_pair(tree *goto_expr, tree *label_expr, tree *label_addr, const char *name)
|
||||
gg_create_goto_pair(tree *goto_expr,
|
||||
tree *label_expr,
|
||||
tree *label_addr,
|
||||
const char *name)
|
||||
{
|
||||
// We are going to create a pair of expressions for our
|
||||
// caller. They are a matched set of goto/label expressions,
|
||||
|
|
@ -1886,16 +1889,6 @@ gg_create_goto_pair(tree *goto_expr,
|
|||
*label_addr = gg_get_address_of(*label_decl);
|
||||
}
|
||||
|
||||
void
|
||||
gg_goto_label_decl(tree label_decl)
|
||||
{
|
||||
tree goto_expr = build1_loc( gg_token_location(),
|
||||
GOTO_EXPR,
|
||||
void_type_node,
|
||||
label_decl);
|
||||
gg_append_statement(goto_expr);
|
||||
}
|
||||
|
||||
void
|
||||
gg_create_goto_pair(tree *goto_expr, tree *label_expr)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -495,7 +495,6 @@ void gg_create_goto_pair( tree *goto_expr,
|
|||
tree *label_expr,
|
||||
tree *label_addr,
|
||||
tree *label_decl);
|
||||
void gg_goto_label_decl(tree label_decl);
|
||||
|
||||
// Used for implementing SECTIONS and PARAGRAPHS. When you have a
|
||||
// void *pointer = &&label, gg_goto is the same as
|
||||
|
|
|
|||
|
|
@ -50,8 +50,6 @@
|
|||
#include "../../libgcobol/exceptl.h"
|
||||
#include "exceptg.h"
|
||||
|
||||
bool internal_codeset_is_ebcdic() { return gcobol_feature_internal_ebcdic(); }
|
||||
|
||||
bool exception_location_active = true;
|
||||
bool skip_exception_processing = true;
|
||||
|
||||
|
|
@ -107,8 +105,13 @@ tree var_decl_treeplet_4s; // SIZE_T_P , "__gg__treeplet_4s"
|
|||
// wasn't successful figuring out how to create an actual NOP assembly language
|
||||
// instruction, I instead gg_assign(var_decl_nop, integer_zero_node)
|
||||
tree var_decl_nop; // int __gg__nop;
|
||||
|
||||
// Indicates which routine main() called
|
||||
tree var_decl_main_called; // int __gg__main_called;
|
||||
|
||||
// Indicates the target label for an ENTRY statement
|
||||
tree var_decl_entry_label; // void* __gg__entry_label
|
||||
|
||||
#if 0
|
||||
#define REFER(a)
|
||||
#else
|
||||
|
|
|
|||
|
|
@ -30,8 +30,6 @@
|
|||
#ifndef _GENUTIL_H_
|
||||
#define _GENUTIL_H_
|
||||
|
||||
bool internal_codeset_is_ebcdic();
|
||||
|
||||
extern bool exception_location_active;
|
||||
extern bool skip_exception_processing;
|
||||
|
||||
|
|
@ -79,9 +77,9 @@ extern tree var_decl_treeplet_3s; // SIZE_T_P , "__gg__treeplet_3
|
|||
extern tree var_decl_treeplet_4f; // cblc_field_pp_type_node , "__gg__treeplet_4f"
|
||||
extern tree var_decl_treeplet_4o; // SIZE_T_P , "__gg__treeplet_4o"
|
||||
extern tree var_decl_treeplet_4s; // SIZE_T_P , "__gg__treeplet_4s"
|
||||
|
||||
extern tree var_decl_nop; // int __gg__nop
|
||||
extern tree var_decl_main_called; // int __gg__main_called
|
||||
extern tree var_decl_entry_label; // void* __gg__entry_label
|
||||
|
||||
int get_scaled_rdigits(cbl_field_t *field);
|
||||
int get_scaled_digits(cbl_field_t *field);
|
||||
|
|
|
|||
|
|
@ -1643,7 +1643,7 @@ symbols_alphabet_set( size_t program, const char name[]) {
|
|||
};
|
||||
|
||||
// Define alphabets for codegen.
|
||||
std::for_each(symbols_begin(), symbols_end(), alpha() );
|
||||
std::for_each(symbols_begin(program), symbols_end(), alpha() );
|
||||
|
||||
// Set collation sequence before parser_symbol_add.
|
||||
if( name ) {
|
||||
|
|
|
|||
|
|
@ -503,6 +503,13 @@ const char * __gg__encoding_iconv_name( cbl_encoding_t encoding );
|
|||
|
||||
bool is_elementary( enum cbl_field_type_t type );
|
||||
|
||||
// These were introduced to discourage the use of
|
||||
// current_encoding('A') and current_encoding('N')
|
||||
enum
|
||||
{
|
||||
encoding_display_e = 'A',
|
||||
encoding_national_e = 'N'
|
||||
};
|
||||
cbl_encoding_t current_encoding( char a_or_n );
|
||||
|
||||
/* In cbl_field_t:
|
||||
|
|
|
|||
|
|
@ -94,13 +94,6 @@ char *__gg__ct_currency_signs[256]; // Compile-time currency signs
|
|||
// And we will take some pains to figure out if the source code file was done
|
||||
// as UTF-8; if not, we will assume 1252/8859-1
|
||||
|
||||
// __gg__ebcdic_codeset_in_use is the ultimate determinator of whether the
|
||||
// internal codeset is ASCII/CP1252 or EBCDIC/CP1140.
|
||||
bool __gg__ebcdic_codeset_in_use = false ;
|
||||
|
||||
static text_codeset_t source_codeset = cs_cp1252_e;
|
||||
static text_codeset_t console_codeset = cs_default_e;
|
||||
|
||||
#define UNICODE_REPLACEMENT 0xFFFD // This a white question mark in a black diamond
|
||||
#define ASCII_REPLACEMENT 0x87 // In CP1252, 0x87 is a double-dagger
|
||||
|
||||
|
|
@ -235,74 +228,6 @@ __gg__ebcdic_to_cp1252_collation[256] =
|
|||
0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0xB3, 0xDB, 0xDC, 0xD9, 0xDA, 0xFF,
|
||||
};
|
||||
|
||||
|
||||
// Here is the list of function pointers establish which ones of the paired
|
||||
// possibilities of conversion routines are actually in use.
|
||||
|
||||
extern "C"
|
||||
void __gg__set_internal_codeset(int use_ebcdic)
|
||||
{
|
||||
__gg__ebcdic_codeset_in_use = !!use_ebcdic;
|
||||
}
|
||||
|
||||
extern "C"
|
||||
void __gg__text_conversion_override(text_device_t device,
|
||||
text_codeset_t codeset)
|
||||
{
|
||||
// Establish the default sourcecode and console codesets, and
|
||||
// establish the codeset conversion routines:
|
||||
|
||||
switch(device)
|
||||
{
|
||||
case td_default_e:
|
||||
{
|
||||
// We are setting our codesets to the defaults
|
||||
|
||||
// First, sort out the console:
|
||||
|
||||
// It is my understanding that the environment variable LANG is
|
||||
// supposed to be set by the terminal to indicate the terminal's
|
||||
// current character set. Let's use that as the winner, even if
|
||||
// that's not quite the way locale(3) works.
|
||||
const char *envLANG = getenv("LANG");
|
||||
if( !envLANG )
|
||||
{
|
||||
// This is odd. No "LANG"?
|
||||
envLANG = setlocale(LC_CTYPE, NULL);
|
||||
}
|
||||
if( !envLANG )
|
||||
{
|
||||
// This is even more odd. Pick something as a backup to the backup
|
||||
envLANG = "UTF-8";
|
||||
}
|
||||
if( envLANG )
|
||||
{
|
||||
if( strcasestr(envLANG, "UTF-8") )
|
||||
{
|
||||
console_codeset = cs_utf8_e;
|
||||
}
|
||||
else
|
||||
{
|
||||
// If it isn't UTF-8, then figure on it being CP1252 as a
|
||||
// convenient way of specifying an SBC codeset.
|
||||
console_codeset = cs_cp1252_e;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case td_sourcecode_e:
|
||||
// Explicitly set the source code codeset:
|
||||
source_codeset = codeset;
|
||||
break;
|
||||
|
||||
case td_console_e:
|
||||
// Explicitly set the console codeset:
|
||||
console_codeset = codeset;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
static encodings_t encodings[] = {
|
||||
{ iconv_437_e, "437" },
|
||||
{ iconv_500_e, "500" },
|
||||
|
|
|
|||
|
|
@ -112,8 +112,6 @@ extern char **__gg__currency_signs ;
|
|||
extern int __gg__default_currency_sign;
|
||||
extern char *__gg__ct_currency_signs[256]; // Compile-time currency signs
|
||||
|
||||
extern bool __gg__ebcdic_codeset_in_use;
|
||||
|
||||
#define NULLCH ('\0')
|
||||
#define DEGENERATE_HIGH_VALUE 0xFF
|
||||
#define DEGENERATE_LOW_VALUE 0x00
|
||||
|
|
@ -202,21 +200,6 @@ extern bool __gg__ebcdic_codeset_in_use;
|
|||
#define ascii_newline ((uint8_t)('\n'))
|
||||
#define ascii_return ((uint8_t)('\r'))
|
||||
|
||||
enum text_device_t
|
||||
{
|
||||
td_default_e,
|
||||
td_sourcecode_e,
|
||||
td_console_e,
|
||||
};
|
||||
|
||||
enum text_codeset_t
|
||||
{
|
||||
cs_default_e,
|
||||
cs_utf8_e,
|
||||
cs_cp1252_e,
|
||||
cs_cp1140_e
|
||||
};
|
||||
|
||||
extern unsigned char __gg__data_space[1] ;
|
||||
extern unsigned char __gg__data_low_values[1] ;
|
||||
extern unsigned char __gg__data_zeros[1] ;
|
||||
|
|
@ -234,19 +217,6 @@ extern const unsigned short __gg__cp1140_to_cp1252_values[256];
|
|||
extern const unsigned short __gg__cp1252_to_ebcdic_collation[256];
|
||||
extern const unsigned short __gg__ebcdic_to_cp1252_collation[256];
|
||||
|
||||
// As described above, we have a number of operations we need to accomplish. But
|
||||
// the actual routines are dependent on whether EBCDIC or ASCII is in use. We
|
||||
// implement that by having a function pointer for each function; those pointers
|
||||
// are established when the __gg__ebcdic_codeset_in_use variable is established.
|
||||
|
||||
// These routines convert a single ASCII character to either ASCII or EBCDIC
|
||||
|
||||
extern "C" void __gg__set_internal_codeset(int use_ebcdic);
|
||||
|
||||
extern "C"
|
||||
void __gg__text_conversion_override(text_device_t device,
|
||||
text_codeset_t codeset);
|
||||
|
||||
const char * __gg__encoding_iconv_name( cbl_encoding_t encoding );
|
||||
cbl_encoding_t __gg__encoding_iconv_type( const char *name );
|
||||
|
||||
|
|
|
|||
|
|
@ -330,12 +330,6 @@ __gg__file_init(
|
|||
{
|
||||
if( !(file->flags & file_flag_initialized_e) )
|
||||
{
|
||||
if( encoding != iconv_CP1140_e && __gg__ebcdic_codeset_in_use )
|
||||
{
|
||||
// This code is to be eliminated when 'encoding' is valid.
|
||||
encoding = iconv_CP1140_e;
|
||||
}
|
||||
|
||||
charmap_t *charmap = __gg__get_charmap(encoding);
|
||||
|
||||
file->name = strdup(name);
|
||||
|
|
|
|||
|
|
@ -139,6 +139,7 @@ int __gg__default_compute_error = 0 ;
|
|||
int __gg__rdigits = 0 ;
|
||||
int __gg__nop = 0 ;
|
||||
int __gg__main_called = 0 ;
|
||||
void *__gg__entry_label = NULL ;
|
||||
cbl_encoding_t __gg__console_encoding = no_encoding_e ;
|
||||
|
||||
// During SORT operations, we don't want the end-of-file condition, which
|
||||
|
|
@ -484,16 +485,7 @@ struct program_state
|
|||
|
||||
memset(rt_currency_signs, 0, sizeof(rt_currency_signs));
|
||||
|
||||
// The default collating sequence:
|
||||
if( __gg__ebcdic_codeset_in_use )
|
||||
{
|
||||
rt_collation = __gg__cp1140_to_cp1252_values;
|
||||
}
|
||||
else
|
||||
{
|
||||
rt_collation = __gg__one_to_one_values;
|
||||
}
|
||||
// rt_collation = __gg__one_to_one_values;
|
||||
rt_program_name = NULL;
|
||||
}
|
||||
|
||||
|
|
@ -694,21 +686,13 @@ void
|
|||
__gg__pop_program_state()
|
||||
{
|
||||
program_states.pop_back();
|
||||
|
||||
// #define decimal_point (program_states.back().rt_decimal_point)
|
||||
// #define decimal_separator (program_states.back().rt_decimal_separator)
|
||||
// #define quote_character (program_states.back().rt_quote_character)
|
||||
// #define low_value_character (program_states.back().rt_low_value_character)
|
||||
// #define high_value_character (program_states.back().rt_high_value_character)
|
||||
|
||||
__gg__decimal_point = program_states.back().rt_decimal_point ;
|
||||
__gg__decimal_separator = program_states.back().rt_decimal_separator ;
|
||||
__gg__quote_character = program_states.back().rt_quote_character ;
|
||||
__gg__low_value_character = program_states.back().rt_low_value_character ;
|
||||
__gg__high_value_character = program_states.back().rt_high_value_character ;
|
||||
__gg__currency_signs = program_states.back().rt_currency_signs ;
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
static
|
||||
int
|
||||
|
|
@ -10733,7 +10717,8 @@ __gg__set_pointer(cblc_field_t *target,
|
|||
|
||||
extern "C"
|
||||
void
|
||||
__gg__alphabet_use( cbl_encoding_t encoding,
|
||||
__gg__alphabet_use( cbl_encoding_t alphabetic_encoding,
|
||||
cbl_encoding_t encoding,
|
||||
size_t alphabet_index)
|
||||
{
|
||||
// We simply replace the values in the current program_state. If the
|
||||
|
|
@ -10743,26 +10728,35 @@ __gg__alphabet_use( cbl_encoding_t encoding,
|
|||
if( program_states.empty() )
|
||||
{
|
||||
// When there is no DATA DIVISION, program_states can be empty when
|
||||
// we arrive here. So, we need to remedy that:
|
||||
// we arrive here. So, we need to remedy that.
|
||||
initialize_program_state();
|
||||
}
|
||||
|
||||
const charmap_t *charmap_alphabetic = __gg__get_charmap(alphabetic_encoding);
|
||||
|
||||
switch( encoding )
|
||||
{
|
||||
case ASCII_e:
|
||||
case iso646_e:
|
||||
// This is one of the very common standard situations; where we are using
|
||||
// something like a CP1252 Western European ASCII-like character set.
|
||||
|
||||
__gg__low_value_character = DEGENERATE_LOW_VALUE;
|
||||
__gg__high_value_character = DEGENERATE_HIGH_VALUE;
|
||||
|
||||
program_states.back().rt_low_value_character = DEGENERATE_LOW_VALUE;
|
||||
program_states.back().rt_high_value_character = DEGENERATE_HIGH_VALUE;
|
||||
|
||||
if( !__gg__ebcdic_codeset_in_use )
|
||||
if( !charmap_alphabetic->is_like_ebcdic() )
|
||||
{
|
||||
// The codeset is ascii-like, and the collation is ascii, so we use
|
||||
// one-to-one values:
|
||||
program_states.back().rt_collation = __gg__one_to_one_values;
|
||||
}
|
||||
else
|
||||
{
|
||||
// The codeset is ebcdic-like, but the collation is specified as
|
||||
// ascii-like. So, we need that collation:
|
||||
program_states.back().rt_collation = __gg__ebcdic_to_cp1252_collation;
|
||||
}
|
||||
|
||||
|
|
@ -10774,12 +10768,16 @@ __gg__alphabet_use( cbl_encoding_t encoding,
|
|||
|
||||
program_states.back().rt_low_value_character = DEGENERATE_LOW_VALUE;
|
||||
program_states.back().rt_high_value_character = DEGENERATE_HIGH_VALUE;
|
||||
if( __gg__ebcdic_codeset_in_use )
|
||||
if( charmap_alphabetic->is_like_ebcdic() )
|
||||
{
|
||||
// The alphanumeric codeset is ebcdic-like, and so is the specified
|
||||
// collation:
|
||||
program_states.back().rt_collation = __gg__one_to_one_values;
|
||||
}
|
||||
else
|
||||
{
|
||||
// The alphanumeric codeset is ebcdic-like, but the specified collation
|
||||
// is ascii-like:
|
||||
program_states.back().rt_collation = __gg__cp1252_to_ebcdic_collation;
|
||||
}
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -79,6 +79,9 @@ __gg__alphabet_create( cbl_encoding_t encoding,
|
|||
|
||||
if( it == __gg__alphabet_states.end() )
|
||||
{
|
||||
// This is an alphabet we don't know about. So just assume the collation
|
||||
// is the same as the character ordering:
|
||||
|
||||
alphabet_state new_state;
|
||||
new_state.low_char = low_char;
|
||||
new_state.high_char = high_char;
|
||||
|
|
|
|||
Loading…
Reference in New Issue