Skip to content

Commit ff6894f

Browse files
tskeithtskeith
committed
Implement missing intrinsics in data initialization.
Bit-wise logical intrinsics (IAND, IOR, IEOR) were not implemented in data initialization expressions and array constructors.
1 parent 020f172 commit ff6894f

File tree

4 files changed

+112
-5
lines changed

4 files changed

+112
-5
lines changed

‎tools/flang1/flang1exe/semant.h‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -616,6 +616,9 @@ struct _aexpr {
616616
#define AC_I_atan2 42
617617
#define AC_I_selected_char_kind 43
618618
#define AC_I_abs 44
619+
#define AC_I_iand 45
620+
#define AC_I_ior 46
621+
#define AC_I_ieor 47
619622

620623
#define BINOP(p) ((p)->op != AC_NEG && (p)->op != AC_CONV)
621624

‎tools/flang1/flang1exe/semutil2.c‎

Lines changed: 58 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3829,6 +3829,15 @@ get_ac_intrinsic(int ast)
38293829
case I_DATAN2:
38303830
intrin = AC_I_atan2;
38313831
break;
3832+
case I_IAND:
3833+
intrin = AC_I_iand;
3834+
break;
3835+
case I_IOR:
3836+
intrin = AC_I_ior;
3837+
break;
3838+
case I_IEOR:
3839+
intrin = AC_I_ieor;
3840+
break;
38323841
}
38333842
break;
38343843
default:;
@@ -3873,6 +3882,9 @@ construct_intrinsic_acl(int ast, int dtype, int parent_acltype)
38733882
case AC_I_atan:
38743883
case AC_I_atan2:
38753884
case AC_I_abs:
3885+
case AC_I_iand:
3886+
case AC_I_ior:
3887+
case AC_I_ieor:
38763888
aclp = mk_elem_init_intrinsic(intrin, ast, dtype, parent_acltype);
38773889
break;
38783890
case AC_I_len:
@@ -8315,6 +8327,41 @@ eval_ishft(ACL *arg, int dtype)
83158327
return rslt;
83168328
}
83178329

8330+
#define INTINTRIN2(iname, ent, op) \
8331+
static ACL *ent(ACL *arg, DTYPE dtype) \
8332+
{ \
8333+
ACL *arg1 = eval_init_expr_item(arg); \
8334+
ACL *arg2 = eval_init_expr_item(arg->next); \
8335+
ACL *rslt = clone_init_const(arg1, TRUE); \
8336+
arg1 = rslt->id == AC_ACONST ? rslt->subc : rslt; \
8337+
arg2 = arg2->id == AC_ACONST ? arg2->subc : arg2; \
8338+
for (; arg1; arg1 = arg1->next, arg2 = arg2->next) { \
8339+
int con1 = arg1->conval; \
8340+
int con2 = arg2->conval; \
8341+
int num1[2], num2[2], res[2], conval; \
8342+
if (DT_ISWORD(arg1->dtype)) { \
8343+
num1[0] = 0, num1[1] = con1; \
8344+
} else { \
8345+
num1[0] = CONVAL1G(con1), num1[1] = CONVAL2G(con1); \
8346+
} \
8347+
if (DT_ISWORD(arg2->dtype)) { \
8348+
num2[0] = 0, num2[1] = con2; \
8349+
} else { \
8350+
num2[0] = CONVAL1G(con2), num2[1] = CONVAL2G(con2); \
8351+
} \
8352+
res[0] = num1[0] op num2[0]; \
8353+
res[1] = num1[1] op num2[1]; \
8354+
conval = DT_ISWORD(dtype) ? res[1] : getcon(res, DT_INT8); \
8355+
arg1->conval = conval; \
8356+
arg1->dtype = dtype; \
8357+
} \
8358+
return rslt; \
8359+
}
8360+
8361+
INTINTRIN2("iand", eval_iand, &)
8362+
INTINTRIN2("ior", eval_ior, |)
8363+
INTINTRIN2("ieor", eval_ieor, ^)
8364+
83188365
static ACL *
83198366
eval_ichar(ACL *arg, int dtype)
83208367
{
@@ -10387,9 +10434,18 @@ eval_init_op(int op, ACL *lop, int ldtype, ACL *rop, int rdtype, int sptr,
1038710434
case AC_I_abs:
1038810435
root = eval_abs(rop, dtype);
1038910436
break;
10437+
case AC_I_iand:
10438+
root = eval_iand(rop, dtype);
10439+
break;
10440+
case AC_I_ior:
10441+
root = eval_ior(rop, dtype);
10442+
break;
10443+
case AC_I_ieor:
10444+
root = eval_ieor(rop, dtype);
10445+
break;
1039010446
default:
10391-
interr("eval_init_op: intrinsic not supported in initialiation",
10392-
lop->u1.i, 3);
10447+
interr("eval_init_op(semutil2.c): intrinsic not supported in "
10448+
"initialization", lop->u1.i, 3);
1039310449
/* Try to avoid a seg fault by returning something reasonable */
1039410450
root = GET_ACL(15);
1039510451
root->id = AC_CONST;
@@ -13511,4 +13567,3 @@ gen_set_type(int dest_ast, int src_ast, int std, LOGICAL insert_before,
1351113567

1351213568
return std;
1351313569
}
13514-

‎tools/flang2/flang2exe/dinit.c‎

Lines changed: 48 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2263,6 +2263,43 @@ eval_ishft(CONST *arg, int dtype)
22632263
return rslt;
22642264
}
22652265

2266+
#define INTINTRIN2(iname, ent, op) \
2267+
static CONST *ent(CONST *arg, DTYPE dtype) \
2268+
{ \
2269+
CONST *arg1 = eval_init_expr_item(arg); \
2270+
CONST *arg2 = eval_init_expr_item(arg->next); \
2271+
CONST *rslt = clone_init_const_list(arg1, TRUE); \
2272+
arg1 = rslt->id == AC_ACONST ? rslt->subc : rslt; \
2273+
arg2 = arg2->id == AC_ACONST ? arg2->subc : arg2; \
2274+
for (; arg1; arg1 = arg1->next, arg2 = arg2->next) { \
2275+
int con1 = arg1->u1.conval; \
2276+
int con2 = arg2->u1.conval; \
2277+
int num1[2], num2[2], res[2], conval; \
2278+
if (DT_ISWORD(arg1->dtype)) { \
2279+
num1[0] = 0, num1[1] = con1; \
2280+
} else { \
2281+
num1[0] = CONVAL1G(con1), num1[1] = CONVAL2G(con1); \
2282+
} \
2283+
if (DT_ISWORD(arg2->dtype)) { \
2284+
num2[0] = 0, num2[1] = con2; \
2285+
} else { \
2286+
num2[0] = CONVAL1G(con2), num2[1] = CONVAL2G(con2); \
2287+
} \
2288+
res[0] = num1[0] op num2[0]; \
2289+
res[1] = num1[1] op num2[1]; \
2290+
conval = DT_ISWORD(dtype) ? res[1] : getcon(res, DT_INT8); \
2291+
arg1->u1.conval = conval; \
2292+
arg1->dtype = dtype; \
2293+
arg1->id = AC_CONST; \
2294+
arg1->repeatc = 1; \
2295+
} \
2296+
return rslt; \
2297+
}
2298+
2299+
INTINTRIN2("iand", eval_iand, &)
2300+
INTINTRIN2("ior", eval_ior, |)
2301+
INTINTRIN2("ieor", eval_ieor, ^)
2302+
22662303
static CONST *
22672304
eval_ichar(CONST *arg, int dtype)
22682305
{
@@ -4149,9 +4186,18 @@ eval_init_op(int op, CONST *lop, int ldtype, CONST *rop, int rdtype, int sptr,
41494186
case AC_I_abs:
41504187
root = eval_abs(rop, dtype);
41514188
break;
4189+
case AC_I_iand:
4190+
root = eval_iand(rop, dtype);
4191+
break;
4192+
case AC_I_ior:
4193+
root = eval_ior(rop, dtype);
4194+
break;
4195+
case AC_I_ieor:
4196+
root = eval_ieor(rop, dtype);
4197+
break;
41524198
default:
4153-
interr("eval_init_op: intrinsic not supported in initialiation",
4154-
lop->u1.conval, 3);
4199+
interr("eval_init_op(dinit.c): intrinsic not supported in "
4200+
"initialization", lop->u1.conval, 3);
41554201
return CONST_ERR(dtype);
41564202
}
41574203
} else if (DTY(ldtype) == TY_ARRAY && DTY(rdtype) == TY_ARRAY) {

‎tools/flang2/flang2exe/semant.h‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -418,6 +418,9 @@ struct const_init {
418418
#define AC_I_atan2 42
419419
#define AC_I_selected_char_kind 43
420420
#define AC_I_abs 44
421+
#define AC_I_iand 45
422+
#define AC_I_ior 46
423+
#define AC_I_ieor 47
421424

422425
#define AC_UNARY_OP(e) (e.op == AC_NEG || e.op == AC_CONV)
423426

0 commit comments

Comments
 (0)