diff --git a/gcc/cobol/failures/nc250/analyze b/gcc/cobol/failures/nc250/analyze
deleted file mode 100755
index 2dfb0aebb12f77692f4d10ad389dbe22f669e336..0000000000000000000000000000000000000000
--- a/gcc/cobol/failures/nc250/analyze
+++ /dev/null
@@ -1,118 +0,0 @@
-#!/usr/bin/python3
-
-import sys
-import os
-
-def extract_name(instring:str):
- left = instring.find("#") + 2
- right = instring.find("_analyze")
- return instring[left:right]
-
-def extract_summary_name(instring:str):
- left = instring.find("#") + 1
- right = instring.rindex("_")
- return instring[left:right]
-
-def sort_sortit(p):
- return p[1]
-
-def main():
- sfile:str = None
- if len(sys.argv) == 1:
- # There were no parameters. See if there is one, and only one,
- # .s assembler file:
- fcount:int = 0
- sfile:str = None
- files:list = os.listdir()
- for file in files:
- if file[-2:] == ".s":
- fcount += 1;
- sfile = file
- if fcount > 1:
- sys.exit("There are more than one .s files; specify one")
- elif len(sys.argv) == 2:
- sfile:str = sys.argv[1]
- if not sfile:
- sys.exit("{} must have one parameter, the file name".format(sys.argv[0]))
-
- all_lines:list = open(sfile).read().split('\n')
-
- lines:list = []
- total_lines:int = 0
- known_lines:int = 0
- for line in all_lines:
- sline:str = line.strip()
- if len(sline) == 0:
- continue
- if not (line.strip()[0] in ('.', '#', '_')
- or line.strip()[-1] == ':'):
- total_lines += 1
- if (line.strip()[0] in ('.', '#', '_')
- and line.find("_analyze_enter") == -1
- and line.find("_analyze_exit") == -1):
- continue
- if sline[-1] == ':':
- continue
- lines.append(sline)
-
- starts:dict = {}
- ends:dict = {}
-
- # First pass creates the entries for _analyze_enter and _analyze_exit
- for nline in range(len(lines)):
- line = lines[nline]
- if line.find("_analyze_enter") > -1:
- starts[extract_name(line)] = nline
- if line.find("_analyze_exit") > -1:
- ends.update({extract_name(line) : nline})
-
- # Create the details
- details:dict = {}
- for key in starts:
- if key in ends:
- ender = key + "_analyze_exit"
- nlevel = 0
- ncount = 0
- nleft = starts[key]
- nright = ends[key]
- for nline in range(nright-1, nleft, -1):
- line = lines[nline]
- if line.find(ender) > -1:
- continue
- if line.find("_analyze_exit") > -1:
- nlevel += 1;
- continue
- if line.find("_analyze_enter") > -1:
- nlevel -= 1;
- if nlevel == 0:
- ncount += 1;
- known_lines += 1;
- details.update({key : ncount})
-
- # create the summary
- summary:dict = {}
- for key in details:
- summary_key = extract_summary_name(key)
- if summary_key in summary:
- newval = summary[summary_key] + details[key]
- summary.update({summary_key : newval})
- else:
- summary.update({summary_key : details[key]})
-
- # build a list of tuples:
- sortit:list = []
- for key in summary:
- sortit.append( (key, summary[key]) )
-
- # sort that list:
- sortit = sorted(sortit, key=sort_sortit)
-
- for pair in sortit:
- print( "{0: <32} {1: >6}".format(pair[0], pair[1]) )
-
- print("lines of assembler {0:>6}".format(total_lines))
- print("lines accounted for {0:>6}".format(known_lines))
- print("lines remaining {0:>6}".format(total_lines-known_lines))
-
-main()
-
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 271bb6c45777803c0565d9d419e935e2ba57e9a8..38b3ef5be05cf082edf44cbdb95c6e4f1c352e39 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -1810,7 +1810,6 @@ refer_fill_subscripts(cbl_refer_t &refer)
if( !refer.nsubscript )
{
// There are no subscripts
- gg_assign(member(refer.refer_decl_node, "all_flags"), integer_zero_node);
return retval;
}
// Figure we have three subscripts, so nsubscript is 3
@@ -1982,7 +1981,9 @@ refer_fill_subscripts(cbl_refer_t &refer)
}
parent = parent_of(parent);
}
- gg_assign(member(refer.refer_decl_node, "all_flags"), all_flags);
+ gg_assign(member(refer.refer_decl_node, "flags"),
+ gg_bitwise_or(member(refer.refer_decl_node, "flags"),
+ gg_cast(INT, all_flags)));
// gg_printf(" returning %d\n", retval, NULL_TREE);
return retval; // This is one if a subscript is beyond depending on
}
@@ -2443,25 +2444,19 @@ refer_fill_internal(cbl_refer_t &refer, refer_type_t refer_type)
counter++);
refer.refer_decl_node = gg_define_variable(cblc_refer_type_node, ach, vs_stack);
- gg_memset(gg_get_address_of(refer.refer_decl_node),
- integer_zero_node,
- build_int_cst_type(SIZE_T, sizeof(cblc_refer_t)));
+ // gg_memset(gg_get_address_of(refer.refer_decl_node),
+ // integer_zero_node,
+ // build_int_cst_type(SIZE_T, sizeof(cblc_refer_t)));
if( refer.field && refer.field->type == FldLiteralA )
{
gg_assign(member(refer.refer_decl_node, "field"),
gg_cast(cblc_field_p_type_node,
gg_get_address_of(pseudo_alpha)));
- if(refer.all)
- {
- gg_assign(member(refer.refer_decl_node, "move_all"),
- refer.all ? integer_one_node : integer_zero_node);
- }
- if(refer.addr_of)
- {
- gg_assign(member(refer.refer_decl_node, "address_of"),
- refer.addr_of ? integer_one_node : integer_zero_node);
- }
+ int flags = (refer.all ? REFER_T_MOVE_ALL : 0)
+ + (refer.addr_of ? REFER_T_ADDRESS_OF : 0);
+ gg_assign(member(refer.refer_decl_node, "flags"),
+ build_int_cst_type(INT, flags));
char *litstring = get_literal_string(refer.field);
gg_assign(member(refer.refer_decl_node, "qual_data"),
gg_cast(UCHAR_P, gg_string_literal(litstring)));
@@ -2473,16 +2468,10 @@ refer_fill_internal(cbl_refer_t &refer, refer_type_t refer_type)
gg_assign(member(refer.refer_decl_node, "field"),
gg_cast(cblc_field_p_type_node,
gg_get_address_of(refer.field->var_decl_node)));
- if(refer.all)
- {
- gg_assign(member(refer.refer_decl_node, "move_all"),
- refer.all ? integer_one_node : integer_zero_node);
- }
- if(refer.addr_of)
- {
- gg_assign(member(refer.refer_decl_node, "address_of"),
- refer.addr_of ? integer_one_node : integer_zero_node);
- }
+ int flags = (refer.all ? REFER_T_MOVE_ALL : 0)
+ + (refer.addr_of ? REFER_T_ADDRESS_OF : 0);
+ gg_assign(member(refer.refer_decl_node, "flags"),
+ build_int_cst_type(INT, flags));
if( refer.field->var_decl_node // On the first call to parser_initialize on it can be null
&& refer.field->type != FldLiteralN)
@@ -2516,7 +2505,7 @@ refer_fill_internal(cbl_refer_t &refer, refer_type_t refer_type)
}
// modify qual_data and qual_size, if necessary, because of refmod
- refer_fill_refmod(refer);
+ refer_fill_refmod(refer);
refer_fill_depends(refer, refer_type);
}
@@ -2530,6 +2519,8 @@ refer_fill_internal(cbl_refer_t &refer, refer_type_t refer_type)
gg_cast(UCHAR_P, null_pointer_node));
gg_assign(member(refer.refer_decl_node,"qual_size"),
size_t_zero_node);
+ gg_assign(member(refer.refer_decl_node, "flags"),
+ integer_zero_node);
}
return retval;
}
diff --git a/gcc/cobol/libgcobol.h b/gcc/cobol/libgcobol.h
index 6545c91e66ae05d1a458f3ac3bdb784347ec1cf2..6227e802f245690dcd9c79c8d2525f0cad45617e 100644
--- a/gcc/cobol/libgcobol.h
+++ b/gcc/cobol/libgcobol.h
@@ -115,15 +115,20 @@ struct cblc_subscript_t
unsigned int type; // When type is FldLiteralN, field is a pointer to __int128
};
+#define REFER_T_ALL_FLAGS_MASK 0x0FF // We allow for seven subscripts
+#define REFER_T_MOVE_ALL 0x100 // This is the move_all flag
+#define REFER_T_ADDRESS_OF 0x200 // This is the address_of flag
+
typedef struct cblc_refer_t
{
// This structure must match the code in structs.cc
cblc_field_t *field; // When flags::VAR_DECL_INT128 is on, this is a pointer to an __int128
unsigned char *qual_data; // As qualified by subscripts or refmods
size_t qual_size; // As qualified by refmods or depending_on
- int all_flags; // These indicate ALL subscripts
- int move_all;
- int address_of;
+ int flags; // combines all_flags, move_all, and address_of
+// int all_flags; // These indicate ALL subscripts
+// int move_all;
+// int address_of;
int dummy; // Fill out to a multiple of eight bytes
} cblc_refer_t;
diff --git a/gcc/cobol/structs.cc b/gcc/cobol/structs.cc
index d21d32365b8fdebf50678291afbd012339c9cab2..433b6ccf4c69e6adc14767e27e5dc8acfeb24d04 100644
--- a/gcc/cobol/structs.cc
+++ b/gcc/cobol/structs.cc
@@ -333,13 +333,14 @@ create_cblc_refer_t()
tree retval = NULL_TREE;
retval = gg_get_filelevel_struct_type_decl(
"cblc_refer_t",
- 7,
+ 5,
cblc_field_p_type_node, "field" ,
UCHAR_P, "qual_data" ,
SIZE_T, "qual_size" ,
- INT, "all_flags",
- INT, "move_all",
- INT, "address_of",
+ INT, "flags",
+ // INT, "all_flags",
+ // INT, "move_all",
+ // INT, "address_of",
INT, "dummy");
retval = TREE_TYPE(retval);
return retval;
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 83383a348ef46b3f1416a8e50fa8b635747832f2..c4acbfae0e637d88ff589fcaf50b485f303f7ec4 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -735,16 +735,6 @@ struct cbl_span_t {
}
};
-// These flags are set in the cblc_refer_t flags byte. REFER_IS_EMPTY is used
-// in the very common case when there are no subscripts and no refmods in an
-// attempt to speed up processing. The MOVE_ALL and ADDR_OF flags
-// are used when translating bool all and bool addr_of to the run-time
-// structures.
-#define REFER_IS_EMPTY 0x0001 // It's important that this be 0x0001
-#define MOVE_ALL_FLAG 0x0002
-#define ADDR_OF_FLAG 0x0004
-#define VAR_DECL_INT128 0x0008 // indicates the cblc_refer_t::field points to an INT128 literal
-
#define RELOP_START 0
enum relop_t {
lt_op = RELOP_START,
diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
index 6f2fd9b53540815b3b4011f5bbeb17303f587d31..d35b3659a77047af937769b9c9c24a7533a0d877 100644
--- a/libgcobol/intrinsic.cc
+++ b/libgcobol/intrinsic.cc
@@ -273,7 +273,7 @@ build_refer_state_for_all( refer_state_for_all &state,
cblc_refer_t *refer)
{
memset(&state, 0, sizeof(refer_state_for_all) );
- if( refer->all_flags )
+ if( refer->flags & REFER_T_ALL_FLAGS_MASK )
{
// At this point, refer points to the very first element of
// an array specification that includes at least one ALL subscript. At
@@ -303,7 +303,7 @@ build_refer_state_for_all( refer_state_for_all &state,
// We are sitting on an occurs clause:
- if( current_bit & refer->all_flags )
+ if( current_bit & refer->flags )
{
// It is an ALL subscript:
state.nflags += 1;
@@ -1698,8 +1698,8 @@ __gg__max(cblc_field_t *dest, size_t ncount, cblc_refer_t inputs[])
best_location = input->qual_data;
best_length = input->qual_size;
best_attr = input->field->attr;
- best_move_all = inputs[i].move_all;
- best_address_of = inputs[i].address_of;
+ best_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ best_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
}
else
{
@@ -1707,8 +1707,8 @@ __gg__max(cblc_field_t *dest, size_t ncount, cblc_refer_t inputs[])
unsigned char *candidate_location = input->qual_data;
size_t candidate_length = input->qual_size;
int candidate_attr = input->field->attr;
- bool candidate_move_all = inputs[i].move_all;
- bool candidate_address_of = inputs[i].address_of;
+ bool candidate_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ bool candidate_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
int compare_result = __gg__compare_2(
candidate_field,
@@ -1946,8 +1946,8 @@ __gg__min(cblc_field_t *dest, size_t ncount, cblc_refer_t inputs[])
best_location = input->qual_data;
best_length = input->qual_size;
best_attr = input->field->attr;
- best_move_all = inputs[i].move_all;
- best_address_of = inputs[i].address_of;
+ best_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ best_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
}
else
{
@@ -1955,8 +1955,8 @@ __gg__min(cblc_field_t *dest, size_t ncount, cblc_refer_t inputs[])
unsigned char *candidate_location = input->qual_data;
size_t candidate_length = input->qual_size;
int candidate_attr = input->field->attr;
- bool candidate_move_all = inputs[i].move_all;
- bool candidate_address_of = inputs[i].address_of;
+ bool candidate_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ bool candidate_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
int compare_result = __gg__compare_2(
candidate_field,
@@ -2761,8 +2761,8 @@ __gg__ord_min(cblc_field_t *dest, size_t ninputs, cblc_refer_t inputs[])
best_location = input->qual_data;
best_length = input->qual_size;
best_attr = input->field->attr;
- best_move_all = inputs[i].move_all;
- best_address_of = inputs[i].address_of;
+ best_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ best_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
}
else
{
@@ -2771,8 +2771,8 @@ __gg__ord_min(cblc_field_t *dest, size_t ninputs, cblc_refer_t inputs[])
candidate_location = input->qual_data;
candidate_length = input->qual_size;
candidate_attr = input->field->attr;
- candidate_move_all = inputs[i].move_all;
- candidate_address_of = inputs[i].address_of;
+ candidate_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ candidate_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
int compare_result =
__gg__compare_2(
@@ -2856,8 +2856,8 @@ __gg__ord_max(cblc_field_t *dest, size_t ninputs, cblc_refer_t inputs[])
best_location = input->qual_data;
best_length = input->qual_size;
best_attr = input->field->attr;
- best_move_all = inputs[i].move_all;
- best_address_of = inputs[i].address_of;
+ best_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ best_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
}
else
{
@@ -2866,8 +2866,8 @@ __gg__ord_max(cblc_field_t *dest, size_t ninputs, cblc_refer_t inputs[])
candidate_location = input->qual_data;
candidate_length = input->qual_size;
candidate_attr = input->field->attr;
- candidate_move_all = inputs[i].move_all;
- candidate_address_of = inputs[i].address_of;
+ candidate_move_all = !!(inputs[i].flags & REFER_T_MOVE_ALL);
+ candidate_address_of = !!(inputs[i].flags & REFER_T_ADDRESS_OF);
int compare_result =
__gg__compare_2(
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index e94e796c6b4a7cf6be0e704dd15e463729bd09f4..2d49468f287c1fc339bf2d5a0260086b4a96da2c 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -2823,7 +2823,7 @@ format_for_display_local(char **dest, size_t *dest_size, cblc_refer_t *var)
var->field,
var->qual_data,
var->qual_size,
- var->address_of);
+ var->flags & REFER_T_ADDRESS_OF);
}
else
{
@@ -3747,14 +3747,14 @@ __gg__compare( struct cblc_refer_t *left_ref,
left_ref->qual_data,
left_ref->qual_size,
left_ref->field->attr,
- left_ref->move_all,
- left_ref->address_of,
+ !!(left_ref->flags & REFER_T_MOVE_ALL),
+ !!(left_ref->flags & REFER_T_ADDRESS_OF),
right_ref->field,
right_ref->qual_data,
right_ref->qual_size,
right_ref->field->attr,
- right_ref->move_all,
- right_ref->address_of,
+ !!(right_ref->flags & REFER_T_MOVE_ALL),
+ !!(right_ref->flags & REFER_T_ADDRESS_OF),
second_time_through);
return retval;
}
@@ -4594,7 +4594,7 @@ __gg__move( struct cblc_refer_t *dest,
// This is a little bold, but non-alphabetics will never
// have the rjust_e or MOVE_ALL bits on, so it's safe
// enough.
- alpha_to_alpha_move(dest, source, source->move_all);
+ alpha_to_alpha_move(dest, source, !!(source->flags & REFER_T_MOVE_ALL));
break;
default:
@@ -4609,14 +4609,14 @@ __gg__move( struct cblc_refer_t *dest,
switch( source_type )
{
case FldGroup:
- alpha_to_alpha_move(dest, source, source->move_all);
+ alpha_to_alpha_move(dest, source, !!(source->flags & REFER_T_MOVE_ALL));
break;
case FldAlphanumeric:
case FldNumericEdited:
case FldAlphaEdited:
// This is an ordinary alpha-to-alpha move:
- alpha_to_alpha_move(dest, source, source->move_all);
+ alpha_to_alpha_move(dest, source, !!(source->flags & REFER_T_MOVE_ALL));
break;
case FldNumericDisplay:
@@ -5082,7 +5082,7 @@ __gg__move( struct cblc_refer_t *dest,
source->field,
(unsigned char *)source->qual_data,
source->qual_size,
- source->address_of);
+ source->flags && REFER_T_ADDRESS_OF);
display_string_length = strlen(display_string);
}
__gg__string_to_alpha_edited( (char *)dest->qual_data,
@@ -6768,7 +6768,7 @@ __gg__display( cblc_refer_t *var,
var->field,
var->qual_data,
var->qual_size,
- var->address_of );
+ !!(var->flags & REFER_T_ADDRESS_OF) );
// }
// else
// {
@@ -8115,7 +8115,7 @@ __gg__set_pointer( cblc_refer_t *target,
cblc_refer_t *source)
{
void *source_address;
- if( source->address_of )
+ if( source->flags & REFER_T_ADDRESS_OF )
{
// This is SET <something> TO ADDRESS OF SOURCE
source_address = source->qual_data;
@@ -8134,7 +8134,7 @@ __gg__set_pointer( cblc_refer_t *target,
}
}
- if( target->address_of )
+ if( target->flags & REFER_T_ADDRESS_OF )
{
// This is SET ADDRESS OF target TO ....
// We know it has to be an unqualified LINKAGE level 01 or level 77
@@ -8426,7 +8426,7 @@ __gg__literaln_alpha_compare(char *left_side,
false,
(char *)right->qual_data,
right->qual_size,
- right->move_all );
+ !!(right->flags & REFER_T_MOVE_ALL) );
return retval;
}