10 #include "../base/base_uses.f90"
35 PUBLIC :: callgraph_type
36 PUBLIC :: callgraph_item_type
41 TYPE private_item_type
43 INTEGER(kind=int_4),
DIMENSION(2) :: key = 0_int_4
44 TYPE(call_stat_type),
POINTER ::
value => null()
45 INTEGER(KIND=int_8) :: hash = 0_int_8
46 TYPE(private_item_type),
POINTER :: next => null()
47 END TYPE private_item_type
50 TYPE private_item_p_type
52 TYPE(private_item_type),
POINTER :: p => null()
53 END TYPE private_item_p_type
58 TYPE(private_item_p_type),
DIMENSION(:),
POINTER :: buckets => null()
60 END TYPE callgraph_type
63 TYPE callgraph_item_type
64 INTEGER(kind=int_4),
DIMENSION(2) :: key = 0_int_4
65 TYPE(call_stat_type),
POINTER ::
value => null()
66 END TYPE callgraph_item_type
78 TYPE(callgraph_type),
INTENT(inout) :: hash_map
79 INTEGER,
INTENT(in),
OPTIONAL :: initial_capacity
81 INTEGER :: initial_capacity_
83 IF (
PRESENT(initial_capacity))
THEN
84 initial_capacity_ = initial_capacity
86 initial_capacity_ = 11
89 IF (initial_capacity_ < 1) &
90 cpabort(
"initial_capacity < 1")
92 IF (
ASSOCIATED(hash_map%buckets)) &
93 cpabort(
"hash map is already initialized.")
95 ALLOCATE (hash_map%buckets(initial_capacity_))
106 FUNCTION callgraph_isready(hash_map)
RESULT(res)
107 TYPE(callgraph_type),
INTENT(inout) :: hash_map
109 res =
ASSOCIATED(hash_map%buckets)
110 END FUNCTION callgraph_isready
120 TYPE(callgraph_type),
INTENT(inout) :: hash_map
121 TYPE(private_item_type),
POINTER :: item, prev_item
124 cpassert(
ASSOCIATED(hash_map%buckets))
126 DO i = 1,
size(hash_map%buckets)
127 item => hash_map%buckets(i)%p
128 DO WHILE (
ASSOCIATED(item))
131 DEALLOCATE (prev_item)
135 DEALLOCATE (hash_map%buckets)
147 TYPE(callgraph_type),
INTENT(inout) :: hash_map
148 INTEGER(kind=int_4),
DIMENSION(2),
INTENT(in) :: key
149 TYPE(call_stat_type),
POINTER,
INTENT(in) :: value
150 INTEGER(KIND=int_8) ::
hash
151 cpassert(
ASSOCIATED(hash_map%buckets))
153 hash = callgraph_hash_function(key)
154 CALL callgraph_set_hashed(hash_map, key,
value,
hash)
165 RECURSIVE SUBROUTINE callgraph_set_hashed(hash_map, key, value, hash)
166 TYPE(callgraph_type),
INTENT(inout) :: hash_map
167 INTEGER(kind=int_4),
DIMENSION(2),
intent(in) :: key
168 TYPE(call_stat_type),
POINTER,
intent(in) :: value
169 INTEGER(KIND=int_8),
intent(in) ::
hash
170 TYPE(private_item_type),
POINTER :: item, new_item
171 INTEGER(KIND=int_8) ::
idx
173 idx = mod(
hash, int(
size(hash_map%buckets), kind=
int_8)) + 1
176 item => hash_map%buckets(
idx)%p
177 DO WHILE (
ASSOCIATED(item))
178 IF (item%hash ==
hash)
THEN
179 IF (callgraph_keys_equal(item%key, key))
THEN
188 IF (4*hash_map%size > 3*
size(hash_map%buckets))
THEN
189 call callgraph_change_capacity(hash_map, 2*
size(hash_map%buckets))
190 idx = mod(
hash, int(
size(hash_map%buckets), kind=
int_8)) + 1
197 new_item%value =>
value
198 new_item%next => hash_map%buckets(
idx)%p
199 hash_map%buckets(
idx)%p => new_item
200 hash_map%size = hash_map%size + 1
202 END SUBROUTINE callgraph_set_hashed
210 RECURSIVE SUBROUTINE callgraph_change_capacity(hash_map, new_capacity)
211 TYPE(callgraph_type),
INTENT(inout) :: hash_map
212 INTEGER,
INTENT(in) :: new_capacity
213 INTEGER :: i, old_size, new_cap
214 TYPE(private_item_type),
POINTER :: item, prev_item
215 TYPE(private_item_p_type),
DIMENSION(:),
POINTER :: old_buckets
216 new_cap = new_capacity
218 IF (new_cap > huge(i))
THEN
219 IF (
size(hash_map%buckets) == huge(i))
RETURN
222 cpassert(new_cap >= 1)
223 cpassert(4*hash_map%size < 3*new_cap)
225 old_size = hash_map%size
226 old_buckets => hash_map%buckets
227 ALLOCATE (hash_map%buckets(new_capacity))
229 DO i = 1,
size(old_buckets)
230 item => old_buckets(i)%p
231 DO WHILE (
ASSOCIATED(item))
232 CALL callgraph_set_hashed(hash_map, item%key, item%value, item%hash)
235 DEALLOCATE (prev_item)
239 DEALLOCATE (old_buckets)
241 cpassert(old_size == hash_map%size)
242 END SUBROUTINE callgraph_change_capacity
255 TYPE(callgraph_type),
INTENT(in) :: hash_map
256 INTEGER(kind=int_4),
DIMENSION(2),
INTENT(in) :: key
257 TYPE(call_stat_type),
POINTER,
INTENT(in),
OPTIONAL :: default_value
258 TYPE(call_stat_type),
POINTER :: value
259 TYPE(private_item_type),
POINTER :: item
260 INTEGER(KIND=int_8) ::
hash,
idx
262 cpassert(
ASSOCIATED(hash_map%buckets))
264 hash = callgraph_hash_function(key)
265 idx = mod(
hash, int(
size(hash_map%buckets), kind=
int_8)) + 1
267 item => hash_map%buckets(
idx)%p
268 DO WHILE (
ASSOCIATED(item))
269 IF (item%hash ==
hash)
THEN
270 IF (callgraph_keys_equal(item%key, key))
THEN
278 IF (
PRESENT(default_value))
THEN
279 value =>default_value
283 cpabort(
"Key not found.")
293 SUBROUTINE callgraph_del(hash_map, key)
294 TYPE(callgraph_type),
INTENT(inout) :: hash_map
295 INTEGER(kind=int_4),
DIMENSION(2),
INTENT(in) :: key
296 TYPE(private_item_type),
POINTER :: item, prev_item
297 INTEGER(KIND=int_8) ::
hash,
idx
299 cpassert(
ASSOCIATED(hash_map%buckets))
301 hash = callgraph_hash_function(key)
302 idx = mod(
hash, int(
size(hash_map%buckets), kind=
int_8)) + 1
304 item => hash_map%buckets(
idx)%p
306 DO WHILE (
ASSOCIATED(item))
307 IF (item%hash ==
hash)
THEN
308 IF (callgraph_keys_equal(item%key, key))
THEN
309 IF (
ASSOCIATED(prev_item))
THEN
310 prev_item%next => item%next
312 hash_map%buckets(
idx)%p => item%next
315 hash_map%size = hash_map%size - 1
323 cpabort(
"Key not found.")
324 END SUBROUTINE callgraph_del
333 TYPE(callgraph_type),
INTENT(IN) :: hash_map
336 cpassert(
ASSOCIATED(hash_map%buckets))
348 TYPE(callgraph_type),
INTENT(IN) :: hash_map
349 INTEGER(kind=int_4),
DIMENSION(2),
INTENT(IN) :: key
351 TYPE(private_item_type),
POINTER :: item
352 INTEGER(KIND=int_8) ::
hash,
idx
354 cpassert(
ASSOCIATED(hash_map%buckets))
357 IF (hash_map%size == 0)
RETURN
359 hash = callgraph_hash_function(key)
360 idx = mod(
hash, int(
size(hash_map%buckets), kind=
int_8)) + 1
362 item => hash_map%buckets(
idx)%p
363 DO WHILE (
ASSOCIATED(item))
364 IF (item%hash ==
hash)
THEN
365 IF (callgraph_keys_equal(item%key, key))
THEN
383 TYPE(callgraph_type),
INTENT(IN) :: hash_map
384 TYPE(callgraph_item_type),
DIMENSION(:),
POINTER :: items
386 TYPE(private_item_type),
POINTER :: item
389 cpassert(
ASSOCIATED(hash_map%buckets))
391 ALLOCATE (items(hash_map%size))
393 DO i = 1,
size(hash_map%buckets)
394 item => hash_map%buckets(i)%p
395 DO WHILE (
ASSOCIATED(item))
396 items(j)%key =item%key
397 items(j)%value =>item%value
403 cpassert(j == hash_map%size + 1)
415 SUBROUTINE callgraph_update(hash_map, from_hash_map)
416 TYPE(callgraph_type),
INTENT(inout) :: hash_map
417 TYPE(callgraph_type),
INTENT(in) :: from_hash_map
418 TYPE(callgraph_item_type),
DIMENSION(:),
POINTER :: from_items
421 cpassert(
ASSOCIATED(hash_map%buckets))
422 cpassert(
ASSOCIATED(from_hash_map%buckets))
425 DO i = 1,
size(from_items)
426 CALL callgraph_set(hash_map, from_items(i)%key, from_items(i)%value)
428 DEALLOCATE (from_items)
429 END SUBROUTINE callgraph_update
437 PURE FUNCTION callgraph_hash_function(key)
RESULT(hash)
438 INTEGER(kind=int_4),
DIMENSION(2),
INTENT(in) :: key
439 INTEGER(KIND=int_8) ::
hash
441 INTEGER(kind=int_8) :: k1, k2
444 hash = ior(k1, ishft(k2, 32))
445 END FUNCTION callgraph_hash_function
452 PURE FUNCTION callgraph_keys_equal(key1, key2)
RESULT(res)
453 INTEGER(kind=int_4),
DIMENSION(2),
INTENT(in) :: key1, key2
456 res = all(key1 == key2)
457 END FUNCTION callgraph_keys_equal
static unsigned int hash(const dbm_task_t task)
Private hash function based on Szudzik's elegant pairing. Using unsigned int to return a positive num...
static GRID_HOST_DEVICE int idx(const orbital a)
Return coset index of given orbital angular momentum.
subroutine, public callgraph_destroy(hash_map)
Deallocated the internal data-structures if the given hash map. Caution: If the stored keys or values...
integer function, public callgraph_size(hash_map)
Returns the number of key/value-items currently stored in the hash map.
subroutine, public callgraph_init(hash_map, initial_capacity)
Allocates the internal data-structures of the given hash map.
type(callgraph_item_type) function, dimension(:), pointer, public callgraph_items(hash_map)
Returns a pointer to an array of all key/value-items stored in the hash map. Caution: The caller is r...
logical function, public callgraph_haskey(hash_map, key)
Checks whether a given key is currently stored in the hash_map.
type(call_stat_type) function, pointer, public callgraph_get(hash_map, key, default_value)
Gets a value for a given key from the hash map. If the key is not found the default_value will be ret...
subroutine, public callgraph_set(hash_map, key, value)
Stores, and possibly overwrites, a given value under a given key.
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public int_4
Types used by timings.F and timings_report.F The types in this module are used within dict or list,...