[flang] lower F77 calls in HLFIR

[jeanPerier]

Summary

Use recently added hlfir.associate/hlfir.end_associate to deal
with the cases where the actual argument is an expression.

[PeteSteinfeld]

Aside from nits and questions, all builds and tests correctly and looks good.

flang/include/flang/Optimizer/Builder/HLFIRTools.h

185

There's an extra space character after Return.

flang/lib/Lower/Bridge.cpp

1112–1116

I don't understand this code. This else corresponds to the if that tests to see if we're generating HLFIR. But since the code is calling createSubroutineCall, I'm concerned that we're not handling the case for a function call. Does createSubroutineCall handle both functions and subroutines?

flang/lib/Lower/ConvertCall.cpp

406–415

I wonder if this is the right test. We need to handle the case where we have an elemental function call that doesn't have any array arguments but which returns an array.

417–425

I'm curious. What's different about lowering of statement functions?

flang/lib/Optimizer/Builder/HLFIRTools.cpp

173

There's an extra space character after numerical.

177

"mismatch" should be "mismatches".

[jeanPerier]

Fix typos and extra spaces in comments caught by Pete.

[jeanPerier]

Thanks for the review @PeteSteinfeld

flang/include/flang/Optimizer/Builder/HLFIRTools.h

185

Thanks !

flang/lib/Lower/Bridge.cpp

1112–1116

There cannot be function calls here, this code (in genFIR(const Fortran::parser::CallStmt &stmt)) deals with fortran call statement lowering. Only subroutines can be called in a call statement.

Function calls lowering happen when lowering an Expr<T> that is a FunctionRef<T>.

The else case basically keeps the current lowering code during the transition.

flang/lib/Lower/ConvertCall.cpp

406–415

We need to handle the case where we have an elemental function call that doesn't have any array arguments but which returns an array.

My understanding is that this is not possible ("C15101: The result of an elemental function shall be scalar" and "15.8.2 point 1: If there are no actual arguments or the actual arguments are all scalar, the result is scalar."), do you have a specific use case in mind ?

Note that a elemental function references can be assigned to an array, but in that case (when all arguments are scalars) the function returns a scalar that is assigned to all the left hand side elements. So there is no elemental aspect to deal with in such calls, the elemental aspects happen in the assignment.

417–425

They are (and still will) be handled very differently: the statement function expression is inlined directly in lowering: we do not generate a function body and symbol for them. That is because it would be more hassle to outline statement functions than it is to inline them on the spot: statement functions do not have a body in the parse tree that would allow using the bridge code to generate a FIR function for them, it would need ad-hoc handling, whereas we already know how to lower an expression given what the referred symbols mapped to.
It is also probably better from a performance point and view. The last point is that it is possible because statement functions cannot directly or indirectly be recursive (otherwise, we would have an infinite loop in lowering).

flang/include/flang/Lower/ConvertCall.h

 ///
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_CONVERTCALL_H
 #define FORTRAN_LOWER_CONVERTCALL_H
 
 #include "flang/Lower/AbstractConverter.h"
 #include "flang/Lower/CallInterface.h"
+#include "flang/Optimizer/Builder/HLFIRTools.h"
 
 namespace Fortran::lower {
 
 /// Given a call site for which the arguments were already lowered, generate
 /// the call and return the result. This function deals with explicit result
 /// allocation and lowering if needed. It also deals with passing the host
 /// link to internal procedures.
 fir::ExtendedValue genCallOpAndResult(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
     Fortran::lower::CallerInterface &caller, mlir::FunctionType callSiteType,
     llvm::Optional<mlir::Type> resultType);
 
 /// If \p arg is the address of a function with a denoted host-association tuple
 /// argument, then return the host-associations tuple value of the current
 /// procedure. Otherwise, return nullptr.
 mlir::Value argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
                                mlir::Value arg);
 
+/// Lower a ProcedureRef to HLFIR. If this is a function call, return the
+/// lowered result value. Return nothing otherwise.
+llvm::Optional<hlfir::EntityWithAttributes> convertCallToHLFIR(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const evaluate::ProcedureRef &procRef,
+    llvm::Optional<mlir::Type> resultType, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx);
+
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERTCALL_H

flang/include/flang/Optimizer/Builder/HLFIRTools.h

 #include "flang/Optimizer/HLFIR/HLFIRDialect.h"
 
 namespace fir {
 class FirOpBuilder;
 }
 
 namespace hlfir {
 
+class AssociateOp;
+
 /// Is this an SSA value type for the value of a Fortran expression?
 inline bool isFortranValueType(mlir::Type type) {
   return type.isa<hlfir::ExprType>() || fir::isa_trivial(type);
 }
 
 /// Is this the value of a Fortran expression in an SSA value form?
 inline bool isFortranValue(mlir::Value value) {
   return isFortranValueType(value.getType());
translateToExtendedValue(mlir::Location loc, fir::FirOpBuilder &builder,
                          fir::FortranVariableOpInterface fortranVariable);
 
 /// Generate declaration for a fir::ExtendedValue in memory.
 EntityWithAttributes genDeclare(mlir::Location loc, fir::FirOpBuilder &builder,
                                 const fir::ExtendedValue &exv,
                                 llvm::StringRef name,
                                 fir::FortranVariableFlagsAttr flags);
 
+/// Generate an hlfir.associate to build a variable from an expression value.
+/// The type of the variable must be provided so that scalar logicals are
+/// properly typed when placed in memory.
+hlfir::AssociateOp genAssociateExpr(mlir::Location loc,
+                                    fir::FirOpBuilder &builder,
+                                    hlfir::Entity value,
+                                    mlir::Type variableType,
+                                    llvm::StringRef name);
+
+/// Get the raw address of a variable (simple fir.ref/fir.ptr, or fir.heap
+/// value). The returned value should be used with care, it does not contain any
+/// stride, shape, and type parameter information. For pointers and
+/// allocatables, this returns the address of the target.
+mlir::Value genVariableRawAddress(mlir::Location loc,
+                                  fir::FirOpBuilder &builder,
+                                  hlfir::Entity var);
+
+/// Get a fir.boxchar for character scalar or array variable (the shape is lost
+/// for arrays).
+mlir::Value genVariableBoxChar(mlir::Location loc, fir::FirOpBuilder &builder,
+                               hlfir::Entity var);
+
 /// If the entity is a variable, load its value (dereference pointers and
 /// allocatables if needed). Do nothing if the entity os already a variable or
 /// if it is not a scalar entity of numerical or logical type.
 Entity loadTrivialScalar(mlir::Location loc, fir::FirOpBuilder &builder,
                          Entity entity);
 
+/// If \p entity is a POINTER or ALLOCATABLE, dereference it and return the
+/// target entity. Return \p entity otherwise.
+hlfir::Entity derefPointersAndAllocatables(mlir::Location loc,
+                                           fir::FirOpBuilder &builder,
+                                           Entity entity);
+
 /// Compute the lower and upper bounds of an entity.
 llvm::SmallVector<std::pair<mlir::Value, mlir::Value>>
 genBounds(mlir::Location loc, fir::FirOpBuilder &builder, Entity entity);
 
 /// Read length parameters into result if this entity has any.
 void genLengthParameters(mlir::Location loc, fir::FirOpBuilder &builder,
                          Entity entity,
                          llvm::SmallVectorImpl<mlir::Value> &result);

flang/lib/Lower/Bridge.cpp

 //===-- Bridge.cpp -- bridge to lower to MLIR -----------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Bridge.h"
 #include "flang/Lower/Allocatable.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/Coarray.h"
+#include "flang/Lower/ConvertCall.h"
 #include "flang/Lower/ConvertExpr.h"
 #include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/HostAssociations.h"
 #include "flang/Lower/IO.h"
 #include "flang/Lower/IterationSpace.h"
 #include "flang/Lower/Mangler.h"
private:
   }
 
   /// Lowering of CALL statement
   void genFIR(const Fortran::parser::CallStmt &stmt) {
     Fortran::lower::StatementContext stmtCtx;
     Fortran::lower::pft::Evaluation &eval = getEval();
     setCurrentPosition(stmt.v.source);
     assert(stmt.typedCall && "Call was not analyzed");
+    mlir::Value res{};
+    if (bridge.getLoweringOptions().getLowerToHighLevelFIR()) {
+      llvm::Optional<mlir::Type> resultType = llvm::None;
+      if (stmt.typedCall->hasAlternateReturns())
+        resultType = builder->getIndexType();
+      auto hlfirRes = Fortran::lower::convertCallToHLFIR(
+          toLocation(), *this, *stmt.typedCall, resultType, localSymbols,
+          stmtCtx);
+      if (hlfirRes)
+        res = *hlfirRes;
+    } else {
       // Call statement lowering shares code with function call lowering.
-    mlir::Value res = Fortran::lower::createSubroutineCall(
+      res = Fortran::lower::createSubroutineCall(
           *this, *stmt.typedCall, explicitIterSpace, implicitIterSpace,
           localSymbols, stmtCtx, /*isUserDefAssignment=*/false);
+    }
     if (!res)
       return; // "Normal" subroutine call.
     // Call with alternate return specifiers.
     // The call returns an index that selects an alternate return branch target.
     llvm::SmallVector<int64_t> indexList;
     llvm::SmallVector<mlir::Block *> blockList;
     int64_t index = 0;
     for (const Fortran::parser::ActualArgSpec &arg :

flang/lib/Lower/ConvertCall.cpp

 //===-- ConvertCall.cpp ---------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertCall.h"
+#include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Lower/ConvertVariable.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/LowLevelIntrinsics.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
+#include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-expr"
 
 /// Helper to package a Value and its properties into an ExtendedValue.
 static fir::ExtendedValue toExtendedValue(mlir::Location loc, mlir::Value base,
                                           llvm::ArrayRef<mlir::Value> extents,
                                           llvm::ArrayRef<mlir::Value> lengths) {
fir::CharacterType charTy =
         funcType.getResults()[0].dyn_cast<fir::CharacterType>();
     mlir::Value len = builder.createIntegerConstant(
         loc, builder.getCharacterLengthType(), charTy.getLen());
     return fir::CharBoxValue{callResult, len};
   }
 
   return callResult;
 }
+
+/// Is this a call to an elemental procedure with at least one array argument?
+static bool
+isElementalProcWithArrayArgs(const Fortran::evaluate::ProcedureRef &procRef) {
+  if (procRef.IsElemental())
+    for (const std::optional<Fortran::evaluate::ActualArgument> &arg :
+         procRef.arguments())
+      if (arg && arg->Rank() != 0)
+        return true;
+  return false;
+}
+
+/// helper to detect statement functions
+static bool
+isStatementFunctionCall(const Fortran::evaluate::ProcedureRef &procRef) {
+  if (const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol())
+    if (const auto *details =
+            symbol->detailsIf<Fortran::semantics::SubprogramDetails>())
+      return details->stmtFunction().has_value();
+  return false;
+}
+
+namespace {
+class CallBuilder {
+public:
+  CallBuilder(mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+              Fortran::lower::SymMap &symMap,
+              Fortran::lower::StatementContext &stmtCtx)
+      : converter{converter}, symMap{symMap}, stmtCtx{stmtCtx}, loc{loc} {}
+
+  llvm::Optional<hlfir::EntityWithAttributes>
+  gen(const Fortran::evaluate::ProcedureRef &procRef,
+      llvm::Optional<mlir::Type> resultType) {
+    mlir::Location loc = getLoc();
+    fir::FirOpBuilder &builder = getBuilder();
+    if (isElementalProcWithArrayArgs(procRef))
+      TODO(loc, "lowering elemental call to HLFIR");
+    if (procRef.proc().GetSpecificIntrinsic())
+      TODO(loc, "lowering ProcRef to HLFIR");
+    if (isStatementFunctionCall(procRef))
+      TODO(loc, "lowering Statement function call to HLFIR");
+
+    Fortran::lower::CallerInterface caller(procRef, converter);
+    using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
+    mlir::FunctionType callSiteType = caller.genFunctionType();
+
+    llvm::SmallVector<llvm::Optional<hlfir::EntityWithAttributes>>
+        loweredActuals;
+    // Lower the actual arguments
+    for (const Fortran::lower::CallInterface<
+             Fortran::lower::CallerInterface>::PassedEntity &arg :
+         caller.getPassedArguments())
+      if (const auto *actual = arg.entity) {
+        const auto *expr = actual->UnwrapExpr();
+        if (!expr)
+          TODO(loc, "assumed type actual argument");
+        loweredActuals.emplace_back(Fortran::lower::convertExprToHLFIR(
+            loc, getConverter(), *expr, getSymMap(), getStmtCtx()));
+      } else {
+        // Optional dummy argument for which there is no actual argument.
+        loweredActuals.emplace_back(llvm::None);
+      }
+
+    llvm::SmallVector<hlfir::AssociateOp> exprAssociations;
+    for (auto [actual, arg] :
+         llvm::zip(loweredActuals, caller.getPassedArguments())) {
+      mlir::Type argTy = callSiteType.getInput(arg.firArgument);
+      if (!actual) {
+        // Optional dummy argument for which there is no actual argument.
+        caller.placeInput(arg, builder.create<fir::AbsentOp>(loc, argTy));
+        continue;
+      }
+
+      const auto *expr = arg.entity->UnwrapExpr();
+      if (!expr)
+        TODO(loc, "assumed type actual argument");
+
+      const bool actualMayBeDynamicallyAbsent =
+          arg.isOptional() && Fortran::evaluate::MayBePassedAsAbsentOptional(
+                                  *expr, getConverter().getFoldingContext());
+      if (actualMayBeDynamicallyAbsent)
+        TODO(loc, "passing optional arguments in HLFIR");
+
+      const bool isSimplyContiguous =
+          actual->isScalar() || Fortran::evaluate::IsSimplyContiguous(
+                                    *expr, getConverter().getFoldingContext());
+
+      switch (arg.passBy) {
+      case PassBy::Value: {
+        // True pass-by-value semantics.
+        auto value = hlfir::loadTrivialScalar(loc, builder, *actual);
+        if (!value.isValue())
+          TODO(loc, "Passing CPTR an CFUNCTPTR VALUE in HLFIR");
+        caller.placeInput(arg, builder.createConvert(loc, argTy, value));
+      } break;
+      case PassBy::BaseAddressValueAttribute: {
+        // VALUE attribute or pass-by-reference to a copy semantics. (byval*)
+        TODO(loc, "HLFIR PassBy::BaseAddressValueAttribute");
+      } break;
+      case PassBy::BaseAddress:
+      case PassBy::BoxChar: {
+        hlfir::Entity entity = *actual;
+        if (entity.isVariable()) {
+          entity = hlfir::derefPointersAndAllocatables(loc, builder, entity);
+          // Copy-in non contiguous variable
+          if (!isSimplyContiguous)
+            TODO(loc, "HLFIR copy-in/copy-out");
+        } else {
+          hlfir::AssociateOp associate = hlfir::genAssociateExpr(
+              loc, builder, entity, argTy, "adapt.valuebyref");
+          exprAssociations.push_back(associate);
+          entity = hlfir::Entity{associate.getBase()};
+        }
+        mlir::Value addr =
+            arg.passBy == PassBy::BaseAddress
+                ? hlfir::genVariableRawAddress(loc, builder, entity)
+                : hlfir::genVariableBoxChar(loc, builder, entity);
+        caller.placeInput(arg, builder.createConvert(loc, argTy, addr));
+      } break;
+      case PassBy::CharBoxValueAttribute: {
+        TODO(loc, "HLFIR PassBy::CharBoxValueAttribute");
+      } break;
+      case PassBy::AddressAndLength:
+        // PassBy::AddressAndLength is only used for character results. Results
+        // are not handled here.
+        fir::emitFatalError(
+            loc, "unexpected PassBy::AddressAndLength for actual arguments");
+        break;
+      case PassBy::CharProcTuple: {
+        TODO(loc, "HLFIR PassBy::CharProcTuple");
+      } break;
+      case PassBy::Box: {
+        TODO(loc, "HLFIR PassBy::Box");
+      } break;
+      case PassBy::MutableBox: {
+        TODO(loc, "HLFIR PassBy::MutableBox");
+      } break;
+      }
+    }
+    // Prepare lowered arguments according to the interface
+    // and map the lowered values to the dummy
+    // arguments.
+    fir::ExtendedValue result = Fortran::lower::genCallOpAndResult(
+        loc, getConverter(), getSymMap(), getStmtCtx(), caller, callSiteType,
+        resultType);
+    mlir::Value resultFirBase = fir::getBase(result);
+
+    /// Clean-up associations and copy-in.
+    for (auto associate : exprAssociations)
+      builder.create<hlfir::EndAssociateOp>(loc, associate);
+    if (!resultFirBase)
+      return llvm::None; // subroutine call.
+    if (fir::isa_trivial(resultFirBase.getType()))
+      return hlfir::EntityWithAttributes{resultFirBase};
+    return hlfir::genDeclare(loc, builder, result, "tmp.funcresult",
+                             fir::FortranVariableFlagsAttr{});
+    // TODO: "move" non pointer results into hlfir.expr.
+  }
+
+private:
+  mlir::Location getLoc() const { return loc; }
+  Fortran::lower::AbstractConverter &getConverter() { return converter; }
+  fir::FirOpBuilder &getBuilder() { return converter.getFirOpBuilder(); }
+  Fortran::lower::SymMap &getSymMap() { return symMap; }
+  Fortran::lower::StatementContext &getStmtCtx() { return stmtCtx; }
+
+  Fortran::lower::AbstractConverter &converter;
+  Fortran::lower::SymMap &symMap;
+  Fortran::lower::StatementContext &stmtCtx;
+  mlir::Location loc;
+};
+} // namespace
+
+llvm::Optional<hlfir::EntityWithAttributes> Fortran::lower::convertCallToHLFIR(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const evaluate::ProcedureRef &procRef,
+    llvm::Optional<mlir::Type> resultType, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx) {
+  return CallBuilder(loc, converter, symMap, stmtCtx).gen(procRef, resultType);
+}

flang/lib/Lower/ConvertExprToHLFIR.cpp

 //===-- ConvertExprToHLFIR.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertExprToHLFIR.h"
 #include "flang/Evaluate/shape.h"
 #include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/CallInterface.h"
+#include "flang/Lower/ConvertCall.h"
 #include "flang/Lower/ConvertConstant.h"
+#include "flang/Lower/ConvertType.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 
 namespace {
 
 /// Lower Designators to HLFIR.
gen(const Fortran::evaluate::Designator<T> &designator) {
     return HlfirDesignatorBuilder(getLoc(), getConverter(), getSymMap(),
                                   getStmtCtx())
         .gen(designator.u);
   }
 
   template <typename T>
   hlfir::EntityWithAttributes
   gen(const Fortran::evaluate::FunctionRef<T> &expr) {
-    TODO(getLoc(), "lowering funcRef to HLFIR");
+    mlir::Type resType =
+        Fortran::lower::TypeBuilder<T>::genType(getConverter(), expr);
+    return Fortran::lower::convertCallToHLFIR(getLoc(), getConverter(), expr,
+                                              resType, getSymMap(),
+                                              getStmtCtx())
+        .value();
   }
 
   template <typename T>
   hlfir::EntityWithAttributes gen(const Fortran::evaluate::Constant<T> &expr) {
     mlir::Location loc = getLoc();
     if constexpr (std::is_same_v<T, Fortran::evaluate::SomeDerived>) {
       TODO(loc, "lowering derived type constant to HLFIR");
     } else {

flang/lib/Optimizer/Builder/HLFIRTools.cpp

exv.match(
                          box.nonDeferredLenParams().end());
       },
       [](const auto &) {});
   auto declareOp = builder.create<hlfir::DeclareOp>(
       loc, base, name, shapeOrShift, lenParams, flags);
   return mlir::cast<fir::FortranVariableOpInterface>(declareOp.getOperation());
 }
 
-/// If the entity is a variable, load its value (dereference pointers and
-/// allocatables if needed). Do nothing if the entity os already a variable or
-/// if it is not a scalar entity of numerical or logical type.
+hlfir::AssociateOp hlfir::genAssociateExpr(mlir::Location loc,
+                                           fir::FirOpBuilder &builder,
+                                           hlfir::Entity value,
+                                           mlir::Type variableType,
+                                           llvm::StringRef name) {
+  assert(value.isValue() && "must not be a variable");
+  mlir::Value shape{};
+  if (value.isArray())
+    TODO(loc, "associating array expressions");
+
+  mlir::Value source = value;
+  // Lowered scalar expression values for numerical and logical may have a
+  // different type than what is required for the type in memory (logical
+  // expressions are typically manipulated as i1, but needs to be stored
+  // according to the fir.logical<kind> so that the storage size is correct).
+  // Character length mismatches are ignored (it is ok for one to be dynamic
+  // and the other static).
+  mlir::Type varEleTy = getFortranElementType(variableType);
+  mlir::Type valueEleTy = getFortranElementType(value.getType());
+  if (varEleTy != valueEleTy && !(valueEleTy.isa<fir::CharacterType>() &&
+                                  varEleTy.isa<fir::CharacterType>())) {
+    assert(value.isScalar() && fir::isa_trivial(value.getType()));
+    source = builder.createConvert(loc, fir::unwrapPassByRefType(variableType),
+                                   value);
+  }
+  llvm::SmallVector<mlir::Value> lenParams;
+  genLengthParameters(loc, builder, value, lenParams);
+  return builder.create<hlfir::AssociateOp>(loc, source, name, shape, lenParams,
+                                            fir::FortranVariableFlagsAttr{});
+}
+
+mlir::Value hlfir::genVariableRawAddress(mlir::Location loc,
+                                         fir::FirOpBuilder &builder,
+                                         hlfir::Entity var) {
+  assert(var.isVariable() && "only address of variables can be taken");
+  mlir::Value baseAddr = var.getFirBase();
+  if (var.isMutableBox())
+    baseAddr = builder.create<fir::LoadOp>(loc, baseAddr);
+  // Get raw address.
+  if (baseAddr.getType().isa<fir::BaseBoxType>()) {
+    auto addrType =
+        fir::ReferenceType::get(fir::unwrapPassByRefType(baseAddr.getType()));
+    baseAddr = builder.create<fir::BoxAddrOp>(loc, addrType, baseAddr);
+  }
+  return baseAddr;
+}
+
+mlir::Value hlfir::genVariableBoxChar(mlir::Location loc,
+                                      fir::FirOpBuilder &builder,
+                                      hlfir::Entity var) {
+  assert(var.isVariable() && "only address of variables can be taken");
+  if (var.getType().isa<fir::BoxCharType>())
+    return var;
+  mlir::Value addr = genVariableRawAddress(loc, builder, var);
+  llvm::SmallVector<mlir::Value> lengths;
+  genLengthParameters(loc, builder, var, lengths);
+  assert(lengths.size() == 1);
+  auto charType = var.getFortranElementType().cast<fir::CharacterType>();
+  auto boxCharType =
+      fir::BoxCharType::get(builder.getContext(), charType.getFKind());
+  auto scalarAddr =
+      builder.createConvert(loc, fir::ReferenceType::get(charType), addr);
+  return builder.create<fir::EmboxCharOp>(loc, boxCharType, scalarAddr,
+                                          lengths[0]);
+}
+
 hlfir::Entity hlfir::loadTrivialScalar(mlir::Location loc,
                                        fir::FirOpBuilder &builder,
                                        Entity entity) {
   if (entity.isVariable() && entity.isScalar() &&
       fir::isa_trivial(entity.getFortranElementType())) {
-    if (entity.isMutableBox())
-      TODO(loc, "load pointer/allocatable scalar");
+    entity = derefPointersAndAllocatables(loc, builder, entity);
     return Entity{builder.create<fir::LoadOp>(loc, entity)};
   }
   return entity;
 }
 
 static mlir::Value genUBound(mlir::Location loc, fir::FirOpBuilder &builder,
                              mlir::Value lb, mlir::Value extent,
                              mlir::Value one) {
if (entity.hasLengthParameters()) {
     typeParams.append(params.begin(), params.end());
   }
   if (entity.isScalar())
     return {fir::getBase(exv), mlir::Value{}};
   if (auto variableInterface = entity.getIfVariableInterface())
     return {fir::getBase(exv), variableInterface.getShape()};
   return {fir::getBase(exv), builder.createShape(loc, exv)};
 }
+
+hlfir::Entity hlfir::derefPointersAndAllocatables(mlir::Location loc,
+                                                  fir::FirOpBuilder &builder,
+                                                  Entity entity) {
+  if (entity.isMutableBox())
+    return hlfir::Entity{builder.create<fir::LoadOp>(loc, entity).getResult()};
+  return entity;
+}

flang/test/Lower/HLFIR/calls-f77.f90

+! Test lowering of F77 calls to HLFIR
+! RUN: bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
+
+! -----------------------------------------------------------------------------
+!     Test lowering of F77 procedure reference arguments
+! -----------------------------------------------------------------------------
+
+subroutine call_no_arg()
+  call void()
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_no_arg() {
+! CHECK-NEXT:  fir.call @_QPvoid() fastmath<contract> : () -> ()
+! CHECK-NEXT:  return
+
+subroutine call_int_arg_var(n)
+  integer :: n
+  call take_i4(n)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_int_arg_var(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<i32>
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFcall_int_arg_varEn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:  fir.call @_QPtake_i4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<i32>) -> ()
+
+subroutine call_int_arg_expr()
+  call take_i4(42)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_int_arg_expr() {
+! CHECK:  %[[VAL_0:.*]] = arith.constant 42 : i32
+! CHECK:  %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {uniq_name = "adapt.valuebyref"} : (i32) -> (!fir.ref<i32>, !fir.ref<i32>, i1)
+! CHECK:  fir.call @_QPtake_i4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<i32>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<i32>, i1
+
+subroutine call_real_arg_expr()
+  call take_r4(0.42)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_real_arg_expr() {
+! CHECK:  %[[VAL_0:.*]] = arith.constant 4.200000e-01 : f32
+! CHECK:  %[[VAL_1:.*]]:3 = hlfir.associate %[[VAL_0]] {uniq_name = "adapt.valuebyref"} : (f32) -> (!fir.ref<f32>, !fir.ref<f32>, i1)
+! CHECK:  fir.call @_QPtake_r4(%[[VAL_1]]#0) fastmath<contract> : (!fir.ref<f32>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_1]]#1, %[[VAL_1]]#2 : !fir.ref<f32>, i1
+
+subroutine call_real_arg_var(x)
+  real :: x
+  call take_r4(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_real_arg_var(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<f32>
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFcall_real_arg_varEx"} : (!fir.ref<f32>) -> (!fir.ref<f32>, !fir.ref<f32>)
+! CHECK:  fir.call @_QPtake_r4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<f32>) -> ()
+
+subroutine call_logical_arg_var(x)
+  logical :: x
+  call take_l4(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_logical_arg_var(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.logical<4>>
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFcall_logical_arg_varEx"} : (!fir.ref<!fir.logical<4>>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>)
+! CHECK:  fir.call @_QPtake_l4(%[[VAL_1]]#1) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()
+
+subroutine call_logical_arg_expr()
+  call take_l4(.true.)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_logical_arg_expr() {
+! CHECK:  %[[VAL_0:.*]] = arith.constant true
+! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<4>
+! CHECK:  %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<4>) -> (!fir.ref<!fir.logical<4>>, !fir.ref<!fir.logical<4>>, i1)
+! CHECK:  fir.call @_QPtake_l4(%[[VAL_2]]#0) fastmath<contract> : (!fir.ref<!fir.logical<4>>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<4>>, i1
+
+subroutine call_logical_arg_expr_2()
+  call take_l8(.true._8)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_logical_arg_expr_2() {
+! CHECK:  %[[VAL_0:.*]] = arith.constant true
+! CHECK:  %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (i1) -> !fir.logical<8>
+! CHECK:  %[[VAL_2:.*]]:3 = hlfir.associate %[[VAL_1]] {uniq_name = "adapt.valuebyref"} : (!fir.logical<8>) -> (!fir.ref<!fir.logical<8>>, !fir.ref<!fir.logical<8>>, i1)
+! CHECK:  fir.call @_QPtake_l8(%[[VAL_2]]#0) fastmath<contract> : (!fir.ref<!fir.logical<8>>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_2]]#1, %[[VAL_2]]#2 : !fir.ref<!fir.logical<8>>, i1
+
+subroutine call_char_arg_var(x)
+  character(*) :: x
+  call take_c(x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_char_arg_var(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>
+! CHECK:  %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "_QFcall_char_arg_varEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK:  fir.call @_QPtake_c(%[[VAL_2]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()
+
+subroutine call_char_arg_var_expr(x)
+  character(*) :: x
+  call take_c(x//x)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_char_arg_var_expr(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.boxchar<1>
+! CHECK:  %[[VAL_1:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK:  %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 {uniq_name = "_QFcall_char_arg_var_exprEx"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+! CHECK:  %[[VAL_3:.*]] = arith.addi %[[VAL_1]]#1, %[[VAL_1]]#1 : index
+! CHECK:  %[[VAL_4:.*]] = hlfir.concat %[[VAL_2]]#0, %[[VAL_2]]#0 len %[[VAL_3]] : (!fir.boxchar<1>, !fir.boxchar<1>, index) -> !hlfir.expr<!fir.char<1,?>>
+! CHECK:  %[[VAL_5:.*]]:3 = hlfir.associate %[[VAL_4]] typeparams %[[VAL_3]] {uniq_name = "adapt.valuebyref"} : (!hlfir.expr<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>, i1)
+! CHECK:  fir.call @_QPtake_c(%[[VAL_5]]#0) fastmath<contract> : (!fir.boxchar<1>) -> ()
+! CHECK:  hlfir.end_associate %[[VAL_5]]#1, %[[VAL_5]]#2 : !fir.ref<!fir.char<1,?>>, i1
+
+subroutine call_arg_array_var(n)
+  integer :: n(10, 20)
+  call take_arr(n)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_arg_array_var(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.ref<!fir.array<10x20xi32>>
+! CHECK:  %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK:  %[[VAL_2:.*]] = arith.constant 20 : index
+! CHECK:  %[[VAL_3:.*]] = fir.shape %[[VAL_1]], %[[VAL_2]] : (index, index) -> !fir.shape<2>
+! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_0]](%[[VAL_3]]) {uniq_name = "_QFcall_arg_array_varEn"} : (!fir.ref<!fir.array<10x20xi32>>, !fir.shape<2>) -> (!fir.ref<!fir.array<10x20xi32>>, !fir.ref<!fir.array<10x20xi32>>)
+! CHECK:  fir.call @_QPtake_arr(%[[VAL_4]]#1) fastmath<contract> : (!fir.ref<!fir.array<10x20xi32>>) -> ()
+
+subroutine call_arg_array_2(n)
+  integer, contiguous, optional :: n(:, :)
+  call take_arr_2(n)
+end subroutine
+! CHECK-LABEL: func.func @_QPcall_arg_array_2(
+! CHECK-SAME:    %[[VAL_0:.*]]: !fir.box<!fir.array<?x?xi32>>
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<contiguous, optional>, uniq_name = "_QFcall_arg_array_2En"} : (!fir.box<!fir.array<?x?xi32>>) -> (!fir.box<!fir.array<?x?xi32>>, !fir.box<!fir.array<?x?xi32>>)
+! CHECK:  %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#1 : (!fir.box<!fir.array<?x?xi32>>) -> !fir.ref<!fir.array<?x?xi32>>
+! CHECK:  fir.call @_QPtake_arr_2(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xi32>>) -> ()
+
+! -----------------------------------------------------------------------------
+!     Test lowering of function results
+! -----------------------------------------------------------------------------
+
+subroutine return_integer()
+  integer :: ifoo
+  print *, ifoo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_integer(
+! CHECK:  fir.call @_QPifoo() fastmath<contract> : () -> i32
+
+
+subroutine return_logical()
+  logical :: lfoo
+  print *, lfoo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_logical(
+! CHECK:  fir.call @_QPlfoo() fastmath<contract> : () -> !fir.logical<4>
+
+subroutine return_complex()
+  complex :: cplxfoo
+  print *, cplxfoo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_complex(
+! CHECK:  fir.call @_QPcplxfoo() fastmath<contract> : () -> !fir.complex<4>
+
+subroutine return_char(n)
+  integer(8) :: n
+  character(n) :: c2foo
+  print *, c2foo()
+end subroutine
+! CHECK-LABEL: func.func @_QPreturn_char(
+! CHECK:  %[[VAL_1:.*]]:2 = hlfir.declare {{.*}}n
+! CHECK:  %[[VAL_2:.*]] = arith.constant -1 : i32
+! CHECK:  %[[VAL_7:.*]] = fir.load %[[VAL_1]]#1 : !fir.ref<i64>
+! CHECK:  %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
+! CHECK:  %[[VAL_9:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_10:.*]] = arith.cmpi sgt, %[[VAL_8]], %[[VAL_9]] : index
+! CHECK:  %[[VAL_11:.*]] = arith.select %[[VAL_10]], %[[VAL_8]], %[[VAL_9]] : index
+! CHECK:  %[[VAL_13:.*]] = fir.alloca !fir.char<1,?>(%[[VAL_11]] : index) {bindc_name = ".result"}
+! CHECK:  %[[VAL_14:.*]] = fir.call @_QPc2foo(%[[VAL_13]], %[[VAL_11]]) fastmath<contract> : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:  %[[VAL_15:.*]]:2 = hlfir.declare %[[VAL_13]] typeparams %[[VAL_11]] {uniq_name = "tmp.funcresult"} : (!fir.ref<!fir.char<1,?>>, index) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+
+! -----------------------------------------------------------------------------
+!     Test calls with alternate returns
+! -----------------------------------------------------------------------------
+
+! CHECK-LABEL: func.func @_QPalternate_return_call(
+subroutine alternate_return_call(n1, n2, k)
+  integer :: n1, n2, k
+  ! CHECK:  %[[VAL_3:.*]]:2 = hlfir.declare {{.*}}k
+  ! CHECK:  %[[VAL_4:.*]]:2 = hlfir.declare {{.*}}n1
+  ! CHECK:  %[[VAL_5:.*]]:2 = hlfir.declare {{.*}}n2
+  ! CHECK:  %[[selector:.*]] = fir.call @_QPalternate_return(%[[VAL_4]]#1, %[[VAL_5]]#1) fastmath<contract> : (!fir.ref<i32>, !fir.ref<i32>) -> index
+  ! CHECK-NEXT: fir.select %[[selector]] : index [1, ^[[block1:bb[0-9]+]], 2, ^[[block2:bb[0-9]+]], unit, ^[[blockunit:bb[0-9]+]]
+  call alternate_return(n1, *5, n2, *7)
+  ! CHECK: ^[[blockunit]]: // pred: ^bb0
+  k =  0; return;
+  ! CHECK: ^[[block1]]: // pred: ^bb0
+5 k = -1; return;
+  ! CHECK: ^[[block2]]: // pred: ^bb0
+7 k =  1; return
+end