From: Robert Dubner <[email protected]>
Date: Fri, 17 Jul 2026 08:19:51 -0400
Subject: [PATCH] cobol: Filename-as-device; normalize special registers.
The compiler now parses a new feature where a filename can be
established using the device syntax. It awaits implementation in the
code generator.
The variables "literally_zero" and "literally_zero" are now established
as global constants in libgcobol instead of as constructed temporary
variables.
The initialization of "special registers", and the necessary
coordination between their compile-time cbl_field_t and run-time
cblc_field_t counterparts has been normalized.
gcc/cobol/ChangeLog:
* genapi.cc (parser_file_open): New filename-as-device feature
awaiting implementation.
* lexio.h (struct filespan_t): Variable name change.
* parse.y: Filename-as-device.
* parse_ante.h (field_find): Likewise.
(data_division_ready): _literally_zero and _literally_one global
constants.
* scan.l: Require separate space after '<', '>' and '=' comparison
operators.
* scan_ante.h (update_location): Change debug message text.
* symbols.cc (constq): Eliminate #define in favor of explicit
(constant_e | quoted_e).
(label_cmp): Formatting: eliminate trailing space.
(symbol_elem_cmp): Filename-as-device.
(enum protoreq_t): Formatting: eliminate trailing space.
(cbl_field_t::clear_attr): Likewise.
(symbols_dump): Likewise.
(cbl_field_t::attr_str): Likewise.
(field_str): Likewise.
(symbols_update): Use _literally_zero and _literally_one.
(endian_bit): Compact access to cobol_target_big_endian().
(symbol_table_init): Normalize initialization of "special
registers".
(symbol_registers_add): Likewise.
(cbl_perform_tgt_t::recurses): Formatting: eliminate trailing
space.
(symbol_literalA): Replace constq.
(cbl_alphabet_t::reencode): Eliminate trailing space.
(symbol_temporary_alphanumerics): Likewise.
(new_literal_add): Likewise.
(new_temporary_clone): Ensure FldLiteralBin5 has the endian
attribute of
the target architecture.
(iconv_cd): Formatting: eliminate trailing space.
(cbl_field_t::encode): Likewise.
(cbl_field_t::set_capacity): Formatting: eliminate trailing space.
(cbl_label_t::str): Likewise.
(cbl_file_t::special_index): New function supporting
filename-as-device.
(cbl_file_t::filename_of): Likewise.
* symbols.h (struct cbl_special_name_t): Support filename as
device.
(struct cbl_file_t): Likewise.
(symbol_typedef): Likewise.
(symbol_special_index): Likewise.
libgcobol/ChangeLog:
* charmaps.h (ebcdic_newline): Use just SPACES instead of both
SPACE and SPACES.
* constants.cc (INTEGER_CONSTANT1): Eliminate.
(struct cblc_field_t): Eliminate __gg__data_space.
(INTEGER_CONSTANT2): Eliminate.
(endian): Adjust the initialization of __ggsr__spaces and the
various DEBUG-ITEM components.
* libgcobol.cc (alpha_to_alpha_move_from_location): Correct a
comment.
(__gg__codeset_figurative_constants): Normalize using SPACES when
SPACE is
specified.
(__gg__get_figconst_data): Likewise.
gcc/testsuite/ChangeLog:
* cobol.dg/group2/INITIALIZE_with_-defaultbyte__ASCII_.cob: Use
"VALUE '-'" instead of "VALUE'-'".
* cobol.dg/group2/INITIALIZE_with_-defaultbyte__EBCDIC_.cob:
Likewise.
* cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.cob:
Removed.
* cobol.dg/group2/RT3609_Unexpected_PROCESS.cob: Removed.
* cobol.dg/group2/DEBUG-ITEM_using_mh_identical.cob: New test.
* cobol.dg/group2/DEBUG-ITEM_using_mh_identical.out: New test.
---
gcc/cobol/genapi.cc | 24 ++
gcc/cobol/lexio.h | 4 +-
gcc/cobol/parse.y | 95 +++----
gcc/cobol/parse_ante.h | 12 +-
gcc/cobol/scan.l | 29 +-
gcc/cobol/scan_ante.h | 2 +-
gcc/cobol/symbols.cc | 267 +++++++++++-------
gcc/cobol/symbols.h | 15 +-
.../group2/DEBUG-ITEM_using_mh_identical.cob | 52 ++++
.../group2/DEBUG-ITEM_using_mh_identical.out | 15 +
.../INITIALIZE_with_-defaultbyte__ASCII_.cob | 4 +-
.../INITIALIZE_with_-defaultbyte__EBCDIC_.cob | 4 +-
...9_RT3586_-_Code_format_heuristic_fails.cob | 7 -
.../group2/RT3609_Unexpected_PROCESS.cob | 9 -
libgcobol/charmaps.h | 2 +-
libgcobol/constants.cc | 160 +++++------
libgcobol/libgcobol.cc | 6 +-
17 files changed, 407 insertions(+), 300 deletions(-)
create mode 100644
gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.cob
create mode 100644
gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.out
delete mode 100644
gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.co
b
delete mode 100644
gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index e95c912fca7..46e2fc743d3 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -9112,6 +9112,30 @@ parser_file_open( struct cbl_file_t *file, int
mode_char )
TRACE1_END
}
+
+//#pragma message "parser_file_open: consult cbl_file_t::filename_of and
cbl_file_t::device"
+
+ /*
+ * The filename of a cbl_file_t may be found in three places:
+ * 1. As before, in the cbl_field_t indexed by cbl_file_t::filename.
+ * 2. Now, in the cbl_special_name_t indexed by cbl_file_t::device.
+ * 3. As ever, in neither, from the environment.
+ *
+ * If both filename and device are nonzero and not FldForward, the
filename
+ * supersedes. The syntax was
+ * SELECT fd-name ASSIGN TO device-name USING filename
+ * That just creates in the parser an alias of device-name to fd-name.
It's
+ * still the same file and does *not* change the device
characteristics.
+ *
+ * If filename is FldForward (or 0) and device is nonzero, the OS
filename is
+ * taken from cbl_special_name_t::os_filename. It is tiny, hard-coded
name
+ * in /dev.
+ *
+ * Upon implementation please feel free to delete this message.
+ * --jkl
+ */
+
+
tree pszFilename = gg_define_char_star();
cbl_field_t *field_of_name = symbol_field_forward(file->filename);
if( field_of_name->type == FldForward )
diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h
index b648997b35c..222a831fe6d 100644
--- a/gcc/cobol/lexio.h
+++ b/gcc/cobol/lexio.h
@@ -168,9 +168,9 @@ struct filespan_t : public bytespan_t {
if( nul != eol ) {
if( std::any_of( nul, eodata,
[]( char ch ) { return ch != '\0'; } ) ) {
- int icol2 = nul - cur;
+ int icol = nul - cur;
fprintf(stderr, "%s:%d:%d: error: NUL character detected in
input\n%*s\n",
- cobol_filename(), int(iline + 1), ++icol2,
+ cobol_filename(), int(iline + 1), ++icol,
int(eol - cur), cur);
parse_error_inc();
std::replace(nul, eol, '\0', SPACE);
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 7ad7fa3d480..05ce448f703 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -789,7 +789,7 @@ class locale_tgt_t {
%type <field> data_descr data_descr1 write_what file_record
%type <field> name88
%type <refer> advancing advance_by
-%type <refer> alphaval alpha_val numeref scalar scalar88
+%type <refer> alphaval alpha_val numeref scalar scalar88
scalar_any
%type <refer> tableref tableish
%type <refer> varg varg1 varg1a start_after start_pos
%type <refer> expr expr_term compute_expr free_tgt by_value_arg
@@ -2367,15 +2367,19 @@ assign_clause: ASSIGN to selected_name[selected]
{
$$.file = new cbl_file_t(protofile);
$$.file->filename = field_index($selected->field);
}
- | ASSIGN to device_name USING name {
+ | ASSIGN to device_name[dev] USING name {
$$.clause = assign_clause_e;
- cbl_unimplemented("ASSIGN TO DEVICE");
- YYERROR;
+ $$.file = new cbl_file_t(protofile);
+ $$.file->assign($dev.id);
+ $$.file->filename = field_index($name);
}
- | ASSIGN to device_name {
+ | ASSIGN to device_name[dev] {
$$.clause = assign_clause_e;
- cbl_unimplemented("ASSIGN TO DEVICE");
- YYERROR;
+ $$.file = new cbl_file_t(protofile);
+ $$.file->assign($dev.id);
+ if( $$.file->org == file_disorganized_e ) {
+ $$.file->org = file_sequential_e;
+ }
}
| ASSIGN USING name {
$$.clause = assign_clause_e;
@@ -3047,26 +3051,6 @@ dev_mnemonic: device_name is NAME
cbl_special_name_t special = { $1.token, $1.id };
if( !namcpy(@NAME, special.name, $NAME) ) YYERROR;
- const char *filename;
-
- switch( special.id ) {
- case STDIN_e: case SYSIN_e: case SYSIPT_e:
- filename = "/dev/stdin";
- break;
- case STDOUT_e: case SYSOUT_e:
- case SYSLIST_e: case SYSLST_e: case CONSOLE_e:
- filename ="/dev/stdout";
- break;
- case STDERR_e: case SYSPUNCH_e: case SYSPCH_e: case
SYSERR_e:
- filename ="/dev/stderr";
- break;
- default:
- filename ="/dev/null";
- break;
- }
-
- special.filename = symbol_index(symbol_literalA(0,
filename));
-
symbol_special_add(PROGRAM, &special);
}
| NAME[device] is NAME[name]
@@ -7352,7 +7336,17 @@ true_false: TRUE_kw { $$ = TRUE_kw; }
| FALSE_kw { $$ = FALSE_kw; }
;
-scalar: tableref {
+scalar: scalar_any {
+ if( was_fd_name($1->field) ) {
+ if( dialect_ok(@1, IbmCallFd, "CALL USING FD
unimplemented") ) {
+ // No other COBOL compiler interprets the FD as a
buffer. This feature
+ // requires further development.
+ warn_msg(@1, "CALL USING FD passes file buffer, not
handle");
+ }
+ }
+ }
+ ;
+scalar_any: tableref {
// Check for missing subscript; others already checked.
if( $1->nsubscript() == 0 && 0 < dimensions($1->field)
) {
subscript_dimension_error(@1, 0, $$);
@@ -8879,33 +8873,29 @@ read_file: READ read_body {
}
;
-read_body: NAME read_next read_into read_key
+read_body: filename[file] read_next read_into read_key
{
statement_begin(@$, READ);
- struct symbol_elem_t *e = symbol_file(PROGRAM, $NAME);
- if( !e ) {
- error_msg(@1, "invalid file name '%s'", $NAME);
- YYERROR;
- }
- $$ = cbl_file_of(e);
+ $$ = $file;
struct cbl_field_t *record = symbol_file_record($$);
if( !record ) {
- error_msg(@1, "syntax error? invalid file record
name");
+ error_msg(@file, "syntax error? invalid file record
name");
YYERROR;
}
+
if( $read_key->field && is_sequential($$) ) {
- error_msg(@1, "SEQUENTIAL file %s has no KEY",
$$->name);
+ error_msg(@file, "SEQUENTIAL file %s has no KEY",
$$->name);
YYERROR;
}
if( $$->org == file_line_sequential_e && $read_next ==
-2 ) {
- error_msg(@1, "LINE SEQUENTIAL file %s cannot READ
PREVIOUS",
+ error_msg(@file, "LINE SEQUENTIAL file %s cannot READ
PREVIOUS",
$$->name);
YYERROR;
}
if( $read_key->field && $read_next < 0 ) {
- error_msg(@1, "cannot read NEXT with KEY %qs",
$$->name);
+ error_msg(@file, "cannot read NEXT with KEY %qs",
$$->name);
YYERROR;
}
@@ -10123,8 +10113,6 @@ filename: NAME
| device_name[dev]
{
auto dev = symbol_special($dev.id);
- error_msg(@dev, "invalid device %qs: FD name required",
dev->name);
- YYERROR;
auto e = symbol_file(PROGRAM, dev->name);
if( ! e ) {
error_msg(@dev, "no FD selected for device '%s'",
dev->name);
@@ -10752,8 +10740,8 @@ ffi_by_val: by_value_arg
}
;
-scalar_arg: scalar
- | scalar AS FIXED LENGTH %prec NAME
+scalar_arg: scalar_any
+ | scalar_any AS FIXED LENGTH %prec NAME
;
call_excepts: call_excepts[a] call_except[b] statements %prec CALL
@@ -13102,12 +13090,13 @@ verify_figconst( enum cbl_figconst_t figconst ,
size_t pos ) {
static size_t
constant_index( int token ) {
switch(token) {
+ // These tokens refer to constants at fixed positions in the symbol
table.
case SPACES : return 0;
- case LOW_VALUES : return verify_figconst(low_value_e, 2);
- case ZERO : return verify_figconst(zero_value_e, 3);
- case HIGH_VALUES : return verify_figconst(high_value_e, 4);
- case QUOTES : return 5;
- case NULLS : return 6;
+ case LOW_VALUES : return verify_figconst(low_value_e, 1);
+ case ZERO : return verify_figconst(zero_value_e, 2);
+ case HIGH_VALUES : return verify_figconst(high_value_e, 3);
+ case QUOTES : return 4;
+ case NULLS : return 5;
}
cbl_errx( "%s:%d: no such constant %d", __func__, __LINE__, token);
return (size_t)-1;
@@ -14630,16 +14619,6 @@ void parser_add_declaratives( size_t n,
cbl_declarative_t *declaratives) {
cbl_field_t *
new_literal( const cbl_loc_t loc, const literal_t& lit, enum
cbl_field_attr_t attr ) {
- bool zstring = lit.prefix[0] == 'Z';
- if( !zstring && lit.data[lit.len] != '\0' ) {
- dbgmsg("%s:%d: line %d, no NUL terminator '%-*.*s'{"
- HOST_SIZE_T_PRINT_UNSIGNED "/" HOST_SIZE_T_PRINT_UNSIGNED "}",
- __func__, __LINE__, yylineno,
- int(lit.len), int(lit.len),
- lit.data, (fmt_size_t)strlen(lit.data), (fmt_size_t)lit.len);
- }
- assert(zstring || lit.data[lit.len] == '\0');
-
size_t attrs(attr);
attrs |= constant_e;
attrs |= literal_attr(lit.prefix);
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 492acb677dc..097d8f62173 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -2896,13 +2896,6 @@ field_find( cbl_loc_t loc, const std::list<const
char *>& names ) {
}
}
symbol_elem_t *e = symbol_find(names);
- if( e && SymField == e->type && was_fd_name(cbl_field_of(e)) ) {
- if( dialect_ok(loc, IbmCallFd, "CALL USING FD unimplemented") ) {
- // No other COBOL compiler interprets the FD as a buffer. This
feature
- // requires further development.
- warn_msg(loc, "CALL USING FD passes file buffer, not handle");
- }
- }
return e? cbl_field_of(e) : NULL;
}
@@ -3606,9 +3599,8 @@ data_division_ready() {
if( (nsymbol = symbols_update(nsymbol, nparse_error == 0)) > 0 ) {
if( ! mode_syntax_only() ) {
if( ! literally_one ) {
- // Use strdup so cbl_field_t::internalize can free them if need
be.
- literally_one = new_constant(xstrdup("1"));
- literally_zero = new_constant(xstrdup("0"));
+ literally_one = register_find("_literally_one");
+ literally_zero = register_find("_literally_zero");
}
} else {
nsymbol = again;
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index 551b1e96209..fedb85e502c 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -322,14 +322,14 @@ PROCEDURE{SPC}DIVISION {
yy_push_state(procedure_div);
(IS{SPC})?">=" { return GE; }
(IS{SPC})?">" { return '>'; }
- {LESS_THAN} { return '<'; }
+ {LESS_THAN}/[[:space:]] { return '<'; }
{LESS_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return LE; }
(IS{SPC})?EQUALS?({SPC}TO)?/[[:space:]] {
static char eq[] = "EQUAL";
ydflval.string = yylval.string = eq;
return EQ; }
{GREATER_THAN}{SPC}{OR_EQUAL}/[[:space:]] { return GE; }
- {GREATER_THAN} { return '>'; }
+ {GREATER_THAN}/[[:space:]] { return '>'; }
{ISNT}{OSPC}">=" { verify_ws(yytext[yyleng - 3]); return '<'; }
{ISNT}{OSPC}">" { verify_ws(yytext[yyleng - 2]); return LE; }
@@ -337,11 +337,11 @@ PROCEDURE{SPC}DIVISION {
yy_push_state(procedure_div);
{ISNT}{OSPC}"<" { verify_ws(yytext[yyleng - 2]); return GE; }
{ISNT}{OSPC}"<=" { verify_ws(yytext[yyleng - 3]); return '>'; }
- {ISNT}{SPC}GREATER{SPC}(THAN)?{SPC}{OR_EQUAL}/[[:space:]] { return '<';
}
- {ISNT}{SPC}GREATER{SPC}(THAN)? { return LE; }
- {ISNT}{SPC}EQUALS?{SPC}(TO)? { return NE; }
- {ISNT}{SPC}LESS{SPC}(THAN)? { return GE; }
- {ISNT}{SPC}LESS{SPC}(THAN)?{SPC}{OR_EQUAL}/[[:space:]] { return '>'; }
+ {ISNT}{SPC}GREATER({SPC}THAN)?{SPC}{OR_EQUAL}/[[:space:]] { return '<';
}
+ {ISNT}{SPC}GREATER({SPC}THAN)?/[[:space:]] { return LE; }
+ {ISNT}{SPC}EQUALS?({SPC}TO)?/[[:space:]] { return NE; }
+ {ISNT}{SPC}LESS({SPC}THAN)?/[[:space:]] { return GE; }
+ {ISNT}{SPC}LESS({SPC}THAN)?{SPC}{OR_EQUAL}/[[:space:]] { return '>'; }
[*]{2} { return POW; }
@@ -791,7 +791,7 @@ GROUP { return GROUP; }
GOBACK { return GOBACK; }
BEAT-FEET { return GOBACK; }
-GO({SPC}TO)? { return GOTO; }
+GO({SPC}TO)?/[[:space:]] { return GOTO; }
GLOBAL { return GLOBAL; }
GIVING { return GIVING; }
@@ -1115,11 +1115,11 @@ USE({SPC}FOR)? { return USE; }
NULLS? { return NULLS; }
OF { return OF; }
- VALUE({SPC}IS)? { return VALUE; }
- VALUES({SPC}ARE)? { return VALUE; }
+ VALUE({SPC}IS)?/[[:space:]] { return VALUE; }
+ VALUES({SPC}ARE)?/[[:space:]] { return VALUE; }
THRU|THROUGH { return THRU; }
- VALUES?({SPC}(IS|ARE))?{SPC}NULLS? { return NULLPTR; }
+ VALUES?({SPC}(IS|ARE))?{SPC}NULLS? { return NULLPTR; }
VALUES?({SPC}(IS|ARE))?/{SPC}[+-]?{dfc} {
yy_push_state(numeric_state); return VALUE; }
@@ -1688,7 +1688,7 @@ USE({SPC}FOR)? { return USE; }
SORT { return SORT; }
SORT-MERGE { return SORT_MERGE; }
SOURCE { return SOURCE; }
- SPACE { return SPACE; }
+ SPACE { return SPACES; }
SPACES { return SPACES; }
SPECIAL-NAMES { return SPECIAL_NAMES; }
STANDARD { return STANDARD; }
@@ -2279,6 +2279,11 @@ USE({SPC}FOR)? { return USE; }
yylval.string = name;
pop_return NAME;
}
+ {PREFIX}?[''] { yylval.literal.set_prefix(yytext,
yyleng-1);
+ BEGIN(quoted1); }
+ {PREFIX}?[""] { yylval.literal.set_prefix(yytext,
yyleng-1);
+ BEGIN(quoted2); }
+
}
/*
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index 2a17a8102b3..c3f46607088 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -462,7 +462,7 @@ update_location( const cbl_loc_t *ploc = nullptr ) {
ydflloc = yylloc = loc;
- dbgmsg(" SC: %s location (%d,%d) to (%d,%d)",
+ dbgmsg(" SC: <%s> (%d,%d) to (%d,%d)",
start_condition_is(),
yylloc.first_line, yylloc.first_column,
yylloc.last_line, yylloc.last_column);
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index da0ca7448ea..e9a0e2bb0a0 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -97,7 +97,7 @@ static struct symbol_table_t {
size_t file_status, linage_counter,
exception_condition, very_true, very_false;
registers_t() {
- file_status = linage_counter =
+ file_status = linage_counter =
exception_condition = very_true = very_false = 0;
}
} registers;
@@ -308,8 +308,6 @@ class group_size_t {
size_t capacity() const { return size; }
};
-#define constq (constant_e | quoted_e)
-
static symbol_elem_t
elementize( const cbl_field_t& field ) {
symbol_elem_t sym (SymField);
@@ -442,15 +440,15 @@ static bool label_cmp( const cbl_label_t& key,
case LblParagraph:
switch( elem.type ) {
case LblNone:
- // dbgmsg("%s:%d: para %s: key parent %zu, LblNone elem parent
%zu", __func__, __LINE__,
+ // dbgmsg("%s:%d: para %s: key parent %zu, LblNone elem parent
%zu", __func__, __LINE__,
// key.name, key.parent, elem.parent);
// Undefined label element with matching parent or no parent.
- if( key.parent == elem.parent || elem.parent == 0 ) {
+ if( key.parent == elem.parent || elem.parent == 0 ) {
return key.line == 0 || elem.line == 0 || key.line == elem.line;
}
break;
case LblParagraph:
- // dbgmsg("%s:%d: para %s: key parent %zu, elem parent %zu",
__func__, __LINE__,
+ // dbgmsg("%s:%d: para %s: key parent %zu, elem parent %zu",
__func__, __LINE__,
// key.name, key.parent, elem.parent);
if( key.parent == 0 || key.parent == elem.parent ) { // explicit or
implicit
return key.line == 0 || elem.line == 0 || key.line == elem.line;
@@ -546,8 +544,16 @@ symbol_elem_cmp( const void *K, const void *E )
if( (cbl_file_of(k)->attr & global_e) == global_e &&
(cbl_file_of(e)->attr & global_e) != global_e ) {
return 1;
+ } else {
+ if( 0 == strcasecmp(k->elem.file.name, e->elem.file.name) ) return
0;
+ // User may refer to a Device name (e.g. SYSIN) aliased to the FD
name via SELECT.
+ auto file = cbl_file_of(e);
+ if( file->device != 0 ) {
+ auto dev = cbl_special_name_of(symbol_at(file->device));
+ return strcasecmp(k->elem.file.name, dev->name);
+ }
+ return 1;
}
- return strcasecmp(k->elem.file.name, e->elem.file.name);
break;
}
assert(k->type == SymField);
@@ -648,7 +654,7 @@ symbols_dump( size_t first, bool header );
enum protoreq_t {
proto_required_e,
proto_allowed_e,
- proto_disallowed_e,
+ proto_disallowed_e,
};
static struct symbol_elem_t *
@@ -844,7 +850,7 @@ cbl_field_t::clear_attr( cbl_field_attr_t attr ) {
}
// Test various ways a Numeric Edited picture can describe a signed
value.
-uint64_t
+uint64_t
cbl_field_t::set_signable() {
gcc_assert(type == FldNumericEdited);
gcc_assert(data.picture);
@@ -1144,8 +1150,8 @@ symbols_dump( size_t first, bool header ) {
auto p = prototype_args(L.name);
unsigned long narg = p.second? p.first.size() : 0;
char *base = s;
- s = xasprintf("%s (%s%zu args)", base,
- L.prototype? "prototype, " : "",
+ s = xasprintf("%s (%s%zu args)", base,
+ L.prototype? "prototype, " : "",
narg);
free(base);
}
@@ -1536,7 +1542,7 @@ cbl_field_t::attr_str( const
std::vector<cbl_field_attr_t>& attrs ) const
const char *sep = "";
char *out = NULL;
uint64_t mask = cbl_field_attr_t(-1);
-
+
for( auto attr_l : attrs ) {
char *part = out;
if( has_attr(attr_l) && (attr_l & mask) == attr_l) {
@@ -1641,7 +1647,7 @@ field_str( const cbl_field_t *field ) {
if( field->attr & local_e ) storage_type = 'w'; // because 'l' hard
to read
static const std::vector<cbl_field_attr_t> attrs {
- strongdef_e, typedef_e,
+ strongdef_e, typedef_e,
figconst_1_e, figconst_2_e, figconst_4_e, rjust_e, ljust_e,
zeros_e, signable_e, constant_e, function_e, quoted_e, filler_e,
intermediate_e, embiggened_e, all_alpha_e, all_x_e,
@@ -1649,7 +1655,7 @@ field_str( const cbl_field_t *field ) {
/* global_e, external_e, */ blank_zero_e, /* linkage_e, local_e, */
leading_e,
separate_e, envar_e, encoded_e, bool_encoded_e, hex_encoded_e,
depends_on_e, /* initialized_e, */ has_value_e, ieeedec_e,
big_endian_e,
- same_as_e, record_key_e,
+ same_as_e, record_key_e,
};
pend += snprintf(pend, string + sizeof(string) - pend,
@@ -1992,7 +1998,7 @@ symbols_update( size_t first, bool parsed_ok ) {
}
// This test is a little too broad, but avoids a special attribute
bit for
- // things like the XML registers. The tests are only internal checks
anyway.
+ // things like the XML registers. The tests are only internal checks
anyway.
if( ! (is_numeric(field) ||
field->has_attr(register_e) ||
field->has_attr(global_e)) ) {
@@ -2337,6 +2343,33 @@ add_token( symbol_elem_t sym ) {
const std::list<cbl_field_t> cdf_literalize();
+static
+cbl_field_attr_t endian_bit()
+ {
+ cbl_field_attr_t retval;
+ if( cobol_target_big_endian() ) // cppcheck-suppress
knownConditionTrueFalse
+ {
+ retval = big_endian_e;
+ }
+ else
+ {
+ volatile int always_one = 1;
+ /* This tortured construction prevents cppcheck from pointing out
that
+ endian_bit() always returns zero on a little-endian machine, which
is
+ redundant in a "register_e | endian_bit()" expression. */
+ if( always_one )
+ {
+ retval = none_e;
+ }
+ else
+ {
+ gcc_unreachable();
+ retval = big_endian_e;
+ }
+ }
+ return retval;
+ }
+
/*
* When adding special registers, be sure to create the actual
cblc_field_t
* in libgcobol/constants.cc.
@@ -2358,25 +2391,27 @@ symbol_table_init(void) {
// These should match the definitions in libgcobol/constants.cc
static cbl_field_t constants[] = {
- { FldAlphanumeric, SPACE_VALUE_E | constq | register_e,
- {1,1,0,0, " \0\xFF"}, 0, "SPACE", cp1252 },
- { FldAlphanumeric, SPACE_VALUE_E | constq | register_e,
+ { FldAlphanumeric, quoted_e | constant_e | register_e |
space_value_e,
{1,1,0,0, " \0\xFF"}, 0, "SPACES", cp1252 },
- { FldAlphanumeric, LOW_VALUE_E | constq | register_e,
+ { FldAlphanumeric, quoted_e | constant_e | register_e | low_value_e,
{1,1,0,0, "L\0\xFF"}, 0, "LOW_VALUES", cp1252 },
- { FldAlphanumeric, ZERO_VALUE_E | constq | register_e,
+ { FldAlphanumeric, quoted_e | constant_e | register_e | zero_value_e,
{1,1,0,0, "0"}, 0, "ZEROS", cp1252 }, // Don't change "ZEROS";
there are
// things that depend on it.
- { FldAlphanumeric, HIGH_VALUE_E | constq | register_e,
+ { FldAlphanumeric, quoted_e | constant_e | register_e | high_value_e,
{1,1,0,0, "H\0\xFF"}, 0, "HIGH_VALUES", cp1252 },
// IBM standard: QUOTE is a double-quote unless APOST compiler option
- { FldAlphanumeric, QUOTE_VALUE_E | constq | register_e ,
+ { FldAlphanumeric, quoted_e | constant_e | register_e | quote_value_e
,
{1,1,0,0, "\"\0\xFF"}, 0, "QUOTES", cp1252 },
- { FldPointer, constq | register_e ,
+ { FldPointer, constant_e | register_e | null_value_e ,
{8,8,0,0, zeroes_for_null_pointer}, 0, "NULLS", cp1252 },
// 01 ARGI is the current index into the argv array
- { FldNumericBin5, signable_e | register_e,
- {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL}, 0, "_ARGI", cp1252 },
+ { FldNumericBin5, signable_e | register_e | endian_bit(),
+ {4, 4, 0, 0, NULL}, 0, "_ARGI", cp1252 },
+ { FldNumericBin5, constant_e | register_e | endian_bit(),
+ {4, 4, 0, 0, NULL}, 0, "_literally_zero", cp1252 },
+ { FldNumericBin5, constant_e | register_e | endian_bit(),
+ {4, 4, 0, 0, NULL}, 0, "_literally_one", cp1252 },
// These last two don't require actual storage; they get BOOL
var_decl_node
// in parser_symbol_add()
@@ -2396,41 +2431,41 @@ symbol_table_init(void) {
}
static symbol_elem_t environs[] = {
- { symbol_elem_t{ 0, cbl_special_name_t{0, CONSOLE_e, "CONSOLE", 0,
"/dev/stdout"}} }, // stdout in DISPLAY; stdin in ACCEPT
-
- { symbol_elem_t{ 0, cbl_special_name_t{0, STDIN_e, "STDIN", 0,
"/dev/stdin"}} },
- { 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/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, 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, STDERR_e, "STDERR", 0,
"/dev/stderr"}} },
- { symbol_elem_t{ 0, cbl_special_name_t{0, SYSERR_e, "SYSERR", 0,
"/dev/stderr"}} },
-
- { 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, CONSOLE_e, "CONSOLE",
"/dev/stdout"}} }, // stdout in DISPLAY; stdin in ACCEPT
+
+ { symbol_elem_t{ 0, cbl_special_name_t{0, STDIN_e, "STDIN",
"/dev/stdin"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSIN_e, "SYSIN",
"/dev/stdin"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSIPT_e, "SYSIPT",
"/dev/stdin"}} },
+
+ { symbol_elem_t{ 0, cbl_special_name_t{0, STDOUT_e, "STDOUT",
"/dev/stdout"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSOUT_e, "SYSOUT",
"/dev/stdout"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSLIST_e, "SYSLIST",
"/dev/stdout"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSLST_e, "SYSLST",
"/dev/stdout"}} },
+
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSPUNCH_e, "SYSPUNCH",
"/dev/stderr"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSPCH_e, "SYSPCH",
"/dev/stderr"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, STDERR_e, "STDERR",
"/dev/stderr"}} },
+ { symbol_elem_t{ 0, cbl_special_name_t{0, SYSERR_e, "SYSERR",
"/dev/stderr"}} },
+
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C01_e, "C01", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C02_e, "C02", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C03_e, "C03", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C04_e, "C04", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C05_e, "C05", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C06_e, "C06", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C07_e, "C07", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C08_e, "C08", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C09_e, "C09", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C10_e, "C10", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C11_e, "C11", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, C12_e, "C12", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, CSP_e, "CSP", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, S01_e, "S01", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, S02_e, "S02", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, S03_e, "S03", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, S04_e, "S04", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, S05_e, "S05", "/dev/null"}}
},
+ { symbol_elem_t{ 0, cbl_special_name_t{0, AFP_5A_e, "AFP-5A",
"/dev/null"}} },
};
struct symbol_elem_t *p = table.elems + table.nelem;
@@ -2501,13 +2536,20 @@ symbol_table_init(void) {
// special registers
static cbl_field_t special_registers[] = {
- { FldNumericDisplay, register_e, {2,2,2,0, NULL}, 0, "_FILE_STATUS",
cp1252 },
- { FldNumericBin5, register_e, {2,2,4,0, NULL}, 0, "UPSI-0", cp1252
},
- { FldNumericBin5, global_e, {2,2,4,0, NULL}, 0, "LINAGE-COUNTER",
cp1252 },
- { FldLiteralA, register_e, {0,0,0,0, "/dev/stdin"}, 0,
"_dev_stdin", cp1252 },
- { FldLiteralA, constq|register_e, {0,0,0,0, "/dev/stdout"}, 0,
"_dev_stdout", cp1252 },
- { FldLiteralA, constq|register_e, {0,0,0,0, "/dev/stderr"}, 0,
"_dev_stderr", cp1252 },
- { FldLiteralA, constq|register_e, {0,0,0,0, "/dev/null"}, 0,
"_dev_null", cp1252 },
+ { FldNumericDisplay, register_e,
+ {2,2,2,0, NULL}, 0, "_FILE_STATUS", cp1252 },
+ { FldNumericBin5, register_e | endian_bit(),
+ {2,2,4,0, NULL}, 0, "UPSI-0", cp1252 },
+ { FldNumericBin5, global_e | endian_bit(),
+ {2,2,4,0, NULL}, 0, "LINAGE-COUNTER", cp1252 },
+ { FldLiteralA, constant_e|quoted_e|register_e,
+ {0,0,0,0, "/dev/stdin"}, 0, "_dev_stdin",
cp1252 },
+ { FldLiteralA, constant_e|quoted_e|register_e,
+ {0,0,0,0, "/dev/stdout"}, 0, "_dev_stdout",
cp1252 },
+ { FldLiteralA, constant_e|quoted_e|register_e,
+ {0,0,0,0, "/dev/stderr"}, 0, "_dev_stderr",
cp1252 },
+ { FldLiteralA, constant_e|quoted_e|register_e,
+ {0,0,0,0, "/dev/null"}, 0, "_dev_null",
cp1252 },
};
assert(table.nelem + COUNT_OF(special_registers) < table.capacity);
@@ -2519,7 +2561,7 @@ symbol_table_init(void) {
table.nelem = p - table.elems;
assert(table.nelem < table.capacity);
- // Add any CDF values defined on the command line.
+ // Add any CDF values defined on the command line.
// After symbols are ready, the CDF adds them directly.
const std::list<cbl_field_t> cdf_values = cdf_literalize();
auto icdf = table.nelem;
@@ -2540,7 +2582,7 @@ symbol_table_init(void) {
f.set_initial(cbl_loc_t());
}
}
-
+
for( auto e = symbols.elems; e < symbols.elems + symbols.nelem; e++ ) {
if( e->type == SymField ) {
update_symbol_map2(e);
@@ -2602,6 +2644,8 @@ symbol_registers_add() {
const static cbl_field_t::codeset_t cp1252(CP1252_e);
const static auto based_any = cbl_field_attr_t(global_e | based_e |
any_length_e);
const static auto glosig = cbl_field_attr_t(global_e | signable_e);
+ const static auto native = glosig | endian_bit();
+
// The data.initial of these fields is used verbatim by
parser_symbol_add.
const static char zero[4] = {0};
static char spc[160] = " ";
@@ -2609,7 +2653,7 @@ symbol_registers_add() {
if( spc[1] != 0x20 ) {
std::fill( spc, spc + sizeof(spc), 0x20 );
}
-
+
/* In the following table, the FldNumericBin5 initial values are
strings with
NUL characters in them. That's because this table bypasses the
encode_numeric
function and the values are passed directly to parser_symbol_add(),
which
@@ -2617,24 +2661,24 @@ symbol_registers_add() {
memory representation of the run-time variable. */
static const cbl_field_t ibm_registers[] = {
-#if COBOL_JSON_READY
- { FldNumericBin5, glosig, {4,4,5,0, zero }, 0, "JSON-CODE",
cp1252 },
- { FldNumericBin5, glosig, {4,4,5,0, zero }, 0, "JSON-STATUS",
cp1252 },
+#if COBOL_JSON_READY
+ { FldNumericBin5, native, {4,4,5,0, zero }, 0, "JSON-CODE",
cp1252 },
+ { FldNumericBin5, native, {4,4,5,0, zero }, 0, "JSON-STATUS",
cp1252 },
#endif
- { FldNumericBin5, glosig, {2,2,4,0, zero }, 0, "RETURN-CODE",
cp1252 },
+ { FldNumericBin5, native, {2,2,4,0, zero }, 0, "RETURN-CODE",
cp1252 },
{ FldAlphanumeric, glosig, {160,160,0,0, spc }, 0, "SORT-CONTROL",
cp1252 },
- { FldNumericBin5, glosig, {4,4,5,0, zero }, 0,
"SORT-CORE-SIZE", cp1252 },
- { FldNumericBin5, glosig, {4,4,5,0, zero }, 0,
"SORT-FILE-SIZE", cp1252 },
+ { FldNumericBin5, native, {4,4,5,0, zero }, 0,
"SORT-CORE-SIZE", cp1252 },
+ { FldNumericBin5, native, {4,4,5,0, zero }, 0,
"SORT-FILE-SIZE", cp1252 },
{ FldAlphanumeric, global_e, {8,8,0,0, spc }, 0, "SORT-MESSAGE",
cp1252 },
- { FldNumericBin5, glosig, {4,4,5,0, zero }, 0,
"SORT-MODE-SIZE", cp1252 },
- { FldNumericBin5, glosig, {4,4,5,0, zero }, 0, "SORT-RETURN",
cp1252 },
+ { FldNumericBin5, native, {4,4,5,0, zero }, 0,
"SORT-MODE-SIZE", cp1252 },
+ { FldNumericBin5, native, {4,4,5,0, zero }, 0, "SORT-RETURN",
cp1252 },
// 01 TALLY GLOBAL PICTURE 9(5) USAGE BINARY VALUE ZERO.
{ FldNumericBin5, global_e, {4,4,5,0, zero }, 0, "_TALLY",
cp1252 },
{ FldAlphanumeric, global_e, {16,16,0,0, spc }, 0,
"WHEN-COMPILED", cp1252 },
// xml registers
- { FldNumericBin5, glosig, {4,4,9,0, zero }, 0, "XML-CODE",
cp1252 },
+ { FldNumericBin5, native, {4,4,9,0, zero }, 0, "XML-CODE",
cp1252 },
{ FldAlphanumeric, global_e, {30,30,0,0, spc }, 0, "XML-EVENT",
cp1252 },
- { FldNumericBin5, glosig, {4,4,9,0, zero }, 0,
"XML-INFORMATION", cp1252 },
+ { FldNumericBin5, native, {4,4,9,0, zero }, 0,
"XML-INFORMATION", cp1252 },
{ FldAlphanumeric, based_any, {1,1,0,0, nullptr }, 0,
"XML-NAMESPACE", cp1252 },
{ FldAlphanumeric, based_any, {1,1,0,0, nullptr }, 0,
"XML-NNAMESPACE", cp1252 },
{ FldAlphanumeric, based_any, {1,1,0,0, nullptr }, 0,
"XML-NAMESPACE-PREFIX", cp1252 },
@@ -2657,7 +2701,7 @@ symbol_registers_add() {
const cbl_label_t *
cbl_perform_tgt_t::recurses( const cbl_label_t *para __attribute__
((unused)),
- const cbl_label_t *sect __attribute__
((unused)) ) const
+ const cbl_label_t *sect __attribute__
((unused)) ) const
{
// Mon Jul 6 11:14:12 2026
// Decided not to enforce until we enforce EC-FLOW-IMP-RECURSION or
@@ -3007,7 +3051,7 @@ symbol_literalA( size_t program, const char name[] )
cbl_field_t field = {};
field.type = FldLiteralA;
field.data.initial = name;
- field.attr = constq;
+ field.attr = constant_e | quoted_e;
struct symbol_elem_t key { program, field };
@@ -3519,7 +3563,7 @@ cbl_alphabet_t::reencode( const cbl_loc_t& loc ) {
UTF-32/LE/BE. What collation means in those environments is
unknown to
me at this time. So, for now I am simply assuming that whatever
we are
doing here fits into a single byte.
-
+
So, for SBC or little-endian character sets, we just pick up the
value
at pos[0]. For big-endian character sets, we find the low-order
byte.
*/
@@ -3620,7 +3664,7 @@ symbol_temporary_alphanumerics() {
symbol_temporaries_t output;
std::copy_if( program_temporaries.begin(),
program_temporaries.end(),
- std::back_inserter(output),
+ std::back_inserter(output),
[]( auto f ) {
switch(f->type) {
case FldAlphaEdited:
@@ -3758,7 +3802,7 @@ new_literal_add( const char initial[], uint32_t len,
field->attr |= attr;
char *orig = static_cast<char *>(xmalloc(len+4));
-
+
auto p = initial? std::copy(initial, initial + len, orig) : orig;
std::fill(p, p+4, 0);
field->data.original(orig);
@@ -4070,6 +4114,9 @@ new_temporary_clone( const cbl_field_t *orig) {
if( field->type == FldNumericBin5 ) {
field->type = orig->type;
field->codeset = orig->codeset;
+ field->attr &= ~big_endian_e;
+ field->attr |= endian_bit();
+
}
field->attr = intermediate_e;
@@ -4196,12 +4243,12 @@ iconv_cd( cbl_encoding_t tgt ) {
iconv_key_t key(tgt, src);
auto p = cds.find(key);
iconv_t cd;
-
+
if( p == cds.end() ) {
const char *fromcode = __gg__encoding_iconv_name(src);
- const char *tocode = __gg__encoding_iconv_name(tgt);
+ const char *tocode = __gg__encoding_iconv_name(tgt);
gcc_assert(fromcode && tocode);
-
+
if( (cd = helpful_iconv_open(tocode, fromcode)) == iconv_t(-1) ) {
return cd;
}
@@ -4234,7 +4281,7 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc )
{
}
extern cbl_loc_t yylloc;
-
+
const char *bad_boy = data.original();
if( 0 == loc.first_line )
loc = level == 0 ? cbl_loc_t(yylloc) :
symbol_field_location(field_index(this));
@@ -4255,13 +4302,13 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc
) {
const_cast<char*>(data.initial));
return nullptr; // may return "truncated success" with error.
}
-
+
auto figconst = cbl_figconst_of(data.original());
if( normal_value_e != figconst ) {
- blank_initial( char_capacity(), figconst );
+ blank_initial( char_capacity(), figconst );
return nullptr;
}
-
+
for( auto src = codeset.default_encodings.current_source_encoding();
src;
src = codeset.default_encodings.next_source_encoding() ) {
@@ -4279,9 +4326,9 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc )
{
xstrerror(errno));
continue;
}
-
+
/*
- * If conversion succeeds, return NULL.
+ * If conversion succeeds, return NULL.
* If it fails, try the next potential encoding.
*/
size_t inbytesleft = srclen, outbytesleft = data.capacity();
@@ -4299,7 +4346,7 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc )
{
// Tolerate trailing zeros for P-values
if( data.rdigits < 0 ) {
if( inbytesleft <= size_t(data.rdigits * -1) ) {
- bool all_zeros = std::all_of(reinterpret_cast<const
char*>(inbuf),
+ bool all_zeros = std::all_of(reinterpret_cast<const
char*>(inbuf),
data.original() + srclen,
[](char ch) {
return '0' == ch;
@@ -4308,13 +4355,13 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc
) {
}
}
}
- error_msg( loc,
+ error_msg( loc,
"VALUE %qs is too long to initialize %qs, discarded
%qs",
data.original(), name, inbuf);
return nullptr; // success-ish
}
dbgmsg("'%c' of '%s'[%lu] could not be converted from %s to %s:
%s",
- *inbuf, data.original(), inbuf - data.original(),
+ *inbuf, data.original(), inbuf - data.original(),
cbl_encoding_str(
codeset.default_encodings.current_source_encoding()->type),
cbl_encoding_str(codeset.encoding),
@@ -4370,7 +4417,7 @@ cbl_field_t::set_capacity(size_t nchar) {
} else {
data.capacity( capacity_cast(nchar) * codeset.stride() );
}
-
+
} else {
cbl_internal_error("%s: %s %s has invalid encoding",
__func__, cbl_field_type_str(type), name);
@@ -4408,7 +4455,7 @@ cbl_label_t::str() const {
char *buf;
switch(type) {
case LblParagraph:
- buf = xasprintf("%-12s %s OF #%ld %s, line %d", type_str() + 3, name,
parent,
+ buf = xasprintf("%-12s %s OF #%ld %s, line %d", type_str() + 3, name,
parent,
parent? cbl_label_of(symbol_at(parent))->name : "",
line);
break;
case LblProgram:
@@ -5434,6 +5481,28 @@ cbl_file_t::keys_str() const {
return xasprintf("%s", names.c_str());
}
+size_t
+cbl_file_t::special_index( special_name_t id ) {
+ 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),
+ symbol_elem_cmp ) );
+ assert(e);
+ return symbol_index(e);
+}
+
+const char *
+cbl_file_t::filename_of() const {
+ if( filename != 0 ) { return cbl_field_of(symbol_at(filename))->name; }
+ if( device != 0 ) {
+ auto dev = cbl_special_name_of(symbol_at(device));
+ if( dev->os_filename[0] != '\0' ) return dev->os_filename;
+ }
+ return nullptr;
+}
+
/*
* _FILE_STATUS symbols
*/
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 3bb84a11d35..2d8c9cee458 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1843,11 +1843,14 @@ struct cbl_locale_t {
}
};
+/*
+ * If SELECT name ASSIGN TO DEVICE is used, the index of the special name
is
+ * assigned to cbl_file_t::device. The device itself never changes.
+ */
struct cbl_special_name_t {
int token;
enum special_name_t id;
cbl_name_t name;
- size_t filename;
char os_filename[16]; // short because always in /dev
};
@@ -2122,7 +2125,7 @@ struct cbl_file_t {
// "The RECORD DELIMITER clause is syntax checked, but has no effect
// on the execution of the program."
enum cbl_file_access_t access;
- size_t filename; //
+ size_t filename, device;
size_t default_record;
size_t nkey; // 1st key is primary & unique
cbl_file_key_t *keys; // indexes into symbol table for key field(s)
@@ -2156,7 +2159,7 @@ struct cbl_file_t {
, optional(false)
, varying_size{ false, 0, 0 }
, access(file_access_seq_e)
- , filename(0)
+ , filename(0), device(0)
, default_record(0)
, nkey(0)
, keys(nullptr)
@@ -2169,6 +2172,7 @@ struct cbl_file_t {
}
bool varies() const { return varying_size.min != varying_size.max; }
+ void assign( special_name_t device ) { this->device =
special_index(device); }
bool validate() const;
void deforward();
cbl_file_key_t * keys_update( cbl_file_key_t * keys ) {
@@ -2188,9 +2192,11 @@ struct cbl_file_t {
return org == file_indexed_e && access == file_access_seq_e;
}
void consider_for_default( const cbl_field_t *record );
+ const char * filename_of() const;
protected:
bool validate_forward( size_t isym ) const;
bool validate_key( const cbl_file_key_t& key ) const;
+ static size_t special_index( special_name_t device );
};
static inline bool
@@ -2856,7 +2862,6 @@ cbl_namelist_t teed_up_names();
size_t end_of_group( size_t igroup );
-symbol_elem_t * symbol_typedef( size_t program, std::list<const char *>
names );
symbol_elem_t * symbol_typedef( size_t program, const char name[] );
symbol_elem_t * symbol_field( size_t program, size_t parent, const char
name[] );
cbl_label_t * symbol_label( size_t program, cbl_label_type_t type,
@@ -2872,6 +2877,8 @@ symbol_elem_t * symbol_literalA( size_t program,
const char name[] );
cbl_special_name_t * symbol_special( special_name_t id );
symbol_elem_t * symbol_special( size_t program, const char name[] );
+size_t symbol_special_index( special_name_t device );
+
symbol_elem_t * symbol_locale( size_t program, const char name[] );
symbol_elem_t * symbol_alphabet( size_t program, const char name[] );
diff --git
a/gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.cob
b/gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.cob
new file mode 100644
index 00000000000..574edc93d2f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.cob
@@ -0,0 +1,52 @@
+ *> { dg-do run }
+ *> { dg-output-file "group2/DEBUG-ITEM_using_mh_identical.out" }
+ identification division.
+ program-id. dbgline.
+ data division.
+ working-storage section.
+ 01 var picture is x(3).
+ 01 var2 picture is x(6).
+ 01 ws-debug-item.
+ 02 ws-debug-line picture is x(6) value "burp".
+ 02 filler picture is x value space.
+ 02 ws-debug-name picture is x(30).
+ 02 filler picture is x value space.
+ 02 ws-debug-sub-1 picture is s9999
+ sign is leading separate character.
+ 02 filler picture is x value space.
+ 02 ws-debug-sub-2 picture is s9999
+ sign is leading separate character.
+ 02 filler picture is x value space.
+ 02 ws-debug-sub-3 picture is s9999
+ sign is leading separate character.
+ 02 filler picture is x value space.
+ 02 ws-debug-contents picture is x(76).
+ procedure division.
+ display "defaults"
+ display """" debug-line """"
+ display """" debug-name """"
+ display debug-sub-1
+ display debug-sub-2
+ display debug-sub-3
+ display """" debug-contents """"
+ move "aaLINE" to ws-debug-line
+ move "bbNAME" to ws-debug-name
+ move 1234 to ws-debug-sub-1
+ move -2345 to ws-debug-sub-2
+ move 3456 to ws-debug-sub-3
+ move "ccDebugging contents" to ws-debug-contents
+ move ws-debug-line to debug-line
+ move ws-debug-name to debug-name
+ move ws-debug-sub-1 to debug-sub-1
+ move ws-debug-sub-2 to debug-sub-2
+ move ws-debug-sub-3 to debug-sub-3
+ move ws-debug-contents to debug-contents
+ display "after the moves"
+ display """" debug-line """"
+ display """" debug-name """"
+ display debug-sub-1
+ display debug-sub-2
+ display debug-sub-3
+ display """" debug-contents """"
+ stop run.
+
diff --git
a/gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.out
b/gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.out
new file mode 100644
index 00000000000..b6e30594476
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/DEBUG-ITEM_using_mh_identical.out
@@ -0,0 +1,15 @@
+defaults
+" "
+" "
++0000
++0000
++0000
+"
"
+after the moves
+"aaLINE"
+"bbNAME "
++1234
+-2345
++3456
+"ccDebugging contents
"
+
diff --git
a/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__ASCII_.cob
b/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__ASCII_.cob
index 66d3a65c99b..09e5c8f2373 100644
---
a/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__ASCII_.cob
+++
b/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__ASCII_.cob
@@ -19,9 +19,9 @@
02 PHONE-NUMBER.
03 NAME PIC A(30).
03 AREA-CODE PIC 999.
- 03 DASH PIC X VALUE'-'.
+ 03 DASH PIC X VALUE '-'.
03 PREFIX PIC 999.
- 03 DASH PIC X VALUE'-'.
+ 03 DASH PIC X VALUE '-'.
03 LOCAL PIC 999.
77 WHO-AM-I PIC X(12).
PROCEDURE DIVISION.
diff --git
a/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__EBCDIC_.cob
b/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__EBCDIC_.cob
index 7859b16ff3c..e8a0cab31f8 100644
---
a/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__EBCDIC_.cob
+++
b/gcc/testsuite/cobol.dg/group2/INITIALIZE_with_-defaultbyte__EBCDIC_.cob
@@ -19,9 +19,9 @@
02 PHONE-NUMBER.
03 NAME PIC A(30).
03 AREA-CODE PIC 999.
- 03 DASH PIC X VALUE'-'.
+ 03 DASH PIC X VALUE '-'.
03 PREFIX PIC 999.
- 03 DASH PIC X VALUE'-'.
+ 03 DASH PIC X VALUE '-'.
03 LOCAL PIC 999.
77 WHO-AM-I PIC X(12).
PROCEDURE DIVISION.
diff --git
a/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.
cob
b/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.
cob
deleted file mode 100644
index c43edb201ed..00000000000
---
a/gcc/testsuite/cobol.dg/group2/PR59_RT3586_-_Code_format_heuristic_fails.
cob
+++ /dev/null
@@ -1,7 +0,0 @@
- *> { dg-do compile }
-
-00002 PROGRAM-ID. PROG.
RJD0002
-00003 PROCEDURE DIVISION.
RJD0003
-00004 GOBACK.
RJD0004
-00005 END PROGRAM PROG.
RJD0005
-
diff --git a/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob
b/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob
deleted file mode 100644
index 39b37c67400..00000000000
--- a/gcc/testsuite/cobol.dg/group2/RT3609_Unexpected_PROCESS.cob
+++ /dev/null
@@ -1,9 +0,0 @@
- *> { dg-do run }
- *> { dg-options "-O0 -Wno-ibm-cdf -I copybooks -Wno-recording-mode
-ffixed-form -dialect ibm -fno-static-call -fexec-charset=CP037
-fexec-national-charset=CP037" }
-
-00001 PROCESS FLAG(I,W) FDUMP
-00002 IDENTIFICATION DIVISION.
-00003 PROGRAM-ID. prog.
-00004 PROCEDURE DIVISION.
-00005 DISPLAY "OK".
-
diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h
index ac0ebd63f02..3f212ac93bc 100644
--- a/libgcobol/charmaps.h
+++ b/libgcobol/charmaps.h
@@ -280,7 +280,7 @@ enum
#define ebcdic_minus ((uint8_t)(0x60))
#define ebcdic_newline ((uint8_t)(0x25))
-extern unsigned char __gg__data_space[1] ;
+extern unsigned char __gg__data_spaces[1] ;
extern unsigned char __gg__data_low_values[1] ;
extern unsigned char __gg__data_zeros[1] ;
extern unsigned char __gg__data_high_values[1] ;
diff --git a/libgcobol/constants.cc b/libgcobol/constants.cc
index 68d9e091bae..51cd5bdfff0 100644
--- a/libgcobol/constants.cc
+++ b/libgcobol/constants.cc
@@ -48,6 +48,7 @@
#include "io.h"
#include "common-defs.h"
#include "gcobolio.h"
+#include "cobol-endian.h"
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wwrite-strings"
@@ -58,84 +59,18 @@
// initialization happens just once.
int __gg__globals_are_initialized = 0;
-// We have a number of integer constants. We need two macros, one for
1-digit
-// names and a second for 2-digit names in order to match our mangling
-// convention for variable names that start with a numeric:
-
-// 4 becomes _1_4
-// _ indicates this is a mangled name
-// 1 means it is one character long
-// _ terminates the 1
-// 4 is the one-character name
-
-#define INTEGER_CONSTANT1(a) \
-unsigned char __gg__data_##a[1] = {(a)}; \
-struct cblc_field_t __ggsr___1_##a = { \
- .data = __gg__data_##a , \
- .capacity = 1 , \
- .allocated = 1 , \
- .offset = 0 , \
- .name = #a , \
- .picture = "" , \
- .initial = #a , \
- .parent = NULL, \
- .occurs_lower = 0 , \
- .occurs_upper = 0 , \
- .attr = global_e | constant_e , \
- .type = FldLiteralN , \
- .level = 0 , \
- .digits = 0 , \
- .rdigits = 0 , \
- .dummy = 0 , \
- };
-
-#define INTEGER_CONSTANT2(a) \
-unsigned char __gg__data_##a[1] = {(a)}; \
-struct cblc_field_t __ggsr___2_##a = { \
- .data = __gg__data_##a , \
- .capacity = 1 , \
- .allocate = 1 , \
- .offset = 0 , \
- .name = #a , \
- .picture = "" , \
- .initial = #a , \
- .parent = NULL, \
- .occurs_lower = 0 , \
- .occurs_upper = 0 , \
- .attr = global_e | constant_e , \
- .type = FldLiteralN , \
- .level = 0 , \
- .digits = 0 , \
- .rdigits = 0 , \
- .encoding = iconv_CP1252_e \
- .alphabet = 0 \
- };
-unsigned char __gg__data_space[1] = {' '};
-struct cblc_field_t __ggsr__space = {
- .data = __gg__data_space ,
- .capacity = sizeof(__gg__data_space) ,
- .allocated = sizeof(__gg__data_space) ,
- .offset = 0 ,
- .name = "SPACE" ,
- .picture = "" ,
- .initial = (char *)space_value_e ,
- .parent = NULL,
- .occurs_lower = 0 ,
- .occurs_upper = 0 ,
- .attr = quoted_e | constant_e | space_value_e ,
- .type = FldAlphanumeric ,
- .level = 0 ,
- .digits = 0 ,
- .rdigits = 0 ,
- .encoding = iconv_CP1252_e ,
- .alphabet = 0 ,
- };
+#if COBOL_BIG_ENDIAN
+#define endian big_endian_e
+#else
+#define endian none_e
+#endif
+unsigned char __gg__data_spaces[1] = {' '};
struct cblc_field_t __ggsr__spaces = {
- .data = __gg__data_space ,
- .capacity = sizeof(__gg__data_space) ,
- .allocated = sizeof(__gg__data_space) ,
+ .data = __gg__data_spaces ,
+ .capacity = 1 ,
+ .allocated = 1 ,
.offset = 0 ,
.name = "SPACES" ,
.picture = "" ,
@@ -143,7 +78,7 @@ struct cblc_field_t __ggsr__spaces = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = quoted_e | constant_e | space_value_e ,
+ .attr = quoted_e | constant_e | register_e | space_value_e,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
@@ -164,7 +99,7 @@ struct cblc_field_t __ggsr__low_values = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x281 ,
+ .attr = quoted_e | constant_e | register_e | low_value_e ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
@@ -185,7 +120,7 @@ struct cblc_field_t __ggsr__zeros = {
.parent = NULL ,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x83 ,
+ .attr = quoted_e | constant_e | register_e | zero_value_e ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
@@ -206,7 +141,7 @@ struct cblc_field_t __ggsr__high_values = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x286 ,
+ .attr = quoted_e | constant_e | register_e | high_value_e ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
@@ -227,7 +162,7 @@ struct cblc_field_t __ggsr__quotes = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x285 ,
+ .attr = quoted_e | constant_e | register_e | quote_value_e ,
.type = FldAlphanumeric ,
.level = 0 ,
.digits = 0 ,
@@ -248,7 +183,7 @@ struct cblc_field_t __ggsr__nulls = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = quoted_e | constant_e ,
+ .attr = constant_e | register_e | null_value_e ,
.type = FldPointer ,
.level = 0 ,
.digits = 0 ,
@@ -269,7 +204,7 @@ struct cblc_field_t __ggsr___file_status = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x0 ,
+ .attr = register_e ,
.type = FldNumericDisplay ,
.level = 0 ,
.digits = 2 ,
@@ -291,7 +226,7 @@ struct cblc_field_t __ggsr__upsi_0 = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x0 ,
+ .attr = register_e | endian,
.type = FldNumericBin5 ,
.level = 0 ,
.digits = 4 ,
@@ -312,7 +247,7 @@ struct cblc_field_t __ggsr___dev_stdin = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x0 ,
+ .attr = constant_e | quoted_e | register_e ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
@@ -333,7 +268,7 @@ struct cblc_field_t __ggsr___dev_stdout = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x0 ,
+ .attr = constant_e | quoted_e | register_e ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
@@ -354,7 +289,7 @@ struct cblc_field_t __ggsr___dev_stderr = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x0 ,
+ .attr = constant_e | quoted_e | register_e ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
@@ -375,7 +310,7 @@ struct cblc_field_t __ggsr___dev_null = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = 0x0 ,
+ .attr = constant_e | quoted_e | register_e ,
.type = FldLiteralA ,
.level = 0 ,
.digits = 0 ,
@@ -384,7 +319,7 @@ struct cblc_field_t __ggsr___dev_null = {
.alphabet = 0 ,
};
-unsigned char __gg__data_argi[] = {0,0};
+unsigned char __gg__data_argi[] = {0,0,0,0};
struct cblc_field_t __ggsr__argi = {
.data = __gg__data_argi ,
.capacity = 4 ,
@@ -396,15 +331,60 @@ struct cblc_field_t __ggsr__argi = {
.parent = NULL,
.occurs_lower = 0 ,
.occurs_upper = 0 ,
- .attr = global_e ,
+ .attr = global_e | endian,
.type = FldNumericBin5 ,
.level = 0 ,
- .digits = 5 ,
+ .digits = 0 ,
.rdigits = 0 ,
.encoding = iconv_CP1252_e ,
.alphabet = 0 ,
};
+unsigned char __gg__data__literally_zero[] = {0,0,0,0};
+struct cblc_field_t __ggsr___literally_zero = {
+ .data = __gg__data__literally_zero ,
+ .capacity = 4 ,
+ .allocated = 4 ,
+ .offset = 0 ,
+ .name = "_literally_zero" ,
+ .picture = "" ,
+ .initial = "" ,
+ .parent = NULL,
+ .occurs_lower = 0 ,
+ .occurs_upper = 0 ,
+ .attr = register_e | endian,
+ .type = FldNumericBin5 ,
+ .level = 0 ,
+ .digits = 0 ,
+ .rdigits = 0 ,
+ .encoding = iconv_CP1252_e ,
+ .alphabet = 0 ,
+ };
+
+#if COBOL_BIG_ENDIAN
+unsigned char __gg__data__literally_one[] = {0,0,0,1};
+#else
+unsigned char __gg__data__literally_one[] = {1,0,0,0};
+#endif
+struct cblc_field_t __ggsr__literally_one = {
+ .data = __gg__data__literally_one ,
+ .capacity = 4 ,
+ .allocated = 4 ,
+ .offset = 0 ,
+ .name = "_literally_one" ,
+ .picture = "" ,
+ .initial = "" ,
+ .parent = NULL,
+ .occurs_lower = 0 ,
+ .occurs_upper = 0 ,
+ .attr = register_e | endian,
+ .type = FldNumericBin5 ,
+ .level = 0 ,
+ .digits = 0 ,
+ .rdigits = 0 ,
+ .encoding = iconv_CP1252_e ,
+ .alphabet = 0 ,
+ };
/* The following defines storage for the global DEBUG-ITEM:
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 391d84ea40d..a4a88238002 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -6250,7 +6250,7 @@ alpha_to_alpha_move_from_location(cblc_field_t
*field,
}
else
{
- // Destination is right-justified, so we
+ // Destination is left-justified, so we
// discard the trailing source characters:
memmove(to,
from,
@@ -11466,7 +11466,7 @@ __gg__codeset_figurative_constants()
{
// This routine gets called after the codeset has been changed
- // __gg__data_space and __gg__data_zeros don't change because they are
+ // __gg__data_spaces and __gg__data_zeros don't change because they are
// permanently encoded as iconv_CP1252_e. These other three can be
changed
// as either compiler options or ALPHABET clauses.
*__gg__data_low_values = __gg__low_value_character;
@@ -11489,7 +11489,7 @@ __gg__get_figconst_data(const cblc_field_t *field)
retval = __gg__data_zeros;
break;
case space_value_e :
- retval = __gg__data_space;
+ retval = __gg__data_spaces;
break;
case quote_value_e :
retval = __gg__data_quotes;
--
2.34.1
