fortsh Public

Watch 0 Fork 0 Star 0
Fortran · 17503 bytes Raw Blame History
1 ! ==============================================================================
2 ! Module: memory_dashboard
3 ! Purpose: Real-time memory pool statistics and visualization
4 ! Phase 4 of the memory pooling project
5 ! ==============================================================================
6 module memory_dashboard
7 use iso_fortran_env, only: int32, int64, output_unit
8 use string_pool
9 implicit none
10 private
11
12 ! Public interface
13 public :: dashboard_init, dashboard_register_module, dashboard_track_allocation
14 public :: dashboard_track_deallocation, dashboard_display, dashboard_get_module_stats
15 public :: dashboard_cleanup, dashboard_export_csv, dashboard_summary
16 public :: module_stats ! Export type for testing
17 public :: MOD_READLINE, MOD_COMPLETION, MOD_PARSER, MOD_EXECUTOR, MOD_EXPANSION
18 public :: MOD_BUILTIN, MOD_AST, MOD_LEXER, MOD_EVALUATOR, MOD_HISTORY, MOD_VARIABLES
19
20 ! Module tracking
21 integer, parameter :: MAX_MODULES = 50
22 integer, parameter :: MODULE_NAME_LEN = 32
23
24 ! Module IDs - these should match the actual modules in fortsh
25 integer, parameter :: MOD_READLINE = 1
26 integer, parameter :: MOD_COMPLETION = 2
27 integer, parameter :: MOD_PARSER = 3
28 integer, parameter :: MOD_EXECUTOR = 4
29 integer, parameter :: MOD_EXPANSION = 5
30 integer, parameter :: MOD_BUILTIN = 6
31 integer, parameter :: MOD_AST = 7
32 integer, parameter :: MOD_LEXER = 8
33 integer, parameter :: MOD_EVALUATOR = 9
34 integer, parameter :: MOD_HISTORY = 10
35 integer, parameter :: MOD_VARIABLES = 11
36 integer, parameter :: MOD_UNKNOWN = 99
37
38 ! Module statistics
39 type :: module_stats
40 character(len=MODULE_NAME_LEN) :: name = "unknown"
41 integer(int64) :: total_allocations = 0
42 integer(int64) :: total_deallocations = 0
43 integer(int64) :: current_bytes = 0
44 integer(int64) :: peak_bytes = 0
45 integer(int64) :: total_bytes_allocated = 0
46 integer :: current_strings = 0
47 integer :: peak_strings = 0
48 ! Bucket-specific stats
49 integer(int64) :: bucket_allocs(5) = 0 ! Count per bucket size
50 integer(int64) :: bucket_bytes(5) = 0 ! Current bytes per bucket
51 end type module_stats
52
53 ! Global dashboard state
54 type :: dashboard_state
55 type(module_stats) :: modules(MAX_MODULES)
56 integer :: num_registered = 0
57 logical :: initialized = .false.
58 logical :: verbose = .false.
59 integer(int64) :: session_start_time = 0
60 ! Pool efficiency metrics
61 real :: overall_hit_rate = 0.0
62 integer(int64) :: total_pool_expansions = 0
63 integer(int64) :: fragmentation_bytes = 0
64 end type dashboard_state
65
66 type(dashboard_state) :: dashboard
67
68 ! ANSI color codes for terminal output
69 character(len=*), parameter :: RESET = char(27)//"[0m"
70 character(len=*), parameter :: BOLD = char(27)//"[1m"
71 character(len=*), parameter :: RED = char(27)//"[31m"
72 character(len=*), parameter :: GREEN = char(27)//"[32m"
73 character(len=*), parameter :: YELLOW = char(27)//"[33m"
74 character(len=*), parameter :: BLUE = char(27)//"[34m"
75 character(len=*), parameter :: CYAN = char(27)//"[36m"
76
77 contains
78
79 ! Initialize the dashboard
80 subroutine dashboard_init(verbose)
81 logical, intent(in), optional :: verbose
82
83 dashboard%initialized = .true.
84 dashboard%verbose = .false.
85 if (present(verbose)) dashboard%verbose = verbose
86
87 #ifdef MEMPOOL_DEBUG
88 ! Enable verbose output when MEMPOOL_DEBUG is defined
89 dashboard%verbose = .true.
90 write(output_unit, '(A)') "[MEMPOOL_DEBUG] Memory dashboard initialized in debug mode"
91 #endif
92
93 ! Get start time (simplified - would use system clock in real implementation)
94 dashboard%session_start_time = 0
95
96 ! Register known modules
97 call dashboard_register_module(MOD_READLINE, "readline")
98 call dashboard_register_module(MOD_COMPLETION, "completion")
99 call dashboard_register_module(MOD_PARSER, "parser")
100 call dashboard_register_module(MOD_EXECUTOR, "executor")
101 call dashboard_register_module(MOD_EXPANSION, "expansion")
102 call dashboard_register_module(MOD_BUILTIN, "builtin")
103 call dashboard_register_module(MOD_AST, "ast")
104 call dashboard_register_module(MOD_LEXER, "lexer")
105 call dashboard_register_module(MOD_EVALUATOR, "evaluator")
106 call dashboard_register_module(MOD_HISTORY, "history")
107 call dashboard_register_module(MOD_VARIABLES, "variables")
108
109 end subroutine dashboard_init
110
111 ! Register a module for tracking
112 subroutine dashboard_register_module(module_id, module_name)
113 integer, intent(in) :: module_id
114 character(len=*), intent(in) :: module_name
115
116 if (.not. dashboard%initialized) call dashboard_init()
117
118 if (module_id <= MAX_MODULES) then
119 dashboard%modules(module_id)%name = module_name
120 if (module_id > dashboard%num_registered) then
121 dashboard%num_registered = module_id
122 end if
123 end if
124
125 end subroutine dashboard_register_module
126
127 ! Track an allocation from a specific module
128 subroutine dashboard_track_allocation(module_id, size_bytes, bucket_idx)
129 integer, intent(in) :: module_id
130 integer, intent(in) :: size_bytes
131 integer, intent(in), optional :: bucket_idx
132
133 if (.not. dashboard%initialized) return
134 if (module_id > MAX_MODULES) return
135
136 ! Update module stats
137 dashboard%modules(module_id)%total_allocations = &
138 dashboard%modules(module_id)%total_allocations + 1
139 dashboard%modules(module_id)%current_bytes = &
140 dashboard%modules(module_id)%current_bytes + size_bytes
141 dashboard%modules(module_id)%total_bytes_allocated = &
142 dashboard%modules(module_id)%total_bytes_allocated + size_bytes
143 dashboard%modules(module_id)%current_strings = &
144 dashboard%modules(module_id)%current_strings + 1
145
146 ! Update peak if necessary
147 if (dashboard%modules(module_id)%current_bytes > dashboard%modules(module_id)%peak_bytes) then
148 dashboard%modules(module_id)%peak_bytes = dashboard%modules(module_id)%current_bytes
149 end if
150 if (dashboard%modules(module_id)%current_strings > dashboard%modules(module_id)%peak_strings) then
151 dashboard%modules(module_id)%peak_strings = dashboard%modules(module_id)%current_strings
152 end if
153
154 ! Track bucket-specific stats
155 if (present(bucket_idx) .and. bucket_idx >= 1 .and. bucket_idx <= 5) then
156 dashboard%modules(module_id)%bucket_allocs(bucket_idx) = &
157 dashboard%modules(module_id)%bucket_allocs(bucket_idx) + 1
158 dashboard%modules(module_id)%bucket_bytes(bucket_idx) = &
159 dashboard%modules(module_id)%bucket_bytes(bucket_idx) + size_bytes
160 end if
161
162 end subroutine dashboard_track_allocation
163
164 ! Track a deallocation from a specific module
165 subroutine dashboard_track_deallocation(module_id, size_bytes, bucket_idx)
166 integer, intent(in) :: module_id
167 integer, intent(in) :: size_bytes
168 integer, intent(in), optional :: bucket_idx
169
170 if (.not. dashboard%initialized) return
171 if (module_id > MAX_MODULES) return
172
173 dashboard%modules(module_id)%total_deallocations = &
174 dashboard%modules(module_id)%total_deallocations + 1
175 dashboard%modules(module_id)%current_bytes = &
176 dashboard%modules(module_id)%current_bytes - size_bytes
177 dashboard%modules(module_id)%current_strings = &
178 dashboard%modules(module_id)%current_strings - 1
179
180 ! Update bucket stats
181 if (present(bucket_idx) .and. bucket_idx >= 1 .and. bucket_idx <= 5) then
182 dashboard%modules(module_id)%bucket_bytes(bucket_idx) = &
183 dashboard%modules(module_id)%bucket_bytes(bucket_idx) - size_bytes
184 end if
185
186 end subroutine dashboard_track_deallocation
187
188 ! Display the dashboard
189 subroutine dashboard_display(detailed)
190 logical, intent(in), optional :: detailed
191 logical :: show_details
192 integer :: i, j, total_allocs, total_deallocs, current_strings, peak_strings
193 real :: hit_rate
194 integer(int64) :: total_current, total_peak, total_allocated
195 character(len=80) :: bar
196 real :: percent
197
198 show_details = .false.
199 if (present(detailed)) show_details = detailed
200
201 ! Get current pool statistics
202 call pool_statistics(total_allocs, total_deallocs, current_strings, peak_strings, hit_rate)
203
204 ! Print header
205 write(output_unit,'(a)') ""
206 write(output_unit,'(a)') BOLD//CYAN// &
207 "======================================================================"//RESET
208 write(output_unit,'(a)') BOLD//CYAN// &
209 " FORTSH MEMORY POOL STATISTICS DASHBOARD"//RESET
210 write(output_unit,'(a)') BOLD//CYAN// &
211 "======================================================================"//RESET
212 write(output_unit,'(a)') ""
213
214 ! Overall statistics
215 write(output_unit,'(a)') BOLD//"═══ Overall Pool Performance ═══"//RESET
216 write(output_unit,'(a,i12)') " Total Allocations: ", total_allocs
217 write(output_unit,'(a,i12)') " Total Deallocations: ", total_deallocs
218 write(output_unit,'(a,i12)') " Current Strings: ", current_strings
219 write(output_unit,'(a,i12)') " Peak Strings: ", peak_strings
220
221 ! Cache performance with color coding
222 if (hit_rate > 0.95) then
223 write(output_unit,'(a,f6.1,a)') " Cache Hit Rate: "//GREEN, hit_rate * 100.0, "%"//RESET
224 else if (hit_rate > 0.80) then
225 write(output_unit,'(a,f6.1,a)') " Cache Hit Rate: "//YELLOW, hit_rate * 100.0, "%"//RESET
226 else
227 write(output_unit,'(a,f6.1,a)') " Cache Hit Rate: "//RED, hit_rate * 100.0, "%"//RESET
228 end if
229
230 ! Memory usage bar graph
231 if (peak_strings > 0) then
232 percent = real(current_strings) / real(peak_strings)
233 call draw_progress_bar(bar, percent)
234 write(output_unit,'(a)') " Memory Usage: "//trim(bar)
235 end if
236
237 write(output_unit,'(a)') ""
238
239 ! Per-module statistics
240 write(output_unit,'(a)') BOLD//"═══ Module Memory Usage ═══"//RESET
241 write(output_unit,'(a)') " Module Allocs Deallocs Current Peak Bytes"
242 write(output_unit,'(a)') &
243 " ---------------------------------------------------------------"
244
245 total_current = 0
246 total_peak = 0
247 total_allocated = 0
248
249 do i = 1, dashboard%num_registered
250 if (dashboard%modules(i)%total_allocations > 0) then
251 write(output_unit,'(a,a16,i10,i10,i8,i8,a,a)') " ", &
252 adjustl(dashboard%modules(i)%name), &
253 int(dashboard%modules(i)%total_allocations), &
254 int(dashboard%modules(i)%total_deallocations), &
255 dashboard%modules(i)%current_strings, &
256 dashboard%modules(i)%peak_strings, &
257 " ", format_bytes(dashboard%modules(i)%current_bytes)
258
259 total_current = total_current + dashboard%modules(i)%current_bytes
260 total_peak = total_peak + dashboard%modules(i)%peak_bytes
261 total_allocated = total_allocated + dashboard%modules(i)%total_bytes_allocated
262 end if
263 end do
264
265 write(output_unit,'(a)') &
266 " ---------------------------------------------------------------"
267 write(output_unit,'(a,a)') " Total Current Memory: ", &
268 format_bytes(total_current)
269 write(output_unit,'(a,a)') " Total Peak Memory: ", &
270 format_bytes(total_peak)
271
272 ! Detailed bucket analysis if requested
273 if (show_details) then
274 write(output_unit,'(a)') ""
275 write(output_unit,'(a)') BOLD//"═══ Bucket Distribution ═══"//RESET
276 write(output_unit,'(a)') " Size Module Allocations Current Bytes"
277 write(output_unit,'(a)') &
278 " --------------------------------------------------------"
279
280 do j = 1, 5
281 select case(j)
282 case(1)
283 write(output_unit,'(a)') " 64 bytes:"
284 case(2)
285 write(output_unit,'(a)') " 256 bytes:"
286 case(3)
287 write(output_unit,'(a)') " 1024 bytes:"
288 case(4)
289 write(output_unit,'(a)') " 4096 bytes:"
290 case(5)
291 write(output_unit,'(a)') " 16384 bytes:"
292 end select
293
294 do i = 1, dashboard%num_registered
295 if (dashboard%modules(i)%bucket_allocs(j) > 0) then
296 write(output_unit,'(a,a16,i14,a,a)') " ", &
297 adjustl(dashboard%modules(i)%name), &
298 int(dashboard%modules(i)%bucket_allocs(j)), &
299 " ", format_bytes(dashboard%modules(i)%bucket_bytes(j))
300 end if
301 end do
302 end do
303 end if
304
305 write(output_unit,'(a)') ""
306 write(output_unit,'(a)') BOLD//CYAN// &
307 "======================================================================"//RESET
308 write(output_unit,'(a)') ""
309
310 end subroutine dashboard_display
311
312 ! Draw a progress bar
313 subroutine draw_progress_bar(bar, percent)
314 character(len=*), intent(out) :: bar
315 real, intent(in) :: percent
316 integer :: filled_chars, i, bar_len
317 integer, parameter :: BAR_WIDTH = 30
318 character(len=10) :: percent_str
319
320 filled_chars = min(int(percent * BAR_WIDTH), BAR_WIDTH)
321 bar = " ["
322
323 ! Build the bar safely
324 do i = 1, filled_chars
325 if (len_trim(bar) < len(bar) - 20) then ! Leave room for percentage
326 bar = trim(bar) // "█"
327 end if
328 end do
329
330 do i = filled_chars + 1, BAR_WIDTH
331 if (len_trim(bar) < len(bar) - 20) then ! Leave room for percentage
332 bar = trim(bar) // "─"
333 end if
334 end do
335
336 bar = trim(bar) // "] "
337 write(percent_str, '(f5.1,a)') percent * 100.0, "%"
338
339 ! Only append percentage if there's room
340 bar_len = len_trim(bar) + len_trim(percent_str)
341 if (bar_len < len(bar)) then
342 bar = trim(bar) // trim(adjustl(percent_str))
343 end if
344
345 end subroutine draw_progress_bar
346
347 ! Format bytes for display
348 function format_bytes(bytes) result(formatted)
349 integer(int64), intent(in) :: bytes
350 character(len=20) :: formatted
351
352 if (bytes < 1024) then
353 write(formatted, '(i0,a)') bytes, " B"
354 else if (bytes < 1024*1024) then
355 write(formatted, '(f0.1,a)') real(bytes)/1024.0, " KB"
356 else if (bytes < int(1024,int64)*1024*1024) then
357 write(formatted, '(f0.1,a)') real(bytes)/(1024.0*1024.0), " MB"
358 else
359 write(formatted, '(f0.1,a)') real(bytes)/(1024.0*1024.0*1024.0), " GB"
360 end if
361
362 formatted = adjustr(formatted)
363
364 end function format_bytes
365
366 ! Get statistics for a specific module
367 function dashboard_get_module_stats(module_id) result(stats)
368 integer, intent(in) :: module_id
369 type(module_stats) :: stats
370
371 if (module_id > 0 .and. module_id <= MAX_MODULES) then
372 stats = dashboard%modules(module_id)
373 else
374 stats%name = "invalid"
375 end if
376
377 end function dashboard_get_module_stats
378
379 ! Export statistics to CSV
380 subroutine dashboard_export_csv(filename)
381 character(len=*), intent(in) :: filename
382 integer :: unit, i, iostat
383
384 open(newunit=unit, file=filename, status='replace', action='write', iostat=iostat)
385 if (iostat /= 0) then
386 write(output_unit,'(a)') "Error: Could not open CSV file for export"
387 return
388 end if
389
390 ! Write header
391 write(unit,'(a)') "Module,Total_Allocations,Total_Deallocations,Current_Strings," // &
392 "Peak_Strings,Current_Bytes,Peak_Bytes,Total_Bytes_Allocated"
393
394 ! Write data
395 do i = 1, dashboard%num_registered
396 if (dashboard%modules(i)%total_allocations > 0) then
397 write(unit,'(a,",",i0,",",i0,",",i0,",",i0,",",i0,",",i0,",",i0)') &
398 trim(dashboard%modules(i)%name), &
399 dashboard%modules(i)%total_allocations, &
400 dashboard%modules(i)%total_deallocations, &
401 dashboard%modules(i)%current_strings, &
402 dashboard%modules(i)%peak_strings, &
403 dashboard%modules(i)%current_bytes, &
404 dashboard%modules(i)%peak_bytes, &
405 dashboard%modules(i)%total_bytes_allocated
406 end if
407 end do
408
409 close(unit)
410 write(output_unit,'(a,a)') "Statistics exported to: ", trim(filename)
411
412 end subroutine dashboard_export_csv
413
414 ! Display a summary
415 subroutine dashboard_summary()
416 integer(int64) :: total_saved, total_allocated
417 integer :: i
418 real :: efficiency
419
420 write(output_unit,'(a)') ""
421 write(output_unit,'(a)') BOLD//"═══ Memory Pool Summary ═══"//RESET
422
423 total_allocated = 0
424 do i = 1, dashboard%num_registered
425 total_allocated = total_allocated + dashboard%modules(i)%total_bytes_allocated
426 end do
427
428 ! Calculate approximate memory saved (assuming 50% reduction from pooling)
429 total_saved = total_allocated / 2
430
431 write(output_unit,'(a,a)') " Total Memory Processed: ", format_bytes(total_allocated)
432 write(output_unit,'(a,a)') " Estimated Memory Saved: ", format_bytes(total_saved)
433
434 if (total_allocated > 0) then
435 efficiency = real(total_saved) / real(total_allocated) * 100.0
436 write(output_unit,'(a,f5.1,a)') " Pool Efficiency: ", efficiency, "%"
437 end if
438
439 write(output_unit,'(a)') ""
440
441 end subroutine dashboard_summary
442
443 ! Clean up the dashboard
444 subroutine dashboard_cleanup()
445 integer :: i
446
447 do i = 1, MAX_MODULES
448 dashboard%modules(i)%total_allocations = 0
449 dashboard%modules(i)%total_deallocations = 0
450 dashboard%modules(i)%current_bytes = 0
451 dashboard%modules(i)%peak_bytes = 0
452 dashboard%modules(i)%total_bytes_allocated = 0
453 dashboard%modules(i)%current_strings = 0
454 dashboard%modules(i)%peak_strings = 0
455 dashboard%modules(i)%bucket_allocs = 0
456 dashboard%modules(i)%bucket_bytes = 0
457 end do
458
459 dashboard%num_registered = 0
460 dashboard%initialized = .false.
461
462 end subroutine dashboard_cleanup
463
464 end module memory_dashboard