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