Skip to content

Commit ba7b1b1

Browse files
AlexisPerryAlexisPerry
authored
Merge pull request #995 from flang-compiler/aperry-nearest
Lowering for NEAREST intrinsic
2 parents f92b8a0 + 51295e5 commit ba7b1b1

File tree

5 files changed

+163
-0
lines changed

5 files changed

+163
-0
lines changed

‎flang/include/flang/Lower/NumericRuntime.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,10 @@ mlir::Value genExponent(Fortran::lower::FirOpBuilder &builder,
2727
mlir::Value genFraction(Fortran::lower::FirOpBuilder &builder,
2828
mlir::Location loc, mlir::Value x);
2929

30+
/// Generate call to Nearest intrinsic runtime routine.
31+
mlir::Value genNearest(Fortran::lower::FirOpBuilder &builder,
32+
mlir::Location loc, mlir::Value x, mlir::Value s);
33+
3034
/// Generate call to RRSpacing intrinsic runtime routine.
3135
mlir::Value genRRSpacing(Fortran::lower::FirOpBuilder &builder,
3236
mlir::Location loc, mlir::Value x);

‎flang/lib/Lower/IntrinsicCall.cpp

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -494,6 +494,7 @@ struct IntrinsicLibrary {
494494
mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
495495
mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
496496
void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
497+
mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
497498
mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
498499
mlir::Value genNot(mlir::Type, llvm::ArrayRef<mlir::Value>);
499500
fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -755,6 +756,7 @@ static constexpr IntrinsicHandler handlers[]{
755756
{"len", asValue},
756757
{"to", asAddr},
757758
{"topos", asValue}}}},
759+
{"nearest", &I::genNearest},
758760
{"nint", &I::genNint},
759761
{"not", &I::genNot},
760762
{"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
@@ -2622,6 +2624,18 @@ void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
26222624
builder.create<fir::StoreOp>(loc, res, toAddr);
26232625
}
26242626

2627+
// NEAREST
2628+
mlir::Value IntrinsicLibrary::genNearest(mlir::Type resultType,
2629+
llvm::ArrayRef<mlir::Value> args) {
2630+
assert(args.size() == 2);
2631+
2632+
auto realX = fir::getBase(args[0]);
2633+
auto realS = fir::getBase(args[1]);
2634+
2635+
return builder.createConvert(
2636+
loc, resultType, Fortran::lower::genNearest(builder, loc, realX, realS));
2637+
}
2638+
26252639
// NINT
26262640
mlir::Value IntrinsicLibrary::genNint(mlir::Type resultType,
26272641
llvm::ArrayRef<mlir::Value> args) {

‎flang/lib/Lower/NumericRuntime.cpp

Lines changed: 60 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -91,6 +91,30 @@ struct ForcedFraction16 {
9191
}
9292
};
9393

94+
/// Placeholder for real*10 version of Nearest Intrinsic
95+
struct ForcedNearest10 {
96+
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest10));
97+
static constexpr Fortran::lower::FuncTypeBuilderFunc getTypeModel() {
98+
return [](mlir::MLIRContext *ctx) {
99+
auto fltTy = mlir::FloatType::getF80(ctx);
100+
auto boolTy = mlir::IntegerType::get(ctx, 1);
101+
return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
102+
};
103+
}
104+
};
105+
106+
/// Placeholder for real*16 version of Nearest Intrinsic
107+
struct ForcedNearest16 {
108+
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(Nearest16));
109+
static constexpr Fortran::lower::FuncTypeBuilderFunc getTypeModel() {
110+
return [](mlir::MLIRContext *ctx) {
111+
auto fltTy = mlir::FloatType::getF128(ctx);
112+
auto boolTy = mlir::IntegerType::get(ctx, 1);
113+
return mlir::FunctionType::get(ctx, {fltTy, boolTy}, {fltTy});
114+
};
115+
}
116+
};
117+
94118
/// Placeholder for real*10 version of RRSpacing Intrinsic
95119
struct ForcedRRSpacing10 {
96120
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(RRSpacing10));
@@ -244,6 +268,42 @@ mlir::Value Fortran::lower::genFraction(Fortran::lower::FirOpBuilder &builder,
244268
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
245269
}
246270

271+
/// Generate call to Nearest intrinsic runtime routine.
272+
mlir::Value Fortran::lower::genNearest(Fortran::lower::FirOpBuilder &builder,
273+
mlir::Location loc, mlir::Value x,
274+
mlir::Value s) {
275+
mlir::FuncOp func;
276+
mlir::Type fltTy = x.getType();
277+
278+
if (fltTy.isF32())
279+
func = Fortran::lower::getRuntimeFunc<mkRTKey(Nearest4)>(loc, builder);
280+
else if (fltTy.isF64())
281+
func = Fortran::lower::getRuntimeFunc<mkRTKey(Nearest8)>(loc, builder);
282+
else if (fltTy.isF80())
283+
func = Fortran::lower::getRuntimeFunc<ForcedNearest10>(loc, builder);
284+
else if (fltTy.isF128())
285+
func = Fortran::lower::getRuntimeFunc<ForcedNearest16>(loc, builder);
286+
else
287+
fir::emitFatalError(loc, "unsupported REAL kind in Nearest lowering");
288+
289+
auto funcTy = func.getType();
290+
291+
mlir::Type sTy = s.getType();
292+
mlir::Value zero = builder.createRealZeroConstant(loc, sTy);
293+
auto cmp =
294+
builder.create<mlir::CmpFOp>(loc, mlir::CmpFPredicate::OGT, s, zero);
295+
296+
mlir::Type boolTy = mlir::IntegerType::get(builder.getContext(), 1);
297+
mlir::Value False = builder.createIntegerConstant(loc, boolTy, 0);
298+
mlir::Value True = builder.createIntegerConstant(loc, boolTy, 1);
299+
300+
mlir::Value positive = builder.create<mlir::SelectOp>(loc, cmp, True, False);
301+
auto args =
302+
Fortran::lower::createArguments(builder, loc, funcTy, x, positive);
303+
304+
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
305+
}
306+
247307
/// Generate call to RRSpacing intrinsic runtime routine.
248308
mlir::Value Fortran::lower::genRRSpacing(Fortran::lower::FirOpBuilder &builder,
249309
mlir::Location loc, mlir::Value x) {

‎flang/test/Intrinsics/nearest.f90

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
! RUN: bbc %s -o - | FileCheck %s
2+
3+
! CHECK: _QQmain
4+
program test_nearest
5+
real :: x = 207.0
6+
real :: s = 2.0
7+
real :: negS = -2.0
8+
9+
print *,"nearest(x,s) = ", nearest(x, s)
10+
print *,"nearest(x,negS) = ", nearest(x, negS)
11+
print *,"difference = ", nearest(x, s) - nearest(x, negS)
12+
13+
end program test_nearest

‎flang/test/Lower/intrinsic-procedures/nearest.f90

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
2+
3+
! CHECK-LABEL: nearest_test1
4+
subroutine nearest_test1(x, s)
5+
real :: x, s, res
6+
! CHECK: %[[res:.*]] = fir.alloca f32 {bindc_name = "res", uniq_name = "_QFnearest_test1Eres"}
7+
! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref<f32>
8+
! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f32>
9+
! CHECK: %[[zero:.*]] = constant 0.000000e+00 : f32
10+
! CHECK: %[[cmp:.*]] = cmpf ogt, %[[s]], %[[zero]] : f32
11+
! CHECK: %[[pos:.*]] = select %[[cmp]], %true, %false : i1
12+
res = nearest(x, s)
13+
! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest4(%[[x]], %[[pos]]) : (f32, i1) -> f32
14+
! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref<f32>
15+
end subroutine nearest_test1
16+
17+
! CHECK-LABEL: nearest_test2
18+
subroutine nearest_test2(x, s)
19+
real(kind=8) :: x, s, res
20+
! CHECK: %[[res:.*]] = fir.alloca f64 {bindc_name = "res", uniq_name = "_QFnearest_test2Eres"}
21+
! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref<f64>
22+
! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f64>
23+
! CHECK: %[[zero:.*]] = constant 0.000000e+00 : f64
24+
! CHECK: %[[cmp:.*]] = cmpf ogt, %[[s]], %[[zero]] : f64
25+
! CHECK: %[[pos:.*]] = select %[[cmp]], %true, %false : i1
26+
res = nearest(x, s)
27+
! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest8(%[[x]], %[[pos]]) : (f64, i1) -> f64
28+
! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref<f64>
29+
end subroutine nearest_test2
30+
31+
! CHECK-LABEL: nearest_test3
32+
subroutine nearest_test3(x, s)
33+
real(kind=10) :: x, s, res
34+
! CHECK: %[[res:.*]] = fir.alloca f80 {bindc_name = "res", uniq_name = "_QFnearest_test3Eres"}
35+
! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref<f80>
36+
! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f80>
37+
! CHECK: %[[zero:.*]] = constant 0.000000e+00 : f80
38+
! CHECK: %[[cmp:.*]] = cmpf ogt, %[[s]], %[[zero]] : f80
39+
! CHECK: %[[pos:.*]] = select %[[cmp]], %true, %false : i1
40+
res = nearest(x, s)
41+
! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest10(%[[x]], %[[pos]]) : (f80, i1) -> f80
42+
! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref<f80>
43+
end subroutine nearest_test3
44+
45+
! CHECK-LABEL: nearest_test4
46+
subroutine nearest_test4(x, s)
47+
real(kind=16) :: x, s, res
48+
! CHECK: %[[res:.*]] = fir.alloca f128 {bindc_name = "res", uniq_name = "_QFnearest_test4Eres"}
49+
! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref<f128>
50+
! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f128>
51+
! CHECK: %[[zero:.*]] = constant 0.000000e+00 : f128
52+
! CHECK: %[[cmp:.*]] = cmpf ogt, %[[s]], %[[zero]] : f128
53+
! CHECK: %[[pos:.*]] = select %[[cmp]], %true, %false : i1
54+
res = nearest(x, s)
55+
! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest16(%[[x]], %[[pos]]) : (f128, i1) -> f128
56+
! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref<f128>
57+
end subroutine nearest_test4
58+
59+
! CHECK-LABEL: nearest_test5
60+
subroutine nearest_test5(x, s)
61+
real(kind=16) :: x, res
62+
! CHECK: %[[res:.*]] = fir.alloca f128 {bindc_name = "res", uniq_name = "_QFnearest_test5Eres"}
63+
! CHECK: %[[x:.*]] = fir.load %arg0 : !fir.ref<f128>
64+
real :: s
65+
! CHECK: %[[s:.*]] = fir.load %arg1 : !fir.ref<f32>
66+
! CHECK: %[[zero:.*]] = constant 0.000000e+00 : f32
67+
! CHECK: %[[cmp:.*]] = cmpf ogt, %[[s]], %[[zero]] : f32
68+
! CHECK: %[[pos:.*]] = select %[[cmp]], %true, %false : i1
69+
res = nearest(x, s)
70+
! CHECK: %[[tmp:.*]] = fir.call @_FortranANearest16(%[[x]], %[[pos]]) : (f128, i1) -> f128
71+
! CHECK: fir.store %[[tmp]] to %[[res]] : !fir.ref<f128>
72+
end subroutine nearest_test5

0 commit comments

Comments
 (0)