procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cobol: Bring the code base into compliance with C++14

Browse source 
gcc/cobol

	* cdf.y: Make compatible with C++14.
	* copybook.h: Likewise.
	* dts.h: Likewise.
	* except.cc: Likewise.
	* genapi.cc: Likewise.
	* genutil.cc: Likewise.
	* genutil.h: Likewise.
	* lexio.cc: Likewise.
	* parse.y: Likewise.
	* parse_ante.h: Likewise.
	* show_parse.h: Likewise.
	* symbols.cc: Likewise.
	* symbols.h: Likewise.
	* util.cc: Likewise.
This commit is contained in:
Bob Dubner 2025-03-18 07:47:39 -04:00 • committed by Robert Dubner
parent 563e6d926d
commit c49382fd22
14 changed files with 723 additions and 483 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
gcc/cobol/cdf.y
View file

@ -702,7 +702,9 @@ suppress: %empty
;
name_any: namelit
| PSEUDOTEXT { $$ = (cdf_arg_t){YDF_PSEUDOTEXT, $1}; }
| PSEUDOTEXT {
$$ = cdf_arg_t{YDF_PSEUDOTEXT, $1};
}
;
name_one: NAME
@ -715,8 +717,8 @@ name_one: NAME
}
$$ = arg;
}
| NUMSTR { $$ = (cdf_arg_t){YDF_NUMSTR, $1}; }
| LITERAL { $$ = (cdf_arg_t){YDF_LITERAL, $1}; }
| NUMSTR { $$ = cdf_arg_t{YDF_NUMSTR, $1}; }
| LITERAL { $$ = cdf_arg_t{YDF_LITERAL, $1}; }
;
namelit: name
@ -738,8 +740,8 @@ namelit: name
cdf_arg_t arg = { YDF_NAME, s };
$$ = arg;
}
| NUMSTR { $$ = (cdf_arg_t){YDF_NUMSTR, $1}; }
| LITERAL { $$ = (cdf_arg_t){YDF_LITERAL, $1}; }
| NUMSTR { $$ = cdf_arg_t{YDF_NUMSTR, $1}; }
| LITERAL { $$ = cdf_arg_t{YDF_LITERAL, $1}; }
;
name: NAME

21
gcc/cobol/copybook.h
View file

@ -128,25 +128,28 @@ private:
char *regex_text;
};
class uppername_t {
std::string upper;
public:
uppername_t( const std::string input ) : upper(input) {
std::transform(input.begin(), input.end(), upper.begin(),
[]( char ch ) { return TOUPPER(ch); } );
}
const char *data() const { return upper.data(); }
};
class copybook_t {
std::list<const char *> directories;
copybook_elem_t book;
// Take copybook name from the environment, if defined, else use it verbatim.
static const char * transform_name( const char name[] ) {
char uname[ strlen(name) ];
uppername_t uname(name);
const char *value = getenv(name);
if( !value ) {
auto ename = name + strlen(name);
std::transform( name, ename, uname,
[]( char ch ) { return TOUPPER(ch); } );
value = getenv(uname); // try uppercase of envar name
value = getenv(uname.data()); // try uppercase of envar name
if( !value ) value = name; // keep original unmodified
}
if( false && value != uname ) {
dbgmsg("using copybook file '%s' from environment variable '%s'",
value, name);
}
return xstrdup(value);
}

6
gcc/cobol/dts.h
View file

@ -93,12 +93,12 @@ namespace dts {
if( eoinput == NULL ) eoinput = strchr(input, '\0');
auto ncm = re.size();
cm.resize(ncm);
regmatch_t cms[ncm];
std::vector <regmatch_t> cms(ncm);
int erc = regexec( &re, input, ncm, cms, 0 );
int erc = regexec( &re, input, ncm, cms.data(), 0 );
if( erc != 0 ) return false;
std::transform( cms, cms+ncm, cm.begin(),
std::transform( cms.begin(), cms.end(), cm.begin(),
[input]( const regmatch_t& m ) {
return csub_match( input, m );
} );

9
gcc/cobol/except.cc
View file

@ -279,10 +279,11 @@ symbol_declaratives_add( size_t program,
char achBlob[32];
sprintf(achBlob, "_DECLARATIVE_BLOB%d_", blob_count++);
cbl_field_data_t data = { .memsize = capacity_cast(len),
.capacity = capacity_cast(len),
.initial = reinterpret_cast<char*>(blob),
.picture = reinterpret_cast<char*>(blob) };
cbl_field_data_t data = {};
data.memsize = capacity_cast(len);
data.capacity = capacity_cast(len);
data.initial = reinterpret_cast<char*>(blob);
data.picture = reinterpret_cast<char*>(blob);
cbl_field_t field = { 0, FldBlob, FldInvalid, constant_e,
0, 0, 0, cbl_occurs_t(), 0, "",
0, {}, data, NULL };

79
gcc/cobol/genapi.cc
View file

@ -470,7 +470,7 @@ get_level_88_domain(size_t parent_capacity, cbl_field_t *var, size_t &returned_s
// Loop through the provided domains:
returned_size = 0;
const struct cbl_domain_t *domain = var->data.domain;
const struct cbl_domain_t *domain = var->data.domain_of();
while( domain->first.name() )
{
// We have another pair to process
@ -513,7 +513,7 @@ get_class_condition_string(cbl_field_t *var)
// We know at this point that var is FldClass
// The LEVEL is not 88, so this is a CLASS SPECIAL-NAME
const struct cbl_domain_t *domain = var->data.domain;
const struct cbl_domain_t *domain = var->data.domain_of();
/* There are five possibilities we need to deal with.
@ -1043,7 +1043,7 @@ initialize_variable_internal( cbl_refer_t refer,
default:
{
char ach[128];
strfromf128(ach, sizeof(ach), "%.16E", parsed_var->data.value);
strfromf128(ach, sizeof(ach), "%.16E", parsed_var->data.value_of());
SHOW_PARSE_TEXT(ach);
break;
}
@ -2964,9 +2964,9 @@ parser_perform(cbl_label_t *label, bool suppress_nexting)
SHOW_PARSE_HEADER
SHOW_PARSE_LABEL(" ", label)
char ach[32];
sprintf(ach, " label is at %p", label);
sprintf(ach, " label is at %p", (void*)label);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " label->proc is %p", label->structs.proc);
sprintf(ach, " label->proc is %p", (void*)label->structs.proc);
SHOW_PARSE_TEXT(ach)
SHOW_PARSE_END
}
@ -3075,9 +3075,9 @@ parser_perform_times( cbl_label_t *proc_1, cbl_refer_t count )
SHOW_PARSE_REF(" ", count)
SHOW_PARSE_TEXT(" TIMES")
char ach[32];
sprintf(ach, " proc_1 is at %p", proc_1);
sprintf(ach, " proc_1 is at %p", (void*)proc_1);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " proc_1->proc is %p", proc_1->structs.proc);
sprintf(ach, " proc_1->proc is %p", (void*)proc_1->structs.proc);
SHOW_PARSE_TEXT(ach)
SHOW_PARSE_END
}
@ -3128,17 +3128,17 @@ internal_perform_through( cbl_label_t *proc_1,
SHOW_PARSE_HEADER
SHOW_PARSE_LABEL(" ", proc_1);
char ach[32];
sprintf(ach, " proc_1 is at %p", proc_1);
sprintf(ach, " proc_1 is at %p", (void*)proc_1);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " proc_1->proc is %p", proc_1->structs.proc);
sprintf(ach, " proc_1->proc is %p", (void*)proc_1->structs.proc);
SHOW_PARSE_TEXT(ach)
if( proc_2 )
{
SHOW_PARSE_INDENT
SHOW_PARSE_LABEL("", proc_2);
sprintf(ach, " proc_2 is at %p", proc_2);
sprintf(ach, " proc_2 is at %p", (void*)proc_2);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " proc_2->proc is %p", proc_2->structs.proc);
sprintf(ach, " proc_2->proc is %p", (void*)proc_2->structs.proc);
SHOW_PARSE_TEXT(ach)
}
SHOW_PARSE_END
@ -3213,17 +3213,17 @@ internal_perform_through_times( cbl_label_t *proc_1,
SHOW_PARSE_HEADER
SHOW_PARSE_LABEL(" ", proc_1);
char ach[32];
sprintf(ach, " proc_1 is at %p", proc_1);
sprintf(ach, " proc_1 is at %p", (void*)proc_1);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " proc_1->proc is %p", proc_1->structs.proc);
sprintf(ach, " proc_1->proc is %p", (void*)proc_1->structs.proc);
SHOW_PARSE_TEXT(ach)
if( proc_2 )
{
SHOW_PARSE_INDENT
SHOW_PARSE_LABEL("", proc_2);
sprintf(ach, " proc_2 is at %p", proc_2);
sprintf(ach, " proc_2 is at %p", (void*)proc_2);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " proc_2->proc is %p", proc_2->structs.proc);
sprintf(ach, " proc_2->proc is %p", (void*)proc_2->structs.proc);
SHOW_PARSE_TEXT(ach)
}
SHOW_PARSE_REF(" ", count);
@ -3796,7 +3796,10 @@ psa_FldLiteralN(struct cbl_field_t *field )
// We are constructing a completely static constant structure, based on the
// text string in .initial
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wpedantic"
__int128 value = 0;
#pragma GCC diagnostic pop
do
{
@ -4025,7 +4028,7 @@ psa_FldLiteralN(struct cbl_field_t *field )
TREE_READONLY(field->literal_decl_node) = 1;
TREE_CONSTANT(field->literal_decl_node) = 1;
char ach[128];
strfromf128(ach, sizeof(ach), "%.36E", field->data.value);
strfromf128(ach, sizeof(ach), "%.36E", field->data.value_of());
REAL_VALUE_TYPE real;
real_from_string(&real, ach);
tree initer = build_real (DOUBLE, real);
@ -4883,7 +4886,7 @@ parser_display_internal(tree file_descriptor,
// We make use of that here
char ach[128];
strfromf128(ach, sizeof(ach), "%.33E", refer.field->data.value);
strfromf128(ach, sizeof(ach), "%.33E", refer.field->data.value_of());
char *p = strchr(ach, 'E');
if( !p )
{
@ -4902,7 +4905,7 @@ parser_display_internal(tree file_descriptor,
int precision = 32 - exp;
char achFormat[24];
sprintf(achFormat, "%%.%df", precision);
strfromf128(ach, sizeof(ach), achFormat, refer.field->data.value);
strfromf128(ach, sizeof(ach), achFormat, refer.field->data.value_of());
}
__gg__remove_trailing_zeroes(ach);
}
@ -7351,9 +7354,9 @@ parser_label_label(struct cbl_label_t *label)
SHOW_PARSE_HEADER
SHOW_PARSE_LABEL("", label)
char ach[32];
sprintf(ach, " label is at %p", label);
sprintf(ach, " label is at %p", (void*)label);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " label->proc is %p", label->structs.proc);
sprintf(ach, " label->proc is %p", (void*)label->structs.proc);
SHOW_PARSE_TEXT(ach)
SHOW_PARSE_END
}
@ -7384,9 +7387,9 @@ parser_label_goto(struct cbl_label_t *label)
SHOW_PARSE_HEADER
SHOW_PARSE_LABEL(" ", label)
char ach[32];
sprintf(ach, " label is at %p", label);
sprintf(ach, " label is at %p", (void*)label);
SHOW_PARSE_TEXT(ach)
sprintf(ach, " label->proc is %p", label->structs.proc);
sprintf(ach, " label->proc is %p", (void*)label->structs.proc);
SHOW_PARSE_TEXT(ach)
SHOW_PARSE_END
}
@ -7603,7 +7606,7 @@ parser_perform_start( struct cbl_perform_tgt_t *tgt )
{
SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at")
char ach[32];
sprintf(ach, " %p", tgt);
sprintf(ach, " %p", (void*)tgt);
SHOW_PARSE_TEXT(ach);
SHOW_PARSE_LABEL(" ", tgt->from())
if( tgt->to() )
@ -7664,7 +7667,7 @@ parser_perform_conditional( struct cbl_perform_tgt_t *tgt )
SHOW_PARSE_HEADER
SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at")
char ach[32];
sprintf(ach, " %p", tgt);
sprintf(ach, " %p", (void*)tgt);
SHOW_PARSE_TEXT(ach);
SHOW_PARSE_END
}
@ -7713,7 +7716,7 @@ parser_perform_conditional_end( struct cbl_perform_tgt_t *tgt )
SHOW_PARSE_HEADER
SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at")
char ach[32];
sprintf(ach, " %p", tgt);
sprintf(ach, " %p", (void*)tgt);
SHOW_PARSE_TEXT(ach);
SHOW_PARSE_END
}
@ -8632,7 +8635,7 @@ parser_perform_until( struct cbl_perform_tgt_t *tgt,
SHOW_PARSE_HEADER
SHOW_PARSE_TEXT(" cbl_perform_tgt_t is at")
char ach[32];
sprintf(ach, " %p", tgt);
sprintf(ach, " %p", (void*)tgt);
SHOW_PARSE_TEXT(ach);
SHOW_PARSE_LABEL(" ", tgt->from())
if( tgt->to() )
@ -8818,11 +8821,11 @@ parser_set_conditional88( struct cbl_refer_t refer, bool which_way )
if( which_way )
{
src = tgt->data.domain;
src = tgt->data.domain_of();
}
else
{
src = tgt->data.false_value;
src = tgt->data.false_value_of();
}
// We want to set the LEVEL88 target to TRUE (or FALSE), so we need to set
@ -13722,6 +13725,8 @@ mh_identical(cbl_refer_t &destref,
return moved;
}
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wpedantic"
static bool
mh_source_is_literalN(cbl_refer_t &destref,
cbl_refer_t &sourceref,
@ -13961,7 +13966,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
// The following generated code is the exact equivalent
// of the C code:
// *(float *)dest = (float)data.value
_Float32 src = (_Float32)sourceref.field->data.value;
_Float32 src = (_Float32)sourceref.field->data.value_of();
tree tsrc = build_string_literal(sizeof(src), (char *)&src);
gg_assign(gg_indirect(gg_cast(build_pointer_type(INT), tdest)),
gg_indirect(gg_cast(build_pointer_type(INT), tsrc )));
@ -13969,7 +13974,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
}
case 8:
{
_Float64 src = (_Float64)sourceref.field->data.value;
_Float64 src = (_Float64)sourceref.field->data.value_of();
tree tsrc = build_string_literal(sizeof(src), (char *)&src);
gg_assign(gg_indirect(gg_cast(build_pointer_type(LONG), tdest)),
gg_indirect(gg_cast(build_pointer_type(LONG), tsrc )));
@ -13977,7 +13982,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
}
case 16:
{
_Float128 src = (_Float128)sourceref.field->data.value;
_Float128 src = (_Float128)sourceref.field->data.value_of();
tree tsrc = build_string_literal(sizeof(src), (char *)&src);
gg_assign(gg_indirect(gg_cast(build_pointer_type(INT128), tdest)),
gg_indirect(gg_cast(build_pointer_type(INT128), tsrc )));
@ -14000,6 +14005,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
}
return moved;
}
#pragma GCC diagnostic pop
static
tree float_type_of(int n)
@ -15004,7 +15010,7 @@ move_helper(tree size_error, // This is an INT
if( figconst )
{
char const_char = 0xFF; // Head off a compiler warning about
char const_char = 0x7F; // Head off a compiler warning about
// // uninitialized variables
switch(figconst)
{
@ -15222,6 +15228,8 @@ parser_print_string(const char *fmt, const char *ach)
gg_printf(fmt, gg_string_literal(ach), NULL_TREE);
}
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wpedantic"
char *
binary_initial_from_float128(cbl_field_t *field, int rdigits, _Float128 value)
{
@ -15300,6 +15308,7 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits, _Float128 value)
return retval;
}
#pragma GCC diagnostic pop
static void
digits_from_float128(char *retval, cbl_field_t *field, size_t width, int rdigits, _Float128 value)
@ -16270,7 +16279,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
new_var->data.digits,
new_var->data.rdigits,
new_var->attr,
new_var);
(void*)new_var);
if( is_table(new_var) )
{
@ -16309,7 +16318,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
{
fprintf(stderr,
" redefines:(%p)%s",
symbol_redefines(new_var),
(void*)symbol_redefines(new_var),
symbol_redefines(new_var)->name);
}
@ -16832,7 +16841,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
if( new_var->data.initial )
{
new_initial = initial_from_float128(new_var, new_var->data.value);
new_initial = initial_from_float128(new_var, new_var->data.value_of());
}
if( new_initial )
{

3
gcc/cobol/genutil.cc
View file

@ -1420,6 +1420,9 @@ get_data_address( cbl_field_t *field,
}
}
// Ignore pedantic because we know 128-bit computation is not ISO C++14.
#pragma GCC diagnostic ignored "-Wpedantic"
__int128
get_power_of_ten(int n)
{

4
gcc/cobol/genutil.h
View file

@ -103,7 +103,11 @@ void get_binary_value( tree value,
tree hilo = NULL);
tree get_data_address( cbl_field_t *field,
tree offset);
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wpedantic"
__int128 get_power_of_ten(int n);
#pragma GCC diagnostic pop
void scale_by_power_of_ten_N(tree value,
int N,
bool check_for_fractional = false);

21
gcc/cobol/lexio.cc
View file

@ -1358,19 +1358,21 @@ include_file_add(const char filename[]) {
bool
preprocess_filter_add( const char input[] ) {
char filter[ strlen(input) + 1 ];
strcpy(filter, input);
char *optstr = strchr(filter, ',');
std::list <std::string> options;
std::string filter(input);
size_t pos = filter.find(",");
if( optstr ) {
if( pos != filter.npos ) {
std::vector<char> others( filter.size() - pos, '\0' );
std::copy( filter.begin() + pos + 1, filter.end(), others.begin() );
filter.resize(pos);
char *optstr = others.data();
for( char *opt = optstr + 1; (opt = strtok(opt, ",")); opt = NULL ) {
options.push_back(opt);
}
*optstr = '\0';
}
auto filename = find_filter(filter);
auto filename = find_filter(filter.c_str());
if( !filename ) {
yywarn("preprocessor '%s/%s' not found", getcwd(NULL, 0), filter);
return false;
@ -1447,9 +1449,10 @@ cdftext::lex_open( const char filename[] ) {
char *filter = filter_pair.first;
std::list<std::string>& options = filter_pair.second;
char * argv[2 + options.size()] = { filter };
std::vector <char*> argv(2 + options.size(), NULL);
argv[0] = filter;
auto last_argv = std::transform( options.begin(), options.end(), argv + 1,
auto last_argv = std::transform( options.begin(), options.end(), argv.begin() + 1,
[]( std::string& opt ) {
return xstrdup(opt.c_str());
} );
@ -1471,7 +1474,7 @@ cdftext::lex_open( const char filename[] ) {
cbl_err( "%s: could not seek to start of file", __func__);
}
int erc;
if( -1 == (erc = execv(filter, argv)) ) {
if( -1 == (erc = execv(filter, argv.data())) ) {
yywarn("could not execute %s", filter);
}
_exit(erc);

406
gcc/cobol/parse.y
View file

@ -1440,7 +1440,7 @@ program_id: PROGRAM_ID dot namestr[name] program_as program_attrs[attr] dot
dot: %empty
| '.'
;
program_as: %empty { $$ = (literal_t){}; }
program_as: %empty { static const literal_t empty {}; $$ = empty; }
| AS LITERAL { $$ = $2; }
;
@ -1856,10 +1856,10 @@ selected_name: external scalar { $$ = $2; }
YYERROR;
}
uint32_t len = $name.len;
cbl_field_t field = {
cbl_field_t field {
0, FldLiteralA, FldInvalid, quoted_e | constant_e,
0, 0, 0, nonarray, 0, "", 0, cbl_field_t::linkage_t(),
{len,len,0,0, $name.data, NULL, {NULL}, {NULL}}, NULL };
{len,len,0,0, $name.data}, NULL };
field.attr |= literal_attr($name.prefix);
$$ = new cbl_refer_t( field_add(@name, &field) );
}
@ -1885,7 +1885,7 @@ select_clauses: select_clause { $$.clauses = $1.clause; $$.file = $1.file; }
if( $$.file->nkey++ == 0 ) {
// If no key yet exists, create room for it and the
// present alternate.
assert($$.file->keys == &no_key);
assert($$.file->keys == &cbl_file_t::no_key);
$$.file->keys = new cbl_file_key_t[++$$.file->nkey];
}
{
@ -2315,10 +2315,11 @@ repo_program: PROGRAM_kw NAME repo_as
assert(program);
parent = symbol_index(symbol_elem_of(program));
// Literal field whose parent is the the aliased program.
cbl_field_t prog = { .type = FldLiteralA,
.attr = quoted_e,
.parent = parent,
.data = {.initial = $repo_as.data} };
cbl_field_t prog = {};
prog.type = FldLiteralA;
prog.attr = quoted_e;
prog.parent = parent;
prog.data.initial = $repo_as.data;
namcpy(@NAME, prog.name, $NAME);
if( ! prog.data.initial ) {
assert(program);
@ -2366,7 +2367,7 @@ special_name: dev_mnemonic
struct cbl_field_t field = { 0,
FldClass, FldInvalid, 0, 0, 0, 0, nonarray, yylineno, "",
0, cbl_field_t::linkage_t(),
{ 0,0,0,0, NULL, NULL, { NULL }, { NULL } }, NULL };
{}, NULL };
if( !namcpy(@NAME, field.name, $2) ) YYERROR;
struct cbl_domain_t *domain =
@ -2374,8 +2375,8 @@ special_name: dev_mnemonic
std::copy(domains.begin(), domains.end(), domain);
field.data.false_value = $domains;
field.data.domain = domain;
field.data.false_value_as($domains);
field.data.domain_as(domain);
domains.clear();
if( field_add(@2, &field) == NULL ) {
@ -2425,8 +2426,7 @@ is_alphabet: ARE NUMSTR
dev_mnemonic: device_name is NAME
{
cbl_special_name_t special = { .token = $1.token,
.id = $1.id };
cbl_special_name_t special = { $1.token, $1.id };
if( !namcpy(@NAME, special.name, $NAME) ) YYERROR;
const char *filename;
@ -2460,15 +2460,15 @@ dev_mnemonic: device_name is NAME
{ "ENVIRONMENT-NAME", ENV_NAME_e },
{ "ENVIRONMENT-VALUE", ENV_VALUE_e },
};
char device[ 1 + strlen($device) ];
std::transform($device, $device + strlen($device) + 1,
device, toupper);
auto p = fujitsus.find(device);
std::string device($device);
std::transform($device, $device + strlen($device),
device.begin(), toupper);
auto p = fujitsus.find(device.c_str());
if( p == fujitsus.end() ) {
error_msg(@device, "%s is not a device name");
}
cbl_special_name_t special = { .id = p->second };
cbl_special_name_t special = { 0, p->second };
if( !namcpy(@name, special.name, $name) ) YYERROR;
symbol_special_add(PROGRAM, &special);
@ -2634,12 +2634,12 @@ upsi: UPSI is NAME
if( $entry.on ) {
cbl_field_t *on = field_alloc(@NAME, FldSwitch, parent, $entry.on);
if( !on ) YYERROR;
on->data.upsi_mask = new cbl_upsi_mask_t(true, value);
on->data = new cbl_upsi_mask_t(true, value);
}
if( $entry.off ) {
cbl_field_t *off = field_alloc(@NAME, FldSwitch, parent, $entry.off);
if( !off ) YYERROR;
off->data.upsi_mask = new cbl_upsi_mask_t(false, value);
off->data = new cbl_upsi_mask_t(false, value);
}
}
| UPSI upsi_entry[entry]
@ -2651,12 +2651,12 @@ upsi: UPSI is NAME
if( $entry.on ) {
cbl_field_t *on = field_alloc($entry.loc, FldSwitch, parent, $entry.on);
if( !on ) YYERROR;
on->data.upsi_mask = new cbl_upsi_mask_t(true, value);
on->data = new cbl_upsi_mask_t(true, value);
}
if( $entry.off ) {
cbl_field_t *off = field_alloc($entry.loc, FldSwitch, parent, $entry.off);
if( !off ) YYERROR;
off->data.upsi_mask = new cbl_upsi_mask_t(false, value);
off->data = new cbl_upsi_mask_t(false, value);
}
}
;
@ -3098,9 +3098,7 @@ field: cdf
// Format data.initial per picture
if( 0 == pristine_values.count(field.data.initial) ) {
if( field.data.digits > 0 &&
field.data.value != 0.0 )
{
if( field.data.digits > 0 && field.data.value_of() != 0.0 ) {
char *initial;
int rdigits = field.data.rdigits < 0?
1 : field.data.rdigits + 1;
@ -3112,7 +3110,7 @@ field: cdf
rdigits = 0;
}
}
initial = string_of(field.data.value);
initial = string_of(field.data.value_of());
if( !initial ) {
error_msg(@1, xstrerror(errno));
YYERROR;
@ -3122,7 +3120,7 @@ field: cdf
free(const_cast<char*>($data_descr->data.initial));
$data_descr->data.initial = initial;
if( yydebug ) {
const char *value_str = string_of(field.data.value);
const char *value_str = string_of(field.data.value_of());
dbgmsg("%s::data.initial is (%%%d.%d) %s ==> '%s'",
field.name,
field.data.digits,
@ -3147,7 +3145,7 @@ occurs_clause: OCCURS cardinal_lb indexed
}
cbl_occurs_t *occurs = &current_field()->occurs;
occurs->bounds.lower =
occurs->bounds.upper = $name->data.value;
occurs->bounds.upper = $name->data.value_of();
}
;
cardinal_lb: cardinal times {
@ -3212,10 +3210,11 @@ index_fields: index_field1
;
index_field1: ctx_name[name]
{
static const cbl_field_data_t data { .capacity = 8, .digits = 0 };
cbl_field_t field = { .type = FldIndex,
.parent = field_index(current_field()),
.data = data };
static const cbl_field_data_t data { 0, 8 }; // capacity 8
cbl_field_t field = {};
field.type = FldIndex;
field.parent = field_index(current_field());
field.data = data;
if( !namcpy(@name, field.name, $name) ) YYERROR;
auto symbol = symbol_field(PROGRAM, 0, $name);
@ -3238,12 +3237,12 @@ index_field1: ctx_name[name]
level_name: LEVEL ctx_name
{
switch($LEVEL) {
case 1 ... 49:
case 66:
case 77:
case 88:
break;
default:
if( 1 <= $LEVEL && $LEVEL <= 49 ) break;
error_msg(@LEVEL, "LEVEL %d not supported", $LEVEL);
YYERROR;
}
@ -3251,7 +3250,7 @@ level_name: LEVEL ctx_name
FldInvalid, FldInvalid, 0, 0, 0, capacity_cast($1),
nonarray, yylineno, "",
0, cbl_field_t::linkage_t(),
{ 0,0,0,0, NULL, NULL, { NULL }, { NULL } }, NULL };
{}, NULL };
if( !namcpy(@ctx_name, field.name, $2) ) YYERROR;
$$ = field_add(@$, &field);
@ -3263,19 +3262,19 @@ level_name: LEVEL ctx_name
| LEVEL
{
switch($LEVEL) {
case 1 ... 49:
case 66:
case 77:
case 88:
break;
default:
if( 1 <= $LEVEL && $LEVEL <= 49 ) break;
error_msg(@LEVEL, "LEVEL %d not supported", $LEVEL);
YYERROR;
}
struct cbl_field_t field = { 0,
FldInvalid, FldInvalid, 0, 0, 0, capacity_cast($1),
nonarray, yylineno, "",
0, {}, { 0,0,0,0, NULL, NULL, { NULL }, { NULL } }, NULL };
0, {}, {}, NULL };
$$ = field_add(@1, &field);
if( !$$ ) {
@ -3307,14 +3306,15 @@ const_value: cce_expr
value78: literalism
{
cbl_field_data_t
data = { .capacity = capacity_cast(strlen($1.data)),
.initial = $1.data };
cbl_field_data_t data = {};
data.capacity = capacity_cast(strlen($1.data));
data.initial = $1.data;
$$ = new cbl_field_data_t(data);
}
| const_value
{
cbl_field_data_t data = { .value = $1 };
cbl_field_data_t data = {};
data = $1;
$$ = new cbl_field_data_t(data);
}
| true_false
@ -3343,7 +3343,7 @@ data_descr1: level_name
field.attr |= constant_e;
if( $is_global ) field.attr |= global_e;
field.type = FldLiteralN;
field.data.value = $const_value;
field.data = $const_value;
field.data.initial = string_of($const_value);
if( !cdf_value(field.name, static_cast<int64_t>($const_value)) ) {
@ -3379,9 +3379,9 @@ data_descr1: level_name
cbl_field_t& field = *$1;
field.attr |= ($is_global | constant_e);
field.data.capacity = cdfval->string ? strlen(cdfval->string)
: sizeof(field.data.value);
: sizeof(field.data.value_of());
field.data.initial = cdfval->string;
field.data.value = cdfval->number;
field.data = cdfval->number;
if( !cdf_value(field.name, *cdfval) ) {
error_msg(@1, "%s was defined by CDF", field.name);
}
@ -3404,9 +3404,9 @@ data_descr1: level_name
}
} else {
field.type = FldLiteralN;
field.data.initial = string_of(field.data.value);
field.data.initial = string_of(field.data.value_of());
if( !cdf_value(field.name,
static_cast<int64_t>(field.data.value)) ) {
static_cast<int64_t>(field.data.value_of())) ) {
yywarn("%s was defined by CDF", field.name);
}
}
@ -3421,7 +3421,7 @@ data_descr1: level_name
struct cbl_field_t field = { 0,
FldClass, FldInvalid, 0, 0, 0, 88, nonarray, yylineno, "",
0, cbl_field_t::linkage_t(),
{ 0,0,0,0, NULL, NULL, { NULL }, { NULL } }, NULL };
{}, NULL };
if( !namcpy(@NAME, field.name, $2) ) YYERROR;
auto fig = constant_of(constant_index(NULLS))->data.initial;
@ -3429,7 +3429,7 @@ data_descr1: level_name
domain[0] = cbl_domain_t(@NAME, false, strlen(fig), fig);
field.data.domain = domain;
field.data.domain_as(domain);
if( ($$ = field_add(@2, &field)) == NULL ) {
error_msg(@NAME, "failed level 88");
@ -3447,7 +3447,7 @@ data_descr1: level_name
struct cbl_field_t field = { 0,
FldClass, FldInvalid, 0, 0, 0, 88, nonarray, yylineno, "",
0, cbl_field_t::linkage_t(),
{ 0,0,0,0, NULL, NULL, { NULL }, { NULL } }, NULL };
{}, NULL };
if( !namcpy(@NAME, field.name, $2) ) YYERROR;
struct cbl_domain_t *domain =
@ -3455,8 +3455,8 @@ data_descr1: level_name
std::copy(domains.begin(), domains.end(), domain);
field.data.domain = domain;
field.data.false_value = $domains;
field.data.domain_as(domain);
field.data.false_value_as($domains);
domains.clear();
if( ($$ = field_add(@2, &field)) == NULL ) {
@ -4120,7 +4120,7 @@ count: %empty { $$ = 0; }
if( e ) { // verify not floating point with nonzero fraction
auto field = cbl_field_of(e);
assert(is_literal(field));
if( field->data.value != size_t(field->data.value) ) {
if( field->data.value_of() != size_t(field->data.value_of()) ) {
nmsg++;
error_msg(@NAME, "invalid PICTURE count '(%s)'",
field->data.initial );
@ -4324,7 +4324,7 @@ value_clause: VALUE all LITERAL[lit] {
std::replace(initial, initial + strlen(initial), '.', decimal);
field->data.initial = initial;
field->data.value = $value;
field->data = $value;
if( $all ) field_value_all(field);
}
@ -4677,11 +4677,6 @@ declaratives: %empty
} [label]
sentences END DECLARATIVES '.'
{
size_t ndecl = current.declaratives.as_list().size();
cbl_declarative_t decls[ ndecl ];
auto decl_list = current.declaratives.as_list();
std::copy( decl_list.begin(), decl_list.end(), decls );
std::sort( decls, decls + ndecl );
current.doing_declaratives(false);
/* TODO: if( intradeclarative_reference() ) yyerror;
* Test also at paragraph_reference, for non-forward
@ -5240,7 +5235,7 @@ allocate: ALLOCATE expr[size] CHARACTERS initialized RETURNING scalar[retu
{
statement_begin(@1, ALLOCATE);
if( $size->field->type == FldLiteralN ) {
if( $size->field->data.value <= 0 ) {
if( $size->field->data.value_of() <= 0 ) {
error_msg(@size, "size must be greater than 0");
YYERROR;
}
@ -5320,9 +5315,8 @@ compute_expr: '=' {
display: disp_body end_display
{
size_t len = $1.vargs->args.size();
struct cbl_refer_t args[len];
std::vector <cbl_refer_t> args($1.vargs->args.size());
std::copy( $1.vargs->args.begin(), $1.vargs->args.end(), args.begin() );
if( $1.special && $1.special->id == ARG_NUM_e ) {
if( $1.vargs->args.size() != 1 ) {
error_msg(@1, "ARGUMENT-NUMBER can be set to only one value");
@ -5331,15 +5325,16 @@ display: disp_body end_display
cbl_field_t *dst = register_find("_ARGI");
parser_move( dst, src );
} else {
parser_display($1.special, use_vargs($1.vargs, args), len,
parser_display($1.special,
args.empty()? NULL : args.data(), args.size(),
DISPLAY_ADVANCE);
}
current.declaratives_evaluate(ec_none_e);
}
| disp_body NO ADVANCING end_display
{
size_t len = $1.vargs->args.size();
struct cbl_refer_t args[len];
std::vector <cbl_refer_t> args($1.vargs->args.size());
std::copy( $1.vargs->args.begin(), $1.vargs->args.end(), args.begin() );
if( $1.special && $1.special->id == ARG_NUM_e ) {
if( $1.vargs->args.size() != 1 ) {
@ -5349,7 +5344,8 @@ display: disp_body end_display
cbl_field_t *dst = register_find("_ARGI");
parser_move( dst, src );
} else {
parser_display($1.special, use_vargs($1.vargs, args), len,
parser_display($1.special,
args.empty()? NULL : args.data(), args.size(),
DISPLAY_NO_ADVANCE);
}
current.declaratives_evaluate(ec_none_e);
@ -5676,8 +5672,8 @@ simple_cond: kind_of_name
cbl_field_t *field = cbl_field_of(symbol_find(@1, $1));
assert(field->type == FldSwitch);
cbl_field_t *parent = parent_of(field);
size_t value = field->data.upsi_mask->value;
bitop_t op = field->data.upsi_mask->on_off?
size_t value = field->data.upsi_mask_of()->value;
bitop_t op = field->data.upsi_mask_of()->on_off?
bit_on_op : bit_off_op;
parser_bitop($$->cond(), parent, op, value );
}
@ -6656,8 +6652,9 @@ move_tgt: scalar[tgt] {
const auto& field(*$1);
static char buf[32];
const char *value_str( name_of($literal) );
if( is_numeric($1) && float(field.data.value) == int(field.data.value) ) {
sprintf(buf, "%d", int(field.data.value));
if( is_numeric($1) &&
float(field.data.value_of()) == int(field.data.value_of()) ) {
sprintf(buf, "%d", int(field.data.value_of()));
value_str = buf;
}
auto litcon = field.name[0] == '_'? "literal" : "constant";
@ -7154,20 +7151,20 @@ perform: perform_verb perform_proc { perform_free(); }
perform_stmts: perform_until perform_inline[in]
{
size_t n = $in->varys.size();
struct cbl_perform_vary_t varys[n];
std::copy( $in->varys.begin(), $in->varys.end(), varys );
std::vector <cbl_perform_vary_t> varys($in->varys.size());
std::copy( $in->varys.begin(), $in->varys.end(), varys.begin() );
parser_perform_until(&$in->tgt, $in->before, n, varys);
parser_perform_until(&$in->tgt, $in->before,
varys.size(), varys.data());
}
| perform_vary perform_inline[in]
{
struct perform_t *p = $in;
size_t n = p->varys.size();
struct cbl_perform_vary_t varys[n];
std::copy( p->varys.begin(), p->varys.end(), varys );
std::vector <cbl_perform_vary_t> varys(p->varys.size());
std::copy( p->varys.begin(), p->varys.end(), varys.begin() );
parser_perform_until(&$in->tgt, $in->before, n, varys);
parser_perform_until(&$in->tgt, $in->before,
varys.size(), varys.data());
}
| perform_times perform_inline[in]
{
@ -7203,11 +7200,10 @@ perform_proc: perform_names %prec NAME
struct perform_t *p = perform_current();
if( yydebug ) p->tgt.dump();
size_t n = p->varys.size();
struct cbl_perform_vary_t varys[n];
std::copy( p->varys.begin(), p->varys.end(), varys );
std::vector <cbl_perform_vary_t> varys(p->varys.size());
std::copy( p->varys.begin(), p->varys.end(), varys.begin() );
parser_perform_until( &p->tgt, p->before, n, varys );
parser_perform_until( &p->tgt, p->before, varys.size(), varys.data() );
}
;
@ -8183,15 +8179,9 @@ merge: MERGE { statement_begin(@1, MERGE); }
filename[file] sort_keys sort_seq
USING filenames[inputs] sort_output
{
size_t nkey = $sort_keys->key_list.size();
cbl_key_t keys[nkey], *pkey = keys;
for( auto p = $sort_keys->key_list.begin();
p != $sort_keys->key_list.end(); p++, pkey++ )
{
cbl_key_t k(*p);
*pkey = k;
}
std::vector <cbl_key_t> keys($sort_keys->key_list.size());
std::copy( $sort_keys->key_list.begin(),
$sort_keys->key_list.end(), keys.begin() );
size_t ninput = $inputs->files.size();
size_t noutput = $sort_output->nfile();
@ -8211,7 +8201,7 @@ merge: MERGE { statement_begin(@1, MERGE); }
}
parser_file_merge( $file, $sort_seq,
nkey, keys,
keys.size(), keys.empty()? NULL : keys.data(),
ninput, inputs,
noutput, outputs,
out_proc );
@ -8379,7 +8369,7 @@ set: SET set_tgts[tgts] TO set_operand[src]
public:
set_conditional( int token ) : tf(token == TRUE_kw) {}
void operator()(cbl_refer_t& refer) {
if( refer.field->data.false_value == NULL && !tf ) {
if( refer.field->data.false_value_of() == NULL && !tf ) {
auto loc = symbol_field_location(field_index(refer.field));
error_msg(loc, "%s has no WHEN SET TO FALSE",
refer.field->name);
@ -8407,7 +8397,7 @@ set_switches: switches TO on_off
assert(sw->type == FldSwitch);
assert(sw->data.initial); // not a switch condition
parser_bitop(NULL, parent_of(sw),
op, sw->data.upsi_mask_of());
op, sw->data.upsi_mask_derive());
return *this;
}
};
@ -8574,21 +8564,22 @@ sort: sort_table
sort_table: SORT tableref[table] sort_keys sort_dup sort_seq {
statement_begin(@1, SORT);
size_t nkey = $sort_keys->key_list.size();
cbl_key_t keys[nkey], *pkey = keys;
std::vector <cbl_key_t> keys($sort_keys->key_list.size());
if( ! is_table($table->field) ) {
error_msg(@1, "%s has no OCCURS clause", $table->field->name);
}
// 23) If data-name-1 is omitted, the data item referenced by
// data-name-2 is the key data item.
int i = 0;
for( auto k : $sort_keys->key_list ) {
if( k.fields.empty() ) {
k.fields.push_back($table->field);
}
*pkey++ = cbl_key_t(k);
keys.at(i++) = cbl_key_t(k);
}
parser_sort( *$table, $sort_dup, $sort_seq, nkey, keys );
parser_sort( *$table, $sort_dup, $sort_seq,
keys.size(), keys.empty()? NULL : keys.data() );
}
| SORT tableref[table] sort_dup sort_seq {
statement_begin(@1, SORT);
@ -8614,15 +8605,9 @@ sort_file: SORT FILENAME[file] sort_keys sort_dup sort_seq
YYERROR;
}
cbl_file_t *file = cbl_file_of(e);
size_t nkey = $sort_keys->key_list.size();
cbl_key_t keys[nkey], *pkey = keys;
for( auto p = $sort_keys->key_list.begin();
p != $sort_keys->key_list.end(); p++, pkey++ )
{
cbl_key_t k(*p);
*pkey = k;
}
std::vector <cbl_key_t> keys($sort_keys->key_list.size());
std::copy( $sort_keys->key_list.begin(),
$sort_keys->key_list.end(), keys.begin() );
size_t ninput = $sort_input->nfile();
size_t noutput = $sort_output->nfile();
@ -8647,7 +8632,7 @@ sort_file: SORT FILENAME[file] sort_keys sort_dup sort_seq
parser_file_sort( file,
$sort_dup,
$sort_seq,
nkey, keys,
keys.size(), keys.empty()? NULL : keys.data(),
ninput, inputs,
noutput, outputs,
in_proc, out_proc );
@ -9241,9 +9226,12 @@ call_impl: CALL call_body[body]
ffi_args_t *params = $body.using_params;
if( yydebug && params ) params->dump();
size_t narg = params? params->elems.size() : 0;
cbl_ffi_arg_t args[1 + narg], *pargs = NULL;
std::vector <cbl_ffi_arg_t> args(narg);
cbl_ffi_arg_t *pargs = NULL;
if( narg > 0 ) {
pargs = use_list(params, args);
std::copy( params->elems.begin(),
params->elems.end(), args.begin() );
pargs = args.data();
}
ast_call( $body.loc, *$body.ffi_name,
*$body.ffi_returning, narg, pargs, NULL, NULL, false );
@ -9255,9 +9243,12 @@ call_cond: CALL call_body[body] call_excepts[except]
ffi_args_t *params = $body.using_params;
if( yydebug && params ) params->dump();
size_t narg = params? params->elems.size() : 0;
cbl_ffi_arg_t args[1 + narg], *pargs = NULL;
std::vector <cbl_ffi_arg_t> args(narg);
cbl_ffi_arg_t *pargs = NULL;
if( narg > 0 ) {
pargs = use_list(params, args);
std::copy( params->elems.begin(),
params->elems.end(), args.begin() );
pargs = args.data();
}
ast_call( $body.loc, *$body.ffi_name,
*$body.ffi_returning, narg, pargs,
@ -9315,9 +9306,12 @@ entry: ENTRY LITERAL
auto name = new_literal($2, quoted_e);
ffi_args_t *params = $parameters;
size_t narg = params? params->elems.size() : 0;
cbl_ffi_arg_t args[1 + narg], *pargs = NULL;
cbl_ffi_arg_t *pargs = NULL;
std::vector <cbl_ffi_arg_t> args(narg);
if( narg > 0 ) {
pargs = use_list(params, args);
std::copy( params->elems.begin(),
params->elems.end(), args.begin() );
pargs = args.data();
}
parser_entry( name, narg, pargs );
}
@ -9477,9 +9471,10 @@ call_except: EXCEPTION
cancel: CANCEL ffi_names
{
statement_begin(@1, CANCEL);
auto nprog = $ffi_names->refers.size();
cbl_refer_t progs[nprog];
parser_initialize_programs(nprog, $ffi_names->use_list(progs));
std::vector <cbl_refer_t> progs($ffi_names->refers.size());
std::copy( $ffi_names->refers.begin(),
$ffi_names->refers.end(), progs.begin() );
parser_initialize_programs( progs.size(), progs.empty()? NULL : progs.data() );
}
;
ffi_names: ffi_name { $$ = new refer_list_t($1); }
@ -9520,19 +9515,19 @@ go_to: GOTO labels[args]
for( auto& label : $args->elems ) {
label->used = yylineno;
}
cbl_label_t *args[narg];
parser_goto( cbl_refer_t(), 1, use_list($args, args) );
cbl_label_t *arg = $args->elems.front();
parser_goto( cbl_refer_t(), 1, &arg );
}
| GOTO labels[args] DEPENDING on scalar[value]
{
statement_begin(@1, GOTO);
size_t narg = $args->elems.size();
assert(narg > 0);
assert(! $args->elems.empty());
std::vector <cbl_label_t *> args($args->elems.size());
std::copy($args->elems.begin(), $args->elems.end(), args.begin());
for( auto& label : $args->elems ) {
label->used = yylineno;
}
cbl_label_t *args[narg];
parser_goto( *$value, narg, use_list($args, args) );
parser_goto( *$value, args.size(), args.data() );
}
| GOTO
{
@ -9889,11 +9884,10 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' {
YYERROR;
}
$$ = new_temporary_clone(cbl_field_of(symbol_at(L->returning)));
auto narg = $args->refers.size();
cbl_ffi_arg_t args[narg];
std::vector <cbl_ffi_arg_t> args($args->refers.size());
size_t i = 0;
// Pass parameters as defined by the function.
std::transform( $args->refers.begin(), $args->refers.end(), args,
std::transform( $args->refers.begin(), $args->refers.end(), args.begin(),
[params, &i]( cbl_refer_t& arg ) {
function_descr_arg_t param = params.at(i++);
auto ar = new cbl_refer_t(arg);
@ -9901,7 +9895,7 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' {
return actual;
} );
auto name = new_literal(strlen(L->name), L->name, quoted_e);
ast_call( @1, name, $$, narg, args, NULL, NULL, true );
ast_call( @1, name, $$, args.size(), args.data(), NULL, NULL, true );
}
| FUNCTION_UDF_0 {
static const size_t narg = 0;
@ -9935,23 +9929,24 @@ intrinsic: function_udf
| intrinsic0
| intrinsic_v '(' arg_list[args] ')' {
location_set(@1);
size_t n = $args->size();
assert(n > 0);
cbl_refer_t args[n];
std::copy( $args->begin(), $args->end(), args );
cbl_refer_t *p = intrinsic_inconsistent_parameter(n, args);
std::vector <cbl_refer_t> args($args->size());
assert(! args.empty());
std::copy( $args->begin(), $args->end(), args.begin() );
cbl_refer_t *p = intrinsic_inconsistent_parameter(args.size(),
args.data());
if( p != NULL ) {
auto loc = symbol_field_location(field_index(p->field));
error_msg(loc, "FUNCTION %s has "
"inconsistent parameter type %zu ('%s')",
keyword_str($1), p - args, name_of(p->field) );
keyword_str($1), p - args.data(), name_of(p->field) );
YYERROR;
}
$$ = is_numeric(args[0].field)?
new_tempnumeric_float() :
new_alphanumeric(args[0].field->data.capacity);
parser_intrinsic_callv( $$, intrinsic_cname($1), n, args );
parser_intrinsic_callv( $$, intrinsic_cname($1),
args.size(), args.data() );
}
| PRESENT_VALUE '(' expr_list[args] ')'
@ -9965,8 +9960,9 @@ intrinsic: function_udf
error_msg(@args, "PRESENT VALUE requires 2 parameters");
YYERROR;
}
cbl_refer_t args[n];
parser_intrinsic_callv( $$, s, n, $args->use_list(args) );
std::vector <cbl_refer_t> args(n);
std::copy( $args->begin(), $args->end(), args.begin() );
parser_intrinsic_callv( $$, s, args.size(), args.data() );
}
| BASECONVERT '(' varg[r1] varg[r2] varg[r3] ')' {
@ -10206,9 +10202,8 @@ intrinsic: function_udf
| SUBSTITUTE '(' varg[r1] subst_inputs[inputs] ')' {
location_set(@1);
$$ = new_alphanumeric(64);
auto narg = $inputs->size();
cbl_substitute_t args[narg];
std::transform( $inputs->begin(), $inputs->end(), args,
std::vector <cbl_substitute_t> args($inputs->size());
std::transform( $inputs->begin(), $inputs->end(), args.begin(),
[]( const substitution_t& arg ) {
cbl_substitute_t output( arg.anycase,
char(arg.first_last),
@ -10216,7 +10211,7 @@ intrinsic: function_udf
arg.replacement );
return output; } );
parser_intrinsic_subst($$, *$r1, narg, args);
parser_intrinsic_subst($$, *$r1, args.size(), args.data());
}
@ -10902,9 +10897,8 @@ cdf_use: USE DEBUGGING on labels
YYERROR;
}
static const cbl_label_t all = {
.type = LblNone,
.name = { ':', 'a', 'l', 'l', ':', } // workaround for gcc < 11.3
};
LblNone, 0, 0,0,0, false, false, false, 0,0, ":all:" };
////.name = { ':', 'a', 'l', 'l', ':', } // workaround for gcc < 11.3
add_debugging_declarative(&all);
}
@ -11044,8 +11038,7 @@ void ast_call( const YYLTYPE& loc, cbl_refer_t name, cbl_refer_t returning,
if( is_literal(name.field) ) {
cbl_field_t called = { 0, FldLiteralA, FldInvalid, quoted_e | constant_e,
0, 0, 77, nonarray, 0, "",
0, cbl_field_t::linkage_t(),
{0,0,0,0, NULL, NULL, {NULL}, {NULL}}, NULL };
0, cbl_field_t::linkage_t(), {}, NULL };
snprintf(called.name, sizeof(called.name), "_%s", name.field->data.initial);
called.data = name.field->data;
name.field = cbl_field_of(symbol_field_add(PROGRAM, &called));
@ -11279,11 +11272,10 @@ classify_of( int token ) {
static cbl_round_t
rounded_of( int token ) {
cbl_round_t mode = current_rounded_mode();
if( 0 <= token && token <= int(truncation_e) ) {
return cbl_round_t(token);
}
switch(token) {
case 0 ... int(truncation_e):
mode = cbl_round_t(token);
break;
case ROUNDED:
mode = current.rounded_mode();
break;
@ -11594,7 +11586,8 @@ int repository_function_tok( const char name[] ) {
function_descr_t
function_descr_t::init( int isym ) {
function_descr_t descr = { .token = FUNCTION_UDF_0, .ret_type = FldInvalid };
function_descr_t descr = { FUNCTION_UDF_0 };
descr.ret_type = FldInvalid;
auto L = cbl_label_of(symbol_at(isym));
bool ok = namcpy(YYLTYPE(), descr.name, L->name);
gcc_assert(ok);
@ -11653,8 +11646,10 @@ ast_op( cbl_refer_t *lhs, char op, cbl_refer_t *rhs ) {
static void
ast_add( arith_t *arith ) {
size_t nC = arith->tgts.size(), nA = arith->A.size();
cbl_num_result_t *pC, C[nC];
cbl_refer_t *pA, A[nA];
std::vector <cbl_num_result_t> C(nC);
cbl_num_result_t *pC;
std::vector <cbl_refer_t> A(nA);
cbl_refer_t *pA;
pC = use_any(arith->tgts, C);
pA = use_any(arith->A, A);
@ -11672,12 +11667,13 @@ ast_add( arith_t *arith ) {
static bool
ast_subtract( arith_t *arith ) {
size_t nC = arith->tgts.size(), nA = arith->A.size(), nB = arith->B.size();
cbl_num_result_t *pC, C[nC];
cbl_refer_t *pA, A[nA], *pB, B[nB];
std::vector <cbl_refer_t> A(nA);
std::vector <cbl_refer_t> B(nB);
std::vector <cbl_num_result_t> C(nC);
pC = use_any(arith->tgts, C);
pA = use_any(arith->A, A);
pB = use_any(arith->B, B);
cbl_refer_t *pA = use_any(arith->A, A);
cbl_refer_t *pB = use_any(arith->B, B);
cbl_num_result_t *pC = use_any(arith->tgts, C);
parser_subtract( nC, pC, nA, pA, nB, pB, arith->format, arith->on_error, arith->not_error );
@ -11689,12 +11685,13 @@ ast_subtract( arith_t *arith ) {
static bool
ast_multiply( arith_t *arith ) {
size_t nC = arith->tgts.size(), nA = arith->A.size(), nB = arith->B.size();
cbl_num_result_t *pC, C[nC];
cbl_refer_t *pA, A[nA], *pB, B[nB];
std::vector <cbl_refer_t> A(nA);
std::vector <cbl_refer_t> B(nB);
std::vector <cbl_num_result_t> C(nC);
pC = use_any(arith->tgts, C);
pA = use_any(arith->A, A);
pB = use_any(arith->B, B);
cbl_refer_t *pA = use_any(arith->A, A);
cbl_refer_t *pB = use_any(arith->B, B);
cbl_num_result_t *pC = use_any(arith->tgts, C);
parser_multiply( nC, pC, nA, pA, nB, pB, arith->on_error, arith->not_error );
@ -11706,12 +11703,13 @@ ast_multiply( arith_t *arith ) {
static bool
ast_divide( arith_t *arith ) {
size_t nC = arith->tgts.size(), nA = arith->A.size(), nB = arith->B.size();
cbl_num_result_t *pC, C[nC];
cbl_refer_t *pA, A[nA], *pB, B[nB];
std::vector <cbl_refer_t> A(nA);
std::vector <cbl_refer_t> B(nB);
std::vector <cbl_num_result_t> C(nC);
pC = use_any(arith->tgts, C);
pA = use_any(arith->A, A);
pB = use_any(arith->B, B);
cbl_refer_t *pA = use_any(arith->A, A);
cbl_refer_t *pB = use_any(arith->B, B);
cbl_num_result_t *pC = use_any(arith->tgts, C);
parser_divide( nC, pC, nA, pA, nB, pB,
arith->remainder, arith->on_error, arith->not_error );
@ -11754,18 +11752,17 @@ stringify( refer_collection_t *inputs,
cbl_label_t *on_error,
cbl_label_t *not_error )
{
size_t n = inputs->lists.size();
stringify_src_t sources[n];
std::vector <stringify_src_t> sources(inputs->lists.size());
if( inputs->lists.back().marker == NULL ) {
inputs->lists.back().marker = cbl_refer_t::empty();
}
assert( inputs->lists.back().marker );
std::copy( inputs->lists.begin(), inputs->lists.end(), sources );
if( getenv(__func__) ) {
std::for_each(sources, sources+n, stringify_src_t::dump);
std::copy( inputs->lists.begin(), inputs->lists.end(), sources.begin() );
if( yydebug && getenv(__func__) ) {
std::for_each(sources.begin(), sources.end(), stringify_src_t::dump);
}
parser_string( into, pointer, n, sources, on_error, not_error );
parser_string( into, pointer, sources.size(), sources.data(), on_error, not_error );
}
void
@ -11776,26 +11773,26 @@ unstringify( cbl_refer_t& src,
cbl_label_t *not_error )
{
size_t ndelimited = delimited? delimited->size() : 0;
cbl_refer_t delimiteds[1 + ndelimited], *pdelimited = NULL;
cbl_refer_t *pdelimited = NULL;
std::vector <cbl_refer_t> delimiteds(ndelimited);
if( ndelimited > 0 ) {
pdelimited = delimited->use_list( delimiteds );
pdelimited = use_any( delimited->refers, delimiteds );
}
size_t noutput = into->size();
cbl_refer_t outputs[noutput];
std::vector <cbl_refer_t> outputs(into->size());
into->use_list( outputs, unstring_tgt_t::tgt_of );
cbl_refer_t delimiters[noutput];
std::vector <cbl_refer_t> delimiters(into->size());
into->use_list( delimiters, unstring_tgt_t::delimiter_of );
cbl_refer_t counts[noutput];
std::vector <cbl_refer_t> counts(into->size());
into->use_list( counts, unstring_tgt_t::count_of );
parser_unstring( src,
ndelimited, pdelimited,
// into
noutput,
outputs, delimiters, counts,
outputs.size(),
outputs.data(), delimiters.data(), counts.data(),
into->pointer, into->tally,
on_error, not_error );
delete into;
@ -12331,10 +12328,9 @@ initialize_table( cbl_num_result_t target,
assert( 0 < n );
size_t isym( field_index(src.field) );
size_t ntbl = subtables.size();
cbl_subtable_t tbls[ntbl], *ptbls = 0 < ntbl? tbls : NULL;
std::copy( subtables.begin(), subtables.end(), tbls );
parser_initialize_table( n, src, nspan, spans, isym, ntbl, ptbls );
std::vector <cbl_subtable_t> tbls(subtables.size());
std::copy( subtables.begin(), subtables.end(), tbls.begin() );
parser_initialize_table( n, src, nspan, spans, isym, tbls.size(), tbls.data() );
return true;
}
@ -12343,7 +12339,7 @@ synthesize_table_refer( cbl_refer_t tgt ) {
// For a table, use supplied subscripts or start with 1.
auto ndim( dimensions(tgt.field) );
if( tgt.nsubscript < ndim ) { // it's an incomplete table
cbl_refer_t subscripts[ndim];
std::vector <cbl_refer_t> subscripts(ndim);
for( size_t i=0; i < ndim; i++ ) {
if( i < tgt.nsubscript ) {
subscripts[i] = tgt.subscripts[i];
@ -12352,7 +12348,7 @@ synthesize_table_refer( cbl_refer_t tgt ) {
subscripts[i].field = new_tempnumeric();
parser_set_numeric(subscripts[i].field, 1);
}
return cbl_refer_t( tgt.field, ndim, subscripts );
return cbl_refer_t( tgt.field, subscripts.size(), subscripts.data() );
}
return tgt;
}
@ -12444,11 +12440,11 @@ initialize_statement( const cbl_num_result_t& target, bool with_filler,
field_spans.push_back(span);
}
// convert field spans to byte ranges
cbl_bytespan_t ranges[ field_spans.size() ];
std::vector <cbl_bytespan_t> ranges( field_spans.size() );
size_t nrange = 0;
if( honor_filler ) {
nrange = COUNT_OF(ranges);
std::transform( field_spans.begin(), field_spans.end(), ranges,
nrange = ranges.size();
std::transform( field_spans.begin(), field_spans.end(), ranges.begin(),
[]( const auto& span ) {
size_t first, second;
first = second = group_offset(span.first);
@ -12466,9 +12462,9 @@ initialize_statement( const cbl_num_result_t& target, bool with_filler,
}
if( getenv("initialize_statement") ) {
dump_spans( field_index(output.refer.field), output.refer.field,
field_spans, nrange, ranges, depth, subtables );
field_spans, ranges.size(), ranges.data(), depth, subtables );
}
return initialize_table( output, nrange, ranges, subtables );
return initialize_table( output, nrange, ranges.data(), subtables );
}
}
return fOK;
@ -12779,8 +12775,8 @@ cbl_field_t::has_subordinate( const cbl_field_t *that ) const {
bool
cbl_field_t::value_set( _Float128 value ) {
data.value = value;
char *initial = string_of(data.value);
data = value;
char *initial = string_of(data.value_of());
if( !initial ) return false;
// Trim trailing zeros.
@ -12801,7 +12797,9 @@ cbl_field_t::value_set( _Float128 value ) {
const char *
cbl_field_t::value_str() const {
return string_of(data.value);
if( data.etc_type == cbl_field_data_t::value_e )
return string_of( data.value_of() );
return "???";
}
static const cbl_division_t not_syntax_only = cbl_division_t(-1);
@ -12857,7 +12855,7 @@ literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ) {
if( ! is_literal(refmod.from->field) ) {
if( ! refmod.len ) return true;
if( ! is_literal(refmod.len->field) ) return true;
auto edge = refmod.len->field->data.value;
auto edge = refmod.len->field->data.value_of();
if( 0 < edge ) {
if( --edge < r.field->data.capacity ) return true;
}
@ -12866,18 +12864,18 @@ literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ) {
"size is %u",
r.field->name,
refmod.from->name(),
size_t(refmod.len->field->data.value),
size_t(refmod.len->field->data.value_of()),
static_cast<unsigned int>(r.field->data.capacity) );
return false;
}
if( refmod.from->field->data.value > 0 ) {
auto edge = refmod.from->field->data.value;
if( refmod.from->field->data.value_of() > 0 ) {
auto edge = refmod.from->field->data.value_of();
if( --edge < r.field->data.capacity ) {
if( ! refmod.len ) return true;
if( ! is_literal(refmod.len->field) ) return true;
if( refmod.len->field->data.value > 0 ) {
edge += refmod.len->field->data.value;
if( refmod.len->field->data.value_of() > 0 ) {
edge += refmod.len->field->data.value_of();
if( --edge < r.field->data.capacity ) return true;
}
// len < 0 or not: 0 < from + len <= capacity
@ -12885,8 +12883,8 @@ literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ) {
error_msg(loc, "%s(%zu:%zu) out of bounds, "
"size is %u",
r.field->name,
size_t(refmod.from->field->data.value),
size_t(refmod.len->field->data.value),
size_t(refmod.from->field->data.value_of()),
size_t(refmod.len->field->data.value_of()),
static_cast<unsigned int>(r.field->data.capacity) );
return false;
}
@ -12894,7 +12892,7 @@ literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ) {
// not: 0 < from <= capacity
error_msg(loc,"%s(%zu) out of bounds, size is %u",
r.field->name,
size_t(refmod.from->field->data.value),
size_t(refmod.from->field->data.value_of()),
static_cast<unsigned int>(r.field->data.capacity) );
return false;
}
@ -12986,7 +12984,7 @@ eval_subject_t::eval_subject_t()
cbl_label_t *
eval_subject_t::label( const char skel[] ) {
static const cbl_label_t protolabel = { .type = LblEvaluate };
static const cbl_label_t protolabel = { LblEvaluate };
cbl_label_t label = protolabel;
label.line = yylineno;
size_t n = 1 + symbols_end() - symbols_begin();

79
gcc/cobol/parse_ante.h
View file

@ -111,10 +111,10 @@ extern int yydebug;
const char *
consistent_encoding_check( const YYLTYPE& loc, const char input[] ) {
cbl_field_t faux = {
.type = FldAlphanumeric,
.data = { .capacity = capacity_cast(strlen(input)), .initial = input }
};
cbl_field_t faux = {};
faux.type = FldAlphanumeric;
faux.data.capacity = capacity_cast(strlen(input));
faux.data.initial = input;
auto s = faux.internalize();
if( !s ) {
@ -320,7 +320,7 @@ struct evaluate_elem_t {
, result( keep_temporary(FldConditional) )
, pcase( cases.end() )
{
static const cbl_label_t protolabel = { .type = LblEvaluate };
static const cbl_label_t protolabel = { LblEvaluate };
label = protolabel;
label.line = yylineno;
if( -1 == snprintf(label.name, sizeof(label.name),
@ -577,6 +577,15 @@ static T* use_any( list<T>& src, T *tgt) {
return tgt;
}
template <typename T>
static T* use_any( list<T>& src, std::vector<T>& tgt) {
if( src.empty() ) return NULL;
std::copy(src.begin(), src.end(), tgt.begin());
src.clear();
return tgt.data();
}
class evaluate_t;
/*
@ -1251,10 +1260,10 @@ struct unstring_tgt_list_t {
size_t size() const { return unstring_tgts.size(); }
typedef cbl_refer_t xform_t( const unstring_tgt_t& that );
void use_list( cbl_refer_t *output, xform_t func ) {
void use_list( std::vector<cbl_refer_t>& output, xform_t func ) {
std::transform( unstring_tgts.begin(),
unstring_tgts.end(),
output, func );
output.begin(), func );
}
};
@ -1977,14 +1986,13 @@ static class current_t {
bool common, bool initial )
{
size_t parent = programs.empty()? 0 : programs.top().program_index;
cbl_label_t label = {
.type = type,
.parent = parent,
.line = yylineno,
.common = common,
.initial = initial,
.os_name = os_name
};
cbl_label_t label = {};
label.type = type;
label.parent = parent;
label.line = yylineno;
label.common = common;
label.initial = initial;
label.os_name = os_name;
if( !namcpy(loc, label.name, name) ) { gcc_unreachable(); }
const cbl_label_t *L;
@ -2963,19 +2971,19 @@ value_encoding_check( const YYLTYPE& loc, cbl_field_t *field ) {
static struct cbl_field_t *
field_alloc( const YYLTYPE& loc, cbl_field_type_t type, size_t parent, const char name[] ) {
cbl_field_t *f, field = { .type = type, .usage = FldInvalid,
.parent = parent, .line = yylineno };
cbl_field_t *f, field = {};
field.type = type;
field.usage = FldInvalid;
field.parent = parent;
field.line = yylineno;
if( !namcpy(loc, field.name, name) ) return NULL;
f = field_add(loc, &field);
assert(f);
return f;
}
static cbl_file_key_t no_key;
static const struct
cbl_file_t protofile = { .org = file_disorganized_e,
.access = file_access_seq_e,
.keys = &no_key };
static const cbl_file_t protofile;
// Add a file to the symbol table with its record area field.
// The default organization is sequential.
@ -2984,10 +2992,8 @@ cbl_file_t protofile = { .org = file_disorganized_e,
static cbl_file_t *
file_add( YYLTYPE loc, cbl_file_t *file ) {
gcc_assert(file);
struct cbl_field_t area = { .type = FldAlphanumeric,
.level = 1,
.line = yylineno,
.data = { .capacity = 0 } },
enum { level = 1 };
struct cbl_field_t area = { 0, FldAlphanumeric, FldInvalid, 0, 0,0, level, {}, yylineno },
*field = field_add(loc, &area);
file->default_record = field_index(field);
@ -3108,10 +3114,10 @@ parser_move_carefully( const char */*F*/, int /*L*/,
}
}
size_t ntgt = tgt_list->targets.size();
cbl_refer_t tgts[ntgt];
std::transform( tgt_list->targets.begin(), tgt_list->targets.end(), tgts,
std::vector <cbl_refer_t> tgts(ntgt);
std::transform( tgt_list->targets.begin(), tgt_list->targets.end(), tgts.begin(),
[]( const cbl_num_result_t& res ) { return res.refer; } );
parser_move(ntgt, tgts, src);
parser_move(ntgt, tgts.data(), src);
delete tgt_list;
return true;
}
@ -3125,15 +3131,12 @@ ast_set_pointers( const list<cbl_num_result_t>& tgts, cbl_refer_t src ) {
assert(!tgts.empty());
assert(src.field || src.prog_func);
size_t nptr = tgts.size();
cbl_refer_t ptrs[nptr];
std::vector <cbl_refer_t> ptrs(nptr);
std::transform( tgts.begin(), tgts.end(), ptrs, cbl_num_result_t::refer_of );
parser_set_pointers(nptr, ptrs, src);
std::transform( tgts.begin(), tgts.end(), ptrs.begin(), cbl_num_result_t::refer_of );
parser_set_pointers(nptr, ptrs.data(), src);
}
static struct cbl_refer_t *
use_vargs( struct vargs_t *v, struct cbl_refer_t *tgt);
void
stringify( refer_collection_t *inputs,
cbl_refer_t into, cbl_refer_t pointer,
@ -3300,9 +3303,11 @@ procedure_division_ready( YYLTYPE loc, cbl_field_t *returning, ffi_args_t *ffi_a
// Start the Procedure Division.
size_t narg = ffi_args? ffi_args->elems.size() : 0;
cbl_ffi_arg_t args[1 + narg], *pargs = NULL;
std::vector <cbl_ffi_arg_t> args(narg);
cbl_ffi_arg_t*pargs = NULL;
if( narg > 0 ) {
pargs = use_list(ffi_args, args);
std::copy(ffi_args->elems.begin(), ffi_args->elems.end(), args.begin());
pargs = args.data();
}
// Create program initialization section. We build it on an island,

2
gcc/cobol/show_parse.h
View file

@ -170,7 +170,7 @@ extern bool cursor_at_sol;
} \
else \
{ \
fprintf(stderr, " %p:%s (%s)", b, b->name, b->type_str()); \
fprintf(stderr, " %p:%s (%s)", (void*)b, b->name, b->type_str()); \
} \
show_parse_sol = false; \
} while(0);

268
gcc/cobol/symbols.cc
View file

@ -84,9 +84,13 @@ static struct symbol_table_t {
int fd;
size_t capacity, nelem;
size_t first_program, procedures;
struct {
struct registers_t {
size_t file_status, linage_counter, return_code,
exception_condition, very_true, very_false;
registers_t() {
file_status = linage_counter = return_code =
exception_condition = very_true = very_false = 0;
}
} registers;
struct symbol_elem_t *elems;
@ -96,6 +100,12 @@ static struct symbol_table_t {
std::vector<symbol_pair_t> mappings;
symbol_table_t()
: fd(-1)
, capacity(0), nelem(0), first_program(0), procedures(0)
, elems(NULL)
{}
/*
* To compute an offset into the symbol table from an element
* pointer, first search the mappings to determine which one it
@ -117,7 +127,7 @@ static struct symbol_table_t {
const char *name = cbl_label_of(e)->name;
labels[ elem_key_t(e->program, name) ].push_back( symbol_index(e) );
}
} symbols { .fd = -1 };
} symbols;
static symbol_table_t&
symbol_table_extend() {
@ -286,14 +296,14 @@ static const struct cbl_field_t empty_float = {
intermediate_e,
0, 0, 0, nonarray, 0, "",
0, cbl_field_t::linkage_t(),
{16, 16, 32, 0, NULL, NULL, {NULL}, {NULL}}, NULL };
{16, 16, 32, 0, NULL}, NULL };
static const struct cbl_field_t empty_comp5 = {
0, FldNumericBin5, FldInvalid,
signable_e | intermediate_e,
0, 0, 0, nonarray, 0, "",
0, cbl_field_t::linkage_t(),
{16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL, NULL, {NULL}, {NULL}}, NULL };
{16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL}, NULL };
#if 0
# define CONSTANT_E constant_e
@ -305,13 +315,13 @@ static struct cbl_field_t empty_literal = {
0, FldInvalid, FldInvalid, CONSTANT_E,
0, 0, 0, nonarray, 0, "",
0, cbl_field_t::linkage_t(),
{0,0,0,0, NULL, NULL, {NULL}, {NULL}}, NULL };
{}, NULL };
static const struct cbl_field_t empty_conditional = {
0, FldConditional, FldInvalid, intermediate_e,
0, 0, 0, nonarray, 0, "",
0, cbl_field_t::linkage_t(),
{0,0,0,0, NULL, NULL, {NULL}, {NULL}}, NULL };
{}, NULL };
/**
@ -332,29 +342,29 @@ static const struct cbl_field_t empty_conditional = {
static cbl_field_t debug_registers[] = {
{ 0, FldGroup, FldInvalid, global_e, 0,0,1, nonarray, 0,
"DEBUG-ITEM", 0, {}, {132,132,0,0, NULL, NULL, {NULL}, {NULL}}, NULL },
"DEBUG-ITEM", 0, {}, {132,132,0,0, NULL}, NULL },
{ 0, FldAlphanumeric, FldInvalid, global_e, 0,0,2, nonarray, 0,
"DEBUG-LINE", 0, {}, {6,6,0,0, " ", NULL, {NULL}, {NULL}}, NULL },
"DEBUG-LINE", 0, {}, {6,6,0,0, " "}, NULL },
{ 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
"FILLER", 0, {}, {1,1,0,0, " ", NULL, {NULL}, {NULL}}, NULL },
"FILLER", 0, {}, {1,1,0,0, " "}, NULL },
{ 0, FldAlphanumeric, FldInvalid, global_e, 0,0,2, nonarray, 0,
"DEBUG-NAME", 0, {}, {30,30,0,0, NULL, NULL, {NULL}, {NULL}}, NULL },
"DEBUG-NAME", 0, {}, {30,30,0,0, NULL}, NULL },
{ 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
"FILLER", 0, {}, {1,1,0,0, " ", NULL, {NULL}, {NULL}}, NULL },
"FILLER", 0, {}, {1,1,0,0, " "}, NULL },
{ 0, FldNumericDisplay, FldInvalid, signable_e | global_e | leading_e | separate_e, 0,0,2, nonarray, 0,
"DEBUG-SUB-1", 0, {}, {5,5,3,0, NULL, NULL, {NULL}, {NULL}}, NULL },
"DEBUG-SUB-1", 0, {}, {5,5,3,0, NULL}, NULL },
{ 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
"FILLER", 0, {}, {1,1,0,0, " ", NULL, {NULL}, {NULL}}, NULL },
"FILLER", 0, {}, {1,1,0,0, " "}, NULL },
{ 0, FldNumericDisplay, FldInvalid, signable_e | global_e | leading_e | separate_e, 0,0,2, nonarray, 0,
"DEBUG-SUB-2", 0, {}, {5,5,3,0, NULL, NULL, {NULL}, {NULL}}, NULL },
"DEBUG-SUB-2", 0, {}, {5,5,3,0, NULL}, NULL },
{ 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
"FILLER", 0, {}, {1,1,0,0, " ", NULL, {NULL}, {NULL}}, NULL },
"FILLER", 0, {}, {1,1,0,0, " "}, NULL },
{ 0, FldNumericDisplay, FldInvalid, signable_e | global_e | leading_e | separate_e, 0,0,2, nonarray, 0,
"DEBUG-SUB-3", 0, {}, {5,5,3,0, NULL, NULL, {NULL}, {NULL}}, NULL },
"DEBUG-SUB-3", 0, {}, {5,5,3,0, NULL}, NULL },
{ 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
"FILLER", 0, {}, {1,1,0,0, " ", NULL, {NULL}, {NULL}}, NULL },
"FILLER", 0, {}, {1,1,0,0, " "}, NULL },
{ 0, FldAlphanumeric, FldInvalid, signable_e | global_e, 0,0,2, nonarray, 0,
"DEBUG-CONTENTS", 0, {}, {76,76,0,0, NULL, NULL, {NULL}, {NULL}}, NULL },
"DEBUG-CONTENTS", 0, {}, {76,76,0,0, NULL}, NULL },
};
class group_size_t {
@ -372,28 +382,29 @@ enum { constq = constant_e | quoted_e };
static cbl_field_t special_registers[] = {
{ 0, FldNumericDisplay, FldInvalid, 0, 0, 0, 0, nonarray, 0, "_FILE_STATUS",
0, {}, {2,2,2,0, NULL, NULL, {NULL}, {NULL}}, NULL },
0, {}, {2,2,2,0, NULL}, NULL },
{ 0, FldNumericBin5, FldInvalid, 0, 0, 0, 0, nonarray, 0, "UPSI-0",
0, {}, {2,2,4,0, NULL, NULL, {NULL}, {NULL}}, NULL },
0, {}, {2,2,4,0, NULL}, NULL },
{ 0, FldNumericBin5, FldInvalid, 0, 0, 0, 0, nonarray, 0, "RETURN-CODE",
0, {}, {2,2,4,0, NULL, NULL, {NULL}, {NULL}}, NULL },
0, {}, {2,2,4,0, NULL}, NULL },
{ 0, FldNumericBin5, FldInvalid, 0, 0, 0, 0, nonarray, 0, "LINAGE-COUNTER",
0, {}, {2,2,4,0, NULL, NULL, {NULL}, {NULL}}, NULL },
0, {}, {2,2,4,0, NULL}, NULL },
{ 0, FldLiteralA, FldInvalid, 0, 0, 0, 0, nonarray, 0, "_dev_stdin",
0, {}, {0,0,0,0, "/dev/stdin", NULL, {NULL}, {NULL}}, NULL },
0, {}, {0,0,0,0, "/dev/stdin"}, NULL },
{ 0, FldLiteralA, FldInvalid, constq, 0, 0, 0, nonarray, 0, "_dev_stdout",
0, {}, {0,0,0,0, "/dev/stdout", NULL, {NULL}, {NULL}}, NULL },
0, {}, {0,0,0,0, "/dev/stdout"}, NULL },
{ 0, FldLiteralA, FldInvalid, constq, 0, 0, 0, nonarray, 0, "_dev_stderr",
0, {}, {0,0,0,0, "/dev/stderr", NULL, {NULL}, {NULL}}, NULL },
0, {}, {0,0,0,0, "/dev/stderr"}, NULL },
{ 0, FldLiteralA, FldInvalid, constq, 0, 0, 0, nonarray, 0, "_dev_null",
0, {}, {0,0,0,0, "/dev/null", NULL, {NULL}, {NULL}}, NULL },
0, {}, {0,0,0,0, "/dev/null"}, NULL },
};
static symbol_elem_t
elementize( cbl_field_t& field ) {
symbol_elem_t elem = { .type = SymField, .elem = {.field = field} };
return elem;
symbol_elem_t sym (SymField);
sym.elem.field = field;
return sym;
}
size_t
@ -675,7 +686,8 @@ symbol_label( size_t program, cbl_label_type_t type, size_t section,
auto p = symbols.labels.find(key);
if( p == symbols.labels.end()) return NULL;
cbl_label_t protolabel = { .type = type, .parent = section, .os_name = os_name };
cbl_label_t protolabel = { type, section };
protolabel.os_name = os_name;
assert(strlen(name) < sizeof protolabel.name);
strcpy(protolabel.name, name);
@ -727,7 +739,7 @@ symbol_program( size_t parent, const char name[] )
assert(strlen(name) < sizeof label.name);
strcpy(label.name, name);
struct symbol_elem_t key = { SymLabel, 0, { NULL } }, *e;
struct symbol_elem_t key( SymLabel, 0 ), *e;
key.elem.label = label;
e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems,
@ -765,7 +777,7 @@ symbol_function( size_t parent, const char name[] )
assert(strlen(name) < sizeof label.name);
strcpy(label.name, name);
struct symbol_elem_t key = { SymLabel, 0, { NULL } }, *e;
struct symbol_elem_t key(SymLabel, 0), *e;
key.elem.label = label;
e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems,
@ -790,7 +802,7 @@ symbol_alphabet( size_t program, const char name[] )
assert(strlen(name) < sizeof alphabet.name);
strcpy(alphabet.name, name);
struct symbol_elem_t key = { SymAlphabet, program, { NULL } }, *e;
struct symbol_elem_t key(SymAlphabet, program), *e;
key.elem.alphabet = alphabet;
e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems,
@ -1603,12 +1615,12 @@ field_str( const cbl_field_t *field ) {
if( field->occurs.ntimes() == 0 ) {
snprintf(name, sizeof(name), "%s", field->name);
} else {
char updown[1 + field->occurs.nkey] = "";
std::vector <char> updown(1 + field->occurs.nkey, '\0');
for( size_t i=0; i < field->occurs.nkey; i++ ) {
updown[i] = field->occurs.keys[i].ascending? 'A' : 'D';
}
snprintf(name, sizeof(name), "%s[%zu]%s",
field->name, field->occurs.ntimes(), updown);
field->name, field->occurs.ntimes(), updown.data());
}
}
@ -1654,11 +1666,11 @@ field_str( const cbl_field_t *field ) {
} else {
data = "NULL";
if( field->type == FldSwitch ) {
data = xasprintf("0x%02x", field->data.upsi_mask->value);
data = xasprintf("0x%02x", field->data.upsi_mask_of()->value);
}
}
if( field->level == 88 ) {
const auto& dom = *field->data.domain;
const auto& dom = *field->data.domain_of();
data = xasprintf("%s%s %s - %s%s",
dom.first.all? "A" : "",
value_or_figconst_name(dom.first.name()) ,
@ -1718,7 +1730,8 @@ struct capacity_of {
static void
extend_66_capacity( cbl_field_t *alias ) {
static_assert(sizeof(symbol_elem_t*) == sizeof(const char *));
static_assert(sizeof(symbol_elem_t*) == sizeof(const char *),
"all pointers must be same size");
assert(alias->data.picture);
assert(alias->type == FldGroup);
symbol_elem_t *e = symbol_at(alias->parent);
@ -2207,11 +2220,11 @@ symbol_field_parent_set( struct cbl_field_t *field )
// verify level 88 domain value
if( is_numeric(prior) && field->level == 88 ) {
// domain array terminated by an element with a NULL name (value)
auto edom = field->data.domain;
auto edom = field->data.domain_of();
while( edom->first.name() ) edom++;
bool all_numeric =
std::all_of( field->data.domain, edom,
std::all_of( field->data.domain_of(), edom,
[]( const cbl_domain_t& domain ) {
switch( cbl_figconst_of(domain.first.name()) ) {
case normal_value_e:
@ -2280,74 +2293,75 @@ symbol_table_init(void) {
// These should match the definitions in libgcobol/constants.cc
static cbl_field_t constants[] = {
{ 0, FldAlphanumeric, FldInvalid, space_value_e | constq, 0, 0, 0, nonarray, 0,
"SPACE", 0, {}, {1,1,0,0, " \0\xFF", NULL, { NULL }, { NULL } }, NULL },
"SPACE", 0, {}, {1,1,0,0, " \0\xFF"}, NULL },
{ 0, FldAlphanumeric, FldInvalid, space_value_e | constq , 0, 0, 0, nonarray, 0,
"SPACES", 0, {}, {1,1,0,0, " \0\xFF", NULL, { NULL }, { NULL } }, NULL },
"SPACES", 0, {}, {1,1,0,0, " \0\xFF"}, NULL },
{ 0, FldAlphanumeric, FldInvalid, low_value_e | constq, 0, 0, 0, nonarray, 0,
"LOW_VALUES", 0, {}, {1,1,0,0, "L\0\xFF", NULL, { NULL }, { NULL } }, NULL },
"LOW_VALUES", 0, {}, {1,1,0,0, "L\0\xFF"}, NULL },
{ 0, FldAlphanumeric, FldInvalid, zero_value_e | constq, 0, 0, 0, nonarray, 0,
"ZEROS", 0, {}, {1,1,0,0, "0", NULL, { NULL }, { NULL } }, NULL },
"ZEROS", 0, {}, {1,1,0,0, "0"}, NULL },
{ 0, FldAlphanumeric, FldInvalid, high_value_e | constq, 0, 0, 0, nonarray, 0,
"HIGH_VALUES", 0, {}, {1,1,0,0, "H\0\xFF", NULL, { NULL }, { NULL } }, NULL },
"HIGH_VALUES", 0, {}, {1,1,0,0, "H\0\xFF"}, NULL },
// IBM standard: QUOTE is a double-quote unless APOST compiler option
{ 0, FldAlphanumeric, FldInvalid, quote_value_e | constq , 0, 0, 0, nonarray, 0,
"QUOTES", 0, {}, {1,1,0,0, "\"\0\xFF", NULL, { NULL }, { NULL } }, NULL },
"QUOTES", 0, {}, {1,1,0,0, "\"\0\xFF"}, NULL },
{ 0, FldPointer, FldPointer, constq , 0, 0, 0, nonarray, 0,
"NULLS", 0, {}, {8,8,0,0, zeroes_for_null_pointer, NULL, { NULL }, { NULL } }, NULL },
"NULLS", 0, {}, {8,8,0,0, zeroes_for_null_pointer}, NULL },
// IBM defines TALLY
// 01 TALLY GLOBAL PICTURE 9(5) USAGE BINARY VALUE ZERO.
{ 0, FldNumericBin5, FldInvalid, signable_e, 0, 0, 0, nonarray, 0,
"_TALLY", 0, {}, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL, NULL, {NULL}, {NULL}}, NULL },
"_TALLY", 0, {}, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL}, NULL },
// 01 ARGI is the current index into the argv array
{ 0, FldNumericBin5, FldInvalid, signable_e, 0, 0, 0, nonarray, 0,
"_ARGI", 0, {}, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL, NULL, {NULL}, {NULL}}, NULL },
"_ARGI", 0, {}, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL}, NULL },
// These last two don't require actual storage; they get BOOL var_decl_node
// in parser_symbol_add()
{ 0, FldConditional, FldInvalid, constant_e , 0, 0, 0, nonarray, 0,
"_VERY_TRUE", 0, {}, {1,1,0,0, "", NULL, { NULL }, { NULL } }, NULL },
"_VERY_TRUE", 0, {}, {1,1,0,0, ""}, NULL },
{ 0, FldConditional, FldInvalid, constant_e , 0, 0, 0, nonarray, 0,
"_VERY_FALSE", 0, {}, {1,1,0,0, "", NULL, { NULL }, { NULL } }, NULL },
"_VERY_FALSE", 0, {}, {1,1,0,0, ""}, NULL },
};
for( struct cbl_field_t *f = constants;
f < constants + COUNT_OF(constants); f++ ) {
f->our_index = table.nelem;
struct symbol_elem_t e = { SymField, 0, { .field = *f } };
table.elems[table.nelem++] = e;
f->our_index = table.nelem;
struct symbol_elem_t sym(SymField, 0);
sym.elem.field = *f;
table.elems[table.nelem++] = sym;
}
static symbol_elem_t environs[] = {
{ SymSpecial, 0, {.special = {0, SYSIN_e, "SYSIN", 0, "/dev/stdin"}} },
{ SymSpecial, 0, {.special = {0, SYSIPT_e, "SYSIPT", 0, "/dev/stdout"}} },
{ SymSpecial, 0, {.special = {0, SYSOUT_e, "SYSOUT", 0, "/dev/stdout"}} },
{ SymSpecial, 0, {.special = {0, SYSLIST_e, "SYSLIST", 0, "/dev/stdout"}} },
{ SymSpecial, 0, {.special = {0, SYSLST_e, "SYSLST", 0, "/dev/stdout"}} },
{ SymSpecial, 0, {.special = {0, SYSPUNCH_e, "SYSPUNCH", 0, "/dev/stderr"}} },
{ SymSpecial, 0, {.special = {0, SYSPCH_e, "SYSPCH", 0, "/dev/stderr"}} },
{ SymSpecial, 0, {.special = {0, CONSOLE_e, "CONSOLE", 0, "/dev/stdout"}} },
{ SymSpecial, 0, {.special = {0, C01_e, "C01", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C02_e, "C02", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C03_e, "C03", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C04_e, "C04", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C05_e, "C05", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C06_e, "C06", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C07_e, "C07", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C08_e, "C08", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C09_e, "C09", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C10_e, "C10", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C11_e, "C11", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, C12_e, "C12", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, CSP_e, "CSP", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, S01_e, "S01", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, S02_e, "S02", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, S03_e, "S03", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, S04_e, "S04", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, S05_e, "S05", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, AFP_5A_e, "AFP-5A", 0, "/dev/null"}} },
{ SymSpecial, 0, {.special = {0, STDIN_e, "STDIN", 0, "/dev/stdin"}} },
{ SymSpecial, 0, {.special = {0, STDOUT_e, "STDOUT", 0, "/dev/stdout"}} },
{ SymSpecial, 0, {.special = {0, STDERR_e, "STDERR", 0, "/dev/stderr"}} },
{ SymSpecial, 0, {.special = {0, SYSERR_e, "SYSERR", 0, "/dev/stderr"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSIN_e, "SYSIN", 0, "/dev/stdin"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSIPT_e, "SYSIPT", 0, "/dev/stdout"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSOUT_e, "SYSOUT", 0, "/dev/stdout"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSLIST_e, "SYSLIST", 0, "/dev/stdout"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSLST_e, "SYSLST", 0, "/dev/stdout"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSPUNCH_e, "SYSPUNCH", 0, "/dev/stderr"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSPCH_e, "SYSPCH", 0, "/dev/stderr"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, CONSOLE_e, "CONSOLE", 0, "/dev/stdout"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C01_e, "C01", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C02_e, "C02", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C03_e, "C03", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C04_e, "C04", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C05_e, "C05", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C06_e, "C06", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C07_e, "C07", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C08_e, "C08", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C09_e, "C09", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C10_e, "C10", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C11_e, "C11", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, C12_e, "C12", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, CSP_e, "CSP", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, S01_e, "S01", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, S02_e, "S02", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, S03_e, "S03", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, S04_e, "S04", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, S05_e, "S05", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, AFP_5A_e, "AFP-5A", 0, "/dev/null"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, STDIN_e, "STDIN", 0, "/dev/stdin"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, STDOUT_e, "STDOUT", 0, "/dev/stdout"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, STDERR_e, "STDERR", 0, "/dev/stderr"}} },
{ symbol_elem_t{ 0, cbl_special_name_t{0, SYSERR_e, "SYSERR", 0, "/dev/stderr"}} },
};
struct symbol_elem_t *p = table.elems + table.nelem;
@ -2460,11 +2474,11 @@ cbl_perform_tgt_t::finally( size_t program ) {
auto p = proto.name + strlen(proto.name);
auto n = snprintf(p, proto.name + sizeof(proto.name) - p, "%s", fini);
assert(n < int(sizeof(fini)));
symbol_elem_t elem = {
.type = SymLabel,
.program = program,
.elem = { .label = proto } }, *e;
e = symbol_add(&elem);
symbol_elem_t sym = {}, *e;
sym.type = SymLabel;
sym.program = program;
sym.elem.label = proto;
e = symbol_add(&sym);
ifrom = symbol_index(e);
return cbl_label_of(e);
}
@ -2485,7 +2499,7 @@ symbol_file_add( size_t program, cbl_file_t *file ) {
return NULL;
}
struct symbol_elem_t sym = { SymFile, program, {NULL} };
struct symbol_elem_t sym = { SymFile, program };
sym.elem.file = *file;
e = symbol_add(&sym);
@ -2500,7 +2514,8 @@ symbol_file_add( size_t program, cbl_file_t *file ) {
struct symbol_elem_t *
symbol_alphabet_add( size_t program, struct cbl_alphabet_t *alphabet ) {
struct symbol_elem_t sym = { SymAlphabet, program, {.alphabet = *alphabet} };
struct symbol_elem_t sym{ SymAlphabet, program };
sym.elem.alphabet = *alphabet;
return symbol_add(&sym);
}
@ -2546,7 +2561,7 @@ symbol_typedef_add( size_t program, struct cbl_field_t *field ) {
if( f == field ) return e;
}
symbol_elem_t elem = { SymField, program, { .field = *field } };
symbol_elem_t elem{ program, *field };
e = symbol_add( &elem );
@ -2592,7 +2607,7 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
if( is_numeric(parent->usage) && parent->data.capacity > 0 ) {
field->type = parent->usage;
field->data = parent->data;
field->data.value = 0.0;
field->data = 0.0;
field->data.initial = NULL;
}
}
@ -2638,8 +2653,7 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
field->attr |= filler_e;
}
struct symbol_elem_t key = { .type = SymField, .program = program, NULL };
key.elem.field = *field;
symbol_elem_t key { program, *field };
// Literals must have an initial value;
assert( !is_literal(field) || field->data.initial );
@ -2778,7 +2792,7 @@ symbol_field_forward_add( size_t program, size_t parent,
FldForward, FldInvalid, 0, parent, 0, 0,
nonarray, line, "",
0, cbl_field_t::linkage_t(),
{0,0,0,0, " ", NULL, {NULL}, {NULL}}, NULL };
{0,0,0,0, " "}, NULL };
if( sizeof(field.name) < strlen(name) ) {
dbgmsg("%s:%d: logic error: name %s too long", __func__, __LINE__, name);
return NULL;
@ -2795,7 +2809,7 @@ symbol_literalA( size_t program, const char name[] )
field.data.initial = name;
field.attr = constq;
struct symbol_elem_t key = { SymField, program, { .field = field } };
struct symbol_elem_t key { program, field };
symbol_elem_t *start = symbols_begin(key.program), *e;
size_t nelem = symbols_end() - start;
@ -2809,7 +2823,7 @@ symbol_literalA( size_t program, const char name[] )
struct symbol_elem_t *
symbol_file( size_t program, const char name[] ) {
size_t nelem = symbols.nelem;
struct symbol_elem_t key = { SymFile, program, {NULL} }, *e = &key;
struct symbol_elem_t key = { SymFile, program }, *e = &key;
assert(strlen(name) < sizeof(key.elem.file.name));
strcpy(key.elem.file.name, name);
@ -2853,8 +2867,7 @@ struct symbol_elem_t *
symbol_field_alias( struct symbol_elem_t *e, const char name[] )
{
cbl_field_t alias = *cbl_field_of(e);
cbl_field_data_t data = { .memsize = alias.data.memsize,
.capacity = alias.data.capacity };
cbl_field_data_t data = { alias.data.memsize, alias.data.capacity };
alias.data = data;
alias.data.memsize = 0;
@ -2960,7 +2973,9 @@ symbol_field_same_as( cbl_field_t *tgt, const cbl_field_t *src ) {
} );
}
cbl_field_t dup = { .parent = field_index(tgt), .line = tgt->line };
cbl_field_t dup = {};
dup.parent = field_index(tgt);
dup.line = tgt->line;
elem_group_t group(++bog, eog);
@ -3070,6 +3085,8 @@ static bool fd_record_size_cmp( const symbol_elem_t& a, const symbol_elem_t& b )
return cbl_field_of(&a)->data.capacity < cbl_field_of(&b)->data.capacity;
}
cbl_file_key_t cbl_file_t::no_key;
/*
* Find largest and smallest record defined for a file. The rule is:
* cbl_file_t::varies() returns true if the record size varies,
@ -3243,7 +3260,7 @@ new_temporary_impl( enum cbl_field_type_t type )
0, FldAlphanumeric, FldInvalid,
intermediate_e, 0, 0, 0, nonarray, 0, "",
0, cbl_field_t::linkage_t(),
{0,0,0,0, NULL, NULL, {NULL}, {NULL}}, NULL };
{}, NULL };
struct cbl_field_t *f = new cbl_field_t;
f->type = type;
@ -3590,9 +3607,10 @@ cbl_field_t::internalize() {
if( is_ascii() ) return data.initial;
assert(data.capacity > 0);
char output[data.capacity + 2], *out = output;
std::vector<char> output(data.capacity + 2, '\0');
char *out = output.data();
char *in = const_cast<char*>(data.initial);
size_t n, inbytesleft = data.capacity, outbytesleft = sizeof(output);
size_t n, inbytesleft = data.capacity, outbytesleft = output.size();
if( !is_literal(this) && inbytesleft < strlen(data.initial) ) {
inbytesleft = strlen(data.initial);
}
@ -3624,8 +3642,8 @@ cbl_field_t::internalize() {
}
// Replace data.initial only if iconv output differs.
if( 0 != memcmp(data.initial, output, out - output) ) {
assert(out <= output + data.capacity);
if( 0 != memcmp(data.initial, output.data(), out - output.data()) ) {
assert(out <= output.data() + data.capacity);
if( getenv(__func__) ) {
const char *eoi = data.initial + data.capacity, *p;
@ -3640,18 +3658,18 @@ cbl_field_t::internalize() {
dbgmsg("%s: converted '%.*s' to %s",
__func__, data.capacity, data.initial, tocode);
int len = int(out - output);
char *mem = static_cast<char*>( xcalloc(1, sizeof(output)) );
int len = int(out - output.data());
char *mem = static_cast<char*>( xcalloc(1, output.size()) );
// Set the new memory to all blanks, tacking a '!' on the end.
memset(mem, 0x20, sizeof(output) - 1);
mem[ sizeof(output) - 2] = '!';
memset(mem, 0x20, output.size() - 1);
mem[ output.size() - 2] = '!';
if( is_literal(this) ) {
data.capacity = len; // trailing '!' will be overwritten
}
memcpy(mem, output, len); // copy only as much as iconv converted
memcpy(mem, output.data(), len); // copy only as much as iconv converted
free(const_cast<char*>(data.initial));
data.initial = mem;
@ -3828,7 +3846,7 @@ symbol_label_add( size_t program, cbl_label_t *input )
}
struct symbol_elem_t
elem = { SymLabel, program, { .label = *input } }, *e = &elem;
elem { program, *input }, *e = &elem;
assert(0 <= e->elem.label.line);
e->elem.label.line = -e->elem.label.line; // force insertion
@ -3895,8 +3913,7 @@ symbol_label_section_exists( size_t program ) {
cbl_label_t *
symbol_program_add( size_t program, cbl_label_t *input )
{
symbol_elem_t
elem = { SymLabel, program, { .label = *input } }, *e;
symbol_elem_t elem { program, *input }, *e;
assert( is_program(elem) );
@ -3927,9 +3944,8 @@ symbol_program_add( size_t program, cbl_label_t *input )
#if 1
struct cbl_special_name_t *
symbol_special( special_name_t id ) {
cbl_special_name_t special = { .id = id };
struct symbol_elem_t key = { SymSpecial, 0,
{ .special = special } }, *e;
cbl_special_name_t special = { 0, id };
struct symbol_elem_t key { 0, special }, *e;
e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems,
&symbols.nelem, sizeof(key),
@ -3954,7 +3970,7 @@ symbol_special_add( size_t program, struct cbl_special_name_t *special )
}
assert(e == NULL);
struct symbol_elem_t elem = { SymSpecial, program, { .special = *special } };
struct symbol_elem_t elem { program, *special };
if( (e = symbol_add(&elem)) == NULL ) {
cbl_errx( "%s:%d: could not add '%s'", __func__, __LINE__, special->name);
@ -3973,8 +3989,7 @@ symbol_special_add( size_t program, struct cbl_special_name_t *special )
struct cbl_section_t *
symbol_section( size_t program, struct cbl_section_t *section ) {
struct symbol_elem_t key = { SymDataSection, program,
{ .section = *section } }, *e;
struct symbol_elem_t key { program, *section }, *e;
e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems,
&symbols.nelem, sizeof(key),
@ -3990,8 +4005,7 @@ symbol_section_add( size_t program, struct cbl_section_t *section )
return NULL; // error, exists
}
struct symbol_elem_t *e, elem = { SymDataSection,
program, { .section = *section } };
struct symbol_elem_t *e, elem { program, *section };
if( (e = symbol_add(&elem)) == NULL ) {
cbl_errx( "%s:%d: could not add '%s'", __func__, __LINE__, section->name());
@ -4497,7 +4511,7 @@ cbl_occurs_t::subscript_ok( const cbl_field_t *subscript ) const {
// It must be a number.
if( subscript->type != FldLiteralN ) return false;
auto sub = subscript->data.value;
auto sub = subscript->data.value_of();
if( sub < 1 || sub != size_t(sub) ) {
return false; // zero/fraction invalid
@ -4722,12 +4736,12 @@ cbl_file_t::deforward() {
char *
cbl_file_t::keys_str() const {
char *ks[nkey];
std::transform(keys, keys + nkey, ks,
std::vector <char *> ks(nkey);
std::transform(keys, keys + nkey, ks.begin(),
[]( const cbl_file_key_t& key ) {
return key.str();
} );
size_t n = 4 * nkey + std::accumulate(ks, ks + nkey, 0,
size_t n = 4 * nkey + std::accumulate(ks.begin(), ks.end(), 0,
[]( int n, const char *s ) {
return n + strlen(s);
} );
@ -4804,7 +4818,7 @@ cbl_file_status_cmp( const void *K, const void *E ) {
static long
file_status_status_of( file_status_t status ) {
size_t n = COUNT_OF(file_status_fields);
file_status_field_t *fs, key = { .status = status };
file_status_field_t *fs, key { status };
fs = (file_status_field_t*)lfind( &key, file_status_fields,
&n, sizeof(*fs), cbl_file_status_cmp );

230
gcc/cobol/symbols.h
View file

@ -44,7 +44,6 @@
#include <set>
#include <stack>
#include <string>
#include <variant>
#include <vector>
#define PICTURE_MAX 64
@ -252,17 +251,98 @@ struct cbl_field_data_t {
int32_t rdigits; // digits to the right
const char *initial, *picture;
union {
enum etc_type_t { val88_e, upsi_e, value_e } etc_type;
const char *
etc_type_str() const {
switch(etc_type) {
case val88_e: return "val88_e";
case upsi_e: return "upsi_e";
case value_e: return "value_e";
}
return "???";
}
union etc_t {
// "Domain" is an array representing the VALUE of CLASS or 88 type.
const struct { cbl_domain_t *false_value; cbl_domain_t *domain; };
const struct cbl_upsi_mask_t *upsi_mask;
struct val88_t {
cbl_domain_t *false_value;
cbl_domain_t *domain;
val88_t() : false_value(NULL), domain(NULL) {}
} val88;
struct cbl_upsi_mask_t *upsi_mask;
_Float128 value;
};
union { // anonymous union allows for other function types later
time_now_f time_func;
};
uint32_t upsi_mask_of() const {
explicit etc_t( double v = 0.0 ) : value(v) {}
} etc;
cbl_field_data_t( uint32_t memsize=0, uint32_t capacity=0 )
: memsize(memsize)
, capacity(capacity)
, digits(0)
, rdigits(0)
, initial(0)
, picture(0)
, etc_type(value_e)
, etc(0)
{}
cbl_field_data_t( uint32_t memsize, uint32_t capacity,
uint32_t digits, uint32_t rdigits,
const char *initial,
const char *picture = NULL )
: memsize(memsize)
, capacity(capacity)
, digits(digits)
, rdigits(rdigits)
, initial(initial)
, picture(picture)
, etc_type(value_e)
, etc(0)
{}
cbl_field_data_t( const cbl_field_data_t& that ) {
copy_self(that);
}
cbl_field_data_t& operator=( const cbl_field_data_t& that ) {
return copy_self(that);
}
cbl_domain_t * false_value_of() const { return etc.val88.false_value; }
cbl_domain_t * false_value_as( cbl_domain_t * domain ) {
etc_type = val88_e;
return etc.val88.false_value = domain;
}
cbl_domain_t * domain_of() const {
assert(etc_type == val88_e);
return etc.val88.domain;
}
cbl_domain_t * domain_as(cbl_domain_t * domain) {
etc_type = val88_e;
return etc.val88.domain = domain;
}
cbl_upsi_mask_t * upsi_mask_of() const {
assert(etc_type == upsi_e);
return etc.upsi_mask;
}
cbl_upsi_mask_t * operator=( cbl_upsi_mask_t * mask) {
etc_type = upsi_e;
return etc.upsi_mask = mask;
}
_Float128 value_of() const {
if( etc_type != value_e ) {
dbgmsg("%s:%d: type is %s", __func__, __LINE__, etc_type_str());
}
//// assert(etc_type == value_e);
return etc.value;
}
_Float128& operator=( _Float128 v) {
etc_type = value_e;
return etc.value = v;
}
time_now_f time_func;
uint32_t upsi_mask_derive() const {
assert(initial);
assert('0' <= initial[0] && initial[0] < '8');
const uint32_t bitn = initial[0] - '0';
@ -275,16 +355,17 @@ struct cbl_field_data_t {
cbl_field_data_t& valify() {
assert(initial);
const size_t len = strlen(initial);
char input[len + 1];
std::copy(initial, initial + len + 1, input); // copy the NUL
std::string input(len + 1, '\0'); // add a NUL
std::copy(initial, initial + len, input.begin());
if( decimal_is_comma() ) {
std::replace(input, input + sizeof(input), ',', '.');
std::replace(input.begin(), input.end(), ',', '.');
}
char *pend = NULL;
value = strtof128( input, &pend );
etc.value = strtof128(input.c_str(), &pend);
if( pend != input + len ) {
if( pend != input.c_str() + len ) {
dbgmsg("%s: error: could not interpret '%s' of '%s' as a number",
__func__, pend, initial);
}
@ -296,6 +377,30 @@ struct cbl_field_data_t {
capacity = strlen(initial);
return valify();
}
protected:
cbl_field_data_t& copy_self( const cbl_field_data_t& that ) {
memsize = that.memsize;
capacity = that.capacity;
digits = that.digits;
rdigits = that.rdigits;
initial = that.initial;
picture = that.picture;
etc_type = that.etc_type;
switch(etc_type) {
case value_e:
etc.value = that.etc.value;
break;
case val88_e:
etc.val88 = that.etc.val88;
break;
case upsi_e:
etc.upsi_mask = that.etc.upsi_mask;
break;
}
return *this;
}
};
static inline uint32_t
@ -456,7 +561,7 @@ struct cbl_field_t {
if( ! (is_typedef || that.type == FldClass) ) {
data.initial = NULL;
data.value = 0.0;
data = _Float128(0.0);
}
return *this;
}
@ -1254,7 +1359,7 @@ struct cbl_alphabet_t {
YYLTYPE loc;
cbl_name_t name;
cbl_encoding_t encoding;
unsigned char low_index, high_index, last_index, alphabet[256];;
unsigned char low_index, high_index, last_index, alphabet[256];
cbl_alphabet_t()
: loc { 1,1, 1,1 }
@ -1447,6 +1552,7 @@ struct cbl_file_lock_t {
};
struct cbl_file_t {
static cbl_file_key_t no_key;
enum cbl_file_org_t org;
enum file_entry_type_t entry_type;
uint32_t attr;
@ -1471,6 +1577,14 @@ struct cbl_file_t {
cbl_name_t name;
cbl_sortreturn_t *addresses; // Used during parser_return_start, et al.
tree var_decl_node; // GENERIC tag for the run-time FIELD structure
cbl_file_t()
: org(file_disorganized_e),
access(file_access_seq_e)
{
keys = &no_key;
}
bool varies() const { return varying_size.min != varying_size.max; }
bool validate() const;
void deforward();
@ -1512,14 +1626,84 @@ struct symbol_elem_t {
size_t program;
union symbol_elem_u {
char *filename;
struct cbl_function_t function;
struct cbl_field_t field;
struct cbl_label_t label;
struct cbl_special_name_t special;
struct cbl_alphabet_t alphabet;
struct cbl_file_t file;
struct cbl_section_t section;
cbl_function_t function;
cbl_field_t field;
cbl_label_t label;
cbl_special_name_t special;
cbl_alphabet_t alphabet;
cbl_file_t file;
cbl_section_t section;
symbol_elem_u() {
static const cbl_field_t empty = {};
field = empty;
}
} elem;
symbol_elem_t( symbol_type_t type = SymField, size_t program = 0 )
: type(type), program(program)
{}
symbol_elem_t( const symbol_elem_t& that )
: type(that.type), program(that.program)
{
copy_by_type(that);
}
symbol_elem_t& operator=( const symbol_elem_t& that ) {
type = that.type;
program = that.program;
return copy_by_type(that);
}
explicit symbol_elem_t( size_t program, const cbl_field_t& field )
: type(SymField), program(program)
{
elem.field = field;
}
explicit symbol_elem_t( size_t program, const cbl_label_t& label )
: type(SymLabel), program(program)
{
elem.label = label;
}
explicit symbol_elem_t( size_t program, const cbl_special_name_t& special )
: type(SymSpecial), program(program)
{
elem.special = special;
}
explicit symbol_elem_t( size_t program, const cbl_section_t& section )
: type(SymDataSection), program(program)
{
elem.section = section;
}
protected:
symbol_elem_t& copy_by_type( const symbol_elem_t& that ) {
switch(type) {
case SymFilename:
elem.filename = that.elem.filename;
break;
case SymFunction:
elem.function = that.elem.function;
break;
case SymField:
elem.field = that.elem.field;
break;
case SymLabel:
elem.label = that.elem.label;
break;
case SymSpecial:
elem.special = that.elem.special;
break;
case SymAlphabet:
elem.alphabet = that.elem.alphabet;
break;
case SymFile:
elem.file = that.elem.file;
break;
case SymDataSection:
elem.section = that.elem.section;
break;
}
return *this;
}
};
# define offsetof(TYPE, MEMBER) __builtin_offsetof (TYPE, MEMBER)

66
gcc/cobol/util.cc
View file

@ -357,16 +357,15 @@ normalize_picture( char picture[] )
goto irregular;
}
char pic[len + 1];
memset(pic, *start, len);
pic[len] = '\0';
std::vector <char> pic(len + 1, '\0');
memset(pic.data(), *start, len);
const char *finish = picture + pmatch[2].rm_eo,
*eopicture = picture + strlen(picture);
p = xasprintf( "%*s%s%*s",
(int)(start - picture), picture,
pic,
(int)(eopicture - finish), finish );
(int)(start - picture), picture,
pic.data(),
(int)(eopicture - finish), finish );
free(picture);
picture = p;
@ -573,7 +572,7 @@ plausible_usage( cbl_field_type_t usage, cbl_field_type_t candidate ) {
cbl_field_t *
symbol_field_index_set( cbl_field_t *field ) {
static const cbl_field_data_t data { .capacity = 8, .digits = 0 };
static const cbl_field_data_t data { 0, 8 };
field->data = data;
@ -596,8 +595,7 @@ symbol_field_type_update( cbl_field_t *field,
// set the type
field->type = candidate;
if( field->data.capacity == 0 ) {
static const cbl_field_data_t data = {0, 8, 0, 0,
NULL, NULL, {NULL}, {NULL}};
static const cbl_field_data_t data = {0, 8, 0, 0, NULL};
field->data = data;
field->attr &= ~size_t(signable_e);
}
@ -926,8 +924,8 @@ literal_subscript_oob( const cbl_refer_t& r, size_t& isub /* output */) {
size_t ndim(dimensions(r.field));
if( ndim == 0 || ndim != r.nsubscript ) return NULL;
cbl_refer_t *esub = r.subscripts + r.nsubscript;
cbl_field_t *dims[ ndim ], **pdim = dims + ndim;
std::fill(dims, pdim, (cbl_field_t*)NULL);
std::vector<cbl_field_t *> dims( ndim, NULL );
auto pdim = dims.end();
for( auto f = r.field; f; f = parent_of(f) ) {
if( f->occurs.ntimes() ) {
@ -936,7 +934,7 @@ literal_subscript_oob( const cbl_refer_t& r, size_t& isub /* output */) {
}
}
assert(dims[0] != NULL);
assert(pdim == dims);
assert(pdim == dims.begin());
/*
* For each subscript, if it is a literal, verify it is in bounds
@ -981,18 +979,21 @@ cbl_refer_t::name() const {
const char *
cbl_refer_t::deref_str() const {
char dimstr[nsubscript * 16] = "(", *p = dimstr + 1;
std::vector<char> dimstr(nsubscript * 16, '\0');
dimstr.at(0) = '(';
auto p = dimstr.begin() + 1;
if( !field ) return name();
for( auto sub = subscripts; sub < subscripts + nsubscript; sub++ ) {
auto initial = sub->field->data.initial ? sub->field->data.initial : "?";
p += snprintf( p, (dimstr + sizeof(dimstr)) - p, "%s ", initial );
size_t len = dimstr.end() - p;
p += snprintf( &*p, len, "%s ", initial );
}
if( 0 < nsubscript ) {
*--p = ')';
}
char *output = xasprintf("%s%s", field->name, dimstr);
char *output = xasprintf("%s%s", field->name, dimstr.data());
return output;
}
@ -1233,16 +1234,24 @@ type_capacity( enum cbl_field_type_t type, uint32_t digits )
return (digits+2)/2; // one nybble per digit + a sign nybble
}
switch(digits) {
case 1 ... 4:
return 2;
case 5 ... 9:
return 4;
case 10 ... 18:
return 8;
case 19 ... 38:
return 16;
}
static const struct sizes_t {
std::pair<uint32_t, uint32_t> bounds;
size_t size;
sizes_t( uint32_t first, uint32_t last, uint32_t size )
: bounds(first, last), size(size)
{}
} sizes[] = {
{ 1, 4, 2 },
{ 5, 9, 4 },
{10, 18, 8 },
{19, 38, 16 },
}, *esizes = sizes + COUNT_OF(sizes);
auto psize = std::find_if( sizes, esizes,
[digits]( sizes_t sizes ) {
return sizes.bounds.first <= digits && digits <= sizes.bounds.second;
} );
if( psize != esizes ) return psize->size;
dbgmsg( "%s:%d: invalid size %u for type %s", __func__, __LINE__,
digits, cbl_field_type_str(type) );
@ -1258,7 +1267,7 @@ public:
static char buffer[ sizeof(hex_pair_t) + 1 ] = "";
memcpy( buffer, input, sizeof(buffer) - 1 );
int x;
unsigned int x;
sscanf( buffer, "%x", &x );
return x;
}
@ -2254,6 +2263,9 @@ cbl_unimplemented_at( const YYLTYPE& loc, const char *gmsgid, ... ) {
/*
* analogs to err(3) and errx(3).
*/
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wformat"
void
cbl_err(const char *fmt, ...) {
auto_diagnostic_group d;
@ -2264,6 +2276,8 @@ cbl_err(const char *fmt, ...) {
emit_diagnostic_valist( DK_FATAL, token_location, option_zero, gmsgid, &ap );
va_end(ap);
}
#pragma GCC diagnostic pop
void
cbl_errx(const char *gmsgid, ...) {
verify_format(gmsgid);