Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@perl.apache.org
Date: 28 Aug 2002 03:16:20 -0000
Message-ID: <20020828031620.56439.qmail@icarus.apache.org>
From: dougm@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0/xs/Apache/Module Apache__Module.h

dougm       2002/08/27 20:16:20

  Modified:    lib/ModPerl Code.pm
               src/modules/perl modperl_perl.c modperl_perl.h
                        modperl_module.c
               xs/Apache/Module Apache__Module.h
  Log:
  integrate modperl_svptr_table api
  
  Revision  Changes    Path
  1.87      +1 -1      modperl-2.0/lib/ModPerl/Code.pm
  
  Index: Code.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
  retrieving revision 1.86
  retrieving revision 1.87
  diff -u -r1.86 -r1.87
  --- Code.pm	27 Aug 2002 04:21:53 -0000	1.86
  +++ Code.pm	28 Aug 2002 03:16:20 -0000	1.87
  @@ -569,7 +569,7 @@
   
   my @c_src_names = qw(interp tipool log config cmd options callback handler
                        gtop util io filter bucket mgv pcw global env cgi
  -                     perl perl_global perl_pp sys module);
  +                     perl perl_global perl_pp sys module svptr_table);
   my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
   my @c_names   = ('mod_perl', (map "modperl_$_", @c_src_names));
   sub c_files { [map { "$_.c" } @c_names, @g_c_names] }
  
  
  
  1.18      +0 -137    modperl-2.0/src/modules/perl/modperl_perl.c
  
  Index: modperl_perl.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.c,v
  retrieving revision 1.17
  retrieving revision 1.18
  diff -u -r1.17 -r1.18
  --- modperl_perl.c	27 Aug 2002 05:19:09 -0000	1.17
  +++ modperl_perl.c	28 Aug 2002 03:16:20 -0000	1.18
  @@ -146,140 +146,3 @@
       }
   #endif
   }
  -
  -/*
  - * modperl_svptr_table api is an add-on to the Perl ptr_table_ api.
  - * we use a PTR_TBL_t to map config structures (e.g. from parsed
  - * httpd.conf or .htaccess), where each interpreter needs to have its
  - * own copy of the Perl SV object.  we do not use an HV* for this, because
  - * the HV keys must be SVs with a string value, too much overhead.
  - * we do not use an apr_hash_t because they only have the lifetime of
  - * the pool used to create them. which may or may not be the same lifetime
  - * of the objects we need to lookup.
  - */
  -
  -#ifdef USE_ITHREADS
  -
  -#ifdef MP_PERL_5_6_x
  -#   define my_sv_dup(s, p) sv_dup(s)
  -
  -typedef struct {
  -    AV *stashes;
  -    UV flags;
  -    PerlInterpreter *proto_perl;
  -} CLONE_PARAMS;
  -
  -#else
  -#   define my_sv_dup(s, p) sv_dup(s, p)
  -#endif
  -
  -/*
  - * copy a PTR_TBL_t whos PTR_TBL_ENT_t values are SVs.
  - * the SVs are dup-ed so each interpreter has its own copy.
  - */
  -PTR_TBL_t *modperl_svptr_table_clone(pTHX_ PerlInterpreter *proto_perl,
  -                                     PTR_TBL_t *source)
  -{
  -    UV i;
  -    PTR_TBL_t *tbl;
  -    PTR_TBL_ENT_t **src_ary, **dst_ary;
  -    CLONE_PARAMS parms;
  -
  -    Newz(0, tbl, 1, PTR_TBL_t);
  -    tbl->tbl_max	= source->tbl_max;
  -    tbl->tbl_items	= source->tbl_items;
  -    Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t *);
  -
  -    dst_ary = tbl->tbl_ary;
  -    src_ary = source->tbl_ary;
  -
  -    Zero(&parms, 0, CLONE_PARAMS);
  -    parms.flags = 0;
  -    parms.stashes = newAV();
  -
  -    for (i=0; i < source->tbl_max; i++, dst_ary++, src_ary++) {
  -	PTR_TBL_ENT_t *src_ent, *dst_ent=NULL;
  -
  -	if (!*src_ary) {
  -	    continue;
  -        }
  -
  -	for (src_ent = *src_ary;
  -             src_ent;
  -             src_ent = src_ent->next)
  -        {
  -            if (dst_ent == NULL) {
  -                Newz(0, dst_ent, 1, PTR_TBL_ENT_t);
  -                *dst_ary = dst_ent;
  -            }
  -            else {
  -                Newz(0, dst_ent->next, 1, PTR_TBL_ENT_t);
  -                dst_ent = dst_ent->next;
  -            }
  -
  -            /* key is just a pointer we do not modify, no need to copy */
  -            dst_ent->oldval = src_ent->oldval;
  -
  -            dst_ent->newval =
  -                SvREFCNT_inc(my_sv_dup((SV*)src_ent->newval, &parms));
  -        }
  -    }
  -
  -    SvREFCNT_dec(parms.stashes);
  -
  -    return tbl;
  -}
  -
  -#endif
  -
  -/*
  - * need to free the SV values in addition to ptr_table_free
  - */
  -void modperl_svptr_table_destroy(pTHX_ PTR_TBL_t *tbl)
  -{
  -    UV i;
  -    PTR_TBL_ENT_t **ary = tbl->tbl_ary;
  -
  -    for (i=0; i < tbl->tbl_max; i++, ary++) {
  -	PTR_TBL_ENT_t *ent;
  -
  -	if (!*ary) {
  -	    continue;
  -        }
  -
  -	for (ent = *ary; ent; ent = ent->next) {
  -            if (!ent->newval) {
  -                continue;
  -            }
  -
  -            SvREFCNT_dec((SV*)ent->newval);
  -            ent->newval = NULL;
  -        }
  -    }
  -
  -    ptr_table_free(tbl);
  -}
  -
  -/*
  - * the Perl ptr_table_ api does not provide a function to remove
  - * an entry from the table.  we need to SvREFCNT_dec the SV value
  - * anyhow.
  - */
  -void modperl_svptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *key)
  -{
  -    PTR_TBL_ENT_t *entry, **oentry;
  -    UV hash = PTR2UV(key);
  -
  -    oentry = &tbl->tbl_ary[hash & tbl->tbl_max];
  -    entry = *oentry;
  -
  -    for (; entry; oentry = &entry->next, entry = *oentry) {
  -	if (entry->oldval == key) {
  -            *oentry = entry->next;
  -            SvREFCNT_dec((SV*)entry->newval);
  -            Safefree(entry);
  -            tbl->tbl_items--;
  -	    return;
  -	}
  -    }
  -}
  
  
  
  1.10      +0 -11     modperl-2.0/src/modules/perl/modperl_perl.h
  
  Index: modperl_perl.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.h,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- modperl_perl.h	27 Aug 2002 05:19:09 -0000	1.9
  +++ modperl_perl.h	28 Aug 2002 03:16:20 -0000	1.10
  @@ -13,15 +13,4 @@
   
   void modperl_perl_destruct(PerlInterpreter *perl);
   
  -#ifdef USE_ITHREADS
  -
  -PTR_TBL_t *modperl_svptr_table_clone(pTHX_ PerlInterpreter *proto_perl,
  -                                     PTR_TBL_t *source);
  -
  -#endif
  -
  -void modperl_svptr_table_destroy(pTHX_ PTR_TBL_t *tbl);
  -
  -void modperl_svptr_table_delete(pTHX_ PTR_TBL_t *tbl, void *key);
  -
   #endif /* MODPERL_PERL_H */
  
  
  
  1.3       +6 -6      modperl-2.0/src/modules/perl/modperl_module.c
  
  Index: modperl_module.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_module.c,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- modperl_module.c	27 Aug 2002 19:10:08 -0000	1.2
  +++ modperl_module.c	28 Aug 2002 03:16:20 -0000	1.3
  @@ -69,7 +69,7 @@
   
       sv = *svp;
       if (!SvIOK(sv) && create) {
  -        table = ptr_table_new();
  +        table = modperl_svptr_table_new(aTHX);
           sv_setiv(sv, (IV)table);
       }
       else {
  @@ -144,8 +144,8 @@
   
       PTR_TBL_t *table = modperl_module_config_table_get(aTHX_ TRUE);
       SV *mrg_obj = Nullsv,
  -        *base_obj = ptr_table_fetch(table, base),
  -        *add_obj  = ptr_table_fetch(table, add);
  +        *base_obj = modperl_svptr_table_fetch(aTHX_ table, base),
  +        *add_obj  = modperl_svptr_table_fetch(aTHX_ table, add);
   
       HV *stash;
   
  @@ -193,7 +193,7 @@
           mrg_obj = newSVsv(base_obj);
       }
   
  -    ptr_table_store(table, mrg, mrg_obj);
  +    modperl_svptr_table_store(aTHX_ table, mrg, mrg_obj);
   
       if (!is_startup) {
           modperl_module_config_obj_cleanup_register(aTHX_ p, table, mrg);
  @@ -236,7 +236,7 @@
        * modperl_module_cfg_t * directly and avoid the ptr_table
        * altogether.
        */
  -    if ((*obj = (SV*)ptr_table_fetch(table, cfg))) {
  +    if ((*obj = (SV*)modperl_svptr_table_fetch(aTHX_ table, cfg))) {
           /* object already exists */
           return NULL;
       }
  @@ -289,7 +289,7 @@
           modperl_module_config_obj_cleanup_register(aTHX_ p, table, cfg);
       }
   
  -    ptr_table_store(table, cfg, *obj);
  +    modperl_svptr_table_store(aTHX_ table, cfg, *obj);
   
       return NULL;
   }
  
  
  
  1.6       +1 -1      modperl-2.0/xs/Apache/Module/Apache__Module.h
  
  Index: Apache__Module.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/Apache/Module/Apache__Module.h,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- Apache__Module.h	27 Aug 2002 04:28:38 -0000	1.5
  +++ Apache__Module.h	28 Aug 2002 03:16:20 -0000	1.6
  @@ -75,7 +75,7 @@
           return Nullsv;
       }
   
  -    if (!(obj = ptr_table_fetch(table, ptr))) {
  +    if (!(obj = modperl_svptr_table_fetch(aTHX_ table, ptr))) {
           return Nullsv;
       }