Commit | Line | Data |
79072805 |
1 | /* $RCSfile: sv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:45 $ |
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: sv.c,v $ |
9 | * Revision 4.1 92/08/07 18:26:45 lwall |
10 | * |
11 | * Revision 4.0.1.6 92/06/11 21:14:21 lwall |
12 | * patch34: quotes containing subscripts containing variables didn't parse right |
13 | * |
14 | * Revision 4.0.1.5 92/06/08 15:40:43 lwall |
15 | * patch20: removed implicit int declarations on functions |
16 | * patch20: Perl now distinguishes overlapped copies from non-overlapped |
17 | * patch20: paragraph mode now skips extra newlines automatically |
18 | * patch20: fixed memory leak in doube-quote interpretation |
19 | * patch20: made /\$$foo/ look for literal '$foo' |
20 | * patch20: "$var{$foo'bar}" didn't scan subscript correctly |
21 | * patch20: a splice on non-existent array elements could dump core |
22 | * patch20: running taintperl explicitly now does checks even if $< == $> |
23 | * |
24 | * Revision 4.0.1.4 91/11/05 18:40:51 lwall |
25 | * patch11: $foo .= <BAR> could overrun malloced memory |
26 | * patch11: \$ didn't always make it through double-quoter to regexp routines |
27 | * patch11: prepared for ctype implementations that don't define isascii() |
28 | * |
29 | * Revision 4.0.1.3 91/06/10 01:27:54 lwall |
30 | * patch10: $) and $| incorrectly handled in run-time patterns |
31 | * |
32 | * Revision 4.0.1.2 91/06/07 11:58:13 lwall |
33 | * patch4: new copyright notice |
34 | * patch4: taint check on undefined string could cause core dump |
35 | * |
36 | * Revision 4.0.1.1 91/04/12 09:15:30 lwall |
37 | * patch1: fixed undefined environ problem |
38 | * patch1: substr($ENV{"PATH"},0,0) = "/foo:" didn't modify environment |
39 | * patch1: $foo .= <BAR> could cause core dump for certain lengths of $foo |
40 | * |
41 | * Revision 4.0 91/03/20 01:39:55 lwall |
42 | * 4.0 baseline. |
43 | * |
44 | */ |
45 | |
46 | #include "EXTERN.h" |
47 | #include "perl.h" |
48 | #include "perly.h" |
49 | |
50 | static void ucase(); |
51 | static void lcase(); |
52 | |
53 | bool |
54 | sv_upgrade(sv, mt) |
55 | register SV* sv; |
56 | U32 mt; |
57 | { |
58 | char* pv; |
59 | U32 cur; |
60 | U32 len; |
61 | I32 iv; |
62 | double nv; |
63 | MAGIC* magic; |
64 | HV* stash; |
65 | |
66 | if (SvTYPE(sv) == mt) |
67 | return TRUE; |
68 | |
69 | switch (SvTYPE(sv)) { |
70 | case SVt_NULL: |
71 | pv = 0; |
72 | cur = 0; |
73 | len = 0; |
74 | iv = 0; |
75 | nv = 0.0; |
76 | magic = 0; |
77 | stash = 0; |
78 | break; |
79 | case SVt_REF: |
80 | sv_free((SV*)SvANY(sv)); |
81 | pv = 0; |
82 | cur = 0; |
83 | len = 0; |
84 | iv = SvANYI32(sv); |
85 | nv = (double)SvANYI32(sv); |
86 | SvNOK_only(sv); |
87 | magic = 0; |
88 | stash = 0; |
89 | if (mt == SVt_PV) |
90 | mt = SVt_PVIV; |
91 | break; |
92 | case SVt_IV: |
93 | pv = 0; |
94 | cur = 0; |
95 | len = 0; |
96 | iv = SvIV(sv); |
97 | nv = (double)SvIV(sv); |
98 | del_XIV(SvANY(sv)); |
99 | magic = 0; |
100 | stash = 0; |
101 | if (mt == SVt_PV) |
102 | mt = SVt_PVIV; |
103 | break; |
104 | case SVt_NV: |
105 | pv = 0; |
106 | cur = 0; |
107 | len = 0; |
108 | if (SvIOK(sv)) |
109 | iv = SvIV(sv); |
110 | else |
111 | iv = (I32)SvNV(sv); |
112 | nv = SvNV(sv); |
113 | magic = 0; |
114 | stash = 0; |
115 | del_XNV(SvANY(sv)); |
116 | SvANY(sv) = 0; |
117 | if (mt == SVt_PV || mt == SVt_PVIV) |
118 | mt = SVt_PVNV; |
119 | break; |
120 | case SVt_PV: |
121 | nv = 0.0; |
122 | pv = SvPV(sv); |
123 | cur = SvCUR(sv); |
124 | len = SvLEN(sv); |
125 | iv = 0; |
126 | nv = 0.0; |
127 | magic = 0; |
128 | stash = 0; |
129 | del_XPV(SvANY(sv)); |
130 | break; |
131 | case SVt_PVIV: |
132 | nv = 0.0; |
133 | pv = SvPV(sv); |
134 | cur = SvCUR(sv); |
135 | len = SvLEN(sv); |
136 | iv = SvIV(sv); |
137 | nv = 0.0; |
138 | magic = 0; |
139 | stash = 0; |
140 | del_XPVIV(SvANY(sv)); |
141 | break; |
142 | case SVt_PVNV: |
143 | nv = SvNV(sv); |
144 | pv = SvPV(sv); |
145 | cur = SvCUR(sv); |
146 | len = SvLEN(sv); |
147 | iv = SvIV(sv); |
148 | nv = SvNV(sv); |
149 | magic = 0; |
150 | stash = 0; |
151 | del_XPVNV(SvANY(sv)); |
152 | break; |
153 | case SVt_PVMG: |
154 | pv = SvPV(sv); |
155 | cur = SvCUR(sv); |
156 | len = SvLEN(sv); |
157 | iv = SvIV(sv); |
158 | nv = SvNV(sv); |
159 | magic = SvMAGIC(sv); |
160 | stash = SvSTASH(sv); |
161 | del_XPVMG(SvANY(sv)); |
162 | break; |
163 | default: |
164 | fatal("Can't upgrade that kind of scalar"); |
165 | } |
166 | |
167 | switch (mt) { |
168 | case SVt_NULL: |
169 | fatal("Can't upgrade to undef"); |
170 | case SVt_REF: |
171 | SvIOK_on(sv); |
172 | break; |
173 | case SVt_IV: |
174 | SvANY(sv) = new_XIV(); |
175 | SvIV(sv) = iv; |
176 | break; |
177 | case SVt_NV: |
178 | SvANY(sv) = new_XNV(); |
179 | SvIV(sv) = iv; |
180 | SvNV(sv) = nv; |
181 | break; |
182 | case SVt_PV: |
183 | SvANY(sv) = new_XPV(); |
184 | SvPV(sv) = pv; |
185 | SvCUR(sv) = cur; |
186 | SvLEN(sv) = len; |
187 | break; |
188 | case SVt_PVIV: |
189 | SvANY(sv) = new_XPVIV(); |
190 | SvPV(sv) = pv; |
191 | SvCUR(sv) = cur; |
192 | SvLEN(sv) = len; |
193 | SvIV(sv) = iv; |
194 | if (SvNIOK(sv)) |
195 | SvIOK_on(sv); |
196 | SvNOK_off(sv); |
197 | break; |
198 | case SVt_PVNV: |
199 | SvANY(sv) = new_XPVNV(); |
200 | SvPV(sv) = pv; |
201 | SvCUR(sv) = cur; |
202 | SvLEN(sv) = len; |
203 | SvIV(sv) = iv; |
204 | SvNV(sv) = nv; |
205 | break; |
206 | case SVt_PVMG: |
207 | SvANY(sv) = new_XPVMG(); |
208 | SvPV(sv) = pv; |
209 | SvCUR(sv) = cur; |
210 | SvLEN(sv) = len; |
211 | SvIV(sv) = iv; |
212 | SvNV(sv) = nv; |
213 | SvMAGIC(sv) = magic; |
214 | SvSTASH(sv) = stash; |
215 | break; |
216 | case SVt_PVLV: |
217 | SvANY(sv) = new_XPVLV(); |
218 | SvPV(sv) = pv; |
219 | SvCUR(sv) = cur; |
220 | SvLEN(sv) = len; |
221 | SvIV(sv) = iv; |
222 | SvNV(sv) = nv; |
223 | SvMAGIC(sv) = magic; |
224 | SvSTASH(sv) = stash; |
225 | LvTARGOFF(sv) = 0; |
226 | LvTARGLEN(sv) = 0; |
227 | LvTARG(sv) = 0; |
228 | LvTYPE(sv) = 0; |
229 | break; |
230 | case SVt_PVAV: |
231 | SvANY(sv) = new_XPVAV(); |
232 | SvPV(sv) = pv; |
233 | SvCUR(sv) = cur; |
234 | SvLEN(sv) = len; |
235 | SvIV(sv) = iv; |
236 | SvNV(sv) = nv; |
237 | SvMAGIC(sv) = magic; |
238 | SvSTASH(sv) = stash; |
239 | AvMAGIC(sv) = 0; |
240 | AvARRAY(sv) = 0; |
241 | AvALLOC(sv) = 0; |
242 | AvMAX(sv) = 0; |
243 | AvFILL(sv) = 0; |
244 | AvARYLEN(sv) = 0; |
245 | AvFLAGS(sv) = 0; |
246 | break; |
247 | case SVt_PVHV: |
248 | SvANY(sv) = new_XPVHV(); |
249 | SvPV(sv) = pv; |
250 | SvCUR(sv) = cur; |
251 | SvLEN(sv) = len; |
252 | SvIV(sv) = iv; |
253 | SvNV(sv) = nv; |
254 | SvMAGIC(sv) = magic; |
255 | SvSTASH(sv) = stash; |
256 | HvMAGIC(sv) = 0; |
257 | HvARRAY(sv) = 0; |
258 | HvMAX(sv) = 0; |
259 | HvDOSPLIT(sv) = 0; |
260 | HvFILL(sv) = 0; |
261 | HvRITER(sv) = 0; |
262 | HvEITER(sv) = 0; |
263 | HvPMROOT(sv) = 0; |
264 | HvNAME(sv) = 0; |
265 | HvDBM(sv) = 0; |
266 | HvCOEFFSIZE(sv) = 0; |
267 | break; |
268 | case SVt_PVCV: |
269 | SvANY(sv) = new_XPVCV(); |
270 | SvPV(sv) = pv; |
271 | SvCUR(sv) = cur; |
272 | SvLEN(sv) = len; |
273 | SvIV(sv) = iv; |
274 | SvNV(sv) = nv; |
275 | SvMAGIC(sv) = magic; |
276 | SvSTASH(sv) = stash; |
277 | CvSTASH(sv) = 0; |
278 | CvSTART(sv) = 0; |
279 | CvROOT(sv) = 0; |
280 | CvUSERSUB(sv) = 0; |
281 | CvUSERINDEX(sv) = 0; |
282 | CvFILEGV(sv) = 0; |
283 | CvDEPTH(sv) = 0; |
284 | CvPADLIST(sv) = 0; |
285 | CvDELETED(sv) = 0; |
286 | break; |
287 | case SVt_PVGV: |
288 | SvANY(sv) = new_XPVGV(); |
289 | SvPV(sv) = pv; |
290 | SvCUR(sv) = cur; |
291 | SvLEN(sv) = len; |
292 | SvIV(sv) = iv; |
293 | SvNV(sv) = nv; |
294 | SvMAGIC(sv) = magic; |
295 | SvSTASH(sv) = stash; |
93a17b20 |
296 | GvGP(sv) = 0; |
79072805 |
297 | GvNAME(sv) = 0; |
298 | GvNAMELEN(sv) = 0; |
299 | GvSTASH(sv) = 0; |
300 | break; |
301 | case SVt_PVBM: |
302 | SvANY(sv) = new_XPVBM(); |
303 | SvPV(sv) = pv; |
304 | SvCUR(sv) = cur; |
305 | SvLEN(sv) = len; |
306 | SvIV(sv) = iv; |
307 | SvNV(sv) = nv; |
308 | SvMAGIC(sv) = magic; |
309 | SvSTASH(sv) = stash; |
310 | BmRARE(sv) = 0; |
311 | BmUSEFUL(sv) = 0; |
312 | BmPREVIOUS(sv) = 0; |
313 | break; |
314 | case SVt_PVFM: |
315 | SvANY(sv) = new_XPVFM(); |
316 | SvPV(sv) = pv; |
317 | SvCUR(sv) = cur; |
318 | SvLEN(sv) = len; |
319 | SvIV(sv) = iv; |
320 | SvNV(sv) = nv; |
321 | SvMAGIC(sv) = magic; |
322 | SvSTASH(sv) = stash; |
323 | FmLINES(sv) = 0; |
324 | break; |
325 | } |
326 | SvTYPE(sv) = mt; |
327 | return TRUE; |
328 | } |
329 | |
330 | char * |
331 | sv_peek(sv) |
332 | register SV *sv; |
333 | { |
334 | char *t = tokenbuf; |
335 | *t = '\0'; |
336 | |
337 | retry: |
338 | if (!sv) { |
339 | strcpy(t, "VOID"); |
340 | return tokenbuf; |
341 | } |
342 | else if (sv == (SV*)0x55555555 || SvTYPE(sv) == 'U') { |
343 | strcpy(t, "WILD"); |
344 | return tokenbuf; |
345 | } |
346 | else if (SvREFCNT(sv) == 0 && !SvREADONLY(sv)) { |
347 | strcpy(t, "UNREF"); |
348 | return tokenbuf; |
349 | } |
350 | else { |
351 | switch (SvTYPE(sv)) { |
352 | default: |
353 | strcpy(t,"FREED"); |
354 | return tokenbuf; |
355 | break; |
356 | |
357 | case SVt_NULL: |
93a17b20 |
358 | strcpy(t,"UNDEF"); |
359 | return tokenbuf; |
79072805 |
360 | case SVt_REF: |
93a17b20 |
361 | *t++ = '\\'; |
362 | if (t - tokenbuf > 10) { |
363 | strcpy(tokenbuf + 3,"..."); |
364 | return tokenbuf; |
365 | } |
79072805 |
366 | sv = (SV*)SvANY(sv); |
367 | goto retry; |
368 | case SVt_IV: |
369 | strcpy(t,"IV"); |
370 | break; |
371 | case SVt_NV: |
372 | strcpy(t,"NV"); |
373 | break; |
374 | case SVt_PV: |
375 | strcpy(t,"PV"); |
376 | break; |
377 | case SVt_PVIV: |
378 | strcpy(t,"PVIV"); |
379 | break; |
380 | case SVt_PVNV: |
381 | strcpy(t,"PVNV"); |
382 | break; |
383 | case SVt_PVMG: |
384 | strcpy(t,"PVMG"); |
385 | break; |
386 | case SVt_PVLV: |
387 | strcpy(t,"PVLV"); |
388 | break; |
389 | case SVt_PVAV: |
390 | strcpy(t,"AV"); |
391 | break; |
392 | case SVt_PVHV: |
393 | strcpy(t,"HV"); |
394 | break; |
395 | case SVt_PVCV: |
396 | strcpy(t,"CV"); |
397 | break; |
398 | case SVt_PVGV: |
399 | strcpy(t,"GV"); |
400 | break; |
401 | case SVt_PVBM: |
402 | strcpy(t,"BM"); |
403 | break; |
404 | case SVt_PVFM: |
405 | strcpy(t,"FM"); |
406 | break; |
407 | } |
408 | } |
409 | t += strlen(t); |
410 | |
411 | if (SvPOK(sv)) { |
412 | if (!SvPV(sv)) |
413 | return "(null)"; |
414 | if (SvOOK(sv)) |
415 | sprintf(t,"(%d+\"%0.127s\")",SvIV(sv),SvPV(sv)); |
416 | else |
417 | sprintf(t,"(\"%0.127s\")",SvPV(sv)); |
418 | } |
419 | else if (SvNOK(sv)) |
420 | sprintf(t,"(%g)",SvNV(sv)); |
421 | else if (SvIOK(sv)) |
422 | sprintf(t,"(%ld)",(long)SvIV(sv)); |
423 | else |
424 | strcpy(t,"()"); |
425 | return tokenbuf; |
426 | } |
427 | |
428 | int |
429 | sv_backoff(sv) |
430 | register SV *sv; |
431 | { |
432 | assert(SvOOK(sv)); |
433 | if (SvIV(sv)) { |
434 | char *s = SvPV(sv); |
435 | SvLEN(sv) += SvIV(sv); |
436 | SvPV(sv) -= SvIV(sv); |
437 | SvIV_set(sv, 0); |
438 | Move(s, SvPV(sv), SvCUR(sv)+1, char); |
439 | } |
440 | SvFLAGS(sv) &= ~SVf_OOK; |
441 | } |
442 | |
443 | char * |
444 | sv_grow(sv,newlen) |
445 | register SV *sv; |
446 | #ifndef DOSISH |
447 | register I32 newlen; |
448 | #else |
449 | unsigned long newlen; |
450 | #endif |
451 | { |
452 | register char *s; |
453 | |
454 | #ifdef MSDOS |
455 | if (newlen >= 0x10000) { |
456 | fprintf(stderr, "Allocation too large: %lx\n", newlen); |
457 | my_exit(1); |
458 | } |
459 | #endif /* MSDOS */ |
460 | if (SvREADONLY(sv)) |
461 | fatal(no_modify); |
462 | if (SvTYPE(sv) < SVt_PV) { |
463 | sv_upgrade(sv, SVt_PV); |
464 | s = SvPV(sv); |
465 | } |
466 | else if (SvOOK(sv)) { /* pv is offset? */ |
467 | sv_backoff(sv); |
468 | s = SvPV(sv); |
469 | if (newlen > SvLEN(sv)) |
470 | newlen += 10 * (newlen - SvCUR(sv)); /* avoid copy each time */ |
471 | } |
472 | else |
473 | s = SvPV(sv); |
474 | if (newlen > SvLEN(sv)) { /* need more room? */ |
475 | if (SvLEN(sv)) |
476 | Renew(s,newlen,char); |
477 | else |
478 | New(703,s,newlen,char); |
479 | SvPV_set(sv, s); |
480 | SvLEN_set(sv, newlen); |
481 | } |
482 | return s; |
483 | } |
484 | |
485 | void |
486 | sv_setiv(sv,i) |
487 | register SV *sv; |
488 | I32 i; |
489 | { |
490 | if (SvREADONLY(sv)) |
491 | fatal(no_modify); |
492 | if (SvTYPE(sv) < SVt_IV) |
493 | sv_upgrade(sv, SVt_IV); |
494 | else if (SvTYPE(sv) == SVt_PV) |
495 | sv_upgrade(sv, SVt_PVIV); |
496 | SvIV(sv) = i; |
497 | SvIOK_only(sv); /* validate number */ |
498 | SvTDOWN(sv); |
499 | } |
500 | |
501 | void |
502 | sv_setnv(sv,num) |
503 | register SV *sv; |
504 | double num; |
505 | { |
506 | if (SvREADONLY(sv)) |
507 | fatal(no_modify); |
508 | if (SvTYPE(sv) < SVt_NV) |
509 | sv_upgrade(sv, SVt_NV); |
510 | else if (SvTYPE(sv) < SVt_PVNV) |
511 | sv_upgrade(sv, SVt_PVNV); |
512 | else if (SvPOK(sv)) { |
513 | SvOOK_off(sv); |
514 | } |
515 | SvNV(sv) = num; |
516 | SvNOK_only(sv); /* validate number */ |
517 | SvTDOWN(sv); |
518 | } |
519 | |
520 | I32 |
521 | sv_2iv(sv) |
522 | register SV *sv; |
523 | { |
524 | if (!sv) |
525 | return 0; |
526 | if (SvREADONLY(sv)) { |
527 | if (SvNOK(sv)) |
528 | return (I32)SvNV(sv); |
529 | if (SvPOK(sv) && SvLEN(sv)) |
530 | return atof(SvPV(sv)); |
531 | if (dowarn) |
532 | warn("Use of uninitialized variable"); |
533 | return 0; |
534 | } |
535 | if (SvTYPE(sv) < SVt_IV) { |
536 | if (SvTYPE(sv) == SVt_REF) |
537 | return (I32)SvANYI32(sv); |
538 | sv_upgrade(sv, SVt_IV); |
539 | DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvIV(sv))); |
540 | return SvIV(sv); |
541 | } |
542 | else if (SvTYPE(sv) == SVt_PV) |
543 | sv_upgrade(sv, SVt_PVIV); |
544 | if (SvNOK(sv)) |
545 | SvIV(sv) = (I32)SvNV(sv); |
93a17b20 |
546 | else if (SvPOK(sv) && SvLEN(sv)) { |
547 | if (dowarn && !looks_like_number(sv)) { |
548 | if (op) |
549 | warn("Argument wasn't numeric for \"%s\"",op_name[op->op_type]); |
550 | else |
551 | warn("Argument wasn't numeric"); |
552 | } |
79072805 |
553 | SvIV(sv) = atol(SvPV(sv)); |
93a17b20 |
554 | } |
79072805 |
555 | else { |
556 | if (dowarn) |
557 | warn("Use of uninitialized variable"); |
558 | SvUPGRADE(sv, SVt_IV); |
559 | SvIV(sv) = 0; |
560 | } |
561 | SvIOK_on(sv); |
562 | DEBUG_c((stderr,"0x%lx 2iv(%d)\n",sv,SvIV(sv))); |
563 | return SvIV(sv); |
564 | } |
565 | |
566 | double |
567 | sv_2nv(sv) |
568 | register SV *sv; |
569 | { |
570 | if (!sv) |
571 | return 0.0; |
572 | if (SvREADONLY(sv)) { |
573 | if (SvPOK(sv) && SvLEN(sv)) |
574 | return atof(SvPV(sv)); |
575 | if (dowarn) |
576 | warn("Use of uninitialized variable"); |
577 | return 0.0; |
578 | } |
579 | if (SvTYPE(sv) < SVt_NV) { |
580 | if (SvTYPE(sv) == SVt_REF) |
581 | return (double)SvANYI32(sv); |
582 | sv_upgrade(sv, SVt_NV); |
583 | DEBUG_c((stderr,"0x%lx num(%g)\n",sv,SvNV(sv))); |
584 | return SvNV(sv); |
585 | } |
586 | else if (SvTYPE(sv) < SVt_PVNV) |
587 | sv_upgrade(sv, SVt_PVNV); |
93a17b20 |
588 | if (SvIOK(sv) && |
589 | (!SvPOK(sv) || !strchr(SvPV(sv),'.') || !looks_like_number(sv))) |
590 | { |
79072805 |
591 | SvNV(sv) = (double)SvIV(sv); |
93a17b20 |
592 | } |
593 | else if (SvPOK(sv) && SvLEN(sv)) { |
594 | if (dowarn && !SvIOK(sv) && !looks_like_number(sv)) { |
595 | if (op) |
596 | warn("Argument wasn't numeric for \"%s\"",op_name[op->op_type]); |
597 | else |
598 | warn("Argument wasn't numeric"); |
599 | } |
600 | SvNV(sv) = atof(SvPV(sv)); |
601 | } |
79072805 |
602 | else { |
603 | if (dowarn) |
604 | warn("Use of uninitialized variable"); |
605 | SvNV(sv) = 0.0; |
606 | } |
607 | SvNOK_on(sv); |
608 | DEBUG_c((stderr,"0x%lx 2nv(%g)\n",sv,SvNV(sv))); |
609 | return SvNV(sv); |
610 | } |
611 | |
612 | char * |
613 | sv_2pv(sv) |
614 | register SV *sv; |
615 | { |
616 | register char *s; |
617 | int olderrno; |
618 | |
619 | if (!sv) |
620 | return ""; |
621 | if (SvTYPE(sv) == SVt_REF) { |
622 | sv = (SV*)SvANY(sv); |
623 | if (!sv) |
624 | return "<Empty reference>"; |
625 | switch (SvTYPE(sv)) { |
626 | case SVt_NULL: s = "an undefined value"; break; |
627 | case SVt_REF: s = "a reference"; break; |
628 | case SVt_IV: s = "an integer value"; break; |
629 | case SVt_NV: s = "a numeric value"; break; |
630 | case SVt_PV: s = "a string value"; break; |
631 | case SVt_PVIV: s = "a string+integer value"; break; |
632 | case SVt_PVNV: s = "a scalar value"; break; |
633 | case SVt_PVMG: s = "a magic value"; break; |
634 | case SVt_PVLV: s = "an lvalue"; break; |
635 | case SVt_PVAV: s = "an array value"; break; |
636 | case SVt_PVHV: s = "an associative array value"; break; |
637 | case SVt_PVCV: s = "a code value"; break; |
638 | case SVt_PVGV: s = "a glob value"; break; |
639 | case SVt_PVBM: s = "a search string"; break; |
640 | case SVt_PVFM: s = "a formatline"; break; |
641 | default: s = "something weird"; break; |
642 | } |
643 | sprintf(tokenbuf,"<Reference to %s at 0x%lx>", s, (unsigned long)sv); |
644 | return tokenbuf; |
645 | } |
646 | if (SvREADONLY(sv)) { |
647 | if (SvIOK(sv)) { |
648 | (void)sprintf(tokenbuf,"%ld",SvIV(sv)); |
649 | return tokenbuf; |
650 | } |
651 | if (SvNOK(sv)) { |
652 | (void)sprintf(tokenbuf,"%.20g",SvNV(sv)); |
653 | return tokenbuf; |
654 | } |
655 | if (dowarn) |
656 | warn("Use of uninitialized variable"); |
657 | return ""; |
658 | } |
659 | if (!SvUPGRADE(sv, SVt_PV)) |
660 | return 0; |
661 | if (SvNOK(sv)) { |
662 | if (SvTYPE(sv) < SVt_PVNV) |
663 | sv_upgrade(sv, SVt_PVNV); |
664 | SvGROW(sv, 28); |
665 | s = SvPV(sv); |
666 | olderrno = errno; /* some Xenix systems wipe out errno here */ |
667 | #if defined(scs) && defined(ns32000) |
668 | gcvt(SvNV(sv),20,s); |
669 | #else |
670 | #ifdef apollo |
671 | if (SvNV(sv) == 0.0) |
672 | (void)strcpy(s,"0"); |
673 | else |
674 | #endif /*apollo*/ |
675 | (void)sprintf(s,"%.20g",SvNV(sv)); |
676 | #endif /*scs*/ |
677 | errno = olderrno; |
678 | while (*s) s++; |
679 | #ifdef hcx |
680 | if (s[-1] == '.') |
681 | s--; |
682 | #endif |
683 | } |
684 | else if (SvIOK(sv)) { |
685 | if (SvTYPE(sv) < SVt_PVIV) |
686 | sv_upgrade(sv, SVt_PVIV); |
687 | SvGROW(sv, 11); |
688 | s = SvPV(sv); |
689 | olderrno = errno; /* some Xenix systems wipe out errno here */ |
690 | (void)sprintf(s,"%ld",SvIV(sv)); |
691 | errno = olderrno; |
692 | while (*s) s++; |
693 | } |
694 | else { |
695 | if (dowarn) |
696 | warn("Use of uninitialized variable"); |
697 | sv_grow(sv, 1); |
698 | s = SvPV(sv); |
699 | } |
700 | *s = '\0'; |
701 | SvCUR_set(sv, s - SvPV(sv)); |
702 | SvPOK_on(sv); |
703 | DEBUG_c((stderr,"0x%lx 2pv(%s)\n",sv,SvPV(sv))); |
704 | return SvPV(sv); |
705 | } |
706 | |
707 | /* Note: sv_setsv() should not be called with a source string that needs |
708 | * be reused, since it may destroy the source string if it is marked |
709 | * as temporary. |
710 | */ |
711 | |
712 | void |
713 | sv_setsv(dstr,sstr) |
714 | SV *dstr; |
715 | register SV *sstr; |
716 | { |
717 | if (sstr == dstr) |
718 | return; |
719 | if (SvREADONLY(dstr)) |
720 | fatal(no_modify); |
721 | if (!sstr) |
722 | sstr = &sv_undef; |
723 | |
724 | if (SvTYPE(dstr) < SvTYPE(sstr)) |
725 | sv_upgrade(dstr, SvTYPE(sstr)); |
726 | else if (SvTYPE(dstr) == SVt_PV && SvTYPE(sstr) <= SVt_NV) { |
727 | if (SvTYPE(sstr) <= SVt_IV) |
728 | sv_upgrade(dstr, SVt_PVIV); /* handle discontinuities */ |
729 | else |
730 | sv_upgrade(dstr, SVt_PVNV); |
731 | } |
732 | else if (SvTYPE(dstr) == SVt_PVIV && SvTYPE(sstr) == SVt_NV) |
733 | sv_upgrade(dstr, SVt_PVNV); |
734 | |
735 | switch (SvTYPE(sstr)) { |
736 | case SVt_NULL: |
737 | if (SvTYPE(dstr) == SVt_REF) { |
738 | sv_free((SV*)SvANY(dstr)); |
739 | SvANY(dstr) = 0; |
740 | SvTYPE(dstr) = SVt_NULL; |
741 | } |
742 | else |
743 | SvOK_off(dstr); |
744 | return; |
745 | case SVt_REF: |
746 | SvTUP(sstr); |
747 | if (SvTYPE(dstr) == SVt_REF) { |
748 | SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr)); |
749 | } |
750 | else { |
751 | if (SvMAGICAL(dstr)) |
752 | fatal("Can't assign a reference to a magical variable"); |
753 | sv_clear(dstr); |
754 | SvTYPE(dstr) = SVt_REF; |
755 | SvANY(dstr) = (void*)sv_ref((SV*)SvANY(sstr)); |
756 | SvOK_off(dstr); |
757 | } |
758 | SvTDOWN(sstr); |
759 | return; |
760 | case SVt_PVGV: |
761 | SvTUP(sstr); |
762 | if (SvTYPE(dstr) == SVt_PVGV) { |
763 | SvOK_off(dstr); |
764 | if (!GvAV(sstr)) |
765 | gv_AVadd(sstr); |
766 | if (!GvHV(sstr)) |
767 | gv_HVadd(sstr); |
768 | if (!GvIO(sstr)) |
769 | GvIO(sstr) = newIO(); |
770 | if (GvGP(dstr)) |
771 | gp_free(dstr); |
772 | GvGP(dstr) = gp_ref(GvGP(sstr)); |
773 | SvTDOWN(sstr); |
774 | return; |
775 | } |
776 | /* FALL THROUGH */ |
777 | |
778 | default: |
779 | if (SvMAGICAL(sstr)) |
780 | mg_get(sstr); |
781 | /* XXX */ |
782 | break; |
783 | } |
784 | |
785 | SvPRIVATE(dstr) = SvPRIVATE(sstr); |
786 | SvSTORAGE(dstr) = SvSTORAGE(sstr); |
787 | |
788 | if (SvPOK(sstr)) { |
789 | |
790 | SvTUP(sstr); |
791 | |
792 | /* |
793 | * Check to see if we can just swipe the string. If so, it's a |
794 | * possible small lose on short strings, but a big win on long ones. |
795 | * It might even be a win on short strings if SvPV(dstr) |
796 | * has to be allocated and SvPV(sstr) has to be freed. |
797 | */ |
798 | |
799 | if (SvTEMP(sstr)) { /* slated for free anyway? */ |
800 | if (SvPOK(dstr)) { |
801 | SvOOK_off(dstr); |
802 | Safefree(SvPV(dstr)); |
803 | } |
804 | SvPV_set(dstr, SvPV(sstr)); |
805 | SvLEN_set(dstr, SvLEN(sstr)); |
806 | SvCUR_set(dstr, SvCUR(sstr)); |
807 | SvTYPE(dstr) = SvTYPE(sstr); |
808 | SvPOK_only(dstr); |
809 | SvTEMP_off(dstr); |
810 | SvPV_set(sstr, Nullch); |
811 | SvLEN_set(sstr, 0); |
812 | SvPOK_off(sstr); /* wipe out any weird flags */ |
813 | SvTYPE(sstr) = 0; /* so sstr frees uneventfully */ |
814 | } |
815 | else { /* have to copy actual string */ |
816 | if (SvPV(dstr)) { /* XXX ck type */ |
817 | SvOOK_off(dstr); |
818 | } |
819 | sv_setpvn(dstr,SvPV(sstr),SvCUR(sstr)); |
820 | } |
821 | /*SUPPRESS 560*/ |
822 | if (SvNOK(sstr)) { |
823 | SvNOK_on(dstr); |
824 | SvNV(dstr) = SvNV(sstr); |
825 | } |
826 | if (SvIOK(sstr)) { |
827 | SvIOK_on(dstr); |
828 | SvIV(dstr) = SvIV(sstr); |
829 | } |
830 | } |
831 | else if (SvNOK(sstr)) { |
832 | SvTUP(sstr); |
833 | SvNV(dstr) = SvNV(sstr); |
834 | SvNOK_only(dstr); |
835 | if (SvIOK(sstr)) { |
836 | SvIOK_on(dstr); |
837 | SvIV(dstr) = SvIV(sstr); |
838 | } |
839 | } |
840 | else if (SvIOK(sstr)) { |
841 | SvTUP(sstr); |
842 | SvIOK_only(dstr); |
843 | SvIV(dstr) = SvIV(sstr); |
844 | } |
845 | else { |
846 | SvTUP(sstr); |
847 | SvOK_off(dstr); |
848 | } |
849 | SvTDOWN(dstr); |
850 | } |
851 | |
852 | void |
853 | sv_setpvn(sv,ptr,len) |
854 | register SV *sv; |
855 | register char *ptr; |
856 | register STRLEN len; |
857 | { |
858 | if (!SvUPGRADE(sv, SVt_PV)) |
859 | return; |
860 | SvGROW(sv, len + 1); |
861 | if (ptr) |
862 | Move(ptr,SvPV(sv),len,char); |
863 | SvCUR_set(sv, len); |
864 | *SvEND(sv) = '\0'; |
865 | SvPOK_only(sv); /* validate pointer */ |
866 | SvTDOWN(sv); |
867 | } |
868 | |
869 | void |
870 | sv_setpv(sv,ptr) |
871 | register SV *sv; |
872 | register char *ptr; |
873 | { |
874 | register STRLEN len; |
875 | |
876 | if (SvREADONLY(sv)) |
877 | fatal(no_modify); |
878 | if (!ptr) |
879 | ptr = ""; |
880 | len = strlen(ptr); |
881 | if (!SvUPGRADE(sv, SVt_PV)) |
882 | return; |
883 | SvGROW(sv, len + 1); |
884 | Move(ptr,SvPV(sv),len+1,char); |
885 | SvCUR_set(sv, len); |
886 | SvPOK_only(sv); /* validate pointer */ |
887 | SvTDOWN(sv); |
888 | } |
889 | |
890 | void |
891 | sv_chop(sv,ptr) /* like set but assuming ptr is in sv */ |
892 | register SV *sv; |
893 | register char *ptr; |
894 | { |
895 | register STRLEN delta; |
896 | |
897 | if (!ptr || !SvPOK(sv)) |
898 | return; |
899 | if (SvREADONLY(sv)) |
900 | fatal(no_modify); |
901 | if (SvTYPE(sv) < SVt_PVIV) |
902 | sv_upgrade(sv,SVt_PVIV); |
903 | |
904 | if (!SvOOK(sv)) { |
905 | SvIV(sv) = 0; |
906 | SvFLAGS(sv) |= SVf_OOK; |
907 | } |
908 | SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK); |
909 | delta = ptr - SvPV(sv); |
910 | SvLEN(sv) -= delta; |
911 | SvCUR(sv) -= delta; |
912 | SvPV(sv) += delta; |
913 | SvIV(sv) += delta; |
914 | } |
915 | |
916 | void |
917 | sv_catpvn(sv,ptr,len) |
918 | register SV *sv; |
919 | register char *ptr; |
920 | register STRLEN len; |
921 | { |
922 | if (SvREADONLY(sv)) |
923 | fatal(no_modify); |
924 | if (!(SvPOK(sv))) |
925 | (void)sv_2pv(sv); |
926 | SvGROW(sv, SvCUR(sv) + len + 1); |
927 | Move(ptr,SvPV(sv)+SvCUR(sv),len,char); |
928 | SvCUR(sv) += len; |
929 | *SvEND(sv) = '\0'; |
930 | SvPOK_only(sv); /* validate pointer */ |
931 | SvTDOWN(sv); |
932 | } |
933 | |
934 | void |
935 | sv_catsv(dstr,sstr) |
936 | SV *dstr; |
937 | register SV *sstr; |
938 | { |
939 | char *s; |
940 | if (!sstr) |
941 | return; |
942 | if (s = SvPVn(sstr)) { |
943 | if (SvPOK(sstr)) |
944 | sv_catpvn(dstr,s,SvCUR(sstr)); |
945 | else |
946 | sv_catpv(dstr,s); |
947 | } |
948 | } |
949 | |
950 | void |
951 | sv_catpv(sv,ptr) |
952 | register SV *sv; |
953 | register char *ptr; |
954 | { |
955 | register STRLEN len; |
956 | |
957 | if (SvREADONLY(sv)) |
958 | fatal(no_modify); |
959 | if (!ptr) |
960 | return; |
961 | if (!(SvPOK(sv))) |
962 | (void)sv_2pv(sv); |
963 | len = strlen(ptr); |
964 | SvGROW(sv, SvCUR(sv) + len + 1); |
965 | Move(ptr,SvPV(sv)+SvCUR(sv),len+1,char); |
966 | SvCUR(sv) += len; |
967 | SvPOK_only(sv); /* validate pointer */ |
968 | SvTDOWN(sv); |
969 | } |
970 | |
79072805 |
971 | SV * |
972 | #ifdef LEAKTEST |
973 | newSV(x,len) |
974 | I32 x; |
975 | #else |
976 | newSV(len) |
977 | #endif |
978 | STRLEN len; |
979 | { |
980 | register SV *sv; |
981 | |
982 | sv = (SV*)new_SV(); |
983 | Zero(sv, 1, SV); |
984 | SvREFCNT(sv)++; |
985 | if (len) { |
986 | sv_upgrade(sv, SVt_PV); |
987 | SvGROW(sv, len + 1); |
988 | } |
989 | return sv; |
990 | } |
991 | |
992 | void |
993 | sv_magic(sv, obj, how, name, namlen) |
994 | register SV *sv; |
995 | SV *obj; |
996 | char how; |
997 | char *name; |
998 | STRLEN namlen; |
999 | { |
1000 | MAGIC* mg; |
1001 | |
1002 | if (SvREADONLY(sv)) |
1003 | fatal(no_modify); |
1004 | if (!SvUPGRADE(sv, SVt_PVMG)) |
1005 | return; |
1006 | Newz(702,mg, 1, MAGIC); |
1007 | mg->mg_moremagic = SvMAGIC(sv); |
1008 | SvMAGICAL_on(sv); |
1009 | SvMAGIC(sv) = mg; |
1010 | mg->mg_obj = obj; |
1011 | mg->mg_type = how; |
1012 | if (name) { |
1013 | mg->mg_ptr = nsavestr(name, namlen); |
1014 | mg->mg_len = namlen; |
1015 | } |
1016 | switch (how) { |
1017 | case 0: |
1018 | mg->mg_virtual = &vtbl_sv; |
1019 | break; |
1020 | case 'B': |
1021 | mg->mg_virtual = &vtbl_bm; |
1022 | break; |
1023 | case 'D': |
1024 | mg->mg_virtual = &vtbl_dbm; |
1025 | break; |
1026 | case 'd': |
1027 | mg->mg_virtual = &vtbl_dbmelem; |
1028 | break; |
1029 | case 'E': |
1030 | mg->mg_virtual = &vtbl_env; |
1031 | break; |
1032 | case 'e': |
1033 | mg->mg_virtual = &vtbl_envelem; |
1034 | break; |
93a17b20 |
1035 | case 'g': |
1036 | mg->mg_virtual = &vtbl_mglob; |
1037 | break; |
79072805 |
1038 | case 'L': |
93a17b20 |
1039 | mg->mg_virtual = 0; |
1040 | break; |
1041 | case 'l': |
79072805 |
1042 | mg->mg_virtual = &vtbl_dbline; |
1043 | break; |
1044 | case 'S': |
1045 | mg->mg_virtual = &vtbl_sig; |
1046 | break; |
1047 | case 's': |
1048 | mg->mg_virtual = &vtbl_sigelem; |
1049 | break; |
1050 | case 'U': |
1051 | mg->mg_virtual = &vtbl_uvar; |
1052 | break; |
1053 | case 'v': |
1054 | mg->mg_virtual = &vtbl_vec; |
1055 | break; |
1056 | case 'x': |
1057 | mg->mg_virtual = &vtbl_substr; |
1058 | break; |
1059 | case '*': |
1060 | mg->mg_virtual = &vtbl_glob; |
1061 | break; |
1062 | case '#': |
1063 | mg->mg_virtual = &vtbl_arylen; |
1064 | break; |
1065 | default: |
1066 | fatal("Don't know how to handle magic of type '%c'", how); |
1067 | } |
1068 | } |
1069 | |
1070 | void |
1071 | sv_insert(bigstr,offset,len,little,littlelen) |
1072 | SV *bigstr; |
1073 | STRLEN offset; |
1074 | STRLEN len; |
1075 | char *little; |
1076 | STRLEN littlelen; |
1077 | { |
1078 | register char *big; |
1079 | register char *mid; |
1080 | register char *midend; |
1081 | register char *bigend; |
1082 | register I32 i; |
1083 | |
1084 | if (SvREADONLY(bigstr)) |
1085 | fatal(no_modify); |
1086 | SvPOK_only(bigstr); |
1087 | |
1088 | i = littlelen - len; |
1089 | if (i > 0) { /* string might grow */ |
1090 | if (!SvUPGRADE(bigstr, SVt_PV)) |
1091 | return; |
1092 | SvGROW(bigstr, SvCUR(bigstr) + i + 1); |
1093 | big = SvPV(bigstr); |
1094 | mid = big + offset + len; |
1095 | midend = bigend = big + SvCUR(bigstr); |
1096 | bigend += i; |
1097 | *bigend = '\0'; |
1098 | while (midend > mid) /* shove everything down */ |
1099 | *--bigend = *--midend; |
1100 | Move(little,big+offset,littlelen,char); |
1101 | SvCUR(bigstr) += i; |
1102 | SvSETMAGIC(bigstr); |
1103 | return; |
1104 | } |
1105 | else if (i == 0) { |
1106 | Move(little,SvPV(bigstr)+offset,len,char); |
1107 | SvSETMAGIC(bigstr); |
1108 | return; |
1109 | } |
1110 | |
1111 | big = SvPV(bigstr); |
1112 | mid = big + offset; |
1113 | midend = mid + len; |
1114 | bigend = big + SvCUR(bigstr); |
1115 | |
1116 | if (midend > bigend) |
1117 | fatal("panic: sv_insert"); |
1118 | |
1119 | if (mid - big > bigend - midend) { /* faster to shorten from end */ |
1120 | if (littlelen) { |
1121 | Move(little, mid, littlelen,char); |
1122 | mid += littlelen; |
1123 | } |
1124 | i = bigend - midend; |
1125 | if (i > 0) { |
1126 | Move(midend, mid, i,char); |
1127 | mid += i; |
1128 | } |
1129 | *mid = '\0'; |
1130 | SvCUR_set(bigstr, mid - big); |
1131 | } |
1132 | /*SUPPRESS 560*/ |
1133 | else if (i = mid - big) { /* faster from front */ |
1134 | midend -= littlelen; |
1135 | mid = midend; |
1136 | sv_chop(bigstr,midend-i); |
1137 | big += i; |
1138 | while (i--) |
1139 | *--midend = *--big; |
1140 | if (littlelen) |
1141 | Move(little, mid, littlelen,char); |
1142 | } |
1143 | else if (littlelen) { |
1144 | midend -= littlelen; |
1145 | sv_chop(bigstr,midend); |
1146 | Move(little,midend,littlelen,char); |
1147 | } |
1148 | else { |
1149 | sv_chop(bigstr,midend); |
1150 | } |
1151 | SvSETMAGIC(bigstr); |
1152 | } |
1153 | |
1154 | /* make sv point to what nstr did */ |
1155 | |
1156 | void |
1157 | sv_replace(sv,nsv) |
1158 | register SV *sv; |
1159 | register SV *nsv; |
1160 | { |
1161 | U32 refcnt = SvREFCNT(sv); |
1162 | if (SvREADONLY(sv)) |
1163 | fatal(no_modify); |
1164 | if (SvREFCNT(nsv) != 1) |
1165 | warn("Reference miscount in sv_replace()"); |
93a17b20 |
1166 | if (SvMAGICAL(sv)) { |
1167 | SvUPGRADE(nsv, SVt_PVMG); |
1168 | SvMAGIC(nsv) = SvMAGIC(sv); |
1169 | SvMAGICAL_on(nsv); |
1170 | SvMAGICAL_off(sv); |
1171 | SvMAGIC(sv) = 0; |
1172 | } |
79072805 |
1173 | SvREFCNT(sv) = 0; |
1174 | sv_clear(sv); |
1175 | StructCopy(nsv,sv,SV); |
1176 | SvREFCNT(sv) = refcnt; |
1177 | Safefree(nsv); |
1178 | } |
1179 | |
1180 | void |
1181 | sv_clear(sv) |
1182 | register SV *sv; |
1183 | { |
1184 | assert(sv); |
1185 | assert(SvREFCNT(sv) == 0); |
1186 | |
1187 | switch (SvTYPE(sv)) { |
1188 | case SVt_PVFM: |
1189 | goto freemagic; |
1190 | case SVt_PVBM: |
1191 | goto freemagic; |
1192 | case SVt_PVGV: |
1193 | gp_free(sv); |
1194 | goto freemagic; |
1195 | case SVt_PVCV: |
1196 | op_free(CvSTART(sv)); |
1197 | goto freemagic; |
1198 | case SVt_PVHV: |
1199 | hv_clear(sv, FALSE); |
1200 | goto freemagic; |
1201 | case SVt_PVAV: |
1202 | av_clear(sv); |
1203 | goto freemagic; |
1204 | case SVt_PVLV: |
1205 | goto freemagic; |
1206 | case SVt_PVMG: |
1207 | freemagic: |
1208 | if (SvMAGICAL(sv)) |
1209 | mg_freeall(sv); |
1210 | case SVt_PVNV: |
1211 | case SVt_PVIV: |
1212 | SvOOK_off(sv); |
1213 | /* FALL THROUGH */ |
1214 | case SVt_PV: |
1215 | if (SvPV(sv)) |
1216 | Safefree(SvPV(sv)); |
1217 | break; |
1218 | case SVt_NV: |
1219 | break; |
1220 | case SVt_IV: |
1221 | break; |
1222 | case SVt_REF: |
1223 | sv_free((SV*)SvANY(sv)); |
1224 | break; |
1225 | case SVt_NULL: |
1226 | break; |
1227 | } |
1228 | |
1229 | switch (SvTYPE(sv)) { |
1230 | case SVt_NULL: |
1231 | break; |
1232 | case SVt_REF: |
1233 | break; |
1234 | case SVt_IV: |
1235 | del_XIV(SvANY(sv)); |
1236 | break; |
1237 | case SVt_NV: |
1238 | del_XNV(SvANY(sv)); |
1239 | break; |
1240 | case SVt_PV: |
1241 | del_XPV(SvANY(sv)); |
1242 | break; |
1243 | case SVt_PVIV: |
1244 | del_XPVIV(SvANY(sv)); |
1245 | break; |
1246 | case SVt_PVNV: |
1247 | del_XPVNV(SvANY(sv)); |
1248 | break; |
1249 | case SVt_PVMG: |
1250 | del_XPVMG(SvANY(sv)); |
1251 | break; |
1252 | case SVt_PVLV: |
1253 | del_XPVLV(SvANY(sv)); |
1254 | break; |
1255 | case SVt_PVAV: |
1256 | del_XPVAV(SvANY(sv)); |
1257 | break; |
1258 | case SVt_PVHV: |
1259 | del_XPVHV(SvANY(sv)); |
1260 | break; |
1261 | case SVt_PVCV: |
1262 | del_XPVCV(SvANY(sv)); |
1263 | break; |
1264 | case SVt_PVGV: |
1265 | del_XPVGV(SvANY(sv)); |
1266 | break; |
1267 | case SVt_PVBM: |
1268 | del_XPVBM(SvANY(sv)); |
1269 | break; |
1270 | case SVt_PVFM: |
1271 | del_XPVFM(SvANY(sv)); |
1272 | break; |
1273 | } |
1274 | DEB(SvTYPE(sv) = 0xff;) |
1275 | } |
1276 | |
1277 | SV * |
1278 | sv_ref(sv) |
1279 | SV* sv; |
1280 | { |
1281 | SvREFCNT(sv)++; |
1282 | return sv; |
1283 | } |
1284 | |
1285 | void |
1286 | sv_free(sv) |
1287 | SV *sv; |
1288 | { |
1289 | if (!sv) |
1290 | return; |
1291 | if (SvREADONLY(sv)) { |
1292 | if (sv == &sv_undef || sv == &sv_yes || sv == &sv_no) |
1293 | return; |
1294 | } |
1295 | if (SvREFCNT(sv) == 0) { |
1296 | warn("Attempt to free unreferenced scalar"); |
1297 | return; |
1298 | } |
1299 | if (--SvREFCNT(sv) > 0) |
1300 | return; |
1301 | if (SvSTORAGE(sv) == 'O') { |
1302 | dSP; |
1303 | BINOP myop; /* fake syntax tree node */ |
1304 | GV* destructor; |
1305 | |
1306 | SvSTORAGE(sv) = 0; /* Curse the object. */ |
1307 | |
1308 | ENTER; |
1309 | SAVESPTR(curcop); |
1310 | SAVESPTR(op); |
1311 | curcop = &compiling; |
1312 | curstash = SvSTASH(sv); |
1313 | destructor = gv_fetchpv("DESTROY", FALSE); |
1314 | |
1315 | if (GvCV(destructor)) { |
1316 | SV* ref = sv_mortalcopy(&sv_undef); |
1317 | SvREFCNT(ref) = 1; |
1318 | sv_upgrade(ref, SVt_REF); |
1319 | SvANY(ref) = (void*)sv_ref(sv); |
1320 | |
1321 | op = (OP*)&myop; |
1322 | Zero(op, 1, OP); |
1323 | myop.op_last = (OP*)&myop; |
1324 | myop.op_flags = OPf_STACKED; |
1325 | myop.op_next = Nullop; |
1326 | |
1327 | EXTEND(SP, 2); |
1328 | PUSHs((SV*)destructor); |
1329 | pp_pushmark(); |
1330 | PUSHs(ref); |
1331 | PUTBACK; |
1332 | op = pp_entersubr(); |
1333 | run(); |
1334 | stack_sp--; |
1335 | LEAVE; /* Will eventually free sv as ordinary item. */ |
1336 | return; |
1337 | } |
1338 | LEAVE; |
1339 | } |
1340 | sv_clear(sv); |
1341 | DEB(SvTYPE(sv) = 0xff;) |
1342 | del_SV(sv); |
1343 | } |
1344 | |
1345 | STRLEN |
1346 | sv_len(sv) |
1347 | register SV *sv; |
1348 | { |
1349 | I32 paren; |
1350 | I32 i; |
1351 | char *s; |
1352 | |
1353 | if (!sv) |
1354 | return 0; |
1355 | |
1356 | if (SvMAGICAL(sv)) |
93a17b20 |
1357 | return mg_len(sv); |
79072805 |
1358 | |
1359 | if (!(SvPOK(sv))) { |
1360 | (void)sv_2pv(sv); |
1361 | if (!SvOK(sv)) |
1362 | return 0; |
1363 | } |
1364 | if (SvPV(sv)) |
1365 | return SvCUR(sv); |
1366 | else |
1367 | return 0; |
1368 | } |
1369 | |
1370 | I32 |
1371 | sv_eq(str1,str2) |
1372 | register SV *str1; |
1373 | register SV *str2; |
1374 | { |
1375 | char *pv1; |
1376 | U32 cur1; |
1377 | char *pv2; |
1378 | U32 cur2; |
1379 | |
1380 | if (!str1) { |
1381 | pv1 = ""; |
1382 | cur1 = 0; |
1383 | } |
1384 | else { |
1385 | if (SvMAGICAL(str1)) |
1386 | mg_get(str1); |
1387 | if (!SvPOK(str1)) { |
1388 | (void)sv_2pv(str1); |
1389 | if (!SvPOK(str1)) |
1390 | str1 = &sv_no; |
1391 | } |
1392 | pv1 = SvPV(str1); |
1393 | cur1 = SvCUR(str1); |
1394 | } |
1395 | |
1396 | if (!str2) |
1397 | return !cur1; |
1398 | else { |
1399 | if (SvMAGICAL(str2)) |
1400 | mg_get(str2); |
1401 | if (!SvPOK(str2)) { |
1402 | (void)sv_2pv(str2); |
1403 | if (!SvPOK(str2)) |
1404 | return !cur1; |
1405 | } |
1406 | pv2 = SvPV(str2); |
1407 | cur2 = SvCUR(str2); |
1408 | } |
1409 | |
1410 | if (cur1 != cur2) |
1411 | return 0; |
1412 | |
1413 | return !bcmp(pv1, pv2, cur1); |
1414 | } |
1415 | |
1416 | I32 |
1417 | sv_cmp(str1,str2) |
1418 | register SV *str1; |
1419 | register SV *str2; |
1420 | { |
1421 | I32 retval; |
1422 | char *pv1; |
1423 | U32 cur1; |
1424 | char *pv2; |
1425 | U32 cur2; |
1426 | |
1427 | if (!str1) { |
1428 | pv1 = ""; |
1429 | cur1 = 0; |
1430 | } |
1431 | else { |
1432 | if (SvMAGICAL(str1)) |
1433 | mg_get(str1); |
1434 | if (!SvPOK(str1)) { |
1435 | (void)sv_2pv(str1); |
1436 | if (!SvPOK(str1)) |
1437 | str1 = &sv_no; |
1438 | } |
1439 | pv1 = SvPV(str1); |
1440 | cur1 = SvCUR(str1); |
1441 | } |
1442 | |
1443 | if (!str2) { |
1444 | pv2 = ""; |
1445 | cur2 = 0; |
1446 | } |
1447 | else { |
1448 | if (SvMAGICAL(str2)) |
1449 | mg_get(str2); |
1450 | if (!SvPOK(str2)) { |
1451 | (void)sv_2pv(str2); |
1452 | if (!SvPOK(str2)) |
1453 | str2 = &sv_no; |
1454 | } |
1455 | pv2 = SvPV(str2); |
1456 | cur2 = SvCUR(str2); |
1457 | } |
1458 | |
1459 | if (!cur1) |
1460 | return cur2 ? -1 : 0; |
1461 | if (!cur2) |
1462 | return 1; |
1463 | |
1464 | if (cur1 < cur2) { |
1465 | /*SUPPRESS 560*/ |
1466 | if (retval = memcmp(pv1, pv2, cur1)) |
1467 | return retval < 0 ? -1 : 1; |
1468 | else |
1469 | return -1; |
1470 | } |
1471 | /*SUPPRESS 560*/ |
1472 | else if (retval = memcmp(pv1, pv2, cur2)) |
1473 | return retval < 0 ? -1 : 1; |
1474 | else if (cur1 == cur2) |
1475 | return 0; |
1476 | else |
1477 | return 1; |
1478 | } |
1479 | |
1480 | char * |
1481 | sv_gets(sv,fp,append) |
1482 | register SV *sv; |
1483 | register FILE *fp; |
1484 | I32 append; |
1485 | { |
1486 | register char *bp; /* we're going to steal some values */ |
1487 | register I32 cnt; /* from the stdio struct and put EVERYTHING */ |
1488 | register STDCHAR *ptr; /* in the innermost loop into registers */ |
1489 | register I32 newline = rschar;/* (assuming >= 6 registers) */ |
1490 | I32 i; |
1491 | STRLEN bpx; |
1492 | I32 shortbuffered; |
1493 | |
1494 | if (SvREADONLY(sv)) |
1495 | fatal(no_modify); |
1496 | if (!SvUPGRADE(sv, SVt_PV)) |
1497 | return; |
1498 | if (rspara) { /* have to do this both before and after */ |
1499 | do { /* to make sure file boundaries work right */ |
1500 | i = getc(fp); |
1501 | if (i != '\n') { |
1502 | ungetc(i,fp); |
1503 | break; |
1504 | } |
1505 | } while (i != EOF); |
1506 | } |
1507 | #ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */ |
1508 | cnt = fp->_cnt; /* get count into register */ |
1509 | SvPOK_only(sv); /* validate pointer */ |
1510 | if (SvLEN(sv) - append <= cnt + 1) { /* make sure we have the room */ |
1511 | if (cnt > 80 && SvLEN(sv) > append) { |
1512 | shortbuffered = cnt - SvLEN(sv) + append + 1; |
1513 | cnt -= shortbuffered; |
1514 | } |
1515 | else { |
1516 | shortbuffered = 0; |
1517 | SvGROW(sv, append+cnt+2);/* (remembering cnt can be -1) */ |
1518 | } |
1519 | } |
1520 | else |
1521 | shortbuffered = 0; |
1522 | bp = SvPV(sv) + append; /* move these two too to registers */ |
1523 | ptr = fp->_ptr; |
1524 | for (;;) { |
1525 | screamer: |
93a17b20 |
1526 | if (cnt > 0) { |
1527 | while (--cnt >= 0) { /* this */ /* eat */ |
1528 | if ((*bp++ = *ptr++) == newline) /* really */ /* dust */ |
1529 | goto thats_all_folks; /* screams */ /* sed :-) */ |
1530 | } |
79072805 |
1531 | } |
1532 | |
1533 | if (shortbuffered) { /* oh well, must extend */ |
1534 | cnt = shortbuffered; |
1535 | shortbuffered = 0; |
1536 | bpx = bp - SvPV(sv); /* prepare for possible relocation */ |
1537 | SvCUR_set(sv, bpx); |
1538 | SvGROW(sv, SvLEN(sv) + append + cnt + 2); |
1539 | bp = SvPV(sv) + bpx; /* reconstitute our pointer */ |
1540 | continue; |
1541 | } |
1542 | |
1543 | fp->_cnt = cnt; /* deregisterize cnt and ptr */ |
1544 | fp->_ptr = ptr; |
1545 | i = _filbuf(fp); /* get more characters */ |
1546 | cnt = fp->_cnt; |
1547 | ptr = fp->_ptr; /* reregisterize cnt and ptr */ |
1548 | |
1549 | bpx = bp - SvPV(sv); /* prepare for possible relocation */ |
1550 | SvCUR_set(sv, bpx); |
1551 | SvGROW(sv, bpx + cnt + 2); |
1552 | bp = SvPV(sv) + bpx; /* reconstitute our pointer */ |
1553 | |
1554 | if (i == newline) { /* all done for now? */ |
1555 | *bp++ = i; |
1556 | goto thats_all_folks; |
1557 | } |
1558 | else if (i == EOF) /* all done for ever? */ |
1559 | goto thats_really_all_folks; |
1560 | *bp++ = i; /* now go back to screaming loop */ |
1561 | } |
1562 | |
1563 | thats_all_folks: |
1564 | if (rslen > 1 && (bp - SvPV(sv) < rslen || bcmp(bp - rslen, rs, rslen))) |
1565 | goto screamer; /* go back to the fray */ |
1566 | thats_really_all_folks: |
1567 | if (shortbuffered) |
1568 | cnt += shortbuffered; |
1569 | fp->_cnt = cnt; /* put these back or we're in trouble */ |
1570 | fp->_ptr = ptr; |
1571 | *bp = '\0'; |
1572 | SvCUR_set(sv, bp - SvPV(sv)); /* set length */ |
1573 | |
1574 | #else /* !STDSTDIO */ /* The big, slow, and stupid way */ |
1575 | |
1576 | { |
1577 | char buf[8192]; |
1578 | register char * bpe = buf + sizeof(buf) - 3; |
1579 | |
1580 | screamer: |
1581 | bp = buf; |
1582 | while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe) ; |
1583 | |
1584 | if (append) |
1585 | sv_catpvn(sv, buf, bp - buf); |
1586 | else |
1587 | sv_setpvn(sv, buf, bp - buf); |
1588 | if (i != EOF /* joy */ |
1589 | && |
1590 | (i != newline |
1591 | || |
1592 | (rslen > 1 |
1593 | && |
1594 | (SvCUR(sv) < rslen |
1595 | || |
1596 | bcmp(SvPV(sv) + SvCUR(sv) - rslen, rs, rslen) |
1597 | ) |
1598 | ) |
1599 | ) |
1600 | ) |
1601 | { |
1602 | append = -1; |
1603 | goto screamer; |
1604 | } |
1605 | } |
1606 | |
1607 | #endif /* STDSTDIO */ |
1608 | |
1609 | if (rspara) { |
1610 | while (i != EOF) { |
1611 | i = getc(fp); |
1612 | if (i != '\n') { |
1613 | ungetc(i,fp); |
1614 | break; |
1615 | } |
1616 | } |
1617 | } |
1618 | return SvCUR(sv) - append ? SvPV(sv) : Nullch; |
1619 | } |
1620 | |
1621 | void |
1622 | sv_inc(sv) |
1623 | register SV *sv; |
1624 | { |
1625 | register char *d; |
1626 | |
1627 | if (!sv) |
1628 | return; |
1629 | if (SvREADONLY(sv)) |
1630 | fatal(no_modify); |
1631 | if (SvMAGICAL(sv)) |
1632 | mg_get(sv); |
1633 | if (SvIOK(sv)) { |
1634 | ++SvIV(sv); |
1635 | SvIOK_only(sv); |
1636 | return; |
1637 | } |
1638 | if (SvNOK(sv)) { |
1639 | SvNV(sv) += 1.0; |
1640 | SvNOK_only(sv); |
1641 | return; |
1642 | } |
1643 | if (!SvPOK(sv) || !*SvPV(sv)) { |
1644 | if (!SvUPGRADE(sv, SVt_NV)) |
1645 | return; |
1646 | SvNV(sv) = 1.0; |
1647 | SvNOK_only(sv); |
1648 | return; |
1649 | } |
1650 | d = SvPV(sv); |
1651 | while (isALPHA(*d)) d++; |
1652 | while (isDIGIT(*d)) d++; |
1653 | if (*d) { |
1654 | sv_setnv(sv,atof(SvPV(sv)) + 1.0); /* punt */ |
1655 | return; |
1656 | } |
1657 | d--; |
1658 | while (d >= SvPV(sv)) { |
1659 | if (isDIGIT(*d)) { |
1660 | if (++*d <= '9') |
1661 | return; |
1662 | *(d--) = '0'; |
1663 | } |
1664 | else { |
1665 | ++*d; |
1666 | if (isALPHA(*d)) |
1667 | return; |
1668 | *(d--) -= 'z' - 'a' + 1; |
1669 | } |
1670 | } |
1671 | /* oh,oh, the number grew */ |
1672 | SvGROW(sv, SvCUR(sv) + 2); |
1673 | SvCUR(sv)++; |
1674 | for (d = SvPV(sv) + SvCUR(sv); d > SvPV(sv); d--) |
1675 | *d = d[-1]; |
1676 | if (isDIGIT(d[1])) |
1677 | *d = '1'; |
1678 | else |
1679 | *d = d[1]; |
1680 | } |
1681 | |
1682 | void |
1683 | sv_dec(sv) |
1684 | register SV *sv; |
1685 | { |
1686 | if (!sv) |
1687 | return; |
1688 | if (SvREADONLY(sv)) |
1689 | fatal(no_modify); |
1690 | if (SvMAGICAL(sv)) |
1691 | mg_get(sv); |
1692 | if (SvIOK(sv)) { |
1693 | --SvIV(sv); |
1694 | SvIOK_only(sv); |
1695 | return; |
1696 | } |
1697 | if (SvNOK(sv)) { |
1698 | SvNV(sv) -= 1.0; |
1699 | SvNOK_only(sv); |
1700 | return; |
1701 | } |
1702 | if (!SvPOK(sv)) { |
1703 | if (!SvUPGRADE(sv, SVt_NV)) |
1704 | return; |
1705 | SvNV(sv) = -1.0; |
1706 | SvNOK_only(sv); |
1707 | return; |
1708 | } |
1709 | sv_setnv(sv,atof(SvPV(sv)) - 1.0); |
1710 | } |
1711 | |
1712 | /* Make a string that will exist for the duration of the expression |
1713 | * evaluation. Actually, it may have to last longer than that, but |
1714 | * hopefully we won't free it until it has been assigned to a |
1715 | * permanent location. */ |
1716 | |
1717 | SV * |
1718 | sv_mortalcopy(oldstr) |
1719 | SV *oldstr; |
1720 | { |
1721 | register SV *sv = NEWSV(78,0); |
1722 | |
1723 | sv_setsv(sv,oldstr); |
1724 | if (++tmps_ix > tmps_max) { |
1725 | tmps_max = tmps_ix; |
1726 | if (!(tmps_max & 127)) { |
1727 | if (tmps_max) |
1728 | Renew(tmps_stack, tmps_max + 128, SV*); |
1729 | else |
1730 | New(702,tmps_stack, 128, SV*); |
1731 | } |
1732 | } |
1733 | tmps_stack[tmps_ix] = sv; |
1734 | if (SvPOK(sv)) |
1735 | SvTEMP_on(sv); |
1736 | return sv; |
1737 | } |
1738 | |
1739 | /* same thing without the copying */ |
1740 | |
1741 | SV * |
1742 | sv_2mortal(sv) |
1743 | register SV *sv; |
1744 | { |
1745 | if (!sv) |
1746 | return sv; |
1747 | if (SvREADONLY(sv)) |
1748 | fatal(no_modify); |
1749 | if (++tmps_ix > tmps_max) { |
1750 | tmps_max = tmps_ix; |
1751 | if (!(tmps_max & 127)) { |
1752 | if (tmps_max) |
1753 | Renew(tmps_stack, tmps_max + 128, SV*); |
1754 | else |
1755 | New(704,tmps_stack, 128, SV*); |
1756 | } |
1757 | } |
1758 | tmps_stack[tmps_ix] = sv; |
1759 | if (SvPOK(sv)) |
1760 | SvTEMP_on(sv); |
1761 | return sv; |
1762 | } |
1763 | |
1764 | SV * |
1765 | newSVpv(s,len) |
1766 | char *s; |
1767 | STRLEN len; |
1768 | { |
1769 | register SV *sv = NEWSV(79,0); |
1770 | |
1771 | if (!len) |
1772 | len = strlen(s); |
1773 | sv_setpvn(sv,s,len); |
1774 | return sv; |
1775 | } |
1776 | |
1777 | SV * |
1778 | newSVnv(n) |
1779 | double n; |
1780 | { |
1781 | register SV *sv = NEWSV(80,0); |
1782 | |
1783 | sv_setnv(sv,n); |
1784 | return sv; |
1785 | } |
1786 | |
1787 | SV * |
1788 | newSViv(i) |
1789 | I32 i; |
1790 | { |
1791 | register SV *sv = NEWSV(80,0); |
1792 | |
1793 | sv_setiv(sv,i); |
1794 | return sv; |
1795 | } |
1796 | |
1797 | /* make an exact duplicate of old */ |
1798 | |
1799 | SV * |
1800 | newSVsv(old) |
1801 | register SV *old; |
1802 | { |
1803 | register SV *new; |
1804 | |
1805 | if (!old) |
1806 | return Nullsv; |
1807 | if (SvTYPE(old) == 0xff) { |
1808 | warn("semi-panic: attempt to dup freed string"); |
1809 | return Nullsv; |
1810 | } |
1811 | new = NEWSV(80,0); |
1812 | if (SvTEMP(old)) { |
1813 | SvTEMP_off(old); |
1814 | sv_setsv(new,old); |
1815 | SvTEMP_on(old); |
1816 | } |
1817 | else |
1818 | sv_setsv(new,old); |
1819 | return new; |
1820 | } |
1821 | |
1822 | void |
1823 | sv_reset(s,stash) |
1824 | register char *s; |
1825 | HV *stash; |
1826 | { |
1827 | register HE *entry; |
1828 | register GV *gv; |
1829 | register SV *sv; |
1830 | register I32 i; |
1831 | register PMOP *pm; |
1832 | register I32 max; |
1833 | |
1834 | if (!*s) { /* reset ?? searches */ |
1835 | for (pm = HvPMROOT(stash); pm; pm = pm->op_pmnext) { |
1836 | pm->op_pmflags &= ~PMf_USED; |
1837 | } |
1838 | return; |
1839 | } |
1840 | |
1841 | /* reset variables */ |
1842 | |
1843 | if (!HvARRAY(stash)) |
1844 | return; |
1845 | while (*s) { |
1846 | i = *s; |
1847 | if (s[1] == '-') { |
1848 | s += 2; |
1849 | } |
1850 | max = *s++; |
1851 | for ( ; i <= max; i++) { |
1852 | for (entry = HvARRAY(stash)[i]; |
1853 | entry; |
1854 | entry = entry->hent_next) { |
1855 | gv = (GV*)entry->hent_val; |
1856 | sv = GvSV(gv); |
1857 | SvOK_off(sv); |
1858 | if (SvTYPE(sv) >= SVt_PV) { |
1859 | SvCUR_set(sv, 0); |
1860 | SvTDOWN(sv); |
1861 | if (SvPV(sv) != Nullch) |
1862 | *SvPV(sv) = '\0'; |
1863 | } |
1864 | if (GvAV(gv)) { |
1865 | av_clear(GvAV(gv)); |
1866 | } |
1867 | if (GvHV(gv)) { |
1868 | hv_clear(GvHV(gv), FALSE); |
1869 | if (gv == envgv) |
1870 | environ[0] = Nullch; |
1871 | } |
1872 | } |
1873 | } |
1874 | } |
1875 | } |
1876 | |
1877 | #ifdef OLD |
1878 | AV * |
1879 | sv_2av(sv, st, gvp, lref) |
1880 | SV *sv; |
1881 | HV **st; |
1882 | GV **gvp; |
1883 | I32 lref; |
1884 | { |
1885 | GV *gv; |
1886 | |
1887 | switch (SvTYPE(sv)) { |
1888 | case SVt_PVAV: |
1889 | *st = sv->sv_u.sv_stash; |
1890 | *gvp = Nullgv; |
1891 | return sv->sv_u.sv_av; |
1892 | case SVt_PVHV: |
1893 | case SVt_PVCV: |
1894 | *gvp = Nullgv; |
1895 | return Nullav; |
1896 | default: |
1897 | if (isGV(sv)) |
1898 | gv = (GV*)sv; |
1899 | else |
1900 | gv = gv_fetchpv(SvPVn(sv), lref); |
1901 | *gvp = gv; |
1902 | if (!gv) |
1903 | return Nullav; |
1904 | *st = GvESTASH(gv); |
1905 | if (lref) |
1906 | return GvAVn(gv); |
1907 | else |
1908 | return GvAV(gv); |
1909 | } |
1910 | } |
1911 | |
1912 | HV * |
1913 | sv_2hv(sv, st, gvp, lref) |
1914 | SV *sv; |
1915 | HV **st; |
1916 | GV **gvp; |
1917 | I32 lref; |
1918 | { |
1919 | GV *gv; |
1920 | |
1921 | switch (SvTYPE(sv)) { |
1922 | case SVt_PVHV: |
1923 | *st = sv->sv_u.sv_stash; |
1924 | *gvp = Nullgv; |
1925 | return sv->sv_u.sv_hv; |
1926 | case SVt_PVAV: |
1927 | case SVt_PVCV: |
1928 | *gvp = Nullgv; |
1929 | return Nullhv; |
1930 | default: |
1931 | if (isGV(sv)) |
1932 | gv = (GV*)sv; |
1933 | else |
1934 | gv = gv_fetchpv(SvPVn(sv), lref); |
1935 | *gvp = gv; |
1936 | if (!gv) |
1937 | return Nullhv; |
1938 | *st = GvESTASH(gv); |
1939 | if (lref) |
1940 | return GvHVn(gv); |
1941 | else |
1942 | return GvHV(gv); |
1943 | } |
1944 | } |
1945 | #endif; |
1946 | |
1947 | CV * |
1948 | sv_2cv(sv, st, gvp, lref) |
1949 | SV *sv; |
1950 | HV **st; |
1951 | GV **gvp; |
1952 | I32 lref; |
1953 | { |
1954 | GV *gv; |
1955 | CV *cv; |
1956 | |
1957 | if (!sv) |
93a17b20 |
1958 | return *gvp = Nullgv, Nullcv; |
79072805 |
1959 | switch (SvTYPE(sv)) { |
1960 | case SVt_REF: |
1961 | cv = (CV*)SvANY(sv); |
1962 | if (SvTYPE(cv) != SVt_PVCV) |
1963 | fatal("Not a subroutine reference"); |
1964 | *gvp = Nullgv; |
1965 | *st = CvSTASH(cv); |
1966 | return cv; |
1967 | case SVt_PVCV: |
1968 | *st = CvSTASH(sv); |
1969 | *gvp = Nullgv; |
1970 | return (CV*)sv; |
1971 | case SVt_PVHV: |
1972 | case SVt_PVAV: |
1973 | *gvp = Nullgv; |
1974 | return Nullcv; |
1975 | default: |
1976 | if (isGV(sv)) |
1977 | gv = (GV*)sv; |
1978 | else |
1979 | gv = gv_fetchpv(SvPVn(sv), lref); |
1980 | *gvp = gv; |
1981 | if (!gv) |
1982 | return Nullcv; |
1983 | *st = GvESTASH(gv); |
1984 | return GvCV(gv); |
1985 | } |
1986 | } |
1987 | |
1988 | #ifndef SvTRUE |
1989 | I32 |
1990 | SvTRUE(sv) |
1991 | register SV *sv; |
1992 | { |
1993 | if (SvMAGICAL(sv)) |
1994 | mg_get(sv); |
1995 | if (SvPOK(sv)) { |
1996 | register XPV* Xpv; |
1997 | if ((Xpv = (XPV*)SvANY(sv)) && |
1998 | (*Xpv->xpv_pv > '0' || |
1999 | Xpv->xpv_cur > 1 || |
2000 | (Xpv->xpv_cur && *Xpv->xpv_pv != '0'))) |
2001 | return 1; |
2002 | else |
2003 | return 0; |
2004 | } |
2005 | else { |
2006 | if (SvIOK(sv)) |
2007 | return SvIV(sv) != 0; |
2008 | else { |
2009 | if (SvNOK(sv)) |
2010 | return SvNV(sv) != 0.0; |
2011 | else |
2012 | return 0; |
2013 | } |
2014 | } |
2015 | } |
2016 | #endif /* SvTRUE */ |
2017 | |
2018 | #ifndef SvNVn |
2019 | double SvNVn(Sv) |
2020 | register SV *Sv; |
2021 | { |
2022 | SvTUP(Sv); |
2023 | if (SvMAGICAL(sv)) |
2024 | mg_get(sv); |
2025 | if (SvNOK(Sv)) |
2026 | return SvNV(Sv); |
2027 | if (SvIOK(Sv)) |
2028 | return (double)SvIV(Sv); |
2029 | return sv_2nv(Sv); |
2030 | } |
2031 | #endif /* SvNVn */ |
2032 | |
2033 | #ifndef SvPVn |
2034 | char * |
2035 | SvPVn(sv) |
2036 | SV *sv; |
2037 | { |
2038 | SvTUP(sv); |
2039 | if (SvMAGICAL(sv)) |
2040 | mg_get(sv); |
2041 | return SvPOK(sv) ? SvPV(sv) : sv_2pv(sv); |
2042 | } |
2043 | #endif |
2044 | |