-:    0:Source:modperl_perl_pp.c
        -:    0:Object:modperl_perl_pp.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:static enum opcode MP_pp_map[] = {
        -:   19:#ifdef MP_REFGEN_FIXUP
        -:   20:    OP_SREFGEN,
        -:   21:#endif
        -:   22:    OP_REQUIRE
        -:   23:};
        -:   24:
        -:   25:typedef OP * (*modperl_pp_t)(pTHX);
        -:   26:
        -:   27:static modperl_pp_t MP_PERL_ppaddr[MP_OP_max];
        -:   28:
        -:   29:#ifdef MP_REFGEN_FIXUP
        -:   30:
        -:   31:/*
        -:   32: * nasty workaround for bug fixed in bleedperl (11536 + 11553)
        -:   33: * XXX: when 5.8.0 is released + stable, we will require 5.8.0
        -:   34: * if ithreads are enabled.
        -:   35: */
        -:   36:
        -:   37:static OP *modperl_pp_srefgen(pTHX)
        -:   38:{
        -:   39:    dSP;
        -:   40:    OP *o;
        -:   41:    SV *sv = *SP;
        -:   42:
        -:   43:    if (SvPADTMP(sv) && IS_PADGV(sv)) {
        -:   44:        /* prevent S_refto from making a copy of the GV,
        -:   45:         * tricking it to SvREFCNT_inc and point to this one instead.
        -:   46:         */
        -:   47:        SvPADTMP_off(sv);
        -:   48:    }
        -:   49:    else {
        -:   50:        sv = Nullsv;
        -:   51:    }
        -:   52:
        -:   53:    /* o = Perl_pp_srefgen(aTHX) */
        -:   54:    o = MP_PERL_ppaddr[MP_OP_SREFGEN](aTHX);
        -:   55:
        -:   56:    if (sv) {
        -:   57:        /* restore original flags */
        -:   58:        SvPADTMP_on(sv);
        -:   59:    }
        -:   60:
        -:   61:    return o;
        -:   62:}
        -:   63:
        -:   64:#endif /* MP_REFGEN_FIXUP */
        -:   65:
        -:   66:static OP *modperl_pp_require(pTHX)
    11587:   67:{
        -:   68:    /* nothing yet */
    11587:   69:    return MP_PERL_ppaddr[MP_OP_REQUIRE](aTHX);
        -:   70:}
        -:   71:
        -:   72:static modperl_pp_t MP_ppaddr[] = {
        -:   73:#ifdef MP_REFGEN_FIXUP
        -:   74:    MEMBER_TO_FPTR(modperl_pp_srefgen),
        -:   75:#endif
        -:   76:    MEMBER_TO_FPTR(modperl_pp_require)
        -:   77:};
        -:   78:
        -:   79:void modperl_perl_pp_set(modperl_perl_opcode_e idx)
        8:   80:{
        8:   81:    int pl_idx = MP_pp_map[idx];
        -:   82:
        -:   83:    /* save original */
        8:   84:    MP_PERL_ppaddr[idx] = PL_ppaddr[pl_idx];
        -:   85:
        -:   86:    /* replace with our own */
        8:   87:    PL_ppaddr[pl_idx] = MP_ppaddr[idx];
        -:   88:}
        -:   89:
        -:   90:void modperl_perl_pp_set_all(void)
        8:   91:{
        8:   92:    int i;
        -:   93:
       16:   94:    for (i=0; i<MP_OP_max; i++) {
        8:   95:        modperl_perl_pp_set(i);
        -:   96:    }
        -:   97:}
        -:   98:
        -:   99:void modperl_perl_pp_unset(modperl_perl_opcode_e idx)
        4:  100:{
        4:  101:    int pl_idx = MP_pp_map[idx];
        -:  102:
        -:  103:    /* restore original */
        4:  104:    PL_ppaddr[pl_idx] = MP_PERL_ppaddr[idx];
        -:  105:}
        -:  106:
        -:  107:void modperl_perl_pp_unset_all(void)
        4:  108:{
        4:  109:    int i;
        -:  110:
        8:  111:    for (i=0; i<MP_OP_max; i++) {
        4:  112:        modperl_perl_pp_unset(i);
        -:  113:    }
        -:  114:}