Intercepting Fortran STOP from C++

…衆ロ難τιáo~ 提交于 2019-11-30 15:28:52

You can solve your problem by intercepting the call to the exit function from the Fortran runtime. See below. a.out is created with your code and the compilation lines you give.

Step 1. Figure out which function is called. Fire up gdb

$ gdb ./a.out
GNU gdb (GDB) Red Hat Enterprise Linux (7.2-60.el6_4.1)
[...]
(gdb) break fsub
Breakpoint 1 at 0x400888
(gdb) run
Starting program: a.out 
5

Breakpoint 1, 0x00007ffff7dfc7e4 in fsub () from ./libfmodule.so
(gdb) step
Single stepping until exit from function fsub,
which has no line number information.
stop_string (string=0x7ffff7dfc8d8 "x >=5 : this kills the programfmodule.f90", len=30) at /usr/local/src/gcc-4.7.2/libgfortran/runtime/stop.c:67

So stop_string is called. We need to know to which symbol this function corresponds.

Step 2. Find the exact name of the stop_string function. It must be in one of the shared libraries.

$ ldd ./a.out 
    linux-vdso.so.1 =>  (0x00007fff54095000)
    libfmodule.so => ./libfmodule.so (0x00007fa31ab7d000)
    libstdc++.so.6 => /usr/local/gcc/4.7.2/lib64/libstdc++.so.6 (0x00007fa31a875000)
    libm.so.6 => /lib64/libm.so.6 (0x0000003da4000000)
    libgcc_s.so.1 => /usr/local/gcc/4.7.2/lib64/libgcc_s.so.1 (0x00007fa31a643000)
    libc.so.6 => /lib64/libc.so.6 (0x0000003da3c00000)
    libgfortran.so.3 => /usr/local/gcc/4.7.2/lib64/libgfortran.so.3 (0x00007fa31a32f000)
    libquadmath.so.0 => /usr/local/gcc/4.7.2/lib64/libquadmath.so.0 (0x00007fa31a0fa000)
    /lib64/ld-linux-x86-64.so.2 (0x0000003da3800000)

I found it in (no surprise) the fortran runtime.

$ readelf -s /usr/local/gcc/4.7.2/lib64/libgfortran.so.3|grep stop_string
  1121: 000000000001b320    63 FUNC    GLOBAL DEFAULT   11 _gfortran_stop_string@@GFORTRAN_1.0
  2417: 000000000001b320    63 FUNC    GLOBAL DEFAULT   11 _gfortran_stop_string

Step 3. Write a function that will replace that function

I look for the precise signature of the function in the source code (/usr/local/src/gcc-4.7.2/libgfortran/runtime/stop.c see gdb session)

$ cat my_exit.c 
#define _GNU_SOURCE
#include <stdio.h>

void _gfortran_stop_string (const char *string, int len)
{
        printf("Let's keep on");
}

Step 4. Compile a shared object exporting that symbol.

gcc -Wall -fPIC -c -o my_exit.o my_exit.c
gcc -shared -fPIC -Wl,-soname -Wl,libmy_exit.so -o libmy_exit.so my_exit.o

Step 5. Run the program with LD_PRELOAD so that our new function has precedence over the one form the runtime

$ LD_PRELOAD=./libmy_exit.so ./a.out 
1
   1.0000000000000000     
2
   2.0000000000000000     
3
   3.0000000000000000     
4
   4.0000000000000000     
5
Let's keep on   5.0000000000000000     
6
Let's keep on   6.0000000000000000     
7
Let's keep on   7.0000000000000000   

There you go.

Since what you want would result in non-portable code anyway, why not just subvert the exit mechanism using the obscure long jump mechanism:

#include<iostream>
#include<csetjmp>
#include<cstdlib>

// prototype for the external Fortran subroutine
extern "C" {
  void fsub(double* x);  
}

volatile bool please_dont_exit = false;
std::jmp_buf jenv;

static void my_exit_handler() {
  if (please_dont_exit) {
    std::cout << "But not yet!\n";
    // Re-register ourself
    std::atexit(my_exit_handler);
    longjmp(jenv, 1);
  }
}

void wrapped_fsub(double& x) {
  please_dont_stop = true;
  if (!setjmp(jenv)) {
    fsub(&x);
  }
  please_dont_stop = false;
}

int main() {
  std::atexit(my_exit_handler);  
  double x;
  while(std::cin >> x) {
    wrapped_fsub(x);
  }
  return 0;
}

Calling longjmp jumps right in the middle of the line with the setjmp call and setjmp returns the value passed as the second argument of longjmp. Otherwise setjmp returns 0. Sample output (OS X 10.7.4, GCC 4.7.1):

$ ./a.out 
2
   2.0000000000000000     
6
STOP x >=5 : this kills the program
But not yet!
7
STOP x >=5 : this kills the program
But not yet!
4
   4.0000000000000000
^D     
$

No library preloading required (which anyway is a bit more involved on OS X than on Linux). A word of warning though - exit handlers are called in reverse order of their registration. One should be careful that no other exit handlers are registered after my_exit_handler.

Combining the two answers that use a custom _gfortran_stop_string function and longjmp, I thought that raising an exception inside the custom function would be similar, then catch in in the main code. So this came out:

main.cpp:

#include<iostream>

// prototype for the external Fortran subroutine
extern "C" {
  void fsub(double& x);  
}

int main() {  
  double x;
  while(std::cin >> x) {
    try { fsub(x); }
    catch (int rc) { std::cout << "Fortran stopped with rc = " << rc <<std::endl; }
  }
  return 0;
}

catch.cpp:

extern "C" {
    void _gfortran_stop_string (const char*, int);
}

void _gfortran_stop_string (const char *string, int len)
{
        throw 666;
}

Then, compiling:

gfortran -c fmodule.f90
g++ -c catch.cpp
g++ main.cpp fmodule.o catch.o -lgfortran

Running:

./a.out
2
   2.0000000000000000     
3
   3.0000000000000000     
5
Fortran stopped with rc = 666
6
Fortran stopped with rc = 666
2
   2.0000000000000000     
3
   3.0000000000000000     
^D

So, seems to work :)

I suggest you fork your process before calling the fortran code and exit 0 (edit: if STOP exits with zero, you will need a sentinel exit code, clanky but does the job) after the fortran execution. That way every fortran call will finish in the same way: the same as if it had stopped. Or, if "STOP" ensure an error, throw the exception when the fortran code stops and send some other message when the fortran execution "completes" normaly.

Below is an example inspire from you code assuming a fortran "STOP" is an error.

 int main() {  
   double x;
   pid_t pid;
   int   exit_code_normal = //some value that is different from all STOP exit code values
   while(std::cin >> x) {
     pid = fork();
     if(pid < 0) {
       // error with the fork handle appropriately
     } else if(pid == 0) {
       fsub(x);
       exit(exit_code_normal);
     } else {
       wait(&status);
       if(status != exit_code_normal)
          // throw your error message.
     }
   }
   return 0;
 }

The exit code could be a constant instead of a variable. I don't think it matters much.

Following a comment, it occurs that the result from the execution would be lost if it sits in the memory of the process (rather than, say, write to a file). If it is the case, I can think of 3 possibilities:

  • The fortran code messes a whole lot of memory during the call and letting the execution continue beyond the STOP is probably not a good idea in the first place.
  • The fortran code simply return some value (through it's argument if my fortran is not too rusty) and this could be relayed back to the parent easily through a shared memory space.
  • The execution of the fortran subroutine acts on an external system (ex: writes to a file) and no return values are expected.

In the 3rd case, my solution above works as is. I prefer it over some other suggested solution mainly because: 1) you don't have to ensure the build process is properly maintained 2) fortran "STOP" still behave as expected and 3) it requires very few lines of code and all the "fortran STOP workaround" logic sits in one single place. So in terms of long term maintenance, I much prefer that.

In the 2nd case, my code above needs small modification but still holds the advantages enumerated above at the price of minimal added complexity.

In the 1st case, you will have to mess with the fortran code no matter what.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!