metal_intf.F90

Go to the documentation of this file.

! Copyright (c) 2025, The Neko Authors
! All rights reserved.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
!
!   * Redistributions of source code must retain the above copyright
!     notice, this list of conditions and the following disclaimer.
!
!   * Redistributions in binary form must reproduce the above
!     copyright notice, this list of conditions and the following
!     disclaimer in the documentation and/or other materials provided
!     with the distribution.
!
!   * Neither the name of the authors nor the names of its
!     contributors may be used to endorse or promote products derived
!     from this software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
module metal_intf
  use utils, only : neko_error
  use, intrinsic :: iso_c_binding
  implicit none
 
#ifdef HAVE_METAL
 
  integer, parameter :: metalSuccess = 0
 
  interface
 
     integer(c_int) function metalalloc(ptr_d, s) &
          bind(c, name = 'metal_alloc')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr) :: ptr_d
       integer(c_size_t), value :: s
     end function metalalloc
 
     integer(c_int) function metalfree(ptr_d) &
          bind(c, name = 'metal_free')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: ptr_d
     end function metalfree
 
     integer(c_int) function metalmemcpyhtod(dst_d, src, s) &
          bind(c, name = 'metal_memcpy_htod')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: dst_d, src
       integer(c_size_t), value :: s
     end function metalmemcpyhtod
 
     integer(c_int) function metalmemcpydtoh(dst, src_d, s) &
          bind(c, name = 'metal_memcpy_dtoh')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: dst, src_d
       integer(c_size_t), value :: s
     end function metalmemcpydtoh
 
     integer(c_int) function metalmemcpydtod(dst_d, src_d, s) &
          bind(c, name = 'metal_memcpy_dtod')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: dst_d, src_d
       integer(c_size_t), value :: s
     end function metalmemcpydtod
 
     integer(c_int) function metalmemset(buf_d, v, s) &
          bind(c, name = 'metal_memset')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: buf_d
       integer(c_int), value :: v
       integer(c_size_t), value :: s
     end function metalmemset
 
     integer(c_int) function metaldevicesynchronize() &
          bind(c, name = 'metal_device_sync')
       use, intrinsic :: iso_c_binding
       implicit none
     end function metaldevicesynchronize
 
     integer(c_int) function metalstreamsynchronize(stream) &
          bind(c, name = 'metal_stream_sync')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: stream
     end function metalstreamsynchronize
 
     integer(c_int) function metalstreamcreate(stream) &
          bind(c, name = 'metal_stream_create')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr) :: stream
     end function metalstreamcreate
 
     integer(c_int) function metalstreamdestroy(stream) &
          bind(c, name = 'metal_stream_destroy')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: stream
     end function metalstreamdestroy
 
     integer(c_int) function metaleventcreate(event) &
          bind(c, name = 'metal_event_create')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr) :: event
     end function metaleventcreate
 
     integer(c_int) function metaleventdestroy(event) &
          bind(c, name = 'metal_event_destroy')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: event
     end function metaleventdestroy
 
     integer(c_int) function metaleventrecord(event, stream) &
          bind(c, name = 'metal_event_record')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: event, stream
     end function metaleventrecord
 
     integer(c_int) function metaleventsynchronize(event) &
          bind(c, name = 'metal_event_sync')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: event
     end function metaleventsynchronize
 
     integer(c_int) function metalstreamwaitevent(stream, event) &
          bind(c, name = 'metal_stream_wait_event')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: stream, event
     end function metalstreamwaitevent
 
     subroutine metal_device_name_c(name, len) &
          bind(c, name = 'metal_device_name')
       use, intrinsic :: iso_c_binding
       implicit none
       type(c_ptr), value :: name
       integer(c_int), value :: len
     end subroutine metal_device_name_c
 
     integer(c_int) function metal_device_count_c() &
          bind(c, name = 'metal_device_count')
       use, intrinsic :: iso_c_binding
       implicit none
     end function metal_device_count_c
 
  end interface
 
contains
 
  subroutine metal_init(glb_cmd_queue, aux_cmd_queue)
    type(c_ptr), intent(inout) :: glb_cmd_queue
    type(c_ptr), intent(inout) :: aux_cmd_queue
 
    interface
       subroutine metal_init_c(glb_q, aux_q) &
            bind(c, name = 'metal_init')
         use, intrinsic :: iso_c_binding
         implicit none
         type(c_ptr) :: glb_q
         type(c_ptr) :: aux_q
       end subroutine metal_init_c
    end interface
 
    call metal_init_c(glb_cmd_queue, aux_cmd_queue)
  end subroutine metal_init
 
  subroutine metal_finalize(glb_cmd_queue, aux_cmd_queue)
    type(c_ptr), intent(inout) :: glb_cmd_queue
    type(c_ptr), intent(inout) :: aux_cmd_queue
 
    interface
       subroutine metal_finalize_c(glb_q, aux_q) &
            bind(c, name = 'metal_finalize')
         use, intrinsic :: iso_c_binding
         implicit none
         type(c_ptr), value :: glb_q
         type(c_ptr), value :: aux_q
       end subroutine metal_finalize_c
    end interface
 
    call metal_finalize_c(glb_cmd_queue, aux_cmd_queue)
  end subroutine metal_finalize
 
  subroutine metal_device_name(name)
    character(len=*), intent(inout) :: name
    character(kind=c_char, len=256), target :: c_name
    integer :: end_pos
 
    call metal_device_name_c(c_loc(c_name), 256)
 
    end_pos = scan(c_name, c_null_char)
    if (end_pos .ge. 2) then
       name(1:end_pos-1) = c_name(1:end_pos-1)
    end if
  end subroutine metal_device_name
 
  integer function metal_device_count()
    metal_device_count = metal_device_count_c()
  end function metal_device_count
 
#endif
 
end module metal_intf