From 4e23f49a2859cf8e2eb184c6a869dfc3c1e00bbc Mon Sep 17 00:00:00 2001
From: "James K. Lowden" <jklowden@symas.com>
Date: Fri, 22 Dec 2023 11:58:24 -0500
Subject: [PATCH] WIP: re-parsing CALL and UDF
---
gcc/cobol/cdf.y | 26 +++++++++----------
gcc/cobol/parse.y | 58 +++++++++++++++---------------------------
gcc/cobol/parse_ante.h | 15 +++++++----
gcc/cobol/scan.l | 2 +-
gcc/cobol/symbols.h | 2 +-
5 files changed, 46 insertions(+), 57 deletions(-)
diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y
index 77ea416303e7..9136afb0f1bd 100644
--- a/gcc/cobol/cdf.y
+++ b/gcc/cobol/cdf.y
@@ -262,12 +262,12 @@ apply_cdf_turn( exception_turns_t& turns ) {
%token BY 470
%token COPY 358
%token CDF_DISPLAY 380
-%token IN 583
+%token IN 584
%token NAME 286
%token NUMSTR 304
-%token OF 661
-%token PSEUDOTEXT 697
-%token REPLACING 719
+%token OF 662
+%token PSEUDOTEXT 698
+%token REPLACING 720
%token LITERAL 297
%token SUPPRESS 375
@@ -279,19 +279,19 @@ apply_cdf_turn( exception_turns_t& turns ) {
%token AS 454 CONSTANT 357 DEFINED 359
%type <boolean> DEFINED
-%token OTHER 673 PARAMETER_kw 364 OFF 662 OVERRIDE 365
-%token THRU 909
-%token TRUE_kw 784
+%token OTHER 674 PARAMETER_kw 364 OFF 663 OVERRIDE 365
+%token THRU 910
+%token TRUE_kw 785
-%token TURN 786 CHECKING 478 LOCATION 625 ON 664 WITH 810
+%token TURN 787 CHECKING 479 LOCATION 626 ON 665 WITH 811
-%left OR 910
-%left AND 911
-%right NOT 912
-%left '<' '>' '=' NE 913 LE 914 GE 915
+%left OR 911
+%left AND 912
+%right NOT 913
+%left '<' '>' '=' NE 914 LE 915 GE 916
%left '-' '+'
%left '*' '/'
-%right NEG 916
+%right NEG 917
%define api.prefix {ydf}
%define api.token.prefix{YDF_}
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 776c265454b0..99c55295b906 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -420,9 +420,8 @@
%type <number> /* addr_len_of */ alphanum_pic
%type <pic_part> alphanum_part
-%type <ffi_arg> ffi_by_ref ffi_by_con ffi_by_val
-%type <ffi_args> ffi_by_refs ffi_by_cons ffi_by_vals
-%type <ffi_args> parameter parameters
+%type <ffi_arg> parameter ffi_by_ref ffi_by_con ffi_by_val
+%type <ffi_args> parameters
%type <ffi_impl> call_body call_impl
%type <ffi_arg> procedure_use
@@ -636,7 +635,7 @@
ASCENDING ASIN ASSIGN AT ATAN AUTHOR
BASED BEFORE BINARY BIT BIT_OF BIT_TO_CHAR BLANK BLOCK
- BOTTOM BY BYTE_LENGTH
+ BOTTOM BY BYTE_LENGTH BYTE_LENGTH_OF
C01 C02 C03 C04 C05 C06 C07 C08 C09 C10 C11 C12 CF CH
CHANGED CHAR CHARACTER CHARACTERS CHECKING CLASS
@@ -955,6 +954,7 @@ program_id: PROGRAM_ID dot namestr[name] program_as program_attrs[attr] dot
if(false && yydebug) {
warnx("current program is now %s", name);
}
+ if( nparse_error > 0 ) YYABORT;
}
;
dot: %empty
@@ -978,6 +978,7 @@ function_id: FUNCTION '.' NAME program_as program_attrs[attr] '.'
if(false && yydebug) {
warnx("current program is now %s", $NAME);
}
+ if( nparse_error > 0 ) YYABORT;
}
| FUNCTION '.' NAME program_as is PROTOTYPE '.'
{
@@ -2700,8 +2701,8 @@ data_descr: data_descr1
;
const_value: cce_expr
- | BYTE_LENGTH of name { $$ = $name->data.capacity; }
- | LENGTH of name { $$ = $name->data.capacity; }
+ | BYTE_LENGTH_OF of name { $$ = $name->data.capacity; }
+ | LENGTH of name { $$ = $name->data.capacity; }
;
value78: literalism
@@ -6150,16 +6151,16 @@ varg: varg1
| ALL varg1 { $$ = $2; $$->all = true; }
;
-varg1: literal
+varg1: scalar
+ | intrinsic_call
+ | literal
{
$$ = new_reference($1);
}
- | scalar
| reserved_value
{
$$ = new_reference(constant_of(constant_index($1)));
}
- | intrinsic_call
;
literal: LITERAL
@@ -7786,23 +7787,17 @@ ffi_name: name
| LITERAL { $$ = new_reference(new_literal($1, quoted_e)); }
;
-parameters: parameter
+parameters: parameter { $$ = new ffi_args_t($1); }
| parameters parameter
{
- $1->elems.splice($1->elems.end(), $2->elems);
+ $1->push_back($2);
$$ = $1;
}
;
-parameter: ffi_by_ref { $$ = new ffi_args_t($1); }
- | by REFERENCE ffi_by_refs { $$ = $3; }
- | by CONTENT ffi_by_cons { $$ = $3; }
- | by VALUE ffi_by_vals { $$ = $3; }
- ;
-ffi_by_refs: ffi_by_ref { $$ = new ffi_args_t($1); }
- | ffi_by_refs ffi_by_ref[ref]
- {
- $$ = $1->push_back($ref);
- }
+parameter: ffi_by_ref { $$ = $1; $$->crv = cbl_ffi_crv_t(0); }
+ | by REFERENCE ffi_by_ref { $$ = $3; }
+ | by CONTENT ffi_by_con { $$ = $3; }
+ | by VALUE ffi_by_val { $$ = $3; }
;
ffi_by_ref: scalar_arg[refer]
{
@@ -7819,20 +7814,12 @@ ffi_by_ref: scalar_arg[refer]
}
;
-ffi_by_cons: ffi_by_con { $$ = new ffi_args_t($1); }
- | ffi_by_cons ffi_by_con { $$ = $1->push_back($2); }
- ;
-ffi_by_con: scalar_arg
- {
- $$ = new cbl_ffi_arg_t(by_content_e, $1);
- }
- | ADDRESS OF scalar_arg[arg]
+ffi_by_con: expr
{
- $$ = new cbl_ffi_arg_t(by_content_e, $arg, address_of_e);
- }
- | LENGTH OF scalar_arg[arg]
- {
- $$ = new cbl_ffi_arg_t(by_content_e, $arg, length_of_e);
+ cbl_refer_t *r = new cbl_refer_t(*$1);
+ r->field = new_temporary_clone($1->field);
+ parser_move(r->field, $1->field);
+ $$ = new cbl_ffi_arg_t(by_content_e, r);
}
| LITERAL
{
@@ -7846,9 +7833,6 @@ ffi_by_con: scalar_arg
}
;
-ffi_by_vals: ffi_by_val { $$ = new ffi_args_t($1); }
- | ffi_by_vals ffi_by_val { $$ = $1->push_back($2); }
- ;
ffi_by_val: by_value_arg
{
$$ = new cbl_ffi_arg_t(by_value_e, $1);
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 88d54ba58dd6..7de44a83a6ae 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -1143,20 +1143,24 @@ struct ffi_args_t {
list<cbl_ffi_arg_t> elems;
ffi_args_t( cbl_ffi_arg_t *arg ) {
- elems.push_back(*arg);
- delete arg;
+ this->push_back(arg);
}
+ // set explicitly, or assume
ffi_args_t * push_back( cbl_ffi_arg_t *arg ) {
+ if( arg->crv < by_reference_e ) {
+ arg->crv = elems.empty()? by_reference_e : elems.back().crv;
+ }
elems.push_back(*arg);
delete arg;
return this;
}
+ // infer reference/content/value from previous
ffi_args_t * push_back( cbl_refer_t* refer,
cbl_ffi_arg_attr_t attr = none_of_e ) {
- assert(!elems.empty());
- cbl_ffi_arg_t arg( elems.back().crv, refer, attr );
+ cbl_ffi_crv_t crv = elems.empty()? by_reference_e : elems.back().crv;
+ cbl_ffi_arg_t arg( crv, refer, attr );
elems.push_back(arg);
return this;
}
@@ -1826,7 +1830,8 @@ new_tempnumeric_float(void) { return new_temporary(FldFloat); }
static inline cbl_field_t *
new_temporary_clone( const cbl_field_t *orig) {
- auto f = new_temporary_imply(orig->type);
+ cbl_field_type_t type = is_literal(orig)? FldAlphanumeric : orig->type;
+ auto f = new_temporary_imply(type);
f->data = orig->data;
parser_symbol_add(f);
return f;
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index a7ee009a4a48..3e4b7dee2f0e 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -980,7 +980,7 @@ USE([[:space:]]+FOR)? { return USE; }
BLANK { return BLANK; }
BLOCK { return BLOCK; }
BY { return BY; }
- BYTE-LENGTH { return BYTE_LENGTH; }
+ BYTE-LENGTH { return BYTE_LENGTH_OF; }
CHARACTER { return CHARACTER; }
CHARACTERS { return CHARACTERS; }
CODE-SET { return CODESET; }
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index d0b215db02c9..7fa780255391 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -888,7 +888,7 @@ struct cbl_num_result_t {
* CALL
*/
enum cbl_ffi_arg_attr_t { none_of_e, address_of_e, length_of_e };
-enum cbl_ffi_crv_t { by_reference_e, by_content_e, by_value_e };
+enum cbl_ffi_crv_t { by_reference_e = 'R', by_content_e = 'C', by_value_e = 'E' };
void parser_symbol_add( struct cbl_field_t *new_var );
void parser_local_add( struct cbl_field_t *new_var );
--
GitLab