Creating redirected console for DLL

I recently had (still do) a problem in getting diagnostic information out of a Fortran DLL containing offloads to Xeon Phi coprocessor. The host application was a C# forms application with no console. To aid in debugging, there are some diagnostic options you can set in the environment variables (H_TRACE, etc). Using the Kernel32 function AllocConsole() worked for the most part. The "gotcha" that got me now is one of those "Heisenbugs" - the kind that when you look for them, their not there.

What I wanted to do is to run the Release build, with debugging information, in the Amplifier (aka VTune). The release code image would run without the debugger and outside of the Amplifier. Same image would run when launched for a debug session. However, when attempting an Amplifier run the application would crash on the first offload *** before any of the offload code got loaded ***. (I could run the Amplifier using the Debug build). Unfortunately, when the crash occurs the console window closes and any information gets lost. To correct for this, I needed to add a redirected to file console to a non-console application. I thought I should share the code for those in a similar pickle:

!DIR$ IF (.TRUE.)
! enable this section to get console ouput for debugging of MIC offloads
function DllMain (hInstDLL, fdwReason, lpReserved)
!DEC$ ATTRIBUTES STDCALL, DECORATE, DLLEXPORT, ALIAS:"DllMain" :: DllMain
    USE IFWINTY
    USE Kernel32
   
    IMPLICIT NONE
    integer(BOOL) :: DllMain
    integer(HANDLE), intent(IN) :: hinstDLL
    integer(DWORD), intent(IN) :: fdwReason
    integer(LPVOID), intent(IN) :: lpReserved
   
    character(500) :: eVar
    character(500) :: fName
    logical :: exists
    logical, save :: FirstTime = .true.
   
    integer(BOOL) :: b
    integer(HANDLE) :: hConFile
    interface
        INTEGER FUNCTION internal_crames_try_offload_mic(iMIC)
            integer :: iMIC
        end FUNCTION internal_crames_try_offload_mic
    end interface
   
    select case(fdwReason)
    case (DLL_PROCESS_DETACH)
       ! ...
        DllMain = TRUE
    case (DLL_PROCESS_ATTACH)
!DIR$ IF(.FALSE.)
     b = AllocConsole()
!DIR$ ELSE
        hConFile = CreateFile("C:\\DebugOutput\\ConsoleOutput.txt"C, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
        b=SetStdHandle(STD_OUTPUT_HANDLE, hConFile)
!DIR$ ENDIF
        write(*,*) "***************************"
        CALL GET_ENVIRONMENT_VARIABLE("MIC_LIBRARY_PATH",eVar)
        write(*,*) "MIC_LIBRARY_PATH=",TRIM(eVar)
        CALL GET_ENVIRONMENT_VARIABLE("MIC_LD_LIBRARY_PATH",eVar)
        write(*,*) "MIC_LD_LIBRARY_PATH=",TRIM(eVar)
        write(*,*) "***************************"
    case (DLL_THREAD_ATTACH)
        ! ...
    case (DLL_THREAD_DETACH)
        ! ...
    case default
        ! ...
    end select
    DllMain = TRUE
    write(*,*) "DllMain(",hInstDLL, ",", fdwReason, ",", lpReserved,")"
    end function DllMain
!DIR$ ENDIF

Now for the "Heisenbug" part. Adding the conditional compile statements to switch from AllocConsole and SetStdHandle caused the application to not crash. In any event, I am all set to catch any fleeting output should the bug crop up again.

Jim Dempsey