! Module  : photcache_m
! Purpose : Define photache_t type, for representing a cached
!           table of photint_t's
!
! Copyright 2022 Rich Townsend & The MSG Team
!
! This file is part of MSG. MSG is free software: you can redistribute
! it and/or modify it under the terms of the GNU General Public
! License as published by the Free Software Foundation, version 3.
!
! MSG is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
! License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.

#:include 'forum.inc'

module photcache_m

   ! Uses

   use forum_m

   use photint_m
   use photsource_m
   use stat_m

   use ISO_FORTRAN_ENV

   ! No implicit typing

   implicit none

   ! Parameter definitions

   integer(ID), parameter :: INITIAL_LIMIT = 128

   ! Derived-type definitions

   type :: photcache_t
      private
      class(photsource_t), allocatable     :: photsource
      type(photint_element_t), allocatable :: photint_elements(:)
      integer, allocatable                 :: ref_counts(:)
      integer, allocatable                 :: exp_counts(:)
      integer(ID)                          :: ssize
      integer                              :: limit
      integer                              :: n
   contains
      private
      procedure, public :: get_limit
      procedure, public :: get_usage
      procedure, public :: set_limit
      procedure, public :: fetch
      procedure, public :: release
      procedure, public :: flush
      procedure         :: trim_
   end type photcache_t

   type :: photint_element_t
      class(photint_t), allocatable :: photint
   end type photint_element_t

   ! Interfaces

   interface photcache_t
      module procedure photcache_t_
   end interface photcache_t

   ! Access specifiers

   private

   public :: photcache_t

contains

   function photcache_t_(n) result(photcache)

      integer, intent(in) :: n
      type(photcache_t)   :: photcache

      ! Construct photcache with n entries

      allocate(photcache%photint_elements(n))

      allocate(photcache%ref_counts(n))
      photcache%ref_counts = 0

      allocate(photcache%exp_counts(n))
      photcache%exp_counts = 0

      photcache%ssize = 0
      photcache%limit = INITIAL_LIMIT

      photcache%n = n

      ! Finish

      return

   end function photcache_t_

   !****

   subroutine get_limit(self, limit)

      class(photcache_t), intent(in) :: self
      integer, intent(out)           :: limit
         
      ! Get the memory usage limit

      limit = self%limit

      ! Finish

      return

   end subroutine get_limit

   !****

   subroutine get_usage(self, usage)

      class(photcache_t), intent(in) :: self
      integer, intent(out)           :: usage
         
      ! Get the memory usage (megabytes)

      usage = self%ssize/(1024*1024)

      ! Finish

      return

   end subroutine get_usage

   !****

   subroutine set_limit(self, limit, stat)

      class(photcache_t), intent(inout) :: self
      integer, intent(in)               :: limit
      integer, intent(out), optional    :: stat

      ! Set the memory usage limit

      if (limit < 0) then
         if (PRESENT(stat)) then
            stat = STAT_INVALID_ARGUMENT
            return
         else
            @:ABORT('invalid argument')
         end if
      end if

      self%limit = limit

      ! Trim the cache

      call self%trim_()
         
      ! Finish

      if (PRESENT(stat)) stat = STAT_OK

      return

   end subroutine set_limit

   !****

   subroutine fetch(self, i, fetch_proc, photint, stat)

      class(photcache_t), target, intent(inout) :: self
      integer, intent(in)                       :: i
      interface
         subroutine fetch_proc(i, photint, stat)
            use photint_m
            integer, intent(in)                        :: i
            class(photint_t), allocatable, intent(out) :: photint
            integer, intent(out), optional             :: stat
         end subroutine fetch_proc
      end interface
      class(photint_t), pointer, intent(out) :: photint
      integer, intent(out), optional         :: stat

      integer(ID) :: ssize
         
      ! Fetch the i'th photint

      if (i < 0 .OR. i > self%n) then
         if (PRESENT(stat)) then
            stat = STAT_INVALID_ARGUMENT
            return
         else
            @:ABORT('invalid argument')
         end if
      end if

      ! Check if the entry is already present

      if (self%ref_counts(i) > 0) then

         ! Present and referenced; increment the reference counter

         self%ref_counts(i) = self%ref_counts(i) + 1

      elseif (self%exp_counts(i) > 0) then

         ! Present but not referenced; set the reference and expiry
         ! counters

         self%ref_counts(i) = 1
         self%exp_counts(i) = 0
            
      else

         ! Fetch the photint

         call fetch_proc(i, self%photint_elements(i)%photint, stat)
         if (PRESENT(stat)) then
            if (stat /= STAT_OK) return
         end if

         ! Update the storage size

         call self%photint_elements(i)%photint%get_ssize(ssize)

         self%ssize = self%ssize + ssize

         ! Set the reference and expiry counters

         self%ref_counts(i) = 1
         self%exp_counts(i) = 0

      end if

      ! Set up the return pointer

      photint => self%photint_elements(i)%photint

      ! Finish

      if (PRESENT(stat)) stat = STAT_OK

      return

   end subroutine fetch

   !****

   subroutine release(self, i, stat)

      class(photcache_t), target, intent(inout) :: self
      integer, intent(in)                       :: i
      integer, intent(out), optional            :: stat

      ! Release the i'th photint

      if (i < 0 .OR. i > self%n) then
         if (PRESENT(stat)) then
            stat = STAT_INVALID_ARGUMENT
            return
         else
            @:ABORT('invalid argument')
         end if
      end if

      if (self%ref_counts(i) > 0) then

         ! Decrement the reference counter

         self%ref_counts(i) = self%ref_counts(i) - 1

         ! If it's reached zero, set the expiry counter

         if (self%ref_counts(i) == 0) self%exp_counts(i) = MAXVAL(self%exp_counts) + 1
         
      end if

      ! Trim the cache

      call self%trim_()

      ! Finish

      return

   end subroutine release

   !****

   subroutine flush(self)

      class(photcache_t), intent(inout) :: self

      integer :: i

      ! Flush the cache

      flush_loop : do i = 1, self%n

         if (self%exp_counts(i) > 0 .OR. self%ref_counts(i) > 0) then
            deallocate(self%photint_elements(i)%photint)
         end if

      end do flush_loop

      self%ref_counts = 0
      self%exp_counts = 0

      self%ssize = 0

      ! Finish

      return

   end subroutine flush

   !****

   subroutine trim_(self)

      class(photcache_t), intent(inout) :: self

      integer     :: j
      integer     :: usage
      integer(ID) :: ssize

      ! Trim the cache so that its memory usage is smaller than limit

      trim_loop : do

         ! Check usage

         call self%get_usage(usage)

         if (usage <= self%limit) exit trim_loop

         ! Find the unreferenced entry with the smallest expiry time

         j = MINLOC(self%exp_counts, DIM=1, mask=self%ref_counts == 0 .AND. self%exp_counts > 0)

         ! Deallocate it

         call self%photint_elements(j)%photint%get_ssize(ssize)

         deallocate(self%photint_elements(j)%photint)

         self%ssize = self%ssize - ssize

         ! Update expiry counter

         self%exp_counts(j) = 0

      end do trim_loop

      ! Finish

      return

   end subroutine trim_

end module photcache_m
