| 1 | ! ============================================================================== |
| 2 | ! Module: performance |
| 3 | ! Purpose: Performance monitoring and optimization for fortsh |
| 4 | ! ============================================================================== |
| 5 | module performance |
| 6 | use iso_fortran_env, only: output_unit, error_unit, int64 |
| 7 | use iso_c_binding, only: c_long |
| 8 | implicit none |
| 9 | |
| 10 | ! Performance monitoring state |
| 11 | logical :: perf_monitoring_enabled = .false. |
| 12 | logical :: memory_tracking_enabled = .true. |
| 13 | |
| 14 | ! Timing information |
| 15 | integer(int64) :: startup_time = 0 |
| 16 | integer(int64) :: total_commands = 0 |
| 17 | integer(int64) :: total_parse_time = 0 |
| 18 | integer(int64) :: total_exec_time = 0 |
| 19 | integer(int64) :: total_glob_time = 0 |
| 20 | |
| 21 | ! Memory tracking |
| 22 | integer :: total_allocations = 0 |
| 23 | integer :: current_allocations = 0 |
| 24 | integer :: peak_allocations = 0 |
| 25 | integer(int64) :: total_memory_used = 0 |
| 26 | integer(int64) :: peak_memory_used = 0 |
| 27 | integer(int64) :: current_memory_used = 0 |
| 28 | |
| 29 | ! Memory pools for common allocations |
| 30 | integer, parameter :: MAX_POOLED_TOKENS = 100 |
| 31 | integer, parameter :: MAX_TOKEN_POOLS = 10 |
| 32 | |
| 33 | type :: token_pool_t |
| 34 | character(len=256), allocatable :: tokens(:) |
| 35 | integer :: size = 0 |
| 36 | integer :: capacity = 0 |
| 37 | logical :: in_use = .false. |
| 38 | end type token_pool_t |
| 39 | |
| 40 | type(token_pool_t) :: token_pools(MAX_TOKEN_POOLS) |
| 41 | integer :: next_pool_index = 1 |
| 42 | |
| 43 | contains |
| 44 | |
| 45 | ! Initialize performance monitoring |
| 46 | subroutine init_performance_monitoring() |
| 47 | integer(int64) :: current_time |
| 48 | |
| 49 | call system_clock(current_time) |
| 50 | startup_time = current_time |
| 51 | |
| 52 | ! Initialize token pools |
| 53 | call init_token_pools() |
| 54 | |
| 55 | if (perf_monitoring_enabled) then |
| 56 | write(output_unit, '(a)') '[PERF] Performance monitoring initialized' |
| 57 | end if |
| 58 | end subroutine |
| 59 | |
| 60 | ! Enable/disable performance monitoring |
| 61 | subroutine set_performance_monitoring(enabled) |
| 62 | logical, intent(in) :: enabled |
| 63 | perf_monitoring_enabled = enabled |
| 64 | end subroutine |
| 65 | |
| 66 | ! Start timing a section |
| 67 | subroutine start_timer(timer_id, start_time) |
| 68 | character(len=*), intent(in) :: timer_id |
| 69 | integer(int64), intent(out) :: start_time |
| 70 | |
| 71 | call system_clock(start_time) |
| 72 | |
| 73 | if (perf_monitoring_enabled) then |
| 74 | write(output_unit, '(a,a)') '[PERF] Started timer: ', timer_id |
| 75 | end if |
| 76 | end subroutine |
| 77 | |
| 78 | ! End timing a section and accumulate |
| 79 | subroutine end_timer(timer_id, start_time, total_time) |
| 80 | character(len=*), intent(in) :: timer_id |
| 81 | integer(int64), intent(in) :: start_time |
| 82 | integer(int64), intent(inout) :: total_time |
| 83 | |
| 84 | integer(int64) :: end_time, elapsed |
| 85 | |
| 86 | call system_clock(end_time) |
| 87 | elapsed = end_time - start_time |
| 88 | total_time = total_time + elapsed |
| 89 | |
| 90 | if (perf_monitoring_enabled) then |
| 91 | write(output_unit, '(a,a,a,i15,a)') '[PERF] ', timer_id, ' took ', elapsed, ' ticks' |
| 92 | end if |
| 93 | end subroutine |
| 94 | |
| 95 | ! Track memory allocation |
| 96 | subroutine track_allocation(size_bytes, location) |
| 97 | integer, intent(in) :: size_bytes |
| 98 | character(len=*), intent(in), optional :: location |
| 99 | |
| 100 | if (.not. memory_tracking_enabled) return |
| 101 | |
| 102 | total_allocations = total_allocations + 1 |
| 103 | current_allocations = current_allocations + 1 |
| 104 | current_memory_used = current_memory_used + size_bytes |
| 105 | total_memory_used = total_memory_used + size_bytes |
| 106 | |
| 107 | if (current_allocations > peak_allocations) then |
| 108 | peak_allocations = current_allocations |
| 109 | end if |
| 110 | |
| 111 | if (current_memory_used > peak_memory_used) then |
| 112 | peak_memory_used = current_memory_used |
| 113 | end if |
| 114 | |
| 115 | if (perf_monitoring_enabled .and. present(location)) then |
| 116 | write(output_unit, '(a,i15,a,a)') '[MEM] Allocated ', size_bytes, ' bytes at ', location |
| 117 | end if |
| 118 | end subroutine |
| 119 | |
| 120 | ! Track memory deallocation |
| 121 | subroutine track_deallocation(size_bytes, location) |
| 122 | integer, intent(in) :: size_bytes |
| 123 | character(len=*), intent(in), optional :: location |
| 124 | |
| 125 | if (.not. memory_tracking_enabled) return |
| 126 | |
| 127 | current_allocations = current_allocations - 1 |
| 128 | current_memory_used = current_memory_used - size_bytes |
| 129 | |
| 130 | if (perf_monitoring_enabled .and. present(location)) then |
| 131 | write(output_unit, '(a,i15,a,a)') '[MEM] Deallocated ', size_bytes, ' bytes at ', location |
| 132 | end if |
| 133 | end subroutine |
| 134 | |
| 135 | ! Initialize token memory pools |
| 136 | subroutine init_token_pools() |
| 137 | integer :: i |
| 138 | |
| 139 | do i = 1, MAX_TOKEN_POOLS |
| 140 | token_pools(i)%capacity = 0 |
| 141 | token_pools(i)%size = 0 |
| 142 | token_pools(i)%in_use = .false. |
| 143 | end do |
| 144 | end subroutine |
| 145 | |
| 146 | ! Get a token array from pool (performance optimization) |
| 147 | function get_pooled_tokens(requested_size) result(pool_id) |
| 148 | integer, intent(in) :: requested_size |
| 149 | integer :: pool_id |
| 150 | |
| 151 | integer :: i, best_fit, best_fit_size |
| 152 | |
| 153 | pool_id = 0 |
| 154 | best_fit = 0 |
| 155 | best_fit_size = huge(1) |
| 156 | |
| 157 | ! Find best-fit available pool |
| 158 | do i = 1, MAX_TOKEN_POOLS |
| 159 | if (.not. token_pools(i)%in_use .and. & |
| 160 | token_pools(i)%capacity >= requested_size .and. & |
| 161 | token_pools(i)%capacity < best_fit_size) then |
| 162 | best_fit = i |
| 163 | best_fit_size = token_pools(i)%capacity |
| 164 | end if |
| 165 | end do |
| 166 | |
| 167 | if (best_fit > 0) then |
| 168 | pool_id = best_fit |
| 169 | token_pools(pool_id)%in_use = .true. |
| 170 | token_pools(pool_id)%size = requested_size |
| 171 | else |
| 172 | ! Create new pool |
| 173 | pool_id = find_empty_pool() |
| 174 | if (pool_id > 0) then |
| 175 | allocate(token_pools(pool_id)%tokens(requested_size)) |
| 176 | token_pools(pool_id)%capacity = requested_size |
| 177 | token_pools(pool_id)%size = requested_size |
| 178 | token_pools(pool_id)%in_use = .true. |
| 179 | call track_allocation(requested_size * 256, 'token_pool') |
| 180 | end if |
| 181 | end if |
| 182 | end function |
| 183 | |
| 184 | ! Return tokens to pool |
| 185 | subroutine return_pooled_tokens(pool_id) |
| 186 | integer, intent(in) :: pool_id |
| 187 | |
| 188 | if (pool_id > 0 .and. pool_id <= MAX_TOKEN_POOLS) then |
| 189 | token_pools(pool_id)%in_use = .false. |
| 190 | token_pools(pool_id)%size = 0 |
| 191 | end if |
| 192 | end subroutine |
| 193 | |
| 194 | ! Find empty pool slot |
| 195 | function find_empty_pool() result(pool_id) |
| 196 | integer :: pool_id |
| 197 | integer :: i |
| 198 | |
| 199 | pool_id = 0 |
| 200 | do i = 1, MAX_TOKEN_POOLS |
| 201 | if (token_pools(i)%capacity == 0) then |
| 202 | pool_id = i |
| 203 | return |
| 204 | end if |
| 205 | end do |
| 206 | end function |
| 207 | |
| 208 | ! Optimize memory usage by compacting pools |
| 209 | subroutine optimize_memory_pools() |
| 210 | integer :: i, active_pools |
| 211 | |
| 212 | active_pools = 0 |
| 213 | |
| 214 | ! Count active pools |
| 215 | do i = 1, MAX_TOKEN_POOLS |
| 216 | if (token_pools(i)%capacity > 0 .and. .not. token_pools(i)%in_use) then |
| 217 | active_pools = active_pools + 1 |
| 218 | end if |
| 219 | end do |
| 220 | |
| 221 | ! If we have too many unused pools, deallocate smaller ones |
| 222 | if (active_pools > 5) then |
| 223 | do i = 1, MAX_TOKEN_POOLS |
| 224 | if (token_pools(i)%capacity > 0 .and. & |
| 225 | .not. token_pools(i)%in_use .and. & |
| 226 | token_pools(i)%capacity < 20) then |
| 227 | |
| 228 | if (allocated(token_pools(i)%tokens)) then |
| 229 | call track_deallocation(token_pools(i)%capacity * 256, 'token_pool_cleanup') |
| 230 | deallocate(token_pools(i)%tokens) |
| 231 | end if |
| 232 | token_pools(i)%capacity = 0 |
| 233 | end if |
| 234 | end do |
| 235 | end if |
| 236 | end subroutine |
| 237 | |
| 238 | ! Print performance statistics |
| 239 | subroutine print_performance_stats() |
| 240 | integer(int64) :: current_time, uptime, count_rate |
| 241 | real :: avg_parse_time, avg_exec_time, avg_glob_time |
| 242 | |
| 243 | call system_clock(current_time, count_rate) |
| 244 | uptime = current_time - startup_time |
| 245 | |
| 246 | write(output_unit, '(a)') '' |
| 247 | write(output_unit, '(a)') '====================================' |
| 248 | write(output_unit, '(a)') 'FORTSH PERFORMANCE STATISTICS' |
| 249 | write(output_unit, '(a)') '====================================' |
| 250 | |
| 251 | ! Runtime statistics |
| 252 | write(output_unit, '(a,f0.3,a)') 'Uptime: ', real(uptime)/real(count_rate), ' seconds' |
| 253 | write(output_unit, '(a,i15)') 'Total commands: ', total_commands |
| 254 | |
| 255 | ! Performance timings |
| 256 | if (total_commands > 0) then |
| 257 | avg_parse_time = real(total_parse_time) / real(count_rate) / real(total_commands) * 1000.0 |
| 258 | avg_exec_time = real(total_exec_time) / real(count_rate) / real(total_commands) * 1000.0 |
| 259 | avg_glob_time = real(total_glob_time) / real(count_rate) / real(total_commands) * 1000.0 |
| 260 | |
| 261 | write(output_unit, '(a,f0.3,a)') 'Avg parse time: ', avg_parse_time, ' ms' |
| 262 | write(output_unit, '(a,f0.3,a)') 'Avg exec time: ', avg_exec_time, ' ms' |
| 263 | write(output_unit, '(a,f0.3,a)') 'Avg glob time: ', avg_glob_time, ' ms' |
| 264 | end if |
| 265 | |
| 266 | write(output_unit, '(a)') '' |
| 267 | write(output_unit, '(a)') 'MEMORY STATISTICS' |
| 268 | write(output_unit, '(a)') '====================================' |
| 269 | write(output_unit, '(a,i15)') 'Total allocations: ', total_allocations |
| 270 | write(output_unit, '(a,i15)') 'Current allocations:', current_allocations |
| 271 | write(output_unit, '(a,i15)') 'Peak allocations: ', peak_allocations |
| 272 | write(output_unit, '(a,i15,a)') 'Total memory used: ', total_memory_used, ' bytes' |
| 273 | write(output_unit, '(a,i15,a)') 'Current memory: ', current_memory_used, ' bytes' |
| 274 | write(output_unit, '(a,i15,a)') 'Peak memory: ', peak_memory_used, ' bytes' |
| 275 | |
| 276 | ! Memory pool statistics |
| 277 | call print_pool_stats() |
| 278 | |
| 279 | write(output_unit, '(a)') '====================================' |
| 280 | end subroutine |
| 281 | |
| 282 | ! Print memory pool statistics |
| 283 | subroutine print_pool_stats() |
| 284 | integer :: i, active_pools, total_capacity, used_capacity |
| 285 | |
| 286 | active_pools = 0 |
| 287 | total_capacity = 0 |
| 288 | used_capacity = 0 |
| 289 | |
| 290 | do i = 1, MAX_TOKEN_POOLS |
| 291 | if (token_pools(i)%capacity > 0) then |
| 292 | active_pools = active_pools + 1 |
| 293 | total_capacity = total_capacity + token_pools(i)%capacity |
| 294 | if (token_pools(i)%in_use) then |
| 295 | used_capacity = used_capacity + token_pools(i)%size |
| 296 | end if |
| 297 | end if |
| 298 | end do |
| 299 | |
| 300 | write(output_unit, '(a)') '' |
| 301 | write(output_unit, '(a)') 'TOKEN POOL STATISTICS' |
| 302 | write(output_unit, '(a)') '====================================' |
| 303 | write(output_unit, '(a,i15)') 'Active pools: ', active_pools |
| 304 | write(output_unit, '(a,i15)') 'Total capacity: ', total_capacity |
| 305 | write(output_unit, '(a,i15)') 'Used capacity: ', used_capacity |
| 306 | if (total_capacity > 0) then |
| 307 | write(output_unit, '(a,f0.1,a)') 'Pool utilization: ', & |
| 308 | real(used_capacity)/real(total_capacity)*100.0, '%' |
| 309 | end if |
| 310 | end subroutine |
| 311 | |
| 312 | ! Cleanup performance monitoring |
| 313 | subroutine cleanup_performance_monitoring() |
| 314 | integer :: i |
| 315 | |
| 316 | ! Cleanup token pools |
| 317 | do i = 1, MAX_TOKEN_POOLS |
| 318 | if (allocated(token_pools(i)%tokens)) then |
| 319 | deallocate(token_pools(i)%tokens) |
| 320 | end if |
| 321 | end do |
| 322 | |
| 323 | if (perf_monitoring_enabled) then |
| 324 | write(output_unit, '(a)') '[PERF] Performance monitoring cleaned up' |
| 325 | end if |
| 326 | end subroutine |
| 327 | |
| 328 | ! Get memory usage estimate |
| 329 | function get_memory_usage() result(usage_kb) |
| 330 | integer :: usage_kb |
| 331 | usage_kb = int(current_memory_used / 1024) |
| 332 | end function |
| 333 | |
| 334 | ! Check if memory optimization is needed |
| 335 | function needs_memory_optimization() result(needed) |
| 336 | logical :: needed |
| 337 | needed = (current_memory_used > 1024*1024) .or. (current_allocations > 100) |
| 338 | end function |
| 339 | |
| 340 | ! Perform automatic memory optimization |
| 341 | subroutine auto_optimize_memory() |
| 342 | if (needs_memory_optimization()) then |
| 343 | call optimize_memory_pools() |
| 344 | if (perf_monitoring_enabled) then |
| 345 | write(output_unit, '(a)') '[PERF] Auto memory optimization triggered' |
| 346 | end if |
| 347 | end if |
| 348 | end subroutine |
| 349 | |
| 350 | end module performance |