move_tree( cbl_field_t *dest,
tree offset,
tree psz_source, // psz_source is a null-terminated string
- tree length_bump=integer_zero_node)
+ tree length_bump=integer_zero_node)
{
// This routine assumes that the psz_source is in the same codeset as the
// dest.
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" );
}
}
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);
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
}
gg_get_address_of(table256),
build_int_cst_type(INT, alphabet.low_index),
build_int_cst_type(INT, alphabet.high_index),
+
NULL_TREE );
break;
}
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
}
__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);
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);
// 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;
}
}
+static
+void
+establish_using(size_t nusing,
+ cbl_ffi_arg_t args[] )
+ {
+ if( nusing )
+ {
+ 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.
+
+ 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);
+ if( par_type == FLOAT )
+ {
+ par_type = SSIZE_T;
+ }
+ if( par_type == DOUBLE )
+ {
+ par_type = SSIZE_T;
+ }
+ if( par_type == FLOAT128 )
+ {
+ par_type = INT128;
+ }
+ chain_parameter_to_function(current_function->function_decl, par_type, ach);
+ free(ach);
+ }
+
+ // 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
+ // marked as VARYING.
+ bool check_for_parameter_count = false;
+ for(size_t i=0; i<nusing; i++)
+ {
+ if( args[i].optional )
+ {
+ check_for_parameter_count = true;
+ break;
+ }
+ if( args[i].refer.field->attr & any_length_e )
+ {
+ check_for_parameter_count = true;
+ break;
+ }
+ }
+
+ if( check_for_parameter_count )
+ {
+ IF( var_decl_call_parameter_signature,
+ eq_op,
+ gg_cast(CHAR_P, current_function->function_address) )
+ {
+ // We know to use var_decl_call_parameter_count, so unflag this
+ // pointer to avoid problems in the ridiculous possibility of
+ // COBOL-A calls C_B calls COBOL_A
+ gg_assign(var_decl_call_parameter_signature,
+ gg_cast(CHAR_P, null_pointer_node));
+ }
+ ELSE
+ {
+ // We were apparently called by a C routine, not a COBOL routine, so
+ // make sure we don't get shortchanged by a count left behind from an
+ // earlier COBOL call.
+ gg_assign(var_decl_call_parameter_count,
+ build_int_cst_type(INT, A_ZILLION));
+ }
+ ENDIF
+ }
+ else
+ {
+ // None of our parameters require a count, so make sure we don't get
+ // bamboozled by a count left behind from an earlier COBOL call.
+ gg_assign(var_decl_call_parameter_count,
+ build_int_cst_type(INT, A_ZILLION));
+ }
+
+ // There are 'nusing' elements in the PROCEDURE DIVISION USING list.
+
+ tree parameter = NULL_TREE;
+ tree rt_i = gg_define_int();
+ for(size_t i=0; i<nusing; i++)
+ {
+ // And this compiler code generates run-time execution code. The
+ // generated code picks up, at run time, the variable we just
+ // established in the chain at compile time.
+
+ // It makes more sense if you don't think about it too hard.
+
+ // We need to be able to restore prior arguments when doing recursive
+ // calls:
+ IF( member(args[i].refer.field->var_decl_node, "data"),
+ ne_op,
+ gg_cast(UCHAR_P, null_pointer_node) )
+ {
+ gg_call(VOID,
+ "__gg__push_local_variable",
+ gg_get_address_of(args[i].refer.field->var_decl_node),
+ NULL_TREE);
+ }
+ ELSE
+ ENDIF
+
+ tree base = gg_define_variable(UCHAR_P);
+ gg_assign(rt_i, build_int_cst_type(INT, i));
+ //gg_printf("The rt_i counter is %d\n", rt_i, NULL_TREE);
+ IF( rt_i, lt_op , var_decl_call_parameter_count )
+ {
+ if( i == 0 )
+ {
+ // This is the first parameter.
+ parameter = DECL_ARGUMENTS(current_function->function_decl);
+ }
+ else
+ {
+ // These are subsequent parameters
+ parameter = TREE_CHAIN(parameter);
+ }
+ gg_assign(base, gg_cast(UCHAR_P, parameter));
+
+ if( args[i].refer.field->attr & any_length_e )
+ {
+ // gg_printf("side channel: Length of \"%s\" is %ld\n",
+ // member(args[i].refer.field->var_decl_node, "name"),
+ // gg_array_value(var_decl_call_parameter_lengths, rt_i),
+ // NULL_TREE);
+
+ // Get the length from the global lengths[] side channel. Don't
+ // forget to use the length mask on the table value.
+ gg_assign(member(args[i].refer.field->var_decl_node, "capacity"),
+ gg_array_value(var_decl_call_parameter_lengths, rt_i));
+ }
+ }
+ ELSE
+ {
+ gg_assign(base, gg_cast(UCHAR_P, null_pointer_node));
+ }
+ ENDIF
+
+ // Arriving here means that we are processing an instruction like
+ // this:
+ // PROCEDURE DIVISION USING using[0] using[1] ... using using[nusing-1]
+
+ // When __gg__call_parameter_count is equal to A_ZILLION, then this is
+ // an OTHER-TO-COBOL call and the var_decl_call_parameter_lengths array
+ // is not valid
+
+ cbl_ffi_crv_t crv = args[i].crv;
+ cbl_field_t *new_var = args[i].refer.field;
+
+ if( crv == by_value_e )
+ {
+ switch(new_var->type)
+ {
+ case FldGroup:
+ case FldAlphanumeric:
+ case FldAlphaEdited:
+ case FldNumericEdited:
+ crv = by_reference_e;
+ break;
+ default:
+ break;
+ }
+ }
+
+ if( crv == by_value_e )
+ {
+ // 'parameter' is the 64-bit or 128-bit value that was placed on the stack
+
+ size_t nbytes;
+ tree_type_from_field_type(new_var, nbytes);
+ tree parm = gg_define_variable(INT128);
+
+ if( nbytes <= 8 )
+ {
+ // Our input is a 64-bit number
+ if( new_var->attr & signable_e )
+ {
+ IF( gg_bitwise_and( gg_cast(SIZE_T, base),
+ build_int_cst_type(SIZE_T, 0x8000000000000000ULL)),
+ ne_op,
+ gg_cast(SIZE_T, integer_zero_node) )
+ {
+ // Our input is a negative number
+ gg_assign(parm, gg_cast(INT128, integer_minus_one_node));
+ }
+ ELSE
+ {
+ // Our input is a positive number
+ gg_assign(parm, gg_cast(INT128, integer_zero_node));
+ }
+ ENDIF
+ }
+ else
+ {
+ // This is a 64-bit positive number:
+ gg_assign(parm, gg_cast(INT128, integer_zero_node));
+ }
+ }
+ // At this point, parm has been set to 0 or -1
+
+ gg_memcpy(gg_get_address_of(parm),
+ gg_get_address_of(base),
+ build_int_cst_type(SIZE_T, nbytes));
+
+ tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity);
+ tree data_decl_node = gg_define_variable( array_type,
+ NULL,
+ vs_static);
+ gg_assign( member(new_var->var_decl_node, "data"),
+ gg_get_address_of(data_decl_node) );
+
+ // And then move it into place
+ gg_call(VOID,
+ "__gg__assign_value_from_stack",
+ gg_get_address_of(new_var->var_decl_node),
+ parm,
+ NULL_TREE);
+ // We now have to handle an oddball situation. It's possible we are
+ // dealing with
+ //
+ // linkage section.
+ // 01 var1
+ // 01 var2 redefines var1
+ //
+ // If so, we have to give var2::data_pointer the same value as
+ // var1::data_pointer
+ //
+ size_t our_index = symbol_index(symbol_elem_of(new_var));
+ size_t next_index = our_index + 1;
+ // Look ahead in the symbol table for the next LEVEL01/77
+ for(;;)
+ {
+ symbol_elem_t *e = symbol_at(next_index);
+ if( e->type != SymField )
+ {
+ break;
+ }
+ cbl_field_t *next_var = cbl_field_of(e);
+ if( !next_var )
+ {
+ break;
+ }
+ if( next_var->level == LEVEL01 || next_var->level == LEVEL77 )
+ {
+ if( next_var->parent == our_index )
+ {
+ gg_assign(member(next_var->var_decl_node, "data"),
+ member(new_var->var_decl_node, "data"));
+ }
+ break;
+ }
+ next_index += 1;
+ }
+ }
+ else
+ {
+ // 'parameter' is a reference, so it it becomes the data member of
+ // the cblc_field_t COBOL variable.
+ gg_assign(member(args[i].field()->var_decl_node, "data"), base);
+
+ // We need to apply base + offset to the LINKAGE variable
+ // and all of its children
+ propogate_linkage_offsets( args[i].field(), base );
+ }
+ }
+ }
+ }
+
void
parser_division(cbl_division_t division,
cbl_field_t *returning,
// 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);
-
- size_t nbytes = 0;
- tree par_type = tree_type_from_field_type(args[i].refer.field, nbytes);
- if( par_type == FLOAT )
- {
- par_type = SSIZE_T;
- }
- if( par_type == DOUBLE )
- {
- par_type = SSIZE_T;
- }
- if( par_type == FLOAT128 )
- {
- par_type = INT128;
- }
- chain_parameter_to_function(current_function->function_decl, par_type, 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
- // marked as VARYING.
- bool check_for_parameter_count = false;
- for(size_t i=0; i<nusing; i++)
- {
- if( args[i].optional )
- {
- check_for_parameter_count = true;
- break;
- }
- if( args[i].refer.field->attr & any_length_e )
- {
- check_for_parameter_count = true;
- break;
- }
- }
-
- if( check_for_parameter_count )
- {
- IF( var_decl_call_parameter_signature,
- eq_op,
- gg_cast(CHAR_P, current_function->function_address) )
- {
- // We know to use var_decl_call_parameter_count, so unflag this
- // pointer to avoid problems in the ridiculous possibility of
- // COBOL-A calls C_B calls COBOL_A
- gg_assign(var_decl_call_parameter_signature,
- gg_cast(CHAR_P, null_pointer_node));
- }
- ELSE
- {
- // We were apparently called by a C routine, not a COBOL routine, so
- // make sure we don't get shortchanged by a count left behind from an
- // earlier COBOL call.
- gg_assign(var_decl_call_parameter_count,
- build_int_cst_type(INT, A_ZILLION));
- }
- ENDIF
- }
- else
- {
- // None of our parameters require a count, so make sure we don't get
- // bamboozled by a count left behind from an earlier COBOL call.
- gg_assign(var_decl_call_parameter_count,
- build_int_cst_type(INT, A_ZILLION));
- }
-
- // There are 'nusing' elements in the PROCEDURE DIVISION USING list.
-
- tree parameter = NULL_TREE;
- tree rt_i = gg_define_int();
- for(size_t i=0; i<nusing; i++)
- {
- // And this compiler code generates run-time execution code. The
- // generated code picks up, at run time, the variable we just
- // established in the chain at compile time.
-
- // It makes more sense if you don't think about it too hard.
-
- // We need to be able to restore prior arguments when doing recursive
- // calls:
- IF( member(args[i].refer.field->var_decl_node, "data"),
- ne_op,
- gg_cast(UCHAR_P, null_pointer_node) )
- {
- gg_call(VOID,
- "__gg__push_local_variable",
- gg_get_address_of(args[i].refer.field->var_decl_node),
- NULL_TREE);
- }
- ELSE
- ENDIF
-
- tree base = gg_define_variable(UCHAR_P);
- gg_assign(rt_i, build_int_cst_type(INT, i));
- //gg_printf("The rt_i counter is %d\n", rt_i, NULL_TREE);
- IF( rt_i, lt_op , var_decl_call_parameter_count )
- {
- if( i == 0 )
- {
- // This is the first parameter.
- parameter = DECL_ARGUMENTS(current_function->function_decl);
- }
- else
- {
- // These are subsequent parameters
- parameter = TREE_CHAIN(parameter);
- }
- gg_assign(base, gg_cast(UCHAR_P, parameter));
-
- if( args[i].refer.field->attr & any_length_e )
- {
- // gg_printf("side channel: Length of \"%s\" is %ld\n",
- // member(args[i].refer.field->var_decl_node, "name"),
- // gg_array_value(var_decl_call_parameter_lengths, rt_i),
- // NULL_TREE);
-
- // Get the length from the global lengths[] side channel. Don't
- // forget to use the length mask on the table value.
- gg_assign(member(args[i].refer.field->var_decl_node, "capacity"),
- gg_array_value(var_decl_call_parameter_lengths, rt_i));
- }
- }
- ELSE
- {
- gg_assign(base, gg_cast(UCHAR_P, null_pointer_node));
- }
- ENDIF
-
- // Arriving here means that we are processing an instruction like
- // this:
- // PROCEDURE DIVISION USING using[0] using[1] ... using using[nusing-1]
-
- // When __gg__call_parameter_count is equal to A_ZILLION, then this is
- // an OTHER-TO-COBOL call and the var_decl_call_parameter_lengths array
- // is not valid
-
- cbl_ffi_crv_t crv = args[i].crv;
- cbl_field_t *new_var = args[i].refer.field;
-
- if( crv == by_value_e )
- {
- switch(new_var->type)
- {
- case FldGroup:
- case FldAlphanumeric:
- case FldAlphaEdited:
- case FldNumericEdited:
- crv = by_reference_e;
- break;
- default:
- break;
- }
- }
-
- if( crv == by_value_e )
- {
- // 'parameter' is the 64-bit or 128-bit value that was placed on the stack
-
- size_t nbytes;
- tree_type_from_field_type(new_var, nbytes);
- tree parm = gg_define_variable(INT128);
-
- if( nbytes <= 8 )
- {
- // Our input is a 64-bit number
- if( new_var->attr & signable_e )
- {
- IF( gg_bitwise_and( gg_cast(SIZE_T, base),
- build_int_cst_type(SIZE_T, 0x8000000000000000ULL)),
- ne_op,
- gg_cast(SIZE_T, integer_zero_node) )
- {
- // Our input is a negative number
- gg_assign(parm, gg_cast(INT128, integer_minus_one_node));
- }
- ELSE
- {
- // Our input is a positive number
- gg_assign(parm, gg_cast(INT128, integer_zero_node));
- }
- ENDIF
- }
- else
- {
- // This is a 64-bit positive number:
- gg_assign(parm, gg_cast(INT128, integer_zero_node));
- }
- }
- // At this point, parm has been set to 0 or -1
-
- gg_memcpy(gg_get_address_of(parm),
- gg_get_address_of(base),
- build_int_cst_type(SIZE_T, nbytes));
-
- tree array_type = build_array_type_nelts(UCHAR, new_var->data.capacity);
- tree data_decl_node = gg_define_variable( array_type,
- NULL,
- vs_static);
- gg_assign( member(new_var->var_decl_node, "data"),
- gg_get_address_of(data_decl_node) );
-
- // And then move it into place
- gg_call(VOID,
- "__gg__assign_value_from_stack",
- gg_get_address_of(new_var->var_decl_node),
- parm,
- NULL_TREE);
- // We now have to handle an oddball situation. It's possible we are
- // dealing with
- //
- // linkage section.
- // 01 var1
- // 01 var2 redefines var1
- //
- // If so, we have to give var2::data_pointer the same value as
- // var1::data_pointer
- //
- size_t our_index = symbol_index(symbol_elem_of(new_var));
- size_t next_index = our_index + 1;
- // Look ahead in the symbol table for the next LEVEL01/77
- for(;;)
- {
- symbol_elem_t *e = symbol_at(next_index);
- if( e->type != SymField )
- {
- break;
- }
- cbl_field_t *next_var = cbl_field_of(e);
- if( !next_var )
- {
- break;
- }
- if( next_var->level == LEVEL01 || next_var->level == LEVEL77 )
- {
- if( next_var->parent == our_index )
- {
- gg_assign(member(next_var->var_decl_node, "data"),
- member(new_var->var_decl_node, "data"));
- }
- break;
- }
- next_index += 1;
- }
- }
- else
- {
- // 'parameter' is a reference, so it it becomes the data member of
- // the cblc_field_t COBOL variable.
- gg_assign(member(args[i].field()->var_decl_node, "data"), base);
-
- // We need to apply base + offset to the LINKAGE variable
- // and all of its children
- propogate_linkage_offsets( args[i].field(), base );
- }
- }
- }
-
gg_call(VOID,
"__gg__pseudo_return_bookmark",
NULL_TREE);
// 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);
}
}
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;
gg_call( CHAR_P,
"__gg__convert_encoding",
psz,
- build_int_cst_type(INT,
+ build_int_cst_type(INT,
field_of_name->codeset.encoding),
build_int_cst_type(INT,
DEFAULT_CHARMAP_SOURCE),
{
// 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++ )
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
// __gg__string_to_alpha_edited expects the source string to be in
// the same encoding as the target:
size_t len = strlen(sourceref.field->data.initial);
- char *src =
+ char *src =
static_cast<char *>(xmalloc(len+1));
memcpy( src,
sourceref.field->data.initial,
projects / thirdparty / gcc.git / commitdiff
