void LoweringVisitor::visit(const Nodecl::ExpressionStatement& expr_stmt)
{
Nodecl::NodeclBase nest = expr_stmt.get_nest();
if (IS_FORTRAN_LANGUAGE
&& nest.is<Nodecl::FunctionCall>())
{
Nodecl::FunctionCall function_call = nest.as<Nodecl::FunctionCall>();
if (function_call.get_called().is<Nodecl::Symbol>())
{
TL::Symbol sym = function_call.get_called().as<Nodecl::Symbol>().get_symbol();
// We are only interested in two intrinsic symbols
if (sym.is_intrinsic())
{
if(sym.get_name() == "ompss_opencl_allocate")
{
// We replace the intrinsic call by a call to a new function which:
// - allocates a new temporary array with descriptor
// - copies the array descriptor to the address of the array
// - calls to the Nanos++ API to allocate the buffer in the shared memory
// - deallocates the temporary array with descriptor
//
// Example:
//
// ...
// INTEGER, ALLOCATABLE :: V(:)
// OMPSS_OPENCL_ALLOCATE(V(10))
// ...
//
// Is transformed into:
//
// SUBROUTINE NANOX_OPENCL_ALLOCATE_INTERNAL(ARR, LB1, UB1)
// INTEGER, ALLOCATABLE :: ARR(:)
// INTEGER :: LB1, UB1, ERR
// INTEGER, ALLOCATABLE :: TMP(:)
//
// ALLOCATE(TMP(LB1:UB1))
//
// ERR = NANOS_MEMCPY(
// MERCURIUM_GET_ADDRESS_OF(ARR),
// MERCURIUM_GET_ADDRESS_OF(TMP),
// 48)
//
// CALL NANOS_OPENCL_ALLOCATE_FORTRAN(
// SIZEOF(TMP),
// MERCURIUM_GET_ADDRESS_OF(ARR))
//
// DEALLOCATE(TMP)
// END SUBROUTINE NANOX_OPENCL_ALLOCATE_INTERNAL
//
// ...
// INTEGER, ALLOCATABLE :: V(:)
// CALL NANOX_OPENCL_ALLOCATE_INTERNAL(V, 1, 10)
// ...
//
// For more information: https://pm.bsc.es/projects/mcxx/ticket/1994
handle_ompss_opencl_allocate_intrinsic(
function_call,
_declared_ocl_allocate_functions,
expr_stmt);
}
else if (sym.get_name() == "ompss_opencl_deallocate")
{
// The transformation applied to this intrinsic is more
// simple than the other one, we only need to replace
// the call to the intrinsic by a call to the Nanos++
// API:
//
// ...
// INTEGER, ALLOCATABLE :: V(:)
// ...
// OMPSS_OPENCL_DEALLOCATE(V)
// ...
//
// Is transformed into:
//
// ...
// INTEGER, ALLOCATABLE :: V(:)
// ...
// CALL NANOS_OPENCL_ALLOCATE_FORTRAN(MERCURIUM_GET_ADDRESS_OF(V))
// ...
handle_ompss_opencl_deallocate_intrinsic(function_call, expr_stmt);
}
}
}
}
walk(expr_stmt.get_nest());
}
