This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate win32 into ansiperl
[perl5.git] / mg.c
CommitLineData
a0d0e21e 1/* mg.c
79072805 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
79072805
LW
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 *
a0d0e21e
LW
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."
79072805
LW
13 */
14
15#include "EXTERN.h"
16#include "perl.h"
17
e6d9441c 18/* XXX If this causes problems, set i_unistd=undef in the hint file. */
a0d0e21e
LW
19#ifdef I_UNISTD
20# include <unistd.h>
21#endif
a0d0e21e 22
5cd24f17 23#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
188ea221
CS
24# ifndef NGROUPS
25# define NGROUPS 32
26# endif
27#endif
28
c07a80fd
PP
29/*
30 * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
31 */
32
33struct magic_state {
34 SV* mgs_sv;
35 U32 mgs_flags;
36};
37typedef struct magic_state MGS;
38
39static void restore_magic _((void *p));
40
48e43a1c 41static void
8ac85365 42save_magic(MGS *mgs, SV *sv)
c07a80fd 43{
c07a80fd
PP
44 assert(SvMAGICAL(sv));
45
c07a80fd
PP
46 mgs->mgs_sv = sv;
47 mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
48 SAVEDESTRUCTOR(restore_magic, mgs);
49
50 SvMAGICAL_off(sv);
51 SvREADONLY_off(sv);
52 SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
c07a80fd
PP
53}
54
55static void
8ac85365 56restore_magic(void *p)
c07a80fd 57{
48e43a1c 58 MGS* mgs = (MGS*)p;
c07a80fd
PP
59 SV* sv = mgs->mgs_sv;
60
61 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
62 {
63 if (mgs->mgs_flags)
64 SvFLAGS(sv) |= mgs->mgs_flags;
65 else
66 mg_magical(sv);
67 if (SvGMAGICAL(sv))
68 SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
69 }
c07a80fd
PP
70}
71
8990e307 72void
8ac85365 73mg_magical(SV *sv)
8990e307
LW
74{
75 MAGIC* mg;
76 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
77 MGVTBL* vtbl = mg->mg_virtual;
78 if (vtbl) {
a0d0e21e 79 if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
8990e307
LW
80 SvGMAGICAL_on(sv);
81 if (vtbl->svt_set)
82 SvSMAGICAL_on(sv);
83 if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
84 SvRMAGICAL_on(sv);
85 }
86 }
87}
88
79072805 89int
8ac85365 90mg_get(SV *sv)
79072805 91{
48e43a1c 92 MGS mgs;
79072805 93 MAGIC* mg;
c6496cc7 94 MAGIC** mgp;
760ac839 95 int mgp_valid = 0;
463ee0b2 96
c07a80fd 97 ENTER;
48e43a1c 98 save_magic(&mgs, sv);
463ee0b2 99
c6496cc7
PP
100 mgp = &SvMAGIC(sv);
101 while ((mg = *mgp) != 0) {
79072805 102 MGVTBL* vtbl = mg->mg_virtual;
a0d0e21e 103 if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
79072805 104 (*vtbl->svt_get)(sv, mg);
c6496cc7 105 /* Ignore this magic if it's been deleted */
48e43a1c
CS
106 if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
107 (mg->mg_flags & MGf_GSKIP))
108 mgs.mgs_flags = 0;
a0d0e21e 109 }
c6496cc7 110 /* Advance to next magic (complicated by possible deletion) */
760ac839 111 if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
c6496cc7 112 mgp = &mg->mg_moremagic;
760ac839
LW
113 mgp_valid = 1;
114 }
115 else
116 mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
79072805 117 }
463ee0b2 118
c07a80fd 119 LEAVE;
79072805
LW
120 return 0;
121}
122
123int
8ac85365 124mg_set(SV *sv)
79072805 125{
48e43a1c 126 MGS mgs;
79072805 127 MAGIC* mg;
463ee0b2
LW
128 MAGIC* nextmg;
129
c07a80fd 130 ENTER;
48e43a1c 131 save_magic(&mgs, sv);
463ee0b2
LW
132
133 for (mg = SvMAGIC(sv); mg; mg = nextmg) {
79072805 134 MGVTBL* vtbl = mg->mg_virtual;
463ee0b2 135 nextmg = mg->mg_moremagic; /* it may delete itself */
a0d0e21e
LW
136 if (mg->mg_flags & MGf_GSKIP) {
137 mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
48e43a1c 138 mgs.mgs_flags = 0;
a0d0e21e 139 }
79072805
LW
140 if (vtbl && vtbl->svt_set)
141 (*vtbl->svt_set)(sv, mg);
142 }
463ee0b2 143
c07a80fd 144 LEAVE;
79072805
LW
145 return 0;
146}
147
148U32
8ac85365 149mg_len(SV *sv)
79072805
LW
150{
151 MAGIC* mg;
748a9306 152 char *junk;
463ee0b2 153 STRLEN len;
463ee0b2 154
79072805
LW
155 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
156 MGVTBL* vtbl = mg->mg_virtual;
85e6fe83 157 if (vtbl && vtbl->svt_len) {
48e43a1c
CS
158 MGS mgs;
159
c07a80fd 160 ENTER;
48e43a1c 161 save_magic(&mgs, sv);
a0d0e21e 162 /* omit MGf_GSKIP -- not changed here */
85e6fe83 163 len = (*vtbl->svt_len)(sv, mg);
c07a80fd 164 LEAVE;
85e6fe83
LW
165 return len;
166 }
167 }
168
748a9306 169 junk = SvPV(sv, len);
463ee0b2 170 return len;
79072805
LW
171}
172
173int
8ac85365 174mg_clear(SV *sv)
79072805 175{
48e43a1c 176 MGS mgs;
79072805 177 MAGIC* mg;
463ee0b2 178
c07a80fd 179 ENTER;
48e43a1c 180 save_magic(&mgs, sv);
463ee0b2 181
79072805
LW
182 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
183 MGVTBL* vtbl = mg->mg_virtual;
a0d0e21e
LW
184 /* omit GSKIP -- never set here */
185
79072805
LW
186 if (vtbl && vtbl->svt_clear)
187 (*vtbl->svt_clear)(sv, mg);
188 }
463ee0b2 189
c07a80fd 190 LEAVE;
79072805
LW
191 return 0;
192}
193
93a17b20 194MAGIC*
8ac85365 195mg_find(SV *sv, int type)
93a17b20
LW
196{
197 MAGIC* mg;
93a17b20
LW
198 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
199 if (mg->mg_type == type)
200 return mg;
201 }
202 return 0;
203}
204
79072805 205int
8ac85365 206mg_copy(SV *sv, SV *nsv, char *key, I32 klen)
79072805 207{
463ee0b2 208 int count = 0;
79072805 209 MAGIC* mg;
463ee0b2
LW
210 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
211 if (isUPPER(mg->mg_type)) {
a0d0e21e 212 sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen);
463ee0b2 213 count++;
79072805 214 }
79072805 215 }
463ee0b2 216 return count;
79072805
LW
217}
218
219int
8ac85365 220mg_free(SV *sv)
79072805
LW
221{
222 MAGIC* mg;
223 MAGIC* moremagic;
224 for (mg = SvMAGIC(sv); mg; mg = moremagic) {
225 MGVTBL* vtbl = mg->mg_virtual;
226 moremagic = mg->mg_moremagic;
227 if (vtbl && vtbl->svt_free)
228 (*vtbl->svt_free)(sv, mg);
93a17b20 229 if (mg->mg_ptr && mg->mg_type != 'g')
88e89b8a
PP
230 if (mg->mg_len >= 0)
231 Safefree(mg->mg_ptr);
232 else if (mg->mg_len == HEf_SVKEY)
233 SvREFCNT_dec((SV*)mg->mg_ptr);
85e6fe83 234 if (mg->mg_flags & MGf_REFCOUNTED)
8990e307 235 SvREFCNT_dec(mg->mg_obj);
79072805
LW
236 Safefree(mg);
237 }
238 SvMAGIC(sv) = 0;
239 return 0;
240}
241
242#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
243#include <signal.h>
244#endif
245
93a17b20 246U32
8ac85365 247magic_len(SV *sv, MAGIC *mg)
93a17b20 248{
a863c7d1 249 dTHR;
93a17b20
LW
250 register I32 paren;
251 register char *s;
252 register I32 i;
bbce6d69 253 register REGEXP *rx;
748a9306 254 char *t;
93a17b20
LW
255
256 switch (*mg->mg_ptr) {
257 case '1': case '2': case '3': case '4':
258 case '5': case '6': case '7': case '8': case '9': case '&':
bbce6d69 259 if (curpm && (rx = curpm->op_pmregexp)) {
93a17b20
LW
260 paren = atoi(mg->mg_ptr);
261 getparen:
bbce6d69
PP
262 if (paren <= rx->nparens &&
263 (s = rx->startp[paren]) &&
264 (t = rx->endp[paren]))
265 {
748a9306 266 i = t - s;
71be2cbc 267 if (i >= 0)
93a17b20 268 return i;
93a17b20 269 }
93a17b20 270 }
748a9306 271 return 0;
93a17b20 272 case '+':
bbce6d69
PP
273 if (curpm && (rx = curpm->op_pmregexp)) {
274 paren = rx->lastparen;
13f57bf8
CS
275 if (paren)
276 goto getparen;
93a17b20 277 }
748a9306 278 return 0;
93a17b20 279 case '`':
bbce6d69 280 if (curpm && (rx = curpm->op_pmregexp)) {
13f57bf8 281 if ((s = rx->subbeg) && rx->startp[0]) {
bbce6d69 282 i = rx->startp[0] - s;
71be2cbc 283 if (i >= 0)
93a17b20 284 return i;
93a17b20 285 }
93a17b20 286 }
748a9306 287 return 0;
93a17b20 288 case '\'':
bbce6d69 289 if (curpm && (rx = curpm->op_pmregexp)) {
13f57bf8
CS
290 if (rx->subend && (s = rx->endp[0])) {
291 i = rx->subend - s;
292 if (i >= 0)
5cd24f17 293 return i;
93a17b20 294 }
93a17b20 295 }
748a9306 296 return 0;
93a17b20
LW
297 case ',':
298 return (STRLEN)ofslen;
299 case '\\':
300 return (STRLEN)orslen;
301 }
302 magic_get(sv,mg);
303 if (!SvPOK(sv) && SvNIOK(sv))
463ee0b2 304 sv_2pv(sv, &na);
93a17b20
LW
305 if (SvPOK(sv))
306 return SvCUR(sv);
307 return 0;
308}
309
79072805 310int
8ac85365 311magic_get(SV *sv, MAGIC *mg)
79072805 312{
a863c7d1 313 dTHR;
79072805
LW
314 register I32 paren;
315 register char *s;
316 register I32 i;
bbce6d69 317 register REGEXP *rx;
748a9306 318 char *t;
79072805
LW
319
320 switch (*mg->mg_ptr) {
748a9306
LW
321 case '\001': /* ^A */
322 sv_setsv(sv, bodytarget);
323 break;
79072805 324 case '\004': /* ^D */
188ea221 325 sv_setiv(sv, (IV)(debug & 32767));
79072805 326 break;
28f23441
PP
327 case '\005': /* ^E */
328#ifdef VMS
329 {
330# include <descrip.h>
331# include <starlet.h>
332 char msg[255];
333 $DESCRIPTOR(msgdsc,msg);
946ec16e 334 sv_setnv(sv,(double) vaxc$errno);
28f23441
PP
335 if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1)
336 sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length);
337 else
338 sv_setpv(sv,"");
339 }
340#else
88e89b8a 341#ifdef OS2
fb73857a
PP
342 if (!(_emx_env & 0x200)) { /* Under DOS */
343 sv_setnv(sv, (double)errno);
344 sv_setpv(sv, errno ? Strerror(errno) : "");
345 } else {
346 if (errno != errno_isOS2)
347 Perl_rc = _syserrno();
348 sv_setnv(sv, (double)Perl_rc);
349 sv_setpv(sv, os2error(Perl_rc));
350 }
88e89b8a 351#else
22fae026
TM
352#ifdef WIN32
353 {
354 DWORD dwErr = GetLastError();
355 sv_setnv(sv, (double)dwErr);
356 if (dwErr)
357 win32_str_os_error(sv, dwErr);
358 else
359 sv_setpv(sv, "");
360 SetLastError(dwErr);
361 }
362#else
946ec16e 363 sv_setnv(sv, (double)errno);
28f23441
PP
364 sv_setpv(sv, errno ? Strerror(errno) : "");
365#endif
88e89b8a 366#endif
22fae026 367#endif
946ec16e 368 SvNOK_on(sv); /* what a wonderful hack! */
28f23441 369 break;
79072805 370 case '\006': /* ^F */
188ea221 371 sv_setiv(sv, (IV)maxsysfd);
79072805 372 break;
a0d0e21e 373 case '\010': /* ^H */
188ea221 374 sv_setiv(sv, (IV)hints);
a0d0e21e 375 break;
79072805
LW
376 case '\t': /* ^I */
377 if (inplace)
378 sv_setpv(sv, inplace);
379 else
188ea221 380 sv_setsv(sv, &sv_undef);
79072805 381 break;
28f23441 382 case '\017': /* ^O */
188ea221 383 sv_setpv(sv, osname);
28f23441 384 break;
79072805 385 case '\020': /* ^P */
188ea221 386 sv_setiv(sv, (IV)perldb);
79072805 387 break;
fb73857a 388 case '\023': /* ^S */
d58bf5aa
MB
389 {
390 dTHR;
391 if (lex_state != LEX_NOTPARSING)
392 SvOK_off(sv);
393 else if (in_eval)
394 sv_setiv(sv, 1);
395 else
396 sv_setiv(sv, 0);
397 }
fb73857a 398 break;
79072805 399 case '\024': /* ^T */
88e89b8a 400#ifdef BIG_TIME
188ea221 401 sv_setnv(sv, basetime);
88e89b8a 402#else
188ea221 403 sv_setiv(sv, (IV)basetime);
88e89b8a 404#endif
79072805
LW
405 break;
406 case '\027': /* ^W */
188ea221 407 sv_setiv(sv, (IV)dowarn);
79072805
LW
408 break;
409 case '1': case '2': case '3': case '4':
410 case '5': case '6': case '7': case '8': case '9': case '&':
bbce6d69 411 if (curpm && (rx = curpm->op_pmregexp)) {
a863c7d1
MB
412 /*
413 * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
414 * XXX Does the new way break anything?
415 */
416 paren = atoi(mg->mg_ptr);
79072805 417 getparen:
bbce6d69
PP
418 if (paren <= rx->nparens &&
419 (s = rx->startp[paren]) &&
420 (t = rx->endp[paren]))
421 {
748a9306 422 i = t - s;
13f57bf8 423 getrx:
748a9306 424 if (i >= 0) {
13f57bf8
CS
425 bool was_tainted;
426 if (tainting) {
427 was_tainted = tainted;
428 tainted = FALSE;
429 }
79072805 430 sv_setpvn(sv,s,i);
13f57bf8 431 if (tainting)
c277df42 432 tainted = was_tainted || RX_MATCH_TAINTED(rx);
748a9306
LW
433 break;
434 }
79072805 435 }
79072805 436 }
748a9306 437 sv_setsv(sv,&sv_undef);
79072805
LW
438 break;
439 case '+':
bbce6d69
PP
440 if (curpm && (rx = curpm->op_pmregexp)) {
441 paren = rx->lastparen;
a0d0e21e
LW
442 if (paren)
443 goto getparen;
79072805 444 }
748a9306 445 sv_setsv(sv,&sv_undef);
79072805
LW
446 break;
447 case '`':
bbce6d69 448 if (curpm && (rx = curpm->op_pmregexp)) {
13f57bf8 449 if ((s = rx->subbeg) && rx->startp[0]) {
bbce6d69 450 i = rx->startp[0] - s;
13f57bf8 451 goto getrx;
79072805 452 }
79072805 453 }
748a9306 454 sv_setsv(sv,&sv_undef);
79072805
LW
455 break;
456 case '\'':
bbce6d69 457 if (curpm && (rx = curpm->op_pmregexp)) {
13f57bf8
CS
458 if (rx->subend && (s = rx->endp[0])) {
459 i = rx->subend - s;
460 goto getrx;
79072805 461 }
79072805 462 }
748a9306 463 sv_setsv(sv,&sv_undef);
79072805
LW
464 break;
465 case '.':
466#ifndef lint
a0d0e21e 467 if (GvIO(last_in_gv)) {
188ea221 468 sv_setiv(sv, (IV)IoLINES(GvIO(last_in_gv)));
79072805
LW
469 }
470#endif
471 break;
472 case '?':
809a5acc
MB
473 {
474 dTHR;
475 sv_setiv(sv, (IV)STATUS_CURRENT);
ff0cee69 476#ifdef COMPLEX_STATUS
809a5acc
MB
477 LvTARGOFF(sv) = statusvalue;
478 LvTARGLEN(sv) = statusvalue_vms;
ff0cee69 479#endif
809a5acc 480 }
79072805
LW
481 break;
482 case '^':
a0d0e21e 483 s = IoTOP_NAME(GvIOp(defoutgv));
79072805
LW
484 if (s)
485 sv_setpv(sv,s);
486 else {
487 sv_setpv(sv,GvENAME(defoutgv));
488 sv_catpv(sv,"_TOP");
489 }
490 break;
491 case '~':
a0d0e21e 492 s = IoFMT_NAME(GvIOp(defoutgv));
79072805
LW
493 if (!s)
494 s = GvENAME(defoutgv);
495 sv_setpv(sv,s);
496 break;
497#ifndef lint
498 case '=':
188ea221 499 sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(defoutgv)));
79072805
LW
500 break;
501 case '-':
188ea221 502 sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(defoutgv)));
79072805
LW
503 break;
504 case '%':
188ea221 505 sv_setiv(sv, (IV)IoPAGE(GvIOp(defoutgv)));
79072805
LW
506 break;
507#endif
508 case ':':
509 break;
510 case '/':
511 break;
512 case '[':
0f15f207 513 WITH_THR(sv_setiv(sv, (IV)curcop->cop_arybase));
79072805
LW
514 break;
515 case '|':
188ea221 516 sv_setiv(sv, (IV)(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
79072805
LW
517 break;
518 case ',':
519 sv_setpvn(sv,ofs,ofslen);
520 break;
521 case '\\':
522 sv_setpvn(sv,ors,orslen);
523 break;
524 case '#':
525 sv_setpv(sv,ofmt);
526 break;
527 case '!':
a5f75d66 528#ifdef VMS
946ec16e 529 sv_setnv(sv, (double)((errno == EVMSERR) ? vaxc$errno : errno));
88e89b8a 530 sv_setpv(sv, errno ? Strerror(errno) : "");
a5f75d66 531#else
88e89b8a
PP
532 {
533 int saveerrno = errno;
946ec16e 534 sv_setnv(sv, (double)errno);
88e89b8a
PP
535#ifdef OS2
536 if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc));
537 else
a5f75d66 538#endif
2304df62 539 sv_setpv(sv, errno ? Strerror(errno) : "");
88e89b8a
PP
540 errno = saveerrno;
541 }
542#endif
946ec16e 543 SvNOK_on(sv); /* what a wonderful hack! */
79072805
LW
544 break;
545 case '<':
188ea221 546 sv_setiv(sv, (IV)uid);
79072805
LW
547 break;
548 case '>':
188ea221 549 sv_setiv(sv, (IV)euid);
79072805
LW
550 break;
551 case '(':
188ea221 552 sv_setiv(sv, (IV)gid);
fc36a67e 553 sv_setpvf(sv, "%Vd", (IV)gid);
79072805
LW
554 goto add_groups;
555 case ')':
188ea221 556 sv_setiv(sv, (IV)egid);
fc36a67e 557 sv_setpvf(sv, "%Vd", (IV)egid);
79072805 558 add_groups:
79072805 559#ifdef HAS_GETGROUPS
79072805 560 {
a0d0e21e 561 Groups_t gary[NGROUPS];
79072805 562 i = getgroups(NGROUPS,gary);
46fc3d4c 563 while (--i >= 0)
fc36a67e 564 sv_catpvf(sv, " %Vd", (IV)gary[i]);
79072805
LW
565 }
566#endif
29355cf7 567 SvIOK_on(sv); /* what a wonderful hack! */
79072805
LW
568 break;
569 case '*':
570 break;
571 case '0':
572 break;
a863c7d1
MB
573#ifdef USE_THREADS
574 case '@':
38a03e6e 575 sv_setsv(sv, thr->errsv);
a863c7d1
MB
576 break;
577#endif /* USE_THREADS */
79072805 578 }
a0d0e21e 579 return 0;
79072805
LW
580}
581
582int
8ac85365 583magic_getuvar(SV *sv, MAGIC *mg)
79072805
LW
584{
585 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
586
587 if (uf && uf->uf_val)
588 (*uf->uf_val)(uf->uf_index, sv);
589 return 0;
590}
591
592int
8ac85365 593magic_setenv(SV *sv, MAGIC *mg)
79072805
LW
594{
595 register char *s;
88e89b8a 596 char *ptr;
5aabfad6 597 STRLEN len, klen;
a0d0e21e 598 I32 i;
1e422769 599
a0d0e21e 600 s = SvPV(sv,len);
5aabfad6 601 ptr = MgPV(mg,klen);
88e89b8a 602 my_setenv(ptr, s);
1e422769 603
a0d0e21e
LW
604#ifdef DYNAMIC_ENV_FETCH
605 /* We just undefd an environment var. Is a replacement */
606 /* waiting in the wings? */
607 if (!len) {
5aabfad6
PP
608 SV **valp;
609 if ((valp = hv_fetch(GvHVn(envgv), ptr, klen, FALSE)))
610 s = SvPV(*valp, len);
a0d0e21e
LW
611 }
612#endif
1e422769 613
39e571d4 614#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
79072805
LW
615 /* And you'll never guess what the dog had */
616 /* in its mouth... */
463ee0b2 617 if (tainting) {
1e422769
PP
618 MgTAINTEDDIR_off(mg);
619#ifdef VMS
5aabfad6 620 if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
1e422769
PP
621 char pathbuf[256], eltbuf[256], *cp, *elt = s;
622 struct stat sbuf;
623 int i = 0, j = 0;
624
625 do { /* DCL$PATH may be a search list */
626 while (1) { /* as may dev portion of any element */
627 if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) {
628 if ( *(cp+1) == '.' || *(cp+1) == '-' ||
629 cando_by_name(S_IWUSR,0,elt) ) {
630 MgTAINTEDDIR_on(mg);
631 return 0;
632 }
633 }
634 if ((cp = strchr(elt, ':')) != Nullch)
635 *cp = '\0';
636 if (my_trnlnm(elt, eltbuf, j++))
637 elt = eltbuf;
638 else
639 break;
640 }
641 j = 0;
642 } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf));
643 }
644#endif /* VMS */
5aabfad6 645 if (s && klen == 4 && strEQ(ptr,"PATH")) {
a0d0e21e 646 char *strend = s + len;
463ee0b2
LW
647
648 while (s < strend) {
96827780 649 char tmpbuf[256];
1e422769 650 struct stat st;
96827780 651 s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
fc36a67e 652 s, strend, ':', &i);
463ee0b2 653 s++;
96827780
MB
654 if (i >= sizeof tmpbuf /* too long -- assume the worst */
655 || *tmpbuf != '/'
656 || (Stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
8990e307 657 MgTAINTEDDIR_on(mg);
1e422769
PP
658 return 0;
659 }
463ee0b2 660 }
79072805
LW
661 }
662 }
39e571d4 663#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
1e422769 664
79072805
LW
665 return 0;
666}
667
668int
8ac85365 669magic_clearenv(SV *sv, MAGIC *mg)
85e6fe83 670{
5aabfad6 671 my_setenv(MgPV(mg,na),Nullch);
85e6fe83
LW
672 return 0;
673}
674
88e89b8a 675int
8ac85365 676magic_set_all_env(SV *sv, MAGIC *mg)
fb73857a
PP
677{
678#if defined(VMS)
679 die("Can't make list assignment to %%ENV on this system");
680#else
d58bf5aa 681 dTHR;
fb73857a
PP
682 if (localizing) {
683 HE* entry;
684 magic_clear_all_env(sv,mg);
685 hv_iterinit((HV*)sv);
686 while (entry = hv_iternext((HV*)sv)) {
687 I32 keylen;
688 my_setenv(hv_iterkey(entry, &keylen),
689 SvPV(hv_iterval((HV*)sv, entry), na));
690 }
691 }
692#endif
693 return 0;
694}
695
696int
8ac85365 697magic_clear_all_env(SV *sv, MAGIC *mg)
66b1d557 698{
3e3baf6d
TB
699#if defined(VMS)
700 die("Can't make list assignment to %%ENV on this system");
701#else
702#ifdef WIN32
703 char *envv = GetEnvironmentStrings();
704 char *cur = envv;
705 STRLEN len;
706 while (*cur) {
707 char *end = strchr(cur,'=');
708 if (end && end != cur) {
709 *end = '\0';
710 my_setenv(cur,Nullch);
711 *end = '=';
712 cur += strlen(end+1)+1;
713 }
714 else if ((len = strlen(cur)))
715 cur += len+1;
716 }
717 FreeEnvironmentStrings(envv);
66b1d557
HM
718#else
719 I32 i;
720
721 if (environ == origenviron)
722 New(901, environ, 1, char*);
723 else
724 for (i = 0; environ[i]; i++)
725 Safefree(environ[i]);
726 environ[0] = Nullch;
727
66b1d557 728#endif
3e3baf6d
TB
729#endif
730 return 0;
66b1d557
HM
731}
732
733int
8ac85365 734magic_getsig(SV *sv, MAGIC *mg)
88e89b8a
PP
735{
736 I32 i;
737 /* Are we fetching a signal entry? */
5aabfad6 738 i = whichsig(MgPV(mg,na));
88e89b8a
PP
739 if (i) {
740 if(psig_ptr[i])
741 sv_setsv(sv,psig_ptr[i]);
742 else {
ff68c719
PP
743 Sighandler_t sigstate = rsignal_state(i);
744
88e89b8a 745 /* cache state so we don't fetch it again */
ff68c719 746 if(sigstate == SIG_IGN)
88e89b8a
PP
747 sv_setpv(sv,"IGNORE");
748 else
749 sv_setsv(sv,&sv_undef);
750 psig_ptr[i] = SvREFCNT_inc(sv);
751 SvTEMP_off(sv);
752 }
753 }
754 return 0;
755}
756int
8ac85365 757magic_clearsig(SV *sv, MAGIC *mg)
88e89b8a
PP
758{
759 I32 i;
760 /* Are we clearing a signal entry? */
5aabfad6 761 i = whichsig(MgPV(mg,na));
88e89b8a
PP
762 if (i) {
763 if(psig_ptr[i]) {
764 SvREFCNT_dec(psig_ptr[i]);
765 psig_ptr[i]=0;
766 }
767 if(psig_name[i]) {
768 SvREFCNT_dec(psig_name[i]);
769 psig_name[i]=0;
770 }
771 }
772 return 0;
773}
3d37d572 774
85e6fe83 775int
8ac85365 776magic_setsig(SV *sv, MAGIC *mg)
79072805 777{
11343788 778 dTHR;
79072805
LW
779 register char *s;
780 I32 i;
748a9306 781 SV** svp;
a0d0e21e 782
5aabfad6 783 s = MgPV(mg,na);
748a9306
LW
784 if (*s == '_') {
785 if (strEQ(s,"__DIE__"))
786 svp = &diehook;
787 else if (strEQ(s,"__WARN__"))
788 svp = &warnhook;
789 else if (strEQ(s,"__PARSE__"))
790 svp = &parsehook;
791 else
792 croak("No such hook: %s", s);
793 i = 0;
4633a7c4
LW
794 if (*svp) {
795 SvREFCNT_dec(*svp);
796 *svp = 0;
797 }
748a9306
LW
798 }
799 else {
800 i = whichsig(s); /* ...no, a brick */
801 if (!i) {
802 if (dowarn || strEQ(s,"ALARM"))
803 warn("No such signal: SIG%s", s);
804 return 0;
805 }
ff0cee69
PP
806 SvREFCNT_dec(psig_name[i]);
807 SvREFCNT_dec(psig_ptr[i]);
88e89b8a 808 psig_ptr[i] = SvREFCNT_inc(sv);
88e89b8a 809 SvTEMP_off(sv); /* Make sure it doesn't go away on us */
ff0cee69 810 psig_name[i] = newSVpv(s, strlen(s));
88e89b8a 811 SvREADONLY_on(psig_name[i]);
748a9306 812 }
a0d0e21e 813 if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
748a9306 814 if (i)
c23142e2 815 (void)rsignal(i, sighandlerp);
748a9306
LW
816 else
817 *svp = SvREFCNT_inc(sv);
a0d0e21e
LW
818 return 0;
819 }
820 s = SvPV_force(sv,na);
748a9306
LW
821 if (strEQ(s,"IGNORE")) {
822 if (i)
ff68c719 823 (void)rsignal(i, SIG_IGN);
748a9306
LW
824 else
825 *svp = 0;
826 }
827 else if (strEQ(s,"DEFAULT") || !*s) {
828 if (i)
ff68c719 829 (void)rsignal(i, SIG_DFL);
748a9306
LW
830 else
831 *svp = 0;
832 }
79072805 833 else {
5aabfad6
PP
834 /*
835 * We should warn if HINT_STRICT_REFS, but without
836 * access to a known hint bit in a known OP, we can't
837 * tell whether HINT_STRICT_REFS is in force or not.
838 */
46fc3d4c
PP
839 if (!strchr(s,':') && !strchr(s,'\''))
840 sv_setpv(sv, form("main::%s", s));
748a9306 841 if (i)
c23142e2 842 (void)rsignal(i, sighandlerp);
748a9306
LW
843 else
844 *svp = SvREFCNT_inc(sv);
79072805
LW
845 }
846 return 0;
847}
848
849int
8ac85365 850magic_setisa(SV *sv, MAGIC *mg)
79072805 851{
a0231f0e
MB
852 HV *stash;
853 SV **svp;
854 I32 fill;
855 HV *basefields = Nullhv;
856 GV **gvp;
857 GV *gv;
858 HE *he;
859 static char *FIELDS = "FIELDS";
860
463ee0b2 861 sub_generation++;
a0231f0e
MB
862
863 if (mg->mg_type == 'i')
864 return 0; /* Ignore lower-case version of the magic */
865
866 stash = GvSTASH(mg->mg_obj);
867 svp = AvARRAY((AV*)sv);
868
869 for (fill = AvFILL((AV*)sv); fill >= 0; fill--, svp++) {
870 HV *basestash = gv_stashsv(*svp, FALSE);
871
872 if (!basestash) {
873 if (dowarn)
874 warn("No such package \"%_\" in @ISA assignment", *svp);
875 continue;
876 }
877 gvp = (GV**)hv_fetch(basestash, FIELDS, 6, FALSE);
878 if (gvp && *gvp && GvHV(*gvp)) {
879 if (basefields)
880 croak("Can't multiply inherit %%FIELDS");
881 basefields = GvHV(*gvp);
882 }
883 }
884
885 if (!basefields)
886 return 0;
887
888 gv = (GV*)*hv_fetch(stash, FIELDS, 6, TRUE);
889 if (!isGV(gv))
890 gv_init(gv, stash, FIELDS, 6, TRUE);
891 if (!GvHV(gv))
892 GvHV(gv) = newHV();
893 if (HvKEYS(GvHV(gv)))
894 croak("Inherited %%FIELDS can't override existing %%FIELDS");
895
896 hv_iterinit(GvHV(gv));
897 while ((he = hv_iternext(basefields)))
898 hv_store(GvHV(gv), HeKEY(he), HeKLEN(he), HeVAL(he), HeHASH(he));
899
463ee0b2
LW
900 return 0;
901}
902
a0d0e21e
LW
903#ifdef OVERLOAD
904
463ee0b2 905int
8ac85365 906magic_setamagic(SV *sv, MAGIC *mg)
463ee0b2 907{
a0d0e21e
LW
908 /* HV_badAMAGIC_on(Sv_STASH(sv)); */
909 amagic_generation++;
463ee0b2 910
a0d0e21e
LW
911 return 0;
912}
913#endif /* OVERLOAD */
463ee0b2 914
946ec16e 915int
8ac85365 916magic_setnkeys(SV *sv, MAGIC *mg)
946ec16e
PP
917{
918 if (LvTARG(sv)) {
919 hv_ksplit((HV*)LvTARG(sv), SvIV(sv));
920 LvTARG(sv) = Nullsv; /* Don't allow a ref to reassign this. */
921 }
922 return 0;
923}
924
a0d0e21e 925static int
8ac85365 926magic_methpack(SV *sv, MAGIC *mg, char *meth)
a0d0e21e
LW
927{
928 dSP;
463ee0b2 929
a0d0e21e
LW
930 ENTER;
931 SAVETMPS;
932 PUSHMARK(sp);
933 EXTEND(sp, 2);
934 PUSHs(mg->mg_obj);
88e89b8a
PP
935 if (mg->mg_ptr) {
936 if (mg->mg_len >= 0)
937 PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
938 else if (mg->mg_len == HEf_SVKEY)
939 PUSHs((SV*)mg->mg_ptr);
940 }
a0d0e21e
LW
941 else if (mg->mg_type == 'p')
942 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
463ee0b2
LW
943 PUTBACK;
944
a0d0e21e
LW
945 if (perl_call_method(meth, G_SCALAR))
946 sv_setsv(sv, *stack_sp--);
463ee0b2 947
a0d0e21e
LW
948 FREETMPS;
949 LEAVE;
950 return 0;
951}
463ee0b2 952
a0d0e21e 953int
8ac85365 954magic_getpack(SV *sv, MAGIC *mg)
a0d0e21e
LW
955{
956 magic_methpack(sv,mg,"FETCH");
957 if (mg->mg_ptr)
958 mg->mg_flags |= MGf_GSKIP;
463ee0b2
LW
959 return 0;
960}
961
962int
8ac85365 963magic_setpack(SV *sv, MAGIC *mg)
463ee0b2 964{
463ee0b2 965 dSP;
463ee0b2 966
a0d0e21e
LW
967 PUSHMARK(sp);
968 EXTEND(sp, 3);
969 PUSHs(mg->mg_obj);
88e89b8a
PP
970 if (mg->mg_ptr) {
971 if (mg->mg_len >= 0)
972 PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
973 else if (mg->mg_len == HEf_SVKEY)
974 PUSHs((SV*)mg->mg_ptr);
975 }
a0d0e21e
LW
976 else if (mg->mg_type == 'p')
977 PUSHs(sv_2mortal(newSViv(mg->mg_len)));
463ee0b2
LW
978 PUSHs(sv);
979 PUTBACK;
980
a0d0e21e 981 perl_call_method("STORE", G_SCALAR|G_DISCARD);
463ee0b2
LW
982
983 return 0;
984}
985
986int
8ac85365 987magic_clearpack(SV *sv, MAGIC *mg)
463ee0b2 988{
a0d0e21e
LW
989 return magic_methpack(sv,mg,"DELETE");
990}
463ee0b2 991
8ac85365 992int magic_wipepack(SV *sv, MAGIC *mg)
a0d0e21e
LW
993{
994 dSP;
463ee0b2 995
a0d0e21e
LW
996 PUSHMARK(sp);
997 XPUSHs(mg->mg_obj);
463ee0b2 998 PUTBACK;
463ee0b2 999
a0d0e21e 1000 perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
463ee0b2
LW
1001
1002 return 0;
1003}
1004
1005int
8ac85365 1006magic_nextpack(SV *sv, MAGIC *mg, SV *key)
463ee0b2 1007{
463ee0b2 1008 dSP;
a0d0e21e 1009 char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
463ee0b2
LW
1010
1011 ENTER;
a0d0e21e
LW
1012 SAVETMPS;
1013 PUSHMARK(sp);
1014 EXTEND(sp, 2);
1015 PUSHs(mg->mg_obj);
463ee0b2
LW
1016 if (SvOK(key))
1017 PUSHs(key);
1018 PUTBACK;
1019
a0d0e21e
LW
1020 if (perl_call_method(meth, G_SCALAR))
1021 sv_setsv(key, *stack_sp--);
463ee0b2 1022
a0d0e21e
LW
1023 FREETMPS;
1024 LEAVE;
79072805
LW
1025 return 0;
1026}
1027
1028int
8ac85365 1029magic_existspack(SV *sv, MAGIC *mg)
a0d0e21e
LW
1030{
1031 return magic_methpack(sv,mg,"EXISTS");
1032}
1033
1034int
8ac85365 1035magic_setdbline(SV *sv, MAGIC *mg)
79072805 1036{
11343788 1037 dTHR;
79072805
LW
1038 OP *o;
1039 I32 i;
1040 GV* gv;
1041 SV** svp;
1042
1043 gv = DBline;
1044 i = SvTRUE(sv);
188ea221 1045 svp = av_fetch(GvAV(gv),
5aabfad6 1046 atoi(MgPV(mg,na)), FALSE);
8990e307 1047 if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
93a17b20 1048 o->op_private = i;
79072805
LW
1049 else
1050 warn("Can't break at that line\n");
1051 return 0;
1052}
1053
1054int
8ac85365 1055magic_getarylen(SV *sv, MAGIC *mg)
79072805 1056{
0f15f207 1057 dTHR;
a0d0e21e 1058 sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
79072805
LW
1059 return 0;
1060}
1061
1062int
8ac85365 1063magic_setarylen(SV *sv, MAGIC *mg)
79072805 1064{
0f15f207 1065 dTHR;
a0d0e21e
LW
1066 av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
1067 return 0;
1068}
1069
1070int
8ac85365 1071magic_getpos(SV *sv, MAGIC *mg)
a0d0e21e
LW
1072{
1073 SV* lsv = LvTARG(sv);
1074
1075 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
1076 mg = mg_find(lsv, 'g');
1077 if (mg && mg->mg_len >= 0) {
0f15f207 1078 dTHR;
a0d0e21e
LW
1079 sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
1080 return 0;
1081 }
1082 }
1083 (void)SvOK_off(sv);
1084 return 0;
1085}
1086
1087int
8ac85365 1088magic_setpos(SV *sv, MAGIC *mg)
a0d0e21e
LW
1089{
1090 SV* lsv = LvTARG(sv);
1091 SSize_t pos;
1092 STRLEN len;
1093
1094 mg = 0;
1095
1096 if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv))
1097 mg = mg_find(lsv, 'g');
1098 if (!mg) {
1099 if (!SvOK(sv))
1100 return 0;
1101 sv_magic(lsv, (SV*)0, 'g', Nullch, 0);
1102 mg = mg_find(lsv, 'g');
1103 }
1104 else if (!SvOK(sv)) {
1105 mg->mg_len = -1;
1106 return 0;
1107 }
1108 len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
1109
0f15f207 1110 WITH_THR(pos = SvIV(sv) - curcop->cop_arybase);
a0d0e21e
LW
1111 if (pos < 0) {
1112 pos += len;
1113 if (pos < 0)
1114 pos = 0;
1115 }
1116 else if (pos > len)
1117 pos = len;
1118 mg->mg_len = pos;
71be2cbc 1119 mg->mg_flags &= ~MGf_MINMATCH;
a0d0e21e 1120
79072805
LW
1121 return 0;
1122}
1123
1124int
8ac85365 1125magic_getglob(SV *sv, MAGIC *mg)
79072805 1126{
8646b087
PP
1127 if (SvFAKE(sv)) { /* FAKE globs can get coerced */
1128 SvFAKE_off(sv);
946ec16e 1129 gv_efullname3(sv,((GV*)sv), "*");
8646b087
PP
1130 SvFAKE_on(sv);
1131 }
1132 else
946ec16e 1133 gv_efullname3(sv,((GV*)sv), "*"); /* a gv value, be nice */
79072805
LW
1134 return 0;
1135}
1136
1137int
8ac85365 1138magic_setglob(SV *sv, MAGIC *mg)
79072805
LW
1139{
1140 register char *s;
1141 GV* gv;
1142
1143 if (!SvOK(sv))
1144 return 0;
463ee0b2 1145 s = SvPV(sv, na);
79072805
LW
1146 if (*s == '*' && s[1])
1147 s++;
85e6fe83 1148 gv = gv_fetchpv(s,TRUE, SVt_PVGV);
79072805
LW
1149 if (sv == (SV*)gv)
1150 return 0;
1151 if (GvGP(sv))
88e89b8a 1152 gp_free((GV*)sv);
79072805 1153 GvGP(sv) = gp_ref(GvGP(gv));
79072805
LW
1154 return 0;
1155}
1156
1157int
8ac85365 1158magic_setsubstr(SV *sv, MAGIC *mg)
79072805 1159{
8990e307
LW
1160 STRLEN len;
1161 char *tmps = SvPV(sv,len);
1162 sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
79072805
LW
1163 return 0;
1164}
1165
1166int
8ac85365 1167magic_gettaint(SV *sv, MAGIC *mg)
463ee0b2 1168{
a863c7d1 1169 dTHR;
bbce6d69
PP
1170 TAINT_IF((mg->mg_len & 1) ||
1171 (mg->mg_len & 2) && mg->mg_obj == sv); /* kludge */
463ee0b2
LW
1172 return 0;
1173}
1174
1175int
8ac85365 1176magic_settaint(SV *sv, MAGIC *mg)
463ee0b2 1177{
11343788 1178 dTHR;
748a9306
LW
1179 if (localizing) {
1180 if (localizing == 1)
1181 mg->mg_len <<= 1;
1182 else
1183 mg->mg_len >>= 1;
a0d0e21e 1184 }
748a9306
LW
1185 else if (tainted)
1186 mg->mg_len |= 1;
1187 else
1188 mg->mg_len &= ~1;
463ee0b2
LW
1189 return 0;
1190}
1191
1192int
8ac85365 1193magic_setvec(SV *sv, MAGIC *mg)
79072805
LW
1194{
1195 do_vecset(sv); /* XXX slurp this routine */
1196 return 0;
1197}
1198
1199int
8ac85365 1200magic_getdefelem(SV *sv, MAGIC *mg)
5f05dabc 1201{
71be2cbc 1202 SV *targ = Nullsv;
5f05dabc 1203 if (LvTARGLEN(sv)) {
68dc0745
PP
1204 if (mg->mg_obj) {
1205 HV* hv = (HV*)LvTARG(sv);
1206 HE* he = hv_fetch_ent(hv, mg->mg_obj, FALSE, 0);
1207 if (he)
1208 targ = HeVAL(he);
1209 }
1210 else {
1211 AV* av = (AV*)LvTARG(sv);
1212 if ((I32)LvTARGOFF(sv) <= AvFILL(av))
1213 targ = AvARRAY(av)[LvTARGOFF(sv)];
1214 }
1215 if (targ && targ != &sv_undef) {
e858de61 1216 dTHR; /* just for SvREFCNT_dec */
68dc0745
PP
1217 /* somebody else defined it for us */
1218 SvREFCNT_dec(LvTARG(sv));
1219 LvTARG(sv) = SvREFCNT_inc(targ);
1220 LvTARGLEN(sv) = 0;
1221 SvREFCNT_dec(mg->mg_obj);
1222 mg->mg_obj = Nullsv;
1223 mg->mg_flags &= ~MGf_REFCOUNTED;
1224 }
5f05dabc 1225 }
71be2cbc
PP
1226 else
1227 targ = LvTARG(sv);
1228 sv_setsv(sv, targ ? targ : &sv_undef);
1229 return 0;
1230}
1231
1232int
8ac85365 1233magic_setdefelem(SV *sv, MAGIC *mg)
71be2cbc
PP
1234{
1235 if (LvTARGLEN(sv))
68dc0745
PP
1236 vivify_defelem(sv);
1237 if (LvTARG(sv)) {
5f05dabc 1238 sv_setsv(LvTARG(sv), sv);
68dc0745
PP
1239 SvSETMAGIC(LvTARG(sv));
1240 }
5f05dabc
PP
1241 return 0;
1242}
1243
1244int
8ac85365 1245magic_freedefelem(SV *sv, MAGIC *mg)
5f05dabc
PP
1246{
1247 SvREFCNT_dec(LvTARG(sv));
71be2cbc
PP
1248 return 0;
1249}
1250
1251void
8ac85365 1252vivify_defelem(SV *sv)
71be2cbc 1253{
e858de61 1254 dTHR; /* just for SvREFCNT_inc and SvREFCNT_dec*/
68dc0745
PP
1255 MAGIC* mg;
1256 SV* value;
71be2cbc 1257
68dc0745 1258 if (!LvTARGLEN(sv) || !(mg = mg_find(sv, 'y')))
71be2cbc 1259 return;
68dc0745
PP
1260 if (mg->mg_obj) {
1261 HV* hv = (HV*)LvTARG(sv);
1262 HE* he = hv_fetch_ent(hv, mg->mg_obj, TRUE, 0);
1263 if (!he || (value = HeVAL(he)) == &sv_undef)
1264 croak(no_helem, SvPV(mg->mg_obj, na));
71be2cbc 1265 }
68dc0745
PP
1266 else {
1267 AV* av = (AV*)LvTARG(sv);
5aabfad6 1268 if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
68dc0745
PP
1269 LvTARG(sv) = Nullsv; /* array can't be extended */
1270 else {
1271 SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE);
1272 if (!svp || (value = *svp) == &sv_undef)
1273 croak(no_aelem, (I32)LvTARGOFF(sv));
1274 }
1275 }
3e3baf6d 1276 (void)SvREFCNT_inc(value);
68dc0745
PP
1277 SvREFCNT_dec(LvTARG(sv));
1278 LvTARG(sv) = value;
71be2cbc 1279 LvTARGLEN(sv) = 0;
68dc0745
PP
1280 SvREFCNT_dec(mg->mg_obj);
1281 mg->mg_obj = Nullsv;
1282 mg->mg_flags &= ~MGf_REFCOUNTED;
5f05dabc
PP
1283}
1284
1285int
8ac85365 1286magic_setmglob(SV *sv, MAGIC *mg)
93a17b20 1287{
a0d0e21e 1288 mg->mg_len = -1;
c6496cc7 1289 SvSCREAM_off(sv);
93a17b20
LW
1290 return 0;
1291}
1292
1293int
8ac85365 1294magic_setbm(SV *sv, MAGIC *mg)
79072805 1295{
463ee0b2 1296 sv_unmagic(sv, 'B');
79072805
LW
1297 SvVALID_off(sv);
1298 return 0;
1299}
1300
1301int
8ac85365 1302magic_setfm(SV *sv, MAGIC *mg)
55497cff
PP
1303{
1304 sv_unmagic(sv, 'f');
1305 SvCOMPILED_off(sv);
1306 return 0;
1307}
1308
1309int
8ac85365 1310magic_setuvar(SV *sv, MAGIC *mg)
79072805
LW
1311{
1312 struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
1313
1314 if (uf && uf->uf_set)
1315 (*uf->uf_set)(uf->uf_index, sv);
1316 return 0;
1317}
1318
c277df42
IZ
1319int
1320magic_freeregexp(SV *sv, MAGIC *mg)
1321{
1322 regexp *re = (regexp *)mg->mg_obj;
1323 ReREFCNT_dec(re);
1324 return 0;
1325}
1326
7a4c00b4 1327#ifdef USE_LOCALE_COLLATE
79072805 1328int
8ac85365 1329magic_setcollxfrm(SV *sv, MAGIC *mg)
bbce6d69
PP
1330{
1331 /*
1332 * René Descartes said "I think not."
1333 * and vanished with a faint plop.
1334 */
7a4c00b4
PP
1335 if (mg->mg_ptr) {
1336 Safefree(mg->mg_ptr);
1337 mg->mg_ptr = NULL;
1338 mg->mg_len = -1;
1339 }
bbce6d69
PP
1340 return 0;
1341}
7a4c00b4 1342#endif /* USE_LOCALE_COLLATE */
bbce6d69
PP
1343
1344int
8ac85365 1345magic_set(SV *sv, MAGIC *mg)
79072805 1346{
11343788 1347 dTHR;
79072805
LW
1348 register char *s;
1349 I32 i;
8990e307 1350 STRLEN len;
79072805 1351 switch (*mg->mg_ptr) {
748a9306
LW
1352 case '\001': /* ^A */
1353 sv_setsv(bodytarget, sv);
1354 break;
79072805 1355 case '\004': /* ^D */
8990e307 1356 debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000;
79072805
LW
1357 DEBUG_x(dump_all());
1358 break;
28f23441
PP
1359 case '\005': /* ^E */
1360#ifdef VMS
1361 set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1362#else
22fae026
TM
1363#ifdef WIN32
1364 SetLastError( SvIV(sv) );
1365#else
f86702cc
PP
1366 /* will anyone ever use this? */
1367 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
28f23441 1368#endif
22fae026 1369#endif
28f23441 1370 break;
79072805 1371 case '\006': /* ^F */
463ee0b2 1372 maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805 1373 break;
a0d0e21e
LW
1374 case '\010': /* ^H */
1375 hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
1376 break;
79072805
LW
1377 case '\t': /* ^I */
1378 if (inplace)
1379 Safefree(inplace);
1380 if (SvOK(sv))
a0d0e21e 1381 inplace = savepv(SvPV(sv,na));
79072805
LW
1382 else
1383 inplace = Nullch;
1384 break;
28f23441
PP
1385 case '\017': /* ^O */
1386 if (osname)
1387 Safefree(osname);
1388 if (SvOK(sv))
1389 osname = savepv(SvPV(sv,na));
1390 else
1391 osname = Nullch;
1392 break;
79072805 1393 case '\020': /* ^P */
84902520 1394 perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1395 break;
1396 case '\024': /* ^T */
88e89b8a
PP
1397#ifdef BIG_TIME
1398 basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv));
1399#else
85e6fe83 1400 basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
88e89b8a 1401#endif
79072805
LW
1402 break;
1403 case '\027': /* ^W */
463ee0b2 1404 dowarn = (bool)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1405 break;
1406 case '.':
748a9306
LW
1407 if (localizing) {
1408 if (localizing == 1)
1409 save_sptr((SV**)&last_in_gv);
1410 }
88e89b8a 1411 else if (SvOK(sv) && GvIO(last_in_gv))
a0d0e21e 1412 IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv);
79072805
LW
1413 break;
1414 case '^':
a0d0e21e
LW
1415 Safefree(IoTOP_NAME(GvIOp(defoutgv)));
1416 IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
1417 IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
79072805
LW
1418 break;
1419 case '~':
a0d0e21e
LW
1420 Safefree(IoFMT_NAME(GvIOp(defoutgv)));
1421 IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na));
1422 IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
79072805
LW
1423 break;
1424 case '=':
a0d0e21e 1425 IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1426 break;
1427 case '-':
a0d0e21e
LW
1428 IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
1429 if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L)
1430 IoLINES_LEFT(GvIOp(defoutgv)) = 0L;
79072805
LW
1431 break;
1432 case '%':
a0d0e21e 1433 IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1434 break;
1435 case '|':
4b65379b
CS
1436 {
1437 IO *io = GvIOp(defoutgv);
1438 if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
1439 IoFLAGS(io) &= ~IOf_FLUSH;
1440 else {
1441 if (!(IoFLAGS(io) & IOf_FLUSH)) {
1442 PerlIO *ofp = IoOFP(io);
1443 if (ofp)
1444 (void)PerlIO_flush(ofp);
1445 IoFLAGS(io) |= IOf_FLUSH;
1446 }
1447 }
79072805
LW
1448 }
1449 break;
1450 case '*':
463ee0b2 1451 i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1452 multiline = (i != 0);
1453 break;
1454 case '/':
c07a80fd
PP
1455 SvREFCNT_dec(nrs);
1456 nrs = newSVsv(sv);
1457 SvREFCNT_dec(rs);
1458 rs = SvREFCNT_inc(nrs);
79072805
LW
1459 break;
1460 case '\\':
1461 if (ors)
1462 Safefree(ors);
e3c19b7b
CS
1463 if (SvOK(sv) || SvGMAGICAL(sv))
1464 ors = savepv(SvPV(sv,orslen));
1465 else {
1466 ors = Nullch;
1467 orslen = 0;
1468 }
79072805
LW
1469 break;
1470 case ',':
1471 if (ofs)
1472 Safefree(ofs);
a0d0e21e 1473 ofs = savepv(SvPV(sv, ofslen));
79072805
LW
1474 break;
1475 case '#':
1476 if (ofmt)
1477 Safefree(ofmt);
a0d0e21e 1478 ofmt = savepv(SvPV(sv,na));
79072805
LW
1479 break;
1480 case '[':
a0d0e21e 1481 compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1482 break;
1483 case '?':
ff0cee69
PP
1484#ifdef COMPLEX_STATUS
1485 if (localizing == 2) {
1486 statusvalue = LvTARGOFF(sv);
1487 statusvalue_vms = LvTARGLEN(sv);
1488 }
1489 else
1490#endif
1491#ifdef VMSISH_STATUS
1492 if (VMSISH_STATUS)
1493 STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
1494 else
1495#endif
1496 STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
79072805
LW
1497 break;
1498 case '!':
f86702cc
PP
1499 SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
1500 (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
79072805
LW
1501 break;
1502 case '<':
463ee0b2 1503 uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1504 if (delaymagic) {
1505 delaymagic |= DM_RUID;
1506 break; /* don't do magic till later */
1507 }
1508#ifdef HAS_SETRUID
85e6fe83 1509 (void)setruid((Uid_t)uid);
79072805
LW
1510#else
1511#ifdef HAS_SETREUID
85e6fe83 1512 (void)setreuid((Uid_t)uid, (Uid_t)-1);
748a9306 1513#else
85e6fe83
LW
1514#ifdef HAS_SETRESUID
1515 (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
79072805
LW
1516#else
1517 if (uid == euid) /* special case $< = $> */
1518 (void)setuid(uid);
a0d0e21e
LW
1519 else {
1520 uid = (I32)getuid();
463ee0b2 1521 croak("setruid() not implemented");
a0d0e21e 1522 }
79072805
LW
1523#endif
1524#endif
85e6fe83 1525#endif
748a9306 1526 uid = (I32)getuid();
4633a7c4 1527 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1528 break;
1529 case '>':
463ee0b2 1530 euid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1531 if (delaymagic) {
1532 delaymagic |= DM_EUID;
1533 break; /* don't do magic till later */
1534 }
1535#ifdef HAS_SETEUID
85e6fe83 1536 (void)seteuid((Uid_t)euid);
79072805
LW
1537#else
1538#ifdef HAS_SETREUID
85e6fe83
LW
1539 (void)setreuid((Uid_t)-1, (Uid_t)euid);
1540#else
1541#ifdef HAS_SETRESUID
1542 (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
79072805
LW
1543#else
1544 if (euid == uid) /* special case $> = $< */
1545 setuid(euid);
a0d0e21e
LW
1546 else {
1547 euid = (I32)geteuid();
463ee0b2 1548 croak("seteuid() not implemented");
a0d0e21e 1549 }
79072805
LW
1550#endif
1551#endif
85e6fe83 1552#endif
79072805 1553 euid = (I32)geteuid();
4633a7c4 1554 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1555 break;
1556 case '(':
463ee0b2 1557 gid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
79072805
LW
1558 if (delaymagic) {
1559 delaymagic |= DM_RGID;
1560 break; /* don't do magic till later */
1561 }
1562#ifdef HAS_SETRGID
85e6fe83 1563 (void)setrgid((Gid_t)gid);
79072805
LW
1564#else
1565#ifdef HAS_SETREGID
85e6fe83
LW
1566 (void)setregid((Gid_t)gid, (Gid_t)-1);
1567#else
1568#ifdef HAS_SETRESGID
1569 (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
79072805
LW
1570#else
1571 if (gid == egid) /* special case $( = $) */
1572 (void)setgid(gid);
748a9306
LW
1573 else {
1574 gid = (I32)getgid();
463ee0b2 1575 croak("setrgid() not implemented");
748a9306 1576 }
79072805
LW
1577#endif
1578#endif
85e6fe83 1579#endif
79072805 1580 gid = (I32)getgid();
4633a7c4 1581 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1582 break;
1583 case ')':
5cd24f17
PP
1584#ifdef HAS_SETGROUPS
1585 {
1586 char *p = SvPV(sv, na);
1587 Groups_t gary[NGROUPS];
1588
1589 SET_NUMERIC_STANDARD();
1590 while (isSPACE(*p))
1591 ++p;
1592 egid = I_V(atof(p));
1593 for (i = 0; i < NGROUPS; ++i) {
1594 while (*p && !isSPACE(*p))
1595 ++p;
1596 while (isSPACE(*p))
1597 ++p;
1598 if (!*p)
1599 break;
1600 gary[i] = I_V(atof(p));
1601 }
8cc95fdb
PP
1602 if (i)
1603 (void)setgroups(i, gary);
5cd24f17
PP
1604 }
1605#else /* HAS_SETGROUPS */
463ee0b2 1606 egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
5cd24f17 1607#endif /* HAS_SETGROUPS */
79072805
LW
1608 if (delaymagic) {
1609 delaymagic |= DM_EGID;
1610 break; /* don't do magic till later */
1611 }
1612#ifdef HAS_SETEGID
85e6fe83 1613 (void)setegid((Gid_t)egid);
79072805
LW
1614#else
1615#ifdef HAS_SETREGID
85e6fe83
LW
1616 (void)setregid((Gid_t)-1, (Gid_t)egid);
1617#else
1618#ifdef HAS_SETRESGID
1619 (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
79072805
LW
1620#else
1621 if (egid == gid) /* special case $) = $( */
1622 (void)setgid(egid);
748a9306
LW
1623 else {
1624 egid = (I32)getegid();
463ee0b2 1625 croak("setegid() not implemented");
748a9306 1626 }
79072805
LW
1627#endif
1628#endif
85e6fe83 1629#endif
79072805 1630 egid = (I32)getegid();
4633a7c4 1631 tainting |= (uid && (euid != uid || egid != gid));
79072805
LW
1632 break;
1633 case ':':
a0d0e21e 1634 chopset = SvPV_force(sv,na);
79072805
LW
1635 break;
1636 case '0':
1637 if (!origalen) {
1638 s = origargv[0];
1639 s += strlen(s);
1640 /* See if all the arguments are contiguous in memory */
1641 for (i = 1; i < origargc; i++) {
fb73857a
PP
1642 if (origargv[i] == s + 1
1643#ifdef OS2
1644 || origargv[i] == s + 2
1645#endif
1646 )
79072805 1647 s += strlen(++s); /* this one is ok too */
fb73857a
PP
1648 else
1649 break;
79072805 1650 }
bbce6d69 1651 /* can grab env area too? */
fb73857a
PP
1652 if (origenviron && (origenviron[0] == s + 1
1653#ifdef OS2
1654 || (origenviron[0] == s + 9 && (s += 8))
1655#endif
1656 )) {
66b1d557 1657 my_setenv("NoNe SuCh", Nullch);
79072805
LW
1658 /* force copy of environment */
1659 for (i = 0; origenviron[i]; i++)
1660 if (origenviron[i] == s + 1)
1661 s += strlen(++s);
fb73857a
PP
1662 else
1663 break;
79072805
LW
1664 }
1665 origalen = s - origargv[0];
1666 }
a0d0e21e 1667 s = SvPV_force(sv,len);
8990e307 1668 i = len;
79072805
LW
1669 if (i >= origalen) {
1670 i = origalen;
fb73857a
PP
1671 /* don't allow system to limit $0 seen by script */
1672 /* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
79072805 1673 Copy(s, origargv[0], i, char);
fb73857a
PP
1674 s = origargv[0]+i;
1675 *s = '\0';
79072805
LW
1676 }
1677 else {
1678 Copy(s, origargv[0], i, char);
1679 s = origargv[0]+i;
1680 *s++ = '\0';
1681 while (++i < origalen)
8990e307
LW
1682 *s++ = ' ';
1683 s = origargv[0]+i;
ed6116ce 1684 for (i = 1; i < origargc; i++)
8990e307 1685 origargv[i] = Nullch;
79072805
LW
1686 }
1687 break;
a863c7d1
MB
1688#ifdef USE_THREADS
1689 case '@':
38a03e6e 1690 sv_setsv(thr->errsv, sv);
a863c7d1
MB
1691 break;
1692#endif /* USE_THREADS */
79072805
LW
1693 }
1694 return 0;
1695}
1696
f93b4edd
MB
1697#ifdef USE_THREADS
1698int
8ac85365 1699magic_mutexfree(SV *sv, MAGIC *mg)
f93b4edd
MB
1700{
1701 dTHR;
bc1f4c86
MB
1702 DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n",
1703 (unsigned long)thr, (unsigned long)sv);)
f93b4edd
MB
1704 if (MgOWNER(mg))
1705 croak("panic: magic_mutexfree");
1706 MUTEX_DESTROY(MgMUTEXP(mg));
1707 COND_DESTROY(MgCONDP(mg));
e55aaa0e 1708 SvREFCNT_dec(sv);
f93b4edd
MB
1709 return 0;
1710}
1711#endif /* USE_THREADS */
1712
79072805 1713I32
8ac85365 1714whichsig(char *sig)
79072805
LW
1715{
1716 register char **sigv;
1717
1718 for (sigv = sig_name+1; *sigv; sigv++)
1719 if (strEQ(sig,*sigv))
8e07c86e 1720 return sig_num[sigv - sig_name];
79072805
LW
1721#ifdef SIGCLD
1722 if (strEQ(sig,"CHLD"))
1723 return SIGCLD;
1724#endif
1725#ifdef SIGCHLD
1726 if (strEQ(sig,"CLD"))
1727 return SIGCHLD;
1728#endif
1729 return 0;
1730}
1731
84902520
TB
1732static SV* sig_sv;
1733
1734static void
8ac85365 1735unwind_handler_stack(void *p)
84902520 1736{
ff26ac79 1737 dTHR;
84902520
TB
1738 U32 flags = *(U32*)p;
1739
1740 if (flags & 1)
1741 savestack_ix -= 5; /* Unprotect save in progress. */
1742 /* cxstack_ix-- Not needed, die already unwound it. */
1743 if (flags & 64)
1744 SvREFCNT_dec(sig_sv);
1745}
1746
ecfc5424 1747Signal_t
8ac85365 1748sighandler(int sig)
79072805
LW
1749{
1750 dSP;
00d579c5 1751 GV *gv = Nullgv;
a0d0e21e 1752 HV *st;
84902520 1753 SV *sv, *tSv = Sv;
00d579c5 1754 CV *cv = Nullcv;
79072805 1755 AV *oldstack;
84902520
TB
1756 OP *myop = op;
1757 U32 flags = 0;
1758 I32 o_save_i = savestack_ix, type;
c09156bb 1759 PERL_CONTEXT *cx;
84902520
TB
1760 XPV *tXpv = Xpv;
1761
1762 if (savestack_ix + 15 <= savestack_max)
1763 flags |= 1;
1764 if (cxstack_ix < cxstack_max - 2)
1765 flags |= 2;
1766 if (markstack_ptr < markstack_max - 2)
1767 flags |= 4;
1768 if (retstack_ix < retstack_max - 2)
1769 flags |= 8;
1770 if (scopestack_ix < scopestack_max - 3)
1771 flags |= 16;
1772
1773 if (flags & 2) { /* POPBLOCK may decrease cxstack too early. */
1774 cxstack_ix++; /* Protect from overwrite. */
1775 cx = &cxstack[cxstack_ix];
1776 type = cx->cx_type; /* Can be during partial write. */
1777 cx->cx_type = CXt_NULL; /* Make it safe for unwind. */
1778 }
ff0cee69
PP
1779 if (!psig_ptr[sig])
1780 die("Signal SIG%s received, but no signal handler set.\n",
1781 sig_name[sig]);
1782
84902520
TB
1783 /* Max number of items pushed there is 3*n or 4. We cannot fix
1784 infinity, so we fix 4 (in fact 5): */
1785 if (flags & 1) {
1786 savestack_ix += 5; /* Protect save in progress. */
1787 o_save_i = savestack_ix;
1788 SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags);
1789 }
1790 if (flags & 4)
1791 markstack_ptr++; /* Protect mark. */
1792 if (flags & 8) {
1793 retstack_ix++;
1794 retstack[retstack_ix] = NULL;
1795 }
1796 if (flags & 16)
1797 scopestack_ix += 1;
1798 /* sv_2cv is too complicated, try a simpler variant first: */
1799 if (!SvROK(psig_ptr[sig]) || !(cv = (CV*)SvRV(psig_ptr[sig]))
1800 || SvTYPE(cv) != SVt_PVCV)
1801 cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
1802
a0d0e21e 1803 if (!cv || !CvROOT(cv)) {
79072805
LW
1804 if (dowarn)
1805 warn("SIG%s handler \"%s\" not defined.\n",
00d579c5
GS
1806 sig_name[sig], (gv ? GvENAME(gv)
1807 : ((cv && CvGV(cv))
1808 ? GvENAME(CvGV(cv))
1809 : "__ANON__")));
1810 goto cleanup;
79072805
LW
1811 }
1812
88e89b8a
PP
1813 oldstack = curstack;
1814 if (curstack != signalstack)
a0d0e21e 1815 AvFILL(signalstack) = 0;
88e89b8a 1816 SWITCHSTACK(curstack, signalstack);
79072805 1817
84902520 1818 if(psig_name[sig]) {
88e89b8a 1819 sv = SvREFCNT_inc(psig_name[sig]);
84902520
TB
1820 flags |= 64;
1821 sig_sv = sv;
1822 } else {
ff0cee69
PP
1823 sv = sv_newmortal();
1824 sv_setpv(sv,sig_name[sig]);
88e89b8a 1825 }
a0d0e21e 1826 PUSHMARK(sp);
79072805 1827 PUSHs(sv);
79072805 1828 PUTBACK;
a0d0e21e
LW
1829
1830 perl_call_sv((SV*)cv, G_DISCARD);
79072805
LW
1831
1832 SWITCHSTACK(signalstack, oldstack);
00d579c5 1833cleanup:
84902520
TB
1834 if (flags & 1)
1835 savestack_ix -= 8; /* Unprotect save in progress. */
1836 if (flags & 2) {
1837 cxstack[cxstack_ix].cx_type = type;
1838 cxstack_ix -= 1;
1839 }
1840 if (flags & 4)
1841 markstack_ptr--;
1842 if (flags & 8)
1843 retstack_ix--;
1844 if (flags & 16)
1845 scopestack_ix -= 1;
1846 if (flags & 64)
1847 SvREFCNT_dec(sv);
1848 op = myop; /* Apparently not needed... */
1849
1850 Sv = tSv; /* Restore global temporaries. */
1851 Xpv = tXpv;
79072805
LW
1852 return;
1853}
4e35701f
NIS
1854
1855