Skip to content

Commit

Permalink
Merge SVN 4686
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddeclerck
ddeclerck committed Jun 24, 2024
1 parent 0ddd8a4 commit d326219
Show file tree
Hide file tree
Showing 32 changed files with 1,416 additions and 395 deletions.
67 changes: 37 additions & 30 deletions cobc/cobc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5425,7 +5425,8 @@ print_fields (struct cb_field *top, int *found)
const char *name_or_filler;

for (; top; top = top->sister) {
if (!top->level) {
if (top->level == 0
|| (top->flag_internal_register && !top->count)) {
continue;
}
if (*found == 0) {
Expand Down Expand Up @@ -5556,6 +5557,35 @@ print_fields_in_section (struct cb_field *first_field_in_section)
return found;
}

/* add a "receiving" entry for a given field reference
and increment used counter */
void
cobc_xref_set_receiving (const cb_tree target_ext)
{
cb_tree target = target_ext;
struct cb_field *target_fld;
int xref_line;

if (CB_CAST_P (target)) {
target = CB_CAST (target)->val;
}
if (!CB_REF_OR_FIELD_P (target)) {
return;
}
target_fld = CB_FIELD_PTR (target);
target_fld->count++;
#ifdef COB_INTERNAL_XREF
if (CB_REFERENCE_P (target)) {
xref_line = CB_REFERENCE (target)->common.source_line;
} else if (current_statement) {
xref_line = current_statement->common.source_line;
} else {
xref_line = cb_source_line;
}
cobc_xref_link (&target_fld->xref, xref_line, 1);
#endif
}

#ifdef COB_INTERNAL_XREF
/* create xref_elem with line number for existing xref entry */
void
Expand Down Expand Up @@ -5632,32 +5662,6 @@ cobc_xref_link_parent (const struct cb_field *field)
}
}

/* add a "receiving" entry for a given field reference */
void
cobc_xref_set_receiving (const cb_tree target_ext)
{
cb_tree target = target_ext;
struct cb_field *target_fld;
int xref_line;

if (CB_CAST_P (target)) {
target = CB_CAST (target)->val;
}
if (CB_REF_OR_FIELD_P (target)) {
target_fld = CB_FIELD_PTR (target);
} else {
return;
}
if (CB_REFERENCE_P (target)) {
xref_line = CB_REFERENCE (target)->common.source_line;
} else if (current_statement) {
xref_line = current_statement->common.source_line;
} else {
xref_line = cb_source_line;
}
cobc_xref_link (&target_fld->xref, xref_line, 1);
}

void
cobc_xref_call (const char *name, const int line, const int is_ident, const int is_sys)
{
Expand Down Expand Up @@ -5756,8 +5760,9 @@ xref_fields (struct cb_field *top)
for (; top; top = top->sister) {
/* no entry for internal generated fields
other than used special indexes */
if (!top->level || (top->index_type != CB_NORMAL_INDEX
&& !top->count)) {
if (top->level == 0
|| (top->flag_internal_register && !top->count)
|| (top->index_type != CB_NORMAL_INDEX && !top->count)) {
continue;
}
#if 0 /* FIXME: at least in the context of RW flag_filler is not set correct in
Expand Down Expand Up @@ -5819,7 +5824,9 @@ xref_fields_in_section (struct cb_field *first_field_in_section)

if (first_field_in_section != NULL) {
found = !!xref_fields (first_field_in_section);
print_program_data ("");
if (found) {
print_program_data ("");
}
}
return found;
}
Expand Down
5 changes: 2 additions & 3 deletions cobc/cobc.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,8 @@ enum cb_current_date {
#define CB_CS_CONVERT CB_CS_DAY
#define CB_CS_MODULE_NAME CB_CS_DAY
#define CB_CS_DEFAULT CB_CS_DAY
#define CB_CS_VALIDATE_STATUS CB_CS_DAY
#define CB_CS_VALIDATE_STATUS CB_CS_DAY
#define CB_CS_SPECIAL_NAMES CB_CS_DAY

/* Support for cobc from stdin */
#define COB_DASH "-"
Expand Down Expand Up @@ -512,8 +513,6 @@ extern int cb_exp_line;
extern int functions_are_all;
extern struct cb_tree_common *defined_prog_list;
extern int current_call_convention;
extern struct cb_field *external_defined_fields_ws;
extern struct cb_field *external_defined_fields_global;

/* Functions */

Expand Down
102 changes: 78 additions & 24 deletions cobc/codegen.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -291,13 +291,18 @@ static void codegen_init (struct cb_program *, const char *);
static void codegen_internal (struct cb_program *, const int);
static void codegen_finalize (void);

static void output_perform_once (struct cb_perform *);

/* Local functions */

static void
count_all_fields (struct cb_field *p)
{
struct cb_field *f, *f01;
cb_tree l;
if (p->flag_internal_register) {
return;
}
if (p->storage == CB_STORAGE_REPORT) {
f01 = real_field_founder (p);
if (!f01->flag_base) {
Expand Down Expand Up @@ -2302,6 +2307,7 @@ static void
emit_symtab (struct cb_field *f)
{
if (!f->flag_sym_emitted
&& !f->flag_internal_register
&& f->level >= 1
&& f->level != 66
&& f->level != 78
Expand Down Expand Up @@ -4200,15 +4206,41 @@ output_ml_trees_definitions (struct cb_ml_generate_tree *tree)

/* Parameter */

static COB_INLINE COB_A_INLINE void
create_field (struct cb_field *f, cb_tree x)
{
if (!f->flag_field) {
struct field_list* fl;
FILE* savetarget = output_target;
output_target = NULL;
output_field (x);

fl = cobc_parse_malloc (sizeof (struct field_list));
fl->x = x;
fl->f = f;
fl->curr_prog = excp_current_program_id;
if (f->index_type != CB_INT_INDEX
&& (f->flag_is_global
|| current_prog->flag_file_global)) {
fl->next = field_cache;
field_cache = fl;
} else {
fl->next = local_field_cache;
local_field_cache = fl;
}

f->flag_field = 1;
output_target = savetarget;
}
}

static void
output_param (cb_tree x, int id)
{
struct cb_reference *r;
struct cb_field *f;
struct cb_cast *cp;
struct cb_binary_op *bp;
struct field_list *fl;
FILE *savetarget;
struct cb_intrinsic *ip;
struct cb_alphabet_name *abp;
cb_tree l;
Expand Down Expand Up @@ -4457,28 +4489,7 @@ output_param (cb_tree x, int id)
&& f->count != 0
&& !chk_field_variable_size (f)
&& !chk_field_variable_address (f)) {
if (!f->flag_field) {
savetarget = output_target;
output_target = NULL;
output_field (x);

fl = cobc_parse_malloc (sizeof (struct field_list));
fl->x = x;
fl->f = f;
fl->curr_prog = excp_current_program_id;
if (f->index_type != CB_INT_INDEX
&& ( f->flag_is_global
|| current_prog->flag_file_global)) {
fl->next = field_cache;
field_cache = fl;
} else {
fl->next = local_field_cache;
local_field_cache = fl;
}

f->flag_field = 1;
output_target = savetarget;
}
create_field (f, x);
if (add_comma) {
add_comma = 0;
output (", ");
Expand Down Expand Up @@ -7687,6 +7698,45 @@ output_set_attribute (const struct cb_field *f, cob_flags_t val_on,
}
}

/* XML PARSE */


static void
output_xml_parse (struct cb_xml_parse *p)
{
output_block_open ();
output_line ("void *xml_state = NULL;");
output_prefix ();
output ("cob_set_int ("),
output_param (current_program->xml_code, 0);
output (", 0);");
output_newline ();

output_line ("for (;;)");
output_block_open ();

/* actual XML parsing function and possible end */
output_source_reference (CB_TREE (p), STMT_XML_PARSE);
output_prefix ();
output ("if (cob_xml_parse ("),
output_param (p->data, 0);
output (", ");
output_param (p->encoding, 1);
output (", ");
output_param (p->validating, 2);
output (", %d, &xml_state)) break;", p->returning_national);

/* COBOL callback function -> PROCESSING PROCEDURE */
/* note: automatic source reference */
output_newline ();
output_perform_once (CB_PERFORM (p->proc));

output_block_close ();

output_block_close ();
output_newline ();
}

/* CANCEL */

static void
Expand Down Expand Up @@ -9405,6 +9455,9 @@ output_stmt (cb_tree x)
output_set_attribute (sap->fld, sap->val_on, sap->val_off);
break;
}
case CB_TAG_XML_PARSE:
output_xml_parse (CB_XML_PARSE (x));
break;
case CB_TAG_ALTER:
output_alter (CB_ALTER (x));
break;
Expand Down Expand Up @@ -11845,6 +11898,7 @@ output_module_init_function (struct cb_program *prog)
}
output_line ("module->flag_dump_sect = 0x%02X;", cb_flag_dump);
output_line ("module->flag_dump_ready = %u;", cb_flag_dump ? 1 : 0);
output_line ("module->xml_mode = %u;", cb_xml_parse_xmlss);
output_line ("module->module_stmt = 0;");
if (source_cache) {
output_line ("module->module_sources = %ssource_files;",
Expand Down
3 changes: 3 additions & 0 deletions cobc/config.def
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,6 +195,9 @@ CB_CONFIG_BOOLEAN (cb_implicit_assign_dynamic_var, "implicit-assign-dynamic-var"
CB_CONFIG_BOOLEAN (cb_device_mnemonics, "device-mnemonics",
_("specifying device by mnemonic"))

CB_CONFIG_BOOLEAN (cb_xml_parse_xmlss, "xml-parse-xmlss",
"XML PARSE XMLSS")

/* Support flags */

CB_CONFIG_SUPPORT (cb_comment_paragraphs, "comment-paragraphs",
Expand Down
11 changes: 6 additions & 5 deletions cobc/field.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1246,11 +1246,6 @@ validate_any_length_item (struct cb_field *f)
return 1;
}

/* CHECKME: Why do we increase the reference counter here
(to ensure the field is generated)?
Better would be to add the check for 'f->count != 0' to the place
where it possibly is missing... */
f->count++;
return 0;
}

Expand Down Expand Up @@ -3170,13 +3165,19 @@ cb_validate_field (struct cb_field *f)
validate_field_value (f);
if (f->flag_is_global) {
struct cb_field *c;
#if 0 /* CHECKME: Why should we adjust the field count here? */
if (f->count == 0)
f->count++;
for (c = f->children; c; c = c->sister) {
c->flag_is_global = 1;
if (c->count == 0)
c->count++;
}
#else
for (c = f->children; c; c = c->sister) {
c->flag_is_global = 1;
}
#endif
}

f->flag_is_verified = 1;
Expand Down
Loading

0 comments on commit d326219

Please sign in to comment.