diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td --- a/flang/include/flang/Optimizer/Dialect/FIROps.td +++ b/flang/include/flang/Optimizer/Dialect/FIROps.td @@ -1053,6 +1053,23 @@ let results = (outs AnyIntegerLike); } +def fir_BoxTypeCodeOp : fir_SimpleOneResultOp<"box_typecode", [NoMemoryEffect]> +{ + let summary = "return the type code the boxed value"; + + let description = [{ + Returns the descriptor type code of an entity of `box` type. + + ```mlir + %1 = fir.box_type %0 : (!fir.box) -> i32 + ``` + }]; + + let arguments = (ins BoxOrClassType:$box); + + let results = (outs AnyIntegerLike); +} + def fir_BoxIsAllocOp : fir_SimpleOp<"box_isalloc", [NoMemoryEffect]> { let summary = "is the boxed value an ALLOCATABLE?"; diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -650,6 +650,23 @@ } }; +/// Lower `fir.box_typecode` to a sequence of operations to extract the type +/// code in the boxed value. +struct BoxTypeCodeOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::BoxTypeCodeOp op, OpAdaptor adaptor, + mlir::ConversionPatternRewriter &rewriter) const override { + mlir::Value box = adaptor.getOperands()[0]; + auto loc = box.getLoc(); + auto ty = convertType(op.getType()); + auto typeCode = getValueFromBox(loc, box, ty, rewriter, kTypePosInBox); + rewriter.replaceOp(op, typeCode); + return mlir::success(); + } +}; + /// Lower `fir.string_lit` to LLVM IR dialect operation. struct StringLitOpConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; @@ -3584,24 +3601,24 @@ AllocaOpConversion, AllocMemOpConversion, BoxAddrOpConversion, BoxCharLenOpConversion, BoxDimsOpConversion, BoxEleSizeOpConversion, BoxIsAllocOpConversion, BoxIsArrayOpConversion, BoxIsPtrOpConversion, - BoxProcHostOpConversion, BoxRankOpConversion, BoxTypeDescOpConversion, - CallOpConversion, CmpcOpConversion, ConstcOpConversion, - ConvertOpConversion, CoordinateOpConversion, DispatchOpConversion, - DispatchTableOpConversion, DTEntryOpConversion, DivcOpConversion, - EmboxOpConversion, EmboxCharOpConversion, EmboxProcOpConversion, - ExtractValueOpConversion, FieldIndexOpConversion, FirEndOpConversion, - FreeMemOpConversion, GenTypeDescOpConversion, GlobalLenOpConversion, - GlobalOpConversion, HasValueOpConversion, InsertOnRangeOpConversion, - InsertValueOpConversion, IsPresentOpConversion, - LenParamIndexOpConversion, LoadOpConversion, MulcOpConversion, - NegcOpConversion, NoReassocOpConversion, SelectCaseOpConversion, - SelectOpConversion, SelectRankOpConversion, SelectTypeOpConversion, - ShapeOpConversion, ShapeShiftOpConversion, ShiftOpConversion, - SliceOpConversion, StoreOpConversion, StringLitOpConversion, - SubcOpConversion, UnboxCharOpConversion, UnboxProcOpConversion, - UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion, - XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>( - typeConverter, options, bindingTables); + BoxProcHostOpConversion, BoxRankOpConversion, BoxTypeCodeOpConversion, + BoxTypeDescOpConversion, CallOpConversion, CmpcOpConversion, + ConstcOpConversion, ConvertOpConversion, CoordinateOpConversion, + DispatchOpConversion, DispatchTableOpConversion, DTEntryOpConversion, + DivcOpConversion, EmboxOpConversion, EmboxCharOpConversion, + EmboxProcOpConversion, ExtractValueOpConversion, FieldIndexOpConversion, + FirEndOpConversion, FreeMemOpConversion, GenTypeDescOpConversion, + GlobalLenOpConversion, GlobalOpConversion, HasValueOpConversion, + InsertOnRangeOpConversion, InsertValueOpConversion, + IsPresentOpConversion, LenParamIndexOpConversion, LoadOpConversion, + MulcOpConversion, NegcOpConversion, NoReassocOpConversion, + SelectCaseOpConversion, SelectOpConversion, SelectRankOpConversion, + SelectTypeOpConversion, ShapeOpConversion, ShapeShiftOpConversion, + ShiftOpConversion, SliceOpConversion, StoreOpConversion, + StringLitOpConversion, SubcOpConversion, UnboxCharOpConversion, + UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion, + XArrayCoorOpConversion, XEmboxOpConversion, XReboxOpConversion, + ZeroOpConversion>(typeConverter, options, bindingTables); mlir::populateFuncToLLVMConversionPatterns(typeConverter, pattern); mlir::populateOpenMPToLLVMConversionPatterns(typeConverter, pattern); mlir::arith::populateArithToLLVMConversionPatterns(typeConverter, pattern); diff --git a/flang/test/Fir/box-typecode.fir b/flang/test/Fir/box-typecode.fir new file mode 100644 --- /dev/null +++ b/flang/test/Fir/box-typecode.fir @@ -0,0 +1,12 @@ +// RUN: tco %s | FileCheck %s + +func.func @test_box_typecode(%a: !fir.class) -> i32 { + %0 = fir.box_typecode %a : (!fir.class) -> i32 + return %0 : i32 +} + +// CHECK-LABEL: @test_box_typecode( +// CHECK-SAME: ptr %[[BOX:.*]]) +// CHECK: %[[GEP:.*]] = getelementptr { ptr, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}} }, ptr %[[BOX]], i32 0, i32 4 +// CHECK: %[[TYPE_CODE:.*]] = load i32, ptr %[[GEP]] +// CHECK: ret i32 %[[TYPE_CODE]] diff --git a/flang/test/Fir/fir-ops.fir b/flang/test/Fir/fir-ops.fir --- a/flang/test/Fir/fir-ops.fir +++ b/flang/test/Fir/fir-ops.fir @@ -882,3 +882,12 @@ // CHECK: fir.alloca f32 {fortran_attrs = #fir.var_attrs} // CHECK: fir.alloca !fir.box>> {fortran_attrs = #fir.var_attrs} } + +func.func @test_box_typecode(%a: !fir.class) { + %0 = fir.box_typecode %a : (!fir.class) -> i32 + return +} + +// CHECK-LABEL: func.func @test_box_typecode( +// CHECK-SAME: %[[A:.*]]: !fir.class) +// CHECK: %{{.*}} = fir.box_typecode %[[A]] : (!fir.class) -> i32