mirror of git://gcc.gnu.org/git/gcc.git
cobol: Development round-up. [PR120765, PR119337, PR120794]
This collection of changes reflects development by both Jim Lowden and Bob
Dubner. It includes fixes to the cobcd script; refinements to the multiple-
period syntax; changes to the parser; implementation of DISPLAY/ACCEPT to and
from ENVIRONMENT-NAME, ENVIRONMENT-VALUE, ARGUMENT-NUMBER, ARGUMENT-VALUE and
minor changes to genapi.cc to cut down on the number of cppcheck warnings.
Co-authored-by: James K. Lowden <jklowden@cobolworx.com>
Co-authored-by: Robert Dubner <rdubner@symas.com>
gcc/cobol/ChangeLog:
PR cobol/120765
PR cobol/119337
PR cobol/120794
* Make-lang.in: Take control of the .cc.o rule.
* cbldiag.h (error_msg_direct): New declaration.
(gcc_location_dump): Forward declaration.
(location_dump): Use gcc_location_dump.
* cdf.y: Change some tokens.
* gcobc: Change dialect handling.
* genapi.cc (parser_call_targets_dump): Temporarily remove from service.
(parser_compile_dcls): Combine temporary arrays.
(get_binary_value_from_float): Apply const to one parameter.
(depending_on_value): Localize a boolean variable.
(normal_normal_compare): Likewise.
(cobol_compare): Eliminate cppcheck warning.
(combined_name): Apply const to an input parameter.
(parser_perform): Apply const to a variable.
(parser_accept): Improve handling of special_name_t parameter and
the exception conditions.
(parser_display): Improve handling of speciat_name_t parameter; use the
os_filename[] string when appropriate.
(program_end_stuff): Rename shadowing variable.
(parser_division): Consolidate temporary char[] arrays.
(parser_file_start): Apply const to a parameter.
(inspect_replacing): Likewise.
(parser_program_hierarchy): Rename shadowing variable.
(mh_identical): Apply const to parameters.
(float_type_of): Likewise.
(picky_memcpy): Likewise.
(mh_numeric_display): Likewise.
(mh_little_endian): Likewise.
(mh_source_is_group): Apply static to a variable it.
(move_helper): Quiet a cppcheck warning.
* genapi.h (parser_accept): Add exceptions to declaration.
(parser_accept_under_discussion): Add declaration.
(parser_display): Change to std::vector; add exceptions to declaration.
* lexio.cc (cdf_source_format): Improve source code location handling.
(source_format_t::infer): Likewise.
(is_fixed_format): Likewise.
(is_reference_format): Likewise.
(left_margin): Likewise.
(right_margin): Likewise.
(cobol_set_indicator_column): Likewise.
(include_debug): Likewise.
(continues_at): Likewise.
(indicated): Likewise.
(check_source_format_directive): Likewise.
(cdftext::free_form_reference_format): Likewise.
* parse.y: Tokens; program and function names; DISPLAY and ACCEPT
handling.
* parse_ante.h (class tokenset_t): Removed.
(class current_tokens_t): Removed.
(field_of): Removed.
* scan.l: Token handling.
* scan_ante.h (level_found): Comment.
* scan_post.h (start_condition_str): Remove cast author_state:.
* symbols.cc (symbols_update): Change error message.
(symbol_table_init): Correct and reorder entries.
(symbol_unresolved_file_key): New function definition.
(cbl_file_key_t::deforward): Change error message.
* symbols.h (symbol_unresolved_file_key): New declaration.
(keyword_tok): New function.
(redefined_token): New function.
(class current_tokens_t): New class.
* symfind.cc (symbol_match): Revise error message.
* token_names.h: Reorder and change numbers in comments.
* util.cc (class cdf_directives_t): New class.
(cobol_set_indicator_column): New function.
(cdf_source_format): New function.
(gcc_location_set_impl): Improve column handling in token_location.
(gcc_location_dump): New function.
(class temp_loc_t): Modify constructor.
(error_msg_direct): New function.
* util.h (class source_format_t): New class.
libgcobol/ChangeLog:
* libgcobol.cc (__gg__accept_envar): ACCEPT/DISPLAY environment variables.
(accept_envar): Likewise.
(default_exception_handler): Refine system log entries.
(open_syslog): Likewise.
(__gg__set_env_name): ACCEPT/DISPLAY environment variables.
(__gg__get_env_name): ACCEPT/DISPLAY environment variables.
(__gg__get_env_value): ACCEPT/DISPLAY environment variables.
(__gg__set_env_value): ACCEPT/DISPLAY environment variables.
(__gg__fprintf_stderr): Adjust __attribute__ for printf.
(__gg__set_arg_num): ACCEPT/DISPLAY command-line arguments.
(__gg__accept_arg_value): ACCEPT/DISPLAY command-line arguments.
(__gg__get_file_descriptor): DISPLAY on os_filename[] /dev device.
(cherry picked from commit 069bf2fe31)
This commit is contained in:
Robert Dubner
parent
2e508448cf
commit
4a3e130f39
|
|
@ -384,3 +384,23 @@ cobol.stagefeedback: stagefeedback-start
|
|||
selftest-cobol:
|
||||
|
||||
lang_checks += check-cobol
|
||||
|
||||
#
|
||||
# Front-end specific flags: Originally done for the COBOL front end, this
|
||||
# scripting applies CXXFLAGS_FOR_COBOL only to compilations of source code in the
|
||||
# gcc/cobol source code tree. Both forms can be used:
|
||||
#
|
||||
# CXXFLAGS_FOR_COBOL=xxx ../configure --enable-languages=....
|
||||
# and
|
||||
# make <gcc> CXXFLAGS_FOR_COBOL=yyy
|
||||
#
|
||||
# The second form overrides the first.
|
||||
#
|
||||
# To apply this feature to other front ends, look for and clone lines
|
||||
# containing "CXXFLAGS_FOR_COBOL" in configure.ac, Makefile.tbl, and Makefile.def.
|
||||
#
|
||||
|
||||
cobol/%.o: cobol/%.cc
|
||||
@echo $(COMPILE) $(CXXFLAGS_FOR_COBOL) $<
|
||||
$(COMPILE) $(CXXFLAGS_FOR_COBOL) $<
|
||||
$(POSTCOMPILE)
|
||||
|
|
|
|||
|
|
@ -82,6 +82,10 @@ struct YDFLTYPE
|
|||
void error_msg( const YYLTYPE& loc, const char gmsgid[], ... )
|
||||
ATTRIBUTE_GCOBOL_DIAG(2, 3);
|
||||
|
||||
// an error that uses token_location, not yylloc
|
||||
void error_msg_direct( const char gmsgid[], ... )
|
||||
ATTRIBUTE_GCOBOL_DIAG(1, 2);
|
||||
|
||||
void dialect_error( const YYLTYPE& loc, const char term[], const char dialect[] );
|
||||
|
||||
|
||||
|
|
@ -104,16 +108,20 @@ void dbgmsg( const char fmt[], ... ) ATTRIBUTE_PRINTF_1;
|
|||
|
||||
void gcc_location_set( const YYLTYPE& loc );
|
||||
|
||||
void gcc_location_dump();
|
||||
|
||||
// tree.h defines yy_flex_debug as a macro because options.h
|
||||
#if ! defined(yy_flex_debug)
|
||||
template <typename LOC>
|
||||
static void
|
||||
location_dump( const char func[], int line, const char tag[], const LOC& loc) {
|
||||
extern int yy_flex_debug; // cppcheck-suppress shadowVariable
|
||||
if( yy_flex_debug && gcobol_getenv("update_location") )
|
||||
if( yy_flex_debug && gcobol_getenv("update_location") ) {
|
||||
fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d)\n",
|
||||
func, line, tag,
|
||||
loc.first_line, loc.first_column, loc.last_line, loc.last_column);
|
||||
gcc_location_dump();
|
||||
}
|
||||
}
|
||||
#endif // defined(yy_flex_debug)
|
||||
|
||||
|
|
|
|||
|
|
@ -204,15 +204,15 @@ apply_cdf_turn( const exception_turn_t& turn ) {
|
|||
%type <file> filename
|
||||
%type <files> filenames
|
||||
|
||||
%token BY 478
|
||||
%token BY 482
|
||||
%token COPY 362
|
||||
%token CDF_DISPLAY 384 ">>DISPLAY"
|
||||
%token IN 597
|
||||
%token IN 601
|
||||
%token NAME 286
|
||||
%token NUMSTR 305 "numeric literal"
|
||||
%token OF 678
|
||||
%token PSEUDOTEXT 713
|
||||
%token REPLACING 735
|
||||
%token OF 682
|
||||
%token PSEUDOTEXT 717
|
||||
%token REPLACING 739
|
||||
%token LITERAL 298
|
||||
%token SUPPRESS 376
|
||||
|
||||
|
|
@ -227,25 +227,25 @@ apply_cdf_turn( const exception_turn_t& turn ) {
|
|||
%token CDF_WHEN 389 ">>WHEN"
|
||||
%token CDF_END_EVALUATE 390 ">>END-EVALUATE"
|
||||
|
||||
%token AS 460 CONSTANT 361 DEFINED 363
|
||||
%token AS 464 CONSTANT 361 DEFINED 363
|
||||
%type <boolean> DEFINED
|
||||
%token OTHER 690 PARAMETER_kw 368 "PARAMETER"
|
||||
%token OFF 679 OVERRIDE 369
|
||||
%token THRU 931
|
||||
%token TRUE_kw 805 "True"
|
||||
%token OTHER 694 PARAMETER_kw 368 "PARAMETER"
|
||||
%token OFF 683 OVERRIDE 369
|
||||
%token THRU 935
|
||||
%token TRUE_kw 809 "True"
|
||||
|
||||
%token CALL_COBOL 391 "CALL"
|
||||
%token CALL_VERBATIM 392 "CALL (as C)"
|
||||
|
||||
%token TURN 807 CHECKING 488 LOCATION 641 ON 681 WITH 833
|
||||
%token TURN 811 CHECKING 492 LOCATION 645 ON 685 WITH 837
|
||||
|
||||
%left OR 932
|
||||
%left AND 933
|
||||
%right NOT 934
|
||||
%left '<' '>' '=' NE 935 LE 936 GE 937
|
||||
%left OR 936
|
||||
%left AND 937
|
||||
%right NOT 938
|
||||
%left '<' '>' '=' NE 939 LE 940 GE 941
|
||||
%left '-' '+'
|
||||
%left '*' '/'
|
||||
%right NEG 939
|
||||
%right NEG 943
|
||||
|
||||
%define api.prefix {ydf}
|
||||
%define api.token.prefix{YDF_}
|
||||
|
|
|
|||
|
|
@ -125,25 +125,24 @@ $0 recognizes the following GnuCOBOL cobc compilation options:
|
|||
-std=mvs -std=mvs-strict
|
||||
-std=mf -std=mf-strict
|
||||
-std=cobol85 -std=cobol2002 -std=cobol2014
|
||||
Options that are the same in gcobol and cobc are passed through verbatim.
|
||||
Options that have no analog in gcobol produce a warning message.
|
||||
To produce this message, use -HELP.
|
||||
Options that are the same in gcobol and cobc are passed through verbatim.
|
||||
Options that have no analog in gcobol produce a warning message.
|
||||
To produce this message, use -HELP.
|
||||
To see the constructed cobc command-line, use -echo.
|
||||
To override the default cobc, set the "cobc" environment variable.
|
||||
By default, gcobc invokes the gcobol the same directory the gcobc resides.
|
||||
To override, set the gcobol environment variable.
|
||||
EOF
|
||||
}
|
||||
EOF
|
||||
}
|
||||
|
||||
dialect="gnu"
|
||||
dialect="mf gnu"
|
||||
out_set=""
|
||||
first=""
|
||||
|
||||
#
|
||||
# Simply iterate over the command-line tokens. We can't use getopts
|
||||
# here because it's not designed for single-dash words (e.g. -shared).
|
||||
#
|
||||
|
||||
# Iterate over the command-line tokens. We can't use getopts here
|
||||
# because it's not designed for single-dash words (e.g. -shared).
|
||||
#
|
||||
for opt in "$@"
|
||||
do
|
||||
if [ "$skip_arg" ]
|
||||
|
|
@ -441,11 +440,13 @@ do
|
|||
-std=mvs | -std=mvs-strict | -std=ibm | -std=ibm-strict) dialect=ibm
|
||||
;;
|
||||
-std=mf | -std=mf-strict) dialect=mf
|
||||
;;
|
||||
-std=default) dialect=gnu # that's GnuCOBOL's default and GCC's dialect for GnuCOBOL
|
||||
;;
|
||||
-std=cobol*) dialect="" # GCC COBOL targets COBOL2024 "mostly backward to COBOL85"
|
||||
;;
|
||||
;;
|
||||
# GnuCOBOL's default and GCC's dialect for GnuCOBOL
|
||||
-std=default) dialect=gnu
|
||||
;;
|
||||
# GCC COBOL targets COBOL2024 "mostly backward to COBOL85"
|
||||
-std=cobol*) dialect=""
|
||||
;;
|
||||
-std=*)
|
||||
dialect=""
|
||||
warn "$opt (unkown dialect)"
|
||||
|
|
@ -480,7 +481,8 @@ do
|
|||
opts="$opts /dev/stdin"
|
||||
;;
|
||||
|
||||
*) if [ -z "$output_name" ] # first non-option argument is source file name
|
||||
# First file name argument is default output filename.
|
||||
*) if [ -z "$output_name" -a -e "$opt" ]
|
||||
then
|
||||
output_name=$(basename "${opt%.*}")
|
||||
case $mode in
|
||||
|
|
@ -512,6 +514,11 @@ fi
|
|||
# To override the default gcobol, set the "gcobol" environment variable.
|
||||
gcobol="${gcobol:-${0%/*}/gcobol}"
|
||||
|
||||
if [ "$dialect" ]
|
||||
then
|
||||
dialect=$(echo $dialect | sed -E 's/[[:alnum:]]+/-dialect &/g')
|
||||
fi
|
||||
|
||||
if [ "$echo" ]
|
||||
then
|
||||
echo $gcobol $mode $opts
|
||||
|
|
@ -523,4 +530,4 @@ then
|
|||
set -x
|
||||
fi
|
||||
|
||||
exec $gcobol $mode $opts
|
||||
exec $gcobol $mode $dialect $opts
|
||||
|
|
|
|||
|
|
@ -766,8 +766,9 @@ parser_call_target_convention( tree func )
|
|||
void
|
||||
parser_call_targets_dump()
|
||||
{
|
||||
dbgmsg( "call targets for #" HOST_SIZE_T_PRINT_UNSIGNED,
|
||||
dbgmsg( "call targets for #" HOST_SIZE_T_PRINT_UNSIGNED " NOT dumping",
|
||||
(fmt_size_t)current_program_index() );
|
||||
return; // not currently working
|
||||
for( const auto& elem : call_targets ) {
|
||||
const auto& k = elem.first;
|
||||
const auto& v = elem.second;
|
||||
|
|
@ -1034,14 +1035,13 @@ parser_compile_dcls( const std::vector<uint64_t>& dcls )
|
|||
return NULL_TREE;
|
||||
}
|
||||
|
||||
char ach[32];
|
||||
char ach[64];
|
||||
static int counter = 1;
|
||||
sprintf(ach, "_dcls_table_%d", counter++);
|
||||
tree retval = array_of_long_long(ach, dcls);
|
||||
SHOW_IF_PARSE(nullptr)
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
char ach[64];
|
||||
snprintf(ach, sizeof(ach), " Size is %lu; retval is %p",
|
||||
gb4(dcls.size()), as_voidp(retval));
|
||||
SHOW_PARSE_TEXT(ach);
|
||||
|
|
@ -1050,7 +1050,6 @@ parser_compile_dcls( const std::vector<uint64_t>& dcls )
|
|||
TRACE1
|
||||
{
|
||||
TRACE1_HEADER
|
||||
char ach[64];
|
||||
snprintf(ach, sizeof(ach), " Size is %lu; retval is %p",
|
||||
gb4(dcls.size()), as_voidp(retval));
|
||||
TRACE1_TEXT_ABC("", ach, "");
|
||||
|
|
@ -1588,7 +1587,7 @@ parser_initialize(const cbl_refer_t& refer, bool like_parser_symbol_add)
|
|||
|
||||
static void
|
||||
get_binary_value_from_float(tree value,
|
||||
cbl_refer_t &dest,
|
||||
const cbl_refer_t &dest,
|
||||
cbl_field_t *source,
|
||||
tree source_offset
|
||||
)
|
||||
|
|
@ -1682,6 +1681,7 @@ depending_on_value(tree depending_on, cbl_field_t *current_sizer)
|
|||
// gg_assign(occurs_lower, build_int_cst_type(LONG, current_sizer->occurs.bounds.lower));
|
||||
// gg_assign(occurs_upper, build_int_cst_type(LONG, current_sizer->occurs.bounds.upper));
|
||||
|
||||
gcc_assert(current_sizer);
|
||||
if( current_sizer->occurs.depending_on )
|
||||
{
|
||||
get_depending_on_value_from_odo(depending_on, current_sizer);
|
||||
|
|
@ -1825,16 +1825,12 @@ normal_normal_compare(bool debugging,
|
|||
NULL_TREE);
|
||||
}
|
||||
|
||||
bool needs_adjusting;
|
||||
if( !left_intermediate && !right_intermediate )
|
||||
{
|
||||
// Yay! Both sides have fixed rdigit values.
|
||||
|
||||
// Flag needs_adjusting as false, because we are going to do it here:
|
||||
needs_adjusting = false;
|
||||
int adjust = get_scaled_rdigits(left_side_ref->field)
|
||||
- get_scaled_rdigits(right_side_ref->field);
|
||||
|
||||
if( adjust > 0 )
|
||||
{
|
||||
// We need to make right_side bigger to match the scale of left_side
|
||||
|
|
@ -1849,6 +1845,7 @@ normal_normal_compare(bool debugging,
|
|||
else
|
||||
{
|
||||
// At least one side is right_intermediate
|
||||
bool needs_adjusting;
|
||||
|
||||
tree adjust;
|
||||
if( !left_intermediate && right_intermediate )
|
||||
|
|
@ -2357,7 +2354,7 @@ cobol_compare( tree return_int,
|
|||
build_int_cst_type(INT, rightflags),
|
||||
integer_zero_node,
|
||||
NULL_TREE));
|
||||
compared = true;
|
||||
// compared = true; // Commented out to quiet cppcheck
|
||||
}
|
||||
|
||||
// gg_printf(" result is %d\n", return_int, NULL_TREE);
|
||||
|
|
@ -2563,7 +2560,7 @@ get_string_from(cbl_field_t *field)
|
|||
}
|
||||
|
||||
static char *
|
||||
combined_name(cbl_label_t *label)
|
||||
combined_name(const cbl_label_t *label)
|
||||
{
|
||||
// This routine returns a pointer to a static, so make sure you use the result
|
||||
// before calling the routine again
|
||||
|
|
@ -2578,7 +2575,7 @@ combined_name(cbl_label_t *label)
|
|||
if( label->parent )
|
||||
{
|
||||
// It's possible for implicit
|
||||
cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
|
||||
const cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
|
||||
sect_name = section_label->name;
|
||||
}
|
||||
}
|
||||
|
|
@ -3315,7 +3312,7 @@ parser_perform(cbl_label_t *label, bool suppress_nexting)
|
|||
char ach[256];
|
||||
if( label->type == LblParagraph )
|
||||
{
|
||||
cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
|
||||
const cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
|
||||
para_name = label->name;
|
||||
sect_name = section_label->name;
|
||||
sprintf(ach,
|
||||
|
|
@ -4339,67 +4336,182 @@ psa_FldBlob(struct cbl_field_t *var )
|
|||
}
|
||||
|
||||
void
|
||||
parser_accept( struct cbl_refer_t refer,
|
||||
enum special_name_t special_e )
|
||||
parser_accept(struct cbl_refer_t tgt,
|
||||
special_name_t special_e,
|
||||
cbl_label_t *error,
|
||||
cbl_label_t *not_error )
|
||||
{
|
||||
Analyze();
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_HEADER
|
||||
SHOW_PARSE_REF(" ", refer);
|
||||
if( error )
|
||||
{
|
||||
SHOW_PARSE_LABEL(" error ", error)
|
||||
}
|
||||
if( not_error )
|
||||
{
|
||||
SHOW_PARSE_LABEL(" not_error ", not_error)
|
||||
}
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
TRACE1
|
||||
{
|
||||
TRACE1_HEADER
|
||||
TRACE1_END
|
||||
}
|
||||
|
||||
/*
|
||||
enum special_name_t
|
||||
{
|
||||
SYSIN_e,
|
||||
SYSIPT_e,
|
||||
SYSOUT_e,
|
||||
SYSLIST_e,
|
||||
SYSLST_e,
|
||||
SYSPUNCH_e,
|
||||
SYSPCH_e,
|
||||
CONSOLE_e,
|
||||
C01_e, C02_e, C03_e, C04_e, C05_e, C06_e,
|
||||
C07_e, C08_e, C09_e, C10_e, C11_e, C12_e,
|
||||
CSP_e,
|
||||
S01_e, S02_e, S03_e, S04_e, S05_e,
|
||||
AFP_5A_e,
|
||||
};
|
||||
*/
|
||||
|
||||
// The ISO spec describes the valid special names for ACCEPT as implementation
|
||||
// dependent. We are following IBM's lead.
|
||||
|
||||
tree environment = build_int_cst_type(INT, special_e);
|
||||
|
||||
switch( special_e )
|
||||
const char *function_to_call = NULL;
|
||||
|
||||
switch(special_e)
|
||||
{
|
||||
case STDIN_e:
|
||||
case CONSOLE_e:
|
||||
case SYSIPT_e:
|
||||
case SYSIN_e:
|
||||
break;
|
||||
default:
|
||||
dbgmsg("%s(): We don't know what to do with special_name_t %d,", __func__, special_e);
|
||||
dbgmsg("%s(): so we are ignoring it.", __func__);
|
||||
yywarn("unrecognized SPECIAL NAME ignored");
|
||||
// This is ordinary input from from the stdin:
|
||||
gg_call(VOID,
|
||||
"__gg__accept",
|
||||
environment,
|
||||
gg_get_address_of(tgt.field->var_decl_node),
|
||||
refer_offset(tgt),
|
||||
refer_size_dest(tgt),
|
||||
NULL_TREE);
|
||||
return;
|
||||
break;
|
||||
}
|
||||
|
||||
gg_call(VOID,
|
||||
"__gg__accept",
|
||||
environment,
|
||||
gg_get_address_of(refer.field->var_decl_node),
|
||||
refer_offset(refer),
|
||||
refer_size_dest(refer),
|
||||
NULL_TREE);
|
||||
case C01_e:
|
||||
case C02_e:
|
||||
case C03_e:
|
||||
case C04_e:
|
||||
case C05_e:
|
||||
case C06_e:
|
||||
case C07_e:
|
||||
case C08_e:
|
||||
case C09_e:
|
||||
case C10_e:
|
||||
case C11_e:
|
||||
case C12_e:
|
||||
case CSP_e:
|
||||
case S01_e:
|
||||
case S02_e:
|
||||
case S03_e:
|
||||
case S04_e:
|
||||
case S05_e:
|
||||
case AFP_5A_e:
|
||||
case STDOUT_e:
|
||||
case SYSOUT_e:
|
||||
case SYSLIST_e:
|
||||
case SYSLST_e:
|
||||
case STDERR_e:
|
||||
case SYSPUNCH_e:
|
||||
case SYSPCH_e:
|
||||
case SYSERR_e:
|
||||
cbl_internal_error("Not valid for ACCEPT statement.");
|
||||
break;
|
||||
|
||||
case ARG_NUM_e:
|
||||
// This ACCEPT statement wants the number of argv values:
|
||||
gg_call(VOID,
|
||||
"__gg__get_argc",
|
||||
gg_get_address_of(tgt.field->var_decl_node),
|
||||
refer_offset(tgt),
|
||||
refer_size_source(tgt),
|
||||
NULL_TREE);
|
||||
return;
|
||||
break;
|
||||
|
||||
case ENV_NAME_e:
|
||||
// This fetches the environment name set by DISPLAY... UPON ENV_NAME_e
|
||||
gg_call(VOID,
|
||||
"__gg__get_env_name",
|
||||
gg_get_address_of(tgt.field->var_decl_node),
|
||||
refer_offset(tgt),
|
||||
refer_size_source(tgt),
|
||||
NULL_TREE);
|
||||
return;
|
||||
break;
|
||||
|
||||
case ENV_VALUE_e:
|
||||
// This fetches the environment value associated with the previously
|
||||
// esablished name
|
||||
function_to_call = "__gg__get_env_value";
|
||||
break;
|
||||
|
||||
case ARG_VALUE_e:
|
||||
// We are fetching the variable whose index was established by a prior
|
||||
// DISPLAY UPON ARGUMENT-NUMBER. After the fetch, the value will be
|
||||
// incremented by one.
|
||||
function_to_call = "__gg__accept_arg_value";
|
||||
break;
|
||||
}
|
||||
if( function_to_call )
|
||||
{
|
||||
tree erf = gg_define_int();
|
||||
gg_assign(erf,
|
||||
gg_call_expr( INT,
|
||||
function_to_call,
|
||||
gg_get_address_of(tgt.field->var_decl_node),
|
||||
refer_offset(tgt),
|
||||
refer_size_dest(tgt),
|
||||
NULL_TREE));
|
||||
if( error )
|
||||
{
|
||||
// There is an ON EXCEPTION phrase:
|
||||
IF( erf, ne_op, integer_zero_node )
|
||||
{
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_INDENT
|
||||
SHOW_PARSE_TEXT("Laying down GOTO error->INTO for_argv")
|
||||
SHOW_PARSE_LABEL(" ", error)
|
||||
}
|
||||
gg_append_statement( error->structs.arith_error->into.go_to );
|
||||
}
|
||||
ELSE
|
||||
{
|
||||
}
|
||||
ENDIF
|
||||
}
|
||||
if( not_error )
|
||||
{
|
||||
// There is an NOT ON EXCEPTION phrase:
|
||||
IF( erf, eq_op, integer_zero_node )
|
||||
{
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_INDENT
|
||||
SHOW_PARSE_TEXT("Laying down GOTO not_error->INTO for_argv")
|
||||
SHOW_PARSE_LABEL(" ", not_error)
|
||||
}
|
||||
gg_append_statement( not_error->structs.arith_error->into.go_to );
|
||||
}
|
||||
ELSE
|
||||
{
|
||||
}
|
||||
ENDIF
|
||||
}
|
||||
if( error )
|
||||
{
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_INDENT
|
||||
SHOW_PARSE_TEXT("Laying down LABEL error->bottom")
|
||||
SHOW_PARSE_LABEL(" ", error)
|
||||
}
|
||||
gg_append_statement( error->structs.arith_error->bottom.label );
|
||||
}
|
||||
if( not_error )
|
||||
{
|
||||
SHOW_PARSE
|
||||
{
|
||||
SHOW_PARSE_INDENT
|
||||
SHOW_PARSE_TEXT("Laying down LABEL not_error->bottom")
|
||||
SHOW_PARSE_LABEL(" ", not_error)
|
||||
SHOW_PARSE_END
|
||||
}
|
||||
gg_append_statement( not_error->structs.arith_error->bottom.label );
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// TODO: update documentation.
|
||||
|
|
@ -5250,22 +5362,29 @@ parser_display_field(cbl_field_t *field)
|
|||
DISPLAY_NO_ADVANCE);
|
||||
}
|
||||
|
||||
/*
|
||||
* The first parameter to parser_display is the "device" upon which to display
|
||||
* the data. Besides normal devices, these may include elements that define the
|
||||
* Unix command line and environment:
|
||||
* 1. ARG_NUM_e, the ARGUMENT-NUMBER
|
||||
* 2. ARG_VALUE_e, the ARGUMENT-VALUE
|
||||
* 3. ENV_NAME_e, the ENVIRONMENT-NAME
|
||||
* 4. ENV_VALUE_e, the ENVIRONMENT-VALUE
|
||||
* that need special care and feeding.
|
||||
*/
|
||||
void
|
||||
parser_display( const struct cbl_special_name_t *upon,
|
||||
struct cbl_refer_t refs[],
|
||||
size_t n,
|
||||
bool advance )
|
||||
std::vector<cbl_refer_t> refs,
|
||||
bool advance,
|
||||
cbl_label_t *not_error,
|
||||
cbl_label_t *error )
|
||||
{
|
||||
const size_t n = refs.size();
|
||||
/*
|
||||
* The first parameter to parser_display is the "device" upon which to display
|
||||
* the data. Besides normal devices, these may include elements that define the
|
||||
* Unix command line and environment:
|
||||
* 1. ARG_NUM_e, the ARGUMENT-NUMBER
|
||||
* 2. ARG_VALUE_e, the ARGUMENT-VALUE
|
||||
* 3. ENV_NAME_e, the ENVIRONMENT-NAME
|
||||
* 4. ENV_VALUE_e, the ENVIRONMENT-VALUE
|
||||
* that need special care and feeding.
|
||||
*/
|
||||
|
||||
// At the present time, I am not sure what not_error and error are for
|
||||
gcc_assert(!not_error);
|
||||
gcc_assert(!error);
|
||||
|
||||
Analyze();
|
||||
SHOW_PARSE
|
||||
{
|
||||
|
|
@ -5274,7 +5393,7 @@ parser_display( const struct cbl_special_name_t *upon,
|
|||
for(size_t i=0; i<n; i++)
|
||||
{
|
||||
SHOW_PARSE_INDENT
|
||||
SHOW_PARSE_REF("", refs[i]);
|
||||
SHOW_PARSE_REF("", refs.at(i));
|
||||
}
|
||||
if( advance )
|
||||
{
|
||||
|
|
@ -5306,23 +5425,81 @@ parser_display( const struct cbl_special_name_t *upon,
|
|||
{
|
||||
switch(upon->id)
|
||||
{
|
||||
// See table 5 in the IBM Cobol For Linux x86 1.2 document.
|
||||
|
||||
case STDIN_e:
|
||||
case SYSIN_e:
|
||||
case SYSIPT_e:
|
||||
cbl_internal_error("Attempting to send to an input device.");
|
||||
break;
|
||||
|
||||
case C01_e:
|
||||
case C02_e:
|
||||
case C03_e:
|
||||
case C04_e:
|
||||
case C05_e:
|
||||
case C06_e:
|
||||
case C07_e:
|
||||
case C08_e:
|
||||
case C09_e:
|
||||
case C10_e:
|
||||
case C11_e:
|
||||
case C12_e:
|
||||
case CSP_e:
|
||||
case S01_e:
|
||||
case S02_e:
|
||||
case S03_e:
|
||||
case S04_e:
|
||||
case S05_e:
|
||||
case AFP_5A_e:
|
||||
case ARG_VALUE_e:
|
||||
cbl_internal_error("Not valid for DISPLAY statement.");
|
||||
break;
|
||||
|
||||
case STDOUT_e:
|
||||
case SYSOUT_e:
|
||||
case SYSLIST_e:
|
||||
case SYSLST_e:
|
||||
case CONSOLE_e:
|
||||
// These are inarguably stdout
|
||||
gg_assign(file_descriptor, integer_one_node);
|
||||
break;
|
||||
|
||||
case STDERR_e:
|
||||
case SYSPUNCH_e:
|
||||
case SYSPCH_e:
|
||||
case SYSERR_e:
|
||||
// These are inarguably stderr
|
||||
gg_assign(file_descriptor, integer_two_node);
|
||||
break;
|
||||
|
||||
case SYSOUT_e:
|
||||
case SYSLIST_e:
|
||||
case SYSLST_e:
|
||||
case SYSPUNCH_e:
|
||||
case SYSPCH_e:
|
||||
// In the 21st century, when there are no longer valid assumptions to
|
||||
// be made about the existence of line printers, and where things
|
||||
// formerly-ubiquitous card punches no longer exist, there is a need
|
||||
// for the possibility of assigning these "devices" to externally-
|
||||
// determined Unix gadgetry in /dev:
|
||||
gg_assign(file_descriptor,
|
||||
gg_call_expr( INT,
|
||||
"__gg__get_file_descriptor",
|
||||
gg_string_literal(upon->os_filename),
|
||||
NULL_TREE));
|
||||
needs_closing = true;
|
||||
break;
|
||||
|
||||
case ARG_NUM_e:
|
||||
// Set the index number for a subsequent ACCEPT FROM ARG_VALUE_e
|
||||
gg_call(VOID,
|
||||
"__gg__set_arg_num",
|
||||
gg_get_address_of(refs[0].field->var_decl_node),
|
||||
refer_offset(refs[0]),
|
||||
refer_size_source(refs[0]),
|
||||
NULL_TREE);
|
||||
return;
|
||||
break;
|
||||
|
||||
case ENV_NAME_e:
|
||||
// This Part I of the slightly absurd method of using DISPLAY...UPON
|
||||
// to fetch, or set, environment variables.
|
||||
// Establish the name of an environment variable for later use with
|
||||
// in either DISPLAY UPON or ACCEPT FROM
|
||||
gg_call(VOID,
|
||||
"__gg__set_env_name",
|
||||
gg_get_address_of(refs[0].field->var_decl_node),
|
||||
|
|
@ -5332,19 +5509,16 @@ parser_display( const struct cbl_special_name_t *upon,
|
|||
return;
|
||||
break;
|
||||
|
||||
default:
|
||||
if( upon->os_filename[0] )
|
||||
{
|
||||
tree topen = gg_open( gg_string_literal(upon->os_filename),
|
||||
build_int_cst_type(INT, O_APPEND|O_WRONLY));
|
||||
gg_assign(file_descriptor, topen);
|
||||
needs_closing = true;
|
||||
}
|
||||
else
|
||||
{
|
||||
fprintf(stderr, "We don't know what to do in parser_display\n");
|
||||
gcc_unreachable();
|
||||
}
|
||||
case ENV_VALUE_e:
|
||||
// Set the contents of the environment variable named with ENV_NAME_e
|
||||
gg_call(VOID,
|
||||
"__gg__set_env_value",
|
||||
gg_get_address_of(refs[0].field->var_decl_node),
|
||||
refer_offset(refs[0]),
|
||||
refer_size_source(refs[0]),
|
||||
NULL_TREE);
|
||||
return;
|
||||
break;
|
||||
}
|
||||
}
|
||||
else
|
||||
|
|
@ -5359,12 +5533,9 @@ parser_display( const struct cbl_special_name_t *upon,
|
|||
}
|
||||
CHECK_FIELD(refs[n-1].field);
|
||||
parser_display_internal(file_descriptor, refs[n-1], advance ? DISPLAY_ADVANCE : DISPLAY_NO_ADVANCE);
|
||||
|
||||
if( needs_closing )
|
||||
{
|
||||
tree tclose = gg_close(file_descriptor);
|
||||
// We are ignoring the close() return value
|
||||
gg_append_statement(tclose);
|
||||
gg_close(file_descriptor);
|
||||
}
|
||||
|
||||
cursor_at_sol = advance;
|
||||
|
|
@ -6240,12 +6411,12 @@ program_end_stuff(cbl_refer_t refer, ec_type_t ec)
|
|||
|
||||
tree array_type = build_array_type_nelts(UCHAR,
|
||||
returner->data.capacity);
|
||||
tree retval = gg_define_variable(array_type, vs_static);
|
||||
gg_memcpy(gg_get_address_of(retval),
|
||||
tree array = gg_define_variable(array_type, vs_static);
|
||||
gg_memcpy(gg_get_address_of(array),
|
||||
member(returner->var_decl_node, "data"),
|
||||
member(returner->var_decl_node, "capacity"));
|
||||
|
||||
tree actual = gg_cast(COBOL_FUNCTION_RETURN_TYPE, gg_get_address_of(retval));
|
||||
tree actual = gg_cast(COBOL_FUNCTION_RETURN_TYPE, gg_get_address_of(array));
|
||||
|
||||
restore_local_variables();
|
||||
gg_return(actual);
|
||||
|
|
@ -6876,7 +7047,6 @@ parser_division(cbl_division_t division,
|
|||
// expected formal parameter and tacks it onto the end of the
|
||||
// function's arguments chain.
|
||||
|
||||
char ach[2*sizeof(cbl_name_t)];
|
||||
sprintf(ach, "_p_%s", args[i].refer.field->name);
|
||||
|
||||
size_t nbytes = 0;
|
||||
|
|
@ -9947,8 +10117,8 @@ parser_file_start(struct cbl_file_t *file,
|
|||
// A key has a number of fields
|
||||
for(size_t ifield=0; ifield<file->keys[key_number].nfield; ifield++)
|
||||
{
|
||||
size_t field_index = file->keys[key_number].fields[ifield];
|
||||
cbl_field_t *field = cbl_field_of(symbol_at(field_index));
|
||||
size_t nfield = file->keys[key_number].fields[ifield];
|
||||
cbl_field_t *field = cbl_field_of(symbol_at(nfield));
|
||||
combined_length += field->data.capacity;
|
||||
}
|
||||
gg_assign(length, build_int_cst_type(SIZE_T, combined_length));
|
||||
|
|
@ -9975,7 +10145,7 @@ parser_file_start(struct cbl_file_t *file,
|
|||
|
||||
static void
|
||||
inspect_tally(bool backward,
|
||||
cbl_refer_t identifier_1,
|
||||
const cbl_refer_t &identifier_1,
|
||||
cbl_inspect_opers_t& identifier_2)
|
||||
{
|
||||
Analyze();
|
||||
|
|
@ -10175,8 +10345,8 @@ inspect_tally(bool backward,
|
|||
|
||||
static void
|
||||
inspect_replacing(int backward,
|
||||
cbl_refer_t identifier_1,
|
||||
cbl_inspect_opers_t& operations)
|
||||
const cbl_refer_t &identifier_1,
|
||||
cbl_inspect_opers_t &operations)
|
||||
{
|
||||
Analyze();
|
||||
// This is an INSPECT FORMAT 2
|
||||
|
|
@ -13510,9 +13680,9 @@ parser_program_hierarchy( const cbl_prog_hier_t& hier )
|
|||
// are also accessible by us. Go find them.
|
||||
std::vector<const hier_node *>uncles;
|
||||
find_uncles(nodes[i], uncles);
|
||||
for( size_t i=0; i<uncles.size(); i++ )
|
||||
for( size_t j=0; j<uncles.size(); j++ )
|
||||
{
|
||||
const hier_node *uncle = uncles[i];
|
||||
const hier_node *uncle = uncles[j];
|
||||
if( map_of_sets[caller].find(uncle->name) == map_of_sets[caller].end() )
|
||||
{
|
||||
// We have a COMMON uncle or sibling we haven't seen before.
|
||||
|
|
@ -13550,7 +13720,6 @@ parser_program_hierarchy( const cbl_prog_hier_t& hier )
|
|||
if( callers.find(caller) == callers.end() )
|
||||
{
|
||||
// We haven't seen this caller before
|
||||
callers.insert(caller);
|
||||
|
||||
char ach[3*sizeof(cbl_name_t)];
|
||||
tree names_table_type = build_array_type_nelts(CHAR_P, mol->second.size()+1);
|
||||
|
|
@ -13617,6 +13786,8 @@ parser_program_hierarchy( const cbl_prog_hier_t& hier )
|
|||
(fmt_size_t)caller);
|
||||
tree accessible_programs_decl = gg_trans_unit_var_decl(ach);
|
||||
gg_assign( accessible_programs_decl, gg_get_address_of(the_constructed_table) );
|
||||
|
||||
callers.insert(caller);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -13883,8 +14054,8 @@ conditional_abs(tree source, const cbl_field_t *field)
|
|||
|
||||
static bool
|
||||
mh_identical(cbl_refer_t &destref,
|
||||
cbl_refer_t &sourceref,
|
||||
TREEPLET &tsource)
|
||||
const cbl_refer_t &sourceref,
|
||||
const TREEPLET &tsource)
|
||||
{
|
||||
// Check to see if the two variables are identical types, thus allowing
|
||||
// for a simple byte-for-byte copy of the data areas:
|
||||
|
|
@ -14224,7 +14395,7 @@ float_type_of(const cbl_field_t *field)
|
|||
}
|
||||
|
||||
static tree
|
||||
float_type_of(cbl_refer_t *refer)
|
||||
float_type_of(const cbl_refer_t *refer)
|
||||
{
|
||||
return float_type_of(refer->field);
|
||||
}
|
||||
|
|
@ -14456,7 +14627,7 @@ picky_memset(tree &dest_p, unsigned char value, size_t length)
|
|||
}
|
||||
|
||||
static void
|
||||
picky_memcpy(tree &dest_p, tree &source_p, size_t length)
|
||||
picky_memcpy(tree &dest_p, const tree &source_p, size_t length)
|
||||
{
|
||||
if( length )
|
||||
{
|
||||
|
|
@ -14476,8 +14647,8 @@ picky_memcpy(tree &dest_p, tree &source_p, size_t length)
|
|||
|
||||
static bool
|
||||
mh_numeric_display( cbl_refer_t &destref,
|
||||
cbl_refer_t &sourceref,
|
||||
TREEPLET &tsource,
|
||||
const cbl_refer_t &sourceref,
|
||||
const TREEPLET &tsource,
|
||||
tree size_error)
|
||||
{
|
||||
bool moved = false;
|
||||
|
|
@ -14965,8 +15136,8 @@ mh_numeric_display( cbl_refer_t &destref,
|
|||
|
||||
static bool
|
||||
mh_little_endian( cbl_refer_t &destref,
|
||||
cbl_refer_t &sourceref,
|
||||
TREEPLET &tsource,
|
||||
const cbl_refer_t &sourceref,
|
||||
const TREEPLET &tsource,
|
||||
bool check_for_error,
|
||||
tree size_error)
|
||||
{
|
||||
|
|
@ -15037,8 +15208,8 @@ mh_little_endian( cbl_refer_t &destref,
|
|||
|
||||
static bool
|
||||
mh_source_is_group( cbl_refer_t &destref,
|
||||
cbl_refer_t &sourceref,
|
||||
TREEPLET &tsrc)
|
||||
const cbl_refer_t &sourceref,
|
||||
const TREEPLET &tsrc)
|
||||
{
|
||||
bool retval = false;
|
||||
if( sourceref.field->type == FldGroup && !(destref.field->attr & rjust_e) )
|
||||
|
|
@ -15103,7 +15274,7 @@ move_helper(tree size_error, // This is an INT
|
|||
{
|
||||
// We are creating a copy of the original destination in case we clobber it
|
||||
// and have to restore it because of a computational error.
|
||||
bool first_time = true;
|
||||
static bool first_time = true;
|
||||
static size_t stash_size = 1024;
|
||||
if( first_time )
|
||||
{
|
||||
|
|
@ -15341,7 +15512,7 @@ move_helper(tree size_error, // This is an INT
|
|||
gg_attribute_bit_clear(destref.field, refmod_e);
|
||||
}
|
||||
|
||||
moved = true;
|
||||
// moved = true; // commented out to quiet cppcheck
|
||||
}
|
||||
|
||||
if( restore_on_error )
|
||||
|
|
|
|||
|
|
@ -52,10 +52,13 @@ void parser_division( cbl_division_t division,
|
|||
void parser_enter_program(const char *funcname, bool is_function, int *retval);
|
||||
void parser_leave_program();
|
||||
|
||||
void parser_accept( cbl_refer_t refer, special_name_t special_e);
|
||||
void parser_accept( cbl_refer_t refer, special_name_t special_e,
|
||||
cbl_label_t *error, cbl_label_t *not_error );
|
||||
void parser_accept_exception( cbl_label_t *name );
|
||||
void parser_accept_exception_end( cbl_label_t *name );
|
||||
|
||||
void parser_accept_under_discussion(struct cbl_refer_t tgt, special_name_t special,
|
||||
cbl_label_t *error, cbl_label_t *not_error );
|
||||
void parser_accept_envar( cbl_refer_t refer, cbl_refer_t envar,
|
||||
cbl_label_t *error, cbl_label_t *not_error );
|
||||
void parser_set_envar( cbl_refer_t envar, cbl_refer_t refer );
|
||||
|
|
@ -263,8 +266,10 @@ void parser_exit_program(void); // exits back to COBOL only, else continue
|
|||
|
||||
void
|
||||
parser_display( const struct cbl_special_name_t *upon,
|
||||
struct cbl_refer_t args[], size_t n,
|
||||
bool advance = DISPLAY_ADVANCE );
|
||||
std::vector<cbl_refer_t> args,
|
||||
bool advance = DISPLAY_ADVANCE,
|
||||
cbl_label_t *not_error = nullptr,
|
||||
cbl_label_t *compute_error = nullptr );
|
||||
|
||||
void parser_display_field(cbl_field_t *fld);
|
||||
|
||||
|
|
|
|||
|
|
@ -38,29 +38,24 @@
|
|||
|
||||
extern int yy_flex_debug;
|
||||
|
||||
static struct {
|
||||
bool first_file, explicitly;
|
||||
int column, right_margin;
|
||||
bool inference_pending() {
|
||||
bool tf = first_file && !explicitly;
|
||||
first_file = false;
|
||||
return tf;
|
||||
source_format_t& cdf_source_format();
|
||||
|
||||
void
|
||||
source_format_t::infer( const char *bol, bool want_reference_format ) {
|
||||
if( bol ) {
|
||||
left = 7;
|
||||
if( want_reference_format ) {
|
||||
right = 73;
|
||||
}
|
||||
}
|
||||
inline bool is_fixed() const { return column == 7; }
|
||||
inline bool is_reffmt() const { return is_fixed() && right_margin == 73; }
|
||||
inline bool is_free() const { return ! is_fixed(); }
|
||||
|
||||
const char * description() const {
|
||||
if( is_reffmt() ) return "REFERENCE";
|
||||
if( is_fixed() ) return "FIXED";
|
||||
if( is_free() ) return "FREE";
|
||||
gcc_unreachable();
|
||||
}
|
||||
} indicator = { true, false, 0, 0 };
|
||||
dbgmsg("%s:%d: %s format detected", __func__, __LINE__,
|
||||
description());
|
||||
}
|
||||
|
||||
|
||||
// public source format test functions
|
||||
bool is_fixed_format() { return indicator.is_fixed(); }
|
||||
bool is_reference_format() { return indicator.is_reffmt(); }
|
||||
bool is_fixed_format() { return cdf_source_format().is_fixed(); }
|
||||
bool is_reference_format() { return cdf_source_format().is_reffmt(); }
|
||||
|
||||
static bool debug_mode = false;
|
||||
|
||||
|
|
@ -76,11 +71,10 @@ static bool debug_mode = false;
|
|||
*/
|
||||
|
||||
static inline int left_margin() {
|
||||
return indicator.column == 0? indicator.column : indicator.column - 1;
|
||||
return cdf_source_format().left_margin();
|
||||
}
|
||||
static inline int right_margin() {
|
||||
return indicator.right_margin == 0?
|
||||
indicator.right_margin : indicator.right_margin - 1;
|
||||
return cdf_source_format().right_margin();
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
@ -89,18 +83,9 @@ static inline int right_margin() {
|
|||
* When setting back to 0 (free), the right margin is also reset to 0.
|
||||
*/
|
||||
void
|
||||
cobol_set_indicator_column( int column )
|
||||
{
|
||||
indicator.explicitly = true;
|
||||
if( column == 0 ) indicator.right_margin = 0;
|
||||
if( column < 0 ) {
|
||||
column = -column;
|
||||
indicator.right_margin = 73;
|
||||
}
|
||||
indicator.column = column;
|
||||
}
|
||||
cobol_set_indicator_column( int column );
|
||||
|
||||
bool include_debug() { return indicator.column == 7 && debug_mode; }
|
||||
bool include_debug() { return is_fixed_format() && debug_mode; }
|
||||
bool set_debug( bool tf ) { return debug_mode = tf && is_fixed_format(); }
|
||||
|
||||
static bool nonblank( const char ch ) { return !isblank(ch); }
|
||||
|
|
@ -114,7 +99,7 @@ start_of_line( char *bol, char *eol ) {
|
|||
|
||||
static inline char *
|
||||
continues_at( char *bol, char *eol ) {
|
||||
if( indicator.column == 0 ) return NULL; // cannot continue in free format
|
||||
if( cdf_source_format().is_free() ) return NULL; // cannot continue in free format
|
||||
bol += left_margin();
|
||||
if( *bol != '-' ) return NULL; // not a continuation line
|
||||
return start_of_line(++bol, eol);
|
||||
|
|
@ -124,7 +109,7 @@ continues_at( char *bol, char *eol ) {
|
|||
// NULL means no indicator column or tested value not present.
|
||||
static inline char *
|
||||
indicated( char *bol, const char *eol, char ch = '\0' ) {
|
||||
if( indicator.column == 0 && *bol != '*' ) {
|
||||
if( cdf_source_format().left_margin() == 0 && *bol != '*' ) {
|
||||
return NULL; // no indicator column in free format, except for comments
|
||||
}
|
||||
gcc_assert(bol != NULL);
|
||||
|
|
@ -365,9 +350,9 @@ check_source_format_directive( filespan_t& mfile ) {
|
|||
|
||||
dbgmsg( "%s:%d: %s format set, on line " HOST_SIZE_T_PRINT_UNSIGNED,
|
||||
__func__, __LINE__,
|
||||
indicator.column == 7? "FIXED" : "FREE",
|
||||
cdf_source_format().description(),
|
||||
(fmt_size_t)mfile.lineno() );
|
||||
char *bol = indicator.is_fixed()? mfile.cur : const_cast<char*>(cm[0].first);
|
||||
char *bol = cdf_source_format().is_fixed()? mfile.cur : const_cast<char*>(cm[0].first);
|
||||
erase_line(bol, const_cast<char*>(cm[0].second));
|
||||
mfile.cur = const_cast<char*>(cm[0].second);
|
||||
}
|
||||
|
|
@ -1695,17 +1680,11 @@ cdftext::free_form_reference_format( int input ) {
|
|||
/*
|
||||
* Infer source code format.
|
||||
*/
|
||||
if( indicator.inference_pending() ) {
|
||||
if( cdf_source_format().inference_pending() ) {
|
||||
const char *bol = valid_sequence_area(mfile.data, mfile.eodata);
|
||||
if( bol ) {
|
||||
indicator.column = 7;
|
||||
if( infer_reference_format(bol, mfile.eodata) ) {
|
||||
indicator.right_margin = 73;
|
||||
}
|
||||
cdf_source_format().infer( bol, infer_reference_format(bol, mfile.eodata) );
|
||||
}
|
||||
|
||||
dbgmsg("%s:%d: %s format detected", __func__, __LINE__,
|
||||
indicator.description());
|
||||
}
|
||||
|
||||
while( mfile.next_line() ) {
|
||||
|
|
|
|||
|
|
@ -45,6 +45,7 @@
|
|||
};
|
||||
|
||||
enum accept_func_t {
|
||||
accept_e,
|
||||
accept_done_e,
|
||||
accept_command_line_e,
|
||||
accept_envar_e,
|
||||
|
|
@ -349,7 +350,7 @@
|
|||
%token <string> SECTION
|
||||
%token <number> STANDARD_ALPHABET "STANDARD ALPHABET"
|
||||
%token <string> SWITCH
|
||||
%token <string> UPSI
|
||||
%token <string> UPSI
|
||||
%token <number> ZERO
|
||||
|
||||
/* environment names */
|
||||
|
|
@ -399,7 +400,10 @@
|
|||
STRING_kw "STRING" STOP SUBTRACT START
|
||||
UNSTRING WRITE WHEN
|
||||
|
||||
ABS ACCESS ACOS ACTUAL ADVANCING AFTER ALL
|
||||
ARGUMENT_NUMBER ARGUMENT_VALUE
|
||||
ENVIRONMENT_NAME ENVIRONMENT_VALUE
|
||||
|
||||
ABS ACCESS ACOS ACTUAL ADVANCING AFTER ALL
|
||||
ALLOCATE
|
||||
ALPHABET ALPHABETIC ALPHABETIC_LOWER "ALPHABETIC-LOWER"
|
||||
ALPHABETIC_UPPER "ALPHABETIC-UPPER"
|
||||
|
|
@ -793,6 +797,7 @@
|
|||
%type <error_clauses> io_invalids read_eofs write_eops
|
||||
%type <boolean> io_invalid read_eof write_eop
|
||||
global is_global anycase backward
|
||||
end_display
|
||||
%type <number> mistake globally first_last
|
||||
%type <io_mode> io_mode
|
||||
|
||||
|
|
@ -848,7 +853,7 @@
|
|||
declarative_list_t* dcl_list_t;
|
||||
isym_list_t* isym_list;
|
||||
struct { radix_t radix; char *string; } numstr;
|
||||
struct { int token; literal_t name; } prog_end;
|
||||
struct { YYLTYPE loc; int token; literal_t name; } prog_end;
|
||||
struct { int token; special_name_t id; } special_type;
|
||||
struct { cbl_field_type_t type;
|
||||
uint32_t capacity; bool signable; } computational;
|
||||
|
|
@ -902,7 +907,7 @@
|
|||
struct refer_pair_t { cbl_refer_t *first, *second; } refer2;
|
||||
struct { refer_collection_t *inputs; refer_pair_t into; } str_body;
|
||||
|
||||
struct { accept_func_t func; cbl_refer_t *into, *from; } accept_func;
|
||||
struct { accept_func_t func; cbl_refer_t *into, *from; special_name_t special;} accept_func;
|
||||
struct unstring_into_t *uns_into;
|
||||
struct unstring_tgt_list_t *uns_tgts;
|
||||
struct unstring_tgt_t *uns_tgt;
|
||||
|
|
@ -1513,7 +1518,7 @@ program_as: %empty { static const literal_t empty {}; $$ = empty; }
|
|||
| AS LITERAL { $$ = $2; }
|
||||
;
|
||||
|
||||
function_id: FUNCTION '.' NAME program_as program_attrs[attr] '.'
|
||||
function_id: FUNCTION NAME program_as program_attrs[attr] '.'
|
||||
{
|
||||
internal_ebcdic_lock();
|
||||
current_division = identification_div_e;
|
||||
|
|
@ -1547,7 +1552,7 @@ function_id: FUNCTION '.' NAME program_as program_attrs[attr] '.'
|
|||
current.udf_add(current_program_index());
|
||||
if( nparse_error > 0 ) YYABORT;
|
||||
}
|
||||
| FUNCTION '.' NAME program_as is PROTOTYPE '.'
|
||||
| FUNCTION NAME program_as is PROTOTYPE '.'
|
||||
{
|
||||
cbl_unimplemented("FUNCTION PROTOTYPE");
|
||||
}
|
||||
|
|
@ -1838,7 +1843,7 @@ select: SELECT optional NAME[name] select_clauses[clauses] '.'
|
|||
cbl_file_t *file = $clauses.file;
|
||||
|
||||
file->optional = $optional;
|
||||
file->line = yylineno;
|
||||
file->line = @name.first_line;
|
||||
if( !namcpy(@clauses, file->name, $name) ) YYERROR;
|
||||
|
||||
if( ! ($clauses.clauses & assign_clause_e) ) {
|
||||
|
|
@ -1911,7 +1916,7 @@ select: SELECT optional NAME[name] select_clauses[clauses] '.'
|
|||
cbl_file_t file = protofile;
|
||||
|
||||
file.optional = $optional;
|
||||
file.line = yylineno;
|
||||
file.line = @name.first_line;
|
||||
if( !namcpy(@name, file.name, $name) ) YYERROR;
|
||||
|
||||
if( file_add(@name, &file) == NULL ) YYERROR;
|
||||
|
|
@ -2473,7 +2478,7 @@ special_name: dev_mnemonic
|
|||
| CLASS NAME is domains
|
||||
{
|
||||
struct cbl_field_t field = { 0,
|
||||
FldClass, FldInvalid, 0, 0, 0, 0, nonarray, yylineno, "",
|
||||
FldClass, FldInvalid, 0, 0, 0, 0, nonarray, @NAME.first_line, "",
|
||||
0, cbl_field_t::linkage_t(),
|
||||
{}, NULL };
|
||||
if( !namcpy(@NAME, field.name, $2) ) YYERROR;
|
||||
|
|
@ -2604,6 +2609,10 @@ device_name: SYSIN { $$.token = SYSIN; $$.id = SYSIN_e; }
|
|||
| STDIN { $$.token = STDIN; $$.id = STDIN_e; }
|
||||
| STDOUT { $$.token = STDOUT; $$.id = STDOUT_e; }
|
||||
| STDERR { $$.token = STDERR; $$.id = STDERR_e; }
|
||||
/* These cannot be both ctx_name and here. *
|
||||
/* ARGUMENT_NUMBER { $$.token=0; $$.id = ARG_NUM_e; } */
|
||||
/* ENVIRONMENT_NAME { $$.token=0; $$.id = ENV_NAME_e; } */
|
||||
/* ENVIRONMENT_VALUE { $$.token=0; $$.id = ENV_VALUE_e; } */
|
||||
;
|
||||
|
||||
alphabet_name: STANDARD_ALPHABET { $$ = alphabet_add(@1, ASCII_e); }
|
||||
|
|
@ -3164,7 +3173,7 @@ depending: %empty
|
|||
assert(e->type == SymField);
|
||||
odo = symbol_index(e);
|
||||
} else {
|
||||
e = symbol_field_forward_add(PROGRAM, 0, $NAME, yylineno);
|
||||
e = symbol_field_forward_add(PROGRAM, 0, $NAME, @NAME.first_line);
|
||||
if( !e ) YYERROR;
|
||||
symbol_field_location( symbol_index(e), @NAME );
|
||||
odo = field_index(cbl_field_of(e));
|
||||
|
|
@ -3364,7 +3373,7 @@ level_name: LEVEL ctx_name
|
|||
}
|
||||
struct cbl_field_t field = { 0,
|
||||
FldInvalid, FldInvalid, 0, 0, 0, capacity_cast($1),
|
||||
nonarray, yylineno, "",
|
||||
nonarray, @ctx_name.first_line, "",
|
||||
0, cbl_field_t::linkage_t(),
|
||||
{}, NULL };
|
||||
if( !namcpy(@ctx_name, field.name, $2) ) YYERROR;
|
||||
|
|
@ -3389,7 +3398,7 @@ level_name: LEVEL ctx_name
|
|||
}
|
||||
struct cbl_field_t field = { 0,
|
||||
FldInvalid, FldInvalid, 0, 0, 0, capacity_cast($1),
|
||||
nonarray, yylineno, "",
|
||||
nonarray, @LEVEL.first_line, "",
|
||||
0, {}, {}, NULL };
|
||||
|
||||
$$ = field_add(@1, &field);
|
||||
|
|
@ -3527,7 +3536,7 @@ data_descr1: level_name
|
|||
}
|
||||
struct cbl_field_t field = { 0, FldLiteralA, FldInvalid,
|
||||
constant_e, 0, 0, 78, nonarray,
|
||||
yylineno, "", 0, {}, *$data, NULL };
|
||||
@name.first_line, "", 0, {}, *$data, NULL };
|
||||
if( !namcpy(@name, field.name, $name) ) YYERROR;
|
||||
if( field.data.initial ) {
|
||||
field.attr |= quoted_e;
|
||||
|
|
@ -3550,7 +3559,7 @@ data_descr1: level_name
|
|||
| LEVEL88 NAME /* VALUE */ NULLPTR
|
||||
{
|
||||
struct cbl_field_t field = { 0,
|
||||
FldClass, FldInvalid, 0, 0, 0, 88, nonarray, yylineno, "",
|
||||
FldClass, FldInvalid, 0, 0, 0, 88, nonarray, @NAME.first_line, "",
|
||||
0, cbl_field_t::linkage_t(),
|
||||
{}, NULL };
|
||||
if( !namcpy(@NAME, field.name, $2) ) YYERROR;
|
||||
|
|
@ -3576,7 +3585,7 @@ data_descr1: level_name
|
|||
| LEVEL88 NAME VALUE domains
|
||||
{
|
||||
struct cbl_field_t field = { 0,
|
||||
FldClass, FldInvalid, 0, 0, 0, 88, nonarray, yylineno, "",
|
||||
FldClass, FldInvalid, 0, 0, 0, 88, nonarray, @NAME.first_line, "",
|
||||
0, cbl_field_t::linkage_t(),
|
||||
{}, NULL };
|
||||
if( !namcpy(@NAME, field.name, $2) ) YYERROR;
|
||||
|
|
@ -4606,7 +4615,7 @@ justified_clause: is JUSTIFIED
|
|||
|
||||
redefines_clause: REDEFINES NAME[orig]
|
||||
{
|
||||
struct symbol_elem_t *e = field_of($orig);
|
||||
struct symbol_elem_t *e = symbol_field(PROGRAM, 0, $orig);
|
||||
if( !e ) {
|
||||
error_msg(@2, "REDEFINES target not defined");
|
||||
YYERROR;
|
||||
|
|
@ -5068,9 +5077,8 @@ statement: error {
|
|||
|
||||
/*
|
||||
* ISO defines ON EXCEPTION only for Format 3 (screen). We
|
||||
* implement extensions defined by MF and Fujitsu (and us) to
|
||||
* use ACCEPT to interact with the command line and the
|
||||
* environment.
|
||||
* implement extensions defined by MF and Fujitsu to use ACCEPT
|
||||
* to interact with the command line and the environment.
|
||||
*
|
||||
* ISO ACCEPT and some others are implemented in accept_body,
|
||||
* before the parser sees any ON EXCEPTION. In those cases
|
||||
|
|
@ -5085,6 +5093,9 @@ accept: accept_body end_accept {
|
|||
switch( $accept_body.func ) {
|
||||
case accept_done_e:
|
||||
break;
|
||||
case accept_e:
|
||||
parser_accept(*$1.into, $1.special, nullptr, nullptr);
|
||||
break;
|
||||
case accept_command_line_e:
|
||||
if( $1.from->field == NULL ) { // take next command-line arg
|
||||
parser_accept_command_line(*$1.into, argi, NULL, NULL);
|
||||
|
|
@ -5108,6 +5119,9 @@ accept: accept_body end_accept {
|
|||
error_msg(@ec, "ON EXCEPTION valid only "
|
||||
"with ENVIRONMENT or COMMAND-LINE(n)");
|
||||
break;
|
||||
case accept_e:
|
||||
parser_accept(*$1.into, $1.special, $ec.on_error, $ec.not_error);
|
||||
break;
|
||||
case accept_command_line_e:
|
||||
if( $1.from->field == NULL ) { // take next command-line arg
|
||||
parser_accept_command_line(*$1.into, argi,
|
||||
|
|
@ -5139,7 +5153,7 @@ end_accept: %empty %prec ACCEPT
|
|||
accept_body: accept_refer
|
||||
{
|
||||
$$.func = accept_done_e;
|
||||
parser_accept(*$1, CONSOLE_e);
|
||||
parser_accept(*$1, CONSOLE_e, nullptr, nullptr);
|
||||
}
|
||||
| accept_refer FROM DATE
|
||||
{
|
||||
|
|
@ -5198,29 +5212,15 @@ accept_body: accept_refer
|
|||
}
|
||||
| accept_refer FROM acceptable
|
||||
{
|
||||
cbl_field_t *argc = register_find("_ARGI");
|
||||
switch( $acceptable->id ) {
|
||||
case ARG_NUM_e:
|
||||
$$.func = accept_command_line_e;
|
||||
$$.into = $1;
|
||||
$$.from = new_reference(argc);
|
||||
break;
|
||||
case ARG_VALUE_e:
|
||||
$$.func = accept_command_line_e;
|
||||
$$.into = $1;
|
||||
$$.from = cbl_refer_t::empty();
|
||||
break;
|
||||
default:
|
||||
$$.func = accept_done_e;
|
||||
parser_accept( *$1, $acceptable->id );
|
||||
}
|
||||
$$.func = accept_e;
|
||||
$$.into = $1;
|
||||
$$.special = $acceptable->id;
|
||||
}
|
||||
| accept_refer FROM ENVIRONMENT envar
|
||||
{
|
||||
$$.func = accept_envar_e;
|
||||
$$.into = $1;
|
||||
$$.from = $envar;
|
||||
//// parser_accept_envar( *$1, *$envar );
|
||||
}
|
||||
| accept_refer FROM COMMAND_LINE
|
||||
{
|
||||
|
|
@ -5232,7 +5232,6 @@ accept_body: accept_refer
|
|||
$$.func = accept_command_line_e;
|
||||
$$.into = $1;
|
||||
$$.from = $expr;
|
||||
//// parser_accept_command_line(*$1, $expr->field );
|
||||
}
|
||||
| accept_refer FROM COMMAND_LINE_COUNT {
|
||||
$$.func = accept_done_e;
|
||||
|
|
@ -5285,7 +5284,7 @@ accept_except: EXCEPTION
|
|||
{
|
||||
$$.not_error = NULL;
|
||||
$$.on_error = label_add(LblArith,
|
||||
uniq_label("accept"), yylineno);
|
||||
uniq_label("accept"), @1.first_line);
|
||||
if( !$$.on_error ) YYERROR;
|
||||
parser_accept_exception( $$.on_error );
|
||||
|
||||
|
|
@ -5320,15 +5319,54 @@ acceptable: device_name
|
|||
error_msg(@NAME, "no such special name '%s'", $NAME);
|
||||
YYERROR;
|
||||
}
|
||||
if( ENV_NAME_e == *special_type ) {
|
||||
error_msg(@NAME, "cannot ACCEPT FROM %qs", $NAME);
|
||||
YYERROR;
|
||||
}
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special = { 0, *special_type };
|
||||
int token = 0;
|
||||
switch(*special_type) {
|
||||
case ARG_NUM_e: token = ARGUMENT_NUMBER; break;
|
||||
case ARG_VALUE_e: token = ARGUMENT_VALUE; break;
|
||||
case ENV_VALUE_e: token = ENVIRONMENT_VALUE; break;
|
||||
|
||||
case ENV_NAME_e:
|
||||
default:
|
||||
error_msg(@NAME, "cannot ACCEPT FROM %qs", $NAME);
|
||||
YYERROR;
|
||||
break;
|
||||
}
|
||||
cbl_special_name_t special = { token, *special_type };
|
||||
namcpy(@NAME, special.name, $NAME);
|
||||
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
cbl_special_name_t& unused(*$$);
|
||||
assert(unused.id);
|
||||
}
|
||||
assert($$);
|
||||
}
|
||||
| ENVIRONMENT_VALUE {
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special =
|
||||
{ ENVIRONMENT_VALUE, ENV_VALUE_e, "ENVIRONMENT-VALUE" };
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
| ARGUMENT_NUMBER {
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special =
|
||||
{ ARGUMENT_NUMBER, ARG_NUM_e, "ARGUMENT-NUMBER" };
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
| ARGUMENT_VALUE {
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special =
|
||||
{ ARGUMENT_VALUE, ARG_VALUE_e, "ARGUMENT-VALUE" };
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
;
|
||||
|
||||
add: add_impl end_add { ast_add($1); }
|
||||
|
|
@ -5558,46 +5596,18 @@ compute_expr: '=' {
|
|||
}
|
||||
;
|
||||
|
||||
display: disp_body end_display
|
||||
display: disp_body end_display[advance]
|
||||
{
|
||||
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");
|
||||
}
|
||||
const cbl_refer_t& src( $1.vargs->args.front() );
|
||||
cbl_field_t *dst = register_find("_ARGI");
|
||||
parser_move( dst, src );
|
||||
} else {
|
||||
parser_display($1.special,
|
||||
args.empty()? NULL : args.data(), args.size(),
|
||||
DISPLAY_ADVANCE);
|
||||
}
|
||||
current.declaratives_evaluate();
|
||||
}
|
||||
| disp_body NO ADVANCING end_display
|
||||
{
|
||||
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");
|
||||
}
|
||||
const cbl_refer_t& src( $1.vargs->args.front() );
|
||||
cbl_field_t *dst = register_find("_ARGI");
|
||||
parser_move( dst, src );
|
||||
} else {
|
||||
parser_display($1.special,
|
||||
args.empty()? NULL : args.data(), args.size(),
|
||||
DISPLAY_NO_ADVANCE);
|
||||
}
|
||||
std::vector <cbl_refer_t> args($1.vargs->args.begin(),
|
||||
$1.vargs->args.end());
|
||||
parser_display($1.special, args, $advance);
|
||||
current.declaratives_evaluate();
|
||||
}
|
||||
;
|
||||
end_display: %empty
|
||||
| END_DISPLAY
|
||||
end_display: %empty { $$ = DISPLAY_ADVANCE; }
|
||||
| END_DISPLAY { $$ = DISPLAY_ADVANCE; }
|
||||
| NO ADVANCING { $$ = DISPLAY_NO_ADVANCE; }
|
||||
| NO ADVANCING END_DISPLAY { $$ = DISPLAY_NO_ADVANCE; }
|
||||
;
|
||||
disp_body: disp_vargs[vargs]
|
||||
{
|
||||
|
|
@ -5628,14 +5638,48 @@ disp_upon: device_name {
|
|||
error_msg(@NAME, "no such special name '%s'", $NAME);
|
||||
YYERROR;
|
||||
}
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special = { 0, *special_type };
|
||||
// Add the name now, as a convenience.
|
||||
// These may come through as a NAME, depending on how scanned.
|
||||
int token = 0;
|
||||
switch(*special_type) {
|
||||
case ARG_NUM_e: token = ARGUMENT_NUMBER; break;
|
||||
case ENV_NAME_e: token = ENVIRONMENT_NAME; break;
|
||||
case ENV_VALUE_e: token = ENVIRONMENT_VALUE; break;
|
||||
|
||||
case ARG_VALUE_e:
|
||||
default:
|
||||
error_msg(@NAME, "cannot DISPLAY UPON %qs", $NAME);
|
||||
YYERROR;
|
||||
break;
|
||||
}
|
||||
cbl_special_name_t special = { token, *special_type };
|
||||
namcpy(@NAME, special.name, $NAME);
|
||||
|
||||
e = symbol_special_add(PROGRAM, &special);
|
||||
}
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
| ARGUMENT_NUMBER {
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special =
|
||||
{ ARGUMENT_NUMBER, ARG_NUM_e, "ARGUMENT-NUMBER" };
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
| ENVIRONMENT_NAME {
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special =
|
||||
{ ENVIRONMENT_NAME, ENV_NAME_e, "ENVIRONMENT-NAME" };
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
| ENVIRONMENT_VALUE {
|
||||
// Add the name now, as a convenience.
|
||||
cbl_special_name_t special =
|
||||
{ ENVIRONMENT_VALUE, ENV_VALUE_e, "ENVIRONMENT-VALUE" };
|
||||
symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
|
||||
$$ = cbl_special_name_of(e);
|
||||
}
|
||||
;
|
||||
|
||||
divide: divide_impl end_divide { ast_divide($1); }
|
||||
|
|
@ -5733,14 +5777,14 @@ end_program: end_program1[end] '.'
|
|||
gcc_unreachable();
|
||||
}
|
||||
if( !matches ) {
|
||||
error_msg(@end, "END %s %s does not match "
|
||||
error_msg($end.loc, "END %s %s does not match "
|
||||
"%<IDENTIFICATION DIVISION %s%>",
|
||||
token_name, name, prog->name);
|
||||
YYERROR;
|
||||
}
|
||||
|
||||
if( 0 != strcasecmp(prog->name, name) ) {
|
||||
error_msg(@end, "END PROGRAM '%s' does not match PROGRAM-ID '%s'",
|
||||
error_msg($end.loc, "END PROGRAM '%s' does not match PROGRAM-ID '%s'",
|
||||
name, prog->name);
|
||||
YYERROR;
|
||||
}
|
||||
|
|
@ -5773,20 +5817,24 @@ end_program: end_program1[end] '.'
|
|||
;
|
||||
end_program1: END_PROGRAM namestr[name]
|
||||
{
|
||||
$$.loc = @name;
|
||||
$$.token = END_PROGRAM;
|
||||
$$.name = $name;
|
||||
}
|
||||
| END_FUNCTION namestr[name]
|
||||
{
|
||||
$$.loc = @name;
|
||||
$$.token = END_FUNCTION;
|
||||
$$.name = $name;
|
||||
}
|
||||
| END_PROGRAM '.' // error
|
||||
{
|
||||
$$.loc = @1;
|
||||
$$.token = END_PROGRAM;
|
||||
}
|
||||
| END_FUNCTION '.' // error
|
||||
{
|
||||
$$.loc = @1;
|
||||
$$.token = END_FUNCTION;
|
||||
}
|
||||
;
|
||||
|
|
@ -6622,7 +6670,7 @@ name: qname
|
|||
auto name = names.front();
|
||||
names.pop_front();
|
||||
auto e = symbol_field_forward_add(PROGRAM, parent,
|
||||
name, yylineno);
|
||||
name, @1.first_line);
|
||||
if( !e ) YYERROR;
|
||||
symbol_field_location( symbol_index(e), @qname );
|
||||
parent = symbol_index(e);
|
||||
|
|
@ -6652,6 +6700,10 @@ ctx_name: NAME
|
|||
|
||||
context_word: APPLY { static char s[] ="APPLY";
|
||||
$$ = s; } // screen description entry
|
||||
| ARGUMENT_NUMBER { static char s[] ="ARGUMENT-NUMBER";
|
||||
$$ = s; } // Display Upon / Accept From
|
||||
| ARGUMENT_VALUE { static char s[] ="ARGUMENT-VALUE";
|
||||
$$ = s; } // Accept From
|
||||
| ARITHMETIC { static char s[] ="ARITHMETIC";
|
||||
$$ = s; } // OPTIONS paragraph
|
||||
| ATTRIBUTE { static char s[] ="ATTRIBUTE";
|
||||
|
|
@ -6688,6 +6740,10 @@ context_word: APPLY { static char s[] ="APPLY";
|
|||
$$ = s; } // ERASE clause in a screen description entry
|
||||
| ENTRY_CONVENTION { static char s[] ="ENTRY-CONVENTION";
|
||||
$$ = s; } // OPTIONS paragraph
|
||||
| ENVIRONMENT_NAME { static char s[] ="ENVIRONMENT-NAME";
|
||||
$$ = s; } // Display Upon
|
||||
| ENVIRONMENT_VALUE { static char s[] ="ENVIRONMENT-VALUE";
|
||||
$$ = s; } // Display Upon / Accept From
|
||||
| ERASE { static char s[] ="ERASE";
|
||||
$$ = s; } // screen description entry
|
||||
| EXPANDS { static char s[] ="EXPANDS";
|
||||
|
|
@ -7036,9 +7092,9 @@ arith_err: SIZE_ERROR
|
|||
*ptgt = $1 == NOT?
|
||||
current.compute_not_error() : current.compute_on_error();
|
||||
} else {
|
||||
*ptgt = label_add(LblArith, uniq_label("arith"), yylineno);
|
||||
*ptgt = label_add(LblArith, uniq_label("arith"), @1.first_line);
|
||||
}
|
||||
(*ptgt)->lain = yylineno;
|
||||
(*ptgt)->lain = @1.first_line;
|
||||
parser_arith_error( *ptgt );
|
||||
}
|
||||
;
|
||||
|
|
@ -8754,12 +8810,12 @@ search_1_body: name[table] search_varying[varying]
|
|||
|
||||
cbl_name_t label_name;
|
||||
auto len = snprintf(label_name, sizeof(label_name),
|
||||
"linear_search_%d", yylineno);
|
||||
"linear_search_%d", @1.first_line);
|
||||
if( ! (0 < len && len < int(sizeof(label_name))) ) {
|
||||
gcc_unreachable();
|
||||
}
|
||||
cbl_label_t *name = label_add( LblSearch,
|
||||
label_name, yylineno );
|
||||
label_name, @1.first_line );
|
||||
auto varying($varying);
|
||||
if( index == varying ) varying = NULL;
|
||||
parser_lsearch_start( name, $table, index, varying );
|
||||
|
|
@ -8812,9 +8868,9 @@ search_binary: SEARCH ALL search_2_body search_2_cases
|
|||
search_2_body: name[table]
|
||||
{
|
||||
statement_begin(@$, SEARCH);
|
||||
char *label_name = xasprintf("binary_search_%d", yylineno);
|
||||
char *label_name = xasprintf("binary_search_%d", @1.first_line);
|
||||
cbl_label_t *name = label_add( LblSearch,
|
||||
label_name, yylineno );
|
||||
label_name, @1.first_line );
|
||||
parser_bsearch_start( name, $table );
|
||||
search_alloc(name);
|
||||
}
|
||||
|
|
@ -9759,7 +9815,7 @@ call_except: EXCEPTION
|
|||
{
|
||||
$$.not_error = NULL;
|
||||
$$.on_error = label_add(LblArith,
|
||||
uniq_label("call"), yylineno);
|
||||
uniq_label("call"), @1.first_line);
|
||||
if( !$$.on_error ) YYERROR;
|
||||
parser_call_exception( $$.on_error );
|
||||
|
||||
|
|
@ -9772,7 +9828,7 @@ call_except: EXCEPTION
|
|||
{
|
||||
$$.not_error = NULL;
|
||||
$$.on_error = label_add(LblArith,
|
||||
uniq_label("call"), yylineno);
|
||||
uniq_label("call"), @1.first_line);
|
||||
if( !$$.on_error ) YYERROR;
|
||||
parser_call_exception( $$.on_error );
|
||||
|
||||
|
|
@ -9828,7 +9884,7 @@ go_to: GOTO labels[args]
|
|||
}
|
||||
|
||||
for( auto& label : $args->elems ) {
|
||||
label->used = yylineno;
|
||||
label->used = @2.first_line;
|
||||
}
|
||||
cbl_label_t *arg = $args->elems.front();
|
||||
parser_goto( cbl_refer_t(), 1, &arg );
|
||||
|
|
@ -9840,7 +9896,7 @@ go_to: GOTO labels[args]
|
|||
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;
|
||||
label->used = @2.first_line;
|
||||
}
|
||||
parser_goto( *$value, args.size(), args.data() );
|
||||
}
|
||||
|
|
@ -9860,7 +9916,7 @@ resume: RESUME NEXT STATEMENT
|
|||
{
|
||||
statement_begin(@1, RESUME);
|
||||
parser_clear_exception();
|
||||
$tgt->used = yylineno;
|
||||
$tgt->used = @1.first_line;
|
||||
parser_goto( cbl_refer_t(), 1, &$tgt );
|
||||
}
|
||||
;
|
||||
|
|
@ -10035,7 +10091,7 @@ on_overflow: OVERFLOW_kw
|
|||
{
|
||||
$$.not_error = NULL;
|
||||
$$.on_error = label_add(LblString,
|
||||
uniq_label("string"), yylineno);
|
||||
uniq_label("string"), @1.first_line);
|
||||
if( !$$.on_error ) YYERROR;
|
||||
parser_string_overflow( $$.on_error );
|
||||
|
||||
|
|
@ -11464,6 +11520,8 @@ keyword_str( int token ) {
|
|||
return tokens.name_of(token);
|
||||
}
|
||||
|
||||
bool iso_cobol_word( const std::string& name, bool include_context );
|
||||
|
||||
/*
|
||||
* Return the token for the Cobol name, unless it is a function name. The
|
||||
* lexer uses keyword_tok to determine if what appears to be a NAME is in fact
|
||||
|
|
@ -11474,15 +11532,14 @@ keyword_str( int token ) {
|
|||
*/
|
||||
|
||||
// tokens.h is generated as needed from parse.h with tokens.h.gen
|
||||
tokenset_t::tokenset_t() {
|
||||
current_tokens_t::tokenset_t::tokenset_t() {
|
||||
#include "token_names.h"
|
||||
}
|
||||
|
||||
bool iso_cobol_word( const std::string& name, bool include_context );
|
||||
|
||||
// Look up the lowercase form of a keyword, excluding some CDF names.
|
||||
int
|
||||
tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) {
|
||||
current_tokens_t::tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) {
|
||||
static const cbl_name_t non_names[] = { // including CDF NAMES, and "SWITCH"
|
||||
"CHECKING", "LIST", "LOCATION", "MAP", "SWITCH",
|
||||
}, * const eonames = non_names + COUNT_OF(non_names);
|
||||
|
|
|
|||
|
|
@ -935,161 +935,7 @@ teed_up_names() {
|
|||
return name_queue_t::namelist_of( name_queue.peek() );
|
||||
}
|
||||
|
||||
class tokenset_t {
|
||||
// token_names is initialized from a generated header file.
|
||||
std::vector<const char *>token_names; // position indicates token value
|
||||
std::map <std::string, int> tokens; // aliases
|
||||
std::set<std::string> cobol_words; // Anything in COBOL-WORDS may appear only once.
|
||||
public:
|
||||
static std::string
|
||||
lowercase( const cbl_name_t name ) {
|
||||
cbl_name_t lname;
|
||||
std::transform(name, name + strlen(name) + 1, lname, ftolower);
|
||||
return lname;
|
||||
}
|
||||
static std::string
|
||||
uppercase( const cbl_name_t name ) {
|
||||
cbl_name_t uname;
|
||||
std::transform(name, name + strlen(name) + 1, uname, ftoupper);
|
||||
return uname;
|
||||
}
|
||||
|
||||
public:
|
||||
tokenset_t();
|
||||
int find( const cbl_name_t name, bool include_intrinsics );
|
||||
|
||||
bool equate( const YYLTYPE& loc, int token,
|
||||
const cbl_name_t name, const cbl_name_t verb = "EQUATE") {
|
||||
auto lname( lowercase(name) );
|
||||
auto cw = cobol_words.insert(lname);
|
||||
if( ! cw.second ) {
|
||||
error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
|
||||
return false;
|
||||
}
|
||||
auto p = tokens.find(lowercase(name));
|
||||
bool fOK = p == tokens.end();
|
||||
if( fOK ) { // name not already in use
|
||||
tokens[lname] = token;
|
||||
dbgmsg("%s:%d: %d has alias %s", __func__, __LINE__, token, name);
|
||||
} else {
|
||||
error_msg(loc, "%s: %s already defined as a token", verb, name);
|
||||
}
|
||||
return fOK;
|
||||
}
|
||||
bool undefine( const YYLTYPE& loc,
|
||||
const cbl_name_t name, const cbl_name_t verb = "UNDEFINE" ) {
|
||||
auto lname( lowercase(name) );
|
||||
auto cw = cobol_words.insert(lname);
|
||||
if( ! cw.second ) {
|
||||
error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
|
||||
return false;
|
||||
}
|
||||
|
||||
// Do not erase generic, multi-type tokens COMPUTATIONAL and BINARY_INTEGER.
|
||||
if( binary_integer_usage_of(name) ) {
|
||||
dbgmsg("%s:%d: generic %s remains valid as a token", __func__, __LINE__, name);
|
||||
return true;
|
||||
}
|
||||
|
||||
auto p = tokens.find(lname);
|
||||
bool fOK = p != tokens.end();
|
||||
if( fOK ) { // name in use
|
||||
tokens.erase(p);
|
||||
} else {
|
||||
error_msg(loc, "%s: %s not defined as a token", verb, name);
|
||||
}
|
||||
dbgmsg("%s:%d: %s removed as a valid token name", __func__, __LINE__, name);
|
||||
return fOK;
|
||||
}
|
||||
|
||||
bool substitute( const YYLTYPE& loc,
|
||||
const cbl_name_t extant, int token, const cbl_name_t name ) {
|
||||
return
|
||||
equate( loc, token, name, "SUBSTITUTE" )
|
||||
&&
|
||||
undefine( loc, extant, "SUBSTITUTE" );
|
||||
}
|
||||
bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
|
||||
auto lname( lowercase(name) );
|
||||
auto cw = cobol_words.insert(lname);
|
||||
if( ! cw.second ) {
|
||||
error_msg(loc, "COBOL-WORDS RESERVE: %s may appear but once", name);
|
||||
return false;
|
||||
}
|
||||
tokens[lname] = -42;
|
||||
return true;
|
||||
}
|
||||
int redefined_as( const cbl_name_t name ) {
|
||||
auto lname( lowercase(name) );
|
||||
if( cobol_words.find(lname) != cobol_words.end() ) {
|
||||
auto p = tokens.find(lname);
|
||||
if( p != tokens.end() ) {
|
||||
return p->second;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
const char * name_of( int tok ) const {
|
||||
tok -= (255 + 3);
|
||||
gcc_assert(0 <= tok && size_t(tok) < token_names.size());
|
||||
return tok < 0? "???" : token_names[tok];
|
||||
}
|
||||
};
|
||||
|
||||
class current_tokens_t {
|
||||
tokenset_t tokens;
|
||||
public:
|
||||
current_tokens_t() {}
|
||||
int find( const cbl_name_t name, bool include_intrinsics ) {
|
||||
return tokens.find(name, include_intrinsics);
|
||||
}
|
||||
bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
|
||||
int token;
|
||||
if( 0 == (token = binary_integer_usage_of(keyword)) ) {
|
||||
if( 0 == (token = keyword_tok(keyword)) ) {
|
||||
error_msg(loc, "EQUATE %s: not a valid token", keyword);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
auto name = keyword_alias_add(tokens.uppercase(keyword),
|
||||
tokens.uppercase(alias));
|
||||
if( name != keyword ) {
|
||||
error_msg(loc, "EQUATE: %s is already an alias for %s", alias, name.c_str());
|
||||
return false;
|
||||
}
|
||||
return tokens.equate(loc, token, alias);
|
||||
}
|
||||
bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) {
|
||||
return tokens.undefine(loc, keyword);
|
||||
}
|
||||
bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
|
||||
int token;
|
||||
if( 0 == (token = binary_integer_usage_of(keyword)) ) {
|
||||
if( 0 == (token = keyword_tok(keyword)) ) {
|
||||
error_msg(loc, "SUBSTITUTE %s: not a valid token", keyword);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
auto name = keyword_alias_add(tokens.uppercase(keyword),
|
||||
tokens.uppercase(alias));
|
||||
if( name != keyword ) {
|
||||
error_msg(loc, "SUBSTITUTE: %s is already an alias for %s", alias, name.c_str());
|
||||
return false;
|
||||
}
|
||||
|
||||
dbgmsg("%s:%d: %s (%d) will have alias %s", __func__, __LINE__, keyword, token, alias);
|
||||
return tokens.substitute(loc, keyword, token, alias);
|
||||
}
|
||||
bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
|
||||
return tokens.reserve(loc, name);
|
||||
}
|
||||
int redefined_as( const cbl_name_t name ) {
|
||||
return tokens.redefined_as(name);
|
||||
}
|
||||
const char * name_of( int tok ) const {
|
||||
return tokens.name_of(tok);
|
||||
}
|
||||
} tokens;
|
||||
current_tokens_t tokens;
|
||||
|
||||
int
|
||||
redefined_token( const cbl_name_t name ) {
|
||||
|
|
@ -2909,17 +2755,6 @@ group_attr( const cbl_field_t * field ) {
|
|||
return p->attr;
|
||||
}
|
||||
|
||||
static struct symbol_elem_t *
|
||||
field_of( const char F[], int L, const char name[] ) {
|
||||
struct symbol_elem_t *e = symbol_field(PROGRAM, 0, name);
|
||||
if( !e ) {
|
||||
cbl_internal_error("%s:%d: no symbol '%s' found", F, L, name);
|
||||
}
|
||||
assert( procedure_div_e != current_division );
|
||||
return e;
|
||||
}
|
||||
#define field_of( F ) field_of(__func__, __LINE__, (F))
|
||||
|
||||
static struct cbl_field_t *
|
||||
field_add( const YYLTYPE& loc, cbl_field_t *field ) {
|
||||
switch(current_data_section) {
|
||||
|
|
|
|||
166
gcc/cobol/scan.l
166
gcc/cobol/scan.l
|
|
@ -83,6 +83,8 @@ NONWORD [^[:alnum:]$_-]+
|
|||
|
||||
SPC [[:space:]]+
|
||||
OSPC [[:space:]]*
|
||||
BLANK [[:blank:]]+
|
||||
OBLANK [[:blank:]]*
|
||||
EOL \r?\n
|
||||
BLANK_EOL [[:blank:]]*{EOL}
|
||||
BLANK_OEOL [[:blank:]]*{EOL}?
|
||||
|
|
@ -160,7 +162,7 @@ COMMA [,;][[:blank:]]*
|
|||
ISNT (IS{SPC})?NOT
|
||||
|
||||
|
||||
COMMENTARY DATE-COMPILED|DATE-WRITTEN|INSTALLATION|SECURITY
|
||||
COMMENTARY AUTHOR|DATE-COMPILED|DATE-WRITTEN|INSTALLATION|SECURITY
|
||||
|
||||
SORT_MERGE SORT(-MERGE)?
|
||||
|
||||
|
|
@ -182,7 +184,7 @@ LINE_DIRECTIVE ^[#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n
|
|||
|
||||
%x procedure_div ident_state addr_of function classify
|
||||
%x program_id_state comment_entries
|
||||
%x author_state date_state field_level field_state dot_state
|
||||
%x date_state field_level field_state dot_state
|
||||
%x numeric_state name_state
|
||||
%x quoted1 quoted2 quoteq
|
||||
%x picture picture_count integer_count
|
||||
|
|
@ -238,30 +240,23 @@ WORKING-STORAGE{SPC}SECTION {
|
|||
yy_push_state(field_state);
|
||||
return WORKING_STORAGE_SECT; }
|
||||
LOCAL-STORAGE{SPC}SECTION {
|
||||
yy_push_state(field_state);
|
||||
return LOCAL_STORAGE_SECT; }
|
||||
WORKING-STORAGE {
|
||||
return WORKING_STORAGE; }
|
||||
LOCAL-STORAGE {
|
||||
return LOCAL_STORAGE; }
|
||||
SCREEN {
|
||||
return SCREEN; }
|
||||
yy_push_state(field_state);
|
||||
return LOCAL_STORAGE_SECT; }
|
||||
WORKING-STORAGE { return WORKING_STORAGE; }
|
||||
LOCAL-STORAGE { return LOCAL_STORAGE; }
|
||||
SCREEN { return SCREEN; }
|
||||
|
||||
LINKAGE{SPC}SECTION {
|
||||
yy_push_state(field_state);
|
||||
return LINKAGE_SECT; }
|
||||
|
||||
FUNCTION-ID { yy_push_state(ident_state);
|
||||
yy_push_state(program_id_state);
|
||||
yy_push_state(name_state); return FUNCTION; }
|
||||
FUNCTION-ID{OSPC}{DOTSEP}? { yy_push_state(ident_state);
|
||||
yy_push_state(program_id_state);
|
||||
yy_push_state(name_state); return FUNCTION; }
|
||||
|
||||
PROGRAM-ID { yy_push_state(ident_state);
|
||||
yy_push_state(program_id_state);
|
||||
yy_push_state(name_state); return PROGRAM_ID; }
|
||||
|
||||
PROGRAM-ID/{DOTEOL} { yy_push_state(ident_state);
|
||||
yy_push_state(name_state);
|
||||
yy_push_state(dot_state); return PROGRAM_ID; }
|
||||
PROGRAM-ID{OSPC}{DOTSEP}? { yy_push_state(ident_state);
|
||||
yy_push_state(program_id_state);
|
||||
yy_push_state(name_state); return PROGRAM_ID; }
|
||||
|
||||
PROCEDURE{SPC}DIVISION { yy_push_state(procedure_div);
|
||||
return PROCEDURE_DIV; }
|
||||
|
|
@ -272,30 +267,18 @@ PROCEDURE{SPC}DIVISION { yy_push_state(procedure_div);
|
|||
}
|
||||
|
||||
<ident_state>{
|
||||
{BLANK_OEOL}
|
||||
ID(ENTIFICATION)?{SPC}DIVISION { myless(0); yy_pop_state(); }
|
||||
(ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION {
|
||||
myless(0); yy_pop_state(); }
|
||||
OPTIONS { myless(0); yy_pop_state(); }
|
||||
|
||||
AS{SPC}[""] { yy_push_state(quoted2); return AS; }
|
||||
AS{SPC}[''] { yy_push_state(quoted1); return AS; }
|
||||
IS { pop_return IS; }
|
||||
|
||||
OPTIONS { yy_pop_state(); myless(0); }
|
||||
[[:blank:]]*(ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION/[[:space:].] {
|
||||
yy_pop_state(); myless(0); }
|
||||
[[:blank:]]*AUTHOR[[:blank:].]+{EOL}? {
|
||||
// Might not have an EOL, but stop on one.
|
||||
yy_push_state(author_state); }
|
||||
|
||||
{DOTEOL}
|
||||
|
||||
{COMMENTARY} { BEGIN(comment_entries); }
|
||||
}
|
||||
<author_state>{
|
||||
[[:blank:]]+
|
||||
^{BLANK_EOL}
|
||||
[^\r\n]+ { yy_pop_state();
|
||||
yylval.string = xstrdup(yytext);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
<INITIAL>{
|
||||
COBOL { return COBOL; }
|
||||
|
|
@ -307,6 +290,15 @@ PROCEDURE{SPC}DIVISION { yy_push_state(procedure_div);
|
|||
yy_push_state(field_state);
|
||||
yy_set_bol(1);
|
||||
myless(0); }
|
||||
|
||||
END{SPC}PROGRAM { yy_push_state(name_state);
|
||||
return program_level() > 1?
|
||||
END_SUBPROGRAM : END_PROGRAM; }
|
||||
|
||||
END{SPC}FUNCTION { yy_push_state(name_state);
|
||||
return program_level() > 1?
|
||||
END_SUBPROGRAM /*invalid*/ :
|
||||
END_FUNCTION; }
|
||||
}
|
||||
|
||||
<INITIAL,procedure_div,cdf_state>{
|
||||
|
|
@ -444,6 +436,11 @@ STDOUT { return STDOUT; }
|
|||
STDERR { return STDERR; }
|
||||
SYSERR { return STDERR; }
|
||||
|
||||
ARGUMENT-NUMBER { return ARGUMENT_NUMBER; }
|
||||
ARGUMENT-VALUE { return ARGUMENT_VALUE; }
|
||||
ENVIRONMENT-NAME { return ENVIRONMENT_NAME; }
|
||||
ENVIRONMENT-VALUE { return ENVIRONMENT_VALUE; }
|
||||
|
||||
CANCEL { return CANCEL; }
|
||||
COMMIT { return COMMIT; }
|
||||
COMMON { return COMMON; }
|
||||
|
|
@ -541,7 +538,7 @@ SECTION{SPC}[+-]?{INTEGERZ}/{OSPC}{DOTSEP} {
|
|||
auto eotext = yytext + yyleng;
|
||||
auto p = std::find_if(yytext, eotext, fisspace);
|
||||
p = std::find_if(p, eotext, nonspace);
|
||||
yylval.string = p;
|
||||
yylval.string = xstrdup(p);
|
||||
return SECTION;
|
||||
}
|
||||
|
||||
|
|
@ -1384,45 +1381,36 @@ USE({SPC}FOR)? { return USE; }
|
|||
}
|
||||
|
||||
<program_id_state>{
|
||||
^[[:blank:]]+
|
||||
^{BLANK_EOL}
|
||||
{BLANK_OEOL}
|
||||
(IS)?[[:space:]]
|
||||
|
||||
COMMON/[.]|{SPC}[[:alnum:].] { return COMMON; }
|
||||
INITIAL/[.]|{SPC}[[:alnum:].] { return INITIAL_kw; }
|
||||
RECURSIVE { return RECURSIVE; }
|
||||
PROGRAM/[.]|{SPC}[[:alnum:].] { return PROGRAM_kw; }
|
||||
|
||||
INITIAL { pop_return INITIAL_kw; }
|
||||
COMMON { pop_return COMMON; }
|
||||
PROGRAM { pop_return PROGRAM; }
|
||||
|
||||
AS/{SPC} { myless(0); yy_pop_state(); } /* => ident_state */
|
||||
[[:blank:]]*{DOTSEP}[[:blank:].]+{EOL} { pop_return '.'; }
|
||||
{DOTEOL} { pop_return '.'; }
|
||||
|
||||
INITIAL { return INITIAL_kw; }
|
||||
COMMON { return COMMON; }
|
||||
RECURSIVE { return RECURSIVE; }
|
||||
PROGRAM { return PROGRAM_kw; }
|
||||
|
||||
{DOTSEP} { pop_return '.'; }
|
||||
}
|
||||
|
||||
<name_state>{
|
||||
^[[:blank:]]+
|
||||
^{BLANK_EOL}
|
||||
{NAME} |
|
||||
{NAME}/{OSPC}[.] { yy_pop_state();
|
||||
yylval.string = xstrdup(yytext); return NAME; }
|
||||
<name_state>{ /* Either pop from here, or let the quoted state pop */
|
||||
{BLANK_OEOL}
|
||||
|
||||
{NAME} { yy_pop_state();
|
||||
yylval.string = xstrdup(yytext);
|
||||
return NAME;
|
||||
}
|
||||
Z?[''] { yylval.literal.set_prefix(yytext, yyleng-1);
|
||||
yy_push_state(quoted1); }
|
||||
BEGIN(quoted1); }
|
||||
Z?[""] { yylval.literal.set_prefix(yytext, yyleng-1);
|
||||
yy_push_state(quoted2); }
|
||||
BEGIN(quoted2); }
|
||||
|
||||
[.]/[[:blank:]]+. { return *yytext; }
|
||||
|
||||
[[:blank:]]*{DOTSEP}[[:blank:].]+{EOL} {
|
||||
yy_pop_state(); myless(0); }
|
||||
{DOTEOL} { yy_pop_state(); myless(0); }
|
||||
. { myless(0); yy_pop_state();
|
||||
/* Should not happen for valid inputs. */ }
|
||||
}
|
||||
<dot_state>{
|
||||
[[:blank:]]*[.][[:blank:].]+{EOL} { pop_return '.'; }
|
||||
[[:blank:]]*[.] { pop_return '.'; }
|
||||
[[:blank:]]*[.]+ { pop_return '.'; }
|
||||
}
|
||||
|
||||
<date_state>{
|
||||
|
|
@ -1645,9 +1633,9 @@ B-SHIFT-RC
|
|||
|
||||
FUNCTION { yy_push_state(function); return FUNCTION; }
|
||||
|
||||
SECTION{OSPC}[.]{SPC}/USE[[:space:]] { yylval.string = NULL; return SECTION; }
|
||||
SECTION{OSPC}[.]+{SPC}/USE[[:space:]] { yylval.string = NULL; return SECTION; }
|
||||
|
||||
[.]({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
|
||||
[.]+({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
|
||||
// EXIT format-1 is a "continue" statement
|
||||
}
|
||||
{NAME}/{OSPC}{DOTSEP} {
|
||||
|
|
@ -2073,41 +2061,41 @@ BASIS { yy_push_state(basis); return BASIS; }
|
|||
if( include_debug() ) myless(7);
|
||||
}
|
||||
}
|
||||
^[ ]*>>{OSPC}IF { yy_push_state(cdf_state); return CDF_IF; }
|
||||
^[ ]*>>{OSPC}ELSE { return CDF_ELSE; }
|
||||
^[ ]*>>{OSPC}END-IF { return CDF_END_IF; }
|
||||
^[ ]*>>{OBLANK}IF { yy_push_state(cdf_state); return CDF_IF; }
|
||||
^[ ]*>>{OBLANK}ELSE { return CDF_ELSE; }
|
||||
^[ ]*>>{OBLANK}END-IF { return CDF_END_IF; }
|
||||
|
||||
^[ ]*[$]{OSPC}IF { if( ! dialect_mf() ) {
|
||||
^[ ]*[$]{OBLANK}IF { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
yy_push_state(cdf_state); return CDF_IF; }
|
||||
^[ ]*[$]{OSPC}ELSE { if( ! dialect_mf() ) {
|
||||
^[ ]*[$]{OBLANK}ELSE { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
return CDF_ELSE; }
|
||||
^[ ]*[$]{OSPC}END { if( ! dialect_mf() ) {
|
||||
^[ ]*[$]{OBLANK}END { if( ! dialect_mf() ) {
|
||||
dialect_error(yylloc, yytext, "mf");
|
||||
}
|
||||
return CDF_END_IF; }
|
||||
|
||||
^[ ]*[$]{OSPC}SET({SPC}CONSTANT)? {
|
||||
^[ ]*[$]{OBLANK}SET({SPC}CONSTANT)? {
|
||||
if( ! dialect_mf() ) dialect_error(yylloc, yytext, "mf");
|
||||
yy_push_state(cdf_state); return CDF_DEFINE; }
|
||||
|
||||
^[ ]*>>{OSPC}EVALUATE { return CDF_EVALUATE; }
|
||||
^[ ]*>>{OSPC}WHEN { return CDF_WHEN; }
|
||||
^[ ]*>>{OSPC}END-EVALUATE { return CDF_END_EVALUATE; }
|
||||
^[ ]*>>{OBLANK}EVALUATE { return CDF_EVALUATE; }
|
||||
^[ ]*>>{OBLANK}WHEN { return CDF_WHEN; }
|
||||
^[ ]*>>{OBLANK}END-EVALUATE { return CDF_END_EVALUATE; }
|
||||
|
||||
^[ ]*>>{OSPC}CALL-CONVENTION{SPC}C { return CALL_VERBATIM; }
|
||||
^[ ]*>>{OSPC}CALL-CONVENTION{SPC}COBOL { return CALL_COBOL; }
|
||||
^[ ]*>>{OSPC}CALL-CONVENTION{SPC}VERBATIM { return CALL_VERBATIM; }
|
||||
^[ ]*>>{OBLANK}CALL-CONVENTION{BLANK}C { return CALL_VERBATIM; }
|
||||
^[ ]*>>{OBLANK}CALL-CONVENTION{BLANK}COBOL { return CALL_COBOL; }
|
||||
^[ ]*>>{OBLANK}CALL-CONVENTION{BLANK}VERBATIM { return CALL_VERBATIM; }
|
||||
|
||||
^[ ]*>>{OSPC}DEFINE { yy_push_state(cdf_state); return CDF_DEFINE; }
|
||||
^[ ]*>>{OSPC}DISPLAY { return CDF_DISPLAY; }
|
||||
^[ ]*>>{OSPC}TURN { yy_push_state(exception); return TURN; }
|
||||
^[ ]*>>{OSPC}COBOL-WORDS { yy_push_state(cobol_words); return COBOL_WORDS; }
|
||||
^[ ]*>>{OBLANK}DEFINE { yy_push_state(cdf_state); return CDF_DEFINE; }
|
||||
^[ ]*>>{OBLANK}DISPLAY { return CDF_DISPLAY; }
|
||||
^[ ]*>>{OBLANK}TURN { yy_push_state(exception); return TURN; }
|
||||
^[ ]*>>{OBLANK}COBOL-WORDS { yy_push_state(cobol_words); return COBOL_WORDS; }
|
||||
|
||||
^[ ]*>>{OSPC}{NAME} {
|
||||
^[ ]*>>{OBLANK}{NAME} {
|
||||
error_msg(yylloc, "unknown CDF token: %s", yytext);
|
||||
}
|
||||
|
||||
|
|
@ -2165,7 +2153,7 @@ BASIS { yy_push_state(basis); return BASIS; }
|
|||
|
||||
<*>OR { return OR; }
|
||||
<*>AND { return AND; }
|
||||
<*>{DOTSEP}[[:blank:].]+$ { return '.'; }
|
||||
<*>{DOTSEP} { return '.'; }
|
||||
<*>[().=*/+&-] { return *yytext; }
|
||||
<*>[[:blank:]]+
|
||||
<*>\r?\n
|
||||
|
|
@ -2369,7 +2357,7 @@ BASIS { yy_push_state(basis); return BASIS; }
|
|||
POINTER { return POINTER; }
|
||||
POSITIVE { return POSITIVE; }
|
||||
PROCEDURE { return PROCEDURE; }
|
||||
PROGRAM { return PROGRAM; }
|
||||
PROGRAM { return PROGRAM_kw; }
|
||||
PROGRAM-ID { return PROGRAM_ID; }
|
||||
PROPERTY { return PROPERTY; }
|
||||
PROTOTYPE { return PROTOTYPE; }
|
||||
|
|
@ -2411,7 +2399,7 @@ BASIS { yy_push_state(basis); return BASIS; }
|
|||
SCREEN { return SCREEN; }
|
||||
SD { return SD; }
|
||||
SEARCH { return SEARCH; }
|
||||
SECTION { return SECTION; }
|
||||
SECTION { yylval.string = NULL; return SECTION; }
|
||||
SELECT { return SELECT; }
|
||||
SENTENCE { return SENTENCE; }
|
||||
SEPARATE { return SEPARATE; }
|
||||
|
|
|
|||
|
|
@ -356,6 +356,10 @@ static void level_found() {
|
|||
if( scanner_normal() ) parsing.need_level(false);
|
||||
}
|
||||
|
||||
/*
|
||||
* Trim the scanned location by the amount about to re-scanned.
|
||||
* Must be a macro because it expands yyless.
|
||||
*/
|
||||
#define myless(N) \
|
||||
do { \
|
||||
auto n(N); \
|
||||
|
|
|
|||
|
|
@ -34,7 +34,6 @@ start_condition_str( int sc ) {
|
|||
switch(sc) {
|
||||
case INITIAL: state = "INITIAL"; break;
|
||||
case addr_of: state = "addr_of"; break;
|
||||
case author_state: state = "author_state"; break;
|
||||
case basis: state = "basis"; break;
|
||||
case bool_state: state = "bool_state"; break;
|
||||
case cdf_state: state = "cdf_state"; break;
|
||||
|
|
|
|||
|
|
@ -1768,8 +1768,8 @@ symbols_update( size_t first, bool parsed_ok ) {
|
|||
if( e == symbols_end() ) {
|
||||
// no field redefines the file's default record
|
||||
auto file = cbl_file_of(symbol_at(field->parent));
|
||||
ERROR_FIELD(field, "line %d: %s lacks a file description",
|
||||
file->line, file->name);
|
||||
ERROR_FIELD(field, "%s lacks a file description",
|
||||
file->name);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
|
@ -2180,14 +2180,22 @@ 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/stdout"}} },
|
||||
{ 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, CONSOLE_e, "CONSOLE", 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"}} },
|
||||
|
||||
{ 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"}} },
|
||||
|
|
@ -2207,10 +2215,6 @@ symbol_table_init(void) {
|
|||
{ 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;
|
||||
|
|
@ -4345,6 +4349,26 @@ cbl_occurs_t::subscript_ok( const cbl_field_t *subscript ) const {
|
|||
return bounds.lower <= (size_t)sub && (size_t)sub <= bounds.upper;
|
||||
}
|
||||
|
||||
const cbl_field_t *
|
||||
symbol_unresolved_file_key( const cbl_file_t * file,
|
||||
const cbl_name_t key_field_name ) {
|
||||
const symbol_elem_t *file_sym = symbol_elem_of(file);
|
||||
size_t program = file_sym->program;
|
||||
for( const symbol_elem_t *e = file_sym - 1; e->program == program; e-- ) {
|
||||
if( e->type == SymFile ) break;
|
||||
if( e->type == SymField ) {
|
||||
auto f = cbl_field_of(e);
|
||||
if( f->type == FldLiteralA ) break;
|
||||
if( f->type == FldForward ) {
|
||||
if( 0 == strcmp(key_field_name, f->name) ) {
|
||||
return f;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
cbl_file_key_t::
|
||||
cbl_file_key_t( cbl_name_t name,
|
||||
const std::list<cbl_field_t *>& fields,
|
||||
|
|
@ -4486,7 +4510,7 @@ cbl_file_key_t::deforward( size_t ifile ) {
|
|||
if( ifield == fwd ) {
|
||||
ERROR_FIELD(field, "line %d: %s of %s "
|
||||
"is not defined",
|
||||
file->line, field->name, file->name);
|
||||
field->line, field->name, file->name);
|
||||
return ifield;
|
||||
}
|
||||
|
||||
|
|
@ -4515,9 +4539,13 @@ cbl_file_key_t::deforward( size_t ifile ) {
|
|||
// looked-up field must have same file as parent
|
||||
if( ! (parent != NULL &&
|
||||
symbol_index(symbol_elem_of(parent)) == ifile) ) {
|
||||
ERROR_FIELD(field, "line %d: %s of %s "
|
||||
"is not defined in file description",
|
||||
file->line, field->name, file->name);
|
||||
const cbl_field_t *undefined =
|
||||
symbol_unresolved_file_key(file, field->name);
|
||||
int lineno = undefined? undefined->line : file->line;
|
||||
ERROR_FIELD(undefined? undefined : field,
|
||||
"line %d: %s of %s "
|
||||
"is not defined in file description",
|
||||
lineno, field->name, file->name);
|
||||
}
|
||||
return ifield;
|
||||
} );
|
||||
|
|
|
|||
|
|
@ -1894,6 +1894,10 @@ const cbl_label_t * symbol_program_local( const char called[] );
|
|||
|
||||
bool redefine_field( cbl_field_t *field );
|
||||
|
||||
const cbl_field_t *
|
||||
symbol_unresolved_file_key( const cbl_file_t * file,
|
||||
const cbl_name_t key_field_name );
|
||||
|
||||
static inline struct cbl_section_t *
|
||||
cbl_section_of( struct symbol_elem_t *e ) {
|
||||
assert(e && e->type == SymDataSection);
|
||||
|
|
@ -2387,6 +2391,165 @@ enum cbl_call_convention_t {
|
|||
cbl_call_cobol_e = 'N', // native
|
||||
};
|
||||
|
||||
int keyword_tok( const char * text, bool include_intrinsics = false );
|
||||
int redefined_token( const cbl_name_t name );
|
||||
|
||||
class current_tokens_t {
|
||||
class tokenset_t {
|
||||
// token_names is initialized from a generated header file.
|
||||
std::vector<const char *>token_names; // position indicates token value
|
||||
std::map <std::string, int> tokens; // aliases
|
||||
std::set<std::string> cobol_words; // Anything in COBOL-WORDS may appear only once.
|
||||
public:
|
||||
static std::string
|
||||
lowercase( const cbl_name_t name ) {
|
||||
cbl_name_t lname;
|
||||
std::transform(name, name + strlen(name) + 1, lname, ftolower);
|
||||
return lname;
|
||||
}
|
||||
static std::string
|
||||
uppercase( const cbl_name_t name ) {
|
||||
cbl_name_t uname;
|
||||
std::transform(name, name + strlen(name) + 1, uname, ftoupper);
|
||||
return uname;
|
||||
}
|
||||
|
||||
public:
|
||||
tokenset_t();
|
||||
int find( const cbl_name_t name, bool include_intrinsics );
|
||||
|
||||
bool equate( const YYLTYPE& loc, int token,
|
||||
const cbl_name_t name, const cbl_name_t verb = "EQUATE") {
|
||||
auto lname( lowercase(name) );
|
||||
auto cw = cobol_words.insert(lname);
|
||||
if( ! cw.second ) {
|
||||
error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
|
||||
return false;
|
||||
}
|
||||
auto p = tokens.find(lowercase(name));
|
||||
bool fOK = p == tokens.end();
|
||||
if( fOK ) { // name not already in use
|
||||
tokens[lname] = token;
|
||||
dbgmsg("%s:%d: %d has alias %s", __func__, __LINE__, token, name);
|
||||
} else {
|
||||
error_msg(loc, "%s: %s already defined as a token", verb, name);
|
||||
}
|
||||
return fOK;
|
||||
}
|
||||
bool undefine( const YYLTYPE& loc,
|
||||
const cbl_name_t name, const cbl_name_t verb = "UNDEFINE" ) {
|
||||
auto lname( lowercase(name) );
|
||||
auto cw = cobol_words.insert(lname);
|
||||
if( ! cw.second ) {
|
||||
error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
|
||||
return false;
|
||||
}
|
||||
|
||||
// Do not erase generic, multi-type tokens COMPUTATIONAL and BINARY_INTEGER.
|
||||
if( binary_integer_usage_of(name) ) {
|
||||
dbgmsg("%s:%d: generic %s remains valid as a token", __func__, __LINE__, name);
|
||||
return true;
|
||||
}
|
||||
|
||||
auto p = tokens.find(lname);
|
||||
bool fOK = p != tokens.end();
|
||||
if( fOK ) { // name in use
|
||||
tokens.erase(p);
|
||||
} else {
|
||||
error_msg(loc, "%s: %s not defined as a token", verb, name);
|
||||
}
|
||||
dbgmsg("%s:%d: %s removed as a valid token name", __func__, __LINE__, name);
|
||||
return fOK;
|
||||
}
|
||||
|
||||
bool substitute( const YYLTYPE& loc,
|
||||
const cbl_name_t extant, int token, const cbl_name_t name ) {
|
||||
return
|
||||
equate( loc, token, name, "SUBSTITUTE" )
|
||||
&&
|
||||
undefine( loc, extant, "SUBSTITUTE" );
|
||||
}
|
||||
bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
|
||||
auto lname( lowercase(name) );
|
||||
auto cw = cobol_words.insert(lname);
|
||||
if( ! cw.second ) {
|
||||
error_msg(loc, "COBOL-WORDS RESERVE: %s may appear but once", name);
|
||||
return false;
|
||||
}
|
||||
tokens[lname] = -42;
|
||||
return true;
|
||||
}
|
||||
int redefined_as( const cbl_name_t name ) {
|
||||
auto lname( lowercase(name) );
|
||||
if( cobol_words.find(lname) != cobol_words.end() ) {
|
||||
auto p = tokens.find(lname);
|
||||
if( p != tokens.end() ) {
|
||||
return p->second;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
const char * name_of( int tok ) const {
|
||||
tok -= (255 + 3);
|
||||
gcc_assert(0 <= tok && size_t(tok) < token_names.size());
|
||||
return tok < 0? "???" : token_names[tok];
|
||||
}
|
||||
};
|
||||
|
||||
tokenset_t tokens;
|
||||
public:
|
||||
current_tokens_t() {}
|
||||
int find( const cbl_name_t name, bool include_intrinsics ) {
|
||||
return tokens.find(name, include_intrinsics);
|
||||
}
|
||||
bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
|
||||
int token;
|
||||
if( 0 == (token = binary_integer_usage_of(keyword)) ) {
|
||||
if( 0 == (token = keyword_tok(keyword)) ) {
|
||||
error_msg(loc, "EQUATE %s: not a valid token", keyword);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
auto name = keyword_alias_add(tokens.uppercase(keyword),
|
||||
tokens.uppercase(alias));
|
||||
if( name != keyword ) {
|
||||
error_msg(loc, "EQUATE: %s is already an alias for %s", alias, name.c_str());
|
||||
return false;
|
||||
}
|
||||
return tokens.equate(loc, token, alias);
|
||||
}
|
||||
bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) {
|
||||
return tokens.undefine(loc, keyword);
|
||||
}
|
||||
bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
|
||||
int token;
|
||||
if( 0 == (token = binary_integer_usage_of(keyword)) ) {
|
||||
if( 0 == (token = keyword_tok(keyword)) ) {
|
||||
error_msg(loc, "SUBSTITUTE %s: not a valid token", keyword);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
auto name = keyword_alias_add(tokens.uppercase(keyword),
|
||||
tokens.uppercase(alias));
|
||||
if( name != keyword ) {
|
||||
error_msg(loc, "SUBSTITUTE: %s is already an alias for %s", alias, name.c_str());
|
||||
return false;
|
||||
}
|
||||
|
||||
dbgmsg("%s:%d: %s (%d) will have alias %s", __func__, __LINE__, keyword, token, alias);
|
||||
return tokens.substitute(loc, keyword, token, alias);
|
||||
}
|
||||
bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
|
||||
return tokens.reserve(loc, name);
|
||||
}
|
||||
int redefined_as( const cbl_name_t name ) {
|
||||
return tokens.redefined_as(name);
|
||||
}
|
||||
const char * name_of( int tok ) const {
|
||||
return tokens.name_of(tok);
|
||||
}
|
||||
};
|
||||
|
||||
cbl_call_convention_t current_call_convention();
|
||||
|
||||
cbl_call_convention_t
|
||||
|
|
@ -2433,9 +2596,6 @@ public:
|
|||
int line_number() const { return line; }
|
||||
};
|
||||
|
||||
int keyword_tok( const char * text, bool include_intrinsics = false );
|
||||
int redefined_token( const cbl_name_t name );
|
||||
|
||||
void procedure_definition_add( size_t program, const cbl_label_t *procedure );
|
||||
void procedure_reference_add( const char *sect, const char *para,
|
||||
int line, size_t context );
|
||||
|
|
|
|||
|
|
@ -504,7 +504,7 @@ symbol_match( size_t program, const std::list<const char *>& names ) {
|
|||
}
|
||||
auto inserted = output.insert(*p);
|
||||
if( ! inserted.second ) {
|
||||
yyerror("%s is not a unique reference", key.name);
|
||||
error_msg_direct("%s is not a unique reference", key.name);
|
||||
}
|
||||
}
|
||||
return output;
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -34,29 +34,32 @@
|
|||
* header files.
|
||||
*/
|
||||
|
||||
#include "cobol-system.h"
|
||||
#include "coretypes.h"
|
||||
#include "tree.h"
|
||||
#include <cobol-system.h>
|
||||
#include <coretypes.h>
|
||||
#include <tree.h>
|
||||
#undef yy_flex_debug
|
||||
|
||||
#include <langinfo.h>
|
||||
|
||||
#include "coretypes.h"
|
||||
#include "version.h"
|
||||
#include "demangle.h"
|
||||
#include "intl.h"
|
||||
#include "backtrace.h"
|
||||
#include "diagnostic.h"
|
||||
#include "diagnostic-color.h"
|
||||
#include "diagnostic-url.h"
|
||||
#include "diagnostic-metadata.h"
|
||||
#include "diagnostic-path.h"
|
||||
#include "edit-context.h"
|
||||
#include "selftest.h"
|
||||
#include "selftest-diagnostic.h"
|
||||
#include "opts.h"
|
||||
#include <coretypes.h>
|
||||
#include <version.h>
|
||||
#include <demangle.h>
|
||||
#include <intl.h>
|
||||
#include <backtrace.h>
|
||||
#include <diagnostic.h>
|
||||
#include <diagnostic-color.h>
|
||||
#include <diagnostic-url.h>
|
||||
#include <diagnostic-metadata.h>
|
||||
#include <diagnostic-path.h>
|
||||
#include <edit-context.h>
|
||||
#include <selftest.h>
|
||||
#include <selftest-diagnostic.h>
|
||||
#include <opts.h>
|
||||
|
||||
#include "util.h"
|
||||
|
||||
#include "cbldiag.h"
|
||||
#include "cdfval.h"
|
||||
#include "lexio.h"
|
||||
|
||||
#include "../../libgcobol/ec.h"
|
||||
|
|
@ -111,6 +114,81 @@ gb4( size_t input ) {
|
|||
return input;
|
||||
}
|
||||
|
||||
/*
|
||||
* Most CDF Directives -- those that have state -- can be pushed and popped.
|
||||
* This class maintains stacks of them, with each stack having a "default
|
||||
* value" that may be updated, without push/pop, via a CDF directive or
|
||||
* command-line option. A push to a stack pushes the default value onto it; a
|
||||
* pop copies the top of the stack to the default value.
|
||||
*
|
||||
* >>PUSH ALL calls the class's push() method.
|
||||
* >>POP ALL calls the class's pop() method.
|
||||
*/
|
||||
class cdf_directives_t
|
||||
{
|
||||
typedef std::map<std::string, cdfval_t> cdf_values_t;
|
||||
|
||||
template <typename T>
|
||||
class cdf_stack_t : private std::stack<T> {
|
||||
T default_value;
|
||||
public:
|
||||
void value( const T& value ) {
|
||||
T& output( std::stack<T>::empty()? default_value : std::stack<T>::top() );
|
||||
output = value;
|
||||
}
|
||||
T& value() {
|
||||
return std::stack<T>::empty()? default_value : std::stack<T>::top();
|
||||
}
|
||||
void push() {
|
||||
std::stack<T>::push(value());
|
||||
}
|
||||
void pop() {
|
||||
if( std::stack<T>::empty() ) {
|
||||
error_msg(YYLTYPE(), "CDF stack empty");
|
||||
return;
|
||||
}
|
||||
default_value = std::stack<T>::top();
|
||||
std::stack<T>::pop();
|
||||
}
|
||||
};
|
||||
|
||||
public:
|
||||
cdf_stack_t<cbl_call_convention_t> call_convention;
|
||||
cdf_stack_t<current_tokens_t> cobol_words;
|
||||
cdf_stack_t<cdf_values_t> dictionary; // DEFINE
|
||||
cdf_stack_t<source_format_t> source_format;
|
||||
cdf_stack_t<cbl_enabled_exceptions_t> enabled_exceptions;
|
||||
|
||||
cdf_directives_t() {
|
||||
call_convention.value() = cbl_call_cobol_e;
|
||||
}
|
||||
|
||||
void push() {
|
||||
call_convention.push();
|
||||
cobol_words.push();
|
||||
dictionary.push();
|
||||
source_format.push();
|
||||
enabled_exceptions.push();
|
||||
}
|
||||
void pop() {
|
||||
call_convention.pop();
|
||||
cobol_words.pop();
|
||||
dictionary.pop();
|
||||
source_format.pop();
|
||||
enabled_exceptions.pop();
|
||||
}
|
||||
};
|
||||
static cdf_directives_t cdf_directives;
|
||||
|
||||
void
|
||||
cobol_set_indicator_column( int column ) {
|
||||
cdf_directives.source_format.value().indicator_column_set(column);
|
||||
}
|
||||
source_format_t& cdf_source_format() {
|
||||
return cdf_directives.source_format.value();
|
||||
}
|
||||
|
||||
|
||||
const char *
|
||||
symbol_type_str( enum symbol_type_t type )
|
||||
{
|
||||
|
|
@ -1927,7 +2005,8 @@ location_t location_from_lineno() { return token_location; }
|
|||
template <typename LOC>
|
||||
static void
|
||||
gcc_location_set_impl( const LOC& loc ) {
|
||||
token_location = linemap_line_start( line_table, loc.last_line, 80 );
|
||||
// Set the position to the first line & column in the location.
|
||||
token_location = linemap_line_start( line_table, loc.first_line, 80 );
|
||||
token_location = linemap_position_for_column( line_table, loc.first_column);
|
||||
location_dump(__func__, __LINE__, "parser", loc);
|
||||
}
|
||||
|
|
@ -1972,6 +2051,11 @@ verify_format( const char gmsgid[] ) {
|
|||
static const diagnostic_option_id option_zero;
|
||||
size_t parse_error_inc();
|
||||
|
||||
void gcc_location_dump() {
|
||||
linemap_dump_location( line_table, token_location, stderr );
|
||||
}
|
||||
|
||||
|
||||
void ydferror( const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
|
||||
|
||||
void
|
||||
|
|
@ -2008,10 +2092,7 @@ class temp_loc_t {
|
|||
gcc_location_set(loc);
|
||||
}
|
||||
explicit temp_loc_t( const YDFLTYPE& loc) : orig(token_location) {
|
||||
YYLTYPE lloc = {
|
||||
loc.first_line, loc.first_column,
|
||||
loc.last_line, loc.last_column };
|
||||
gcc_location_set(lloc);
|
||||
gcc_location_set(loc);
|
||||
}
|
||||
~temp_loc_t() {
|
||||
if( orig != token_location ) {
|
||||
|
|
@ -2057,6 +2138,17 @@ void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... ) {
|
|||
ERROR_MSG_BODY
|
||||
}
|
||||
|
||||
void error_msg_direct( const char gmsgid[], ... ) {
|
||||
verify_format(gmsgid);
|
||||
parse_error_inc();
|
||||
auto_diagnostic_group d;
|
||||
va_list ap;
|
||||
va_start (ap, gmsgid);
|
||||
auto ret = emit_diagnostic_valist( DK_ERROR, token_location,
|
||||
option_zero, gmsgid, &ap );
|
||||
va_end (ap);
|
||||
}
|
||||
|
||||
void
|
||||
yyerror( const char gmsgid[], ... ) {
|
||||
temp_loc_t looker;
|
||||
|
|
|
|||
|
|
@ -59,5 +59,55 @@ as_voidp( P p ) {
|
|||
return static_cast<const void *>(p);
|
||||
}
|
||||
|
||||
/*
|
||||
* The default source format, whether free or fixed, is determined
|
||||
* heuristically by examining the PROGRAM-ID line, if it exists, in the first
|
||||
* input file. If that file does not have such a line, the default is free
|
||||
* format. Else the format is set to fixed if anything appears on that line
|
||||
* that would prohibit parsing it as free format,
|
||||
*/
|
||||
class source_format_t {
|
||||
bool first_file, explicitly;
|
||||
int left, right;
|
||||
public:
|
||||
source_format_t()
|
||||
: first_file(true), explicitly(false), left(0), right(0)
|
||||
{}
|
||||
void indicator_column_set( int column ) {
|
||||
explicitly = true;
|
||||
if( column == 0 ) right = 0;
|
||||
if( column < 0 ) {
|
||||
column = -column;
|
||||
right = 73;
|
||||
}
|
||||
left = column;
|
||||
}
|
||||
|
||||
bool inference_pending() {
|
||||
bool tf = first_file && !explicitly;
|
||||
first_file = false;
|
||||
return tf;
|
||||
}
|
||||
|
||||
void infer( const char *bol, bool want_reference_format );
|
||||
|
||||
inline bool is_fixed() const { return left == 7; }
|
||||
inline bool is_reffmt() const { return is_fixed() && right == 73; }
|
||||
inline bool is_free() const { return ! is_fixed(); }
|
||||
|
||||
const char * description() const {
|
||||
if( is_reffmt() ) return "REFERENCE";
|
||||
if( is_fixed() ) return "FIXED";
|
||||
if( is_free() ) return "FREE";
|
||||
gcc_unreachable();
|
||||
}
|
||||
|
||||
inline int left_margin() {
|
||||
return left == 0? left : left - 1;
|
||||
}
|
||||
inline int right_margin() {
|
||||
return right == 0? right : right - 1;
|
||||
}
|
||||
};
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -10132,52 +10132,70 @@ __gg__classify( classify_t type,
|
|||
return retval;
|
||||
}
|
||||
|
||||
static
|
||||
int
|
||||
accept_envar( cblc_field_t *tgt,
|
||||
size_t tgt_offset,
|
||||
size_t tgt_length,
|
||||
const char *psz_name)
|
||||
{
|
||||
int retval = 1; // 1 means we couldn't find it
|
||||
if( psz_name )
|
||||
{
|
||||
tgt_length = tgt_length ? tgt_length : tgt->capacity;
|
||||
|
||||
// Pick up the environment variable name, which is in the internal codeset
|
||||
char *env = strdup(psz_name);
|
||||
massert(env);
|
||||
|
||||
// Get rid of leading and trailing internal_space characters:
|
||||
char *trimmed_env = brute_force_trim(env);
|
||||
|
||||
// Convert the name to the console codeset:
|
||||
__gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
|
||||
|
||||
// Pick up the environment variable, and convert it to the internal codeset
|
||||
const char *p = getenv(trimmed_env);
|
||||
if(p)
|
||||
{
|
||||
char *pp = strdup(p);
|
||||
massert(pp);
|
||||
console_to_internal(pp, strlen(pp));
|
||||
retval = 0; // Okay
|
||||
move_string(tgt, tgt_offset, tgt_length, pp);
|
||||
free(pp);
|
||||
}
|
||||
free(env);
|
||||
}
|
||||
|
||||
if( retval == 1 )
|
||||
{
|
||||
// Could't find it
|
||||
exception_raise(ec_argument_imp_environment_e);
|
||||
}
|
||||
|
||||
return retval;
|
||||
}
|
||||
|
||||
extern "C"
|
||||
int
|
||||
__gg__accept_envar( cblc_field_t *tgt,
|
||||
size_t tgt_offset,
|
||||
size_t tgt_length,
|
||||
cblc_field_t *name,
|
||||
const cblc_field_t *name,
|
||||
size_t name_offset,
|
||||
size_t name_length)
|
||||
{
|
||||
int retval;
|
||||
tgt_length = tgt_length ? tgt_length : tgt->capacity;
|
||||
name_length = name_length ? name_length : name->capacity;
|
||||
|
||||
// Pick up the environment variable name, which is in teh internal codeset
|
||||
static char *env = NULL;
|
||||
static size_t env_length = 0;
|
||||
if( env_length < name_length+1 )
|
||||
{
|
||||
env_length = name_length+1;
|
||||
env = static_cast<char *>(realloc(env, env_length));
|
||||
}
|
||||
memcpy(env, name->data + name_offset, name_length);
|
||||
env[name_length] = '\0';
|
||||
|
||||
// Get rid of leading and trailing internal_space characters:
|
||||
char *trimmed_env = brute_force_trim(env);
|
||||
|
||||
// Convert the name to the console codeset:
|
||||
__gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
|
||||
|
||||
// Pick up the environment variable, and convert it to the internal codeset
|
||||
const char *p = getenv(trimmed_env);
|
||||
if(p)
|
||||
{
|
||||
char *pp = strdup(p);
|
||||
console_to_internal(pp, strlen(pp));
|
||||
retval = 0; // Okay
|
||||
move_string(tgt, tgt_offset, tgt_length, pp);
|
||||
free(pp);
|
||||
}
|
||||
else
|
||||
{
|
||||
retval = 1; // Could't find it
|
||||
exception_raise(ec_argument_imp_environment_e);
|
||||
}
|
||||
|
||||
// We need the name to be nul-terminated:
|
||||
char *p = static_cast<char *>(malloc(name_length + 1));
|
||||
massert(p);
|
||||
memcpy(p, name->data+name_offset, name_length);
|
||||
p[name_length] = '\0';
|
||||
int retval = accept_envar(tgt,
|
||||
tgt_offset,
|
||||
tgt_length,
|
||||
p);
|
||||
free(p);
|
||||
return retval;
|
||||
}
|
||||
|
||||
|
|
@ -11247,6 +11265,28 @@ match_declarative( bool enabled,
|
|||
return matches;
|
||||
}
|
||||
|
||||
static
|
||||
void open_syslog(int option, int facility)
|
||||
{
|
||||
static bool first_time = true;
|
||||
if( first_time ) {
|
||||
#if HAVE_DECL_PROGRAM_INVOCATION_SHORT_NAME
|
||||
/* Declared in errno.h, when available. */
|
||||
static const char * const ident = program_invocation_short_name;
|
||||
#elif defined (HAVE_GETPROGNAME)
|
||||
/* Declared in stdlib.h. */
|
||||
static const char * const ident = getprogname();
|
||||
#else
|
||||
/* Avoid a NULL entry. */
|
||||
static const char * const ident = "unnamed_COBOL_program";
|
||||
#endif
|
||||
// TODO: Program to set option in library via command-line and/or environment.
|
||||
// Library listens to program, not to the environment.
|
||||
openlog(ident, option, facility);
|
||||
first_time = false;
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* The default exception handler is called if:
|
||||
* 1. The EC is enabled and was not handled by a Declarative, or
|
||||
|
|
@ -11256,26 +11296,11 @@ match_declarative( bool enabled,
|
|||
static void
|
||||
default_exception_handler( ec_type_t ec )
|
||||
{
|
||||
#if HAVE_DECL_PROGRAM_INVOCATION_SHORT_NAME
|
||||
/* Declared in errno.h, when available. */
|
||||
static const char * const ident = program_invocation_short_name;
|
||||
#elif defined (HAVE_GETPROGNAME)
|
||||
/* Declared in stdlib.h. */
|
||||
static const char * const ident = getprogname();
|
||||
#else
|
||||
/* Avoid a NULL entry. */
|
||||
static const char * const ident = "unnamed_COBOL_program";
|
||||
#endif
|
||||
static bool first_time = true;
|
||||
static const int priority = LOG_INFO, option = LOG_PERROR, facility = LOG_USER;
|
||||
open_syslog(option, facility);
|
||||
|
||||
ec_disposition_t disposition = ec_category_fatal_e;
|
||||
|
||||
if( first_time ) {
|
||||
// TODO: Program to set option in library via command-line and/or environment.
|
||||
// Library listens to program, not to the environment.
|
||||
openlog(ident, option, facility);
|
||||
first_time = false;
|
||||
}
|
||||
|
||||
if( ec != ec_none_e ) {
|
||||
auto pec = std::find_if( __gg__exception_table, __gg__exception_table_end,
|
||||
|
|
@ -13148,6 +13173,7 @@ operator<<( std::vector<cbl_declarative_t>& dcls,
|
|||
return decode( dcls, encoded );
|
||||
}
|
||||
|
||||
// The first element of each array is the number of elements that follow
|
||||
// The first element of each array is the number of elements that follow
|
||||
extern "C"
|
||||
void
|
||||
|
|
@ -13207,6 +13233,7 @@ __gg__set_env_name( const cblc_field_t *var,
|
|||
size_t offset,
|
||||
size_t length )
|
||||
{
|
||||
// implements DISPLAY UPON ENVIRONMENT-NAME
|
||||
free(sv_envname);
|
||||
sv_envname = static_cast<char *>(malloc(length+1));
|
||||
massert(sv_envname);
|
||||
|
|
@ -13214,12 +13241,41 @@ __gg__set_env_name( const cblc_field_t *var,
|
|||
sv_envname[length] = '\0';
|
||||
}
|
||||
|
||||
|
||||
extern "C"
|
||||
void
|
||||
__gg__get_env_name( cblc_field_t *dest,
|
||||
size_t dest_offset,
|
||||
size_t dest_length)
|
||||
{
|
||||
// Implements ACCEPT FROM ENVIRONMENT-NAME
|
||||
// It returns the value previously established by __gg__set_env_name.
|
||||
if( sv_envname )
|
||||
{
|
||||
sv_envname = strdup("");
|
||||
}
|
||||
move_string(dest, dest_offset, dest_length, sv_envname);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
int
|
||||
__gg__get_env_value(cblc_field_t *dest,
|
||||
size_t dest_offset,
|
||||
size_t dest_length)
|
||||
{
|
||||
return accept_envar(dest,
|
||||
dest_offset,
|
||||
dest_length,
|
||||
sv_envname);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
void
|
||||
__gg__set_env_value(const cblc_field_t *value,
|
||||
size_t offset,
|
||||
size_t length )
|
||||
{
|
||||
// implements DISPLAY UPON ENVIRONMENT-VALUE
|
||||
size_t name_length = strlen(sv_envname);
|
||||
size_t value_length = length;
|
||||
|
||||
|
|
@ -13258,6 +13314,11 @@ __gg__set_env_value(const cblc_field_t *value,
|
|||
setenv(trimmed_env, trimmed_val, 1);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
void
|
||||
__gg__fprintf_stderr(const char *format_string, ...)
|
||||
__attribute__ ((__format__ (__printf__, 1, 2)));
|
||||
|
||||
extern "C"
|
||||
void
|
||||
__gg__fprintf_stderr(const char *format_string, ...)
|
||||
|
|
@ -13270,3 +13331,81 @@ __gg__fprintf_stderr(const char *format_string, ...)
|
|||
va_end(ap);
|
||||
}
|
||||
|
||||
|
||||
static int sv_argument_number = 0;
|
||||
|
||||
extern "C"
|
||||
void
|
||||
__gg__set_arg_num( const cblc_field_t *index,
|
||||
size_t index_offset,
|
||||
size_t index_size )
|
||||
{
|
||||
// Implements DISPLAY UPON ARGUMENT-NUMBER.
|
||||
int rdigits;
|
||||
__int128 N = get_binary_value_local(&rdigits,
|
||||
index,
|
||||
index->data + index_offset,
|
||||
index_size);
|
||||
// If he gives us fractional digits, just truncate
|
||||
N /= __gg__power_of_ten(rdigits);
|
||||
|
||||
// N is 1-based, per normal COBOL. We have to decrement it here:
|
||||
N -= 1;
|
||||
sv_argument_number = static_cast<int>(N);
|
||||
}
|
||||
|
||||
extern "C"
|
||||
int
|
||||
__gg__accept_arg_value( cblc_field_t *dest,
|
||||
size_t dest_offset,
|
||||
size_t dest_length)
|
||||
{
|
||||
// Implements ACCEPT FROM ARGUMENT-VALUE
|
||||
int retcode;
|
||||
command_line_plan_b();
|
||||
if( sv_argument_number >= stashed_argc || sv_argument_number < 0 )
|
||||
{
|
||||
exception_raise(ec_argument_imp_command_e);
|
||||
retcode = 1; // Error
|
||||
}
|
||||
else
|
||||
{
|
||||
char *retval = strdup(stashed_argv[sv_argument_number]);
|
||||
console_to_internal(retval, strlen(retval));
|
||||
move_string(dest, dest_offset, dest_length, retval);
|
||||
free(retval);
|
||||
retcode = 0; // Okay
|
||||
|
||||
// The Fujitsu spec says bump this value by one.
|
||||
sv_argument_number += 1;
|
||||
}
|
||||
return retcode;
|
||||
}
|
||||
|
||||
extern "C"
|
||||
int
|
||||
__gg__get_file_descriptor(const char *device)
|
||||
{
|
||||
int retval = open(device, O_WRONLY);
|
||||
|
||||
if( retval == -1 )
|
||||
{
|
||||
char *msg;
|
||||
int ec = asprintf(&msg,
|
||||
"Trying to open %s. Got error %s",
|
||||
device,
|
||||
strerror(errno));
|
||||
if( ec != -1 )
|
||||
{
|
||||
static const int priority = LOG_INFO,
|
||||
option = LOG_PERROR,
|
||||
facility = LOG_USER;
|
||||
open_syslog(option, facility);
|
||||
syslog(priority, "%s", msg);
|
||||
}
|
||||
|
||||
// Open a new handle to /dev/stdout, since our caller will be closing it
|
||||
retval = open("/dev/stdout", O_WRONLY);
|
||||
}
|
||||
return retval;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue