src/pmc/addrregistry.pmc

   1 /*
   2 Copyright (C) 2005-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/addrregistry.pmc - A DOD Registry PMC
   8
   9 =head1 DESCRIPTION
  10
  11 The AddrRegistry class provides the equivalence of reference counts
  12 mainly for extenders and embedders of Parrot. The hash keys are the
  13 addresses of the key PMC, values are reference counts, i.e. the
  14 difference of (set_pmc_keyed - delete_pmc_keyed). If the reference
  15 goes to zero, the entry is deleted physically.
  16
  17 Please note that you have to anchor an instance of AddrRegistry yourself with
  18 C<Parrot_register_pmc> if it isn't visible to Parrot.
  19
  20 =head2 Functions
  21
  22 =over 4
  23
  24 =cut
  25
  26 */
  27
  28 #include "parrot/parrot.h"
  29
  30 /* included manually to prevent breaking C++ builds -- see RT #56534 */
  31 #include "parrot/hash.h"
  32 #include "pmc_hash.h"
  33
  34 pmclass AddrRegistry need_ext provides hash {
  35     ATTR Hash *hash;    /* a PMC Hash */
  36 /*
  37
  38 =item C<void init()>
  39
  40 Initializes the instance.
  41
  42 =item C<void destroy()>
  43
  44 Free hash structure.
  45
  46 =cut
  47
  48 */
  49
  50     VTABLE void init() {
  51         Hash                       *registry;
  52         Parrot_AddrRegistry * const addr_registry =
  53             mem_allocate_zeroed_typed(Parrot_AddrRegistry);
  54
  55         PMC_data(SELF)      = addr_registry;
  56         PObj_custom_mark_destroy_SETALL(SELF);
  57
  58         parrot_new_pmc_hash_x(SELF, enum_type_int, Hash_key_type_PMC,
  59                               int_compare, key_hash_int);
  60
  61         registry            = (Hash*)PMC_struct_val(SELF);
  62
  63         /* this hack can go away when parrot_new_pmc_hash_x behaves */
  64         addr_registry->hash = registry;
  65         registry->container = SELF;
  66     }
  67
  68     VTABLE void destroy() {
  69         if (PMC_data(SELF)) {
  70             Parrot_AddrRegistry * const registry = PARROT_ADDRREGISTRY(SELF);
  71
  72             parrot_hash_destroy(INTERP, registry->hash);
  73             PMC_data(SELF) = NULL;
  74         }
  75     }
  76
  77 /*
  78
  79 =item C<void mark()>
  80
  81 Marks the hash as live.
  82
  83 =cut
  84
  85 */
  86
  87     VTABLE void mark() {
  88         if (PMC_data(SELF))
  89             parrot_mark_hash(INTERP, PARROT_ADDRREGISTRY(SELF)->hash);
  90     }
  91
  92 /*
  93
  94 =item C<INTVAL get_integer_keyed(PMC *key)>
  95
  96 Returns the reference count for C<key> or 0 if the key doesn't exist.
  97
  98 =item C<INTVAL elements()>
  99
 100 Returns the number of elements in the hash.
 101
 102 =item C<INTVAL get_bool()>
 103
 104 Returns true if the hash size is not zero.
 105
 106 =cut
 107
 108 */
 109
 110     VTABLE INTVAL get_integer_keyed(PMC *key) {
 111         Hash   *hash  = PARROT_ADDRREGISTRY(SELF)->hash;
 112         void   *value = parrot_hash_get(INTERP, hash, key);
 113
 114         if (value)
 115             return (INTVAL)value;
 116
 117         return 0;
 118     }
 119
 120     VTABLE INTVAL elements() {
 121         return parrot_hash_size(INTERP, PARROT_ADDRREGISTRY(SELF)->hash);
 122     }
 123
 124     VTABLE INTVAL get_bool() {
 125         return parrot_hash_size(INTERP, PARROT_ADDRREGISTRY(SELF)->hash) != 0;
 126     }
 127 /*
 128
 129 =item C<void set_pmc_keyed(PMC *key, PMC *value)>
 130
 131 Increment the reference count of C<key>. If the entry doesn't exist
 132 create it. The C<value> is always ignored.
 133
 134 =item C<void set_integer_keyed(PMC *key, INTVAL value)>
 135
 136 Set the given value.
 137
 138 =item C<void delete_keyed(PMC *key)>
 139
 140 Decrement the reference count of C<key>. If the reference count
 141 reaches 0, delete the entry.
 142
 143
 144 =cut
 145
 146 */
 147
 148     VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
 149         Hash       * const hash = PARROT_ADDRREGISTRY(SELF)->hash;
 150         void       *oldval      = parrot_hash_get(INTERP, hash, key);
 151         long        newval      = 1;
 152         UNUSED(value);
 153
 154         if (oldval)
 155             newval += (long)oldval;
 156
 157         parrot_hash_put(INTERP, hash, key, (void *)newval);
 158     }
 159
 160     VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
 161         Hash *hash = PARROT_ADDRREGISTRY(SELF)->hash;
 162         parrot_hash_put(INTERP, hash, key, (void *)value);
 163     }
 164
 165     VTABLE void delete_keyed(PMC *key) {
 166         Hash       * const hash  = PARROT_ADDRREGISTRY(SELF)->hash;
 167         void              *value = parrot_hash_get(INTERP, hash, key);
 168
 169         /* these casts look bad, but they avoid type punning warnings with -O */
 170         if (value) {
 171             long val = (long)value;
 172             if (val == 1L)
 173                 parrot_hash_delete(INTERP, hash, key);
 174             else {
 175                 value = (void *)(--val);
 176                 parrot_hash_put(INTERP, hash, key, value);
 177             }
 178         }
 179     }
 180
 181 /*
 182
 183 =item C<PMC *get_iter ()>
 184
 185 Return a new iterator for the PMC.
 186
 187 =item C<PMC *get_pmc_keyed(PMC *key)>
 188
 189 If called from iteration, return the key PMC, else PMCNULL is returned.
 190
 191 =cut
 192
 193 */
 194
 195     VTABLE PMC *get_iter() {
 196         return Parrot_Hash_get_iter(INTERP, SELF);
 197     }
 198
 199     VTABLE PMC *get_pmc_keyed(PMC *key) {
 200         Hash * const hash = PARROT_ADDRREGISTRY(SELF)->hash;
 201
 202         if (KEY_IS_HASH_ITERATOR(key))
 203             return (PMC *)parrot_hash_get_idx(INTERP, hash, key);
 204
 205         return PMCNULL;
 206     }
 207 }
 208
 209 /*
 210
 211 =back
 212
 213 =head1 SEE ALSO
 214
 215 F<src/pmc.c:dod_register_pmc()>
 216
 217 =cut
 218
 219 */
 220
 221 /*
 222  * Local variables:
 223  *   c-file-style: "parrot"
 224  * End:
 225  * vim: expandtab shiftwidth=4:
 226  */