3 * Copyright (c) 1991-1994, Larry Wall
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.
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."
18 /* XXX If this causes problems, set i_unistd=undef in the hint file. */
24 * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
31 typedef struct magic_state MGS;
33 static void restore_magic _((void *p));
41 assert(SvMAGICAL(sv));
43 mgs = (MGS*)safemalloc(sizeof(MGS));
45 mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
46 SAVEDESTRUCTOR(restore_magic, mgs);
50 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
62 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
65 SvFLAGS(sv) |= mgs->mgs_flags;
69 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
81 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
82 MGVTBL* vtbl = mg->mg_virtual;
84 if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
88 if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
104 mgs = save_magic(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))
115 /* Advance to next magic (complicated by possible deletion) */
116 if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
117 mgp = &mg->mg_moremagic;
121 mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
137 mgs = save_magic(sv);
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 */
146 if (vtbl && vtbl->svt_set)
147 (*vtbl->svt_set)(sv, mg);
162 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
163 MGVTBL* vtbl = mg->mg_virtual;
164 if (vtbl && vtbl->svt_len) {
167 /* omit MGf_GSKIP -- not changed here */
168 len = (*vtbl->svt_len)(sv, mg);
174 junk = SvPV(sv, len);
187 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
188 MGVTBL* vtbl = mg->mg_virtual;
189 /* omit GSKIP -- never set here */
191 if (vtbl && vtbl->svt_clear)
192 (*vtbl->svt_clear)(sv, mg);
205 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
206 if (mg->mg_type == type)
213 mg_copy(sv, nsv, key, klen)
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);
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')
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);
254 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
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 '&':
272 paren = atoi(mg->mg_ptr);
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]) ) {
287 paren = curpm->op_pmregexp->lastparen;
296 if (curpm->op_pmregexp &&
297 (s = curpm->op_pmregexp->subbeg) ) {
298 i = curpm->op_pmregexp->startp[0] - s;
306 if (curpm->op_pmregexp &&
307 (s = curpm->op_pmregexp->endp[0]) ) {
308 return (STRLEN) (curpm->op_pmregexp->subend - s);
313 return (STRLEN)ofslen;
315 return (STRLEN)orslen;
318 if (!SvPOK(sv) && SvNIOK(sv))
335 switch (*mg->mg_ptr) {
336 case '\001': /* ^A */
337 sv_setsv(sv, bodytarget);
339 case '\004': /* ^D */
340 sv_setiv(sv,(I32)(debug & 32767));
342 case '\005': /* ^E */
345 # include <descrip.h>
346 # include <starlet.h>
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);
357 sv_setnv(sv,(double)Perl_rc);
358 sv_setpv(sv, os2error(Perl_rc));
360 sv_setnv(sv,(double)errno);
361 sv_setpv(sv, errno ? Strerror(errno) : "");
364 SvNOK_on(sv); /* what a wonderful hack! */
366 case '\006': /* ^F */
367 sv_setiv(sv,(I32)maxsysfd);
369 case '\010': /* ^H */
370 sv_setiv(sv,(I32)hints);
374 sv_setpv(sv, inplace);
376 sv_setsv(sv,&sv_undef);
378 case '\017': /* ^O */
381 case '\020': /* ^P */
382 sv_setiv(sv,(I32)perldb);
384 case '\024': /* ^T */
386 sv_setnv(sv,basetime);
388 sv_setiv(sv,(I32)basetime);
391 case '\027': /* ^W */
392 sv_setiv(sv,(I32)dowarn);
394 case '1': case '2': case '3': case '4':
395 case '5': case '6': case '7': case '8': case '9': case '&':
397 paren = atoi(GvENAME((GV*)mg->mg_obj));
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]) ) {
407 if (tainting && (tmg = mg_find(sv,'t')))
408 tmg->mg_len = 0; /* guarantee $1 untainted */
413 sv_setsv(sv,&sv_undef);
417 paren = curpm->op_pmregexp->lastparen;
421 sv_setsv(sv,&sv_undef);
425 if (curpm->op_pmregexp &&
426 (s = curpm->op_pmregexp->subbeg) ) {
427 i = curpm->op_pmregexp->startp[0] - s;
434 sv_setsv(sv,&sv_undef);
438 if (curpm->op_pmregexp &&
439 (s = curpm->op_pmregexp->endp[0]) ) {
440 sv_setpvn(sv,s, curpm->op_pmregexp->subend - s);
444 sv_setsv(sv,&sv_undef);
448 if (GvIO(last_in_gv)) {
449 sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv)));
454 sv_setiv(sv,(I32)statusvalue);
457 s = IoTOP_NAME(GvIOp(defoutgv));
461 sv_setpv(sv,GvENAME(defoutgv));
466 s = IoFMT_NAME(GvIOp(defoutgv));
468 s = GvENAME(defoutgv);
473 sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv)));
476 sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv)));
479 sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv)));
487 sv_setiv(sv,(I32)curcop->cop_arybase);
490 sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
493 sv_setpvn(sv,ofs,ofslen);
496 sv_setpvn(sv,ors,orslen);
503 sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno));
504 sv_setpv(sv, errno ? Strerror(errno) : "");
507 int saveerrno = errno;
508 sv_setnv(sv,(double)errno);
510 if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc));
513 sv_setpv(sv, errno ? Strerror(errno) : "");
517 SvNOK_on(sv); /* what a wonderful hack! */
520 sv_setiv(sv,(I32)uid);
523 sv_setiv(sv,(I32)euid);
527 (void)sprintf(s,"%d",(int)gid);
531 (void)sprintf(s,"%d",(int)egid);
539 Groups_t gary[NGROUPS];
541 i = getgroups(NGROUPS,gary);
543 (void)sprintf(s," %ld", (long)gary[i]);
559 magic_getuvar(sv, mg)
563 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
565 if (uf && uf->uf_val)
566 (*uf->uf_val)(uf->uf_index, sv);
580 ptr = (mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr;
582 #ifdef DYNAMIC_ENV_FETCH
583 /* We just undefd an environment var. Is a replacement */
584 /* waiting in the wings? */
587 if (envhe = hv_fetch_ent(GvHVn(envgv),HeSVKEY((HE*)(mg->mg_ptr)),FALSE,0))
588 s = SvPV(HeVAL(envhe),len);
591 /* And you'll never guess what the dog had */
592 /* in its mouth... */
594 if (s && strEQ(ptr,"PATH")) {
595 char *strend = s + len;
598 s = cpytill(tokenbuf,s,strend,':',&i);
601 || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
610 magic_clearenv(sv,mg)
614 my_setenv(((mg->mg_len == HEf_SVKEY) ?
615 SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr),Nullch);
620 /* set up reliable signal() clone */
622 typedef void (*Sigfunc) _((int));
625 Sigfunc rsignal(signo,handler)
629 struct sigaction act,oact;
631 act.sa_handler = handler;
632 sigemptyset(&act.sa_mask);
635 act.sa_flags |= SA_RESTART; /* SVR4, 4.3+BSD */
637 if (sigaction(signo, &act, &oact) < 0)
640 return(oact.sa_handler);
645 /* ah well, so much for reliability */
647 #define rsignal(x,y) signal(x,y)
665 /* Are we fetching a signal entry? */
666 i = whichsig(mg->mg_ptr);
669 sv_setsv(sv,psig_ptr[i]);
671 void (*origsig) _((int));
672 /* get signal state without losing signals */
674 origsig = rsignal(i,sig_trap);
678 /* cache state so we don't fetch it again */
679 if(origsig == SIG_IGN)
680 sv_setpv(sv,"IGNORE");
682 sv_setsv(sv,&sv_undef);
683 psig_ptr[i] = SvREFCNT_inc(sv);
690 magic_clearsig(sv,mg)
695 /* Are we clearing a signal entry? */
696 i = whichsig(mg->mg_ptr);
699 SvREFCNT_dec(psig_ptr[i]);
703 SvREFCNT_dec(psig_name[i]);
719 s = (mg->mg_len == HEf_SVKEY) ? SvPV((SV*)mg->mg_ptr, na) : mg->mg_ptr;
721 if (strEQ(s,"__DIE__"))
723 else if (strEQ(s,"__WARN__"))
725 else if (strEQ(s,"__PARSE__"))
728 croak("No such hook: %s", s);
736 i = whichsig(s); /* ...no, a brick */
738 if (dowarn || strEQ(s,"ALARM"))
739 warn("No such signal: SIG%s", s);
743 SvREFCNT_dec(psig_ptr[i]);
744 psig_ptr[i] = SvREFCNT_inc(sv);
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]);
751 if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
753 (void)rsignal(i,sighandler);
755 *svp = SvREFCNT_inc(sv);
758 s = SvPV_force(sv,na);
759 if (strEQ(s,"IGNORE")) {
761 (void)rsignal(i,SIG_IGN);
765 else if (strEQ(s,"DEFAULT") || !*s) {
767 (void)rsignal(i,SIG_DFL);
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);
779 (void)rsignal(i,sighandler);
781 *svp = SvREFCNT_inc(sv);
798 magic_setamagic(sv,mg)
802 /* HV_badAMAGIC_on(Sv_STASH(sv)); */
807 #endif /* OVERLOAD */
810 magic_methpack(sv,mg,meth)
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);
828 else if (mg->mg_type == 'p')
829 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
832 if (perl_call_method(meth, G_SCALAR))
833 sv_setsv(sv, *stack_sp--);
845 magic_methpack(sv,mg,"FETCH");
847 mg->mg_flags |= MGf_GSKIP;
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);
867 else if (mg->mg_type == 'p')
868 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
872 perl_call_method("STORE", G_SCALAR|G_DISCARD);
878 magic_clearpack(sv,mg)
882 return magic_methpack(sv,mg,"DELETE");
885 int magic_wipepack(sv,mg)
895 perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
901 magic_nextpack(sv,mg,key)
907 char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
918 if (perl_call_method(meth, G_SCALAR))
919 sv_setsv(key, *stack_sp--);
927 magic_existspack(sv,mg)
931 return magic_methpack(sv,mg,"EXISTS");
935 magic_setdbline(sv,mg)
946 svp = av_fetch(GvAV(gv),atoi(mg->mg_ptr), FALSE);
947 if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
950 warn("Can't break at that line\n");
955 magic_getarylen(sv,mg)
959 sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
964 magic_setarylen(sv,mg)
968 av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
977 SV* lsv = LvTARG(sv);
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);
995 SV* lsv = LvTARG(sv);
1001 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
1002 mg = mg_find(lsv, 'g');
1006 sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
1007 mg = mg_find(lsv, 'g');
1009 else if (!SvOK(sv)) {
1013 len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
1015 pos = SvIV(sv) - curcop->cop_arybase;
1029 magic_getglob(sv,mg)
1033 gv_efullname(sv,((GV*)sv));/* a gv value, be nice */
1038 magic_setglob(sv,mg)
1048 if (*s == '*' && s[1])
1050 gv = gv_fetchpv(s,TRUE, SVt_PVGV);
1055 GvGP(sv) = gp_ref(GvGP(gv));
1061 GvIOp(gv) = newIO();
1066 magic_setsubstr(sv,mg)
1071 char *tmps = SvPV(sv,len);
1072 sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
1077 magic_gettaint(sv,mg)
1083 else if (mg->mg_len & 2 && mg->mg_obj == sv) /* kludge */
1089 magic_settaint(sv,mg)
1094 if (localizing == 1)
1111 do_vecset(sv); /* XXX slurp this routine */
1116 magic_setmglob(sv,mg)
1130 sv_unmagic(sv, 'B');
1136 magic_setuvar(sv,mg)
1140 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
1142 if (uf && uf->uf_set)
1143 (*uf->uf_set)(uf->uf_index, sv);
1155 switch (*mg->mg_ptr) {
1156 case '\001': /* ^A */
1157 sv_setsv(bodytarget, sv);
1159 case '\004': /* ^D */
1160 debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
1161 DEBUG_x(dump_all());
1163 case '\005': /* ^E */
1165 set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1167 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4); /* will anyone ever use this? */
1170 case '\006': /* ^F */
1171 maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1173 case '\010': /* ^H */
1174 hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1180 inplace = savepv(SvPV(sv,na));
1184 case '\017': /* ^O */
1188 osname = savepv(SvPV(sv,na));
1192 case '\020': /* ^P */
1193 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1202 case '\024': /* ^T */
1204 basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
1206 basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1209 case '\027': /* ^W */
1210 dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1214 if (localizing == 1)
1215 save_sptr((SV**)&last_in_gv);
1217 else if (SvOK(sv) && GvIO(last_in_gv))
1218 IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
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);
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);
1231 IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
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;
1239 IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1242 IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
1243 if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
1244 IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
1248 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1249 multiline = (i != 0);
1255 rs = SvREFCNT_inc(nrs);
1260 ors = savepv(SvPV(sv,orslen));
1265 ofs = savepv(SvPV(sv, ofslen));
1270 ofmt = savepv(SvPV(sv,na));
1273 compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1276 statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1279 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno); /* will anyone ever use this? */
1282 uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1284 delaymagic |= DM_RUID;
1285 break; /* don't do magic till later */
1288 (void)setruid((Uid_t)uid);
1291 (void)setreuid((Uid_t)uid, (Uid_t)-1);
1293 #ifdef HAS_SETRESUID
1294 (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
1296 if (uid == euid) /* special case $< = $> */
1299 uid = (I32)getuid();
1300 croak("setruid() not implemented");
1305 uid = (I32)getuid();
1306 tainting |= (uid && (euid != uid || egid != gid));
1309 euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1311 delaymagic |= DM_EUID;
1312 break; /* don't do magic till later */
1315 (void)seteuid((Uid_t)euid);
1318 (void)setreuid((Uid_t)-1, (Uid_t)euid);
1320 #ifdef HAS_SETRESUID
1321 (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
1323 if (euid == uid) /* special case $> = $< */
1326 euid = (I32)geteuid();
1327 croak("seteuid() not implemented");
1332 euid = (I32)geteuid();
1333 tainting |= (uid && (euid != uid || egid != gid));
1336 gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1338 delaymagic |= DM_RGID;
1339 break; /* don't do magic till later */
1342 (void)setrgid((Gid_t)gid);
1345 (void)setregid((Gid_t)gid, (Gid_t)-1);
1347 #ifdef HAS_SETRESGID
1348 (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
1350 if (gid == egid) /* special case $( = $) */
1353 gid = (I32)getgid();
1354 croak("setrgid() not implemented");
1359 gid = (I32)getgid();
1360 tainting |= (uid && (euid != uid || egid != gid));
1363 egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1365 delaymagic |= DM_EGID;
1366 break; /* don't do magic till later */
1369 (void)setegid((Gid_t)egid);
1372 (void)setregid((Gid_t)-1, (Gid_t)egid);
1374 #ifdef HAS_SETRESGID
1375 (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
1377 if (egid == gid) /* special case $) = $( */
1380 egid = (I32)getegid();
1381 croak("setegid() not implemented");
1386 egid = (I32)getegid();
1387 tainting |= (uid && (euid != uid || egid != gid));
1390 chopset = SvPV_force(sv,na);
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 */
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)
1408 origalen = s - origargv[0];
1410 s = SvPV_force(sv,len);
1412 if (i >= origalen) {
1416 Copy(s, origargv[0], i, char);
1419 Copy(s, origargv[0], i, char);
1422 while (++i < origalen)
1425 for (i = 1; i < origargc; i++)
1426 origargv[i] = Nullch;
1437 register char **sigv;
1439 for (sigv = sig_name+1; *sigv; sigv++)
1440 if (strEQ(sig,*sigv))
1441 return sig_num[sigv - sig_name];
1443 if (strEQ(sig,"CHLD"))
1447 if (strEQ(sig,"CLD"))
1465 die("Signal SIG%s received, but no signal handler set.\n",
1468 cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
1469 if (!cv || !CvROOT(cv)) {
1471 warn("SIG%s handler \"%s\" not defined.\n",
1472 sig_name[sig], GvENAME(gv) );
1476 oldstack = curstack;
1477 if (curstack != signalstack)
1478 AvFILL(signalstack) = 0;
1479 SWITCHSTACK(curstack, signalstack);
1482 sv = SvREFCNT_inc(psig_name[sig]);
1484 sv = sv_newmortal();
1485 sv_setpv(sv,sig_name[sig]);
1491 perl_call_sv((SV*)cv, G_DISCARD);
1493 SWITCHSTACK(signalstack, oldstack);