mg.c

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