Add Fortran binding (#55)

README.md

@@ -222,6 +222,48 @@ false
 </td></tr>
 </table>
 
+### ruapu with Fortran
+
+<table>
+
+<tr><td>
+
+Compile ruapu library
+
+```shell
+# from source code
+cd fortran
+cmake -B build
+cmake --build build
+```
+</td>
+<td>
+
+Use ruapu in Fortran
+
+```fortran
+program main
+    use ruapu, only: ruapu_init, ruapu_supports, ruapu_rua
+    implicit none
+
+    character(len=:), allocatable :: isa_supported(:)
+    integer :: i
+
+    call ruapu_init()
+
+    print *, "supports sse: ", ruapu_supports("sse")
+    print *, "supports neon: ", ruapu_supports("neon")
+
+    isa_supported = ruapu_rua()
+    do i = 1, size(isa_supported)
+        print *, trim(isa_supported(i))
+    end do
+end program main
+
+```
+</td></tr>
+</table>
+
 <details>
 <summary>Github-hosted runner result (Linux)</summary>
 

fortran/CMakeLists.txt

@@ -0,0 +1,24 @@
+cmake_minimum_required(VERSION 3.0)
+
+project(ruapu-fortran)
+
+enable_language(Fortran)
+
+include_directories(../)
+
+add_library(ruapu
+    src/ruapu-binding.c
+    src/ruapu-binding.f90
+)
+
+add_executable(${PROJECT_NAME}
+    src/main.f90
+)
+
+target_link_libraries(${PROJECT_NAME} ruapu)
+
+set_target_properties(
+    ruapu-fortran
+    PROPERTIES
+    LINKER_LANGUAGE Fortran
+)

fortran/src/CMakeLists.txt

@@ -0,0 +1,7 @@
+set(SRC
+    ruapu-binding.c
+    ruapu-binding.f90
+)
+
+add_library("${PROJECT_NAME}" ${SRC})
+

fortran/src/main.f90

@@ -0,0 +1,18 @@
+program main
+    use ruapu, only: ruapu_init, ruapu_supports, ruapu_rua
+    implicit none
+
+    character(len=:), allocatable :: isa_supported(:)
+    integer :: i
+
+    print *, "ruapu initializing..."
+    call ruapu_init()
+
+    print *, "supports sse: ", ruapu_supports("sse")
+    print *, "supports neon: ", ruapu_supports("neon")
+
+    isa_supported = ruapu_rua()
+    do i = 1, size(isa_supported)
+        print *, trim(isa_supported(i))
+    end do
+end program main

fortran/src/ruapu-binding.c

@@ -0,0 +1,12 @@
+#define RUAPU_IMPLEMENTATION
+#include "ruapu.h"
+
+int get_num_isa_supported() {
+    int num = 0;
+    const char * const * isa_suppported = g_ruapu_isa_supported;
+    while (*isa_suppported) {
+        num++;
+        isa_suppported++;
+    }
+    return num;
+}

fortran/src/ruapu-binding.f90

@@ -0,0 +1,87 @@
+!------------------------------------------------------------------------------
+! Institution, Affiliation
+!------------------------------------------------------------------------------
+!
+! MODULE:  ruapu
+!
+!> @author
+!> mizu-bai
+!
+! DESCRIPTION: 
+!> Fortran binding for ruapu
+!> ruapu --- detect cpu isa features with single-file
+!
+! REVISION HISTORY:
+! 29 Feb 2024 - Initial Version
+!------------------------------------------------------------------------------
+module ruapu
+    implicit none
+
+contains
+
+subroutine ruapu_init()
+    implicit none
+    interface
+        !> void ruapu_init()
+        subroutine ruapu_init_() bind(c, name="ruapu_init")
+            implicit none
+        end subroutine ruapu_init_
+        end interface
+    call ruapu_init_()
+end subroutine ruapu_init
+
+integer function ruapu_supports(isa)
+    use iso_c_binding, only: c_char, c_int, c_null_char
+    implicit none
+
+    character(len=*), intent(in) :: isa
+
+    interface
+        !> int ruapu_supports(const char* isa)
+        integer(c_int) function ruapu_supports_(isa) bind(c, name="ruapu_supports")
+            import c_int, c_char
+            implicit none
+            character(kind=c_char) :: isa
+        end function ruapu_supports_
+    end interface
+
+    ruapu_supports = ruapu_supports_(trim(isa)//c_null_char)
+end function ruapu_supports
+
+function ruapu_rua()
+    use iso_c_binding, only: c_char, c_f_pointer, c_ptr, c_null_char, c_int, c_null_ptr, C_NEW_LINE
+    implicit none
+
+    character(len=32), allocatable :: ruapu_rua(:)
+    type(c_ptr), pointer :: isa_supported_ptrs(:) => null()
+    character(len=1, kind=c_char), pointer :: isa_chars(:) => null()
+    integer :: i, j, num_isa
+
+    interface
+        !> const char* const* ruapu_rua()
+        type(c_ptr) function ruapu_rua_() bind(c, name="ruapu_rua")
+            import c_ptr
+            implicit none
+        end function ruapu_rua_
+
+        integer(c_int) function get_num_isa_supported() bind(c)
+            import c_int
+        end function
+    end interface
+
+    num_isa = get_num_isa_supported()
+    call c_f_pointer(ruapu_rua_(), isa_supported_ptrs, (/num_isa/))
+    allocate(ruapu_rua(num_isa))
+
+    do i = 1, num_isa
+        call c_f_pointer(isa_supported_ptrs(i), isa_chars, (/len(ruapu_rua(1))/))
+        do j = 1, len(ruapu_rua(1))
+            if (isa_chars(j) .eq. c_null_char) then
+                exit
+            end if
+            ruapu_rua(i)(j: j) = isa_chars(j)
+        end do
+    end do
+end function ruapu_rua
+
+end module ruapu