12
12
13
13
#include " PrivateReductionUtils.h"
14
14
15
+ #include " flang/Lower/ConvertVariable.h"
15
16
#include " flang/Optimizer/Builder/BoxValue.h"
16
17
#include " flang/Optimizer/Builder/Character.h"
17
18
#include " flang/Optimizer/Builder/FIRBuilder.h"
18
19
#include " flang/Optimizer/Builder/HLFIRTools.h"
20
+ #include " flang/Optimizer/Builder/Runtime/Derived.h"
19
21
#include " flang/Optimizer/Builder/Todo.h"
20
22
#include " flang/Optimizer/Dialect/FIROps.h"
21
23
#include " flang/Optimizer/Dialect/FIRType.h"
24
+ #include " flang/Optimizer/HLFIR/HLFIRDialect.h"
22
25
#include " flang/Optimizer/HLFIR/HLFIROps.h"
23
26
#include " flang/Optimizer/Support/FatalError.h"
27
+ #include " flang/Semantics/symbol.h"
24
28
#include " mlir/Dialect/OpenMP/OpenMPDialect.h"
25
29
#include " mlir/IR/Location.h"
26
30
31
+ static bool hasFinalization (const Fortran::semantics::Symbol &sym) {
32
+ if (sym.has <Fortran::semantics::ObjectEntityDetails>())
33
+ if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType ())
34
+ if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
35
+ declTypeSpec->AsDerived ())
36
+ return Fortran::semantics::IsFinalizable (*derivedTypeSpec);
37
+ return false ;
38
+ }
39
+
27
40
static void createCleanupRegion (fir::FirOpBuilder &builder, mlir::Location loc,
28
- mlir::Type argType,
29
- mlir::Region &cleanupRegion ) {
41
+ mlir::Type argType, mlir::Region &cleanupRegion,
42
+ const Fortran::semantics::Symbol *sym ) {
30
43
assert (cleanupRegion.empty ());
31
44
mlir::Block *block = builder.createBlock (&cleanupRegion, cleanupRegion.end (),
32
45
{argType}, {loc});
@@ -41,12 +54,6 @@ static void createCleanupRegion(fir::FirOpBuilder &builder, mlir::Location loc,
41
54
42
55
mlir::Type valTy = fir::unwrapRefType (argType);
43
56
if (auto boxTy = mlir::dyn_cast_or_null<fir::BaseBoxType>(valTy)) {
44
- if (!mlir::isa<fir::HeapType, fir::PointerType>(boxTy.getEleTy ())) {
45
- mlir::Type innerTy = fir::extractSequenceType (boxTy);
46
- if (!mlir::isa<fir::SequenceType>(innerTy))
47
- typeError ();
48
- }
49
-
50
57
mlir::Value arg = builder.loadIfRef (loc, block->getArgument (0 ));
51
58
assert (mlir::isa<fir::BaseBoxType>(arg.getType ()));
52
59
@@ -138,13 +145,20 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
138
145
fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type argType,
139
146
mlir::Value scalarInitValue, mlir::Block *initBlock,
140
147
mlir::Value allocatedPrivVarArg, mlir::Value moldArg,
141
- mlir::Region &cleanupRegion, bool isPrivate) {
148
+ mlir::Region &cleanupRegion, bool isPrivate,
149
+ const Fortran::semantics::Symbol *sym) {
142
150
mlir::Type ty = fir::unwrapRefType (argType);
143
151
builder.setInsertionPointToEnd (initBlock);
144
152
auto yield = [&](mlir::Value ret) {
145
153
builder.create <mlir::omp::YieldOp>(loc, ret);
146
154
};
147
155
156
+ if (isPrivate)
157
+ assert (sym && " Symbol information is needed to privatize derived types" );
158
+ bool needsInitialization =
159
+ sym ? Fortran::lower::hasDefaultInitialization (sym->GetUltimate ())
160
+ : false ;
161
+
148
162
if (fir::isa_trivial (ty)) {
149
163
builder.setInsertionPointToEnd (initBlock);
150
164
@@ -214,39 +228,62 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
214
228
}
215
229
216
230
moldArg = builder.loadIfRef (loc, moldArg);
217
- hlfir::genLengthParameters (loc, builder, hlfir::Entity{moldArg}, lenParams);
231
+ // We pass derived types unboxed and so are not self-contained entities.
232
+ if (hlfir::isFortranEntity (moldArg))
233
+ hlfir::genLengthParameters (loc, builder, hlfir::Entity{moldArg},
234
+ lenParams);
218
235
219
236
mlir::Type innerTy = fir::unwrapRefType (boxTy.getEleTy ());
237
+ bool isDerived = fir::isa_derived (innerTy);
220
238
bool isChar = fir::isa_char (innerTy);
221
- if (fir::isa_trivial (innerTy) || isChar) {
239
+ if (fir::isa_trivial (innerTy) || isDerived || isChar) {
222
240
// boxed non-sequence value e.g. !fir.box<!fir.heap<i32>>
223
- if (!isAllocatableOrPointer)
224
- TODO (loc,
225
- " Reduction/Privatization of non-allocatable trivial typed box" );
241
+ if (!isAllocatableOrPointer && !isDerived )
242
+ TODO (loc, " Reduction/Privatization of non-allocatable trivial or "
243
+ " character typed box" );
226
244
227
- fir::IfOp ifUnallocated = handleNullAllocatable (boxAlloca, moldArg);
245
+ if ((isDerived || isChar) && (!isPrivate || scalarInitValue))
246
+ TODO (loc, " Reduction of an unsupported boxed type" );
247
+
248
+ fir::IfOp ifUnallocated{nullptr };
249
+ if (isAllocatableOrPointer) {
250
+ ifUnallocated = handleNullAllocatable (boxAlloca, moldArg);
251
+ builder.setInsertionPointToStart (
252
+ &ifUnallocated.getElseRegion ().front ());
253
+ }
228
254
229
- builder.setInsertionPointToStart (&ifUnallocated.getElseRegion ().front ());
230
255
mlir::Value valAlloc = builder.createHeapTemporary (
231
256
loc, innerTy, /* name=*/ {}, /* shape=*/ {}, lenParams);
232
257
if (scalarInitValue)
233
258
builder.createStoreWithConvert (loc, scalarInitValue, valAlloc);
234
259
mlir::Value box = builder.create <fir::EmboxOp>(
235
260
loc, ty, valAlloc, /* shape=*/ mlir::Value{}, /* slice=*/ mlir::Value{},
236
261
lenParams);
237
- builder.create <fir::StoreOp>(loc, box, boxAlloca);
262
+ if (needsInitialization)
263
+ fir::runtime::genDerivedTypeInitialize (builder, loc, box);
264
+ fir::StoreOp lastOp = builder.create <fir::StoreOp>(loc, box, boxAlloca);
238
265
239
- createCleanupRegion (builder, loc, argType, cleanupRegion);
240
- builder.setInsertionPointAfter (ifUnallocated);
266
+ createCleanupRegion (builder, loc, argType, cleanupRegion, sym);
267
+
268
+ if (ifUnallocated)
269
+ builder.setInsertionPointAfter (ifUnallocated);
270
+ else
271
+ builder.setInsertionPointAfter (lastOp);
241
272
yield (boxAlloca);
242
273
return ;
243
274
}
275
+
244
276
innerTy = fir::extractSequenceType (boxTy);
245
277
if (!innerTy || !mlir::isa<fir::SequenceType>(innerTy))
246
278
TODO (loc, " Unsupported boxed type for reduction/privatization" );
247
279
248
280
moldArg = builder.loadIfRef (loc, moldArg);
249
- hlfir::genLengthParameters (loc, builder, hlfir::Entity{moldArg}, lenParams);
281
+ // We pass derived types unboxed and so are not self-contained entities.
282
+ // Assume that if length parameters are required, they will be boxed by
283
+ // lowering.
284
+ if (hlfir::isFortranEntity (moldArg))
285
+ hlfir::genLengthParameters (loc, builder, hlfir::Entity{moldArg},
286
+ lenParams);
250
287
251
288
fir::IfOp ifUnallocated{nullptr };
252
289
if (isAllocatableOrPointer) {
@@ -274,7 +311,7 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
274
311
" createTempFromMold decides this statically" );
275
312
if (cstNeedsDealloc.has_value () && *cstNeedsDealloc != false ) {
276
313
mlir::OpBuilder::InsertionGuard guard (builder);
277
- createCleanupRegion (builder, loc, argType, cleanupRegion);
314
+ createCleanupRegion (builder, loc, argType, cleanupRegion, sym );
278
315
} else {
279
316
assert (!isAllocatableOrPointer &&
280
317
" Pointer-like arrays must be heap allocated" );
@@ -298,6 +335,9 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
298
335
299
336
if (scalarInitValue)
300
337
builder.create <hlfir::AssignOp>(loc, scalarInitValue, box);
338
+ if (needsInitialization)
339
+ fir::runtime::genDerivedTypeInitialize (builder, loc, box);
340
+
301
341
builder.create <fir::StoreOp>(loc, box, boxAlloca);
302
342
if (ifUnallocated)
303
343
builder.setInsertionPointAfter (ifUnallocated);
@@ -323,13 +363,29 @@ void Fortran::lower::omp::populateByRefInitAndCleanupRegions(
323
363
loc, eleTy, /* name=*/ {}, /* shape=*/ {}, /* lenParams=*/ len);
324
364
mlir::Value boxChar = charExprHelper.createEmboxChar (privateAddr, len);
325
365
326
- createCleanupRegion (builder, loc, argType, cleanupRegion);
366
+ createCleanupRegion (builder, loc, argType, cleanupRegion, sym );
327
367
328
368
builder.setInsertionPointToEnd (initBlock);
329
369
yield (boxChar);
330
370
return ;
331
371
}
332
372
373
+ if (fir::isa_derived (ty)) {
374
+ if (needsInitialization) {
375
+ builder.setInsertionPointToStart (initBlock);
376
+ mlir::Type boxedTy = fir::BoxType::get (ty);
377
+ mlir::Value box =
378
+ builder.create <fir::EmboxOp>(loc, boxedTy, allocatedPrivVarArg);
379
+ fir::runtime::genDerivedTypeInitialize (builder, loc, box);
380
+ }
381
+ if (sym && hasFinalization (*sym))
382
+ createCleanupRegion (builder, loc, argType, cleanupRegion, sym);
383
+
384
+ builder.setInsertionPointToEnd (initBlock);
385
+ yield (allocatedPrivVarArg);
386
+ return ;
387
+ }
388
+
333
389
TODO (loc,
334
390
" creating reduction/privatization init region for unsupported type" );
335
391
return ;
0 commit comments