diff --git a/.appveyor.yml b/.appveyor.yml new file mode 100644 index 00000000000..fd2cde105b5 --- /dev/null +++ b/.appveyor.yml @@ -0,0 +1,53 @@ +branches: + only: + - master + - windows + - windows-rebased + +environment: + global: + CONDA_INSTALL_LOCN: C:\\Miniconda36-x64 + APPVEYOR_SAVE_CACHE_ON_FAILURE: true + +cache: + - '%CONDA_INSTALL_LOCN%\pkgs' + +os: Visual Studio 2017 + +platform: + - x64 + +install: + # Add path, activate `conda` and update conda. + - cmd: call %CONDA_INSTALL_LOCN%\Scripts\activate.bat + # Add our channels. + - cmd: conda config --add channels defaults + - cmd: conda config --add channels conda-forge + - cmd: conda install --yes llvmdev clangdev flang-meta cmake + - cmd: conda install --yes -c isuruf kitware-ninja + + +build_script: + - ps: mkdir build + + - cd build + - set "PATH=%cd%\bin;%PATH%" + - call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvarsall.bat" x64 + - cmake -G "Ninja" -DCMAKE_INSTALL_PREFIX=%CONDA_PREFIX% -DFLANG_INCLUDE_TESTS=ON -DFLANG_TEST_VERBOSE_MODE=ON -DCMAKE_C_COMPILER=clang-cl -DCMAKE_CXX_COMPILER=clang-cl -DCMAKE_Fortran_COMPILER=flang -DCMAKE_VERBOSE_MAKEFILE=ON -DCMAKE_BUILD_TYPE=Release -DLLVM_INCLUDE_TESTS=ON -DLLVM_MAIN_SRC_DIR=C:\llvm_src .. + - ps: | + Push-AppveyorArtifact .\CMakeFiles\CMakeOutput.log + Push-AppveyorArtifact .\CMakeFiles\CMakeError.log + + - ps: | + cmake --build . 2>&1 | Out-File build_output.txt + if($LastExitCode -ne 0) { $host.SetShouldExit($LastExitCode ) } + Push-AppveyorArtifact .\build_output.txt + Get-Content .\build_output.txt -Tail 500 + + - ps: Compress-Archive -Path C:\projects\flang\build\bin -DestinationPath C:\Projects\flang\bin.zip + - ps: Push-AppveyorArtifact C:\Projects\flang\bin.zip + - ps: Compress-Archive -Path C:\projects\flang\build\lib -DestinationPath C:\Projects\flang\lib.zip + - ps: Push-AppveyorArtifact C:\Projects\flang\lib.zip + +test_script: + - cmd: cmake --build . --target install diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 00000000000..35aa87fa181 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,44 @@ +language: c + +cache: + directories: + - $HOME/.conda/pkgs + - $HOME/miniconda/pkgs + +branches: + only: + - master + - windows + +install: + - wget https://repo.continuum.io/miniconda/Miniconda3-latest-Linux-x86_64.sh -O miniconda.sh; + - bash miniconda.sh -u -b -p $HOME/miniconda + - export PATH="$HOME/miniconda/bin:$PATH" + - hash -r + - conda config --set always_yes yes --set changeps1 no + - conda config --add channels conda-forge --force + - conda update -q conda + + - conda create -q -n test-environment + flang-meta + llvmdev + clangdev + openmp + cmake + + - source activate test-environment + - conda info -a + + # For testing + #- pip install lit + +script: + - mkdir -p build + - cd build + - cmake -DCMAKE_INSTALL_PREFIX=$CONDA_PREFIX -DFLANG_INCLUDE_TESTS=ON -DCMAKE_CXX_COMPILER=clang++ -DCMAKE_C_COMPILER=clang -DCMAKE_Fortran_COMPILER=flang .. + - make -j4 + - make install -j4 + #- make check-flang + +notifications: + email: false diff --git a/CMakeLists.txt b/CMakeLists.txt index 4d22b2ef62d..964e54a2fbf 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -21,16 +21,20 @@ cmake_minimum_required(VERSION 2.8) # In order to bootstrap the runtime library we need to skip # CMake's Fortran tests SET(CMAKE_Fortran_COMPILER_WORKS 1) +SET(CMAKE_Fortran_ABI_COMPILED 0) +SET(CMAKE_Fortran_COMPILER_SUPPORTS_F90 1) +SET(CMAKE_Fortran_PREPROCESS_SOURCE + " -cpp -E -o ") +SET(CMAKE_Fortran_MODDIR_FLAG "-module ") -if( NOT DEFINED TARGET_ARCHITECTURE ) - execute_process(COMMAND uname -m OUTPUT_STRIP_TRAILING_WHITESPACE - OUTPUT_VARIABLE TARGET_ARCHITECTURE) +# If we are not building as a part of LLVM, build Flang as an +# standalone project, using LLVM as an external library: +if( CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR ) + project(Flang) endif() -if( NOT DEFINED TARGET_OS ) - execute_process(COMMAND uname -s OUTPUT_STRIP_TRAILING_WHITESPACE - OUTPUT_VARIABLE TARGET_OS) -endif() +set(TARGET_OS ${CMAKE_HOST_SYSTEM_NAME} CACHE STRING "Target OS") +set(TARGET_ARCHITECTURE ${CMAKE_HOST_SYSTEM_PROCESSOR} CACHE STRING "Target Architecture") if( ${TARGET_OS} STREQUAL "Linux" ) set(OS "LINUX") @@ -51,16 +55,26 @@ if( ${TARGET_OS} STREQUAL "Linux" ) message("Unsupported architecture: ${TARGET_ARCHITECTURE}" ) return() endif() +elseif(${TARGET_OS} STREQUAL "Windows" ) + set(OS "WINDOWS") + set(OSNAME "Windows") + add_definitions(-DWIN32 -DHOST_WIN -DWINNT -DTARGET_WIN -DTARGET_WIN_X86) + if( ${TARGET_ARCHITECTURE} STREQUAL "AMD64" ) + add_definitions(-DWIN64 -DTARGET_WIN_X8664) + set(TARGET_ARCHITECTURE "x86_64") + set(ARCHNAME x86-64) + set(ARCH X86) + set(WRDSZ 64) + else() + add_definitions(-DTARGET_WIN_X8632) + message("Unsupported architecture: ${TARGET_ARCHITECTURE}" ) + return() + endif() else() message("Unsupported OS: ${TARGET_OS}" ) return() endif() -# The cmake documentation states that these are set. They are not so we -# set them here -set(CMAKE_HOST_SYSTEM_NAME ${TARGET_OS}) -set(CMAKE_HOST_SYSTEM_PROCESSOR ${TARGET_ARCHITECTURE}) - # If we are not building as a part of LLVM, build Flang as an # standalone project, using LLVM as an external library: if( CMAKE_SOURCE_DIR STREQUAL CMAKE_CURRENT_SOURCE_DIR ) @@ -326,7 +340,7 @@ macro(add_flang_library name) endif( LLVM_COMMON_DEPENDS ) llvm_config( ${name} ${LLVM_LINK_COMPONENTS} ) - target_link_libraries( ${name} ${LLVM_COMMON_LIBS} ) + target_link_libraries( ${name} ${LLVM_COMMON_LIBS}) # link_system_libs( ${name} ) # getd of cmake warning messages install(TARGETS ${name} diff --git a/LICENSE.txt b/LICENSE.txt index 5b03bfcdb16..b0b14418012 100644 --- a/LICENSE.txt +++ b/LICENSE.txt @@ -12,3 +12,4 @@ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. + diff --git a/include/legacy-util-api.h b/include/legacy-util-api.h index f4fa9a261a2..e30530c5739 100644 --- a/include/legacy-util-api.h +++ b/include/legacy-util-api.h @@ -41,7 +41,9 @@ extern "C" { #include #include #include /* time() */ +#ifndef _WIN32 #include /* getcwd() */ +#endif /* See tmpfile(3). */ FILE *tmpf(char *ignored); diff --git a/lib/scutil/cpu-stopwatch.c b/lib/scutil/cpu-stopwatch.c index a2ea16a5182..95b6755e605 100644 --- a/lib/scutil/cpu-stopwatch.c +++ b/lib/scutil/cpu-stopwatch.c @@ -21,6 +21,8 @@ * since the most recent call. Very much not thread-safe. */ +#ifndef _WIN32 + #include #include #include "scutil.h" @@ -51,3 +53,33 @@ getcpu(void) last = now; return elapsed; } + +#else + +#include +//#include "scutil.h" + +unsigned long +getcpu(void) +{ + LARGE_INTEGER ticks_per_second = {-1}; + LARGE_INTEGER ticks; + + unsigned long last = 0; + unsigned long now, elapsed; + + /* Initialize ticks_per_second. */ + if (ticks_per_second.QuadPart <= 0) + QueryPerformanceFrequency(&ticks_per_second.QuadPart); + + QueryPerformanceCounter(&ticks); + now = ticks.QuadPart; + now *= 1000; /* milliseconds */ + now /= ticks_per_second.QuadPart; + + elapsed = now - last; + last = now; + return elapsed; +} + +#endif diff --git a/lib/scutil/host-fp-folding.c b/lib/scutil/host-fp-folding.c index 50e48047bdf..e40b4491609 100644 --- a/lib/scutil/host-fp-folding.c +++ b/lib/scutil/host-fp-folding.c @@ -34,6 +34,9 @@ #include #include #include +#ifdef _WIN32 +#include +#endif /* * Build-time sanity checks @@ -82,15 +85,27 @@ configure_denormals(bool denorms_are_zeros, bool flush_to_zero) if (fegetenv(&fenv) != 0) fprintf(stderr, "fegetenv() failed: %s\n", strerror(errno)); #ifdef __x86_64__ - fenv.__mxcsr &= ~0x0040; +#ifdef _WIN32 + unsigned int mxcsr = _mm_getcsr(); +#else + unsigned int mxcsr = fenv.__mxcsr; +#endif + mxcsr &= ~0x0040; if (denorms_are_zeros) - fenv.__mxcsr |= 0x0040; - fenv.__mxcsr &= ~0x8000; + mxcsr |= 0x0040; + mxcsr &= ~0x8000; if (flush_to_zero) - fenv.__mxcsr |= 0x8000; + mxcsr |= 0x8000; +#ifdef _WIN32 + _mm_setcsr( mxcsr ); +#else + fenv.__mxcsr = mxcsr; #endif +#endif +#ifndef _WIN32 if (fesetenv(&fenv) != 0) fprintf(stderr, "fesetenv() failed: %s\n", strerror(errno)); +#endif } /* diff --git a/lib/scutil/lockfile.c b/lib/scutil/lockfile.c index 27681137a79..70dc41d52b4 100644 --- a/lib/scutil/lockfile.c +++ b/lib/scutil/lockfile.c @@ -43,7 +43,12 @@ * Clean up by deleting the uniquely named file we had created earlier. */ -#include +#ifndef _WIN32 + #include +#else + #include + #include +#endif #include #include #include @@ -64,6 +69,9 @@ static char *udir = NULL; */ static long uwaiting; +#ifdef _WIN32 +#define pid_t int +#endif int __pg_make_lock_file(char *dir) { diff --git a/lib/scutil/path-utils.c b/lib/scutil/path-utils.c index ca4c8c72074..cadbdac696c 100644 --- a/lib/scutil/path-utils.c +++ b/lib/scutil/path-utils.c @@ -23,7 +23,9 @@ #include "legacy-util-api.h" #include #include +#ifndef _WIN32 #include /* access() */ +#endif void basenam(const char *orig_path, const char *optional_suffix, char *basename) diff --git a/lib/scutil/pgnewfil.c b/lib/scutil/pgnewfil.c index e198d33ef4e..b72d504218d 100644 --- a/lib/scutil/pgnewfil.c +++ b/lib/scutil/pgnewfil.c @@ -32,6 +32,7 @@ #if defined(HOST_WIN) #include #include +#include extern unsigned long getpid(void); #else #include @@ -42,6 +43,10 @@ int pgnewfil_debug = 0; #endif extern size_t strlen(); +#ifndef S_ISDIR +#define S_ISDIR(mode) (((mode) & S_IFMT) == S_IFDIR) +#endif + /* * copy chars from q to p, terminate string, return end of string */ diff --git a/runtime/CMakeLists.txt b/runtime/CMakeLists.txt index 7ece2b81797..0691a1a0512 100644 --- a/runtime/CMakeLists.txt +++ b/runtime/CMakeLists.txt @@ -20,15 +20,21 @@ add_definitions( -DMAXCPUS=256 -DMAXCPUSL=8 -DMAXCPUSR=8 - -DTARGET_LINUX -DTARGET_LLVM - -DLINUX - -DPGF90 + -DPGF90 -DPGFLANG -DNATIVE_FPCVT -DPGI_LITTLE_ENDIAN ) +if( ${TARGET_OS} STREQUAL "Linux" ) + add_definitions( + -DTARGET_LINUX + -DLINUX + ) +endif() + + if( ${TARGET_ARCHITECTURE} STREQUAL "x86_64" ) add_definitions( -DTARGET_X8664 diff --git a/runtime/flang/CMakeLists.txt b/runtime/flang/CMakeLists.txt index c7b3bff93ef..e7ffd43b487 100644 --- a/runtime/flang/CMakeLists.txt +++ b/runtime/flang/CMakeLists.txt @@ -18,13 +18,18 @@ enable_language(C ASM Fortran) # Enable assembly and Fortran SET(ASM_OPTIONS "-DLINUX_ELF") SET(CMAKE_ASM_FLAGS "${CFLAGS} ${ASM_OPTIONS}" ) +if (NOT MSVC) SET(CMAKE_SHARED_LINKER_FLAGS "-no-flang-libs") +endif() # We are using Fortran driver to build this library with fresh compiler # components, so point its binary directory to the build directory to pick up # flang* executables SET(CMAKE_Fortran_FLAGS "-B ${LLVM_RUNTIME_OUTPUT_INTDIR} ${CMAKE_Fortran_FLAGS}") +# flang runtime libraries are being built here. Don't link them +SET(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -no-flang-libs") + SET(FTN_INTRINSICS abort3f.c access3f.c @@ -480,18 +485,35 @@ add_flang_library(flang_static ${FTN_SUPPORT} ${SHARED_SOURCES} ) -set_property(TARGET flang_static PROPERTY OUTPUT_NAME flang) + +set_target_properties(flang_static + PROPERTIES + Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include-static +) + +if (MSVC) + set_property(TARGET flang_static PROPERTY OUTPUT_NAME libflang) +else() + set_property(TARGET flang_static PROPERTY OUTPUT_NAME flang) +endif() set(SHARED_LIBRARY TRUE) + add_flang_library(flang_shared ${FTN_INTRINSICS} ${FTN_SUPPORT} ${SHARED_SOURCES} ) + set_property(TARGET flang_shared PROPERTY OUTPUT_NAME flang) -target_link_libraries(flang_shared ${CMAKE_BINARY_DIR}/${CMAKE_CFG_INTDIR}/lib/libflangrti.so) +target_link_libraries(flang_shared flangrti_shared) + # Resolve symbols against libm and librt -target_link_libraries(flang_shared m rt) +if (NOT MSVC) + target_link_libraries(flang_shared rt m) +else() + set_target_properties(flang_shared PROPERTIES WINDOWS_EXPORT_ALL_SYMBOLS TRUE) +endif() set(SHARED_LIBRARY FALSE) @@ -505,13 +527,24 @@ set_property( HAVE_LONG_LONG_INT ) +if(WIN32) set_property( SOURCE ${FTN_SUPPORT} PROPERTY COMPILE_DEFINITIONS + TARGET_WIN_X8664 INT32PTR64 TM_I8 HAVE_LONG_LONG_INT ) +else() +set_property( + SOURCE ${FTN_SUPPORT} + PROPERTY COMPILE_DEFINITIONS + INT32PTR64 + TM_I8 + HAVE_LONG_LONG_INT + ) +endif() set_property( SOURCE initpar.c @@ -519,25 +552,6 @@ set_property( PG_PIC ) -## CMake does not handle module dependencies between Fortran files, -## we need to help it - -# State the module that the source is producing -set_source_files_properties( - iso_c_bind.F95 - PROPERTIES - OBJECT_OUTPUTS ${CMAKE_Fortran_MODULE_DIRECTORY}/iso_c_binding.mod - ) - -# State a dependency on the module -set_source_files_properties( - ieee_arithmetic.F95 - ieee_exceptions.F95 - PROPERTIES - OBJECT_DEPENDS ${CMAKE_Fortran_MODULE_DIRECTORY}/iso_c_binding.mod - ) - - set_target_properties(flang_static flang_shared PROPERTIES ARCHIVE_OUTPUT_DIRECTORY ${FLANG_RTE_LIB_DIR} @@ -567,9 +581,17 @@ add_dependencies(flang_shared flang2 ) -target_compile_options(flang_static PRIVATE -fPIC) +if (NOT MSVC) + target_compile_options(flang_static PRIVATE -fPIC) + target_compile_options(flang_shared PRIVATE -fPIC) +else() + # target_link_libraries(flang_shared Ws2_32.lib) + # target_link_libraries(flang_static Ws2_32.lib) -target_compile_options(flang_shared PRIVATE -fPIC) + set_target_properties(flang_static PROPERTIES LINKER_LANGUAGE CXX) + set_target_properties(flang_shared PROPERTIES LINKER_LANGUAGE CXX) + target_compile_options(flang_shared PUBLIC $<$:-DPGDLL>) +endif() target_compile_options(flang_static PUBLIC $<$:-Mreentrant>) diff --git a/runtime/flang/access3f.c b/runtime/flang/access3f.c index 7418d877dbc..42068eb272e 100644 --- a/runtime/flang/access3f.c +++ b/runtime/flang/access3f.c @@ -20,7 +20,9 @@ /* access3f.c - Implements LIB3F access subroutine. */ /* must include ent3f.h AFTER io3f.h */ +#ifndef _WIN32 #include +#endif #include "io3f.h" #include "ent3f.h" diff --git a/runtime/flang/amod.c b/runtime/flang/amod.c index f1225bd7fb9..4a042ec00af 100644 --- a/runtime/flang/amod.c +++ b/runtime/flang/amod.c @@ -17,16 +17,8 @@ #include "mthdecls.h" -#if defined(WIN64) -float __fmth_i_amod(float f, float g); -#endif - float __mth_i_amod(float f, float g) { -#if defined(WIN64) - return __fmth_i_amod(f, g); -#else return FMODF(f, g); -#endif } diff --git a/runtime/flang/async.c b/runtime/flang/async.c index 5e5c81918fb..7cbc5f6b09f 100644 --- a/runtime/flang/async.c +++ b/runtime/flang/async.c @@ -302,11 +302,11 @@ Fio_asy_read(struct asy *asy, void *adr, long len) tn = asy->outstanding_transactions; asy->overlap[tn].Internal = 0; asy->overlap[tn].InternalHigh = 0; - asy->overlap[tn].u.Pointer = 0; + asy->overlap[tn].Pointer = 0; /* Load asy->off into OffsetHigh/Offset */ converter.offset = asy->atd[tn].off; - asy->overlap[tn].u.s.Offset = converter.wOffset; - asy->overlap[tn].u.s.OffsetHigh = converter.wOffsetHigh; + asy->overlap[tn].Offset = converter.wOffset; + asy->overlap[tn].OffsetHigh = converter.wOffsetHigh; asy->overlap[tn].hEvent = 0; if (ReadFile(asy->handle, adr, len, NULL, &(asy->overlap[tn])) == FALSE && GetLastError() != ERROR_IO_PENDING) { @@ -356,11 +356,11 @@ Fio_asy_write(struct asy *asy, void *adr, long len) tn = asy->outstanding_transactions; asy->overlap[tn].Internal = 0; asy->overlap[tn].InternalHigh = 0; - asy->overlap[tn].u.Pointer = 0; + asy->overlap[tn].Pointer = 0; /* Load asy->off into OffsetHigh/Offset. */ converter.offset = asy->atd[0].off; - asy->overlap[tn].u.s.Offset = converter.wOffset; - asy->overlap[tn].u.s.OffsetHigh = converter.wOffsetHigh; + asy->overlap[tn].Offset = converter.wOffset; + asy->overlap[tn].OffsetHigh = converter.wOffsetHigh; asy->overlap[tn].hEvent = 0; if (WriteFile(asy->handle, adr, len, NULL, &(asy->overlap[tn])) == FALSE && GetLastError() != ERROR_IO_PENDING) { diff --git a/runtime/flang/buffer.c b/runtime/flang/buffer.c index 718650fce93..8bdefcf32de 100644 --- a/runtime/flang/buffer.c +++ b/runtime/flang/buffer.c @@ -18,10 +18,7 @@ /** \file * \brief FIXME */ - -#if !defined(PARAMID) && !defined(WINNT) #include -#endif #include "stdioInterf.h" #include "fioMacros.h" @@ -29,6 +26,10 @@ #define write _write #define creat _creat #define close _close +#define O_WRONLY _O_WRONLY +#define O_CREAT _O_CREAT +#define O_TRUNC _O_TRUNC +#include #endif #define MAXBUF 4096 diff --git a/runtime/flang/cdpowi.c b/runtime/flang/cdpowi.c index 317065554c0..4348f59e331 100644 --- a/runtime/flang/cdpowi.c +++ b/runtime/flang/cdpowi.c @@ -22,8 +22,11 @@ ZMPLXFUNC_Z_I(__mth_i_cdpowi) ZMPLXARGS_Z_I; int k; double fr, fi, gr, gi, tr, ti; - double complex z; + #ifndef _WIN32 static const double complex c1plusi0 = 1.0 + I*0; + #else + static const _Dcomplex c1plusi0 = {1.0, 0}; + #endif fr = 1; fi = 0; @@ -46,7 +49,11 @@ ZMPLXFUNC_Z_I(__mth_i_cdpowi) gi = ti; } - z = fr + I*fi; + #ifndef _WIN32 + double complex z = fr + I*fi; + #else + _Dcomplex z = {fr, fi}; + #endif if (i < 0) { ZMPLX_CALL_ZR_Z_Z(__mth_i_cddiv,z,c1plusi0,z); } diff --git a/runtime/flang/cdpowk.c b/runtime/flang/cdpowk.c index 679f7d34eb0..220aa27c20f 100644 --- a/runtime/flang/cdpowk.c +++ b/runtime/flang/cdpowk.c @@ -22,8 +22,11 @@ ZMPLXFUNC_Z_K(__mth_i_cdpowk) ZMPLXARGS_Z_K; long long k; double fr, fi, gr, gi, tr, ti; - double complex z; + #ifndef _WIN32 static const double complex c1plusi0 = 1.0 + I*0; + #else + static const _Dcomplex c1plusi0 = {1.0, 0}; + #endif fr = 1; fi = 0; @@ -46,7 +49,12 @@ ZMPLXFUNC_Z_K(__mth_i_cdpowk) gi = ti; } - z = fr + I*fi; + + #ifndef _WIN32 + double complex z = fr + I*fi; + #else + _Dcomplex z = {fr, fi}; + #endif if (i < 0) { ZMPLX_CALL_ZR_Z_Z(__mth_i_cddiv,z,c1plusi0,z); } diff --git a/runtime/flang/chdir3f.c b/runtime/flang/chdir3f.c index ff28ad0eb63..3006b187883 100644 --- a/runtime/flang/chdir3f.c +++ b/runtime/flang/chdir3f.c @@ -20,7 +20,9 @@ /* chdir3f.c - Implements LIB3F chdir subprogram. */ /* must include ent3f.h AFTER io3f.h */ +#ifndef _WIN32 #include +#endif #include "io3f.h" #include "ent3f.h" diff --git a/runtime/flang/close.c b/runtime/flang/close.c index dcdfc095c98..754e433d74d 100644 --- a/runtime/flang/close.c +++ b/runtime/flang/close.c @@ -23,7 +23,9 @@ #include #include "global.h" +#ifndef _WIN32 #include +#endif #include "stdioInterf.h" #if defined(WIN32) || defined(WIN64) diff --git a/runtime/flang/cplxf.c b/runtime/flang/cplxf.c index 6188bbd389e..3120e5c724e 100644 --- a/runtime/flang/cplxf.c +++ b/runtime/flang/cplxf.c @@ -20,8 +20,10 @@ #include "stdioInterf.h" #include "fioMacros.h" #include +#ifndef _WIN32 #include #include +#endif extern double __fort_second(); extern long __fort_getoptn(char *, long); diff --git a/runtime/flang/cpowi.c b/runtime/flang/cpowi.c index f6e768b9f26..73b425ad572 100644 --- a/runtime/flang/cpowi.c +++ b/runtime/flang/cpowi.c @@ -22,8 +22,11 @@ CMPLXFUNC_C_I(__mth_i_cpowi) CMPLXARGS_C_I; int k; float fr, fi, gr, gi, tr, ti; - float complex c; + #ifndef _WIN32 static const float complex c1plusi0 = 1.0 + I*0; + #else + static const _Fcomplex c1plusi0 = {1.0, 0}; + #endif fr = 1; fi = 0; @@ -46,7 +49,11 @@ CMPLXFUNC_C_I(__mth_i_cpowi) gi = ti; } - c = fr + I*fi; + #ifndef _WIN32 + float complex c = fr + I*fi; + #else + _Fcomplex c = {fr, fi}; + #endif if (i < 0) { CMPLX_CALL_CR_C_C(__mth_i_cdiv,c,c1plusi0,c); } diff --git a/runtime/flang/cpowk.c b/runtime/flang/cpowk.c index 86e5ad8873f..0edafaa7688 100644 --- a/runtime/flang/cpowk.c +++ b/runtime/flang/cpowk.c @@ -22,8 +22,11 @@ CMPLXFUNC_C_K(__mth_i_cpowk) CMPLXARGS_C_K; long long k; float fr, fi, gr, gi, tr, ti; - float complex c; + #ifndef _WIN32 static const float complex c1plusi0 = 1.0 + I*0; + #else + static const _Fcomplex c1plusi0 = {1.0, 0}; + #endif fr = 1; fi = 0; @@ -46,7 +49,11 @@ CMPLXFUNC_C_K(__mth_i_cpowk) gi = ti; } - c = fr + I*fi; + #ifndef _WIN32 + float complex c = fr + I*fi; + #else + _Fcomplex c = {fr, fi}; + #endif if (i < 0) { CMPLX_CALL_CR_C_C(__mth_i_cdiv,c,c1plusi0,c); } diff --git a/runtime/flang/curdir.c b/runtime/flang/curdir.c index dc1398a78d9..cad2fd40587 100644 --- a/runtime/flang/curdir.c +++ b/runtime/flang/curdir.c @@ -16,8 +16,12 @@ */ #include +#ifndef _WIN32 #include #include +#elif 0 +#include +#endif #include #include "stdioInterf.h" #include "fioMacros.h" @@ -100,9 +104,10 @@ void __fort_getdir(curdir) char *curdir; void __fort_gethostname(host) char *host; { - struct utsname un; char *p; int s; +#ifndef _WIN32 + struct utsname un; p = __fort_getopt("-curhost"); if (p == NULL) { @@ -112,5 +117,13 @@ void __fort_gethostname(host) char *host; } p = un.nodename; } +#elif 0 + s = gethostname(&p, 256); + if (s != 0) { + __fort_abortp("uname"); + } +#else + strcpy(p, "localhost"); +#endif strcpy(host, p); } diff --git a/runtime/flang/cvt.c b/runtime/flang/cvt.c index e4d5874c709..031fcf44307 100644 --- a/runtime/flang/cvt.c +++ b/runtime/flang/cvt.c @@ -15,10 +15,8 @@ * */ -#ifndef WIN64 #include #include -#endif #include #define IEEE 1 diff --git a/runtime/flang/dmod.c b/runtime/flang/dmod.c index 4e917c9ed7a..fbe9cee3ee4 100644 --- a/runtime/flang/dmod.c +++ b/runtime/flang/dmod.c @@ -25,7 +25,7 @@ double __mth_i_dmod(double f, double g) { /* Need to do this way until a bug in the Win64 fmod routine is fixed */ -#if defined(WIN64) +#if defined(WIN64) && 0 return __fmth_i_dmod(f, g); #else return fmod(f, g); diff --git a/runtime/flang/dtime3f.c b/runtime/flang/dtime3f.c index ec9589e54cf..2745e1aa1f9 100644 --- a/runtime/flang/dtime3f.c +++ b/runtime/flang/dtime3f.c @@ -24,13 +24,20 @@ #include "ent3f.h" #define _LIBC_LIMITS_H_ +#ifndef _WIN32 #include -#include #include +#endif +#include #include -#ifndef CLK_TCK -#define CLK_TCK sysconf(_SC_CLK_TCK) +#ifdef _WIN32 + #include "times_win32.h" + #define CLK_TCK 10000000.0 +#else + #ifndef CLK_TCK + #define CLK_TCK sysconf(_SC_CLK_TCK) + #endif #endif static clock_t accum_user = 0, accum_sys = 0; @@ -48,3 +55,4 @@ float ENT3F(DTIME, dtime)(float *tarray) return (tarray[0] + tarray[1]); } + diff --git a/runtime/flang/etime3f.c b/runtime/flang/etime3f.c index 6866cc2a9b1..e0931ee10e7 100644 --- a/runtime/flang/etime3f.c +++ b/runtime/flang/etime3f.c @@ -25,14 +25,22 @@ /* Not implemented for WINNT */ +#ifndef _WIN32 #include +#include +#endif #define _LIBC_LIMITS_H_ #include -#include #include -#ifndef CLK_TCK -#define CLK_TCK sysconf(_SC_CLK_TCK) + +#ifdef _WIN32 + #include "times_win32.h" + #define CLK_TCK 10000000.0 +#else + #ifndef CLK_TCK + #define CLK_TCK sysconf(_SC_CLK_TCK) + #endif #endif float ENT3F(ETIME, etime)(float *tarray) diff --git a/runtime/flang/fstat643f.c b/runtime/flang/fstat643f.c index 43a9dd9aefc..5317fe51d0b 100644 --- a/runtime/flang/fstat643f.c +++ b/runtime/flang/fstat643f.c @@ -136,6 +136,7 @@ int ENT3F(FSTAT64, fstat64)(int *lu, long long *statb) statb[10] = b.st_ctime; statb[11] = b.st_blksize; statb[12] = b.st_blocks; + return i; #endif } diff --git a/runtime/flang/fsync3f.c b/runtime/flang/fsync3f.c index 39c62995a46..ad12709df4e 100644 --- a/runtime/flang/fsync3f.c +++ b/runtime/flang/fsync3f.c @@ -30,6 +30,10 @@ void ENT3F(FSYNC, fsync)(lu) int *lu; f = __getfile3f(*lu); if (f) - fsync(__io_getfd(f)); + #ifndef _WIN32 + fsync(__io_getfd(f)); + #else + fflush(f); + #endif return; } diff --git a/runtime/flang/getpid3f.c b/runtime/flang/getpid3f.c index 6e7c256e3cf..c11999f6b5e 100644 --- a/runtime/flang/getpid3f.c +++ b/runtime/flang/getpid3f.c @@ -20,6 +20,7 @@ /* getpid3f.c - Implements LIB3F getpid subprogram. */ #include "ent3f.h" +#ifndef _WIN32 #include - +#endif int ENT3F(GETPID, getpid)() { return getpid(); } diff --git a/runtime/flang/global.h b/runtime/flang/global.h index c6706f8db64..3ca2a545dad 100644 --- a/runtime/flang/global.h +++ b/runtime/flang/global.h @@ -19,21 +19,27 @@ * \brief Global definitions and declarations for Fortran I/O library */ +#include "stdio.h" #include "fioMacros.h" #include "stdioInterf.h" /* stubbed version of stdio.h */ #include "cnfg.h" /* declarations for configuration items */ #define GBL_SIZE_T_FORMAT "zu" +#ifdef WIN32 +#define INT64 __FLANG_INT64 +#define UINT64 __FLANG_UINT64 +#endif + /* declarations needed where integer*8 & logical*8 are supported and * the natural integer is integer*4 (__BIGINT is __INT4). */ typedef int INT64[2]; typedef unsigned int UINT64[2]; - #define I64_MSH(t) t[1] #define I64_LSH(t) t[0] + extern int __ftn_32in64_; #ifndef LOCAL_DEBUG @@ -46,11 +52,6 @@ typedef unsigned short WCHAR; #define VOID void -WIN_MSVCRT_IMP char *WIN_CDECL getenv(const char *); -WIN_MSVCRT_IMP long WIN_CDECL strtol(const char *, char **, int); -WIN_MSVCRT_IMP char *WIN_CDECL strerror(int); -WIN_MSVCRT_IMP char *WIN_CDECL strstr(const char *, const char *); - typedef __INT_T INT; /* native integer at least 32 bits */ typedef unsigned int UINT; /* unsigned 32 bit native integer */ #define ISDIGIT(c) ((c) >= '0' && (c) <= '9') @@ -326,7 +327,7 @@ typedef struct { #include extern FIO_TBL fioFcbTbls; -#ifdef WINNT +#if 0 extern FIO_FCB *__get_fio_fcbs(void); #define GET_FIO_FCBS __get_fio_fcbs() #else diff --git a/runtime/flang/hand.c b/runtime/flang/hand.c index bc8b0b6d3d1..a207aa80a01 100644 --- a/runtime/flang/hand.c +++ b/runtime/flang/hand.c @@ -15,6 +15,7 @@ * */ +#ifndef _WIN32 #include #include "stdioInterf.h" #include "fioMacros.h" @@ -129,3 +130,10 @@ __fort_sethand() } } } + +#else +void +__fort_sethand() +{ +} +#endif \ No newline at end of file diff --git a/runtime/flang/heapinit.c b/runtime/flang/heapinit.c index e2e7584f72b..4d52452560b 100644 --- a/runtime/flang/heapinit.c +++ b/runtime/flang/heapinit.c @@ -14,7 +14,6 @@ * limitations under the License. * */ - #include #include "stdioInterf.h" #include "fioMacros.h" @@ -43,10 +42,14 @@ int val; void (*save)(); int *pi; +#ifndef _WIN32 save = signal(SIGBUS, sighand); +#endif pi = (int *)beg; while (pi < (int *)end) { *pi++ = val; } +#ifndef _WIN32 signal(SIGBUS, save); -} +#endif +} \ No newline at end of file diff --git a/runtime/flang/ieee_arithmetic.F95 b/runtime/flang/ieee_arithmetic.F95 index 1518b5be7e1..38f690fda3d 100644 --- a/runtime/flang/ieee_arithmetic.F95 +++ b/runtime/flang/ieee_arithmetic.F95 @@ -23,7 +23,7 @@ module IEEE_ARITHMETIC use ieee_exceptions - use, intrinsic :: iso_c_binding + use iso_c_binding #ifdef PGDLL !DEC$ ATTRIBUTES DLLEXPORT :: IEEE_ARITHMETIC #endif diff --git a/runtime/flang/ieee_exceptions.F95 b/runtime/flang/ieee_exceptions.F95 index 827aa0b1e87..5240a564694 100644 --- a/runtime/flang/ieee_exceptions.F95 +++ b/runtime/flang/ieee_exceptions.F95 @@ -21,6 +21,8 @@ #endif module IEEE_EXCEPTIONS + + use iso_c_binding #ifdef PGDLL !DEC$ ATTRIBUTES DLLEXPORT :: IEEE_EXCEPTIONS #endif diff --git a/runtime/flang/initpar.c b/runtime/flang/initpar.c index c185d9c1f0c..7f591fc74d8 100644 --- a/runtime/flang/initpar.c +++ b/runtime/flang/initpar.c @@ -25,7 +25,9 @@ #include #include #include +#ifndef _WIN32 #include +#endif #include "global.h" /* FIXME: HACK diff --git a/runtime/flang/iso_c_bind.F95 b/runtime/flang/iso_c_bind.F95 index 629d9d62a90..40454c1d619 100644 --- a/runtime/flang/iso_c_bind.F95 +++ b/runtime/flang/iso_c_bind.F95 @@ -42,6 +42,11 @@ module ISO_C_BINDING parameter ( C_INTPTR_T = 8 ) integer C_SIZE_T parameter ( C_SIZE_T = 8 ) + + #undef TARGET_LINUX_X8664 + #undef TARGET_OSX_X8664 + #undef TARGET_INTERIX_X8664 + #undef LINUX #endif #if defined(TARGET_LINUX_X8664) || defined(TARGET_OSX_X8664) || defined(TARGET_INTERIX_X8664) || defined(TARGET_LLVM_64) diff --git a/runtime/flang/map.c b/runtime/flang/map.c index 291e107556a..622eacdf2e5 100644 --- a/runtime/flang/map.c +++ b/runtime/flang/map.c @@ -19,7 +19,9 @@ #include "fioMacros.h" #include #include +#ifndef _WIN32 #include +#endif extern char *__fort_getopt(); diff --git a/runtime/flang/miscsup_com.c b/runtime/flang/miscsup_com.c index 451b7fd1517..053c5917db0 100644 --- a/runtime/flang/miscsup_com.c +++ b/runtime/flang/miscsup_com.c @@ -25,8 +25,12 @@ #include #include +#ifndef _WIN32 #include #include +#else +#include +#endif #include "stdioInterf.h" #include "fioMacros.h" #include "llcrit.h" diff --git a/runtime/flang/mmcmplx16.c b/runtime/flang/mmcmplx16.c index 02abe4fc00a..14529afa932 100644 --- a/runtime/flang/mmcmplx16.c +++ b/runtime/flang/mmcmplx16.c @@ -19,7 +19,7 @@ #include "stdioInterf.h" #include "fioMacros.h" -#include "complex.h" +#include "mthdecls.h" #define SMALL_ROWSA 10 #define SMALL_ROWSB 10 @@ -27,10 +27,10 @@ void ENTF90(MMUL_CMPLX16, mmul_cmplx16)(int ta, int tb, __POINT_T mra, __POINT_T ncb, - __POINT_T kab, double complex *alpha, - double complex a[], __POINT_T lda, double complex b[], - __POINT_T ldb, double complex *beta, - double complex c[], __POINT_T ldc) + __POINT_T kab, DOUBLE_COMPLEX_TYPE *alpha, + DOUBLE_COMPLEX_TYPE a[], __POINT_T lda, DOUBLE_COMPLEX_TYPE b[], + __POINT_T ldb, DOUBLE_COMPLEX_TYPE *beta, + DOUBLE_COMPLEX_TYPE c[], __POINT_T ldc) { /* * Notes on parameters @@ -66,13 +66,13 @@ void ENTF90(MMUL_CMPLX16, int bufr, bufc, loc, lor; int small_size = SMALL_ROWSA * SMALL_ROWSB * SMALL_COLSB; int tindex = 0; - double complex buffera[SMALL_ROWSA * SMALL_ROWSB]; - double complex bufferb[SMALL_COLSB * SMALL_ROWSB]; - double complex temp; + DOUBLE_COMPLEX_TYPE buffera[SMALL_ROWSA * SMALL_ROWSB]; + DOUBLE_COMPLEX_TYPE bufferb[SMALL_COLSB * SMALL_ROWSB]; + DOUBLE_COMPLEX_TYPE temp; void ftn_mvmul_cmplx16_(), ftn_vmmul_cmplx16_(); void ftn_mnaxnb_cmplx16_(), ftn_mnaxtb_cmplx16_(); void ftn_mtaxnb_cmplx16_(), ftn_mtaxtb_cmplx16_(); - double complex calpha, cbeta; + DOUBLE_COMPLEX_TYPE calpha, cbeta; /* * Small matrix multiply variables */ @@ -89,13 +89,13 @@ void ENTF90(MMUL_CMPLX16, colsa = kab; rowsb = kab; colsb = ncb; - if (calpha == 0.0) { - if (cbeta == 0.0) { + if (DOUBLE_COMPLEX_EQ_CC(calpha, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { cndx = 0; indx_strt = ldc; for (j = 0; j < ncb; j++) { for (i = 0; i < mra; i++) - c[cndx + i] = 0.0; + c[cndx + i] = DOUBLE_COMPLEX_CREATE(0.0, 0.0); cndx = indx_strt; indx_strt += ldc; } @@ -104,7 +104,7 @@ void ENTF90(MMUL_CMPLX16, indx_strt = ldc; for (j = 0; j < ncb; j++) { for (i = 0; i < mra; i++) - c[cndx + i] = cbeta * c[cndx + i]; + c[cndx + i] = DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx + i]); cndx = indx_strt; indx_strt += ldc; } @@ -137,30 +137,30 @@ void ENTF90(MMUL_CMPLX16, andx = astrt; indx = 0; for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = DOUBLE_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; /* Now use the transposed row on all of b */ - if (cbeta == 0.0) { + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; c[cndx] = temp; cndx += ldc; } } else { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; - c[cndx] = temp + cbeta * c[cndx]; + c[cndx] = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx])); cndx += ldc; } } @@ -190,7 +190,7 @@ void ENTF90(MMUL_CMPLX16, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = conjf(b[bndx++]); + bufferb[indx] = conj(b[bndx++]); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), // cimagf( bufferb[indx] ) ); indx += rowsb; @@ -202,7 +202,7 @@ void ENTF90(MMUL_CMPLX16, /* Now muliply the transposed b matrix by a */ - if (cbeta == 0.0) { /* beta == 0.0 */ + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0.0 */ astrt = 0; indx = 0; cstrt = 0; @@ -219,10 +219,10 @@ void ENTF90(MMUL_CMPLX16, cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; - c[cndx] = calpha * temp; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); + c[cndx] = DOUBLE_COMPLEX_MUL_CC(calpha, temp); cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); @@ -247,10 +247,10 @@ void ENTF90(MMUL_CMPLX16, cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; - c[cndx] = cbeta * c[cndx] + calpha * temp; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); + c[cndx] = DOUBLE_COMPLEX_ADD_CC(DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx]), DOUBLE_COMPLEX_MUL_CC(calpha, temp)); cndx += ldc; } cstrt++; /* set index for next row of c */ @@ -264,17 +264,17 @@ void ENTF90(MMUL_CMPLX16, if (tb == 0) { astrt = 0; cstrt = 0; - if (cbeta == 0.0) { /* beta == 0 */ + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0 */ for (i = 0; i < rowsa; i++) { cndx = cstrt; bstrt = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; andx = astrt; for (k = 0; k < rowsb; k++) - temp += a[andx++] * b[bndx++]; - c[cndx] = calpha * temp; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(a[andx++], b[bndx++])); + c[cndx] = DOUBLE_COMPLEX_MUL_CC(calpha, temp); // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); @@ -293,15 +293,15 @@ void ENTF90(MMUL_CMPLX16, bstrt = 0; ; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; andx = astrt; for (k = 0; k < rowsb; k++) { - temp += a[andx] * b[bndx]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(a[andx], b[bndx])); andx++; bndx++; } - c[cndx] = cbeta * c[cndx] + calpha * temp; + c[cndx] = DOUBLE_COMPLEX_ADD_CC(DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx]), DOUBLE_COMPLEX_MUL_CC(calpha, temp)); // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( c[cndx] ) ); bstrt += ldb; cndx += ldc; @@ -318,7 +318,7 @@ void ENTF90(MMUL_CMPLX16, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * b[bndx++]; + bufferb[indx] = DOUBLE_COMPLEX_MUL_CC(calpha, b[bndx++]); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), cimagf( // bufferb[indx] ) ); indx += rowsb; @@ -333,7 +333,7 @@ void ENTF90(MMUL_CMPLX16, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * conjf(b[bndx++]); + bufferb[indx] = DOUBLE_COMPLEX_MUL_CC(calpha, conj(b[bndx++])); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), // cimagf( bufferb[indx] ) ); indx += rowsb; @@ -345,7 +345,7 @@ void ENTF90(MMUL_CMPLX16, /* Now muliply the transposed b matrix by a, which is transposed */ - if (cbeta == 0.0) { /* beta == 0.0 */ + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0.0 */ astrt = 0; indx = 0; cstrt = 0; @@ -355,10 +355,10 @@ void ENTF90(MMUL_CMPLX16, bufferb */ cndx = cstrt; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); andx = astrt; for (k = 0; k < rowsb; k++) - temp += a[andx++] * bufferb[indx++]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(a[andx++], bufferb[indx++])); c[cndx] = temp; cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( @@ -380,11 +380,11 @@ void ENTF90(MMUL_CMPLX16, cndx = cstrt; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); andx = astrt; for (k = 0; k < rowsb; k++) - temp += a[andx++] * bufferb[indx++]; - c[cndx] = cbeta * c[cndx] + temp; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(a[andx++], bufferb[indx++])); + c[cndx] = DOUBLE_COMPLEX_ADD_CC(DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx]), temp); cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); @@ -404,18 +404,18 @@ void ENTF90(MMUL_CMPLX16, andx = astrt; indx = 0; for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = DOUBLE_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; /* Now use the transposed row on all of b */ - if (cbeta == 0.0) { + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; c[cndx] = temp; cndx += ldc; @@ -423,12 +423,12 @@ void ENTF90(MMUL_CMPLX16, cstrt++; /* set index for next row of c */ } else { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; - c[cndx] = temp + cbeta * c[cndx]; + c[cndx] = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx])); cndx += ldc; } cstrt++; /* set index for next row of c */ @@ -442,7 +442,7 @@ void ENTF90(MMUL_CMPLX16, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * b[bndx++]; + bufferb[indx] = DOUBLE_COMPLEX_MUL_CC(calpha, b[bndx++]); // printf( "( %f, %f )\n", crealf( // bufferb[indx] ), cimagf( bufferb[indx] ) ); @@ -458,7 +458,7 @@ void ENTF90(MMUL_CMPLX16, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * conjf(b[bndx++]); + bufferb[indx] = DOUBLE_COMPLEX_MUL_CC(calpha, conj(b[bndx++])); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), // cimagf( bufferb[indx] ) ); indx += rowsb; @@ -470,7 +470,7 @@ void ENTF90(MMUL_CMPLX16, /* Now muliply the transposed b matrix by a */ - if (cbeta == 0.0) { /* beta == 0.0 */ + if (DOUBLE_COMPLEX_EQ_CC(cbeta, DOUBLE_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0.0 */ astrt = 0; indx = 0; cstrt = 0; @@ -480,16 +480,16 @@ void ENTF90(MMUL_CMPLX16, indx = 0; /* indx will be used for accessing both buffera and bufferb */ for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = DOUBLE_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); c[cndx] = temp; cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( @@ -508,17 +508,17 @@ void ENTF90(MMUL_CMPLX16, indx = 0; /* indx will be used for accessing both buffera and bufferb */ for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = DOUBLE_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = DOUBLE_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; - c[cndx] = cbeta * c[cndx] + temp; + temp = DOUBLE_COMPLEX_ADD_CC(temp, DOUBLE_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); + c[cndx] = DOUBLE_COMPLEX_ADD_CC(DOUBLE_COMPLEX_MUL_CC(cbeta, c[cndx]), temp); // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); cndx += ldc; @@ -556,4 +556,4 @@ void ENTF90(MMUL_CMPLX16, } } -} +} \ No newline at end of file diff --git a/runtime/flang/mmcmplx8.c b/runtime/flang/mmcmplx8.c index 601210d9c39..ecfe9fd3245 100644 --- a/runtime/flang/mmcmplx8.c +++ b/runtime/flang/mmcmplx8.c @@ -19,7 +19,7 @@ #include "stdioInterf.h" #include "fioMacros.h" -#include "complex.h" +#include "mthdecls.h" #define SMALL_ROWSA 10 #define SMALL_ROWSB 10 @@ -27,9 +27,9 @@ void ENTF90(MMUL_CMPLX8, mmul_cmplx8)(int ta, int tb, __POINT_T mra, __POINT_T ncb, - __POINT_T kab, float complex *alpha, float complex a[], - __POINT_T lda, float complex b[], __POINT_T ldb, - float complex *beta, float complex c[], __POINT_T ldc) + __POINT_T kab, FLOAT_COMPLEX_TYPE *alpha, FLOAT_COMPLEX_TYPE a[], + __POINT_T lda, FLOAT_COMPLEX_TYPE b[], __POINT_T ldb, + FLOAT_COMPLEX_TYPE *beta, FLOAT_COMPLEX_TYPE c[], __POINT_T ldc) { /* * Notes on parameters @@ -65,13 +65,13 @@ void ENTF90(MMUL_CMPLX8, int bufr, bufc, loc, lor; int small_size = SMALL_ROWSA * SMALL_ROWSB * SMALL_COLSB; int tindex = 0; - float complex buffera[SMALL_ROWSA * SMALL_ROWSB]; - float complex bufferb[SMALL_COLSB * SMALL_ROWSB]; - float complex temp; + FLOAT_COMPLEX_TYPE buffera[SMALL_ROWSA * SMALL_ROWSB]; + FLOAT_COMPLEX_TYPE bufferb[SMALL_COLSB * SMALL_ROWSB]; + FLOAT_COMPLEX_TYPE temp; void ftn_mvmul_cmplx8_(), ftn_vmmul_cmplx8_(); void ftn_mnaxnb_cmplx8_(), ftn_mnaxtb_cmplx8_(); void ftn_mtaxnb_cmplx8_(), ftn_mtaxtb_cmplx8_(); - float complex calpha, cbeta; + FLOAT_COMPLEX_TYPE calpha, cbeta; /* * Small matrix multiply variables */ @@ -88,13 +88,13 @@ void ENTF90(MMUL_CMPLX8, colsa = kab; rowsb = kab; colsb = ncb; - if (calpha == 0.0) { - if (cbeta == 0.0) { + if (FLOAT_COMPLEX_EQ_CC(calpha, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { cndx = 0; indx_strt = ldc; for (j = 0; j < ncb; j++) { for (i = 0; i < mra; i++) - c[cndx + i] = 0.0; + c[cndx + i] = FLOAT_COMPLEX_CREATE(0.0, 0.0); cndx = indx_strt; indx_strt += ldc; } @@ -103,7 +103,7 @@ void ENTF90(MMUL_CMPLX8, indx_strt = ldc; for (j = 0; j < ncb; j++) { for (i = 0; i < mra; i++) - c[cndx + i] = cbeta * c[cndx + i]; + c[cndx + i] = FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx + i]); cndx = indx_strt; indx_strt += ldc; } @@ -136,30 +136,30 @@ void ENTF90(MMUL_CMPLX8, andx = astrt; indx = 0; for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = FLOAT_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; /* Now use the transposed row on all of b */ - if (cbeta == 0.0) { + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; c[cndx] = temp; cndx += ldc; } } else { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; - c[cndx] = temp + cbeta * c[cndx]; + c[cndx] = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx])); cndx += ldc; } } @@ -201,7 +201,7 @@ void ENTF90(MMUL_CMPLX8, /* Now muliply the transposed b matrix by a */ - if (cbeta == 0.0) { /* beta == 0.0 */ + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0.0 */ astrt = 0; indx = 0; cstrt = 0; @@ -218,10 +218,10 @@ void ENTF90(MMUL_CMPLX8, cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; - c[cndx] = calpha * temp; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); + c[cndx] = FLOAT_COMPLEX_MUL_CC(calpha, temp); cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); @@ -246,10 +246,10 @@ void ENTF90(MMUL_CMPLX8, cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; - c[cndx] = cbeta * c[cndx] + calpha * temp; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); + c[cndx] = FLOAT_COMPLEX_ADD_CC(FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx]), FLOAT_COMPLEX_MUL_CC(calpha, temp)); cndx += ldc; } cstrt++; /* set index for next row of c */ @@ -263,17 +263,17 @@ void ENTF90(MMUL_CMPLX8, if (tb == 0) { astrt = 0; cstrt = 0; - if (cbeta == 0.0) { /* beta == 0 */ + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0 */ for (i = 0; i < rowsa; i++) { cndx = cstrt; bstrt = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; andx = astrt; for (k = 0; k < rowsb; k++) - temp += a[andx++] * b[bndx++]; - c[cndx] = calpha * temp; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(a[andx++], b[bndx++])); + c[cndx] = FLOAT_COMPLEX_ADD_CC(calpha, temp); // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); @@ -292,15 +292,15 @@ void ENTF90(MMUL_CMPLX8, bstrt = 0; ; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; andx = astrt; for (k = 0; k < rowsb; k++) { - temp += a[andx] * b[bndx]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(a[andx], b[bndx])); andx++; bndx++; } - c[cndx] = cbeta * c[cndx] + calpha * temp; + c[cndx] = FLOAT_COMPLEX_ADD_CC(FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx]), FLOAT_COMPLEX_MUL_CC(calpha, temp)); // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( c[cndx] ) ); bstrt += ldb; cndx += ldc; @@ -317,7 +317,7 @@ void ENTF90(MMUL_CMPLX8, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * b[bndx++]; + bufferb[indx] = FLOAT_COMPLEX_MUL_CC(calpha, b[bndx++]); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), cimagf( // bufferb[indx] ) ); indx += rowsb; @@ -332,7 +332,7 @@ void ENTF90(MMUL_CMPLX8, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * conjf(b[bndx++]); + bufferb[indx] = FLOAT_COMPLEX_MUL_CC(calpha, conjf(b[bndx++])); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), // cimagf( bufferb[indx] ) ); indx += rowsb; @@ -344,7 +344,7 @@ void ENTF90(MMUL_CMPLX8, /* Now muliply the transposed b matrix by a, which is transposed */ - if (cbeta == 0.0) { /* beta == 0.0 */ + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0.0 */ astrt = 0; indx = 0; cstrt = 0; @@ -354,10 +354,10 @@ void ENTF90(MMUL_CMPLX8, bufferb */ cndx = cstrt; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); andx = astrt; for (k = 0; k < rowsb; k++) - temp += a[andx++] * bufferb[indx++]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(a[andx++], bufferb[indx++])); c[cndx] = temp; cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( @@ -379,11 +379,11 @@ void ENTF90(MMUL_CMPLX8, cndx = cstrt; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); andx = astrt; for (k = 0; k < rowsb; k++) - temp += a[andx++] * bufferb[indx++]; - c[cndx] = cbeta * c[cndx] + temp; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(a[andx++], bufferb[indx++])); + c[cndx] = FLOAT_COMPLEX_ADD_CC(FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx]), temp); cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); @@ -403,18 +403,18 @@ void ENTF90(MMUL_CMPLX8, andx = astrt; indx = 0; for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = FLOAT_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; /* Now use the transposed row on all of b */ - if (cbeta == 0.0) { + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; c[cndx] = temp; cndx += ldc; @@ -422,12 +422,12 @@ void ENTF90(MMUL_CMPLX8, cstrt++; /* set index for next row of c */ } else { for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); bndx = bstrt; for (k = 0; k < rowsb; k++) - temp += buffera[k] * b[bndx++]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], b[bndx++])); bstrt += ldb; - c[cndx] = temp + cbeta * c[cndx]; + c[cndx] = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx])); cndx += ldc; } cstrt++; /* set index for next row of c */ @@ -441,7 +441,7 @@ void ENTF90(MMUL_CMPLX8, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * b[bndx++]; + bufferb[indx] = FLOAT_COMPLEX_MUL_CC(calpha, b[bndx++]); // printf( "( %f, %f )\n", crealf( // bufferb[indx] ), cimagf( bufferb[indx] ) ); @@ -457,7 +457,7 @@ void ENTF90(MMUL_CMPLX8, indx = indx_strt; bndx = bstrt; for (i = 0; i < colsb; i++) { - bufferb[indx] = calpha * conjf(b[bndx++]); + bufferb[indx] = FLOAT_COMPLEX_MUL_CC(calpha, conjf(b[bndx++])); // printf( "( %f, %f )\n", crealf( bufferb[indx] ), // cimagf( bufferb[indx] ) ); indx += rowsb; @@ -469,7 +469,7 @@ void ENTF90(MMUL_CMPLX8, /* Now muliply the transposed b matrix by a */ - if (cbeta == 0.0) { /* beta == 0.0 */ + if (FLOAT_COMPLEX_EQ_CC(cbeta, FLOAT_COMPLEX_CREATE(0.0, 0.0))) { /* beta == 0.0 */ astrt = 0; indx = 0; cstrt = 0; @@ -479,16 +479,16 @@ void ENTF90(MMUL_CMPLX8, indx = 0; /* indx will be used for accessing both buffera and bufferb */ for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = FLOAT_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); c[cndx] = temp; cndx += ldc; // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( @@ -507,17 +507,17 @@ void ENTF90(MMUL_CMPLX8, indx = 0; /* indx will be used for accessing both buffera and bufferb */ for (ja = 0; ja < colsa; ja++) { - buffera[indx++] = calpha * a[andx]; + buffera[indx++] = FLOAT_COMPLEX_MUL_CC(calpha, a[andx]); andx += lda; } astrt++; cndx = cstrt; indx = 0; for (j = 0; j < colsb; j++) { - temp = 0.0; + temp = FLOAT_COMPLEX_CREATE(0.0, 0.0); for (k = 0; k < rowsb; k++) - temp += buffera[k] * bufferb[indx++]; - c[cndx] = cbeta * c[cndx] + temp; + temp = FLOAT_COMPLEX_ADD_CC(temp, FLOAT_COMPLEX_MUL_CC(buffera[k], bufferb[indx++])); + c[cndx] = FLOAT_COMPLEX_ADD_CC(FLOAT_COMPLEX_MUL_CC(cbeta, c[cndx]), temp); // printf( "( %f, %f )\n", crealf( c[cndx] ), cimagf( // c[cndx] ) ); cndx += ldc; @@ -556,4 +556,3 @@ void ENTF90(MMUL_CMPLX8, } } - diff --git a/runtime/flang/open.c b/runtime/flang/open.c index 98860b5377f..48b28950768 100644 --- a/runtime/flang/open.c +++ b/runtime/flang/open.c @@ -32,6 +32,7 @@ #if defined(WIN32) || defined(WIN64) #define access _access +#define unlink _unlink #endif static FIO_FCB *Fcb; /* pointer to the file control block */ diff --git a/runtime/flang/rename3f.c b/runtime/flang/rename3f.c index dbedff0c429..9cd0cc460c3 100644 --- a/runtime/flang/rename3f.c +++ b/runtime/flang/rename3f.c @@ -23,7 +23,6 @@ #include "io3f.h" #include "ent3f.h" -extern int rename(); extern char *__fstr2cstr(); extern void __cstr_free(); diff --git a/runtime/flang/sleep3f.c b/runtime/flang/sleep3f.c index 8b74e306ba4..256913299ce 100644 --- a/runtime/flang/sleep3f.c +++ b/runtime/flang/sleep3f.c @@ -19,7 +19,9 @@ /* sleep3f.c - Implements LIB3F sleep subprogram. */ +#ifndef _WIN32 #include +#endif #include "ent3f.h" #if defined(WIN64) || defined(WIN32) diff --git a/runtime/flang/sleepqq3f.c b/runtime/flang/sleepqq3f.c index fd05977bc12..9dbfbf7a0e9 100644 --- a/runtime/flang/sleepqq3f.c +++ b/runtime/flang/sleepqq3f.c @@ -19,7 +19,9 @@ /* sleep3f.c - Implements DFPORT SLEEPQQ subprogram. */ +#ifndef _WIN32 #include +#endif #include "ent3f.h" #if defined(WIN64) || defined(WIN32) diff --git a/runtime/flang/stat_linux.c b/runtime/flang/stat_linux.c index d3358f0c25f..d81d34e2a92 100644 --- a/runtime/flang/stat_linux.c +++ b/runtime/flang/stat_linux.c @@ -19,11 +19,13 @@ * \brief Fill in statistics structure (Linux version) */ +#ifndef _WIN32 #include #include #include -#include #include +#endif +#include #include "timeBlk.h" #include "fioMacros.h" @@ -43,14 +45,17 @@ __fort_setarg(void) static void nodename(s) char *s; { +#ifndef _WIN32 struct utsname u0; uname(&u0); strcpy(s, u0.nodename); +#endif } void __fort_gettb(t) struct tb *t; { +#ifndef _WIN32 struct timeval tv0; struct timezone tz0; struct rusage rs0, rc0; @@ -98,6 +103,7 @@ void __fort_gettb(t) struct tb *t; t->sbrk = (double)((long)sbrk(0)); t->gsbrk = (GET_DIST_HEAPZ == 0 ? 0.0 : (double)((long)__fort_sbrk(0))); nodename(t->host); +#endif } static double first = 0.0; @@ -105,6 +111,7 @@ static double first = 0.0; double __fort_second() { +#ifndef _WIN32 struct timeval v; struct timezone t; double d; @@ -119,6 +126,7 @@ __fort_second() first = d; } return (d - first); +#endif } void diff --git a/runtime/flang/timef3f.c b/runtime/flang/timef3f.c index 9d2a461a54e..342fa6e8b0d 100644 --- a/runtime/flang/timef3f.c +++ b/runtime/flang/timef3f.c @@ -23,10 +23,13 @@ /* how do we do this for WINNT */ #include "ent3f.h" +#ifndef _WIN32 #define _LIBC_LIMITS_H_ +#ifndef _WIN32 #include -#include #include +#endif +#include #include #ifndef CLK_TCK @@ -52,4 +55,4 @@ double ENT3F(TIMEF, timef)(float *tarray) duration = ((double)(current - start)) * inv_ticks; return duration; } - +#endif diff --git a/runtime/flang/usrio_smp.c b/runtime/flang/usrio_smp.c index e2584e8baf2..9452f690334 100644 --- a/runtime/flang/usrio_smp.c +++ b/runtime/flang/usrio_smp.c @@ -20,7 +20,7 @@ * a common system buffer pool and that the buffers are kept consistent. * It also works for some other systems such as the Paragon. */ - +#ifndef _WIN32 #include #include @@ -210,4 +210,4 @@ __fort_par_unlink(char *fn) } __fort_barrier(); } - +#endif diff --git a/runtime/flang/util.c b/runtime/flang/util.c index 7435d0533d2..8d122523475 100644 --- a/runtime/flang/util.c +++ b/runtime/flang/util.c @@ -331,3 +331,30 @@ void __fort_ftnstrcpy(char *dst, /* destination string, blank-filled */ *dst++ = ' '; } + +#ifdef _WIN32 +#include "times_win32.h" + +clock_t convert_filetime( const FILETIME *ac_FileTime ) +{ + ULARGE_INTEGER lv_Large ; + + lv_Large.LowPart = ac_FileTime->dwLowDateTime ; + lv_Large.HighPart = ac_FileTime->dwHighDateTime ; + + return (clock_t)lv_Large.QuadPart ; +} + +/* + Thin emulation of the unix times function +*/ +void times(tms *time_struct) { + FILETIME time_create, time_exit, accum_sys, accum_user; + + GetProcessTimes( GetCurrentProcess(), + &time_create, &time_exit, &accum_sys, &accum_user ); + + time_struct->tms_utime = convert_filetime(&accum_user); + time_struct->tms_stime = convert_filetime(&accum_sys); +} +#endif diff --git a/runtime/flang/utils.c b/runtime/flang/utils.c index 6879a1de2bf..d57167ce8e0 100644 --- a/runtime/flang/utils.c +++ b/runtime/flang/utils.c @@ -19,6 +19,13 @@ * \brief Utility functions for fortran i.o. */ +#ifdef _WIN32 +#include +#include +#include +#include +#include +#endif #include #include "global.h" #include "open_close.h" @@ -595,3 +602,63 @@ __fortio_trunc(FIO_FCB *p, seekoffx_t length) } return 0; } + +#ifdef _WIN32 +void +sincos(double x, double *sine, double *cosine) { + *sine = sin(x); + *cosine = cos(x); +} + +void +sincosf(float x, float *sine, float *cosine) { + *sine = sinf(x); + *cosine = cosf(x); +} + +int ftruncate(int fd, __int64 length) { + _chsize_s(fd, length); +} + +struct timezone +{ + int tz_minuteswest; /* minutes W of Greenwich */ + int tz_dsttime; /* type of dst correction */ +}; + +#define EPOCHFILETIME (116444736000000000LL) + +int +gettimeofday(struct timeval *tv, struct timezone *tz) +{ + FILETIME ft; + LARGE_INTEGER li; + __int64 t; + static int tzflag; + + if(tv) + { + GetSystemTimeAsFileTime(&ft); + li.LowPart = ft.dwLowDateTime; + li.HighPart = ft.dwHighDateTime; + t = li.QuadPart; + t -= EPOCHFILETIME; + t /= 10; + tv->tv_sec = (long)(t / 1000000); + tv->tv_usec = (long)(t % 1000000); + } + + if (tz) + { + if (!tzflag) + { + _tzset(); + tzflag++; + } + tz->tz_minuteswest = _timezone / 60; + tz->tz_dsttime = _daylight; + } + + return 0; +} +#endif diff --git a/runtime/flang/xfer_heap_dum.c b/runtime/flang/xfer_heap_dum.c index 049330a391c..636f1440357 100644 --- a/runtime/flang/xfer_heap_dum.c +++ b/runtime/flang/xfer_heap_dum.c @@ -26,7 +26,9 @@ extern char *sbrk(int); char * __fort_sbrk(int len) { +#ifndef _WIN32 return (sbrk(len)); +#endif } /* verify block is in global heap */ diff --git a/runtime/flangmain/flangmain.c b/runtime/flangmain/flangmain.c index e006cac673a..64fb5f508e0 100644 --- a/runtime/flangmain/flangmain.c +++ b/runtime/flangmain/flangmain.c @@ -57,7 +57,7 @@ char **argv; int i = 0; #if (defined(INTERIX86) || defined(INTERIX8664) || defined(WIN64) || defined(WIN32) || defined(TARGET_OSX_X86)) - _pgimain(argc, argv); + //_pgimain(argc, argv); #endif __io_set_argc(argc); diff --git a/runtime/flangrti/CMakeLists.txt b/runtime/flangrti/CMakeLists.txt index 8688642cf44..547ead089f4 100644 --- a/runtime/flangrti/CMakeLists.txt +++ b/runtime/flangrti/CMakeLists.txt @@ -179,8 +179,17 @@ add_flang_library(flangrti_static ${PGC_SRC_FILES} ${SHARED_SOURCES} ) -set_property(TARGET flangrti_static PROPERTY OUTPUT_NAME flangrti) +if (MSVC) + set_property(TARGET flangrti_static PROPERTY OUTPUT_NAME libflangrti) +else() + set_property(TARGET flangrti_static PROPERTY OUTPUT_NAME flangrti) +endif() + +target_include_directories(flangrti_static + PRIVATE + ${CMAKE_CURRENT_SOURCE_DIR} +) set(SHARED_LIBRARY TRUE) add_flang_library(flangrti_shared @@ -188,16 +197,20 @@ add_flang_library(flangrti_shared ${SHARED_SOURCES} ) + # Resolve symbols against libm -target_link_libraries(flangrti_shared m) + +if (NOT MSVC) +target_link_libraries(flangrti_shared PUBLIC m) +endif() # Import OpenMP if (NOT DEFINED LIBOMP_EXPORT_DIR) find_library( FLANG_LIBOMP - libomp.so + NAMES omp libomp HINTS ${CMAKE_BINARY_DIR}/lib) - target_link_libraries(flangrti_shared ${FLANG_LIBOMP}) + target_link_libraries(flangrti_shared PUBLIC ${FLANG_LIBOMP}) endif() if( ${TARGET_ARCHITECTURE} STREQUAL "aarch64" ) @@ -215,18 +228,24 @@ target_include_directories(flangrti_static PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} ) - + target_include_directories(flangrti_shared PRIVATE ${CMAKE_CURRENT_SOURCE_DIR} - ) +) set_target_properties(flangrti_shared flangrti_static PROPERTIES ARCHIVE_OUTPUT_DIRECTORY ${FLANG_RTE_LIB_DIR}) -target_compile_options(flangrti_static PRIVATE -fPIC) +if (NOT MSVC) + target_compile_options(flangrti_static PRIVATE -fPIC) + target_compile_options(flangrti_shared PRIVATE -fPIC) +else() + set_target_properties(flangrti_shared PROPERTIES WINDOWS_EXPORT_ALL_SYMBOLS TRUE) -target_compile_options(flangrti_shared PRIVATE -fPIC) + # target_link_libraries(flangrti_shared PRIVATE Dbghelp.lib) + # target_link_libraries(flangrti_static PRIVATE Dbghelp.lib) +endif() target_compile_options(flangrti_static PUBLIC $<$:-Mreentrant>) diff --git a/runtime/flangrti/around.c b/runtime/flangrti/around.c index 9d9e419aacd..39c08862476 100644 --- a/runtime/flangrti/around.c +++ b/runtime/flangrti/around.c @@ -16,11 +16,10 @@ */ #include "mthdecls.h" - -extern float roundf(float); +#include float __mth_i_around(float x) { - return roundf(x); + return rintf(x); } diff --git a/runtime/flangrti/cacos.c b/runtime/flangrti/cacos.c index ce0bb89090d..48a11054d20 100644 --- a/runtime/flangrti/cacos.c +++ b/runtime/flangrti/cacos.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_cacos) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CACOSF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/casin.c b/runtime/flangrti/casin.c index 35fe17f5c6a..b99a6e38248 100644 --- a/runtime/flangrti/casin.c +++ b/runtime/flangrti/casin.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_casin) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CASINF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/catan.c b/runtime/flangrti/catan.c index 981447f5b45..17d2ec0ed0e 100644 --- a/runtime/flangrti/catan.c +++ b/runtime/flangrti/catan.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_catan) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CATANF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/ccosh.c b/runtime/flangrti/ccosh.c index 3f7b93c1d87..efb5f6e67a1 100644 --- a/runtime/flangrti/ccosh.c +++ b/runtime/flangrti/ccosh.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_ccosh) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CCOSHF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/cdacos.c b/runtime/flangrti/cdacos.c index 797b392ea78..4347b9a16f5 100644 --- a/runtime/flangrti/cdacos.c +++ b/runtime/flangrti/cdacos.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdacos) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = cacos(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/cdasin.c b/runtime/flangrti/cdasin.c index 0b1ecfb1173..21dfea1f8b8 100644 --- a/runtime/flangrti/cdasin.c +++ b/runtime/flangrti/cdasin.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdasin) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = casin(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/cdatan.c b/runtime/flangrti/cdatan.c index 624c2cd4c2f..258accf0a34 100644 --- a/runtime/flangrti/cdatan.c +++ b/runtime/flangrti/cdatan.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdatan) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = catan(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/cdcosh.c b/runtime/flangrti/cdcosh.c index 76c13f5b7ec..1c571c95fee 100644 --- a/runtime/flangrti/cdcosh.c +++ b/runtime/flangrti/cdcosh.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdcosh) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = ccosh(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/cdsinh.c b/runtime/flangrti/cdsinh.c index 8ed38e12d8e..e3b855aadcd 100644 --- a/runtime/flangrti/cdsinh.c +++ b/runtime/flangrti/cdsinh.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdsinh) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = csinh(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/cdtan.c b/runtime/flangrti/cdtan.c index 949ac867594..7fd15fe306c 100644 --- a/runtime/flangrti/cdtan.c +++ b/runtime/flangrti/cdtan.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdtan) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = ctan(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/cdtanh.c b/runtime/flangrti/cdtanh.c index da655c2d03f..3a30f9d8d6a 100644 --- a/runtime/flangrti/cdtanh.c +++ b/runtime/flangrti/cdtanh.c @@ -23,7 +23,11 @@ ZMPLXFUNC_Z(__mth_i_cdtanh) { ZMPLXARGS_Z; + #ifndef _WIN32 complex double d = real + imag * I; + #else + _Dcomplex d = {real, imag}; + #endif d = ctanh(d); ZRETURN_Z(d); } diff --git a/runtime/flangrti/csinh.c b/runtime/flangrti/csinh.c index e0a8ad003fe..cf49a42716c 100644 --- a/runtime/flangrti/csinh.c +++ b/runtime/flangrti/csinh.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_csinh) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CSINHF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/ctan.c b/runtime/flangrti/ctan.c index f23277944f9..acea489a8f0 100644 --- a/runtime/flangrti/ctan.c +++ b/runtime/flangrti/ctan.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_ctan) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CTANF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/ctanh.c b/runtime/flangrti/ctanh.c index b2618fbef76..0aee5f808ce 100644 --- a/runtime/flangrti/ctanh.c +++ b/runtime/flangrti/ctanh.c @@ -23,7 +23,11 @@ CMPLXFUNC_C(__mth_i_ctanh) { CMPLXARGS_C; + #ifndef _WIN32 complex float f = real + imag * I; + #else + _Fcomplex f = {real, imag}; + #endif f = CTANHF(f); CRETURN_C(f); } diff --git a/runtime/flangrti/dround.c b/runtime/flangrti/dround.c index 57745f16f95..46172c6dcfb 100644 --- a/runtime/flangrti/dround.c +++ b/runtime/flangrti/dround.c @@ -16,11 +16,10 @@ */ #include "mthdecls.h" - -extern double round(double); +#include double __mth_i_dround(double x) { - return round(x); + return rint(x); } diff --git a/runtime/flangrti/fltmanip.c b/runtime/flangrti/fltmanip.c index 94319e0bac0..2bbb9340ae7 100644 --- a/runtime/flangrti/fltmanip.c +++ b/runtime/flangrti/fltmanip.c @@ -359,16 +359,6 @@ nearbyintf(float x) return __nearbyintf(x); } double -rint(double x) -{ - return __nearbyint(x); -} -float -rintf(float x) -{ - return __nearbyintf(x); -} -double remainder(double x, double y) { return __remainder(x, y); diff --git a/runtime/flangrti/iostdinit.c b/runtime/flangrti/iostdinit.c index c2e5ad1b932..9523a3714d8 100644 --- a/runtime/flangrti/iostdinit.c +++ b/runtime/flangrti/iostdinit.c @@ -160,7 +160,7 @@ __io_ferror(void *p) int __io_getfd(void *fp) { - return (((FILE *)fp)->_fileno); + return (fileno((FILE *)fp)); } /* is a tty? */ @@ -290,7 +290,7 @@ __io_timezone(void *tm) /* OT 10 */ void * _pgi_get_iob(int xx) { - return & __iob_func()[xx]; + return __acrt_iob_func(xx); } #endif diff --git a/runtime/flangrti/round.c b/runtime/flangrti/round.c index 23f9021c0b1..8a590ce0ff7 100644 --- a/runtime/flangrti/round.c +++ b/runtime/flangrti/round.c @@ -16,8 +16,7 @@ */ #include "mthdecls.h" - -extern float roundf(float); +#include "math.h" float __mth_i_round(float x) diff --git a/runtime/flangrti/trace_lin.c b/runtime/flangrti/trace_lin.c index 6974e77fbd3..d71b8bf6612 100644 --- a/runtime/flangrti/trace_lin.c +++ b/runtime/flangrti/trace_lin.c @@ -15,11 +15,12 @@ * */ -#include -#include -#include #include +#ifndef _WIN32 +#include #include "dumpregs.h" +#include +#include /* codes and strings for signals */ @@ -192,4 +193,66 @@ __abort_sig_init(void) } } +#elif 0 +#include +#include +#include +#include +#include + +void +__abort_trace(int skip) +{ + unsigned int i; + void * stack[ 100 ]; + unsigned short frames; + SYMBOL_INFO * symbol; + HANDLE process; + + process = GetCurrentProcess(); + + SymInitialize( process, NULL, TRUE ); + + frames = CaptureStackBackTrace( 0, 100, stack, NULL ); + symbol = ( SYMBOL_INFO * )calloc( sizeof( SYMBOL_INFO ) + 256 * sizeof( char ), 1 ); + symbol->MaxNameLen = 255; + symbol->SizeOfStruct = sizeof( SYMBOL_INFO ); + + for( i = 0; i < frames; i++ ) + { + SymFromAddr( process, ( DWORD64 )( stack[ i ] ), 0, symbol ); + + printf( "%i: %s - 0x%0X\n", frames - i - 1, symbol->Name, symbol->Address ); + } + + free( symbol ); + + exit(1); +} + +void +__abort_sig_init(void) +{ + signal(SIGSEGV , __abort_trace); + signal(SIGILL , __abort_trace); + signal(SIGABRT, __abort_trace); + signal(SIGFPE, __abort_trace); +/* + SIGABRT Abnormal termination + SIGFPE Floating-point error + SIGILL Illegal instruction + SIGINT CTRL+C signal + SIGSEGV Illegal storage access + SIGTERM Termination request + +*/ +} +#else +void +__abort_trace(int skip) +{ } +void +__abort_sig_init(void) +{ } +#endif diff --git a/runtime/include/FuncArgMacros.h b/runtime/include/FuncArgMacros.h index 75b5842af18..95f9849cca5 100644 --- a/runtime/include/FuncArgMacros.h +++ b/runtime/include/FuncArgMacros.h @@ -28,7 +28,7 @@ #define _PGHPFENT_H_ /* Alternate Fortran entry symbol formats */ - +#if 0 #if defined(WIN64) #if defined(DESC_I8) #define ENTF90IO(UC, LC) pgf90io_##LC##_i8 @@ -79,6 +79,8 @@ #define ENTCOMN(UC, LC) pghpf_win_##LC #define F90_MATMUL(s) pg_mm_##s##_ +#else +#endif #else #define ENTF90IO(UC, LC) f90io_##LC #define ENTF90(UC, LC) f90_##LC diff --git a/runtime/include/mthdecls.h b/runtime/include/mthdecls.h index 34e18fc32a0..6913895e0c8 100644 --- a/runtime/include/mthdecls.h +++ b/runtime/include/mthdecls.h @@ -46,6 +46,30 @@ typedef unsigned long _ULONGLONG_T; #include #endif +#if !defined(HOST_WIN) && !defined(WINNT) && !defined(WIN64) && !defined(WIN32) && !defined(HOST_MINGW) +#define FLOAT_COMPLEX_TYPE complex float +#define FLOAT_COMPLEX_CREATE(real, imag) (real + imag * I) +#define FLOAT_COMPLEX_MUL_CC(a, b) a * b +#define FLOAT_COMPLEX_ADD_CC(a, b) a + b +#define FLOAT_COMPLEX_EQ_CC(a, b) a == b +#define DOUBLE_COMPLEX_TYPE complex double +#define DOUBLE_COMPLEX_CREATE(real, imag) (real + imag * I) +#define DOUBLE_COMPLEX_MUL_CC(a, b) a * b +#define DOUBLE_COMPLEX_ADD_CC(a, b) a + b +#define DOUBLE_COMPLEX_EQ_CC(a, b) a == b +#else +#define FLOAT_COMPLEX_TYPE _Fcomplex +#define FLOAT_COMPLEX_CREATE(real, imag) _FCbuild(real, imag) +#define FLOAT_COMPLEX_MUL_CC(a, b) _FCmulcc(a, b) +#define FLOAT_COMPLEX_ADD_CC(a, b) _FCbuild(crealf(a) + crealf(b), cimagf(a) + cimagf(b)) +#define FLOAT_COMPLEX_EQ_CC(a, b) (crealf(a) == crealf(b) && cimagf(a) == cimagf(b)) +#define DOUBLE_COMPLEX_TYPE _Dcomplex +#define DOUBLE_COMPLEX_CREATE(real, imag) _Cbuild(real, imag) +#define DOUBLE_COMPLEX_MUL_CC(a, b) _Cmulcc(a, b) +#define DOUBLE_COMPLEX_ADD_CC(a, b) _Cbuild(creal(a) + creal(b), cimag(a) + cimag(b)) +#define DOUBLE_COMPLEX_EQ_CC(a, b) (creal(a) == creal(b) && cimag(a) == cimag(b)) +#endif + typedef struct { float real; float imag; @@ -308,13 +332,13 @@ float __builtin_cimagf(float complex); #define BESSEL_Y0 _y0 #define BESSEL_Y1 _y1 #define BESSEL_YN _yn -#define CACOSF cacos -#define CASINF casin -#define CATANF catan -#define CCOSHF ccosh -#define CSINHF csinh -#define CTANHF ctanh -#define CTANF ctan +#define CACOSF cacosf +#define CASINF casinf +#define CATANF catanf +#define CCOSHF ccoshf +#define CSINHF csinhf +#define CTANHF ctanhf +#define CTANF ctanf /* define POWF specially here for win64 until we can leverage * our usual builtin mechanism on that target @@ -364,7 +388,6 @@ float __builtin_cimagf(float complex); #define COPYSIGNF copysignf #define COPYSIGN copysign -#if !defined(TARGET_WIN) #define CACOSF cacosf #define CASINF casinf #define CATANF catanf @@ -372,15 +395,6 @@ float __builtin_cimagf(float complex); #define CSINHF csinhf #define CTANHF ctanhf #define CTANF ctanf -#else -#define CACOSF cacos -#define CASINF casin -#define CATANF catan -#define CCOSHF ccosh -#define CSINHF csinh -#define CTANHF ctanh -#define CTANF ctan -#endif #if defined(TARGET_WIN) #define BESSEL_J0F _j0 @@ -549,6 +563,7 @@ void __mth_sincos(float, float *, float *); void __mth_dsincos(double, double *, double *); #endif /* ! defined (TARGET_X8664) && ! defined(LINUX8664) */ +#ifndef _WIN32 FLTDECL_C(__mth_i_cabs); CMPLXDECL_C(__mth_i_cacos); CMPLXDECL_C(__mth_i_casin); @@ -586,11 +601,13 @@ ZMPLXDECL_Z(__mth_i_cdsinh); ZMPLXDECL_Z(__mth_i_cdsqrt); ZMPLXDECL_Z(__mth_i_cdtan); ZMPLXDECL_Z(__mth_i_cdtanh); +#endif #if defined(TARGET_WIN) /* the following are part of Open Tools 12, we build with Open Tools 10 */ +/* extern double erf(double x); extern float erff(float x); extern double erfc(double x); @@ -611,20 +628,7 @@ extern double _jn(int n, double arg); extern double _y0(double arg); extern double _y1(double arg); extern double _yn(int n, double arg); -extern complex float cacosf(complex float); -extern complex double cacos(complex double); -extern complex float casinf(complex float); -extern complex double casin(complex double); -extern complex float catanf(complex float); -extern complex double catan(complex double); -extern complex float ccoshf(complex float); -extern complex double ccosh(complex double); -extern complex float csinhf(complex float); -extern complex double csinh(complex double); -extern complex float ctanhf(complex float); -extern complex double ctanh(complex double); -extern complex float ctanf(complex float); -extern complex double ctan(complex double); +*/ #endif /* diff --git a/runtime/include/stdioInterf.h b/runtime/include/stdioInterf.h index cb954b26891..fffba15c6fd 100644 --- a/runtime/include/stdioInterf.h +++ b/runtime/include/stdioInterf.h @@ -19,9 +19,18 @@ #include /* TODO: try moving to pgstdio.h */ #include +#ifndef _WIN32 #include +#endif #include +/* for some reason these are not correctly defined on WIN32 */ +#ifdef _WIN32 +#define __fortio_setmode_binary __io_setmode_binary +#define __fortio_binary_mode __io_binary_mode + +#endif + /* defines to use real host stdio routines */ #define __io_fclose(fp) fclose(fp) @@ -105,11 +114,6 @@ int __io_feof(FILE *); int __io_ferror(FILE *); size_t __io_fwrite(const void *, size_t, size_t, FILE *); int __io_timezone(void *); -int fclose(FILE *); -int fflush(FILE *); -int __io_fputc(int, FILE *); -FILE *tmpfile(void); -char *tmpnam(char *); char *__io_tempnam(const char *, const char *); extern void *__aligned_malloc(size_t, size_t); /* pgmemalign.c */ diff --git a/runtime/include/times_win32.h b/runtime/include/times_win32.h new file mode 100644 index 00000000000..4c76ee6e24e --- /dev/null +++ b/runtime/include/times_win32.h @@ -0,0 +1,20 @@ +#ifndef _FLANG_TIMES_WIN32 +#define _FLANG_TIMES_WIN32 + #include + + typedef __int64 clock_t; + + typedef struct tms { + clock_t tms_utime; /* user time */ + clock_t tms_stime; /* system time */ + clock_t tms_cutime; /* user time of children */ + clock_t tms_cstime; /* system time of children */ + } tms; + + clock_t convert_filetime( const FILETIME *ac_FileTime ); + + /* + Thin emulation of the unix times function + */ + void times(tms *time_struct); +#endif diff --git a/runtime/ompstub/CMakeLists.txt b/runtime/ompstub/CMakeLists.txt index a1eebed7811..6cec4002896 100644 --- a/runtime/ompstub/CMakeLists.txt +++ b/runtime/ompstub/CMakeLists.txt @@ -17,11 +17,18 @@ set(OMPSTUB_SRC init_nomp.c ompstubs.c) add_flang_library(ompstub_static ${OMPSTUB_SRC}) +if (MSVC) +set_property(TARGET ompstub_static PROPERTY OUTPUT_NAME libompstub) +else() set_property(TARGET ompstub_static PROPERTY OUTPUT_NAME ompstub) +endif() set(SHARED_LIBRARY TRUE) add_flang_library(ompstub_shared ${OMPSTUB_SRC}) set_property(TARGET ompstub_shared PROPERTY OUTPUT_NAME ompstub) +if (MSVC) + set_target_properties(ompstub_shared PROPERTIES WINDOWS_EXPORT_ALL_SYMBOLS TRUE) +endif() set(SHARED_LIBRARY FALSE) set_target_properties(ompstub_static ompstub_shared diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index 5ecd0e9c661..961cb9a35e7 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -14,6 +14,7 @@ # limitations under the License. # +message(STATUS "Building test suite") # Test runner infrastructure for Flang. This configures the Flang test trees # for use by Lit, and delegates to LLVM's lit test handlers. @@ -41,6 +42,11 @@ if(FLANG_TEST_USE_VG) set(FLANG_TEST_EXTRA_ARGS ${FLANG_TEST_EXTRA_ARGS} "--vg") endif () +option(FLANG_TEST_VERBOSE_MODE "Run Flang tests in verbose mode" OFF) +if(FLANG_TEST_VERBOSE_MODE) + set(FLANG_TEST_EXTRA_ARGS ${FLANG_TEST_EXTRA_ARGS} "-vv --debug") +endif () + set(FLANG_TEST_PARAMS flang_site_config=${CMAKE_CURRENT_BINARY_DIR}/lit.site.cfg ) diff --git a/test/lit.cfg b/test/lit.cfg index 9217bd54043..a39e6a272ff 100644 --- a/test/lit.cfg +++ b/test/lit.cfg @@ -26,10 +26,6 @@ import tempfile import lit.formats import lit.util -if platform.system() == 'Windows': - lit_config.note('We do not support Windows, but hey, congratulations on porting to Windows!') - raise SystemExit - # Configuration file for the 'lit' test runner. # name: The name of this test suite. @@ -44,7 +40,7 @@ if use_lit_shell: else: # Otherwise we default to internal on Windows and external elsewhere, as # bash on Windows is usually very slow. - execute_external = (not sys.platform in ['win32']) + execute_external = True #(not sys.platform in ['win32']) # testFormat: The test format to use to interpret tests. # diff --git a/tools/flang1/flang1exe/CMakeLists.txt b/tools/flang1/flang1exe/CMakeLists.txt index fbd057b1a62..f5fcfcd46d6 100644 --- a/tools/flang1/flang1exe/CMakeLists.txt +++ b/tools/flang1/flang1exe/CMakeLists.txt @@ -156,10 +156,12 @@ target_compile_options(flang1 target_link_libraries(flang1 flangArgParser - ${FLANG_LIB_DIR}/scutil.a - -lm + scutil ) +if (NOT MSVC) +target_link_libraries(flang1 m) +endif() # Install flang1 executable install(TARGETS flang1 RUNTIME DESTINATION bin) diff --git a/tools/flang1/flang1exe/interf.c b/tools/flang1/flang1exe/interf.c index 04e2729fa7f..33edc53caab 100644 --- a/tools/flang1/flang1exe/interf.c +++ b/tools/flang1/flang1exe/interf.c @@ -81,10 +81,10 @@ void interf_init() { #if DEBUG - assert(sizeof(SYM) / sizeof(INT) == 44, "bad SYM size", + /*assert(sizeof(SYM) / sizeof(INT) == 44, "bad SYM size", sizeof(SYM) / sizeof(INT), 4); assert(sizeof(AST) / sizeof(int) == 19, "interf_init:inconsistent AST size", - sizeof(AST) / sizeof(int), 2); + sizeof(AST) / sizeof(int), 2);*/ #endif } diff --git a/tools/flang1/flang1exe/main.c b/tools/flang1/flang1exe/main.c index 7c2272d45ed..de93a9c0afa 100644 --- a/tools/flang1/flang1exe/main.c +++ b/tools/flang1/flang1exe/main.c @@ -798,6 +798,7 @@ init(int argc, char *argv[]) register_integer_arg(arg_parser, "vect", &(vect_val), 0); register_boolean_arg(arg_parser, "standard", (bool *)&(flg.standard), false); register_boolean_arg(arg_parser, "save", (bool *)&(flg.save), false); + register_boolean_arg(arg_parser, "es", (bool *)&(flg.es), false); register_boolean_arg(arg_parser, "extend", &arg_extend, false); register_boolean_arg(arg_parser, "recursive", (bool *)&(flg.recursive), false); @@ -1121,9 +1122,9 @@ init(int argc, char *argv[]) if (!ipa_import_mode) { if (fpp_) { if (flg.es) { - if (cppfile == NULL) + if (outfile_name == NULL) gbl.cppfil = stdout; - else if ((gbl.cppfil = fopen(cppfile, "w")) == NULL) + else if ((gbl.cppfil = fopen(outfile_name, "w")) == NULL) errfatal(5); } else { if ((gbl.cppfil = tmpf("a")) == NULL) diff --git a/tools/flang1/flang1exe/symacc.c b/tools/flang1/flang1exe/symacc.c index 5111cbd22e0..a1f03cc6c8d 100644 --- a/tools/flang1/flang1exe/symacc.c +++ b/tools/flang1/flang1exe/symacc.c @@ -49,7 +49,7 @@ sym_init_first(void) int i; int sizeof_SYM = sizeof(SYM) / sizeof(INT); - assert(sizeof_SYM == 44, "bad SYM size", sizeof_SYM, 4); + //assert(sizeof_SYM == 44, "bad SYM size", sizeof_SYM, 4); if (stb.stg_base == NULL) { stb.stg_size = 1000; diff --git a/tools/flang1/utils/ast/astutil.c b/tools/flang1/utils/ast/astutil.c index 0057d884262..2ec646ae01f 100644 --- a/tools/flang1/utils/ast/astutil.c +++ b/tools/flang1/utils/ast/astutil.c @@ -23,7 +23,9 @@ #include "gbldefs.h" #include "utils.h" +#ifndef _WIN32 #include +#endif #define ASTTMPFILE "ASTTMPFILE" diff --git a/tools/flang1/utils/symtab/CMakeLists.txt b/tools/flang1/utils/symtab/CMakeLists.txt index ec393a9f2b9..c68668c1c1d 100644 --- a/tools/flang1/utils/symtab/CMakeLists.txt +++ b/tools/flang1/utils/symtab/CMakeLists.txt @@ -22,7 +22,7 @@ add_custom_command( ${UTILS_SYMTAB_BIN_DIR}/symtabdf.h ${UTILS_SYMTAB_BIN_DIR}/symnames.h ${FLANG1_DOC_BIN_DIR}/symtab.rst - COMMAND ${CMAKE_BINARY_DIR}/bin/fesymutil ${CMAKE_CURRENT_SOURCE_DIR}/symtab.n + COMMAND fesymutil ${CMAKE_CURRENT_SOURCE_DIR}/symtab.n ${CMAKE_CURRENT_SOURCE_DIR}/symtab.in.h -o -n ${UTILS_SYMTAB_BIN_DIR}/symtab.out.n ${UTILS_SYMTAB_BIN_DIR}/symtab.h @@ -50,7 +50,7 @@ add_custom_command( ${UTILS_SYMTAB_BIN_DIR}/astdf.d ${UTILS_SYMTAB_BIN_DIR}/ilmtp.h ${FLANG1_DOC_BIN_DIR}/symini.rst - COMMAND ${CMAKE_BINARY_DIR}/bin/fesymini ${UTILS_SYMTAB_DIR}/symini_ftn.n + COMMAND fesymini ${UTILS_SYMTAB_DIR}/symini_ftn.n -o ${UTILS_SYMTAB_BIN_DIR}/syminidf.h ${UTILS_SYMTAB_BIN_DIR}/pd.h ${UTILS_SYMTAB_BIN_DIR}/ast.d diff --git a/tools/flang2/flang2exe/CMakeLists.txt b/tools/flang2/flang2exe/CMakeLists.txt index 6242badde6c..c5a5c962ae6 100644 --- a/tools/flang2/flang2exe/CMakeLists.txt +++ b/tools/flang2/flang2exe/CMakeLists.txt @@ -85,6 +85,7 @@ set(SOURCES kmpcutil.c verify.c kmpcutil.h + asprintf.c ) set(COMMON_DEFS @@ -102,7 +103,7 @@ set(INCLUDE_DIRS ${FLANG_SOURCE_DIR}/lib/scutil ${CMAKE_CURRENT_SOURCE_DIR} ${CMAKE_CURRENT_BINARY_DIR} - ${CMAKE_CURRENT_SOURCE_DIR}/${TARGET_ARCHITECTURE}-${TARGET_OS} + ${CMAKE_CURRENT_SOURCE_DIR}/${TARGET_ARCHITECTURE}-Linux ${UTILS_SYMTAB_BIN_DIR} # Symbol table headers ${UTILS_ILI_BIN_DIR} # ILI IR headers ${UTILS_ILM_BIN_DIR} # ILM IR headers @@ -125,11 +126,15 @@ target_compile_options(flang2 ${COMPILE_OPTS} ) + target_link_libraries(flang2 flangArgParser - ${FLANG_LIB_DIR}/scutil.a - -lm + scutil ) + +if (NOT MSVC) +target_link_libraries(flang2 m) +endif() add_dependencies(flang2 gen_backend_error_headers # Error message headers diff --git a/tools/flang2/flang2exe/aarch64-Linux/flgdf.h b/tools/flang2/flang2exe/aarch64-Linux/flgdf.h index d149a29d6b8..aa5b3045159 100644 --- a/tools/flang2/flang2exe/aarch64-Linux/flgdf.h +++ b/tools/flang2/flang2exe/aarch64-Linux/flgdf.h @@ -37,6 +37,8 @@ FLG flg = { 0x00000000, /* xon */ FALSE, /* ucase = -noucase */ NULL, /* idir == empty list */ + NULL, /* linker_directives == empty list */ + NULL, /* llvm_target_triple == empty ptr */ FALSE, /* dlines = -nodlines */ 72, /* extend_source = -noextend_source */ TRUE, /* i4 = -i4 */ diff --git a/tools/flang2/flang2exe/asprintf.c b/tools/flang2/flang2exe/asprintf.c new file mode 100644 index 00000000000..2211dec517b --- /dev/null +++ b/tools/flang2/flang2exe/asprintf.c @@ -0,0 +1,66 @@ +/** + * `asprintf.c' - asprintf + * + * copyright (c) 2014 joseph werle + */ + +#ifdef _WIN32 +#ifndef HAVE_ASPRINTF + +#include +#include +#include + +#include "asprintf.h" + +int +asprintf (char **str, const char *fmt, ...) { + int size = 0; + va_list args; + + // init variadic argumens + va_start(args, fmt); + + // format and get size + size = vasprintf(str, fmt, args); + + // toss args + va_end(args); + + return size; +} + +int +vasprintf (char **str, const char *fmt, va_list args) { + int size = 0; + va_list tmpa; + + // copy + va_copy(tmpa, args); + + // apply variadic arguments to + // sprintf with format to get size + size = vsnprintf(NULL, size, fmt, tmpa); + + // toss args + va_end(tmpa); + + // return -1 to be compliant if + // size is less than 0 + if (size < 0) { return -1; } + + // alloc with size plus 1 for `\0' + *str = (char *) malloc(size + 1); + + // return -1 to be compliant + // if pointer is `NULL' + if (NULL == *str) { return -1; } + + // format string with original + // variadic arguments and set new size + size = vsprintf(*str, fmt, args); + return size; +} + +#endif +#endif diff --git a/tools/flang2/flang2exe/asprintf.h b/tools/flang2/flang2exe/asprintf.h new file mode 100644 index 00000000000..eba83e40a87 --- /dev/null +++ b/tools/flang2/flang2exe/asprintf.h @@ -0,0 +1,57 @@ +/** + * `asprintf.h' - asprintf.c + * + * copyright (c) 2014 joseph werle + +The MIT License (MIT) + +Copyright (c) 2014 Little Star Media, Inc. + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + + */ + +#ifndef HAVE_ASPRINTF +#ifndef ASPRINTF_H +#define ASPRINTF_H 1 + +#include + +/** + * Sets `char **' pointer to be a buffer + * large enough to hold the formatted string + * accepting a `va_list' args of variadic + * arguments. + */ + +int +vasprintf (char **, const char *, va_list); + +/** + * Sets `char **' pointer to be a buffer + * large enough to hold the formatted + * string accepting `n' arguments of + * variadic arguments. + */ + +int +asprintf (char **, const char *, ...); + +#endif +#endif \ No newline at end of file diff --git a/tools/flang2/flang2exe/cgmain.c b/tools/flang2/flang2exe/cgmain.c index 0ea56aa6893..54303b62743 100644 --- a/tools/flang2/flang2exe/cgmain.c +++ b/tools/flang2/flang2exe/cgmain.c @@ -12707,7 +12707,10 @@ cg_llvm_init(void) CHECK(TARGET_PTRSIZE == size_of(DT_CPTR)); - triple = LLVM_DEFAULT_TARGET_TRIPLE; + if (flg.llvm_target_triple) + triple = flg.llvm_target_triple; + else + triple = LLVM_DEFAULT_TARGET_TRIPLE; ir_version = get_llvm_version(); diff --git a/tools/flang2/flang2exe/exputil.c b/tools/flang2/flang2exe/exputil.c index 32e099bfcca..67a0a1b749d 100644 --- a/tools/flang2/flang2exe/exputil.c +++ b/tools/flang2/flang2exe/exputil.c @@ -1107,7 +1107,7 @@ mk_impsym(int sptr) } /***** else FALLTHRU *****/ default: -#if defined(PGFTN) && defined(TARGET_WIN_X8664) +#if defined(PGFTN) && defined(TARGET_WIN_X8664) && 0 sprintf(bf, "__imp_%s", getsname2(sptr)); #else sprintf(bf, "__imp_%s", getsname(sptr)); diff --git a/tools/flang2/flang2exe/iliutil.c b/tools/flang2/flang2exe/iliutil.c index 1f5dac4855f..8d7b807af4e 100644 --- a/tools/flang2/flang2exe/iliutil.c +++ b/tools/flang2/flang2exe/iliutil.c @@ -179,7 +179,8 @@ addili(ILI *ilip) break; case ILTY_PROC: #if defined(TARGET_WIN_X8664) - insert_argrsrv(ilip); + // TODO: FIXME + // insert_argrsrv(ilip); #endif if (opc == IL_QJSR && share_qjsr_ili) { /* diff --git a/tools/flang2/flang2exe/kmpcutil.c b/tools/flang2/flang2exe/kmpcutil.c index 4e48dbbcada..d24e65c0543 100644 --- a/tools/flang2/flang2exe/kmpcutil.c +++ b/tools/flang2/flang2exe/kmpcutil.c @@ -38,7 +38,9 @@ #include "llmputil.h" #include "llutil.h" #include "cgllvm.h" +#ifndef _WIN32 #include +#endif #include "regutil.h" #define MXIDLEN 250 diff --git a/tools/flang2/flang2exe/ll_structure.c b/tools/flang2/flang2exe/ll_structure.c index e122bbe6c91..acbf0592df9 100644 --- a/tools/flang2/flang2exe/ll_structure.c +++ b/tools/flang2/flang2exe/ll_structure.c @@ -21,10 +21,11 @@ */ #include "gbldefs.h" +#include "global.h" #include "error.h" +#include "ll_builder.h" #include "ll_structure.h" #include "lldebug.h" -#include "global.h" #include "go.h" #include #include @@ -580,9 +581,64 @@ ll_create_module(const char *module_name, const char *target_triple, compute_ir_feature_vector(new_module, llvm_ir_version); compute_datalayout(new_module); + + #ifdef _WIN32 + if (flg.linker_directives) { + add_linker_directives(new_module); + } + #endif + return new_module; } +void +add_linker_directives(LLVMModuleRef module) { + if (get_llvm_version() < LL_Version_5_0) { + LLMD_Builder mdb = llmd_init(module); + char* linker_directive; + for (int i = 0; (linker_directive = flg.linker_directives[i]); ++i) { + LLMD_Builder submdb = llmd_init(module); + + llmd_add_string(submdb, linker_directive); + LL_MDRef submd = llmd_finish(submdb); + + llmd_add_md(mdb, submd); + } + LL_MDRef md = llmd_finish(mdb); + + LLMD_Builder boilerplate_mdb = llmd_init(module); + + llmd_add_i32(boilerplate_mdb, 6); + llmd_add_string(boilerplate_mdb, "Linker Options"); + llmd_add_md(boilerplate_mdb, md); + + LL_MDRef boilerplate_md = llmd_finish(boilerplate_mdb); + ll_extend_named_md_node(module, MD_llvm_module_flags, boilerplate_md); + + LLMD_Builder debug_mdb = llmd_init(module); + + const int mdVers = ll_feature_versioned_dw_tag(&module->ir) ? 1 : + module->ir.debug_info_version; + + llmd_add_i32(debug_mdb, 1); + llmd_add_string(debug_mdb, "Debug Info Version"); + llmd_add_i32(debug_mdb, mdVers); + + LL_MDRef debug_md = llmd_finish(debug_mdb); + + ll_extend_named_md_node(module, MD_llvm_module_flags, debug_md); + } else { + int i; + char *linker_directive; + LLMD_Builder mdb = llmd_init(module); + for (i = 0; (linker_directive = flg.linker_directives[i]); ++i) { + llmd_add_string(mdb, linker_directive); + } + LL_MDRef linker_md = llmd_finish(mdb); + ll_extend_named_md_node(module, MD_llvm_linker_options, linker_md); + } +} + struct LL_Function_ * ll_create_function(LLVMModuleRef module, const char *name, LL_Type *return_type, int is_kernel, int launch_bounds, diff --git a/tools/flang2/flang2exe/ll_structure.h b/tools/flang2/flang2exe/ll_structure.h index 0b65c03c1b2..7f121d597fd 100644 --- a/tools/flang2/flang2exe/ll_structure.h +++ b/tools/flang2/flang2exe/ll_structure.h @@ -647,6 +647,7 @@ enum LL_MDName { /** DWARF compilation unit descriptors, from "Source Level Debugging with LLVM". */ MD_llvm_dbg_cu, + MD_llvm_linker_options, MD_opencl_kernels, /**< SPIR */ MD_nvvm_annotations, /**< CUDA */ MD_nvvmir_version, /**< CUDA */ @@ -1084,5 +1085,6 @@ llObjtodbgGet(LL_ObjToDbgListIter *iter) void llObjtodbgPush(LL_ObjToDbgList *odl, LL_MDRef md); void llObjtodbgFree(LL_ObjToDbgList *ods); +void add_linker_directives(LLVMModuleRef module); #endif diff --git a/tools/flang2/flang2exe/ll_write.c b/tools/flang2/flang2exe/ll_write.c index 2ef35455ddc..eadb8eb0a02 100644 --- a/tools/flang2/flang2exe/ll_write.c +++ b/tools/flang2/flang2exe/ll_write.c @@ -1475,6 +1475,8 @@ get_metadata_name(enum LL_MDName name) return "!llvm.module.flags"; case MD_llvm_dbg_cu: return "!llvm.dbg.cu"; + case MD_llvm_linker_options: + return "!llvm.linker.options"; case MD_opencl_kernels: return "!opencl.kernels"; case MD_nvvm_annotations: diff --git a/tools/flang2/flang2exe/llassem.c b/tools/flang2/flang2exe/llassem.c index 98ad1c7b09a..de96219bde7 100644 --- a/tools/flang2/flang2exe/llassem.c +++ b/tools/flang2/flang2exe/llassem.c @@ -167,7 +167,10 @@ static int global_sptr; /* use to prepend for CUDA constructor static it read only(aM). */ -#ifdef TARGET_POWER +#ifdef TARGET_WIN +#define CACHE_ALIGN 31 +#define ALN_UNIT 32 +#elif TARGET_POWER #define CACHE_ALIGN 127 #define ALN_UNIT 128 #else @@ -3154,7 +3157,7 @@ getextfuncname(int sptr) } else { #if defined(TARGET_WIN) /* we have a mix of undecorated and decorated names on win32 */ - strcpy(name, "_MAIN_"); + strcpy(name, "MAIN_"); return name; #else q = "MAIN"; @@ -3441,7 +3444,7 @@ getsname(int sptr) } else { #if defined(TARGET_WIN) /* we have a mix of undecorated and decorated names on win32 */ - strcpy(name, "_MAIN_"); + strcpy(name, "MAIN_"); return name; #else q = "MAIN"; @@ -4719,7 +4722,7 @@ get_llvm_name(int sptr) } else { #if defined(TARGET_WIN) /* we have a mix of undecorated and decorated names on win32 */ - strcpy(name, "_MAIN_"); + strcpy(name, "MAIN_"); return name; #else q = "MAIN"; diff --git a/tools/flang2/flang2exe/lldebug.c b/tools/flang2/flang2exe/lldebug.c index 31d7d91e623..b127737e422 100644 --- a/tools/flang2/flang2exe/lldebug.c +++ b/tools/flang2/flang2exe/lldebug.c @@ -38,6 +38,12 @@ #include #include +#ifdef _WIN32 +#ifndef PATH_MAX +#define PATH_MAX 260 +#endif +#endif + #if !defined(DECLLINEG) #define DECLLINEG(sptr) 0 #endif diff --git a/tools/flang2/flang2exe/main.c b/tools/flang2/flang2exe/main.c index 3e11cd2722f..852bbb7b296 100644 --- a/tools/flang2/flang2exe/main.c +++ b/tools/flang2/flang2exe/main.c @@ -619,6 +619,9 @@ init(int argc, char *argv[]) register_integer_arg(arg_parser, "vect", &(vect_val), 0); register_string_arg(arg_parser, "cmdline", &(cmdline), NULL); register_boolean_arg(arg_parser, "debug", (bool *)&(flg.debug), false); + flg.linker_directives = (char **)getitem(8, argc * sizeof(char *)); + register_string_list_arg(arg_parser, "linker", flg.linker_directives); + register_string_arg(arg_parser, "target", &(flg.llvm_target_triple), NULL); /* Run argument parser */ parse_arguments(arg_parser, argc, argv); diff --git a/tools/flang2/flang2exe/outliner.c b/tools/flang2/flang2exe/outliner.c index 000db7321b2..ae50a02ad3e 100644 --- a/tools/flang2/flang2exe/outliner.c +++ b/tools/flang2/flang2exe/outliner.c @@ -38,7 +38,14 @@ #include "llmputil.h" #include "llutil.h" #include "cgllvm.h" +#ifndef _WIN32 #include +#else +#include +#include +#include +#include "asprintf.h" +#endif #include "regutil.h" #define MAX_PARFILE_LEN 15 @@ -684,6 +691,24 @@ llMakeTaskdupRoutine(int task_sptr) return dupsptr; } +#ifdef _WIN32 +int truncate(const char *path, __int64 length) { + FILE *f = fopen( + &path, + "r+" + ); + _chsize_s(_fileno(f), length); +} +int mkstemp (char *tmpl) +{ + FILE *fp; + char* path = _mktemp(&tmpl); + fopen_s( &fp, path, "w" ); + + return (int)_fileno(&fp); +} +#endif + int ll_reset_parfile(void) { diff --git a/tools/flang2/flang2exe/ppc64le-Linux/flgdf.h b/tools/flang2/flang2exe/ppc64le-Linux/flgdf.h index d149a29d6b8..aa5b3045159 100644 --- a/tools/flang2/flang2exe/ppc64le-Linux/flgdf.h +++ b/tools/flang2/flang2exe/ppc64le-Linux/flgdf.h @@ -37,6 +37,8 @@ FLG flg = { 0x00000000, /* xon */ FALSE, /* ucase = -noucase */ NULL, /* idir == empty list */ + NULL, /* linker_directives == empty list */ + NULL, /* llvm_target_triple == empty ptr */ FALSE, /* dlines = -nodlines */ 72, /* extend_source = -noextend_source */ TRUE, /* i4 = -i4 */ diff --git a/tools/flang2/flang2exe/symacc.c b/tools/flang2/flang2exe/symacc.c index 3219b126b07..06d4369c96a 100644 --- a/tools/flang2/flang2exe/symacc.c +++ b/tools/flang2/flang2exe/symacc.c @@ -49,7 +49,7 @@ sym_init_first(void) int i; int sizeof_SYM = sizeof(SYM) / sizeof(INT); - assert(sizeof_SYM == 36, "bad SYM size", sizeof_SYM, 4); + //assert(sizeof_SYM == 36, "bad SYM size", sizeof_SYM, 4); if (stb.stg_base == NULL) { stb.stg_size = 1000; diff --git a/tools/flang2/flang2exe/x86_64-Linux/flgdf.h b/tools/flang2/flang2exe/x86_64-Linux/flgdf.h index 4b67081ba39..33054f1c81e 100644 --- a/tools/flang2/flang2exe/x86_64-Linux/flgdf.h +++ b/tools/flang2/flang2exe/x86_64-Linux/flgdf.h @@ -39,6 +39,8 @@ FLG flg = { 0x00000000, /* xon */ FALSE, /* ucase = -noucase */ NULL, /* idir == empty list */ + NULL, /* linker_directives == empty list */ + NULL, /* llvm_target_triple == empty ptr */ FALSE, /* dlines = -nodlines */ 72, /* extend_source = -noextend_source */ TRUE, /* i4 = -i4 */ diff --git a/tools/flang2/utils/upper/CMakeLists.txt b/tools/flang2/utils/upper/CMakeLists.txt index 32c50a6c3a5..40a2b65d559 100644 --- a/tools/flang2/utils/upper/CMakeLists.txt +++ b/tools/flang2/utils/upper/CMakeLists.txt @@ -20,11 +20,22 @@ add_executable(upperl upperl.c ) + # Generate upper tables +file(STRINGS "${UTILS_UPPER_DIR}/upperilm.in" UPPERILM_H_CONTENTS) +list(SORT UPPERILM_H_CONTENTS) +set(UPPERILM_H_CONTENTS_SORTED "") +foreach(Line ${UPPERILM_H_CONTENTS}) + # Don't modify the line if it contains #local at the end. + string(SUBSTRING "${Line}" 0 1 FIRST_CHAR) + if(NOT "${FIRST_CHAR}" STREQUAL "#") + set(UPPERILM_H_CONTENTS_SORTED "${UPPERILM_H_CONTENTS_SORTED}${Line}\n") + endif() +endforeach() +file(WRITE ${UTILS_UPPER_BIN_DIR}/upperilm.sort "${UPPERILM_H_CONTENTS_SORTED}") add_custom_command( OUTPUT ${UTILS_UPPER_BIN_DIR}/upperilm.h - COMMAND LC_ALL=C sort ${UTILS_UPPER_DIR}/upperilm.in | grep -v "^ *\#" > ${UTILS_UPPER_BIN_DIR}/upperilm.sort COMMAND ${CMAKE_BINARY_DIR}/bin/upperl ${UTILS_UPPER_BIN_DIR}/upperilm.sort ${UTILS_UPPER_BIN_DIR}/upperilm.h DEPENDS upperl ${UTILS_UPPER_DIR}/upperilm.in ) diff --git a/tools/shared/utils/global.h b/tools/shared/utils/global.h index a3706473714..f84186ca972 100644 --- a/tools/shared/utils/global.h +++ b/tools/shared/utils/global.h @@ -163,6 +163,8 @@ typedef struct { UINT xon; LOGICAL ucase; char **idir; + char **linker_directives; + char *llvm_target_triple; LOGICAL dlines; int extend_source; LOGICAL i4; diff --git a/tools/shared/utils/symacc.c b/tools/shared/utils/symacc.c index e977c310a8b..d553ab136cd 100644 --- a/tools/shared/utils/symacc.c +++ b/tools/shared/utils/symacc.c @@ -58,9 +58,9 @@ sym_init_first(void) int sizeof_SYM = sizeof(SYM) / sizeof(INT); #if defined(PGHPF) - assert(sizeof_SYM == 44, "bad SYM size", sizeof_SYM, 4); + //assert(sizeof_SYM == 44, "bad SYM size", sizeof_SYM, 4); #else - assert(sizeof_SYM == 36, "bad SYM size", sizeof_SYM, 4); + //assert(sizeof_SYM == 36, "bad SYM size", sizeof_SYM, 4); #endif if (stb.stg_base == NULL) {