This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
clean up some stray "global" symbols
[perl5.git] / gv.c
CommitLineData
a0d0e21e 1/* gv.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, 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 * 'Mercy!' cried Gandalf. 'If the giving of information is to be the cure
12 * of your inquisitiveness, I shall spend all the rest of my days answering
13 * you. What more do you want to know?'
14 * 'The names of all the stars, and of all living things, and the whole
15 * history of Middle-earth and Over-heaven and of the Sundering Seas,'
16 * laughed Pippin.
79072805
LW
17 */
18
19#include "EXTERN.h"
20#include "perl.h"
21
22GV *
8ac85365 23gv_AVadd(register GV *gv)
79072805 24{
a0d0e21e
LW
25 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
26 croak("Bad symbol for array");
79072805
LW
27 if (!GvAV(gv))
28 GvAV(gv) = newAV();
29 return gv;
30}
31
32GV *
8ac85365 33gv_HVadd(register GV *gv)
79072805 34{
a0d0e21e
LW
35 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
36 croak("Bad symbol for hash");
79072805 37 if (!GvHV(gv))
463ee0b2 38 GvHV(gv) = newHV();
79072805
LW
39 return gv;
40}
41
42GV *
8ac85365 43gv_IOadd(register GV *gv)
a0d0e21e
LW
44{
45 if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
46 croak("Bad symbol for filehandle");
47 if (!GvIOp(gv))
48 GvIOp(gv) = newIO();
49 return gv;
50}
51
52GV *
08105a92 53gv_fetchfile(const char *name)
79072805 54{
e858de61 55 dTHR;
53d95988
CS
56 char smallbuf[256];
57 char *tmpbuf;
8ebc5c01 58 STRLEN tmplen;
79072805
LW
59 GV *gv;
60
53d95988
CS
61 tmplen = strlen(name) + 2;
62 if (tmplen < sizeof smallbuf)
63 tmpbuf = smallbuf;
64 else
65 New(603, tmpbuf, tmplen + 1, char);
66 tmpbuf[0] = '_';
67 tmpbuf[1] = '<';
68 strcpy(tmpbuf + 2, name);
3280af22 69 gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE);
8ebc5c01 70 if (!isGV(gv))
3280af22 71 gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE);
53d95988
CS
72 if (tmpbuf != smallbuf)
73 Safefree(tmpbuf);
79072805 74 sv_setpv(GvSV(gv), name);
8ebc5c01 75 if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm")))
a5f75d66 76 GvMULTI_on(gv);
84902520 77 if (PERLDB_LINE)
93a17b20 78 hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
79072805
LW
79 return gv;
80}
81
463ee0b2 82void
08105a92 83gv_init(GV *gv, HV *stash, const char *name, STRLEN len, int multi)
463ee0b2 84{
0f15f207 85 dTHR;
463ee0b2 86 register GP *gp;
55d729e4
GS
87 bool doproto = SvTYPE(gv) > SVt_NULL;
88 char *proto = (doproto && SvPOK(gv)) ? SvPVX(gv) : NULL;
463ee0b2 89
dc437b57 90 sv_upgrade((SV*)gv, SVt_PVGV);
55d729e4
GS
91 if (SvLEN(gv)) {
92 if (proto) {
93 SvPVX(gv) = NULL;
94 SvLEN(gv) = 0;
95 SvPOK_off(gv);
96 } else
97 Safefree(SvPVX(gv));
98 }
44a8e56a 99 Newz(602, gp, 1, GP);
8990e307 100 GvGP(gv) = gp_ref(gp);
463ee0b2 101 GvSV(gv) = NEWSV(72,0);
3280af22
NIS
102 GvLINE(gv) = PL_curcop->cop_line;
103 GvFILEGV(gv) = PL_curcop->cop_filegv;
005a453c 104 GvCVGEN(gv) = 0;
463ee0b2
LW
105 GvEGV(gv) = gv;
106 sv_magic((SV*)gv, (SV*)gv, '*', name, len);
85aff577 107 GvSTASH(gv) = (HV*)SvREFCNT_inc(stash);
a0d0e21e 108 GvNAME(gv) = savepvn(name, len);
463ee0b2 109 GvNAMELEN(gv) = len;
23ad5bf5 110 if (multi || doproto) /* doproto means it _was_ mentioned */
a5f75d66 111 GvMULTI_on(gv);
55d729e4 112 if (doproto) { /* Replicate part of newSUB here. */
57ff9a15 113 SvIOK_off(gv);
55d729e4 114 ENTER;
b099ddc0 115 /* XXX unsafe for threads if eval_owner isn't held */
55d729e4 116 start_subparse(0,0); /* Create CV in compcv. */
3280af22 117 GvCV(gv) = PL_compcv;
55d729e4
GS
118 LEAVE;
119
3280af22 120 PL_sub_generation++;
55d729e4 121 CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
3280af22
NIS
122 CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv;
123 CvSTASH(GvCV(gv)) = PL_curstash;
55d729e4
GS
124#ifdef USE_THREADS
125 CvOWNER(GvCV(gv)) = 0;
1cfa4ec7 126 if (!CvMUTEXP(GvCV(gv))) {
b0a484d2 127 New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
1cfa4ec7
GS
128 MUTEX_INIT(CvMUTEXP(GvCV(gv)));
129 }
55d729e4
GS
130#endif /* USE_THREADS */
131 if (proto) {
132 sv_setpv((SV*)GvCV(gv), proto);
133 Safefree(proto);
134 }
135 }
463ee0b2
LW
136}
137
76e3520e 138STATIC void
8ac85365 139gv_init_sv(GV *gv, I32 sv_type)
a0d0e21e
LW
140{
141 switch (sv_type) {
142 case SVt_PVIO:
143 (void)GvIOn(gv);
144 break;
145 case SVt_PVAV:
146 (void)GvAVn(gv);
147 break;
148 case SVt_PVHV:
149 (void)GvHVn(gv);
150 break;
151 }
152}
153
79072805 154GV *
08105a92 155gv_fetchmeth(HV *stash, const char *name, STRLEN len, I32 level)
79072805
LW
156{
157 AV* av;
463ee0b2 158 GV* topgv;
79072805 159 GV* gv;
463ee0b2 160 GV** gvp;
748a9306 161 CV* cv;
a0d0e21e
LW
162
163 if (!stash)
164 return 0;
44a8e56a 165 if ((level > 100) || (level < -100))
3e0ccd42
JP
166 croak("Recursive inheritance detected while looking for method '%s' in package '%s'",
167 name, HvNAME(stash));
463ee0b2 168
463ee0b2 169 DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
44a8e56a
PP
170
171 gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
172 if (!gvp)
173 topgv = Nullgv;
174 else {
175 topgv = *gvp;
176 if (SvTYPE(topgv) != SVt_PVGV)
177 gv_init(topgv, stash, name, len, TRUE);
178 if (cv = GvCV(topgv)) {
179 /* If genuine method or valid cache entry, use it */
3280af22 180 if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation)
7a4c00b4 181 return topgv;
44a8e56a
PP
182 /* Stale cached entry: junk it */
183 SvREFCNT_dec(cv);
184 GvCV(topgv) = cv = Nullcv;
185 GvCVGEN(topgv) = 0;
748a9306 186 }
3280af22 187 else if (GvCVGEN(topgv) == PL_sub_generation)
005a453c 188 return 0; /* cache indicates sub doesn't exist */
463ee0b2 189 }
79072805 190
9607fc9c 191 gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
3280af22 192 av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : Nullav;
9607fc9c 193
fb73857a
PP
194 /* create and re-create @.*::SUPER::ISA on demand */
195 if (!av || !SvMAGIC(av)) {
9607fc9c
PP
196 char* packname = HvNAME(stash);
197 STRLEN packlen = strlen(packname);
198
199 if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
200 HV* basestash;
201
202 packlen -= 7;
203 basestash = gv_stashpvn(packname, packlen, TRUE);
204 gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE);
3280af22 205 if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
e858de61 206 dTHR; /* just for SvREFCNT_dec */
9607fc9c
PP
207 gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE);
208 if (!gvp || !(gv = *gvp))
209 croak("Cannot create %s::ISA", HvNAME(stash));
210 if (SvTYPE(gv) != SVt_PVGV)
211 gv_init(gv, stash, "ISA", 3, TRUE);
212 SvREFCNT_dec(GvAV(gv));
213 GvAV(gv) = (AV*)SvREFCNT_inc(av);
214 }
215 }
216 }
217
218 if (av) {
79072805 219 SV** svp = AvARRAY(av);
93965878
NIS
220 /* NOTE: No support for tied ISA */
221 I32 items = AvFILLp(av) + 1;
79072805 222 while (items--) {
79072805 223 SV* sv = *svp++;
a0d0e21e 224 HV* basestash = gv_stashsv(sv, FALSE);
9bbf4081 225 if (!basestash) {
d008e5eb 226 dTHR; /* just for ckWARN */
599cee73
PM
227 if (ckWARN(WARN_MISC))
228 warner(WARN_MISC, "Can't locate package %s for @%s::ISA",
463ee0b2 229 SvPVX(sv), HvNAME(stash));
79072805
LW
230 continue;
231 }
44a8e56a
PP
232 gv = gv_fetchmeth(basestash, name, len,
233 (level >= 0) ? level + 1 : level - 1);
234 if (gv)
235 goto gotcha;
79072805
LW
236 }
237 }
a0d0e21e 238
9607fc9c
PP
239 /* if at top level, try UNIVERSAL */
240
44a8e56a 241 if (level == 0 || level == -1) {
9607fc9c
PP
242 HV* lastchance;
243
dc437b57 244 if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
44a8e56a
PP
245 if (gv = gv_fetchmeth(lastchance, name, len,
246 (level >= 0) ? level + 1 : level - 1)) {
247 gotcha:
dc848c6f
PP
248 /*
249 * Cache method in topgv if:
250 * 1. topgv has no synonyms (else inheritance crosses wires)
251 * 2. method isn't a stub (else AUTOLOAD fails spectacularly)
252 */
253 if (topgv &&
254 GvREFCNT(topgv) == 1 &&
255 (cv = GvCV(gv)) &&
256 (CvROOT(cv) || CvXSUB(cv)))
257 {
44a8e56a
PP
258 if (cv = GvCV(topgv))
259 SvREFCNT_dec(cv);
260 GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
3280af22 261 GvCVGEN(topgv) = PL_sub_generation;
44a8e56a 262 }
a0d0e21e
LW
263 return gv;
264 }
005a453c
JP
265 else if (topgv && GvREFCNT(topgv) == 1) {
266 /* cache the fact that the method is not defined */
3280af22 267 GvCVGEN(topgv) = PL_sub_generation;
005a453c 268 }
a0d0e21e
LW
269 }
270 }
271
79072805
LW
272 return 0;
273}
274
275GV *
08105a92 276gv_fetchmethod(HV *stash, const char *name)
463ee0b2 277{
dc848c6f
PP
278 return gv_fetchmethod_autoload(stash, name, TRUE);
279}
280
281GV *
08105a92 282gv_fetchmethod_autoload(HV *stash, const char *name, I32 autoload)
dc848c6f 283{
0f15f207 284 dTHR;
08105a92
GS
285 register const char *nend;
286 const char *nsplit = 0;
a0d0e21e 287 GV* gv;
463ee0b2
LW
288
289 for (nend = name; *nend; nend++) {
9607fc9c 290 if (*nend == '\'')
a0d0e21e 291 nsplit = nend;
9607fc9c
PP
292 else if (*nend == ':' && *(nend + 1) == ':')
293 nsplit = ++nend;
a0d0e21e
LW
294 }
295 if (nsplit) {
08105a92 296 const char *origname = name;
a0d0e21e 297 name = nsplit + 1;
a0d0e21e
LW
298 if (*nsplit == ':')
299 --nsplit;
9607fc9c
PP
300 if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) {
301 /* ->SUPER::method should really be looked up in original stash */
fc36a67e 302 SV *tmpstr = sv_2mortal(newSVpvf("%s::SUPER",
3280af22 303 HvNAME(PL_curcop->cop_stash)));
9607fc9c
PP
304 stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE);
305 DEBUG_o( deb("Treating %s as %s::%s\n",
306 origname, HvNAME(stash), name) );
4633a7c4 307 }
9607fc9c
PP
308 else
309 stash = gv_stashpvn(origname, nsplit - origname, TRUE);
4633a7c4
LW
310 }
311
9607fc9c 312 gv = gv_fetchmeth(stash, name, nend - name, 0);
a0d0e21e 313 if (!gv) {
702887b4 314 if (strEQ(name,"import"))
3280af22 315 gv = (GV*)&PL_sv_yes;
dc848c6f 316 else if (autoload)
54310121 317 gv = gv_autoload4(stash, name, nend - name, TRUE);
463ee0b2 318 }
dc848c6f
PP
319 else if (autoload) {
320 CV* cv = GvCV(gv);
09280a33
CS
321 if (!CvROOT(cv) && !CvXSUB(cv)) {
322 GV* stubgv;
323 GV* autogv;
324
325 if (CvANON(cv))
326 stubgv = gv;
327 else {
328 stubgv = CvGV(cv);
329 if (GvCV(stubgv) != cv) /* orphaned import */
330 stubgv = gv;
331 }
332 autogv = gv_autoload4(GvSTASH(stubgv),
333 GvNAME(stubgv), GvNAMELEN(stubgv), TRUE);
dc848c6f
PP
334 if (autogv)
335 gv = autogv;
336 }
337 }
44a8e56a
PP
338
339 return gv;
340}
341
342GV*
08105a92 343gv_autoload4(HV *stash, const char *name, STRLEN len, I32 method)
44a8e56a 344{
d008e5eb 345 dTHR;
44a8e56a
PP
346 static char autoload[] = "AUTOLOAD";
347 static STRLEN autolen = 8;
348 GV* gv;
349 CV* cv;
350 HV* varstash;
351 GV* vargv;
352 SV* varsv;
353
354 if (len == autolen && strnEQ(name, autoload, autolen))
355 return Nullgv;
dc848c6f
PP
356 if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
357 return Nullgv;
358 cv = GvCV(gv);
359
360 /*
361 * Inheriting AUTOLOAD for non-methods works ... for now.
362 */
599cee73
PM
363 if (ckWARN(WARN_DEPRECATED) && !method &&
364 (GvCVGEN(gv) || GvSTASH(gv) != stash))
365 warner(WARN_DEPRECATED,
dc848c6f
PP
366 "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
367 HvNAME(stash), (int)len, name);
44a8e56a
PP
368
369 /*
370 * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
371 * The subroutine's original name may not be "AUTOLOAD", so we don't
372 * use that, but for lack of anything better we will use the sub's
373 * original package to look up $AUTOLOAD.
374 */
375 varstash = GvSTASH(CvGV(cv));
376 vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
377 if (!isGV(vargv))
378 gv_init(vargv, varstash, autoload, autolen, FALSE);
379 varsv = GvSV(vargv);
380 sv_setpv(varsv, HvNAME(stash));
381 sv_catpvn(varsv, "::", 2);
382 sv_catpvn(varsv, name, len);
383 SvTAINTED_off(varsv);
a0d0e21e
LW
384 return gv;
385}
386
387HV*
08105a92 388gv_stashpv(const char *name, I32 create)
a0d0e21e 389{
dc437b57
PP
390 return gv_stashpvn(name, strlen(name), create);
391}
392
393HV*
08105a92 394gv_stashpvn(const char *name, U32 namelen, I32 create)
dc437b57 395{
46fc3d4c
PP
396 char smallbuf[256];
397 char *tmpbuf;
a0d0e21e
LW
398 HV *stash;
399 GV *tmpgv;
dc437b57 400
46fc3d4c
PP
401 if (namelen + 3 < sizeof smallbuf)
402 tmpbuf = smallbuf;
403 else
404 New(606, tmpbuf, namelen + 3, char);
dc437b57
PP
405 Copy(name,tmpbuf,namelen,char);
406 tmpbuf[namelen++] = ':';
407 tmpbuf[namelen++] = ':';
408 tmpbuf[namelen] = '\0';
46fc3d4c
PP
409 tmpgv = gv_fetchpv(tmpbuf, create, SVt_PVHV);
410 if (tmpbuf != smallbuf)
411 Safefree(tmpbuf);
a0d0e21e
LW
412 if (!tmpgv)
413 return 0;
414 if (!GvHV(tmpgv))
415 GvHV(tmpgv) = newHV();
416 stash = GvHV(tmpgv);
417 if (!HvNAME(stash))
418 HvNAME(stash) = savepv(name);
419 return stash;
463ee0b2
LW
420}
421
a0d0e21e 422HV*
8ac85365 423gv_stashsv(SV *sv, I32 create)
a0d0e21e 424{
dc437b57
PP
425 register char *ptr;
426 STRLEN len;
427 ptr = SvPV(sv,len);
428 return gv_stashpvn(ptr, len, create);
a0d0e21e
LW
429}
430
431
463ee0b2 432GV *
08105a92 433gv_fetchpv(const char *nambeg, I32 add, I32 sv_type)
79072805 434{
11343788 435 dTHR;
08105a92 436 register const char *name = nambeg;
463ee0b2 437 register GV *gv = 0;
79072805 438 GV**gvp;
79072805 439 I32 len;
08105a92 440 register const char *namend;
463ee0b2 441 HV *stash = 0;
9607fc9c 442 U32 add_gvflags = 0;
79072805 443
c07a80fd
PP
444 if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
445 name++;
446
79072805 447 for (namend = name; *namend; namend++) {
463ee0b2
LW
448 if ((*namend == '\'' && namend[1]) ||
449 (*namend == ':' && namend[1] == ':'))
450 {
463ee0b2 451 if (!stash)
3280af22 452 stash = PL_defstash;
dc437b57 453 if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
a0d0e21e 454 return Nullgv;
463ee0b2 455
85e6fe83
LW
456 len = namend - name;
457 if (len > 0) {
3c78fafa 458 char smallbuf[256];
62b57502 459 char *tmpbuf;
62b57502 460
3c78fafa
GS
461 if (len + 3 < sizeof smallbuf)
462 tmpbuf = smallbuf;
62b57502
MB
463 else
464 New(601, tmpbuf, len+3, char);
a0d0e21e
LW
465 Copy(name, tmpbuf, len, char);
466 tmpbuf[len++] = ':';
467 tmpbuf[len++] = ':';
468 tmpbuf[len] = '\0';
463ee0b2 469 gvp = (GV**)hv_fetch(stash,tmpbuf,len,add);
6fa846a0 470 gv = gvp ? *gvp : Nullgv;
3280af22 471 if (gv && gv != (GV*)&PL_sv_undef) {
6fa846a0 472 if (SvTYPE(gv) != SVt_PVGV)
0f303493 473 gv_init(gv, stash, tmpbuf, len, (add & GV_ADDMULTI));
6fa846a0
GS
474 else
475 GvMULTI_on(gv);
476 }
3c78fafa 477 if (tmpbuf != smallbuf)
62b57502 478 Safefree(tmpbuf);
3280af22 479 if (!gv || gv == (GV*)&PL_sv_undef)
a0d0e21e 480 return Nullgv;
85e6fe83 481
463ee0b2
LW
482 if (!(stash = GvHV(gv)))
483 stash = GvHV(gv) = newHV();
85e6fe83 484
463ee0b2 485 if (!HvNAME(stash))
a0d0e21e 486 HvNAME(stash) = savepvn(nambeg, namend - nambeg);
463ee0b2
LW
487 }
488
489 if (*namend == ':')
490 namend++;
491 namend++;
492 name = namend;
493 if (!*name)
3280af22 494 return gv ? gv : (GV*)*hv_fetch(PL_defstash, "main::", 6, TRUE);
79072805 495 }
79072805 496 }
a0d0e21e
LW
497 len = namend - name;
498 if (!len)
499 len = 1;
463ee0b2
LW
500
501 /* No stash in name, so see how we can default */
502
503 if (!stash) {
b86a2fa7
GS
504 if (isIDFIRST(*name)
505 || (IN_UTF8 && ((*name & 0xc0) == 0xc0) && isIDFIRST_utf8((U8*)name)))
506 {
9607fc9c
PP
507 bool global = FALSE;
508
463ee0b2 509 if (isUPPER(*name)) {
9d116dd7
JH
510 if (*name == 'S' && (
511 strEQ(name, "SIG") ||
512 strEQ(name, "STDIN") ||
513 strEQ(name, "STDOUT") ||
514 strEQ(name, "STDERR")))
515 global = TRUE;
516 else if (*name == 'I' && strEQ(name, "INC"))
517 global = TRUE;
518 else if (*name == 'E' && strEQ(name, "ENV"))
519 global = TRUE;
463ee0b2
LW
520 else if (*name == 'A' && (
521 strEQ(name, "ARGV") ||
9d116dd7 522 strEQ(name, "ARGVOUT")))
463ee0b2
LW
523 global = TRUE;
524 }
525 else if (*name == '_' && !name[1])
526 global = TRUE;
9607fc9c 527
463ee0b2 528 if (global)
3280af22
NIS
529 stash = PL_defstash;
530 else if ((COP*)PL_curcop == &PL_compiling) {
531 stash = PL_curstash;
532 if (add && (PL_hints & HINT_STRICT_VARS) &&
748a9306
LW
533 sv_type != SVt_PVCV &&
534 sv_type != SVt_PVGV &&
4633a7c4 535 sv_type != SVt_PVFM &&
c07a80fd 536 sv_type != SVt_PVIO &&
377b8fbc 537 !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
748a9306 538 {
4633a7c4
LW
539 gvp = (GV**)hv_fetch(stash,name,len,0);
540 if (!gvp ||
3280af22 541 *gvp == (GV*)&PL_sv_undef ||
a5f75d66
AD
542 SvTYPE(*gvp) != SVt_PVGV)
543 {
4633a7c4 544 stash = 0;
a5f75d66
AD
545 }
546 else if (sv_type == SVt_PV && !GvIMPORTED_SV(*gvp) ||
547 sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
548 sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
4633a7c4 549 {
a5f75d66 550 warn("Variable \"%c%s\" is not imported",
4633a7c4
LW
551 sv_type == SVt_PVAV ? '@' :
552 sv_type == SVt_PVHV ? '%' : '$',
553 name);
8ebc5c01 554 if (GvCVu(*gvp))
4633a7c4 555 warn("(Did you mean &%s instead?)\n", name);
a0d0e21e 556 stash = 0;
4633a7c4 557 }
a0d0e21e 558 }
85e6fe83 559 }
463ee0b2 560 else
3280af22 561 stash = PL_curcop->cop_stash;
463ee0b2
LW
562 }
563 else
3280af22 564 stash = PL_defstash;
463ee0b2
LW
565 }
566
567 /* By this point we should have a stash and a name */
568
a0d0e21e 569 if (!stash) {
93233ece 570 if (!add)
a0d0e21e 571 return Nullgv;
462551cc 572 {
2c4aebbd
T
573 char sv_type_char = ((sv_type == SVt_PV) ? '$'
574 : (sv_type == SVt_PVAV) ? '@'
575 : (sv_type == SVt_PVHV) ? '%'
576 : 0);
577 if (sv_type_char)
578 warn("Global symbol \"%c%s\" requires explicit package name",
579 sv_type_char, name);
580 else
93233ece
CS
581 warn("Global symbol \"%s\" requires explicit package name",
582 name);
a0d0e21e 583 }
3280af22
NIS
584 ++PL_error_count;
585 stash = PL_curstash ? PL_curstash : PL_defstash; /* avoid core dumps */
93233ece
CS
586 add_gvflags = ((sv_type == SVt_PV) ? GVf_IMPORTED_SV
587 : (sv_type == SVt_PVAV) ? GVf_IMPORTED_AV
588 : (sv_type == SVt_PVHV) ? GVf_IMPORTED_HV
589 : 0);
a0d0e21e
LW
590 }
591
592 if (!SvREFCNT(stash)) /* symbol table under destruction */
593 return Nullgv;
594
79072805 595 gvp = (GV**)hv_fetch(stash,name,len,add);
3280af22 596 if (!gvp || *gvp == (GV*)&PL_sv_undef)
79072805
LW
597 return Nullgv;
598 gv = *gvp;
599 if (SvTYPE(gv) == SVt_PVGV) {
a0d0e21e 600 if (add) {
a5f75d66 601 GvMULTI_on(gv);
a0d0e21e
LW
602 gv_init_sv(gv, sv_type);
603 }
79072805 604 return gv;
55d729e4
GS
605 } else if (add & GV_NOINIT) {
606 return gv;
79072805 607 }
93a17b20
LW
608
609 /* Adding a new symbol */
610
55d729e4 611 if (add & GV_ADDWARN)
a0d0e21e 612 warn("Had to create %s unexpectedly", nambeg);
55d729e4 613 gv_init(gv, stash, name, len, add & GV_ADDMULTI);
a0d0e21e 614 gv_init_sv(gv, sv_type);
9607fc9c 615 GvFLAGS(gv) |= add_gvflags;
93a17b20
LW
616
617 /* set up magic where warranted */
618 switch (*name) {
a0d0e21e
LW
619 case 'A':
620 if (strEQ(name, "ARGV")) {
621 IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START;
622 }
623 break;
a0d0e21e
LW
624 case 'E':
625 if (strnEQ(name, "EXPORT", 6))
a5f75d66 626 GvMULTI_on(gv);
a0d0e21e 627 break;
463ee0b2
LW
628 case 'I':
629 if (strEQ(name, "ISA")) {
630 AV* av = GvAVn(gv);
a5f75d66 631 GvMULTI_on(gv);
a0d0e21e 632 sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
93965878 633 /* NOTE: No support for tied ISA */
55d729e4
GS
634 if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA")
635 && AvFILLp(av) == -1)
85e6fe83 636 {
a0d0e21e 637 char *pname;
79cb57f6 638 av_push(av, newSVpvn(pname = "NDBM_File",9));
dc437b57 639 gv_stashpvn(pname, 9, TRUE);
79cb57f6 640 av_push(av, newSVpvn(pname = "DB_File",7));
dc437b57 641 gv_stashpvn(pname, 7, TRUE);
79cb57f6 642 av_push(av, newSVpvn(pname = "GDBM_File",9));
dc437b57 643 gv_stashpvn(pname, 9, TRUE);
79cb57f6 644 av_push(av, newSVpvn(pname = "SDBM_File",9));
dc437b57 645 gv_stashpvn(pname, 9, TRUE);
79cb57f6 646 av_push(av, newSVpvn(pname = "ODBM_File",9));
dc437b57 647 gv_stashpvn(pname, 9, TRUE);
85e6fe83 648 }
463ee0b2
LW
649 }
650 break;
a0d0e21e
LW
651 case 'O':
652 if (strEQ(name, "OVERLOAD")) {
653 HV* hv = GvHVn(gv);
a5f75d66 654 GvMULTI_on(gv);
ea0efc06 655 hv_magic(hv, gv, 'A');
a0d0e21e
LW
656 }
657 break;
93a17b20
LW
658 case 'S':
659 if (strEQ(name, "SIG")) {
660 HV *hv;
dc437b57 661 I32 i;
3280af22
NIS
662 PL_siggv = gv;
663 GvMULTI_on(PL_siggv);
664 hv = GvHVn(PL_siggv);
665 hv_magic(hv, PL_siggv, 'S');
22c35a8c 666 for(i=1;PL_sig_name[i];i++) {
dc437b57 667 SV ** init;
22c35a8c 668 init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1);
dc437b57 669 if(init)
3280af22 670 sv_setsv(*init,&PL_sv_undef);
22c35a8c
GS
671 PL_psig_ptr[i] = 0;
672 PL_psig_name[i] = 0;
dc437b57 673 }
93a17b20
LW
674 }
675 break;
676
677 case '&':
463ee0b2
LW
678 if (len > 1)
679 break;
3280af22
NIS
680 PL_ampergv = gv;
681 PL_sawampersand = TRUE;
a0d0e21e 682 goto ro_magicalize;
93a17b20
LW
683
684 case '`':
463ee0b2
LW
685 if (len > 1)
686 break;
3280af22
NIS
687 PL_leftgv = gv;
688 PL_sawampersand = TRUE;
a0d0e21e 689 goto ro_magicalize;
93a17b20
LW
690
691 case '\'':
463ee0b2
LW
692 if (len > 1)
693 break;
3280af22
NIS
694 PL_rightgv = gv;
695 PL_sawampersand = TRUE;
a0d0e21e 696 goto ro_magicalize;
93a17b20
LW
697
698 case ':':
463ee0b2
LW
699 if (len > 1)
700 break;
3280af22 701 sv_setpv(GvSV(gv),PL_chopset);
93a17b20
LW
702 goto magicalize;
703
ff0cee69
PP
704 case '?':
705 if (len > 1)
706 break;
707#ifdef COMPLEX_STATUS
07f14f54 708 (void)SvUPGRADE(GvSV(gv), SVt_PVLV);
ff0cee69
PP
709#endif
710 goto magicalize;
711
067391ea 712 case '!':
4318d5a0 713 if (len > 1)
067391ea 714 break;
3280af22 715 if (sv_type > SVt_PV && PL_curcop != &PL_compiling) {
067391ea
GS
716 HV* stash = gv_stashpvn("Errno",5,FALSE);
717 if(!stash || !(gv_fetchmethod(stash, "TIEHASH"))) {
718 dSP;
719 PUTBACK;
720 perl_require_pv("Errno.pm");
721 SPAGAIN;
722 stash = gv_stashpvn("Errno",5,FALSE);
723 if (!stash || !(gv_fetchmethod(stash, "TIEHASH")))
1d2dff63 724 croak("Can't use %%! because Errno.pm is not available");
067391ea
GS
725 }
726 }
727 goto magicalize;
6cef1e77
IZ
728 case '-':
729 if (len > 1)
730 break;
731 else {
732 AV* av = GvAVn(gv);
733 sv_magic((SV*)av, Nullsv, 'D', Nullch, 0);
734 }
735 goto magicalize;
93a17b20 736 case '#':
a0d0e21e 737 case '*':
599cee73
PM
738 if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV)
739 warner(WARN_DEPRECATED, "Use of $%s is deprecated", name);
a0d0e21e
LW
740 /* FALL THROUGH */
741 case '[':
93a17b20
LW
742 case '^':
743 case '~':
744 case '=':
93a17b20
LW
745 case '%':
746 case '.':
93a17b20
LW
747 case '(':
748 case ')':
749 case '<':
750 case '>':
751 case ',':
752 case '\\':
753 case '/':
93a17b20 754 case '|':
748a9306 755 case '\001':
599cee73 756 case '\002':
49460fe6 757 case '\003':
93a17b20 758 case '\004':
ad8898e0 759 case '\005':
748a9306 760 case '\006':
a0d0e21e 761 case '\010':
9d116dd7 762 case '\011': /* NOT \t in EBCDIC */
ad8898e0 763 case '\017':
93a17b20
LW
764 case '\020':
765 case '\024':
766 case '\027':
463ee0b2
LW
767 if (len > 1)
768 break;
769 goto magicalize;
6cef1e77
IZ
770 case '\023':
771 if (len > 1)
772 break;
773 goto ro_magicalize;
463ee0b2 774
a0d0e21e 775 case '+':
6cef1e77
IZ
776 if (len > 1)
777 break;
778 else {
779 AV* av = GvAVn(gv);
780 sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0);
781 }
782 /* FALL THROUGH */
463ee0b2
LW
783 case '1':
784 case '2':
785 case '3':
786 case '4':
787 case '5':
788 case '6':
789 case '7':
790 case '8':
791 case '9':
a0d0e21e
LW
792 ro_magicalize:
793 SvREADONLY_on(GvSV(gv));
93a17b20 794 magicalize:
463ee0b2 795 sv_magic(GvSV(gv), (SV*)gv, 0, name, len);
93a17b20
LW
796 break;
797
798 case '\014':
463ee0b2
LW
799 if (len > 1)
800 break;
93a17b20 801 sv_setpv(GvSV(gv),"\f");
3280af22 802 PL_formfeed = GvSV(gv);
93a17b20
LW
803 break;
804 case ';':
463ee0b2
LW
805 if (len > 1)
806 break;
93a17b20
LW
807 sv_setpv(GvSV(gv),"\034");
808 break;
463ee0b2
LW
809 case ']':
810 if (len == 1) {
f86702cc 811 SV *sv = GvSV(gv);
07f14f54 812 (void)SvUPGRADE(sv, SVt_PVNV);
3280af22 813 sv_setpv(sv, PL_patchlevel);
f86702cc
PP
814 (void)sv_2nv(sv);
815 SvREADONLY_on(sv);
93a17b20
LW
816 }
817 break;
79072805 818 }
93a17b20 819 return gv;
79072805
LW
820}
821
822void
08105a92 823gv_fullname3(SV *sv, GV *gv, const char *prefix)
79072805
LW
824{
825 HV *hv = GvSTASH(gv);
f967eb5f
PP
826 if (!hv) {
827 SvOK_off(sv);
79072805 828 return;
f967eb5f
PP
829 }
830 sv_setpv(sv, prefix ? prefix : "");
79072805 831 sv_catpv(sv,HvNAME(hv));
463ee0b2 832 sv_catpvn(sv,"::", 2);
79072805
LW
833 sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv));
834}
835
836void
08105a92 837gv_efullname3(SV *sv, GV *gv, const char *prefix)
79072805 838{
f967eb5f 839 GV *egv = GvEGV(gv);
748a9306
LW
840 if (!egv)
841 egv = gv;
f6aff53a
PP
842 gv_fullname3(sv, egv, prefix);
843}
844
845/* XXX compatibility with versions <= 5.003. */
846void
8ac85365 847gv_fullname(SV *sv, GV *gv)
f6aff53a
PP
848{
849 gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : "");
850}
851
852/* XXX compatibility with versions <= 5.003. */
853void
8ac85365 854gv_efullname(SV *sv, GV *gv)
f6aff53a
PP
855{
856 gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : "");
79072805
LW
857}
858
859IO *
8ac85365 860newIO(void)
79072805 861{
11343788 862 dTHR;
79072805 863 IO *io;
8990e307
LW
864 GV *iogv;
865
866 io = (IO*)NEWSV(0,0);
a0d0e21e 867 sv_upgrade((SV *)io,SVt_PVIO);
8990e307
LW
868 SvREFCNT(io) = 1;
869 SvOBJECT_on(io);
c9de509e 870 iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV);
5f2d631d
GS
871 /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
872 if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
c9de509e 873 iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
8990e307 874 SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
79072805
LW
875 return io;
876}
877
878void
8ac85365 879gv_check(HV *stash)
79072805 880{
11343788 881 dTHR;
79072805
LW
882 register HE *entry;
883 register I32 i;
884 register GV *gv;
463ee0b2 885 HV *hv;
a0d0e21e 886 GV *filegv;
463ee0b2 887
8990e307
LW
888 if (!HvARRAY(stash))
889 return;
a0d0e21e 890 for (i = 0; i <= (I32) HvMAX(stash); i++) {
dc437b57
PP
891 for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
892 if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
893 (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
a0d0e21e 894 {
19b6c847 895 if (hv != PL_defstash && hv != stash)
a0d0e21e
LW
896 gv_check(hv); /* nested package */
897 }
dc437b57
PP
898 else if (isALPHA(*HeKEY(entry))) {
899 gv = (GV*)HeVAL(entry);
55d729e4 900 if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv))
463ee0b2 901 continue;
3280af22 902 PL_curcop->cop_line = GvLINE(gv);
a0d0e21e 903 filegv = GvFILEGV(gv);
3280af22 904 PL_curcop->cop_filegv = filegv;
a5f75d66 905 if (filegv && GvMULTI(filegv)) /* Filename began with slash */
8990e307 906 continue;
599cee73
PM
907 warner(WARN_ONCE,
908 "Name \"%s::%s\" used only once: possible typo",
a0d0e21e 909 HvNAME(stash), GvNAME(gv));
463ee0b2 910 }
79072805
LW
911 }
912 }
913}
914
915GV *
8ac85365 916newGVgen(char *pack)
79072805 917{
3280af22 918 return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)PL_gensym++),
46fc3d4c 919 TRUE, SVt_PVGV);
79072805
LW
920}
921
922/* hopefully this is only called on local symbol table entries */
923
924GP*
8ac85365 925gp_ref(GP *gp)
79072805
LW
926{
927 gp->gp_refcnt++;
44a8e56a
PP
928 if (gp->gp_cv) {
929 if (gp->gp_cvgen) {
930 /* multi-named GPs cannot be used for method cache */
931 SvREFCNT_dec(gp->gp_cv);
932 gp->gp_cv = Nullcv;
933 gp->gp_cvgen = 0;
934 }
935 else {
936 /* Adding a new name to a subroutine invalidates method cache */
3280af22 937 PL_sub_generation++;
44a8e56a
PP
938 }
939 }
79072805 940 return gp;
79072805
LW
941}
942
943void
8ac85365 944gp_free(GV *gv)
79072805 945{
79072805 946 GP* gp;
377b8fbc 947 CV* cv;
79072805
LW
948
949 if (!gv || !(gp = GvGP(gv)))
950 return;
951 if (gp->gp_refcnt == 0) {
952 warn("Attempt to free unreferenced glob pointers");
953 return;
954 }
44a8e56a
PP
955 if (gp->gp_cv) {
956 /* Deleting the name of a subroutine invalidates method cache */
3280af22 957 PL_sub_generation++;
44a8e56a 958 }
748a9306
LW
959 if (--gp->gp_refcnt > 0) {
960 if (gp->gp_egv == gv)
961 gp->gp_egv = 0;
79072805 962 return;
748a9306 963 }
79072805 964
8990e307
LW
965 SvREFCNT_dec(gp->gp_sv);
966 SvREFCNT_dec(gp->gp_av);
967 SvREFCNT_dec(gp->gp_hv);
377b8fbc 968 SvREFCNT_dec(gp->gp_io);
a6006777 969 SvREFCNT_dec(gp->gp_cv);
748a9306
LW
970 SvREFCNT_dec(gp->gp_form);
971
79072805
LW
972 Safefree(gp);
973 GvGP(gv) = 0;
974}
975
976#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286))
977#define MICROPORT
978#endif
979
980#ifdef MICROPORT /* Microport 2.4 hack */
981AV *GvAVn(gv)
982register GV *gv;
983{
984 if (GvGP(gv)->gp_av)
985 return GvGP(gv)->gp_av;
986 else
987 return GvGP(gv_AVadd(gv))->gp_av;
988}
989
990HV *GvHVn(gv)
991register GV *gv;
992{
993 if (GvGP(gv)->gp_hv)
994 return GvGP(gv)->gp_hv;
995 else
996 return GvGP(gv_HVadd(gv))->gp_hv;
997}
998#endif /* Microport 2.4 hack */
a0d0e21e 999
a0d0e21e
LW
1000/* Updates and caches the CV's */
1001
1002bool
8ac85365 1003Gv_AMupdate(HV *stash)
a0d0e21e 1004{
11343788 1005 dTHR;
a0d0e21e
LW
1006 GV** gvp;
1007 HV* hv;
1008 GV* gv;
1009 CV* cv;
1010 MAGIC* mg=mg_find((SV*)stash,'c');
8ac85365 1011 AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
a6006777 1012 AMT amt;
2d8e6c8d 1013 STRLEN n_a;
a0d0e21e 1014
3280af22
NIS
1015 if (mg && amtp->was_ok_am == PL_amagic_generation
1016 && amtp->was_ok_sub == PL_sub_generation)
a6006777
PP
1017 return AMT_AMAGIC(amtp);
1018 if (amtp && AMT_AMAGIC(amtp)) { /* Have table. */
748a9306 1019 int i;
a6006777 1020 for (i=1; i<NofAMmeth; i++) {
748a9306
LW
1021 if (amtp->table[i]) {
1022 SvREFCNT_dec(amtp->table[i]);
1023 }
1024 }
1025 }
a0d0e21e
LW
1026 sv_unmagic((SV*)stash, 'c');
1027
1028 DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) );
1029
3280af22
NIS
1030 amt.was_ok_am = PL_amagic_generation;
1031 amt.was_ok_sub = PL_sub_generation;
a6006777
PP
1032 amt.fallback = AMGfallNO;
1033 amt.flags = 0;
1034
1035#ifdef OVERLOAD_VIA_HASH
1036 gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE); /* A shortcut */
3280af22 1037 if (gvp && ((gv = *gvp) != (GV*)&PL_sv_undef && (hv = GvHV(gv)))) {
a0d0e21e
LW
1038 int filled=0;
1039 int i;
1040 char *cp;
a0d0e21e
LW
1041 SV* sv;
1042 SV** svp;
a0d0e21e 1043
22c35a8c 1044 /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
a0d0e21e 1045
22c35a8c 1046 if (( cp = (char *)PL_AMG_names[0] ) &&
a6006777 1047 (svp = (SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) {
a0d0e21e
LW
1048 if (SvTRUE(sv)) amt.fallback=AMGfallYES;
1049 else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
1050 }
a6006777
PP
1051 for (i = 1; i < NofAMmeth; i++) {
1052 cv = 0;
22c35a8c 1053 cp = (char *)PL_AMG_names[i];
a6006777
PP
1054
1055 svp = (SV**)hv_fetch(hv, cp, strlen(cp), FALSE);
3280af22 1056 if (svp && ((sv = *svp) != &PL_sv_undef)) {
a0d0e21e
LW
1057 switch (SvTYPE(sv)) {
1058 default:
1059 if (!SvROK(sv)) {
1060 if (!SvOK(sv)) break;
2d8e6c8d 1061 gv = gv_fetchmethod(stash, SvPV(sv, n_a));
a0d0e21e
LW
1062 if (gv) cv = GvCV(gv);
1063 break;
1064 }
1065 cv = (CV*)SvRV(sv);
1066 if (SvTYPE(cv) == SVt_PVCV)
1067 break;
1068 /* FALL THROUGH */
1069 case SVt_PVHV:
1070 case SVt_PVAV:
a6006777 1071 croak("Not a subroutine reference in overload table");
a0d0e21e
LW
1072 return FALSE;
1073 case SVt_PVCV:
8ebc5c01
PP
1074 cv = (CV*)sv;
1075 break;
a0d0e21e 1076 case SVt_PVGV:
8ebc5c01 1077 if (!(cv = GvCVu((GV*)sv)))
f6ec51f7 1078 cv = sv_2cv(sv, &stash, &gv, FALSE);
8ebc5c01 1079 break;
a0d0e21e
LW
1080 }
1081 if (cv) filled=1;
1082 else {
a6006777 1083 croak("Method for operation %s not found in package %.256s during blessing\n",
a0d0e21e
LW
1084 cp,HvNAME(stash));
1085 return FALSE;
1086 }
1087 }
a6006777
PP
1088#else
1089 {
1090 int filled = 0;
1091 int i;
9607fc9c 1092 const char *cp;
a6006777
PP
1093 SV* sv = NULL;
1094 SV** svp;
1095
22c35a8c 1096 /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
a6006777 1097
22c35a8c 1098 if ( cp = PL_AMG_names[0] ) {
a6006777 1099 /* Try to find via inheritance. */
774d564b 1100 gv = gv_fetchmeth(stash, "()", 2, -1); /* A cookie: "()". */
a6006777
PP
1101 if (gv) sv = GvSV(gv);
1102
774d564b 1103 if (!gv) goto no_table;
a6006777
PP
1104 else if (SvTRUE(sv)) amt.fallback=AMGfallYES;
1105 else if (SvOK(sv)) amt.fallback=AMGfallNEVER;
1106 }
1107
1108 for (i = 1; i < NofAMmeth; i++) {
22c35a8c 1109 SV *cookie = sv_2mortal(newSVpvf("(%s", cp = PL_AMG_names[i]));
44a8e56a
PP
1110 DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
1111 cp, HvNAME(stash)) );
46fc3d4c
PP
1112 /* don't fill the cache while looking up! */
1113 gv = gv_fetchmeth(stash, SvPVX(cookie), SvCUR(cookie), -1);
1114 cv = 0;
44a8e56a 1115 if(gv && (cv = GvCV(gv))) {
44a8e56a
PP
1116 if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
1117 && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
1118 /* GvSV contains the name of the method. */
1119 GV *ngv;
1120
1121 DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
2d8e6c8d 1122 SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
dc848c6f
PP
1123 if (!SvPOK(GvSV(gv))
1124 || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
1125 FALSE)))
1126 {
44a8e56a
PP
1127 /* Can be an import stub (created by `can'). */
1128 if (GvCVGEN(gv)) {
1129 croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'",
1130 (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ),
1131 cp, HvNAME(stash));
1132 } else
3f4520fe 1133 croak("Can't resolve method `%.256s' overloading `%s' in package `%.256s'",
44a8e56a
PP
1134 (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ),
1135 cp, HvNAME(stash));
1136 }
dc848c6f 1137 cv = GvCV(gv = ngv);
44a8e56a
PP
1138 }
1139 DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
1140 cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
1141 GvNAME(CvGV(cv))) );
1142 filled = 1;
1143 }
a6006777
PP
1144#endif
1145 amt.table[i]=(CV*)SvREFCNT_inc(cv);
a0d0e21e 1146 }
a0d0e21e 1147 if (filled) {
a6006777
PP
1148 AMT_AMAGIC_on(&amt);
1149 sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT));
a0d0e21e
LW
1150 return TRUE;
1151 }
1152 }
a6006777 1153 /* Here we have no table: */
774d564b 1154 no_table:
a6006777
PP
1155 AMT_AMAGIC_off(&amt);
1156 sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
a0d0e21e
LW
1157 return FALSE;
1158}
1159
a0d0e21e 1160SV*
8ac85365 1161amagic_call(SV *left, SV *right, int method, int flags)
a0d0e21e 1162{
11343788 1163 dTHR;
a0d0e21e
LW
1164 MAGIC *mg;
1165 CV *cv;
1166 CV **cvp=NULL, **ocvp=NULL;
1167 AMT *amtp, *oamtp;
1168 int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
ee239bfe 1169 int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
a0d0e21e
LW
1170 HV* stash;
1171 if (!(AMGf_noleft & flags) && SvAMAGIC(left)
1172 && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
a6006777
PP
1173 && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
1174 ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
8ac85365 1175 : (CV **) NULL))
748a9306
LW
1176 && ((cv = cvp[off=method+assignshift])
1177 || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
1178 * usual method */
1179 (fl = 1, cv = cvp[off=method])))) {
a0d0e21e
LW
1180 lr = -1; /* Call method for left argument */
1181 } else {
1182 if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
1183 int logic;
1184
1185 /* look for substituted methods */
ee239bfe 1186 /* In all the covered cases we should be called with assign==0. */
a0d0e21e
LW
1187 switch (method) {
1188 case inc_amg:
ee239bfe
IZ
1189 force_cpy = 1;
1190 if ((cv = cvp[off=add_ass_amg])
1191 || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) {
3280af22 1192 right = &PL_sv_yes; lr = -1; assign = 1;
a0d0e21e
LW
1193 }
1194 break;
1195 case dec_amg:
ee239bfe
IZ
1196 force_cpy = 1;
1197 if ((cv = cvp[off = subtr_ass_amg])
1198 || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) {
3280af22 1199 right = &PL_sv_yes; lr = -1; assign = 1;
a0d0e21e
LW
1200 }
1201 break;
1202 case bool__amg:
1203 (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg]));
1204 break;
1205 case numer_amg:
1206 (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg]));
1207 break;
1208 case string_amg:
1209 (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
1210 break;
dc437b57
PP
1211 case not_amg:
1212 (void)((cv = cvp[off=bool__amg])
1213 || (cv = cvp[off=numer_amg])
1214 || (cv = cvp[off=string_amg]));
1215 postpr = 1;
1216 break;
748a9306
LW
1217 case copy_amg:
1218 {
76e3520e
GS
1219 /*
1220 * SV* ref causes confusion with the interpreter variable of
1221 * the same name
1222 */
1223 SV* tmpRef=SvRV(left);
1224 if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) {
fc36a67e
PP
1225 /*
1226 * Just to be extra cautious. Maybe in some
1227 * additional cases sv_setsv is safe, too.
1228 */
76e3520e 1229 SV* newref = newSVsv(tmpRef);
748a9306 1230 SvOBJECT_on(newref);
76e3520e 1231 SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(tmpRef));
748a9306
LW
1232 return newref;
1233 }
1234 }
1235 break;
a0d0e21e 1236 case abs_amg:
748a9306 1237 if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg])
a0d0e21e 1238 && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
748a9306 1239 SV* nullsv=sv_2mortal(newSViv(0));
a0d0e21e 1240 if (off1==lt_amg) {
748a9306 1241 SV* lessp = amagic_call(left,nullsv,
a0d0e21e
LW
1242 lt_amg,AMGf_noright);
1243 logic = SvTRUE(lessp);
1244 } else {
748a9306 1245 SV* lessp = amagic_call(left,nullsv,
a0d0e21e
LW
1246 ncmp_amg,AMGf_noright);
1247 logic = (SvNV(lessp) < 0);
1248 }
1249 if (logic) {
1250 if (off==subtr_amg) {
1251 right = left;
748a9306 1252 left = nullsv;
a0d0e21e
LW
1253 lr = 1;
1254 }
1255 } else {
1256 return left;
1257 }
1258 }
1259 break;
1260 case neg_amg:
1261 if (cv = cvp[off=subtr_amg]) {
1262 right = left;
1263 left = sv_2mortal(newSViv(0));
1264 lr = 1;
1265 }
1266 break;
f5284f61
IZ
1267 case iter_amg: /* XXXX Eventually should do to_gv. */
1268 case to_sv_amg:
1269 case to_av_amg:
1270 case to_hv_amg:
1271 case to_gv_amg:
1272 case to_cv_amg:
1273 /* FAIL safe */
1274 return NULL; /* Delegate operation to standard mechanisms. */
1275 break;
a0d0e21e
LW
1276 default:
1277 goto not_found;
1278 }
1279 if (!cv) goto not_found;
1280 } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
1281 && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c'))
a6006777
PP
1282 && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
1283 ? (amtp = (AMT*)mg->mg_ptr)->table
8ac85365 1284 : (CV **) NULL))
a0d0e21e
LW
1285 && (cv = cvp[off=method])) { /* Method for right
1286 * argument found */
1287 lr=1;
748a9306 1288 } else if (((ocvp && oamtp->fallback > AMGfallNEVER
4633a7c4 1289 && (cvp=ocvp) && (lr = -1))
a0d0e21e
LW
1290 || (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
1291 && !(flags & AMGf_unary)) {
1292 /* We look for substitution for
1293 * comparison operations and
fc36a67e 1294 * concatenation */
a0d0e21e
LW
1295 if (method==concat_amg || method==concat_ass_amg
1296 || method==repeat_amg || method==repeat_ass_amg) {
1297 return NULL; /* Delegate operation to string conversion */
1298 }
1299 off = -1;
1300 switch (method) {
1301 case lt_amg:
1302 case le_amg:
1303 case gt_amg:
1304 case ge_amg:
1305 case eq_amg:
1306 case ne_amg:
1307 postpr = 1; off=ncmp_amg; break;
1308 case slt_amg:
1309 case sle_amg:
1310 case sgt_amg:
1311 case sge_amg:
1312 case seq_amg:
1313 case sne_amg:
1314 postpr = 1; off=scmp_amg; break;
1315 }
1316 if (off != -1) cv = cvp[off];
1317 if (!cv) {
1318 goto not_found;
1319 }
1320 } else {
a6006777 1321 not_found: /* No method found, either report or croak */
a0d0e21e
LW
1322 if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */
1323 notfound = 1; lr = -1;
1324 } else if (cvp && (cv=cvp[nomethod_amg])) {
1325 notfound = 1; lr = 1;
1326 } else {
46fc3d4c 1327 SV *msg;
774d564b 1328 if (off==-1) off=method;
46fc3d4c
PP
1329 msg = sv_2mortal(newSVpvf(
1330 "Operation `%s': no method found,%sargument %s%s%s%s",
22c35a8c 1331 PL_AMG_names[method + assignshift],
e7ea3e70 1332 (flags & AMGf_unary ? " " : "\n\tleft "),
a0d0e21e
LW
1333 SvAMAGIC(left)?
1334 "in overloaded package ":
1335 "has no overloaded magic",
1336 SvAMAGIC(left)?
1337 HvNAME(SvSTASH(SvRV(left))):
1338 "",
1339 SvAMAGIC(right)?
e7ea3e70
IZ
1340 ",\n\tright argument in overloaded package ":
1341 (flags & AMGf_unary
1342 ? ""
1343 : ",\n\tright argument has no overloaded magic"),
a0d0e21e
LW
1344 SvAMAGIC(right)?
1345 HvNAME(SvSTASH(SvRV(right))):
46fc3d4c 1346 ""));
a0d0e21e 1347 if (amtp && amtp->fallback >= AMGfallYES) {
46fc3d4c 1348 DEBUG_o( deb("%s", SvPVX(msg)) );
a0d0e21e 1349 } else {
fc36a67e 1350 croak("%_", msg);
a0d0e21e
LW
1351 }
1352 return NULL;
1353 }
ee239bfe 1354 force_cpy = force_cpy || assign;
a0d0e21e
LW
1355 }
1356 }
1357 if (!notfound) {
774d564b 1358 DEBUG_o( deb(
46fc3d4c 1359 "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
22c35a8c 1360 PL_AMG_names[off],
748a9306
LW
1361 method+assignshift==off? "" :
1362 " (initially `",
1363 method+assignshift==off? "" :
22c35a8c 1364 PL_AMG_names[method+assignshift],
748a9306
LW
1365 method+assignshift==off? "" : "')",
1366 flags & AMGf_unary? "" :
1367 lr==1 ? " for right argument": " for left argument",
1368 flags & AMGf_unary? " for argument" : "",
a0d0e21e
LW
1369 HvNAME(stash),
1370 fl? ",\n\tassignment variant used": "") );
ee239bfe 1371 }
748a9306
LW
1372 /* Since we use shallow copy during assignment, we need
1373 * to dublicate the contents, probably calling user-supplied
1374 * version of copy operator
1375 */
ee239bfe
IZ
1376 /* We need to copy in following cases:
1377 * a) Assignment form was called.
1378 * assignshift==1, assign==T, method + 1 == off
1379 * b) Increment or decrement, called directly.
1380 * assignshift==0, assign==0, method + 0 == off
1381 * c) Increment or decrement, translated to assignment add/subtr.
1382 * assignshift==0, assign==T,
1383 * force_cpy == T
1384 * d) Increment or decrement, translated to nomethod.
1385 * assignshift==0, assign==0,
1386 * force_cpy == T
1387 * e) Assignment form translated to nomethod.
1388 * assignshift==1, assign==T, method + 1 != off
1389 * force_cpy == T
1390 */
1391 /* off is method, method+assignshift, or a result of opcode substitution.
1392 * In the latter case assignshift==0, so only notfound case is important.
1393 */
1394 if (( (method + assignshift == off)
1395 && (assign || (method == inc_amg) || (method == dec_amg)))
1396 || force_cpy)
1397 RvDEEPCP(left);
a0d0e21e
LW
1398 {
1399 dSP;
1400 BINOP myop;
1401 SV* res;
54310121 1402 bool oldcatch = CATCH_GET;
a0d0e21e 1403
54310121 1404 CATCH_SET(TRUE);
a0d0e21e
LW
1405 Zero(&myop, 1, BINOP);
1406 myop.op_last = (OP *) &myop;
1407 myop.op_next = Nullop;
54310121 1408 myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
a0d0e21e 1409
e788e7d3 1410 PUSHSTACKi(PERLSI_OVERLOAD);
a0d0e21e 1411 ENTER;
462e5cf6 1412 SAVEOP();
533c011a 1413 PL_op = (OP *) &myop;
3280af22 1414 if (PERLDB_SUB && PL_curstash != PL_debstash)
533c011a 1415 PL_op->op_private |= OPpENTERSUB_DB;
a0d0e21e 1416 PUTBACK;
11343788 1417 pp_pushmark(ARGS);
a0d0e21e 1418
924508f0 1419 EXTEND(SP, notfound + 5);
a0d0e21e
LW
1420 PUSHs(lr>0? right: left);
1421 PUSHs(lr>0? left: right);
3280af22 1422 PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no ));
a0d0e21e 1423 if (notfound) {
22c35a8c 1424 PUSHs( sv_2mortal(newSVpv((char *)PL_AMG_names[method + assignshift],0)));
a0d0e21e
LW
1425 }
1426 PUSHs((SV*)cv);
1427 PUTBACK;
1428
533c011a 1429 if (PL_op = pp_entersub(ARGS))
76e3520e 1430 CALLRUNOPS();
a0d0e21e
LW
1431 LEAVE;
1432 SPAGAIN;
1433
1434 res=POPs;
ebafeae7 1435 PUTBACK;
d3acc0f7 1436 POPSTACK;
54310121 1437 CATCH_SET(oldcatch);
a0d0e21e 1438
a0d0e21e
LW
1439 if (postpr) {
1440 int ans;
1441 switch (method) {
1442 case le_amg:
1443 case sle_amg:
1444 ans=SvIV(res)<=0; break;
1445 case lt_amg:
1446 case slt_amg:
1447 ans=SvIV(res)<0; break;
1448 case ge_amg:
1449 case sge_amg:
1450 ans=SvIV(res)>=0; break;
1451 case gt_amg:
1452 case sgt_amg:
1453 ans=SvIV(res)>0; break;
1454 case eq_amg:
1455 case seq_amg:
1456 ans=SvIV(res)==0; break;
1457 case ne_amg:
1458 case sne_amg:
1459 ans=SvIV(res)!=0; break;
1460 case inc_amg:
1461 case dec_amg:
bbce6d69 1462 SvSetSV(left,res); return left;
dc437b57 1463 case not_amg:
44a8e56a 1464 ans=!SvOK(res); break;
a0d0e21e 1465 }
54310121 1466 return boolSV(ans);
748a9306
LW
1467 } else if (method==copy_amg) {
1468 if (!SvROK(res)) {
a6006777 1469 croak("Copy method did not return a reference");
748a9306
LW
1470 }
1471 return SvREFCNT_inc(SvRV(res));
a0d0e21e
LW
1472 } else {
1473 return res;
1474 }
1475 }
1476}