home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-src.tgz / tar.out / fsf / perl / mg.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  26KB  |  1,410 lines
  1. /*    mg.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  */
  9.  
  10. /*
  11.  * "Sam sat on the ground and put his head in his hands.  'I wish I had never
  12.  * come here, and I don't want to see no more magic,' he said, and fell silent."
  13.  */
  14.  
  15. #include "EXTERN.h"
  16. #include "perl.h"
  17.  
  18. /* Omit -- it causes too much grief on mixed systems.
  19. #ifdef I_UNISTD
  20. # include <unistd.h>
  21. #endif
  22. */
  23.  
  24. /*
  25.  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  26.  */
  27.  
  28. struct magic_state {
  29.     SV* mgs_sv;
  30.     U32 mgs_flags;
  31. };
  32. typedef struct magic_state MGS;
  33.  
  34. static void restore_magic _((void *p));
  35.  
  36. static MGS *
  37. save_magic(sv)
  38. SV* sv;
  39. {
  40.     MGS* mgs;
  41.  
  42.     assert(SvMAGICAL(sv));
  43.  
  44.     mgs = (MGS*)safemalloc(sizeof(MGS));
  45.     mgs->mgs_sv = sv;
  46.     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
  47.     SAVEDESTRUCTOR(restore_magic, mgs);
  48.  
  49.     SvMAGICAL_off(sv);
  50.     SvREADONLY_off(sv);
  51.     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
  52.  
  53.     return mgs;
  54. }
  55.  
  56. static void
  57. restore_magic(p)
  58. void* p;
  59. {
  60.     MGS *mgs = (MGS*)p;
  61.     SV* sv = mgs->mgs_sv;
  62.  
  63.     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
  64.     {
  65.     if (mgs->mgs_flags)
  66.         SvFLAGS(sv) |= mgs->mgs_flags;
  67.     else
  68.         mg_magical(sv);
  69.     if (SvGMAGICAL(sv))
  70.         SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
  71.     }
  72.  
  73.     Safefree(mgs);
  74. }
  75.  
  76.  
  77. void
  78. mg_magical(sv)
  79. SV* sv;
  80. {
  81.     MAGIC* mg;
  82.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  83.     MGVTBL* vtbl = mg->mg_virtual;
  84.     if (vtbl) {
  85.         if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
  86.         SvGMAGICAL_on(sv);
  87.         if (vtbl->svt_set)
  88.         SvSMAGICAL_on(sv);
  89.         if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
  90.         SvRMAGICAL_on(sv);
  91.     }
  92.     }
  93. }
  94.  
  95. int
  96. mg_get(sv)
  97. SV* sv;
  98. {
  99.     MGS* mgs;
  100.     MAGIC* mg;
  101.     MAGIC** mgp;
  102.  
  103.     ENTER;
  104.     mgs = save_magic(sv);
  105.  
  106.     mgp = &SvMAGIC(sv);
  107.     while ((mg = *mgp) != 0) {
  108.     MGVTBL* vtbl = mg->mg_virtual;
  109.     if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
  110.         (*vtbl->svt_get)(sv, mg);
  111.         /* Ignore this magic if it's been deleted */
  112.         if (*mgp == mg && (mg->mg_flags & MGf_GSKIP))
  113.         mgs->mgs_flags = 0;
  114.     }
  115.     /* Advance to next magic (complicated by possible deletion) */
  116.     if (*mgp == mg)
  117.         mgp = &mg->mg_moremagic;
  118.     }
  119.  
  120.     LEAVE;
  121.     return 0;
  122. }
  123.  
  124. int
  125. mg_set(sv)
  126. SV* sv;
  127. {
  128.     MGS* mgs;
  129.     MAGIC* mg;
  130.     MAGIC* nextmg;
  131.  
  132.     ENTER;
  133.     mgs = save_magic(sv);
  134.  
  135.     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
  136.     MGVTBL* vtbl = mg->mg_virtual;
  137.     nextmg = mg->mg_moremagic;    /* it may delete itself */
  138.     if (mg->mg_flags & MGf_GSKIP) {
  139.         mg->mg_flags &= ~MGf_GSKIP;    /* setting requires another read */
  140.         mgs->mgs_flags = 0;
  141.     }
  142.     if (vtbl && vtbl->svt_set)
  143.         (*vtbl->svt_set)(sv, mg);
  144.     }
  145.  
  146.     LEAVE;
  147.     return 0;
  148. }
  149.  
  150. U32
  151. mg_len(sv)
  152. SV* sv;
  153. {
  154.     MAGIC* mg;
  155.     char *junk;
  156.     STRLEN len;
  157.  
  158.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  159.     MGVTBL* vtbl = mg->mg_virtual;
  160.     if (vtbl && vtbl->svt_len) {
  161.         ENTER;
  162.         save_magic(sv);
  163.         /* omit MGf_GSKIP -- not changed here */
  164.         len = (*vtbl->svt_len)(sv, mg);
  165.         LEAVE;
  166.         return len;
  167.     }
  168.     }
  169.  
  170.     junk = SvPV(sv, len);
  171.     return len;
  172. }
  173.  
  174. int
  175. mg_clear(sv)
  176. SV* sv;
  177. {
  178.     MAGIC* mg;
  179.  
  180.     ENTER;
  181.     save_magic(sv);
  182.  
  183.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  184.     MGVTBL* vtbl = mg->mg_virtual;
  185.     /* omit GSKIP -- never set here */
  186.     
  187.     if (vtbl && vtbl->svt_clear)
  188.         (*vtbl->svt_clear)(sv, mg);
  189.     }
  190.  
  191.     LEAVE;
  192.     return 0;
  193. }
  194.  
  195. MAGIC*
  196. mg_find(sv, type)
  197. SV* sv;
  198. int type;
  199. {
  200.     MAGIC* mg;
  201.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  202.     if (mg->mg_type == type)
  203.         return mg;
  204.     }
  205.     return 0;
  206. }
  207.  
  208. int
  209. mg_copy(sv, nsv, key, klen)
  210. SV* sv;
  211. SV* nsv;
  212. char *key;
  213. STRLEN klen;
  214. {
  215.     int count = 0;
  216.     MAGIC* mg;
  217.     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
  218.     if (isUPPER(mg->mg_type)) {
  219.         sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
  220.         count++;
  221.     }
  222.     }
  223.     return count;
  224. }
  225.  
  226. int
  227. mg_free(sv)
  228. SV* sv;
  229. {
  230.     MAGIC* mg;
  231.     MAGIC* moremagic;
  232.     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
  233.     MGVTBL* vtbl = mg->mg_virtual;
  234.     moremagic = mg->mg_moremagic;
  235.     if (vtbl && vtbl->svt_free)
  236.         (*vtbl->svt_free)(sv, mg);
  237.     if (mg->mg_ptr && mg->mg_type != 'g')
  238.         Safefree(mg->mg_ptr);
  239.     if (mg->mg_flags & MGf_REFCOUNTED)
  240.         SvREFCNT_dec(mg->mg_obj);
  241.     Safefree(mg);
  242.     }
  243.     SvMAGIC(sv) = 0;
  244.     return 0;
  245. }
  246.  
  247. #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
  248. #include <signal.h>
  249. #endif
  250.  
  251. U32
  252. magic_len(sv, mg)
  253. SV *sv;
  254. MAGIC *mg;
  255. {
  256.     register I32 paren;
  257.     register char *s;
  258.     register I32 i;
  259.     char *t;
  260.  
  261.     switch (*mg->mg_ptr) {
  262.     case '1': case '2': case '3': case '4':
  263.     case '5': case '6': case '7': case '8': case '9': case '&':
  264.     if (curpm) {
  265.         paren = atoi(mg->mg_ptr);
  266.       getparen:
  267.         if (curpm->op_pmregexp &&
  268.           paren <= curpm->op_pmregexp->nparens &&
  269.           (s = curpm->op_pmregexp->startp[paren]) &&
  270.           (t = curpm->op_pmregexp->endp[paren]) ) {
  271.         i = t - s;
  272.         if (i >= 0)
  273.             return i;
  274.         }
  275.     }
  276.     return 0;
  277.     break;
  278.     case '+':
  279.     if (curpm) {
  280.         paren = curpm->op_pmregexp->lastparen;
  281.         if (!paren)
  282.         return 0;
  283.         goto getparen;
  284.     }
  285.     return 0;
  286.     break;
  287.     case '`':
  288.     if (curpm) {
  289.         if (curpm->op_pmregexp &&
  290.           (s = curpm->op_pmregexp->subbeg) ) {
  291.         i = curpm->op_pmregexp->startp[0] - s;
  292.         if (i >= 0)
  293.             return i;
  294.         }
  295.     }
  296.     return 0;
  297.     case '\'':
  298.     if (curpm) {
  299.         if (curpm->op_pmregexp &&
  300.           (s = curpm->op_pmregexp->endp[0]) ) {
  301.         return (STRLEN) (curpm->op_pmregexp->subend - s);
  302.         }
  303.     }
  304.     return 0;
  305.     case ',':
  306.     return (STRLEN)ofslen;
  307.     case '\\':
  308.     return (STRLEN)orslen;
  309.     }
  310.     magic_get(sv,mg);
  311.     if (!SvPOK(sv) && SvNIOK(sv))
  312.     sv_2pv(sv, &na);
  313.     if (SvPOK(sv))
  314.     return SvCUR(sv);
  315.     return 0;
  316. }
  317.  
  318. int
  319. magic_get(sv, mg)
  320. SV *sv;
  321. MAGIC *mg;
  322. {
  323.     register I32 paren;
  324.     register char *s;
  325.     register I32 i;
  326.     char *t;
  327.  
  328.     switch (*mg->mg_ptr) {
  329.     case '\001':        /* ^A */
  330.     sv_setsv(sv, bodytarget);
  331.     break;
  332.     case '\004':        /* ^D */
  333.     sv_setiv(sv,(I32)(debug & 32767));
  334.     break;
  335.     case '\005':  /* ^E */
  336. #ifdef VMS
  337.     {
  338. #        include <descrip.h>
  339. #        include <starlet.h>
  340.         char msg[255];
  341.         $DESCRIPTOR(msgdsc,msg);
  342.         sv_setnv(sv,(double)vaxc$errno);
  343.         if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
  344.         sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
  345.         else
  346.         sv_setpv(sv,"");
  347.     }
  348. #else
  349.     sv_setnv(sv,(double)errno);
  350.     sv_setpv(sv, errno ? Strerror(errno) : "");
  351. #endif
  352.     SvNOK_on(sv);    /* what a wonderful hack! */
  353.     break;
  354.     case '\006':        /* ^F */
  355.     sv_setiv(sv,(I32)maxsysfd);
  356.     break;
  357.     case '\010':        /* ^H */
  358.     sv_setiv(sv,(I32)hints);
  359.     break;
  360.     case '\t':            /* ^I */
  361.     if (inplace)
  362.         sv_setpv(sv, inplace);
  363.     else
  364.         sv_setsv(sv,&sv_undef);
  365.     break;
  366.     case '\017':        /* ^O */
  367.     sv_setpv(sv,osname);
  368.     break;
  369.     case '\020':        /* ^P */
  370.     sv_setiv(sv,(I32)perldb);
  371.     break;
  372.     case '\024':        /* ^T */
  373.     sv_setiv(sv,(I32)basetime);
  374.     break;
  375.     case '\027':        /* ^W */
  376.     sv_setiv(sv,(I32)dowarn);
  377.     break;
  378.     case '1': case '2': case '3': case '4':
  379.     case '5': case '6': case '7': case '8': case '9': case '&':
  380.     if (curpm) {
  381.         paren = atoi(GvENAME(mg->mg_obj));
  382.       getparen:
  383.         if (curpm->op_pmregexp &&
  384.           paren <= curpm->op_pmregexp->nparens &&
  385.           (s = curpm->op_pmregexp->startp[paren]) &&
  386.           (t = curpm->op_pmregexp->endp[paren]) ) {
  387.         i = t - s;
  388.         if (i >= 0) {
  389.             MAGIC *tmg;
  390.             sv_setpvn(sv,s,i);
  391.             if (tainting && (tmg = mg_find(sv,'t')))
  392.             tmg->mg_len = 0;    /* guarantee $1 untainted */
  393.             break;
  394.         }
  395.         }
  396.     }
  397.     sv_setsv(sv,&sv_undef);
  398.     break;
  399.     case '+':
  400.     if (curpm) {
  401.         paren = curpm->op_pmregexp->lastparen;
  402.         if (paren)
  403.         goto getparen;
  404.     }
  405.     sv_setsv(sv,&sv_undef);
  406.     break;
  407.     case '`':
  408.     if (curpm) {
  409.         if (curpm->op_pmregexp &&
  410.           (s = curpm->op_pmregexp->subbeg) ) {
  411.         i = curpm->op_pmregexp->startp[0] - s;
  412.         if (i >= 0) {
  413.             sv_setpvn(sv,s,i);
  414.             break;
  415.         }
  416.         }
  417.     }
  418.     sv_setsv(sv,&sv_undef);
  419.     break;
  420.     case '\'':
  421.     if (curpm) {
  422.         if (curpm->op_pmregexp &&
  423.           (s = curpm->op_pmregexp->endp[0]) ) {
  424.         sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
  425.         break;
  426.         }
  427.     }
  428.     sv_setsv(sv,&sv_undef);
  429.     break;
  430.     case '.':
  431. #ifndef lint
  432.     if (GvIO(last_in_gv)) {
  433.         sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
  434.     }
  435. #endif
  436.     break;
  437.     case '?':
  438.     sv_setiv(sv,(I32)statusvalue);
  439.     break;
  440.     case '^':
  441.     s = IoTOP_NAME(GvIOp(defoutgv));
  442.     if (s)
  443.         sv_setpv(sv,s);
  444.     else {
  445.         sv_setpv(sv,GvENAME(defoutgv));
  446.         sv_catpv(sv,"_TOP");
  447.     }
  448.     break;
  449.     case '~':
  450.     s = IoFMT_NAME(GvIOp(defoutgv));
  451.     if (!s)
  452.         s = GvENAME(defoutgv);
  453.     sv_setpv(sv,s);
  454.     break;
  455. #ifndef lint
  456.     case '=':
  457.     sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
  458.     break;
  459.     case '-':
  460.     sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
  461.     break;
  462.     case '%':
  463.     sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
  464.     break;
  465. #endif
  466.     case ':':
  467.     break;
  468.     case '/':
  469.     break;
  470.     case '[':
  471.     sv_setiv(sv,(I32)curcop->cop_arybase);
  472.     break;
  473.     case '|':
  474.     sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
  475.     break;
  476.     case ',':
  477.     sv_setpvn(sv,ofs,ofslen);
  478.     break;
  479.     case '\\':
  480.     sv_setpvn(sv,ors,orslen);
  481.     break;
  482.     case '#':
  483.     sv_setpv(sv,ofmt);
  484.     break;
  485.     case '!':
  486. #ifdef VMS
  487.     sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
  488. #else
  489.     sv_setnv(sv,(double)errno);
  490. #endif
  491.     sv_setpv(sv, errno ? Strerror(errno) : "");
  492.     SvNOK_on(sv);    /* what a wonderful hack! */
  493.     break;
  494.     case '<':
  495.     sv_setiv(sv,(I32)uid);
  496.     break;
  497.     case '>':
  498.     sv_setiv(sv,(I32)euid);
  499.     break;
  500.     case '(':
  501.     s = buf;
  502.     (void)sprintf(s,"%d",(int)gid);
  503.     goto add_groups;
  504.     case ')':
  505.     s = buf;
  506.     (void)sprintf(s,"%d",(int)egid);
  507.       add_groups:
  508.     while (*s) s++;
  509. #ifdef HAS_GETGROUPS
  510. #ifndef NGROUPS
  511. #define NGROUPS 32
  512. #endif
  513.     {
  514.         Groups_t gary[NGROUPS];
  515.  
  516.         i = getgroups(NGROUPS,gary);
  517.         while (--i >= 0) {
  518.         (void)sprintf(s," %ld", (long)gary[i]);
  519.         while (*s) s++;
  520.         }
  521.     }
  522. #endif
  523.     sv_setpv(sv,buf);
  524.     break;
  525.     case '*':
  526.     break;
  527.     case '0':
  528.     break;
  529.     }
  530.     return 0;
  531. }
  532.  
  533. int
  534. magic_getuvar(sv, mg)
  535. SV *sv;
  536. MAGIC *mg;
  537. {
  538.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  539.  
  540.     if (uf && uf->uf_val)
  541.     (*uf->uf_val)(uf->uf_index, sv);
  542.     return 0;
  543. }
  544.  
  545. int
  546. magic_setenv(sv,mg)
  547. SV* sv;
  548. MAGIC* mg;
  549. {
  550.     register char *s;
  551.     STRLEN len;
  552.     I32 i;
  553.     s = SvPV(sv,len);
  554.     my_setenv(mg->mg_ptr,s);
  555. #ifdef DYNAMIC_ENV_FETCH
  556.      /* We just undefd an environment var.  Is a replacement */
  557.      /* waiting in the wings? */
  558.     if (!len) {
  559.     SV **envsvp;
  560.     if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE))
  561.         s = SvPV(*envsvp,len);
  562.     }
  563. #endif
  564.                 /* And you'll never guess what the dog had */
  565.                 /*   in its mouth... */
  566.     if (tainting) {
  567.     if (s && strEQ(mg->mg_ptr,"PATH")) {
  568.         char *strend = s + len;
  569.  
  570.         while (s < strend) {
  571.         s = cpytill(tokenbuf,s,strend,':',&i);
  572.         s++;
  573.         if (*tokenbuf != '/'
  574.           || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
  575.             MgTAINTEDDIR_on(mg);
  576.         }
  577.     }
  578.     }
  579.     return 0;
  580. }
  581.  
  582. int
  583. magic_clearenv(sv,mg)
  584. SV* sv;
  585. MAGIC* mg;
  586. {
  587.     my_setenv(mg->mg_ptr,Nullch);
  588.     return 0;
  589. }
  590.  
  591. #ifdef HAS_SIGACTION
  592. /* set up reliable signal() clone */
  593.  
  594. typedef void (*Sigfunc) _((int));
  595.  
  596. static
  597. Sigfunc rsignal(signo,handler)
  598. int signo;
  599. Sigfunc handler;
  600. {
  601.     struct sigaction act,oact;
  602.     
  603.     act.sa_handler = handler;
  604.     sigemptyset(&act.sa_mask);
  605.     act.sa_flags = 0;
  606. #ifdef SIGALRM    
  607.     if (signo == SIGALRM) {
  608. #else
  609.     if (0) {
  610. #endif        
  611. #ifdef SA_INTERRUPT
  612.     act.sa_flags |= SA_INTERRUPT;    /* SunOS */
  613. #endif    
  614.     } else {
  615. #ifdef SA_RESTART
  616.     act.sa_flags |= SA_RESTART;    /* SVR4, 4.3+BSD */
  617. #endif
  618.     }
  619.     if (sigaction(signo, &act, &oact) < 0)
  620.         return(SIG_ERR);
  621.     else
  622.         return(oact.sa_handler);
  623. }
  624.  
  625. #else
  626.  
  627. /* ah well, so much for reliability */
  628.  
  629. #define rsignal(x,y) signal(x,y)
  630.  
  631. #endif
  632.  
  633.  
  634. int
  635. magic_setsig(sv,mg)
  636. SV* sv;
  637. MAGIC* mg;
  638. {
  639.     register char *s;
  640.     I32 i;
  641.     SV** svp;
  642.  
  643.     s = mg->mg_ptr;
  644.     if (*s == '_') {
  645.     if (strEQ(s,"__DIE__"))
  646.         svp = &diehook;
  647.     else if (strEQ(s,"__WARN__"))
  648.         svp = &warnhook;
  649.     else if (strEQ(s,"__PARSE__"))
  650.         svp = &parsehook;
  651.     else
  652.         croak("No such hook: %s", s);
  653.     i = 0;
  654.     if (*svp) {
  655.         SvREFCNT_dec(*svp);
  656.         *svp = 0;
  657.     }
  658.     }
  659.     else {
  660.     i = whichsig(s);    /* ...no, a brick */
  661.     if (!i) {
  662.         if (dowarn || strEQ(s,"ALARM"))
  663.         warn("No such signal: SIG%s", s);
  664.         return 0;
  665.     }
  666.     }
  667.     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
  668.     if (i)
  669.         (void)rsignal(i,sighandler);
  670.     else
  671.         *svp = SvREFCNT_inc(sv);
  672.     return 0;
  673.     }
  674.     s = SvPV_force(sv,na);
  675.     if (strEQ(s,"IGNORE")) {
  676.     if (i)
  677.         (void)rsignal(i,SIG_IGN);
  678.     else
  679.         *svp = 0;
  680.     }
  681.     else if (strEQ(s,"DEFAULT") || !*s) {
  682.     if (i)
  683.         (void)rsignal(i,SIG_DFL);
  684.     else
  685.         *svp = 0;
  686.     }
  687.     else {
  688.     if (!strchr(s,':') && !strchr(s,'\'')) {
  689.         sprintf(tokenbuf, "main::%s",s);
  690.         sv_setpv(sv,tokenbuf);
  691.     }
  692.     if (i)
  693.         (void)rsignal(i,sighandler);
  694.     else
  695.         *svp = SvREFCNT_inc(sv);
  696.     }
  697.     return 0;
  698. }
  699.  
  700. int
  701. magic_setisa(sv,mg)
  702. SV* sv;
  703. MAGIC* mg;
  704. {
  705.     sub_generation++;
  706.     return 0;
  707. }
  708.  
  709. #ifdef OVERLOAD
  710.  
  711. int
  712. magic_setamagic(sv,mg)
  713. SV* sv;
  714. MAGIC* mg;
  715. {
  716.     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
  717.     amagic_generation++;
  718.  
  719.     return 0;
  720. }
  721. #endif /* OVERLOAD */
  722.  
  723. static int
  724. magic_methpack(sv,mg,meth)
  725. SV* sv;
  726. MAGIC* mg;
  727. char *meth;
  728. {
  729.     dSP;
  730.  
  731.     ENTER;
  732.     SAVETMPS;
  733.     PUSHMARK(sp);
  734.     EXTEND(sp, 2);
  735.     PUSHs(mg->mg_obj);
  736.     if (mg->mg_ptr)
  737.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  738.     else if (mg->mg_type == 'p')
  739.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  740.     PUTBACK;
  741.  
  742.     if (perl_call_method(meth, G_SCALAR))
  743.     sv_setsv(sv, *stack_sp--);
  744.  
  745.     FREETMPS;
  746.     LEAVE;
  747.     return 0;
  748. }
  749.  
  750. int
  751. magic_getpack(sv,mg)
  752. SV* sv;
  753. MAGIC* mg;
  754. {
  755.     magic_methpack(sv,mg,"FETCH");
  756.     if (mg->mg_ptr)
  757.     mg->mg_flags |= MGf_GSKIP;
  758.     return 0;
  759. }
  760.  
  761. int
  762. magic_setpack(sv,mg)
  763. SV* sv;
  764. MAGIC* mg;
  765. {
  766.     dSP;
  767.  
  768.     PUSHMARK(sp);
  769.     EXTEND(sp, 3);
  770.     PUSHs(mg->mg_obj);
  771.     if (mg->mg_ptr)
  772.     PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
  773.     else if (mg->mg_type == 'p')
  774.     PUSHs(sv_2mortal(newSViv(mg->mg_len)));
  775.     PUSHs(sv);
  776.     PUTBACK;
  777.  
  778.     perl_call_method("STORE", G_SCALAR|G_DISCARD);
  779.  
  780.     return 0;
  781. }
  782.  
  783. int
  784. magic_clearpack(sv,mg)
  785. SV* sv;
  786. MAGIC* mg;
  787. {
  788.     return magic_methpack(sv,mg,"DELETE");
  789. }
  790.  
  791. int magic_wipepack(sv,mg)
  792. SV* sv;
  793. MAGIC* mg;
  794. {
  795.     dSP;
  796.  
  797.     PUSHMARK(sp);
  798.     XPUSHs(mg->mg_obj);
  799.     PUTBACK;
  800.  
  801.     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
  802.  
  803.     return 0;
  804. }
  805.  
  806. int
  807. magic_nextpack(sv,mg,key)
  808. SV* sv;
  809. MAGIC* mg;
  810. SV* key;
  811. {
  812.     dSP;
  813.     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
  814.  
  815.     ENTER;
  816.     SAVETMPS;
  817.     PUSHMARK(sp);
  818.     EXTEND(sp, 2);
  819.     PUSHs(mg->mg_obj);
  820.     if (SvOK(key))
  821.     PUSHs(key);
  822.     PUTBACK;
  823.  
  824.     if (perl_call_method(meth, G_SCALAR))
  825.     sv_setsv(key, *stack_sp--);
  826.  
  827.     FREETMPS;
  828.     LEAVE;
  829.     return 0;
  830. }
  831.  
  832. int
  833. magic_existspack(sv,mg)
  834. SV* sv;
  835. MAGIC* mg;
  836. {
  837.     return magic_methpack(sv,mg,"EXISTS");
  838. } 
  839.  
  840. int
  841. magic_setdbline(sv,mg)
  842. SV* sv;
  843. MAGIC* mg;
  844. {
  845.     OP *o;
  846.     I32 i;
  847.     GV* gv;
  848.     SV** svp;
  849.  
  850.     gv = DBline;
  851.     i = SvTRUE(sv);
  852.     svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
  853.     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
  854.     o->op_private = i;
  855.     else
  856.     warn("Can't break at that line\n");
  857.     return 0;
  858. }
  859.  
  860. int
  861. magic_getarylen(sv,mg)
  862. SV* sv;
  863. MAGIC* mg;
  864. {
  865.     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
  866.     return 0;
  867. }
  868.  
  869. int
  870. magic_setarylen(sv,mg)
  871. SV* sv;
  872. MAGIC* mg;
  873. {
  874.     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
  875.     return 0;
  876. }
  877.  
  878. int
  879. magic_getpos(sv,mg)
  880. SV* sv;
  881. MAGIC* mg;
  882. {
  883.     SV* lsv = LvTARG(sv);
  884.     
  885.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
  886.     mg = mg_find(lsv, 'g');
  887.     if (mg && mg->mg_len >= 0) {
  888.         sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
  889.         return 0;
  890.     }
  891.     }
  892.     (void)SvOK_off(sv);
  893.     return 0;
  894. }
  895.  
  896. int
  897. magic_setpos(sv,mg)
  898. SV* sv;
  899. MAGIC* mg;
  900. {
  901.     SV* lsv = LvTARG(sv);
  902.     SSize_t pos;
  903.     STRLEN len;
  904.  
  905.     mg = 0;
  906.     
  907.     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
  908.     mg = mg_find(lsv, 'g');
  909.     if (!mg) {
  910.     if (!SvOK(sv))
  911.         return 0;
  912.     sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
  913.     mg = mg_find(lsv, 'g');
  914.     }
  915.     else if (!SvOK(sv)) {
  916.     mg->mg_len = -1;
  917.     return 0;
  918.     }
  919.     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
  920.  
  921.     pos = SvIV(sv) - curcop->cop_arybase;
  922.     if (pos < 0) {
  923.     pos += len;
  924.     if (pos < 0)
  925.         pos = 0;
  926.     }
  927.     else if (pos > len)
  928.     pos = len;
  929.     mg->mg_len = pos;
  930.  
  931.     return 0;
  932. }
  933.  
  934. int
  935. magic_getglob(sv,mg)
  936. SV* sv;
  937. MAGIC* mg;
  938. {
  939.     gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
  940.     return 0;
  941. }
  942.  
  943. int
  944. magic_setglob(sv,mg)
  945. SV* sv;
  946. MAGIC* mg;
  947. {
  948.     register char *s;
  949.     GV* gv;
  950.  
  951.     if (!SvOK(sv))
  952.     return 0;
  953.     s = SvPV(sv, na);
  954.     if (*s == '*' && s[1])
  955.     s++;
  956.     gv = gv_fetchpv(s,TRUE, SVt_PVGV);
  957.     if (sv == (SV*)gv)
  958.     return 0;
  959.     if (GvGP(sv))
  960.     gp_free(sv);
  961.     GvGP(sv) = gp_ref(GvGP(gv));
  962.     if (!GvAV(gv))
  963.     gv_AVadd(gv);
  964.     if (!GvHV(gv))
  965.     gv_HVadd(gv);
  966.     if (!GvIOp(gv))
  967.     GvIOp(gv) = newIO();
  968.     return 0;
  969. }
  970.  
  971. int
  972. magic_setsubstr(sv,mg)
  973. SV* sv;
  974. MAGIC* mg;
  975. {
  976.     STRLEN len;
  977.     char *tmps = SvPV(sv,len);
  978.     sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
  979.     return 0;
  980. }
  981.  
  982. int
  983. magic_gettaint(sv,mg)
  984. SV* sv;
  985. MAGIC* mg;
  986. {
  987.     if (mg->mg_len & 1)
  988.     tainted = TRUE;
  989.     else if (mg->mg_len & 2 && mg->mg_obj == sv)    /* kludge */
  990.     tainted = TRUE;
  991.     return 0;
  992. }
  993.  
  994. int
  995. magic_settaint(sv,mg)
  996. SV* sv;
  997. MAGIC* mg;
  998. {
  999.     if (localizing) {
  1000.     if (localizing == 1)
  1001.         mg->mg_len <<= 1;
  1002.     else
  1003.         mg->mg_len >>= 1;
  1004.     }
  1005.     else if (tainted)
  1006.     mg->mg_len |= 1;
  1007.     else
  1008.     mg->mg_len &= ~1;
  1009.     return 0;
  1010. }
  1011.  
  1012. int
  1013. magic_setvec(sv,mg)
  1014. SV* sv;
  1015. MAGIC* mg;
  1016. {
  1017.     do_vecset(sv);    /* XXX slurp this routine */
  1018.     return 0;
  1019. }
  1020.  
  1021. int
  1022. magic_setmglob(sv,mg)
  1023. SV* sv;
  1024. MAGIC* mg;
  1025. {
  1026.     mg->mg_len = -1;
  1027.     SvSCREAM_off(sv);
  1028.     return 0;
  1029. }
  1030.  
  1031. int
  1032. magic_setbm(sv,mg)
  1033. SV* sv;
  1034. MAGIC* mg;
  1035. {
  1036.     sv_unmagic(sv, 'B');
  1037.     SvVALID_off(sv);
  1038.     return 0;
  1039. }
  1040.  
  1041. int
  1042. magic_setuvar(sv,mg)
  1043. SV* sv;
  1044. MAGIC* mg;
  1045. {
  1046.     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
  1047.  
  1048.     if (uf && uf->uf_set)
  1049.     (*uf->uf_set)(uf->uf_index, sv);
  1050.     return 0;
  1051. }
  1052.  
  1053. int
  1054. magic_set(sv,mg)
  1055. SV* sv;
  1056. MAGIC* mg;
  1057. {
  1058.     register char *s;
  1059.     I32 i;
  1060.     STRLEN len;
  1061.     switch (*mg->mg_ptr) {
  1062.     case '\001':    /* ^A */
  1063.     sv_setsv(bodytarget, sv);
  1064.     break;
  1065.     case '\004':    /* ^D */
  1066.     debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
  1067.     DEBUG_x(dump_all());
  1068.     break;
  1069.     case '\005':  /* ^E */
  1070. #ifdef VMS
  1071.     set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1072. #else
  1073.     SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);        /* will anyone ever use this? */
  1074. #endif
  1075.     break;
  1076.     case '\006':    /* ^F */
  1077.     maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1078.     break;
  1079.     case '\010':    /* ^H */
  1080.     hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1081.     break;
  1082.     case '\t':    /* ^I */
  1083.     if (inplace)
  1084.         Safefree(inplace);
  1085.     if (SvOK(sv))
  1086.         inplace = savepv(SvPV(sv,na));
  1087.     else
  1088.         inplace = Nullch;
  1089.     break;
  1090.     case '\017':    /* ^O */
  1091.     if (osname)
  1092.         Safefree(osname);
  1093.     if (SvOK(sv))
  1094.         osname = savepv(SvPV(sv,na));
  1095.     else
  1096.         osname = Nullch;
  1097.     break;
  1098.     case '\020':    /* ^P */
  1099.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1100.     if (i != perldb) {
  1101.         if (perldb)
  1102.         oldlastpm = curpm;
  1103.         else
  1104.         curpm = oldlastpm;
  1105.     }
  1106.     perldb = i;
  1107.     break;
  1108.     case '\024':    /* ^T */
  1109.     basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1110.     break;
  1111.     case '\027':    /* ^W */
  1112.     dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1113.     break;
  1114.     case '.':
  1115.     if (localizing) {
  1116.         if (localizing == 1)
  1117.         save_sptr((SV**)&last_in_gv);
  1118.     }
  1119.     else if (SvOK(sv))
  1120.         IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
  1121.     break;
  1122.     case '^':
  1123.     Safefree(IoTOP_NAME(GvIOp(defoutgv)));
  1124.     IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1125.     IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1126.     break;
  1127.     case '~':
  1128.     Safefree(IoFMT_NAME(GvIOp(defoutgv)));
  1129.     IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
  1130.     IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
  1131.     break;
  1132.     case '=':
  1133.     IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1134.     break;
  1135.     case '-':
  1136.     IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1137.     if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
  1138.         IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
  1139.     break;
  1140.     case '%':
  1141.     IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1142.     break;
  1143.     case '|':
  1144.     IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
  1145.     if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
  1146.         IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
  1147.     }
  1148.     break;
  1149.     case '*':
  1150.     i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1151.     multiline = (i != 0);
  1152.     break;
  1153.     case '/':
  1154.     SvREFCNT_dec(nrs);
  1155.     nrs = newSVsv(sv);
  1156.     SvREFCNT_dec(rs);
  1157.     rs = SvREFCNT_inc(nrs);
  1158.     break;
  1159.     case '\\':
  1160.     if (ors)
  1161.         Safefree(ors);
  1162.     ors = savepv(SvPV(sv,orslen));
  1163.     break;
  1164.     case ',':
  1165.     if (ofs)
  1166.         Safefree(ofs);
  1167.     ofs = savepv(SvPV(sv, ofslen));
  1168.     break;
  1169.     case '#':
  1170.     if (ofmt)
  1171.         Safefree(ofmt);
  1172.     ofmt = savepv(SvPV(sv,na));
  1173.     break;
  1174.     case '[':
  1175.     compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1176.     break;
  1177.     case '?':
  1178.     statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
  1179.     break;
  1180.     case '!':
  1181.     SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno);        /* will anyone ever use this? */
  1182.     break;
  1183.     case '<':
  1184.     uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1185.     if (delaymagic) {
  1186.         delaymagic |= DM_RUID;
  1187.         break;                /* don't do magic till later */
  1188.     }
  1189. #ifdef HAS_SETRUID
  1190.     (void)setruid((Uid_t)uid);
  1191. #else
  1192. #ifdef HAS_SETREUID
  1193.     (void)setreuid((Uid_t)uid, (Uid_t)-1);
  1194. #else
  1195. #ifdef HAS_SETRESUID
  1196.       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
  1197. #else
  1198.     if (uid == euid)        /* special case $< = $> */
  1199.         (void)setuid(uid);
  1200.     else {
  1201.         uid = (I32)getuid();
  1202.         croak("setruid() not implemented");
  1203.     }
  1204. #endif
  1205. #endif
  1206. #endif
  1207.     uid = (I32)getuid();
  1208.     tainting |= (uid && (euid != uid || egid != gid));
  1209.     break;
  1210.     case '>':
  1211.     euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1212.     if (delaymagic) {
  1213.         delaymagic |= DM_EUID;
  1214.         break;                /* don't do magic till later */
  1215.     }
  1216. #ifdef HAS_SETEUID
  1217.     (void)seteuid((Uid_t)euid);
  1218. #else
  1219. #ifdef HAS_SETREUID
  1220.     (void)setreuid((Uid_t)-1, (Uid_t)euid);
  1221. #else
  1222. #ifdef HAS_SETRESUID
  1223.     (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
  1224. #else
  1225.     if (euid == uid)        /* special case $> = $< */
  1226.         setuid(euid);
  1227.     else {
  1228.         euid = (I32)geteuid();
  1229.         croak("seteuid() not implemented");
  1230.     }
  1231. #endif
  1232. #endif
  1233. #endif
  1234.     euid = (I32)geteuid();
  1235.     tainting |= (uid && (euid != uid || egid != gid));
  1236.     break;
  1237.     case '(':
  1238.     gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1239.     if (delaymagic) {
  1240.         delaymagic |= DM_RGID;
  1241.         break;                /* don't do magic till later */
  1242.     }
  1243. #ifdef HAS_SETRGID
  1244.     (void)setrgid((Gid_t)gid);
  1245. #else
  1246. #ifdef HAS_SETREGID
  1247.     (void)setregid((Gid_t)gid, (Gid_t)-1);
  1248. #else
  1249. #ifdef HAS_SETRESGID
  1250.       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
  1251. #else
  1252.     if (gid == egid)            /* special case $( = $) */
  1253.         (void)setgid(gid);
  1254.     else {
  1255.         gid = (I32)getgid();
  1256.         croak("setrgid() not implemented");
  1257.     }
  1258. #endif
  1259. #endif
  1260. #endif
  1261.     gid = (I32)getgid();
  1262.     tainting |= (uid && (euid != uid || egid != gid));
  1263.     break;
  1264.     case ')':
  1265.     egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
  1266.     if (delaymagic) {
  1267.         delaymagic |= DM_EGID;
  1268.         break;                /* don't do magic till later */
  1269.     }
  1270. #ifdef HAS_SETEGID
  1271.     (void)setegid((Gid_t)egid);
  1272. #else
  1273. #ifdef HAS_SETREGID
  1274.     (void)setregid((Gid_t)-1, (Gid_t)egid);
  1275. #else
  1276. #ifdef HAS_SETRESGID
  1277.     (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
  1278. #else
  1279.     if (egid == gid)            /* special case $) = $( */
  1280.         (void)setgid(egid);
  1281.     else {
  1282.         egid = (I32)getegid();
  1283.         croak("setegid() not implemented");
  1284.     }
  1285. #endif
  1286. #endif
  1287. #endif
  1288.     egid = (I32)getegid();
  1289.     tainting |= (uid && (euid != uid || egid != gid));
  1290.     break;
  1291.     case ':':
  1292.     chopset = SvPV_force(sv,na);
  1293.     break;
  1294.     case '0':
  1295.     if (!origalen) {
  1296.         s = origargv[0];
  1297.         s += strlen(s);
  1298.         /* See if all the arguments are contiguous in memory */
  1299.         for (i = 1; i < origargc; i++) {
  1300.         if (origargv[i] == s + 1)
  1301.             s += strlen(++s);    /* this one is ok too */
  1302.         }
  1303.         if (origenviron[0] == s + 1) {    /* can grab env area too? */
  1304.         my_setenv("NoNeSuCh", Nullch);
  1305.                         /* force copy of environment */
  1306.         for (i = 0; origenviron[i]; i++)
  1307.             if (origenviron[i] == s + 1)
  1308.             s += strlen(++s);
  1309.         }
  1310.         origalen = s - origargv[0];
  1311.     }
  1312.     s = SvPV_force(sv,len);
  1313.     i = len;
  1314.     if (i >= origalen) {
  1315.         i = origalen;
  1316.         SvCUR_set(sv, i);
  1317.         *SvEND(sv) = '\0';
  1318.         Copy(s, origargv[0], i, char);
  1319.     }
  1320.     else {
  1321.         Copy(s, origargv[0], i, char);
  1322.         s = origargv[0]+i;
  1323.         *s++ = '\0';
  1324.         while (++i < origalen)
  1325.         *s++ = ' ';
  1326.         s = origargv[0]+i;
  1327.         for (i = 1; i < origargc; i++)
  1328.         origargv[i] = Nullch;
  1329.     }
  1330.     break;
  1331.     }
  1332.     return 0;
  1333. }
  1334.  
  1335. I32
  1336. whichsig(sig)
  1337. char *sig;
  1338. {
  1339.     register char **sigv;
  1340.  
  1341.     for (sigv = sig_name+1; *sigv; sigv++)
  1342.     if (strEQ(sig,*sigv))
  1343.         return sig_num[sigv - sig_name];
  1344. #ifdef SIGCLD
  1345.     if (strEQ(sig,"CHLD"))
  1346.     return SIGCLD;
  1347. #endif
  1348. #ifdef SIGCHLD
  1349.     if (strEQ(sig,"CLD"))
  1350.     return SIGCHLD;
  1351. #endif
  1352.     return 0;
  1353. }
  1354.  
  1355. Signal_t
  1356. sighandler(sig)
  1357. int sig;
  1358. {
  1359.     dSP;
  1360.     GV *gv;
  1361.     HV *st;
  1362.     SV *sv;
  1363.     CV *cv;
  1364.     AV *oldstack;
  1365.     char *signame; 
  1366.  
  1367. #ifdef OS2        /* or anybody else who requires SIG_ACK */
  1368.     signal(sig, SIG_ACK);
  1369. #endif
  1370.  
  1371.     signame = sig_name[sig];
  1372.     cv = sv_2cv(*hv_fetch(GvHVn(siggv),signame,strlen(signame),
  1373.               TRUE),
  1374.         &st, &gv, TRUE);
  1375.     if (!cv || !CvROOT(cv) &&
  1376.     *signame == 'C' && instr(signame,"LD")) {
  1377.     
  1378.     if (signame[1] == 'H')
  1379.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE),
  1380.             &st, &gv, TRUE);
  1381.     else
  1382.         cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE),
  1383.             &st, &gv, TRUE);
  1384.     /* gag */
  1385.     }
  1386.     if (!cv || !CvROOT(cv)) {
  1387.     if (dowarn)
  1388.         warn("SIG%s handler \"%s\" not defined.\n",
  1389.         signame, GvENAME(gv) );
  1390.     return;
  1391.     }
  1392.  
  1393.     oldstack = stack;
  1394.     if (stack != signalstack)
  1395.     AvFILL(signalstack) = 0;
  1396.     SWITCHSTACK(stack, signalstack);
  1397.  
  1398.     sv = sv_newmortal();
  1399.     sv_setpv(sv,signame);
  1400.     PUSHMARK(sp);
  1401.     PUSHs(sv);
  1402.     PUTBACK;
  1403.  
  1404.     perl_call_sv((SV*)cv, G_DISCARD);
  1405.  
  1406.     SWITCHSTACK(signalstack, oldstack);
  1407.  
  1408.     return;
  1409. }
  1410.