shylie/llvm-project
1
0
Fork 0
Code Issues Pull Requests Actions 6 Packages Projects Releases Wiki Activity
llvm-project/flang/test/Lower/allocatables.f90
Valentin Clement fe252f8ed6
[flang] Lower boxed procedure 
In FIR, we want to wrap function pointers in a special box known as a
boxproc value. Fortran has a limited form of dynamic scoping
[https://tinyurl.com/2p8v2hw7] between "host procedures" and "internal
procedures". There are a number of implementations possible.

Boxproc typed values abstract away the implementation details of when a
function pointer can be passed directly (as a raw address) and when a
function pointer has to account for the presence of a dynamic scope.
When lowering Fortran syntax to FIR, all function pointers are emboxed
as boxproc values.

When creating LLVM IR, we must strip away the abstraction and produce
low-level LLVM "assembly" code. This patch implements that
transformation as converting the boxproc values to either raw function
pointers or executable trampolines on the stack as needed. The
trampoline then captures the dynamic scope context within an executable
thunk that can be passed instead of the function's raw address.

Some extra handling is required for Fortran functions that return a
character value to deal with LEN values here.

Some of the code in Bridge.cpp and ConvertExpr.cpp and be re-arranged to
faciliate the upstreaming effort.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: jeanPerier, PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D122223

Co-authored-by: mleair <leairmark@gmail.com>
Co-authored-by: Jean Perier <jperier@nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
Co-authored-by: V Donaldson <vdonaldson@nvidia.com>
Co-authored-by: Kiran Chandramohan <kiran.chandramohan@arm.com>
2022-03-22 15:41:11 +01:00

200 lines
9.8 KiB
Fortran
Raw Blame History

! RUN: bbc -emit-fir %s -o - | FileCheck %s
! Test lowering of allocatables using runtime for allocate/deallcoate statements.
! CHECK-LABEL: _QPfooscalar
subroutine fooscalar()
! Test lowering of local allocatable specification
real, allocatable :: x
! CHECK: %[[xAddrVar:.*]] = fir.alloca !fir.heap<f32> {{{.*}}uniq_name = "_QFfooscalarEx.addr"}
! CHECK: %[[nullAddr:.*]] = fir.zero_bits !fir.heap<f32>
! CHECK: fir.store %[[nullAddr]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! Test allocation of local allocatables
allocate(x)
! CHECK: %[[alloc:.*]] = fir.allocmem f32 {{{.*}}uniq_name = "_QFfooscalarEx.alloc"}
! CHECK: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! Test reading allocatable bounds and extents
print *, x
! CHECK: %[[xAddr1:.*]] = fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! CHECK: = fir.load %[[xAddr1]] : !fir.heap<f32>
! Test deallocation
deallocate(x)
! CHECK: %[[xAddr2:.*]] = fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
! CHECK: fir.freemem %[[xAddr2]]
! CHECK: %[[nullAddr1:.*]] = fir.zero_bits !fir.heap<f32>
! fir.store %[[nullAddr1]] to %[[xAddrVar]] : !fir.ref<!fir.heap<f32>>
end subroutine
! CHECK-LABEL: _QPfoodim1
subroutine foodim1()
! Test lowering of local allocatable specification
real, allocatable :: x(:)
! CHECK-DAG: %[[xAddrVar:.*]] = fir.alloca !fir.heap<!fir.array<?xf32>> {{{.*}}uniq_name = "_QFfoodim1Ex.addr"}
! CHECK-DAG: %[[xLbVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFfoodim1Ex.lb0"}
! CHECK-DAG: %[[xExtVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFfoodim1Ex.ext0"}
! CHECK: %[[nullAddr:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
! CHECK: fir.store %[[nullAddr]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! Test allocation of local allocatables
allocate(x(42:100))
! CHECK-DAG: %[[c42:.*]] = fir.convert %c42{{.*}} : (i32) -> index
! CHECK-DAG: %[[c100:.*]] = fir.convert %c100_i32 : (i32) -> index
! CHECK-DAG: %[[diff:.*]] = arith.subi %[[c100]], %[[c42]] : index
! CHECK: %[[extent:.*]] = arith.addi %[[diff]], %c1{{.*}} : index
! CHECK: %[[alloc:.*]] = fir.allocmem !fir.array<?xf32>, %[[extent]] {{{.*}}uniq_name = "_QFfoodim1Ex.alloc"}
! CHECK-DAG: fir.store %[[alloc]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! CHECK-DAG: fir.store %[[extent]] to %[[xExtVar]] : !fir.ref<index>
! CHECK-DAG: fir.store %[[c42]] to %[[xLbVar]] : !fir.ref<index>
! Test reading allocatable bounds and extents
print *, x(42)
! CHECK-DAG: fir.load %[[xLbVar]] : !fir.ref<index>
! CHECK-DAG: fir.load %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
deallocate(x)
! CHECK: %[[xAddr1:.*]] = fir.load %1 : !fir.ref<!fir.heap<!fir.array<?xf32>>>
! CHECK: fir.freemem %[[xAddr1]]
! CHECK: %[[nullAddr1:.*]] = fir.zero_bits !fir.heap<!fir.array<?xf32>>
! CHECK: fir.store %[[nullAddr1]] to %[[xAddrVar]] : !fir.ref<!fir.heap<!fir.array<?xf32>>>
end subroutine
! CHECK-LABEL: _QPfoodim2
subroutine foodim2()
! Test lowering of local allocatable specification
real, allocatable :: x(:, :)
! CHECK-DAG: fir.alloca !fir.heap<!fir.array<?x?xf32>> {{{.*}}uniq_name = "_QFfoodim2Ex.addr"}
! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.lb0"}
! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.ext0"}
! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.lb1"}
! CHECK-DAG: fir.alloca index {{{.*}}uniq_name = "_QFfoodim2Ex.ext1"}
end subroutine
! test lowering of character allocatables. Focus is placed on the length handling
! CHECK-LABEL: _QPchar_deferred(
subroutine char_deferred(n)
integer :: n
character(:), allocatable :: c
! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_deferredEc.addr"}
! CHECK-DAG: %[[cLenVar:.*]] = fir.alloca index {{{.*}}uniq_name = "_QFchar_deferredEc.len"}
allocate(character(10):: c)
! CHECK: %[[c10:.]] = fir.convert %c10_i32 : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[c10]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
! CHECK: fir.store %[[c10]] to %[[cLenVar]] : !fir.ref<index>
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(n):: c)
! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref<i32>
! CHECK: %[[ni:.*]] = fir.convert %[[n]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[ni]] : index) {{{.*}}uniq_name = "_QFchar_deferredEc.alloc"}
! CHECK: fir.store %[[ni]] to %[[cLenVar]] : !fir.ref<index>
call bar(c)
! CHECK-DAG: %[[cLen:.*]] = fir.load %[[cLenVar]] : !fir.ref<index>
! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
! CHECK-DAG: %[[cAddrcast:.*]] = fir.convert %[[cAddr]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
! CHECK: fir.emboxchar %[[cAddrcast]], %[[cLen]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
end subroutine
! CHECK-LABEL: _QPchar_explicit_cst(
subroutine char_explicit_cst(n)
integer :: n
character(10), allocatable :: c
! CHECK-DAG: %[[cLen:.*]] = arith.constant 10 : index
! CHECK-DAG: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,10>> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.addr"}
! CHECK-NOT: "_QFchar_explicit_cstEc.len"
allocate(c)
! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(n):: c)
! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(10):: c)
! CHECK: fir.allocmem !fir.char<1,10> {{{.*}}uniq_name = "_QFchar_explicit_cstEc.alloc"}
call bar(c)
! CHECK: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,10>>>
! CHECK: %[[cAddrcast:.*]] = fir.convert %[[cAddr]] : (!fir.heap<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
! CHECK: fir.emboxchar %[[cAddrcast]], %[[cLen]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
end subroutine
! CHECK-LABEL: _QPchar_explicit_dyn(
subroutine char_explicit_dyn(l1, l2)
integer :: l1, l2
character(l1), allocatable :: c
! CHECK: %[[l1:.*]] = fir.load %arg0 : !fir.ref<i32>
! CHECK: %[[c0_i32:.*]] = arith.constant 0 : i32
! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[l1]], %[[c0_i32]] : i32
! CHECK: %[[cLen:.*]] = arith.select %[[cmp]], %[[l1]], %[[c0_i32]] : i32
! CHECK: %[[cAddrVar:.*]] = fir.alloca !fir.heap<!fir.char<1,?>> {{{.*}}uniq_name = "_QFchar_explicit_dynEc.addr"}
! CHECK-NOT: "_QFchar_explicit_dynEc.len"
allocate(c)
! CHECK: %[[cLenCast1:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast1]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(l2):: c)
! CHECK: %[[cLenCast2:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast2]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
deallocate(c)
! CHECK: fir.freemem %{{.*}}
allocate(character(10):: c)
! CHECK: %[[cLenCast3:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK: fir.allocmem !fir.char<1,?>(%[[cLenCast3]] : index) {{{.*}}uniq_name = "_QFchar_explicit_dynEc.alloc"}
call bar(c)
! CHECK-DAG: %[[cLenCast4:.*]] = fir.convert %[[cLen]] : (i32) -> index
! CHECK-DAG: %[[cAddr:.*]] = fir.load %[[cAddrVar]] : !fir.ref<!fir.heap<!fir.char<1,?>>>
! CHECK-DAG: %[[cAddrcast:.*]] = fir.convert %[[cAddr]] : (!fir.heap<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
! CHECK: fir.emboxchar %[[cAddrcast]], %[[cLenCast4]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
end subroutine
! CHECK-LABEL: _QPspecifiers(
subroutine specifiers
allocatable jj1(:), jj2(:,:), jj3(:)
! CHECK: [[STAT:%[0-9]+]] = fir.alloca i32 {{{.*}}uniq_name = "_QFspecifiersEsss"}
integer sss
character*30 :: mmm = "None"
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK-NOT: fir.if %{{[0-9]+}} {
! CHECK-COUNT-2: }
! CHECK-NOT: }
allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm)
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
! CHECK: fir.call @_FortranAAllocatableSetBounds
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableAllocate
allocate(jj1(3), jj2(3,3), jj3(3), stat=sss, errmsg=mmm)
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK: fir.if %{{[0-9]+}} {
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: fir.store [[RESULT]] to [[STAT]]
! CHECK-NOT: fir.if %{{[0-9]+}} {
! CHECK-COUNT-2: }
! CHECK-NOT: }
deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm)
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
! CHECK: [[RESULT:%[0-9]+]] = fir.call @_FortranAAllocatableDeallocate
deallocate(jj1, jj2, jj3, stat=sss, errmsg=mmm)
end subroutine specifiers
Reference in New Issue View Git Blame Copy Permalink