Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -574,8 +574,8 @@ DefaultLogical}, {"llt", {{"string_a", SameCharNoLen}, {"string_b", SameCharNoLen}}, DefaultLogical}, - {"loc", {{"loc_argument", Addressable, Rank::anyOrAssumedRank}}, - SubscriptInt, Rank::scalar}, + {"loc", {{"x", Addressable, Rank::anyOrAssumedRank}}, SubscriptInt, + Rank::scalar}, {"log", {{"x", SameFloating}}, SameFloating}, {"log10", {{"x", SameReal}}, SameReal}, {"logical", {{"l", AnyLogical}, DefaultingKIND}, KINDLogical}, Index: flang/lib/Lower/IntrinsicCall.cpp =================================================================== --- flang/lib/Lower/IntrinsicCall.cpp +++ flang/lib/Lower/IntrinsicCall.cpp @@ -530,6 +530,7 @@ mlir::Value genLeadz(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genLoc(mlir::Type, llvm::ArrayRef); template mlir::Value genMask(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef); @@ -879,6 +880,7 @@ {"lgt", &I::genCharacterCompare}, {"lle", &I::genCharacterCompare}, {"llt", &I::genCharacterCompare}, + {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false}, {"maskl", &I::genMask}, {"maskr", &I::genMask}, {"matmul", @@ -2672,6 +2674,22 @@ return builder.createConvert(loc, resultType, res); } +static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder, + mlir::Location loc, fir::ExtendedValue arg, + bool isFunc) { + mlir::Value argValue = fir::getBase(arg); + mlir::Value addr{nullptr}; + if (isFunc) { + auto funcTy = argValue.getType().cast().getEleTy(); + addr = builder.create(loc, funcTy, argValue); + } else { + const auto *box = arg.getBoxOf(); + addr = builder.create(loc, box->getMemTy(), + fir::getBase(*box)); + } + return addr; +} + static fir::ExtendedValue genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Type resultType, llvm::ArrayRef args, @@ -2680,19 +2698,9 @@ mlir::Value res = builder.create(loc, resultType); mlir::Value resAddr = fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType); - mlir::Value argAddr; - if (isFunc) { - mlir::Value argValue = fir::getBase(args[0]); - assert(argValue.getType().isa() && - "c_funloc argument must have been lowered to a fir.boxproc"); - auto funcTy = argValue.getType().cast().getEleTy(); - argAddr = builder.create(loc, funcTy, argValue); - } else { - const auto *box = args[0].getBoxOf(); - assert(box && "c_loc argument must have been lowered to a fir.box"); - argAddr = builder.create(loc, box->getMemTy(), - fir::getBase(*box)); - } + assert(fir::isa_box_type(fir::getBase(args[0]).getType()) && + "argument must have been lowered to box type"); + mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc); mlir::Value argAddrVal = builder.createConvert( loc, fir::unwrapRefType(resAddr.getType()), argAddr); builder.create(loc, argAddrVal, resAddr); @@ -3748,6 +3756,19 @@ fir::getBase(args[1]), fir::getLen(args[1])); } +// LOC +fir::ExtendedValue +IntrinsicLibrary::genLoc(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + mlir::Value argValue = fir::getBase(args[0]); + assert(fir::isa_box_type(argValue.getType()) && + "argument must have been lowered to box type"); + bool isFunc = argValue.getType().isa(); + mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc); + return builder.createConvert(loc, fir::unwrapRefType(resultType), argAddr); +} + // MASKL, MASKR template mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType, Index: flang/test/Lower/Intrinsics/loc.f90 =================================================================== --- /dev/null +++ flang/test/Lower/Intrinsics/loc.f90 @@ -0,0 +1,250 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s + +! Test LOC intrinsic + +! CHECK-LABEL: func.func @_QPloc_scalar() { +subroutine loc_scalar() + integer(8) :: p + integer :: x + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[x:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref) -> !fir.box +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box) -> !fir.ref +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_char() { +subroutine loc_char() + integer(8) :: p + character(5) :: x = "abcde" + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_charEx) : !fir.ref> +! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_substring() { +subroutine loc_substring() + integer(8) :: p + character(5) :: x = "abcde" + p = loc(x(2:)) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_substringEx) : !fir.ref> +! CHECK: %[[sslb:.*]] = arith.constant 2 : i64 +! CHECK: %[[ssub:.*]] = arith.constant 5 : i64 +! CHECK: %[[sslbidx:.*]] = fir.convert %[[sslb]] : (i64) -> index +! CHECK: %[[ssubidx:.*]] = fir.convert %[[ssub]] : (i64) -> index +! CHECK: %[[one:.*]] = arith.constant 1 : index +! CHECK: %[[lboffset:.*]] = arith.subi %[[sslbidx]], %c1 : index +! CHECK: %[[xarr:.*]] = fir.convert %[[x]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[xarrcoord:.*]] = fir.coordinate_of %[[xarr]], %[[lboffset]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[xss:.*]] = fir.convert %[[xarrcoord]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[rng:.*]] = arith.subi %[[ssubidx]], %[[sslbidx]] : index +! CHECK: %[[rngp1:.*]] = arith.addi %[[rng]], %[[one]] : index +! CHECK: %[[zero:.*]] = arith.constant 0 : index +! CHECK: %[[cmpval:.*]] = arith.cmpi slt, %[[rngp1]], %[[zero]] : index +! CHECK: %[[sltval:.*]] = arith.select %[[cmpval]], %[[zero]], %[[rngp1]] : index +! CHECK: %[[xssbox:.*]] = fir.embox %[[xss]] typeparams %[[sltval]] : (!fir.ref>, index) -> !fir.box> +! CHECK: %[[xssaddr:.*]] = fir.box_addr %[[xssbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xssaddrval:.*]] = fir.convert %[[xssaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xssaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_array() { +subroutine loc_array + integer(8) :: p + integer :: x(10) + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[ten:.*]] = arith.constant 10 : index +! CHECK: %[[x:.*]] = fir.alloca !fir.array<10xi32> {{.*}} +! CHECK: %[[xshp:.*]] = fir.shape %[[ten]] : (index) -> !fir.shape<1> +! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_chararray() { +subroutine loc_chararray() + integer(8) :: p + character(5) :: x(2) + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[two:.*]] = arith.constant 2 : index +! CHECK: %[[x:.*]] = fir.alloca !fir.array<2x!fir.char<1,5>> {{.*}} +! CHECK: %[[xshp:.*]] = fir.shape %[[two]] : (index) -> !fir.shape<1> +! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box>>) -> !fir.ref>> +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref>>) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_arrayelement() { +subroutine loc_arrayelement() + integer(8) :: p + integer :: x(10) + p = loc(x(7)) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[x:.*]] = fir.alloca !fir.array<10xi32> {{.*}} +! CHECK: %[[idx:.*]] = arith.constant 7 : i64 +! CHECK: %[[lb:.*]] = arith.constant 1 : i64 +! CHECK: %[[offset:.*]] = arith.subi %[[idx]], %[[lb]] : i64 +! CHECK: %[[xelemcoord:.*]] = fir.coordinate_of %[[x]], %[[offset]] : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[xelembox:.*]] = fir.embox %[[xelemcoord]] : (!fir.ref) -> !fir.box +! CHECK: %[[xelemaddr:.*]] = fir.box_addr %[[xelembox]] : (!fir.box) -> !fir.ref +! CHECK: %[[xelemaddrval:.*]] = fir.convert %[[xelemaddr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[xelemaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_arraysection( +! CHECK-SAME: %[[arg:.*]]: !fir.ref {{.*}}) { +subroutine loc_arraysection(i) + integer(8) :: p + integer :: i + real :: x(11) + p = loc(x(i:)) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[eleven:.*]] = arith.constant 11 : index +! CHECK: %[[x:.*]] = fir.alloca !fir.array<11xf32> {{.*}} +! CHECK: %[[one:.*]] = arith.constant 1 : index +! CHECK: %[[i:.*]] = fir.load %[[arg]] : !fir.ref +! CHECK: %[[il:.*]] = fir.convert %[[i]] : (i32) -> i64 +! CHECK: %[[iidx:.*]] = fir.convert %[[il]] : (i64) -> index +! CHECK: %[[onel:.*]] = arith.constant 1 : i64 +! CHECK: %[[stpidx:.*]] = fir.convert %[[onel]] : (i64) -> index +! CHECK: %[[xrng:.*]] = arith.addi %[[one]], %[[eleven]] : index +! CHECK: %[[xub:.*]] = arith.subi %[[xrng]], %[[one]] : index +! CHECK: %[[xshp:.*]] = fir.shape %[[eleven]] : (index) -> !fir.shape<1> +! CHECK: %[[xslice:.*]] = fir.slice %[[iidx]], %[[xub]], %[[stpidx]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) [%[[xslice]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_non_save_pointer_scalar() { +subroutine loc_non_save_pointer_scalar() + integer(8) :: p + real, pointer :: x + real, target :: t + x => t + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[t:.*]] = fir.alloca f32 {{.*}} +! CHECK: %2 = fir.alloca !fir.box> {{.*}} +! CHECK: %[[xa:.*]] = fir.alloca !fir.ptr {{.*}} +! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr +! CHECK: fir.store %[[zero]] to %[[xa]] : !fir.ref> +! CHECK: %[[taddr:.*]] = fir.convert %[[t]] : (!fir.ref) -> !fir.ptr +! CHECK: fir.store %[[taddr]] to %[[xa]] : !fir.ref> +! CHECK: %[[x:.*]] = fir.load %[[xa]] : !fir.ref> +! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr) -> !fir.box +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box) -> !fir.ref +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_save_pointer_scalar() { +subroutine loc_save_pointer_scalar() + integer :: p + real, pointer, save :: x + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_save_pointer_scalarEx) : !fir.ref>> +! CHECK: %[[xref:.*]] = fir.load %[[x]] : !fir.ref>> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xref]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[xbox:.*]] = fir.embox %[[xaddr]] : (!fir.ptr) -> !fir.box +! CHECK: %[[xaddr2:.*]] = fir.box_addr %[[xbox]] : (!fir.box) -> !fir.ref +! CHECK: %[[xaddr2vall:.*]] = fir.convert %[[xaddr2]] : (!fir.ref) -> i64 +! CHECK: %[[xaddr2val:.*]] = fir.convert %[[xaddr2vall]] : (i64) -> i32 +! CHECK: fir.store %[[xaddr2val]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_derived_type() { +subroutine loc_derived_type + integer(8) :: p + type dt + integer :: i + end type + type(dt) :: xdt + p = loc(xdt) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFloc_derived_typeTdt{i:i32}> {{.*}} +! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[xdtaddr:.*]] = fir.box_addr %[[xdtbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xdtaddrval:.*]] = fir.convert %[[xdtaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xdtaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_pointer_array() { +subroutine loc_pointer_array + integer(8) :: p + integer, pointer :: x(:) + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[x:.*]] = fir.alloca !fir.box>> {{.*}} +! CHECK: %2 = fir.zero_bits !fir.ptr> +! CHECK: %[[zero:.*]] = arith.constant 0 : index +! CHECK: %[[xshp:.*]] = fir.shape %[[zero]] : (index) -> !fir.shape<1> +! CHECK: %[[xbox0:.*]] = fir.embox %2(%[[xshp]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.box>> +! CHECK: fir.store %[[xbox0]] to %[[x]] : !fir.ref>>> +! CHECK: %[[xbox:.*]] = fir.load %[[x]] : !fir.ref>>> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ptr>) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPloc_allocatable_array() { +subroutine loc_allocatable_array + integer(8) :: p + integer, allocatable :: x(:) + p = loc(x) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %1 = fir.alloca !fir.box>> {{.*}} +! CHECK: %[[stg:.*]] = fir.alloca !fir.heap> {{.*}} +! CHECK: %[[lb:.*]] = fir.alloca index {{.*}} +! CHECK: %[[ext:.*]] = fir.alloca index {{.*}} +! CHECK: %[[zstg:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.store %[[zstg]] to %[[stg]] : !fir.ref>> +! CHECK: %[[lbval:.*]] = fir.load %[[lb]] : !fir.ref +! CHECK: %[[extval:.*]] = fir.load %[[ext]] : !fir.ref +! CHECK: %[[stgaddr:.*]] = fir.load %[[stg]] : !fir.ref>> +! CHECK: %[[ss:.*]] = fir.shape_shift %[[lbval]], %[[extval]] : (index, index) -> !fir.shapeshift<1> +! CHECK: %[[xbox:.*]] = fir.embox %[[stgaddr]](%[[ss]]) : (!fir.heap>, !fir.shapeshift<1>) -> !fir.box> +! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPtest_external() { +subroutine test_external() + integer(8) :: p + integer, external :: f + p = loc(x=f) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[f:.*]] = fir.address_of(@_QPf) : () -> i32 +! CHECK: %[[fbox:.*]] = fir.emboxproc %[[f]] : (() -> i32) -> !fir.boxproc<() -> i32> +! CHECK: %[[faddr:.*]] = fir.box_addr %[[fbox]] : (!fir.boxproc<() -> i32>) -> (() -> i32) +! CHECK: %[[faddrval:.*]] = fir.convert %[[faddr]] : (() -> i32) -> i64 +! CHECK: fir.store %[[faddrval]] to %[[p]] : !fir.ref +end + +! CHECK-LABEL: func.func @_QPtest_proc() { +subroutine test_proc() + integer(8) :: p + procedure() :: g + p = loc(x=g) +! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[g:.*]] = fir.address_of(@_QPg) : () -> () +! CHECK: %[[gbox:.*]] = fir.emboxproc %[[g]] : (() -> ()) -> !fir.boxproc<() -> ()> +! CHECK: %[[gaddr:.*]] = fir.box_addr %[[gbox]] : (!fir.boxproc<() -> ()>) -> (() -> ()) +! CHECK: %[[gaddrval:.*]] = fir.convert %[[gaddr]] : (() -> ()) -> i64 +! CHECK: fir.store %[[gaddrval]] to %[[p]] : !fir.ref +end