-:    0:Source:modperl_svptr_table.c
        -:    0:Object:modperl_svptr_table.bb
        -:    1:/* Copyright 2002-2004 The Apache Software Foundation
        -:    2: *
        -:    3: * Licensed under the Apache License, Version 2.0 (the "License");
        -:    4: * you may not use this file except in compliance with the License.
        -:    5: * You may obtain a copy of the License at
        -:    6: *
        -:    7: *     http://www.apache.org/licenses/LICENSE-2.0
        -:    8: *
        -:    9: * Unless required by applicable law or agreed to in writing, software
        -:   10: * distributed under the License is distributed on an "AS IS" BASIS,
        -:   11: * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
        -:   12: * See the License for the specific language governing permissions and
        -:   13: * limitations under the License.
        -:   14: */
        -:   15:
        -:   16:#include "mod_perl.h"
        -:   17:
        -:   18:/*
        -:   19: * modperl_svptr_table api is an add-on to the Perl ptr_table_ api.
        -:   20: * we use a PTR_TBL_t to map config structures (e.g. from parsed
        -:   21: * httpd.conf or .htaccess), where each interpreter needs to have its
        -:   22: * own copy of the Perl SV object.  we do not use an HV* for this, because
        -:   23: * the HV keys must be SVs with a string value, too much overhead.
        -:   24: * we do not use an apr_hash_t because they only have the lifetime of
        -:   25: * the pool used to create them. which may or may not be the same lifetime
        -:   26: * of the objects we need to lookup.
        -:   27: */
        -:   28:
        -:   29:#ifdef USE_ITHREADS
        -:   30:
        -:   31:#ifdef MP_PERL_5_6_x
        -:   32:#   define my_sv_dup(s, p) sv_dup(s)
        -:   33:
        -:   34:typedef struct {
        -:   35:    AV *stashes;
        -:   36:    UV flags;
        -:   37:    PerlInterpreter *proto_perl;
        -:   38:} CLONE_PARAMS;
        -:   39:
        -:   40:#else
        -:   41:#   define my_sv_dup(s, p) sv_dup(s, p)
        -:   42:#endif
        -:   43:
        -:   44:/*
        -:   45: * copy a PTR_TBL_t whos PTR_TBL_ENT_t values are SVs.
        -:   46: * the SVs are dup-ed so each interpreter has its own copy.
        -:   47: */
        -:   48:PTR_TBL_t *modperl_svptr_table_clone(pTHX_ PerlInterpreter *proto_perl,
        -:   49:                                     PTR_TBL_t *source)
    #####:   50:{
    #####:   51:    UV i;
    #####:   52:    PTR_TBL_t *tbl;
    #####:   53:    PTR_TBL_ENT_t **src_ary, **dst_ary;
    #####:   54:    CLONE_PARAMS parms;
        -:   55:
    #####:   56:    Newz(0, tbl, 1, PTR_TBL_t);
    #####:   57:    tbl->tbl_max	= source->tbl_max;
    #####:   58:    tbl->tbl_items	= source->tbl_items;
    #####:   59:    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t *);
        -:   60:
    #####:   61:    dst_ary = tbl->tbl_ary;
    #####:   62:    src_ary = source->tbl_ary;
        -:   63:
    #####:   64:    Zero(&parms, 0, CLONE_PARAMS);
    #####:   65:    parms.flags = 0;
    #####:   66:    parms.stashes = newAV();
        -:   67:
    #####:   68:    for (i=0; i < source->tbl_max; i++, dst_ary++, src_ary++) {
    #####:   69:	PTR_TBL_ENT_t *src_ent, *dst_ent=NULL;
        -:   70:
    #####:   71:	if (!*src_ary) {
    #####:   72:	    continue;
        -:   73:        }
        -:   74:
    #####:   75:	for (src_ent = *src_ary;
        -:   76:             src_ent;
        -:   77:             src_ent = src_ent->next)
        -:   78:        {
    #####:   79:            if (dst_ent == NULL) {
    #####:   80:                Newz(0, dst_ent, 1, PTR_TBL_ENT_t);
    #####:   81:                *dst_ary = dst_ent;
        -:   82:            }
        -:   83:            else {
    #####:   84:                Newz(0, dst_ent->next, 1, PTR_TBL_ENT_t);
    #####:   85:                dst_ent = dst_ent->next;
        -:   86:            }
        -:   87:
        -:   88:            /* key is just a pointer we do not modify, no need to copy */
    #####:   89:            dst_ent->oldval = src_ent->oldval;
        -:   90:
    #####:   91:            dst_ent->newval =
    #####:   92:                SvREFCNT_inc(my_sv_dup((SV*)src_ent->newval, &parms));
        -:   93:        }
        -:   94:    }
        -:   95:
    #####:   96:    SvREFCNT_dec(parms.stashes);
        -:   97:
    #####:   98:    return tbl;
        -:   99:}
        -:  100:
        -:  101:#endif
        -:  102:
        -:  103:/*
        -:  104: * need to free the SV values in addition to ptr_table_free
        -:  105: */
        -:  106:void modperl_svptr_table_destroy(pTHX_ PTR_TBL_t *tbl)
        2:  107:{
        2:  108:    UV i;
        2:  109:    PTR_TBL_ENT_t **ary = tbl->tbl_ary;
        -:  110:
       42:  111:    for (i=0; i < tbl->tbl_max; i++, ary++) {
     1022:  112:	PTR_TBL_ENT_t *ent;
        -:  113:
     1022:  114:	if (!*ary) {
       40:  115:	    continue;
        -:  116:        }
        -:  117:
       88:  118:	for (ent = *ary; ent; ent = ent->next) {
       48:  119:            if (!ent->newval) {
       48:  120:                continue;
        -:  121:            }
        -:  122:
       48:  123:            SvREFCNT_dec((SV*)ent->newval);
       48:  124:            ent->newval = NULL;
        -:  125:        }
        -:  126:    }
        -:  127:
        2:  128:    modperl_svptr_table_free(aTHX_ tbl);
        -:  129:}
        -:  130:
        -:  131:/*
        -:  132: * the Perl ptr_table_ api does not provide a function to remove
        -:  133: * an entry from the table.  we need to SvREFCNT_dec the SV value
        -:  134: * anyhow.
        -:  135: */
        -:  136:void modperl_svptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *key)
       20:  137:{
       20:  138:    PTR_TBL_ENT_t *entry, **oentry;
       20:  139:    UV hash = PTR2UV(key);
        -:  140:
       20:  141:    oentry = &tbl->tbl_ary[hash & tbl->tbl_max];
       20:  142:    entry = *oentry;
        -:  143:
       20:  144:    for (; entry; oentry = &entry->next, entry = *oentry) {
       20:  145:	if (entry->oldval == key) {
       20:  146:            *oentry = entry->next;
       20:  147:            SvREFCNT_dec((SV*)entry->newval);
       20:  148:            Safefree(entry);
       20:  149:            tbl->tbl_items--;
       20:  150:	    return;
        -:  151:	}
        -:  152:    }
        -:  153:}
        -:  154:
        -:  155:/*
        -:  156: * XXX: the following are a copy of the Perl 5.8.0 Perl_ptr_table api
        -:  157: * renamed s/Perl_ptr/modperl_svptr/g;
        -:  158: * two reasons:
        -:  159: *   these functions do not exist without -DUSE_ITHREADS
        -:  160: *   the clear/free functions do not exist in 5.6.x
        -:  161: */
        -:  162:
        -:  163:/* create a new pointer-mapping table */
        -:  164:
        -:  165:PTR_TBL_t *
        -:  166:modperl_svptr_table_new(pTHX)
        4:  167:{
        4:  168:    PTR_TBL_t *tbl;
        4:  169:    Newz(0, tbl, 1, PTR_TBL_t);
        4:  170:    tbl->tbl_max	= 511;
        4:  171:    tbl->tbl_items	= 0;
        4:  172:    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
        4:  173:    return tbl;
        -:  174:}
        -:  175:
        -:  176:/* map an existing pointer using a table */
        -:  177:
        -:  178:void *
        -:  179:modperl_svptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv)
      419:  180:{
      419:  181:    PTR_TBL_ENT_t *tblent;
      419:  182:    UV hash = PTR2UV(sv);
      419:  183:    assert(tbl);
      419:  184:    tblent = tbl->tbl_ary[hash & tbl->tbl_max];
      461:  185:    for (; tblent; tblent = tblent->next) {
      353:  186:	if (tblent->oldval == sv)
      311:  187:	    return tblent->newval;
        -:  188:    }
      108:  189:    return (void*)NULL;
        -:  190:}
        -:  191:
        -:  192:/* add a new entry to a pointer-mapping table */
        -:  193:
        -:  194:void
        -:  195:modperl_svptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv)
      116:  196:{
      116:  197:    PTR_TBL_ENT_t *tblent, **otblent;
        -:  198:    /* XXX this may be pessimal on platforms where pointers aren't good
        -:  199:     * hash values e.g. if they grow faster in the most significant
        -:  200:     * bits */
      116:  201:    UV hash = PTR2UV(oldv);
      116:  202:    bool i = 1;
        -:  203:
      116:  204:    assert(tbl);
      116:  205:    otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
      142:  206:    for (tblent = *otblent; tblent; i=0, tblent = tblent->next) {
       26:  207:	if (tblent->oldval == oldv) {
    #####:  208:	    tblent->newval = newv;
    #####:  209:	    return;
        -:  210:	}
        -:  211:    }
      116:  212:    Newz(0, tblent, 1, PTR_TBL_ENT_t);
      116:  213:    tblent->oldval = oldv;
      116:  214:    tblent->newval = newv;
      116:  215:    tblent->next = *otblent;
      116:  216:    *otblent = tblent;
      116:  217:    tbl->tbl_items++;
      116:  218:    if (i && tbl->tbl_items > tbl->tbl_max)
    #####:  219:	modperl_svptr_table_split(aTHX_ tbl);
        -:  220:}
        -:  221:
        -:  222:/* double the hash bucket size of an existing ptr table */
        -:  223:
        -:  224:void
        -:  225:modperl_svptr_table_split(pTHX_ PTR_TBL_t *tbl)
    #####:  226:{
    #####:  227:    PTR_TBL_ENT_t **ary = tbl->tbl_ary;
    #####:  228:    UV oldsize = tbl->tbl_max + 1;
    #####:  229:    UV newsize = oldsize * 2;
    #####:  230:    UV i;
        -:  231:
    #####:  232:    Renew(ary, newsize, PTR_TBL_ENT_t*);
    #####:  233:    Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
    #####:  234:    tbl->tbl_max = --newsize;
    #####:  235:    tbl->tbl_ary = ary;
    #####:  236:    for (i=0; i < oldsize; i++, ary++) {
    #####:  237:	PTR_TBL_ENT_t **curentp, **entp, *ent;
    #####:  238:	if (!*ary)
    #####:  239:	    continue;
    #####:  240:	curentp = ary + oldsize;
    #####:  241:	for (entp = ary, ent = *ary; ent; ent = *entp) {
    #####:  242:	    if ((newsize & PTR2UV(ent->oldval)) != i) {
    #####:  243:		*entp = ent->next;
    #####:  244:		ent->next = *curentp;
    #####:  245:		*curentp = ent;
    #####:  246:		continue;
        -:  247:	    }
        -:  248:	    else
    #####:  249:		entp = &ent->next;
        -:  250:	}
        -:  251:    }
        -:  252:}
        -:  253:
        -:  254:/* remove all the entries from a ptr table */
        -:  255:
        -:  256:void
        -:  257:modperl_svptr_table_clear(pTHX_ PTR_TBL_t *tbl)
        2:  258:{
        2:  259:    register PTR_TBL_ENT_t **array;
        2:  260:    register PTR_TBL_ENT_t *entry;
        2:  261:    register PTR_TBL_ENT_t *oentry = Null(PTR_TBL_ENT_t*);
        2:  262:    UV riter = 0;
        2:  263:    UV max;
        -:  264:
        2:  265:    if (!tbl || !tbl->tbl_items) {
        2:  266:        return;
        -:  267:    }
        -:  268:
        2:  269:    array = tbl->tbl_ary;
        2:  270:    entry = array[0];
        2:  271:    max = tbl->tbl_max;
        -:  272:
     2054:  273:    for (;;) {
     1032:  274:        if (entry) {
       48:  275:            oentry = entry;
       48:  276:            entry = entry->next;
       48:  277:            Safefree(oentry);
        -:  278:        }
       48:  279:        if (!entry) {
     1024:  280:            if (++riter > max) {
     1022:  281:                break;
        -:  282:            }
     1022:  283:            entry = array[riter];
        -:  284:        }
        -:  285:    }
        -:  286:
        2:  287:    tbl->tbl_items = 0;
        -:  288:}
        -:  289:
        -:  290:/* clear and free a ptr table */
        -:  291:
        -:  292:void
        -:  293:modperl_svptr_table_free(pTHX_ PTR_TBL_t *tbl)
        2:  294:{
        2:  295:    if (!tbl) {
        2:  296:        return;
        -:  297:    }
        2:  298:    modperl_svptr_table_clear(aTHX_ tbl);
        2:  299:    Safefree(tbl->tbl_ary);
        2:  300:    Safefree(tbl);
        -:  301:}