[FLANG] Fix for Stop statements in Fortran emissary API

Author: gregrodgers

offload/DeviceRTL/include/EmissaryIds.h

@@ -53,6 +53,7 @@ typedef enum {
   _FortranAAbort_idx,
   _FortranAStopStatementText_idx,
   _FortranAioBeginExternalFormattedOutput_idx,
+  _FortranAStopStatement_idx,
 } offload_emis_fortrt_idx;
 
 /// This structure is created by emisExtractArgBuf to make it easier

offload/DeviceRTL/src/EmissaryFortrt.cpp

@@ -33,9 +33,13 @@ uint32_t omp_get_num_threads();
 uint32_t omp_get_team_num();
 uint32_t omp_get_num_teams();
 
+// All Fortran Runtime Functions pass 4 extra args to assist with
+// defered execution and debug. The host variadic wrappers do not use
+// these arguments when calling the actual Fortran runtime.
 #define _EXTRA_ARGS                                                            \
   omp_get_thread_num(), omp_get_num_threads(), omp_get_team_num(),             \
       omp_get_num_teams()
+#define _START_ARGS(idx) _PACK_EMIS_IDS(EMIS_ID_FORTRT, idx), _EXTRA_ARGS,
 
 void *_FortranAioBeginExternalListOutput(uint32_t a1, const char *a2,
                                          uint32_t a3) {
@@ -116,15 +120,20 @@ bool _FortranAioOutputLogical(void *cookie, bool barg) {
       cookie, barg);
 }
 void _FortranAAbort() {
-  _emissary_exec(_PACK_EMIS_IDS(EMIS_ID_FORTRT, _FortranAAbort_idx));
+  _emissary_exec(_PACK_EMIS_IDS(EMIS_ID_FORTRT, _FortranAAbort_idx),
+                 _EXTRA_ARGS);
   // When  host service _FortranAAbort finishes, we must die from the device.
   __builtin_trap();
 }
+void _FortranAStopStatement(int32_t a1, bool a2, bool a3) {
+  _emissary_exec(_PACK_EMIS_IDS(EMIS_ID_FORTRT, _FortranAStopStatement_idx),
+                 _EXTRA_ARGS, a1, a2, a3);
+  __builtin_trap();
+}
 void _FortranAStopStatementText(char *errmsg, int64_t a1, bool a2, bool a3) {
-  // TODO: must use string length from a1 arg
   errmsg[a1 - 1] = (char)0;
   _emissary_exec(_PACK_EMIS_IDS(EMIS_ID_FORTRT, _FortranAStopStatementText_idx),
-                 errmsg, a1, a2, a3);
+                 _EXTRA_ARGS, errmsg, a1, a2, a3);
   __builtin_trap();
 }
 

offload/DeviceRTL/src/exports

@@ -23,7 +23,7 @@ printf_*
 f90print*
 fprintf_*
 
-_FortranAio*
+_FortranA*
 __ockl_dm_alloc
 __ockl_dm_dealloc
 __asan*

offload/plugins-nextgen/common/src/EmissaryFortrt.cpp

@@ -52,6 +52,7 @@ bool _FortranAioOutputComplex64(void *cookie, double re, double im);
 bool _FortranAioOutputLogical(void *cookie, bool truth);
 void _FortranAAbort();
 void _FortranAStopStatementText(char *errmsg, int64_t a1, bool a2, bool a3);
+void _FortranAStopStatement(int32_t a1, bool a2, bool a3);
 
 //  Save the cookie because deferred functions have execution reordered.
 static void *_list_started_cookie = nullptr;
@@ -212,6 +213,17 @@ extern void V_FortranAStopStatementText(void *fnptr, ...) {
   bool b3 = (bool)a3;
   _FortranAStopStatementText(errmsg, a1, b2, b3);
 }
+extern void V_FortranAStopStatement(void *fnptr, ...) {
+  va_list args;
+  va_start(args, fnptr);
+  int32_t a1 = va_arg(args, int32_t);
+  uint32_t a2 = va_arg(args, uint32_t);
+  uint32_t a3 = va_arg(args, uint32_t);
+  va_end(args);
+  bool b2 = (bool)a2;
+  bool b3 = (bool)a3;
+  _FortranAStopStatement(a1, b2, b3);
+}
 } // end extern "C"
 
 // Static vars used to defer functions to reorder execution by thread and team.
@@ -367,6 +379,11 @@ extern "C" emis_return_t EmissaryFortrt(char *data, emisArgBuf_t *ab) {
     fnptr = (void *)V_FortranAStopStatementText;
     break;
   }
+  case _FortranAStopStatement_idx: {
+    defer_for_reorder = false;
+    fnptr = (void *)V_FortranAStopStatement;
+    break;
+  }
   case _FortranAio_INVALID:
   default: {
     defer_for_reorder = false;