1 //===-- CallInterface.cpp -- Procedure call interface ---------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "flang/Lower/CallInterface.h"
10 #include "flang/Evaluate/fold.h"
11 #include "flang/Lower/Bridge.h"
12 #include "flang/Lower/Mangler.h"
13 #include "flang/Lower/PFTBuilder.h"
14 #include "flang/Lower/Support/Utils.h"
15 #include "flang/Lower/Todo.h"
16 #include "flang/Optimizer/Builder/FIRBuilder.h"
17 #include "flang/Optimizer/Dialect/FIRDialect.h"
18 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
19 #include "flang/Optimizer/Support/InternalNames.h"
20 #include "flang/Semantics/symbol.h"
21 #include "flang/Semantics/tools.h"
22 
23 //===----------------------------------------------------------------------===//
24 // BIND(C) mangling helpers
25 //===----------------------------------------------------------------------===//
26 
27 // Return the binding label (from BIND(C...)) or the mangled name of a symbol.
28 static std::string getMangledName(const Fortran::semantics::Symbol &symbol) {
29   const std::string *bindName = symbol.GetBindName();
30   return bindName ? *bindName : Fortran::lower::mangle::mangleName(symbol);
31 }
32 
33 //===----------------------------------------------------------------------===//
34 // Callee side interface implementation
35 //===----------------------------------------------------------------------===//
36 
37 bool Fortran::lower::CalleeInterface::hasAlternateReturns() const {
38   return !funit.isMainProgram() &&
39          Fortran::semantics::HasAlternateReturns(funit.getSubprogramSymbol());
40 }
41 
42 std::string Fortran::lower::CalleeInterface::getMangledName() const {
43   if (funit.isMainProgram())
44     return fir::NameUniquer::doProgramEntry().str();
45   return ::getMangledName(funit.getSubprogramSymbol());
46 }
47 
48 const Fortran::semantics::Symbol *
49 Fortran::lower::CalleeInterface::getProcedureSymbol() const {
50   if (funit.isMainProgram())
51     return nullptr;
52   return &funit.getSubprogramSymbol();
53 }
54 
55 mlir::Location Fortran::lower::CalleeInterface::getCalleeLocation() const {
56   // FIXME: do NOT use unknown for the anonymous PROGRAM case. We probably
57   // should just stash the location in the funit regardless.
58   return converter.genLocation(funit.getStartingSourceLoc());
59 }
60 
61 Fortran::evaluate::characteristics::Procedure
62 Fortran::lower::CalleeInterface::characterize() const {
63   Fortran::evaluate::FoldingContext &foldingContext =
64       converter.getFoldingContext();
65   std::optional<Fortran::evaluate::characteristics::Procedure> characteristic =
66       Fortran::evaluate::characteristics::Procedure::Characterize(
67           funit.getSubprogramSymbol(), foldingContext);
68   assert(characteristic && "Fail to get characteristic from symbol");
69   return *characteristic;
70 }
71 
72 bool Fortran::lower::CalleeInterface::isMainProgram() const {
73   return funit.isMainProgram();
74 }
75 
76 mlir::FuncOp Fortran::lower::CalleeInterface::addEntryBlockAndMapArguments() {
77   // On the callee side, directly map the mlir::value argument of
78   // the function block to the Fortran symbols.
79   func.addEntryBlock();
80   return func;
81 }
82 
83 //===----------------------------------------------------------------------===//
84 // CallInterface implementation: this part is common to both callee and caller
85 // sides.
86 //===----------------------------------------------------------------------===//
87 
88 static void addSymbolAttribute(mlir::FuncOp func,
89                                const Fortran::semantics::Symbol &sym,
90                                mlir::MLIRContext &mlirContext) {
91   // Only add this on bind(C) functions for which the symbol is not reflected in
92   // the current context.
93   if (!Fortran::semantics::IsBindCProcedure(sym))
94     return;
95   std::string name =
96       Fortran::lower::mangle::mangleName(sym, /*keepExternalInScope=*/true);
97   func->setAttr(fir::getSymbolAttrName(),
98                 mlir::StringAttr::get(&mlirContext, name));
99 }
100 
101 /// Declare drives the different actions to be performed while analyzing the
102 /// signature and building/finding the mlir::FuncOp.
103 template <typename T>
104 void Fortran::lower::CallInterface<T>::declare() {
105   if (!side().isMainProgram()) {
106     characteristic.emplace(side().characterize());
107     bool isImplicit = characteristic->CanBeCalledViaImplicitInterface();
108     determineInterface(isImplicit, *characteristic);
109   }
110   // No input/output for main program
111 
112   // Create / get funcOp for direct calls. For indirect calls (only meaningful
113   // on the caller side), no funcOp has to be created here. The mlir::Value
114   // holding the indirection is used when creating the fir::CallOp.
115   if (!side().isIndirectCall()) {
116     std::string name = side().getMangledName();
117     mlir::ModuleOp module = converter.getModuleOp();
118     func = fir::FirOpBuilder::getNamedFunction(module, name);
119     if (!func) {
120       mlir::Location loc = side().getCalleeLocation();
121       mlir::FunctionType ty = genFunctionType();
122       func = fir::FirOpBuilder::createFunction(loc, module, name, ty);
123       if (const Fortran::semantics::Symbol *sym = side().getProcedureSymbol())
124         addSymbolAttribute(func, *sym, converter.getMLIRContext());
125     }
126   }
127 }
128 
129 //===----------------------------------------------------------------------===//
130 // CallInterface implementation: this part is common to both caller and caller
131 // sides.
132 //===----------------------------------------------------------------------===//
133 
134 /// This is the actual part that defines the FIR interface based on the
135 /// characteristic. It directly mutates the CallInterface members.
136 template <typename T>
137 class Fortran::lower::CallInterfaceImpl {
138   using CallInterface = Fortran::lower::CallInterface<T>;
139   using FirPlaceHolder = typename CallInterface::FirPlaceHolder;
140   using Property = typename CallInterface::Property;
141   using TypeAndShape = Fortran::evaluate::characteristics::TypeAndShape;
142 
143 public:
144   CallInterfaceImpl(CallInterface &i)
145       : interface(i), mlirContext{i.converter.getMLIRContext()} {}
146 
147   void buildImplicitInterface(
148       const Fortran::evaluate::characteristics::Procedure &procedure) {
149     // Handle result
150     if (const std::optional<Fortran::evaluate::characteristics::FunctionResult>
151             &result = procedure.functionResult)
152       handleImplicitResult(*result);
153     else if (interface.side().hasAlternateReturns())
154       addFirResult(mlir::IndexType::get(&mlirContext),
155                    FirPlaceHolder::resultEntityPosition, Property::Value);
156   }
157 
158 private:
159   void handleImplicitResult(
160       const Fortran::evaluate::characteristics::FunctionResult &result) {
161     if (result.IsProcedurePointer())
162       TODO(interface.converter.getCurrentLocation(),
163            "procedure pointer result not yet handled");
164     const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
165         result.GetTypeAndShape();
166     assert(typeAndShape && "expect type for non proc pointer result");
167     Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
168     if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
169       TODO(interface.converter.getCurrentLocation(),
170            "implicit result character type");
171     } else if (dynamicType.category() ==
172                Fortran::common::TypeCategory::Derived) {
173       TODO(interface.converter.getCurrentLocation(),
174            "implicit result derived type");
175     } else {
176       // All result other than characters/derived are simply returned by value
177       // in implicit interfaces
178       mlir::Type mlirType =
179           getConverter().genType(dynamicType.category(), dynamicType.kind());
180       addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
181                    Property::Value);
182     }
183   }
184 
185   void addFirResult(mlir::Type type, int entityPosition, Property p) {
186     interface.outputs.emplace_back(FirPlaceHolder{type, entityPosition, p});
187   }
188 
189   Fortran::lower::AbstractConverter &getConverter() {
190     return interface.converter;
191   }
192   CallInterface &interface;
193   mlir::MLIRContext &mlirContext;
194 };
195 
196 template <typename T>
197 void Fortran::lower::CallInterface<T>::determineInterface(
198     bool isImplicit,
199     const Fortran::evaluate::characteristics::Procedure &procedure) {
200   CallInterfaceImpl<T> impl(*this);
201   if (isImplicit)
202     impl.buildImplicitInterface(procedure);
203   else
204     TODO_NOLOC("determineImplicitInterface");
205 }
206 
207 template <typename T>
208 mlir::FunctionType Fortran::lower::CallInterface<T>::genFunctionType() {
209   llvm::SmallVector<mlir::Type> returnTys;
210   for (const FirPlaceHolder &placeHolder : outputs)
211     returnTys.emplace_back(placeHolder.type);
212   return mlir::FunctionType::get(&converter.getMLIRContext(), {}, returnTys);
213 }
214 
215 template class Fortran::lower::CallInterface<Fortran::lower::CalleeInterface>;
216