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