@@ -714,6 +714,137 @@ static void genOMP(Fortran::lower::AbstractConverter &converter,
714714 &wsLoopOpClauseList, iv);
715715}
716716
717+ static void genOmpAtomicHintAndMemoryOrderClauses (
718+ Fortran::lower::AbstractConverter &converter,
719+ const Fortran::parser::OmpAtomicClauseList &clauseList, uint64_t &hint,
720+ mlir::StringAttr &memory_order) {
721+ auto &firOpBuilder = converter.getFirOpBuilder ();
722+ for (const auto &clause : clauseList.v ) {
723+ if (auto ompClause = std::get_if<Fortran::parser::OmpClause>(&clause.u )) {
724+ if (auto hintClause =
725+ std::get_if<Fortran::parser::OmpClause::Hint>(&ompClause->u )) {
726+ const auto *expr = Fortran::semantics::GetExpr (hintClause->v );
727+ hint = *Fortran::evaluate::ToInt64 (*expr);
728+ }
729+ } else if (auto ompMemoryOrderClause =
730+ std::get_if<Fortran::parser::OmpMemoryOrderClause>(
731+ &clause.u )) {
732+ if (std::get_if<Fortran::parser::OmpClause::Acquire>(
733+ &ompMemoryOrderClause->v .u )) {
734+ memory_order =
735+ firOpBuilder.getStringAttr (omp::stringifyClauseMemoryOrderKind (
736+ omp::ClauseMemoryOrderKind::acquire));
737+ } else if (std::get_if<Fortran::parser::OmpClause::Relaxed>(
738+ &ompMemoryOrderClause->v .u )) {
739+ memory_order =
740+ firOpBuilder.getStringAttr (omp::stringifyClauseMemoryOrderKind (
741+ omp::ClauseMemoryOrderKind::relaxed));
742+ } else if (std::get_if<Fortran::parser::OmpClause::SeqCst>(
743+ &ompMemoryOrderClause->v .u )) {
744+ memory_order =
745+ firOpBuilder.getStringAttr (omp::stringifyClauseMemoryOrderKind (
746+ omp::ClauseMemoryOrderKind::seq_cst));
747+ } else if (std::get_if<Fortran::parser::OmpClause::Release>(
748+ &ompMemoryOrderClause->v .u )) {
749+ memory_order =
750+ firOpBuilder.getStringAttr (omp::stringifyClauseMemoryOrderKind (
751+ omp::ClauseMemoryOrderKind::release));
752+ }
753+ }
754+ }
755+ }
756+
757+ static void
758+ genOmpAtomicWrite (Fortran::lower::AbstractConverter &converter,
759+ Fortran::lower::pft::Evaluation &eval,
760+ const Fortran::parser::OmpAtomicWrite &atomicWrite) {
761+ auto &firOpBuilder = converter.getFirOpBuilder ();
762+ auto currentLocation = converter.getCurrentLocation ();
763+ mlir::Value address;
764+ // If no hint clause is specified, the effect is as if
765+ // hint(omp_sync_hint_none) had been specified.
766+ uint64_t hint = 0 ;
767+ mlir::StringAttr memory_order = nullptr ;
768+ const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
769+ std::get<2 >(atomicWrite.t );
770+ const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
771+ std::get<0 >(atomicWrite.t );
772+ const auto &assignmentStmtExpr =
773+ std::get<Fortran::parser::Expr>(std::get<3 >(atomicWrite.t ).statement .t );
774+ const auto &assignmentStmtVariable = std::get<Fortran::parser::Variable>(
775+ std::get<3 >(atomicWrite.t ).statement .t );
776+ Fortran::lower::StatementContext stmtCtx;
777+ auto value = fir::getBase (converter.genExprValue (
778+ *Fortran::semantics::GetExpr (assignmentStmtExpr), stmtCtx));
779+ if (auto varDesignator = std::get_if<
780+ Fortran::common::Indirection<Fortran::parser::Designator>>(
781+ &assignmentStmtVariable.u )) {
782+ if (const auto *name = getDesignatorNameIfDataRef (varDesignator->value ())) {
783+ address = converter.getSymbolAddress (*name->symbol );
784+ }
785+ }
786+
787+ genOmpAtomicHintAndMemoryOrderClauses (converter, leftHandClauseList, hint,
788+ memory_order);
789+ genOmpAtomicHintAndMemoryOrderClauses (converter, rightHandClauseList, hint,
790+ memory_order);
791+ firOpBuilder.create <mlir::omp::AtomicWriteOp>(currentLocation, address, value,
792+ hint, memory_order);
793+ }
794+
795+ static void genOmpAtomicRead (Fortran::lower::AbstractConverter &converter,
796+ Fortran::lower::pft::Evaluation &eval,
797+ const Fortran::parser::OmpAtomicRead &atomicRead) {
798+ auto &firOpBuilder = converter.getFirOpBuilder ();
799+ auto currentLocation = converter.getCurrentLocation ();
800+ mlir::Type resultType;
801+ mlir::Value address;
802+ // If no hint clause is specified, the effect is as if
803+ // hint(omp_sync_hint_none) had been specified.
804+ uint64_t hint = 0 ;
805+ mlir::StringAttr memory_order = nullptr ;
806+ const Fortran::parser::OmpAtomicClauseList &rightHandClauseList =
807+ std::get<2 >(atomicRead.t );
808+ const Fortran::parser::OmpAtomicClauseList &leftHandClauseList =
809+ std::get<0 >(atomicRead.t );
810+ const auto &assignmentStmtExpr =
811+ std::get<Fortran::parser::Expr>(std::get<3 >(atomicRead.t ).statement .t );
812+ if (auto exprDesignator = std::get_if<
813+ Fortran::common::Indirection<Fortran::parser::Designator>>(
814+ &assignmentStmtExpr.u )) {
815+ if (const auto *name =
816+ getDesignatorNameIfDataRef (exprDesignator->value ())) {
817+ address = converter.getSymbolAddress (*name->symbol );
818+ resultType = converter.genType (*name->symbol );
819+ }
820+ }
821+ genOmpAtomicHintAndMemoryOrderClauses (converter, leftHandClauseList, hint,
822+ memory_order);
823+ genOmpAtomicHintAndMemoryOrderClauses (converter, rightHandClauseList, hint,
824+ memory_order);
825+ firOpBuilder.create <mlir::omp::AtomicReadOp>(currentLocation, resultType,
826+ address, hint, memory_order);
827+ }
828+
829+ static void
830+ genOMP (Fortran::lower::AbstractConverter &converter,
831+ Fortran::lower::pft::Evaluation &eval,
832+ const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
833+ std::visit (Fortran::common::visitors{
834+ [&](const Fortran::parser::OmpAtomicRead &atomicRead) {
835+ genOmpAtomicRead (converter, eval, atomicRead);
836+ },
837+ [&](const Fortran::parser::OmpAtomicWrite &atomicWrite) {
838+ genOmpAtomicWrite (converter, eval, atomicWrite);
839+ },
840+ [&](const auto &) {
841+ TODO (converter.getCurrentLocation (),
842+ " Atomic update & capture" );
843+ },
844+ },
845+ atomicConstruct.u );
846+ }
847+
717848static void
718849genOMP (Fortran::lower::AbstractConverter &converter,
719850 Fortran::lower::pft::Evaluation &eval,
@@ -846,7 +977,7 @@ void Fortran::lower::genOpenMPConstruct(
846977 genOMP (converter, eval, blockConstruct);
847978 },
848979 [&](const Fortran::parser::OpenMPAtomicConstruct &atomicConstruct) {
849- TODO (converter. getCurrentLocation (), " OpenMPAtomicConstruct " );
980+ genOMP (converter, eval, atomicConstruct );
850981 },
851982 [&](const Fortran::parser::OpenMPCriticalConstruct
852983 &criticalConstruct) {
0 commit comments