Commit | Line | Data |
---|---|---|
79072805 LW |
1 | /* $RCSfile: gv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:39 $ |
2 | * | |
3 | * Copyright (c) 1991, Larry Wall | |
4 | * | |
5 | * You may distribute under the terms of either the GNU General Public | |
6 | * License or the Artistic License, as specified in the README file. | |
7 | * | |
8 | * $Log: gv.c,v $ | |
9 | * Revision 4.1 92/08/07 18:26:39 lwall | |
10 | * | |
11 | * Revision 4.0.1.4 92/06/08 15:32:19 lwall | |
12 | * patch20: fixed confusion between a *var's real name and its effective name | |
13 | * patch20: the debugger now warns you on lines that can't set a breakpoint | |
14 | * patch20: the debugger made perl forget the last pattern used by // | |
15 | * patch20: paragraph mode now skips extra newlines automatically | |
16 | * patch20: ($<,$>) = ... didn't work on some architectures | |
17 | * | |
18 | * Revision 4.0.1.3 91/11/05 18:35:33 lwall | |
19 | * patch11: length($x) was sometimes wrong for numeric $x | |
20 | * patch11: perl now issues warning if $SIG{'ALARM'} is referenced | |
21 | * patch11: *foo = undef coredumped | |
22 | * patch11: solitary subroutine references no longer trigger typo warnings | |
23 | * patch11: local(*FILEHANDLE) had a memory leak | |
24 | * | |
25 | * Revision 4.0.1.2 91/06/07 11:55:53 lwall | |
26 | * patch4: new copyright notice | |
27 | * patch4: added $^P variable to control calling of perldb routines | |
28 | * patch4: added $^F variable to specify maximum system fd, default 2 | |
29 | * patch4: $` was busted inside s/// | |
30 | * patch4: default top-of-form run_format is now FILEHANDLE_TOP | |
31 | * patch4: length($`), length($&), length($') now optimized to avoid string copy | |
32 | * patch4: $^D |= 1024 now does syntax tree dump at run-time | |
33 | * | |
34 | * Revision 4.0.1.1 91/04/12 09:10:24 lwall | |
35 | * patch1: Configure now differentiates getgroups() type from getgid() type | |
36 | * patch1: you may now use "die" and "caller" in a signal handler | |
37 | * | |
38 | * Revision 4.0 91/03/20 01:39:41 lwall | |
39 | * 4.0 baseline. | |
40 | * | |
41 | */ | |
42 | ||
43 | #include "EXTERN.h" | |
44 | #include "perl.h" | |
45 | ||
463ee0b2 | 46 | extern char rcsid[]; |
93a17b20 | 47 | |
79072805 LW |
48 | GV * |
49 | gv_AVadd(gv) | |
50 | register GV *gv; | |
51 | { | |
52 | if (!GvAV(gv)) | |
53 | GvAV(gv) = newAV(); | |
54 | return gv; | |
55 | } | |
56 | ||
57 | GV * | |
58 | gv_HVadd(gv) | |
59 | register GV *gv; | |
60 | { | |
61 | if (!GvHV(gv)) | |
463ee0b2 | 62 | GvHV(gv) = newHV(); |
79072805 LW |
63 | return gv; |
64 | } | |
65 | ||
66 | GV * | |
67 | gv_fetchfile(name) | |
68 | char *name; | |
69 | { | |
70 | char tmpbuf[1200]; | |
71 | GV *gv; | |
72 | ||
8990e307 | 73 | sprintf(tmpbuf,"::_<%s", name); |
85e6fe83 | 74 | gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV); |
79072805 | 75 | sv_setpv(GvSV(gv), name); |
8990e307 LW |
76 | if (*name == '/') |
77 | SvMULTI_on(gv); | |
79072805 | 78 | if (perldb) |
93a17b20 | 79 | hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); |
79072805 LW |
80 | return gv; |
81 | } | |
82 | ||
463ee0b2 LW |
83 | void |
84 | gv_init(gv, stash, name, len, multi) | |
85 | GV *gv; | |
86 | HV *stash; | |
87 | char *name; | |
88 | STRLEN len; | |
89 | int multi; | |
90 | { | |
91 | register GP *gp; | |
92 | ||
93 | sv_upgrade(gv, SVt_PVGV); | |
94 | if (SvLEN(gv)) | |
95 | Safefree(SvPVX(gv)); | |
96 | Newz(602,gp, 1, GP); | |
8990e307 | 97 | GvGP(gv) = gp_ref(gp); |
463ee0b2 LW |
98 | GvREFCNT(gv) = 1; |
99 | GvSV(gv) = NEWSV(72,0); | |
100 | GvLINE(gv) = curcop->cop_line; | |
8990e307 | 101 | GvFILEGV(gv) = curcop->cop_filegv; |
463ee0b2 LW |
102 | GvEGV(gv) = gv; |
103 | sv_magic((SV*)gv, (SV*)gv, '*', name, len); | |
104 | GvSTASH(gv) = stash; | |
105 | GvNAME(gv) = nsavestr(name, len); | |
106 | GvNAMELEN(gv) = len; | |
107 | if (multi) | |
108 | SvMULTI_on(gv); | |
109 | } | |
110 | ||
79072805 | 111 | GV * |
463ee0b2 | 112 | gv_fetchmeth(stash, name, len) |
79072805 LW |
113 | HV* stash; |
114 | char* name; | |
463ee0b2 | 115 | STRLEN len; |
79072805 LW |
116 | { |
117 | AV* av; | |
463ee0b2 | 118 | GV* topgv; |
79072805 | 119 | GV* gv; |
463ee0b2 LW |
120 | GV** gvp; |
121 | ||
122 | gvp = (GV**)hv_fetch(stash, name, len, TRUE); | |
123 | ||
124 | DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) ); | |
125 | topgv = *gvp; | |
126 | if (SvTYPE(topgv) != SVt_PVGV) | |
127 | gv_init(topgv, stash, name, len, TRUE); | |
128 | ||
129 | if (GvCV(topgv)) { | |
130 | if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation) | |
131 | return topgv; | |
132 | } | |
79072805 LW |
133 | |
134 | gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE); | |
135 | if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { | |
136 | SV** svp = AvARRAY(av); | |
137 | I32 items = AvFILL(av) + 1; | |
138 | while (items--) { | |
79072805 | 139 | SV* sv = *svp++; |
9bbf4081 LW |
140 | HV* basestash = fetch_stash(sv, FALSE); |
141 | if (!basestash) { | |
79072805 LW |
142 | if (dowarn) |
143 | warn("Can't locate package %s for @%s'ISA", | |
463ee0b2 | 144 | SvPVX(sv), HvNAME(stash)); |
79072805 LW |
145 | continue; |
146 | } | |
9bbf4081 | 147 | gv = gv_fetchmeth(basestash, name, len); |
463ee0b2 LW |
148 | if (gv) { |
149 | GvCV(topgv) = GvCV(gv); /* cache the CV */ | |
150 | GvCVGEN(topgv) = sub_generation; /* valid for now */ | |
79072805 | 151 | return gv; |
463ee0b2 | 152 | } |
79072805 LW |
153 | } |
154 | } | |
155 | return 0; | |
156 | } | |
157 | ||
158 | GV * | |
463ee0b2 LW |
159 | gv_fetchmethod(stash, name) |
160 | HV* stash; | |
161 | char* name; | |
162 | { | |
163 | register char *nend; | |
164 | ||
165 | for (nend = name; *nend; nend++) { | |
166 | if (*nend == ':' || *nend == '\'') { | |
85e6fe83 | 167 | return gv_fetchpv(name, FALSE, SVt_PVCV); |
463ee0b2 LW |
168 | } |
169 | } | |
170 | return gv_fetchmeth(stash, name, nend - name); | |
171 | } | |
172 | ||
173 | GV * | |
85e6fe83 | 174 | gv_fetchpv(nambeg,add,svtype) |
463ee0b2 | 175 | char *nambeg; |
79072805 | 176 | I32 add; |
85e6fe83 | 177 | I32 svtype; |
79072805 | 178 | { |
463ee0b2 LW |
179 | register char *name = nambeg; |
180 | register GV *gv = 0; | |
79072805 | 181 | GV**gvp; |
79072805 LW |
182 | I32 len; |
183 | register char *namend; | |
463ee0b2 | 184 | HV *stash = 0; |
79072805 | 185 | bool global = FALSE; |
85e6fe83 | 186 | char *tmpbuf; |
79072805 | 187 | |
79072805 | 188 | for (namend = name; *namend; namend++) { |
463ee0b2 LW |
189 | if ((*namend == '\'' && namend[1]) || |
190 | (*namend == ':' && namend[1] == ':')) | |
191 | { | |
463ee0b2 LW |
192 | if (!stash) |
193 | stash = defstash; | |
194 | ||
85e6fe83 LW |
195 | len = namend - name; |
196 | if (len > 0) { | |
197 | New(601, tmpbuf, len+2, char); | |
198 | *tmpbuf = '_'; | |
199 | Copy(name, tmpbuf+1, len, char); | |
200 | tmpbuf[++len] = '\0'; | |
463ee0b2 | 201 | gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); |
85e6fe83 | 202 | Safefree(tmpbuf); |
463ee0b2 LW |
203 | if (!gvp || *gvp == (GV*)&sv_undef) |
204 | return Nullgv; | |
205 | gv = *gvp; | |
85e6fe83 | 206 | |
463ee0b2 LW |
207 | if (SvTYPE(gv) == SVt_PVGV) |
208 | SvMULTI_on(gv); | |
209 | else | |
210 | gv_init(gv, stash, nambeg, namend - nambeg, (add & 2)); | |
85e6fe83 | 211 | |
463ee0b2 LW |
212 | if (!(stash = GvHV(gv))) |
213 | stash = GvHV(gv) = newHV(); | |
85e6fe83 | 214 | |
463ee0b2 LW |
215 | if (!HvNAME(stash)) |
216 | HvNAME(stash) = nsavestr(nambeg, namend - nambeg); | |
217 | } | |
218 | ||
219 | if (*namend == ':') | |
220 | namend++; | |
221 | namend++; | |
222 | name = namend; | |
223 | if (!*name) | |
224 | return gv ? gv : defgv; | |
79072805 | 225 | } |
79072805 | 226 | } |
463ee0b2 LW |
227 | |
228 | /* No stash in name, so see how we can default */ | |
229 | ||
230 | if (!stash) { | |
231 | if (isIDFIRST(*name)) { | |
232 | if (isUPPER(*name)) { | |
233 | if (*name > 'I') { | |
234 | if (*name == 'S' && ( | |
235 | strEQ(name, "SIG") || | |
236 | strEQ(name, "STDIN") || | |
237 | strEQ(name, "STDOUT") || | |
238 | strEQ(name, "STDERR") )) | |
239 | global = TRUE; | |
240 | } | |
241 | else if (*name > 'E') { | |
242 | if (*name == 'I' && strEQ(name, "INC")) | |
243 | global = TRUE; | |
244 | } | |
245 | else if (*name > 'A') { | |
246 | if (*name == 'E' && strEQ(name, "ENV")) | |
247 | global = TRUE; | |
248 | } | |
249 | else if (*name == 'A' && ( | |
250 | strEQ(name, "ARGV") || | |
251 | strEQ(name, "ARGVOUT") )) | |
252 | global = TRUE; | |
253 | } | |
254 | else if (*name == '_' && !name[1]) | |
255 | global = TRUE; | |
256 | if (global) | |
257 | stash = defstash; | |
85e6fe83 LW |
258 | else if ((COP*)curcop == &compiling) { |
259 | if (!(hints & HINT_STRICT_VARS) || svtype == SVt_PVCV) | |
260 | stash = curstash; | |
261 | } | |
463ee0b2 LW |
262 | else |
263 | stash = curcop->cop_stash; | |
264 | } | |
265 | else | |
266 | stash = defstash; | |
267 | } | |
268 | ||
269 | /* By this point we should have a stash and a name */ | |
270 | ||
93a17b20 | 271 | if (!stash) |
463ee0b2 | 272 | croak("Global symbol \"%s\" requires explicit package name", name); |
79072805 | 273 | len = namend - name; |
463ee0b2 LW |
274 | if (!len) |
275 | len = 1; | |
79072805 LW |
276 | gvp = (GV**)hv_fetch(stash,name,len,add); |
277 | if (!gvp || *gvp == (GV*)&sv_undef) | |
278 | return Nullgv; | |
279 | gv = *gvp; | |
280 | if (SvTYPE(gv) == SVt_PVGV) { | |
281 | SvMULTI_on(gv); | |
282 | return gv; | |
283 | } | |
93a17b20 LW |
284 | |
285 | /* Adding a new symbol */ | |
286 | ||
463ee0b2 | 287 | gv_init(gv, stash, name, len, add & 2); |
93a17b20 LW |
288 | |
289 | /* set up magic where warranted */ | |
290 | switch (*name) { | |
ed6116ce LW |
291 | case 'a': |
292 | case 'b': | |
293 | if (len == 1) | |
294 | SvMULTI_on(gv); | |
295 | break; | |
463ee0b2 LW |
296 | case 'I': |
297 | if (strEQ(name, "ISA")) { | |
298 | AV* av = GvAVn(gv); | |
8990e307 | 299 | SvMULTI_on(gv); |
463ee0b2 | 300 | sv_magic((SV*)av, (SV*)gv, 'I', 0, 0); |
85e6fe83 LW |
301 | if (add & 2 && strEQ(nambeg,"Any_DBM_File::ISA") && AvFILL(av) == -1) |
302 | { | |
303 | av_push(av, newSVpv("NDBM_File",0)); | |
304 | av_push(av, newSVpv("DB_File",0)); | |
305 | av_push(av, newSVpv("GDBM_File",0)); | |
306 | av_push(av, newSVpv("SDBM_File",0)); | |
307 | av_push(av, newSVpv("ODBM_File",0)); | |
308 | } | |
463ee0b2 LW |
309 | } |
310 | break; | |
93a17b20 LW |
311 | case 'S': |
312 | if (strEQ(name, "SIG")) { | |
313 | HV *hv; | |
314 | siggv = gv; | |
315 | SvMULTI_on(siggv); | |
316 | hv = GvHVn(siggv); | |
317 | hv_magic(hv, siggv, 'S'); | |
318 | ||
319 | /* initialize signal stack */ | |
320 | signalstack = newAV(); | |
321 | av_store(signalstack, 32, Nullsv); | |
322 | av_clear(signalstack); | |
323 | AvREAL_off(signalstack); | |
324 | } | |
325 | break; | |
326 | ||
327 | case '&': | |
463ee0b2 LW |
328 | if (len > 1) |
329 | break; | |
93a17b20 LW |
330 | ampergv = gv; |
331 | sawampersand = TRUE; | |
332 | goto magicalize; | |
333 | ||
334 | case '`': | |
463ee0b2 LW |
335 | if (len > 1) |
336 | break; | |
93a17b20 LW |
337 | leftgv = gv; |
338 | sawampersand = TRUE; | |
339 | goto magicalize; | |
340 | ||
341 | case '\'': | |
463ee0b2 LW |
342 | if (len > 1) |
343 | break; | |
93a17b20 LW |
344 | rightgv = gv; |
345 | sawampersand = TRUE; | |
346 | goto magicalize; | |
347 | ||
348 | case ':': | |
463ee0b2 LW |
349 | if (len > 1) |
350 | break; | |
93a17b20 LW |
351 | sv_setpv(GvSV(gv),chopset); |
352 | goto magicalize; | |
353 | ||
354 | case '!': | |
355 | case '#': | |
356 | case '?': | |
357 | case '^': | |
358 | case '~': | |
359 | case '=': | |
360 | case '-': | |
361 | case '%': | |
362 | case '.': | |
363 | case '+': | |
364 | case '*': | |
365 | case '(': | |
366 | case ')': | |
367 | case '<': | |
368 | case '>': | |
369 | case ',': | |
370 | case '\\': | |
371 | case '/': | |
372 | case '[': | |
373 | case '|': | |
374 | case '\004': | |
375 | case '\t': | |
376 | case '\020': | |
377 | case '\024': | |
378 | case '\027': | |
379 | case '\006': | |
463ee0b2 LW |
380 | if (len > 1) |
381 | break; | |
382 | goto magicalize; | |
383 | ||
384 | case '1': | |
385 | case '2': | |
386 | case '3': | |
387 | case '4': | |
388 | case '5': | |
389 | case '6': | |
390 | case '7': | |
391 | case '8': | |
392 | case '9': | |
93a17b20 | 393 | magicalize: |
463ee0b2 | 394 | sv_magic(GvSV(gv), (SV*)gv, 0, name, len); |
93a17b20 LW |
395 | break; |
396 | ||
397 | case '\014': | |
463ee0b2 LW |
398 | if (len > 1) |
399 | break; | |
93a17b20 LW |
400 | sv_setpv(GvSV(gv),"\f"); |
401 | formfeed = GvSV(gv); | |
402 | break; | |
403 | case ';': | |
463ee0b2 LW |
404 | if (len > 1) |
405 | break; | |
93a17b20 LW |
406 | sv_setpv(GvSV(gv),"\034"); |
407 | break; | |
463ee0b2 LW |
408 | case ']': |
409 | if (len == 1) { | |
93a17b20 LW |
410 | SV *sv; |
411 | sv = GvSV(gv); | |
412 | sv_upgrade(sv, SVt_PVNV); | |
413 | sv_setpv(sv,rcsid); | |
463ee0b2 | 414 | SvNVX(sv) = atof(patchlevel); |
93a17b20 LW |
415 | SvNOK_on(sv); |
416 | } | |
417 | break; | |
79072805 | 418 | } |
93a17b20 | 419 | return gv; |
79072805 LW |
420 | } |
421 | ||
422 | void | |
423 | gv_fullname(sv,gv) | |
424 | SV *sv; | |
425 | GV *gv; | |
426 | { | |
427 | HV *hv = GvSTASH(gv); | |
428 | ||
429 | if (!hv) | |
430 | return; | |
431 | sv_setpv(sv, sv == (SV*)gv ? "*" : ""); | |
432 | sv_catpv(sv,HvNAME(hv)); | |
463ee0b2 | 433 | sv_catpvn(sv,"::", 2); |
79072805 LW |
434 | sv_catpvn(sv,GvNAME(gv),GvNAMELEN(gv)); |
435 | } | |
436 | ||
437 | void | |
438 | gv_efullname(sv,gv) | |
439 | SV *sv; | |
440 | GV *gv; | |
441 | { | |
442 | GV* egv = GvEGV(gv); | |
443 | HV *hv = GvSTASH(egv); | |
444 | ||
445 | if (!hv) | |
446 | return; | |
447 | sv_setpv(sv, sv == (SV*)gv ? "*" : ""); | |
448 | sv_catpv(sv,HvNAME(hv)); | |
463ee0b2 | 449 | sv_catpvn(sv,"::", 2); |
79072805 LW |
450 | sv_catpvn(sv,GvNAME(egv),GvNAMELEN(egv)); |
451 | } | |
452 | ||
453 | IO * | |
454 | newIO() | |
455 | { | |
456 | IO *io; | |
8990e307 LW |
457 | GV *iogv; |
458 | ||
459 | io = (IO*)NEWSV(0,0); | |
460 | sv_upgrade(io,SVt_PVIO); | |
461 | SvREFCNT(io) = 1; | |
462 | SvOBJECT_on(io); | |
85e6fe83 | 463 | iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO); |
8990e307 | 464 | SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); |
79072805 LW |
465 | return io; |
466 | } | |
467 | ||
468 | void | |
463ee0b2 LW |
469 | gv_check(stash) |
470 | HV* stash; | |
79072805 LW |
471 | { |
472 | register HE *entry; | |
473 | register I32 i; | |
474 | register GV *gv; | |
463ee0b2 LW |
475 | HV *hv; |
476 | ||
8990e307 LW |
477 | if (!HvARRAY(stash)) |
478 | return; | |
463ee0b2 LW |
479 | for (i = 0; i <= HvMAX(stash); i++) { |
480 | for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { | |
481 | if (isALPHA(*entry->hent_key)) { | |
482 | gv = (GV*)entry->hent_val; | |
483 | if (SvMULTI(gv)) | |
484 | continue; | |
485 | curcop->cop_line = GvLINE(gv); | |
8990e307 LW |
486 | curcop->cop_filegv = GvFILEGV(gv); |
487 | if (SvMULTI(GvFILEGV(gv))) /* Filename began with slash */ | |
488 | continue; | |
2304df62 | 489 | warn("Identifier \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv)); |
463ee0b2 LW |
490 | } |
491 | else if (*entry->hent_key == '_' && | |
492 | (gv = (GV*)entry->hent_val) && | |
493 | (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash) | |
494 | gv_check(hv); /* nested package */ | |
495 | ||
79072805 LW |
496 | } |
497 | } | |
498 | } | |
499 | ||
500 | GV * | |
501 | newGVgen() | |
502 | { | |
503 | (void)sprintf(tokenbuf,"_GEN_%d",gensym++); | |
85e6fe83 | 504 | return gv_fetchpv(tokenbuf,TRUE, SVt_PVGV); |
79072805 LW |
505 | } |
506 | ||
507 | /* hopefully this is only called on local symbol table entries */ | |
508 | ||
509 | GP* | |
510 | gp_ref(gp) | |
511 | GP* gp; | |
512 | { | |
513 | gp->gp_refcnt++; | |
514 | return gp; | |
515 | ||
516 | } | |
517 | ||
518 | void | |
519 | gp_free(gv) | |
520 | GV* gv; | |
521 | { | |
522 | IO *io; | |
523 | CV *cv; | |
524 | GP* gp; | |
525 | ||
526 | if (!gv || !(gp = GvGP(gv))) | |
527 | return; | |
528 | if (gp->gp_refcnt == 0) { | |
529 | warn("Attempt to free unreferenced glob pointers"); | |
530 | return; | |
531 | } | |
532 | if (--gp->gp_refcnt > 0) | |
533 | return; | |
534 | ||
8990e307 LW |
535 | SvREFCNT_dec(gp->gp_sv); |
536 | SvREFCNT_dec(gp->gp_av); | |
537 | SvREFCNT_dec(gp->gp_hv); | |
538 | if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) { | |
79072805 | 539 | do_close(gv,FALSE); |
8990e307 | 540 | SvREFCNT_dec(io); |
79072805 | 541 | } |
8990e307 LW |
542 | if ((cv = gp->gp_cv) && !GvCVGEN(gv)) |
543 | SvREFCNT_dec(cv); | |
79072805 LW |
544 | Safefree(gp); |
545 | GvGP(gv) = 0; | |
546 | } | |
547 | ||
548 | #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) | |
549 | #define MICROPORT | |
550 | #endif | |
551 | ||
552 | #ifdef MICROPORT /* Microport 2.4 hack */ | |
553 | AV *GvAVn(gv) | |
554 | register GV *gv; | |
555 | { | |
556 | if (GvGP(gv)->gp_av) | |
557 | return GvGP(gv)->gp_av; | |
558 | else | |
559 | return GvGP(gv_AVadd(gv))->gp_av; | |
560 | } | |
561 | ||
562 | HV *GvHVn(gv) | |
563 | register GV *gv; | |
564 | { | |
565 | if (GvGP(gv)->gp_hv) | |
566 | return GvGP(gv)->gp_hv; | |
567 | else | |
568 | return GvGP(gv_HVadd(gv))->gp_hv; | |
569 | } | |
570 | #endif /* Microport 2.4 hack */ |