This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_05: pod/perlvar.pod
[perl5.git] / pp.c
CommitLineData
a0d0e21e 1/* pp.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, Larry Wall
79072805 4 *
a0d0e21e
LW
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.
79072805 7 *
a0d0e21e
LW
8 */
9
10/*
11 * "It's a big house this, and very peculiar. Always a bit more to discover,
12 * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise
13 */
79072805
LW
14
15#include "EXTERN.h"
16#include "perl.h"
17
a0d0e21e 18static void doencodes _((SV *sv, char *s, I32 len));
79072805 19
a0d0e21e 20/* variations on pp_null */
79072805 21
93a17b20
LW
22PP(pp_stub)
23{
24 dSP;
25 if (GIMME != G_ARRAY) {
26 XPUSHs(&sv_undef);
27 }
28 RETURN;
29}
30
79072805
LW
31PP(pp_scalar)
32{
33 return NORMAL;
34}
35
36/* Pushy stuff. */
37
93a17b20
LW
38PP(pp_padav)
39{
40 dSP; dTARGET;
a0d0e21e 41 if (op->op_private & OPpLVAL_INTRO)
8990e307 42 SAVECLEARSV(curpad[op->op_targ]);
85e6fe83 43 EXTEND(SP, 1);
a0d0e21e 44 if (op->op_flags & OPf_REF) {
85e6fe83 45 PUSHs(TARG);
93a17b20 46 RETURN;
85e6fe83
LW
47 }
48 if (GIMME == G_ARRAY) {
49 I32 maxarg = AvFILL((AV*)TARG) + 1;
50 EXTEND(SP, maxarg);
51 Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
52 SP += maxarg;
53 }
54 else {
55 SV* sv = sv_newmortal();
56 I32 maxarg = AvFILL((AV*)TARG) + 1;
57 sv_setiv(sv, maxarg);
58 PUSHs(sv);
59 }
60 RETURN;
93a17b20
LW
61}
62
63PP(pp_padhv)
64{
65 dSP; dTARGET;
66 XPUSHs(TARG);
a0d0e21e 67 if (op->op_private & OPpLVAL_INTRO)
8990e307 68 SAVECLEARSV(curpad[op->op_targ]);
a0d0e21e 69 if (op->op_flags & OPf_REF)
93a17b20 70 RETURN;
85e6fe83 71 if (GIMME == G_ARRAY) { /* array wanted */
a0d0e21e 72 RETURNOP(do_kv(ARGS));
85e6fe83
LW
73 }
74 else {
75 SV* sv = sv_newmortal();
76 if (HvFILL((HV*)TARG)) {
77 sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
78 sv_setpv(sv, buf);
79 }
80 else
81 sv_setiv(sv, 0);
82 SETs(sv);
83 RETURN;
84 }
93a17b20
LW
85}
86
ed6116ce
LW
87PP(pp_padany)
88{
89 DIE("NOT IMPL LINE %d",__LINE__);
90}
91
79072805
LW
92/* Translations. */
93
94PP(pp_rv2gv)
95{
96 dSP; dTOPss;
a0d0e21e 97
ed6116ce 98 if (SvROK(sv)) {
a0d0e21e 99 wasref:
ed6116ce 100 sv = SvRV(sv);
b1dadf13
PP
101 if (SvTYPE(sv) == SVt_PVIO) {
102 GV *gv = (GV*) sv_newmortal();
103 gv_init(gv, 0, "", 0, 0);
104 GvIOp(gv) = (IO *)sv;
105 SvREFCNT_inc(sv);
106 sv = (SV*) gv;
107 } else if (SvTYPE(sv) != SVt_PVGV)
a0d0e21e 108 DIE("Not a GLOB reference");
79072805
LW
109 }
110 else {
93a17b20 111 if (SvTYPE(sv) != SVt_PVGV) {
748a9306
LW
112 char *sym;
113
a0d0e21e
LW
114 if (SvGMAGICAL(sv)) {
115 mg_get(sv);
116 if (SvROK(sv))
117 goto wasref;
118 }
119 if (!SvOK(sv)) {
120 if (op->op_flags & OPf_REF ||
121 op->op_private & HINT_STRICT_REFS)
122 DIE(no_usym, "a symbol");
123 RETSETUNDEF;
124 }
748a9306 125 sym = SvPV(sv, na);
85e6fe83 126 if (op->op_private & HINT_STRICT_REFS)
748a9306
LW
127 DIE(no_symref, sym, "a symbol");
128 sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
93a17b20 129 }
79072805 130 }
a0d0e21e 131 if (op->op_private & OPpLVAL_INTRO) {
79072805
LW
132 GP *ogp = GvGP(sv);
133
134 SSCHECK(3);
4633a7c4 135 SSPUSHPTR(SvREFCNT_inc(sv));
79072805
LW
136 SSPUSHPTR(ogp);
137 SSPUSHINT(SAVEt_GP);
138
a0d0e21e 139 if (op->op_flags & OPf_SPECIAL) {
79072805 140 GvGP(sv)->gp_refcnt++; /* will soon be assigned */
a5f75d66 141 GvINTRO_on(sv);
a0d0e21e 142 }
79072805
LW
143 else {
144 GP *gp;
145 Newz(602,gp, 1, GP);
146 GvGP(sv) = gp;
147 GvREFCNT(sv) = 1;
148 GvSV(sv) = NEWSV(72,0);
149 GvLINE(sv) = curcop->cop_line;
f12c7020 150 GvEGV(sv) = (GV*)sv;
79072805
LW
151 }
152 }
153 SETs(sv);
154 RETURN;
155}
156
79072805
LW
157PP(pp_rv2sv)
158{
159 dSP; dTOPss;
160
ed6116ce 161 if (SvROK(sv)) {
a0d0e21e 162 wasref:
ed6116ce 163 sv = SvRV(sv);
79072805
LW
164 switch (SvTYPE(sv)) {
165 case SVt_PVAV:
166 case SVt_PVHV:
167 case SVt_PVCV:
a0d0e21e 168 DIE("Not a SCALAR reference");
79072805
LW
169 }
170 }
171 else {
f12c7020 172 GV *gv = (GV*)sv;
748a9306
LW
173 char *sym;
174
463ee0b2 175 if (SvTYPE(gv) != SVt_PVGV) {
a0d0e21e
LW
176 if (SvGMAGICAL(sv)) {
177 mg_get(sv);
178 if (SvROK(sv))
179 goto wasref;
180 }
181 if (!SvOK(sv)) {
182 if (op->op_flags & OPf_REF ||
183 op->op_private & HINT_STRICT_REFS)
184 DIE(no_usym, "a SCALAR");
185 RETSETUNDEF;
186 }
748a9306 187 sym = SvPV(sv, na);
85e6fe83 188 if (op->op_private & HINT_STRICT_REFS)
748a9306 189 DIE(no_symref, sym, "a SCALAR");
f12c7020 190 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
463ee0b2
LW
191 }
192 sv = GvSV(gv);
a0d0e21e
LW
193 }
194 if (op->op_flags & OPf_MOD) {
195 if (op->op_private & OPpLVAL_INTRO)
196 sv = save_scalar((GV*)TOPs);
464e2e8a
PP
197 else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
198 provide_ref(op, sv);
79072805 199 }
a0d0e21e 200 SETs(sv);
79072805
LW
201 RETURN;
202}
203
204PP(pp_av2arylen)
205{
206 dSP;
207 AV *av = (AV*)TOPs;
208 SV *sv = AvARYLEN(av);
209 if (!sv) {
210 AvARYLEN(av) = sv = NEWSV(0,0);
211 sv_upgrade(sv, SVt_IV);
212 sv_magic(sv, (SV*)av, '#', Nullch, 0);
213 }
214 SETs(sv);
215 RETURN;
216}
217
a0d0e21e
LW
218PP(pp_pos)
219{
220 dSP; dTARGET; dPOPss;
221
222 if (op->op_flags & OPf_MOD) {
223 LvTYPE(TARG) = '<';
224 LvTARG(TARG) = sv;
225 PUSHs(TARG); /* no SvSETMAGIC */
226 RETURN;
227 }
228 else {
229 MAGIC* mg;
230
231 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
232 mg = mg_find(sv, 'g');
233 if (mg && mg->mg_len >= 0) {
234 PUSHi(mg->mg_len + curcop->cop_arybase);
235 RETURN;
236 }
237 }
238 RETPUSHUNDEF;
239 }
240}
241
79072805
LW
242PP(pp_rv2cv)
243{
244 dSP;
79072805
LW
245 GV *gv;
246 HV *stash;
8990e307 247
4633a7c4
LW
248 /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
249 /* (But not in defined().) */
250 CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
79072805 251
4633a7c4
LW
252 if (!cv)
253 cv = (CV*)&sv_undef;
79072805
LW
254 SETs((SV*)cv);
255 RETURN;
256}
257
c07a80fd
PP
258PP(pp_prototype)
259{
260 dSP;
261 CV *cv;
262 HV *stash;
263 GV *gv;
264 SV *ret;
265
266 ret = &sv_undef;
267 cv = sv_2cv(TOPs, &stash, &gv, FALSE);
268 if (cv && SvPOK(cv)) {
269 char *p = SvPVX(cv);
270 ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
271 }
272 SETs(ret);
273 RETURN;
274}
275
a0d0e21e
LW
276PP(pp_anoncode)
277{
278 dSP;
748a9306
LW
279 CV* cv = (CV*)cSVOP->op_sv;
280 EXTEND(SP,1);
281
a5f75d66 282 if (CvCLONE(cv))
b355b4e0 283 cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
748a9306
LW
284
285 PUSHs((SV*)cv);
a0d0e21e
LW
286 RETURN;
287}
288
289PP(pp_srefgen)
79072805
LW
290{
291 dSP; dTOPss;
292 SV* rv;
8990e307 293 rv = sv_newmortal();
ed6116ce 294 sv_upgrade(rv, SVt_RV);
a0d0e21e
LW
295 if (SvPADTMP(sv))
296 sv = newSVsv(sv);
297 else {
298 SvTEMP_off(sv);
299 (void)SvREFCNT_inc(sv);
300 }
301 SvRV(rv) = sv;
ed6116ce 302 SvROK_on(rv);
79072805
LW
303 SETs(rv);
304 RETURN;
a0d0e21e
LW
305}
306
307PP(pp_refgen)
308{
309 dSP; dMARK;
310 SV* sv;
311 SV* rv;
312 if (GIMME != G_ARRAY) {
313 MARK[1] = *SP;
314 SP = MARK + 1;
315 }
316 while (MARK < SP) {
317 sv = *++MARK;
318 rv = sv_newmortal();
319 sv_upgrade(rv, SVt_RV);
320 if (SvPADTMP(sv))
321 sv = newSVsv(sv);
322 else {
323 SvTEMP_off(sv);
324 (void)SvREFCNT_inc(sv);
325 }
326 SvRV(rv) = sv;
327 SvROK_on(rv);
328 *MARK = rv;
329 }
330 RETURN;
79072805
LW
331}
332
333PP(pp_ref)
334{
463ee0b2
LW
335 dSP; dTARGET;
336 SV *sv;
79072805
LW
337 char *pv;
338
a0d0e21e 339 sv = POPs;
f12c7020
PP
340
341 if (sv && SvGMAGICAL(sv))
342 mg_get(sv);
343
a0d0e21e 344 if (!sv || !SvROK(sv))
4633a7c4 345 RETPUSHNO;
79072805 346
ed6116ce 347 sv = SvRV(sv);
a0d0e21e 348 pv = sv_reftype(sv,TRUE);
463ee0b2 349 PUSHp(pv, strlen(pv));
79072805
LW
350 RETURN;
351}
352
353PP(pp_bless)
354{
463ee0b2 355 dSP;
463ee0b2 356 HV *stash;
79072805 357
463ee0b2
LW
358 if (MAXARG == 1)
359 stash = curcop->cop_stash;
360 else
a0d0e21e
LW
361 stash = gv_stashsv(POPs, TRUE);
362
363 (void)sv_bless(TOPs, stash);
79072805
LW
364 RETURN;
365}
366
a0d0e21e 367/* Pattern matching */
79072805 368
a0d0e21e 369PP(pp_study)
79072805 370{
c07a80fd 371 dSP; dPOPss;
a0d0e21e
LW
372 register unsigned char *s;
373 register I32 pos;
374 register I32 ch;
375 register I32 *sfirst;
376 register I32 *snext;
377 I32 retval;
378 STRLEN len;
379
c07a80fd 380 s = (unsigned char*)(SvPV(sv, len));
a0d0e21e 381 pos = len;
c07a80fd
PP
382 if (sv == lastscream)
383 SvSCREAM_off(sv);
384 else {
385 if (lastscream) {
386 SvSCREAM_off(lastscream);
387 SvREFCNT_dec(lastscream);
388 }
389 lastscream = SvREFCNT_inc(sv);
390 }
a0d0e21e
LW
391 if (pos <= 0) {
392 retval = 0;
393 goto ret;
394 }
395 if (pos > maxscream) {
396 if (maxscream < 0) {
397 maxscream = pos + 80;
398 New(301, screamfirst, 256, I32);
399 New(302, screamnext, maxscream, I32);
79072805
LW
400 }
401 else {
a0d0e21e
LW
402 maxscream = pos + pos / 4;
403 Renew(screamnext, maxscream, I32);
79072805 404 }
79072805 405 }
a0d0e21e
LW
406
407 sfirst = screamfirst;
408 snext = screamnext;
409
410 if (!sfirst || !snext)
411 DIE("do_study: out of memory");
412
413 for (ch = 256; ch; --ch)
414 *sfirst++ = -1;
415 sfirst -= 256;
416
417 while (--pos >= 0) {
418 ch = s[pos];
419 if (sfirst[ch] >= 0)
420 snext[pos] = sfirst[ch] - pos;
421 else
422 snext[pos] = -pos;
423 sfirst[ch] = pos;
424
425 /* If there were any case insensitive searches, we must assume they
426 * all are. This speeds up insensitive searches much more than
427 * it slows down sensitive ones.
428 */
429 if (sawi)
430 sfirst[fold[ch]] = pos;
79072805
LW
431 }
432
c07a80fd 433 SvSCREAM_on(sv);
464e2e8a 434 sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
a0d0e21e
LW
435 retval = 1;
436 ret:
437 XPUSHs(sv_2mortal(newSViv((I32)retval)));
79072805
LW
438 RETURN;
439}
440
a0d0e21e 441PP(pp_trans)
79072805 442{
a0d0e21e
LW
443 dSP; dTARG;
444 SV *sv;
445
446 if (op->op_flags & OPf_STACKED)
447 sv = POPs;
79072805 448 else {
a0d0e21e
LW
449 sv = GvSV(defgv);
450 EXTEND(SP,1);
79072805 451 }
adbc6bb1 452 TARG = sv_newmortal();
a0d0e21e
LW
453 PUSHi(do_trans(sv, op));
454 RETURN;
79072805
LW
455}
456
a0d0e21e 457/* Lvalue operators. */
79072805 458
a0d0e21e
LW
459PP(pp_schop)
460{
461 dSP; dTARGET;
462 do_chop(TARG, TOPs);
463 SETTARG;
464 RETURN;
79072805
LW
465}
466
a0d0e21e 467PP(pp_chop)
79072805 468{
a0d0e21e
LW
469 dSP; dMARK; dTARGET;
470 while (SP > MARK)
471 do_chop(TARG, POPs);
472 PUSHTARG;
473 RETURN;
79072805
LW
474}
475
a0d0e21e 476PP(pp_schomp)
79072805 477{
a0d0e21e
LW
478 dSP; dTARGET;
479 SETi(do_chomp(TOPs));
480 RETURN;
79072805
LW
481}
482
a0d0e21e 483PP(pp_chomp)
79072805 484{
a0d0e21e
LW
485 dSP; dMARK; dTARGET;
486 register I32 count = 0;
487
488 while (SP > MARK)
489 count += do_chomp(POPs);
490 PUSHi(count);
491 RETURN;
79072805
LW
492}
493
a0d0e21e 494PP(pp_defined)
463ee0b2 495{
a0d0e21e
LW
496 dSP;
497 register SV* sv;
498
499 sv = POPs;
500 if (!sv || !SvANY(sv))
501 RETPUSHNO;
502 switch (SvTYPE(sv)) {
503 case SVt_PVAV:
8e07c86e 504 if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
a0d0e21e
LW
505 RETPUSHYES;
506 break;
507 case SVt_PVHV:
8e07c86e 508 if (HvARRAY(sv) || SvRMAGICAL(sv))
a0d0e21e
LW
509 RETPUSHYES;
510 break;
511 case SVt_PVCV:
512 if (CvROOT(sv) || CvXSUB(sv))
513 RETPUSHYES;
514 break;
515 default:
516 if (SvGMAGICAL(sv))
517 mg_get(sv);
518 if (SvOK(sv))
519 RETPUSHYES;
520 }
521 RETPUSHNO;
463ee0b2
LW
522}
523
a0d0e21e
LW
524PP(pp_undef)
525{
79072805 526 dSP;
a0d0e21e
LW
527 SV *sv;
528
529 if (!op->op_private)
530 RETPUSHUNDEF;
79072805 531
a0d0e21e
LW
532 sv = POPs;
533 if (!sv)
534 RETPUSHUNDEF;
85e6fe83 535
a0d0e21e
LW
536 if (SvTHINKFIRST(sv)) {
537 if (SvREADONLY(sv))
538 RETPUSHUNDEF;
539 if (SvROK(sv))
540 sv_unref(sv);
85e6fe83
LW
541 }
542
a0d0e21e
LW
543 switch (SvTYPE(sv)) {
544 case SVt_NULL:
545 break;
546 case SVt_PVAV:
547 av_undef((AV*)sv);
548 break;
549 case SVt_PVHV:
550 hv_undef((HV*)sv);
551 break;
552 case SVt_PVCV:
553 cv_undef((CV*)sv);
554 sub_generation++;
555 break;
8e07c86e
AD
556 case SVt_PVGV:
557 if (SvFAKE(sv)) {
558 sv_setsv(sv, &sv_undef);
559 break;
560 }
a0d0e21e 561 default:
4633a7c4
LW
562 if (SvPOK(sv) && SvLEN(sv)) {
563 (void)SvOOK_off(sv);
564 Safefree(SvPVX(sv));
565 SvPV_set(sv, Nullch);
566 SvLEN_set(sv, 0);
a0d0e21e 567 }
4633a7c4
LW
568 (void)SvOK_off(sv);
569 SvSETMAGIC(sv);
79072805 570 }
a0d0e21e
LW
571
572 RETPUSHUNDEF;
79072805
LW
573}
574
a0d0e21e 575PP(pp_predec)
79072805 576{
a0d0e21e 577 dSP;
748a9306 578 if (SvIOK(TOPs)) {
dedeecda 579 if (SvIVX(TOPs) == IV_MIN) {
760ac839
LW
580 sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
581 }
582 else {
583 --SvIVX(TOPs);
584 SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
585 }
748a9306
LW
586 }
587 else
588 sv_dec(TOPs);
a0d0e21e
LW
589 SvSETMAGIC(TOPs);
590 return NORMAL;
591}
79072805 592
a0d0e21e
LW
593PP(pp_postinc)
594{
595 dSP; dTARGET;
596 sv_setsv(TARG, TOPs);
748a9306 597 if (SvIOK(TOPs)) {
dedeecda 598 if (SvIVX(TOPs) == IV_MAX) {
760ac839
LW
599 sv_setnv(TOPs, (double)SvIVX(TOPs) + 1.0);
600 }
601 else {
602 ++SvIVX(TOPs);
603 SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
604 }
748a9306
LW
605 }
606 else
607 sv_inc(TOPs);
a0d0e21e
LW
608 SvSETMAGIC(TOPs);
609 if (!SvOK(TARG))
610 sv_setiv(TARG, 0);
611 SETs(TARG);
612 return NORMAL;
613}
79072805 614
a0d0e21e
LW
615PP(pp_postdec)
616{
617 dSP; dTARGET;
618 sv_setsv(TARG, TOPs);
748a9306 619 if (SvIOK(TOPs)) {
dedeecda 620 if (SvIVX(TOPs) == IV_MIN) {
760ac839
LW
621 sv_setnv(TOPs, (double)SvIVX(TOPs) - 1.0);
622 }
623 else {
624 --SvIVX(TOPs);
625 SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
626 }
748a9306
LW
627 }
628 else
629 sv_dec(TOPs);
a0d0e21e
LW
630 SvSETMAGIC(TOPs);
631 SETs(TARG);
632 return NORMAL;
633}
79072805 634
a0d0e21e
LW
635/* Ordinary operators. */
636
637PP(pp_pow)
638{
639 dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
640 {
641 dPOPTOPnnrl;
642 SETn( pow( left, right) );
643 RETURN;
93a17b20 644 }
a0d0e21e
LW
645}
646
647PP(pp_multiply)
648{
649 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
650 {
651 dPOPTOPnnrl;
652 SETn( left * right );
653 RETURN;
79072805 654 }
a0d0e21e
LW
655}
656
657PP(pp_divide)
658{
659 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
660 {
661 dPOPnv;
662 if (value == 0.0)
663 DIE("Illegal division by zero");
664#ifdef SLOPPYDIVIDE
665 /* insure that 20./5. == 4. */
666 {
667 double x;
668 I32 k;
669 x = POPn;
670 if ((double)I_32(x) == x &&
671 (double)I_32(value) == value &&
672 (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
673 value = k;
674 } else {
675 value = x/value;
79072805 676 }
a0d0e21e
LW
677 }
678#else
679 value = POPn / value;
680#endif
681 PUSHn( value );
682 RETURN;
79072805 683 }
a0d0e21e
LW
684}
685
686PP(pp_modulo)
687{
688 dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
689 {
690 register unsigned long tmpulong;
691 register long tmplong;
692 I32 value;
693
694 tmpulong = (unsigned long) POPn;
695 if (tmpulong == 0L)
696 DIE("Illegal modulus zero");
697 value = TOPn;
698 if (value >= 0.0)
699 value = (I32)(((unsigned long)value) % tmpulong);
700 else {
701 tmplong = (long)value;
702 value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
703 }
704 SETi(value);
705 RETURN;
79072805 706 }
a0d0e21e 707}
79072805 708
a0d0e21e
LW
709PP(pp_repeat)
710{
748a9306
LW
711 dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
712 {
a0d0e21e
LW
713 register I32 count = POPi;
714 if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
715 dMARK;
716 I32 items = SP - MARK;
717 I32 max;
79072805 718
a0d0e21e
LW
719 max = items * count;
720 MEXTEND(MARK, max);
721 if (count > 1) {
722 while (SP > MARK) {
723 if (*SP)
724 SvTEMP_off((*SP));
725 SP--;
79072805 726 }
a0d0e21e
LW
727 MARK++;
728 repeatcpy((char*)(MARK + items), (char*)MARK,
729 items * sizeof(SV*), count - 1);
730 SP += max;
79072805 731 }
a0d0e21e
LW
732 else if (count <= 0)
733 SP -= items;
79072805 734 }
a0d0e21e
LW
735 else { /* Note: mark already snarfed by pp_list */
736 SV *tmpstr;
737 STRLEN len;
738
739 tmpstr = POPs;
740 if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
741 if (SvREADONLY(tmpstr) && curcop != &compiling)
742 DIE("Can't x= to readonly value");
743 if (SvROK(tmpstr))
744 sv_unref(tmpstr);
93a17b20 745 }
a0d0e21e
LW
746 SvSetSV(TARG, tmpstr);
747 SvPV_force(TARG, len);
748 if (count >= 1) {
749 SvGROW(TARG, (count * len) + 1);
750 if (count > 1)
751 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
752 SvCUR(TARG) *= count;
753 *SvEND(TARG) = '\0';
754 (void)SvPOK_only(TARG);
755 }
756 else
757 sv_setsv(TARG, &sv_no);
758 PUSHTARG;
79072805 759 }
a0d0e21e 760 RETURN;
748a9306 761 }
a0d0e21e 762}
79072805 763
a0d0e21e
LW
764PP(pp_subtract)
765{
766 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
767 {
768 dPOPTOPnnrl;
769 SETn( left - right );
770 RETURN;
79072805 771 }
a0d0e21e 772}
79072805 773
a0d0e21e
LW
774PP(pp_left_shift)
775{
776 dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
777 {
748a9306
LW
778 dPOPTOPiirl;
779 SETi( left << right );
780 RETURN;
79072805 781 }
a0d0e21e 782}
79072805 783
a0d0e21e
LW
784PP(pp_right_shift)
785{
786 dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
787 {
788 dPOPTOPiirl;
789 SETi( left >> right );
790 RETURN;
93a17b20 791 }
79072805
LW
792}
793
a0d0e21e 794PP(pp_lt)
79072805 795{
a0d0e21e
LW
796 dSP; tryAMAGICbinSET(lt,0);
797 {
798 dPOPnv;
799 SETs((TOPn < value) ? &sv_yes : &sv_no);
800 RETURN;
79072805 801 }
a0d0e21e 802}
79072805 803
a0d0e21e
LW
804PP(pp_gt)
805{
806 dSP; tryAMAGICbinSET(gt,0);
807 {
808 dPOPnv;
809 SETs((TOPn > value) ? &sv_yes : &sv_no);
810 RETURN;
79072805 811 }
a0d0e21e
LW
812}
813
814PP(pp_le)
815{
816 dSP; tryAMAGICbinSET(le,0);
817 {
818 dPOPnv;
819 SETs((TOPn <= value) ? &sv_yes : &sv_no);
820 RETURN;
79072805 821 }
a0d0e21e
LW
822}
823
824PP(pp_ge)
825{
826 dSP; tryAMAGICbinSET(ge,0);
827 {
828 dPOPnv;
829 SETs((TOPn >= value) ? &sv_yes : &sv_no);
830 RETURN;
79072805 831 }
a0d0e21e 832}
79072805 833
a0d0e21e
LW
834PP(pp_ne)
835{
836 dSP; tryAMAGICbinSET(ne,0);
837 {
838 dPOPnv;
839 SETs((TOPn != value) ? &sv_yes : &sv_no);
840 RETURN;
841 }
79072805
LW
842}
843
a0d0e21e 844PP(pp_ncmp)
79072805 845{
a0d0e21e
LW
846 dSP; dTARGET; tryAMAGICbin(ncmp,0);
847 {
848 dPOPTOPnnrl;
849 I32 value;
79072805 850
a0d0e21e
LW
851 if (left > right)
852 value = 1;
853 else if (left < right)
854 value = -1;
855 else
856 value = 0;
857 SETi(value);
858 RETURN;
79072805 859 }
a0d0e21e 860}
79072805 861
a0d0e21e
LW
862PP(pp_slt)
863{
864 dSP; tryAMAGICbinSET(slt,0);
865 {
866 dPOPTOPssrl;
867 SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
868 RETURN;
869 }
79072805
LW
870}
871
a0d0e21e 872PP(pp_sgt)
79072805 873{
a0d0e21e
LW
874 dSP; tryAMAGICbinSET(sgt,0);
875 {
876 dPOPTOPssrl;
877 SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
878 RETURN;
879 }
880}
79072805 881
a0d0e21e
LW
882PP(pp_sle)
883{
884 dSP; tryAMAGICbinSET(sle,0);
885 {
886 dPOPTOPssrl;
887 SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
888 RETURN;
79072805 889 }
79072805
LW
890}
891
a0d0e21e
LW
892PP(pp_sge)
893{
894 dSP; tryAMAGICbinSET(sge,0);
895 {
896 dPOPTOPssrl;
897 SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
898 RETURN;
899 }
900}
79072805 901
a0d0e21e 902PP(pp_sne)
79072805 903{
a0d0e21e
LW
904 dSP; tryAMAGICbinSET(sne,0);
905 {
906 dPOPTOPssrl;
907 SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
908 RETURN;
463ee0b2 909 }
79072805
LW
910}
911
a0d0e21e 912PP(pp_scmp)
79072805 913{
a0d0e21e
LW
914 dSP; dTARGET; tryAMAGICbin(scmp,0);
915 {
916 dPOPTOPssrl;
917 SETi( sv_cmp(left, right) );
918 RETURN;
919 }
920}
79072805 921
a0d0e21e
LW
922PP(pp_bit_and) {
923 dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
924 {
925 dPOPTOPssrl;
4633a7c4 926 if (SvNIOKp(left) || SvNIOKp(right)) {
a0d0e21e
LW
927 unsigned long value = U_L(SvNV(left));
928 value = value & U_L(SvNV(right));
929 SETn((double)value);
930 }
931 else {
932 do_vop(op->op_type, TARG, left, right);
933 SETTARG;
934 }
935 RETURN;
936 }
937}
79072805 938
a0d0e21e
LW
939PP(pp_bit_xor)
940{
941 dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
942 {
943 dPOPTOPssrl;
4633a7c4 944 if (SvNIOKp(left) || SvNIOKp(right)) {
a0d0e21e
LW
945 unsigned long value = U_L(SvNV(left));
946 value = value ^ U_L(SvNV(right));
947 SETn((double)value);
948 }
949 else {
950 do_vop(op->op_type, TARG, left, right);
951 SETTARG;
952 }
953 RETURN;
954 }
955}
79072805 956
a0d0e21e
LW
957PP(pp_bit_or)
958{
959 dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
960 {
961 dPOPTOPssrl;
4633a7c4 962 if (SvNIOKp(left) || SvNIOKp(right)) {
a0d0e21e
LW
963 unsigned long value = U_L(SvNV(left));
964 value = value | U_L(SvNV(right));
965 SETn((double)value);
966 }
967 else {
968 do_vop(op->op_type, TARG, left, right);
969 SETTARG;
970 }
971 RETURN;
79072805 972 }
a0d0e21e 973}
79072805 974
a0d0e21e
LW
975PP(pp_negate)
976{
977 dSP; dTARGET; tryAMAGICun(neg);
978 {
979 dTOPss;
4633a7c4
LW
980 if (SvGMAGICAL(sv))
981 mg_get(sv);
982 if (SvNIOKp(sv))
a0d0e21e 983 SETn(-SvNV(sv));
4633a7c4 984 else if (SvPOKp(sv)) {
a0d0e21e
LW
985 STRLEN len;
986 char *s = SvPV(sv, len);
987 if (isALPHA(*s) || *s == '_') {
988 sv_setpvn(TARG, "-", 1);
989 sv_catsv(TARG, sv);
79072805 990 }
a0d0e21e
LW
991 else if (*s == '+' || *s == '-') {
992 sv_setsv(TARG, sv);
993 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
79072805
LW
994 }
995 else
a0d0e21e
LW
996 sv_setnv(TARG, -SvNV(sv));
997 SETTARG;
79072805 998 }
4633a7c4
LW
999 else
1000 SETn(-SvNV(sv));
79072805 1001 }
a0d0e21e 1002 RETURN;
79072805
LW
1003}
1004
a0d0e21e 1005PP(pp_not)
79072805 1006{
a0d0e21e
LW
1007#ifdef OVERLOAD
1008 dSP; tryAMAGICunSET(not);
1009#endif /* OVERLOAD */
1010 *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
1011 return NORMAL;
79072805
LW
1012}
1013
a0d0e21e 1014PP(pp_complement)
79072805 1015{
a0d0e21e
LW
1016 dSP; dTARGET; tryAMAGICun(compl);
1017 {
1018 dTOPss;
1019 register I32 anum;
1020
4633a7c4 1021 if (SvNIOKp(sv)) {
748a9306
LW
1022 IV iv = ~SvIV(sv);
1023 if (iv < 0)
1024 SETn( (double) ~U_L(SvNV(sv)) );
1025 else
1026 SETi( iv );
a0d0e21e
LW
1027 }
1028 else {
1029 register char *tmps;
1030 register long *tmpl;
1031 STRLEN len;
1032
1033 SvSetSV(TARG, sv);
1034 tmps = SvPV_force(TARG, len);
1035 anum = len;
1036#ifdef LIBERAL
1037 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1038 *tmps = ~*tmps;
1039 tmpl = (long*)tmps;
1040 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1041 *tmpl = ~*tmpl;
1042 tmps = (char*)tmpl;
1043#endif
1044 for ( ; anum > 0; anum--, tmps++)
1045 *tmps = ~*tmps;
1046
1047 SETs(TARG);
1048 }
1049 RETURN;
1050 }
79072805
LW
1051}
1052
a0d0e21e
LW
1053/* integer versions of some of the above */
1054
a0d0e21e 1055PP(pp_i_multiply)
79072805 1056{
a0d0e21e
LW
1057 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
1058 {
1059 dPOPTOPiirl;
1060 SETi( left * right );
1061 RETURN;
1062 }
79072805
LW
1063}
1064
a0d0e21e 1065PP(pp_i_divide)
79072805 1066{
a0d0e21e
LW
1067 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
1068 {
1069 dPOPiv;
1070 if (value == 0)
1071 DIE("Illegal division by zero");
1072 value = POPi / value;
1073 PUSHi( value );
1074 RETURN;
1075 }
79072805
LW
1076}
1077
a0d0e21e 1078PP(pp_i_modulo)
79072805 1079{
a0d0e21e 1080 dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
79072805 1081 {
a0d0e21e
LW
1082 dPOPTOPiirl;
1083 SETi( left % right );
1084 RETURN;
79072805 1085 }
79072805
LW
1086}
1087
a0d0e21e 1088PP(pp_i_add)
79072805 1089{
a0d0e21e
LW
1090 dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
1091 {
1092 dPOPTOPiirl;
1093 SETi( left + right );
1094 RETURN;
79072805 1095 }
79072805
LW
1096}
1097
a0d0e21e 1098PP(pp_i_subtract)
79072805 1099{
a0d0e21e
LW
1100 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
1101 {
1102 dPOPTOPiirl;
1103 SETi( left - right );
1104 RETURN;
79072805 1105 }
79072805
LW
1106}
1107
a0d0e21e 1108PP(pp_i_lt)
79072805 1109{
a0d0e21e
LW
1110 dSP; tryAMAGICbinSET(lt,0);
1111 {
1112 dPOPTOPiirl;
1113 SETs((left < right) ? &sv_yes : &sv_no);
1114 RETURN;
1115 }
79072805
LW
1116}
1117
a0d0e21e 1118PP(pp_i_gt)
79072805 1119{
a0d0e21e
LW
1120 dSP; tryAMAGICbinSET(gt,0);
1121 {
1122 dPOPTOPiirl;
1123 SETs((left > right) ? &sv_yes : &sv_no);
1124 RETURN;
1125 }
79072805
LW
1126}
1127
a0d0e21e 1128PP(pp_i_le)
79072805 1129{
a0d0e21e
LW
1130 dSP; tryAMAGICbinSET(le,0);
1131 {
1132 dPOPTOPiirl;
1133 SETs((left <= right) ? &sv_yes : &sv_no);
1134 RETURN;
85e6fe83 1135 }
79072805
LW
1136}
1137
a0d0e21e 1138PP(pp_i_ge)
79072805 1139{
a0d0e21e
LW
1140 dSP; tryAMAGICbinSET(ge,0);
1141 {
1142 dPOPTOPiirl;
1143 SETs((left >= right) ? &sv_yes : &sv_no);
1144 RETURN;
1145 }
79072805
LW
1146}
1147
a0d0e21e 1148PP(pp_i_eq)
79072805 1149{
a0d0e21e
LW
1150 dSP; tryAMAGICbinSET(eq,0);
1151 {
1152 dPOPTOPiirl;
1153 SETs((left == right) ? &sv_yes : &sv_no);
1154 RETURN;
1155 }
79072805
LW
1156}
1157
a0d0e21e 1158PP(pp_i_ne)
79072805 1159{
a0d0e21e
LW
1160 dSP; tryAMAGICbinSET(ne,0);
1161 {
1162 dPOPTOPiirl;
1163 SETs((left != right) ? &sv_yes : &sv_no);
1164 RETURN;
1165 }
79072805
LW
1166}
1167
a0d0e21e 1168PP(pp_i_ncmp)
79072805 1169{
a0d0e21e
LW
1170 dSP; dTARGET; tryAMAGICbin(ncmp,0);
1171 {
1172 dPOPTOPiirl;
1173 I32 value;
79072805 1174
a0d0e21e 1175 if (left > right)
79072805 1176 value = 1;
a0d0e21e 1177 else if (left < right)
79072805 1178 value = -1;
a0d0e21e 1179 else
79072805 1180 value = 0;
a0d0e21e
LW
1181 SETi(value);
1182 RETURN;
79072805 1183 }
85e6fe83
LW
1184}
1185
1186PP(pp_i_negate)
1187{
a0d0e21e 1188 dSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW
1189 SETi(-TOPi);
1190 RETURN;
1191}
1192
79072805
LW
1193/* High falutin' math. */
1194
1195PP(pp_atan2)
1196{
a0d0e21e
LW
1197 dSP; dTARGET; tryAMAGICbin(atan2,0);
1198 {
1199 dPOPTOPnnrl;
1200 SETn(atan2(left, right));
1201 RETURN;
1202 }
79072805
LW
1203}
1204
1205PP(pp_sin)
1206{
a0d0e21e
LW
1207 dSP; dTARGET; tryAMAGICun(sin);
1208 {
1209 double value;
1210 value = POPn;
1211 value = sin(value);
1212 XPUSHn(value);
1213 RETURN;
1214 }
79072805
LW
1215}
1216
1217PP(pp_cos)
1218{
a0d0e21e
LW
1219 dSP; dTARGET; tryAMAGICun(cos);
1220 {
1221 double value;
1222 value = POPn;
1223 value = cos(value);
1224 XPUSHn(value);
1225 RETURN;
1226 }
79072805
LW
1227}
1228
1229PP(pp_rand)
1230{
1231 dSP; dTARGET;
1232 double value;
1233 if (MAXARG < 1)
1234 value = 1.0;
1235 else
1236 value = POPn;
1237 if (value == 0.0)
1238 value = 1.0;
1239#if RANDBITS == 31
1240 value = rand() * value / 2147483648.0;
1241#else
1242#if RANDBITS == 16
1243 value = rand() * value / 65536.0;
1244#else
1245#if RANDBITS == 15
1246 value = rand() * value / 32768.0;
1247#else
1248 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1249#endif
1250#endif
1251#endif
1252 XPUSHn(value);
1253 RETURN;
1254}
1255
1256PP(pp_srand)
1257{
1258 dSP;
1259 I32 anum;
79072805
LW
1260
1261 if (MAXARG < 1) {
f12c7020
PP
1262#ifdef VMS
1263# include <starlet.h>
1264 unsigned int when[2];
1265 _ckvmssts(sys$gettim(when));
1266 anum = when[0] ^ when[1];
1267#else
1268# if defined(I_SYS_TIME) && !defined(PLAN9)
1269 struct timeval when;
1270 gettimeofday(&when,(struct timezone *) 0);
1271 anum = when.tv_sec ^ when.tv_usec;
1272# else
1273 Time_t when;
79072805
LW
1274 (void)time(&when);
1275 anum = when;
f12c7020
PP
1276# endif
1277#endif
1278#if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon */
1279 /* 17-Jul-1996 bailey@genetics.upenn.edu */
1280 /* What is a good hashing algorithm here? */
1281 anum ^= ( ( 269 * (U32)getpid())
1282 ^ (26107 * (U32)&when)
1283 ^ (73819 * (U32)stack_sp));
1284#endif
79072805
LW
1285 }
1286 else
1287 anum = POPi;
1288 (void)srand(anum);
1289 EXTEND(SP, 1);
1290 RETPUSHYES;
1291}
1292
1293PP(pp_exp)
1294{
a0d0e21e
LW
1295 dSP; dTARGET; tryAMAGICun(exp);
1296 {
1297 double value;
1298 value = POPn;
1299 value = exp(value);
1300 XPUSHn(value);
1301 RETURN;
1302 }
79072805
LW
1303}
1304
1305PP(pp_log)
1306{
a0d0e21e
LW
1307 dSP; dTARGET; tryAMAGICun(log);
1308 {
1309 double value;
1310 value = POPn;
1311 if (value <= 0.0)
2304df62 1312 DIE("Can't take log of %g", value);
a0d0e21e
LW
1313 value = log(value);
1314 XPUSHn(value);
1315 RETURN;
1316 }
79072805
LW
1317}
1318
1319PP(pp_sqrt)
1320{
a0d0e21e
LW
1321 dSP; dTARGET; tryAMAGICun(sqrt);
1322 {
1323 double value;
1324 value = POPn;
1325 if (value < 0.0)
2304df62 1326 DIE("Can't take sqrt of %g", value);
a0d0e21e
LW
1327 value = sqrt(value);
1328 XPUSHn(value);
1329 RETURN;
1330 }
79072805
LW
1331}
1332
1333PP(pp_int)
1334{
1335 dSP; dTARGET;
1336 double value;
a0d0e21e 1337 value = POPn;
79072805
LW
1338 if (value >= 0.0)
1339 (void)modf(value, &value);
1340 else {
1341 (void)modf(-value, &value);
1342 value = -value;
1343 }
1344 XPUSHn(value);
1345 RETURN;
1346}
1347
463ee0b2
LW
1348PP(pp_abs)
1349{
a0d0e21e
LW
1350 dSP; dTARGET; tryAMAGICun(abs);
1351 {
1352 double value;
1353 value = POPn;
463ee0b2 1354
a0d0e21e 1355 if (value < 0.0)
463ee0b2
LW
1356 value = -value;
1357
a0d0e21e
LW
1358 XPUSHn(value);
1359 RETURN;
1360 }
463ee0b2
LW
1361}
1362
79072805
LW
1363PP(pp_hex)
1364{
1365 dSP; dTARGET;
1366 char *tmps;
464e2e8a 1367 unsigned long value;
79072805
LW
1368 I32 argtype;
1369
a0d0e21e 1370 tmps = POPp;
464e2e8a
PP
1371 value = scan_hex(tmps, 99, &argtype);
1372 if ((IV)value >= 0)
1373 XPUSHi(value);
1374 else
1375 XPUSHn(U_V(value));
79072805
LW
1376 RETURN;
1377}
1378
1379PP(pp_oct)
1380{
1381 dSP; dTARGET;
464e2e8a 1382 unsigned long value;
79072805
LW
1383 I32 argtype;
1384 char *tmps;
1385
a0d0e21e 1386 tmps = POPp;
464e2e8a
PP
1387 while (*tmps && isSPACE(*tmps))
1388 tmps++;
1389 if (*tmps == '0')
79072805
LW
1390 tmps++;
1391 if (*tmps == 'x')
464e2e8a
PP
1392 value = scan_hex(++tmps, 99, &argtype);
1393 else
1394 value = scan_oct(tmps, 99, &argtype);
1395 if ((IV)value >= 0)
1396 XPUSHi(value);
79072805 1397 else
464e2e8a 1398 XPUSHn(U_V(value));
79072805
LW
1399 RETURN;
1400}
1401
1402/* String stuff. */
1403
1404PP(pp_length)
1405{
1406 dSP; dTARGET;
a0d0e21e 1407 SETi( sv_len(TOPs) );
79072805
LW
1408 RETURN;
1409}
1410
1411PP(pp_substr)
1412{
1413 dSP; dTARGET;
1414 SV *sv;
1415 I32 len;
463ee0b2 1416 STRLEN curlen;
79072805
LW
1417 I32 pos;
1418 I32 rem;
a0d0e21e 1419 I32 lvalue = op->op_flags & OPf_MOD;
79072805 1420 char *tmps;
a0d0e21e 1421 I32 arybase = curcop->cop_arybase;
79072805
LW
1422
1423 if (MAXARG > 2)
1424 len = POPi;
1425 pos = POPi - arybase;
1426 sv = POPs;
a0d0e21e 1427 tmps = SvPV(sv, curlen);
79072805
LW
1428 if (pos < 0)
1429 pos += curlen + arybase;
2304df62 1430 if (pos < 0 || pos > curlen) {
a0d0e21e 1431 if (dowarn || lvalue)
2304df62
AD
1432 warn("substr outside of string");
1433 RETPUSHUNDEF;
1434 }
79072805
LW
1435 else {
1436 if (MAXARG < 3)
1437 len = curlen;
a0d0e21e 1438 else if (len < 0) {
748a9306 1439 len += curlen - pos;
a0d0e21e
LW
1440 if (len < 0)
1441 len = 0;
1442 }
79072805
LW
1443 tmps += pos;
1444 rem = curlen - pos; /* rem=how many bytes left*/
1445 if (rem > len)
1446 rem = len;
1447 sv_setpvn(TARG, tmps, rem);
1448 if (lvalue) { /* it's an lvalue! */
dedeecda
PP
1449 if (!SvGMAGICAL(sv)) {
1450 if (SvROK(sv)) {
1451 SvPV_force(sv,na);
1452 if (dowarn)
1453 warn("Attempt to use reference as lvalue in substr");
1454 }
1455 if (SvOK(sv)) /* is it defined ? */
1456 (void)SvPOK_only(sv);
1457 else
1458 sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
1459 }
a0d0e21e
LW
1460 if (SvTYPE(TARG) < SVt_PVLV) {
1461 sv_upgrade(TARG, SVt_PVLV);
1462 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
ed6116ce 1463 }
a0d0e21e 1464
79072805
LW
1465 LvTYPE(TARG) = 's';
1466 LvTARG(TARG) = sv;
a0d0e21e 1467 LvTARGOFF(TARG) = pos;
79072805
LW
1468 LvTARGLEN(TARG) = rem;
1469 }
1470 }
1471 PUSHs(TARG); /* avoid SvSETMAGIC here */
1472 RETURN;
1473}
1474
1475PP(pp_vec)
1476{
1477 dSP; dTARGET;
1478 register I32 size = POPi;
1479 register I32 offset = POPi;
1480 register SV *src = POPs;
a0d0e21e 1481 I32 lvalue = op->op_flags & OPf_MOD;
463ee0b2
LW
1482 STRLEN srclen;
1483 unsigned char *s = (unsigned char*)SvPV(src, srclen);
79072805
LW
1484 unsigned long retnum;
1485 I32 len;
1486
1487 offset *= size; /* turn into bit offset */
1488 len = (offset + size + 7) / 8;
1489 if (offset < 0 || size < 1)
1490 retnum = 0;
79072805 1491 else {
a0d0e21e
LW
1492 if (lvalue) { /* it's an lvalue! */
1493 if (SvTYPE(TARG) < SVt_PVLV) {
1494 sv_upgrade(TARG, SVt_PVLV);
1495 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
1496 }
1497
1498 LvTYPE(TARG) = 'v';
1499 LvTARG(TARG) = src;
1500 LvTARGOFF(TARG) = offset;
1501 LvTARGLEN(TARG) = size;
1502 }
93a17b20 1503 if (len > srclen) {
a0d0e21e
LW
1504 if (size <= 8)
1505 retnum = 0;
1506 else {
1507 offset >>= 3;
748a9306
LW
1508 if (size == 16) {
1509 if (offset >= srclen)
1510 retnum = 0;
a0d0e21e 1511 else
748a9306
LW
1512 retnum = (unsigned long) s[offset] << 8;
1513 }
1514 else if (size == 32) {
1515 if (offset >= srclen)
1516 retnum = 0;
1517 else if (offset + 1 >= srclen)
a0d0e21e 1518 retnum = (unsigned long) s[offset] << 24;
748a9306
LW
1519 else if (offset + 2 >= srclen)
1520 retnum = ((unsigned long) s[offset] << 24) +
1521 ((unsigned long) s[offset + 1] << 16);
1522 else
1523 retnum = ((unsigned long) s[offset] << 24) +
1524 ((unsigned long) s[offset + 1] << 16) +
1525 (s[offset + 2] << 8);
a0d0e21e
LW
1526 }
1527 }
79072805 1528 }
a0d0e21e 1529 else if (size < 8)
79072805
LW
1530 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1531 else {
1532 offset >>= 3;
1533 if (size == 8)
1534 retnum = s[offset];
1535 else if (size == 16)
1536 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1537 else if (size == 32)
1538 retnum = ((unsigned long) s[offset] << 24) +
1539 ((unsigned long) s[offset + 1] << 16) +
1540 (s[offset + 2] << 8) + s[offset+3];
1541 }
79072805
LW
1542 }
1543
1544 sv_setiv(TARG, (I32)retnum);
1545 PUSHs(TARG);
1546 RETURN;
1547}
1548
1549PP(pp_index)
1550{
1551 dSP; dTARGET;
1552 SV *big;
1553 SV *little;
1554 I32 offset;
1555 I32 retval;
1556 char *tmps;
1557 char *tmps2;
463ee0b2 1558 STRLEN biglen;
a0d0e21e 1559 I32 arybase = curcop->cop_arybase;
79072805
LW
1560
1561 if (MAXARG < 3)
1562 offset = 0;
1563 else
1564 offset = POPi - arybase;
1565 little = POPs;
1566 big = POPs;
463ee0b2 1567 tmps = SvPV(big, biglen);
79072805
LW
1568 if (offset < 0)
1569 offset = 0;
93a17b20
LW
1570 else if (offset > biglen)
1571 offset = biglen;
79072805 1572 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
93a17b20 1573 (unsigned char*)tmps + biglen, little)))
79072805
LW
1574 retval = -1 + arybase;
1575 else
1576 retval = tmps2 - tmps + arybase;
1577 PUSHi(retval);
1578 RETURN;
1579}
1580
1581PP(pp_rindex)
1582{
1583 dSP; dTARGET;
1584 SV *big;
1585 SV *little;
463ee0b2
LW
1586 STRLEN blen;
1587 STRLEN llen;
79072805
LW
1588 SV *offstr;
1589 I32 offset;
1590 I32 retval;
1591 char *tmps;
1592 char *tmps2;
a0d0e21e 1593 I32 arybase = curcop->cop_arybase;
79072805 1594
a0d0e21e 1595 if (MAXARG >= 3)
79072805
LW
1596 offstr = POPs;
1597 little = POPs;
1598 big = POPs;
463ee0b2
LW
1599 tmps2 = SvPV(little, llen);
1600 tmps = SvPV(big, blen);
79072805 1601 if (MAXARG < 3)
463ee0b2 1602 offset = blen;
79072805 1603 else
463ee0b2 1604 offset = SvIV(offstr) - arybase + llen;
79072805
LW
1605 if (offset < 0)
1606 offset = 0;
463ee0b2
LW
1607 else if (offset > blen)
1608 offset = blen;
79072805 1609 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 1610 tmps2, tmps2 + llen)))
79072805
LW
1611 retval = -1 + arybase;
1612 else
1613 retval = tmps2 - tmps + arybase;
1614 PUSHi(retval);
1615 RETURN;
1616}
1617
1618PP(pp_sprintf)
1619{
1620 dSP; dMARK; dORIGMARK; dTARGET;
1621 do_sprintf(TARG, SP-MARK, MARK+1);
1622 SP = ORIGMARK;
1623 PUSHTARG;
1624 RETURN;
1625}
1626
79072805
LW
1627PP(pp_ord)
1628{
1629 dSP; dTARGET;
1630 I32 value;
1631 char *tmps;
79072805 1632
79072805 1633#ifndef I286
a0d0e21e 1634 tmps = POPp;
79072805
LW
1635 value = (I32) (*tmps & 255);
1636#else
a0d0e21e
LW
1637 I32 anum;
1638 tmps = POPp;
79072805
LW
1639 anum = (I32) *tmps;
1640 value = (I32) (anum & 255);
1641#endif
1642 XPUSHi(value);
1643 RETURN;
1644}
1645
463ee0b2
LW
1646PP(pp_chr)
1647{
1648 dSP; dTARGET;
1649 char *tmps;
1650
748a9306
LW
1651 (void)SvUPGRADE(TARG,SVt_PV);
1652 SvGROW(TARG,2);
463ee0b2
LW
1653 SvCUR_set(TARG, 1);
1654 tmps = SvPVX(TARG);
748a9306
LW
1655 *tmps++ = POPi;
1656 *tmps = '\0';
a0d0e21e 1657 (void)SvPOK_only(TARG);
463ee0b2
LW
1658 XPUSHs(TARG);
1659 RETURN;
1660}
1661
79072805
LW
1662PP(pp_crypt)
1663{
1664 dSP; dTARGET; dPOPTOPssrl;
1665#ifdef HAS_CRYPT
a0d0e21e 1666 char *tmps = SvPV(left, na);
79072805 1667#ifdef FCRYPT
a0d0e21e 1668 sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
79072805 1669#else
a0d0e21e 1670 sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
79072805
LW
1671#endif
1672#else
1673 DIE(
1674 "The crypt() function is unimplemented due to excessive paranoia.");
1675#endif
1676 SETs(TARG);
1677 RETURN;
1678}
1679
1680PP(pp_ucfirst)
1681{
1682 dSP;
1683 SV *sv = TOPs;
1684 register char *s;
1685
ed6116ce 1686 if (!SvPADTMP(sv)) {
79072805
LW
1687 dTARGET;
1688 sv_setsv(TARG, sv);
1689 sv = TARG;
1690 SETs(sv);
1691 }
a0d0e21e
LW
1692 s = SvPV_force(sv, na);
1693 if (isLOWER(*s))
1694 *s = toUPPER(*s);
79072805
LW
1695
1696 RETURN;
1697}
1698
1699PP(pp_lcfirst)
1700{
1701 dSP;
1702 SV *sv = TOPs;
1703 register char *s;
1704
ed6116ce 1705 if (!SvPADTMP(sv)) {
79072805
LW
1706 dTARGET;
1707 sv_setsv(TARG, sv);
1708 sv = TARG;
1709 SETs(sv);
1710 }
a0d0e21e
LW
1711 s = SvPV_force(sv, na);
1712 if (isUPPER(*s))
1713 *s = toLOWER(*s);
79072805
LW
1714
1715 SETs(sv);
1716 RETURN;
1717}
1718
1719PP(pp_uc)
1720{
1721 dSP;
1722 SV *sv = TOPs;
1723 register char *s;
1724 register char *send;
463ee0b2 1725 STRLEN len;
79072805 1726
ed6116ce 1727 if (!SvPADTMP(sv)) {
79072805
LW
1728 dTARGET;
1729 sv_setsv(TARG, sv);
1730 sv = TARG;
1731 SETs(sv);
1732 }
a0d0e21e 1733 s = SvPV_force(sv, len);
463ee0b2 1734 send = s + len;
79072805 1735 while (s < send) {
a0d0e21e
LW
1736 if (isLOWER(*s))
1737 *s = toUPPER(*s);
79072805
LW
1738 s++;
1739 }
1740 RETURN;
1741}
1742
1743PP(pp_lc)
1744{
1745 dSP;
1746 SV *sv = TOPs;
1747 register char *s;
1748 register char *send;
463ee0b2 1749 STRLEN len;
79072805 1750
ed6116ce 1751 if (!SvPADTMP(sv)) {
79072805
LW
1752 dTARGET;
1753 sv_setsv(TARG, sv);
1754 sv = TARG;
1755 SETs(sv);
1756 }
a0d0e21e 1757 s = SvPV_force(sv, len);
463ee0b2 1758 send = s + len;
79072805 1759 while (s < send) {
a0d0e21e
LW
1760 if (isUPPER(*s))
1761 *s = toLOWER(*s);
79072805
LW
1762 s++;
1763 }
1764 RETURN;
1765}
1766
a0d0e21e 1767PP(pp_quotemeta)
79072805 1768{
a0d0e21e
LW
1769 dSP; dTARGET;
1770 SV *sv = TOPs;
1771 STRLEN len;
1772 register char *s = SvPV(sv,len);
1773 register char *d;
79072805 1774
a0d0e21e
LW
1775 if (len) {
1776 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 1777 SvGROW(TARG, (len * 2) + 1);
a0d0e21e
LW
1778 d = SvPVX(TARG);
1779 while (len--) {
1780 if (!isALNUM(*s))
1781 *d++ = '\\';
1782 *d++ = *s++;
79072805 1783 }
a0d0e21e
LW
1784 *d = '\0';
1785 SvCUR_set(TARG, d - SvPVX(TARG));
1786 (void)SvPOK_only(TARG);
79072805 1787 }
a0d0e21e
LW
1788 else
1789 sv_setpvn(TARG, s, len);
1790 SETs(TARG);
79072805
LW
1791 RETURN;
1792}
1793
a0d0e21e 1794/* Arrays. */
79072805 1795
a0d0e21e 1796PP(pp_aslice)
79072805 1797{
a0d0e21e
LW
1798 dSP; dMARK; dORIGMARK;
1799 register SV** svp;
1800 register AV* av = (AV*)POPs;
1801 register I32 lval = op->op_flags & OPf_MOD;
748a9306
LW
1802 I32 arybase = curcop->cop_arybase;
1803 I32 elem;
79072805 1804
a0d0e21e 1805 if (SvTYPE(av) == SVt_PVAV) {
748a9306
LW
1806 if (lval && op->op_private & OPpLVAL_INTRO) {
1807 I32 max = -1;
1808 for (svp = mark + 1; svp <= sp; svp++) {
1809 elem = SvIVx(*svp);
1810 if (elem > max)
1811 max = elem;
1812 }
1813 if (max > AvMAX(av))
1814 av_extend(av, max);
1815 }
a0d0e21e 1816 while (++MARK <= SP) {
748a9306 1817 elem = SvIVx(*MARK);
a0d0e21e 1818
748a9306
LW
1819 if (elem > 0)
1820 elem -= arybase;
a0d0e21e
LW
1821 svp = av_fetch(av, elem, lval);
1822 if (lval) {
1823 if (!svp || *svp == &sv_undef)
1824 DIE(no_aelem, elem);
1825 if (op->op_private & OPpLVAL_INTRO)
1826 save_svref(svp);
79072805 1827 }
a0d0e21e 1828 *MARK = svp ? *svp : &sv_undef;
79072805
LW
1829 }
1830 }
748a9306 1831 if (GIMME != G_ARRAY) {
a0d0e21e
LW
1832 MARK = ORIGMARK;
1833 *++MARK = *SP;
1834 SP = MARK;
1835 }
79072805
LW
1836 RETURN;
1837}
1838
1839/* Associative arrays. */
1840
1841PP(pp_each)
1842{
1843 dSP; dTARGET;
1844 HV *hash = (HV*)POPs;
c07a80fd 1845 HE *entry;
c07a80fd
PP
1846
1847 PUTBACK;
1848 entry = hv_iternext(hash); /* might clobber stack_sp */
1849 SPAGAIN;
79072805 1850
79072805
LW
1851 EXTEND(SP, 2);
1852 if (entry) {
f12c7020 1853 PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
79072805 1854 if (GIMME == G_ARRAY) {
c07a80fd
PP
1855 PUTBACK;
1856 sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */
1857 SPAGAIN;
8990e307 1858 PUSHs(TARG);
79072805 1859 }
79072805
LW
1860 }
1861 else if (GIMME == G_SCALAR)
1862 RETPUSHUNDEF;
1863
1864 RETURN;
1865}
1866
1867PP(pp_values)
1868{
1869 return do_kv(ARGS);
1870}
1871
1872PP(pp_keys)
1873{
1874 return do_kv(ARGS);
1875}
1876
1877PP(pp_delete)
1878{
1879 dSP;
1880 SV *sv;
1881 SV *tmpsv = POPs;
1882 HV *hv = (HV*)POPs;
463ee0b2 1883 STRLEN len;
a0d0e21e
LW
1884 if (SvTYPE(hv) != SVt_PVHV) {
1885 DIE("Not a HASH reference");
79072805 1886 }
f12c7020
PP
1887 sv = hv_delete_ent(hv, tmpsv,
1888 (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
79072805
LW
1889 if (!sv)
1890 RETPUSHUNDEF;
1891 PUSHs(sv);
1892 RETURN;
1893}
1894
a0d0e21e 1895PP(pp_exists)
79072805 1896{
a0d0e21e
LW
1897 dSP;
1898 SV *tmpsv = POPs;
1899 HV *hv = (HV*)POPs;
a0d0e21e
LW
1900 STRLEN len;
1901 if (SvTYPE(hv) != SVt_PVHV) {
1902 DIE("Not a HASH reference");
1903 }
f12c7020 1904 if (hv_exists_ent(hv, tmpsv, 0))
a0d0e21e
LW
1905 RETPUSHYES;
1906 RETPUSHNO;
1907}
79072805 1908
a0d0e21e
LW
1909PP(pp_hslice)
1910{
1911 dSP; dMARK; dORIGMARK;
f12c7020 1912 register HE *he;
a0d0e21e
LW
1913 register HV *hv = (HV*)POPs;
1914 register I32 lval = op->op_flags & OPf_MOD;
79072805 1915
a0d0e21e
LW
1916 if (SvTYPE(hv) == SVt_PVHV) {
1917 while (++MARK <= SP) {
f12c7020 1918 SV *keysv = *MARK;
79072805 1919
f12c7020 1920 he = hv_fetch_ent(hv, keysv, lval, 0);
a0d0e21e 1921 if (lval) {
f12c7020
PP
1922 if (!he || HeVAL(he) == &sv_undef)
1923 DIE(no_helem, SvPV(keysv, na));
a0d0e21e 1924 if (op->op_private & OPpLVAL_INTRO)
f12c7020 1925 save_svref(&HeVAL(he));
93a17b20 1926 }
f12c7020 1927 *MARK = he ? HeVAL(he) : &sv_undef;
79072805
LW
1928 }
1929 }
a0d0e21e
LW
1930 if (GIMME != G_ARRAY) {
1931 MARK = ORIGMARK;
1932 *++MARK = *SP;
1933 SP = MARK;
79072805 1934 }
a0d0e21e
LW
1935 RETURN;
1936}
1937
1938/* List operators. */
1939
1940PP(pp_list)
1941{
1942 dSP; dMARK;
1943 if (GIMME != G_ARRAY) {
1944 if (++MARK <= SP)
1945 *MARK = *SP; /* unwanted list, return last item */
8990e307 1946 else
a0d0e21e
LW
1947 *MARK = &sv_undef;
1948 SP = MARK;
79072805 1949 }
a0d0e21e 1950 RETURN;
79072805
LW
1951}
1952
a0d0e21e 1953PP(pp_lslice)
79072805
LW
1954{
1955 dSP;
a0d0e21e
LW
1956 SV **lastrelem = stack_sp;
1957 SV **lastlelem = stack_base + POPMARK;
1958 SV **firstlelem = stack_base + POPMARK + 1;
1959 register SV **firstrelem = lastlelem + 1;
1960 I32 arybase = curcop->cop_arybase;
4633a7c4
LW
1961 I32 lval = op->op_flags & OPf_MOD;
1962 I32 is_something_there = lval;
79072805 1963
a0d0e21e
LW
1964 register I32 max = lastrelem - lastlelem;
1965 register SV **lelem;
1966 register I32 ix;
1967
1968 if (GIMME != G_ARRAY) {
748a9306
LW
1969 ix = SvIVx(*lastlelem);
1970 if (ix < 0)
1971 ix += max;
1972 else
1973 ix -= arybase;
a0d0e21e
LW
1974 if (ix < 0 || ix >= max)
1975 *firstlelem = &sv_undef;
1976 else
1977 *firstlelem = firstrelem[ix];
1978 SP = firstlelem;
1979 RETURN;
1980 }
1981
1982 if (max == 0) {
1983 SP = firstlelem - 1;
1984 RETURN;
1985 }
1986
1987 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 1988 ix = SvIVx(*lelem);
a0d0e21e
LW
1989 if (ix < 0) {
1990 ix += max;
1991 if (ix < 0)
1992 *lelem = &sv_undef;
1993 else if (!(*lelem = firstrelem[ix]))
1994 *lelem = &sv_undef;
79072805 1995 }
748a9306
LW
1996 else {
1997 ix -= arybase;
1998 if (ix >= max || !(*lelem = firstrelem[ix]))
1999 *lelem = &sv_undef;
2000 }
4633a7c4
LW
2001 if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
2002 is_something_there = TRUE;
79072805 2003 }
4633a7c4
LW
2004 if (is_something_there)
2005 SP = lastlelem;
2006 else
2007 SP = firstlelem - 1;
79072805
LW
2008 RETURN;
2009}
2010
a0d0e21e
LW
2011PP(pp_anonlist)
2012{
2013 dSP; dMARK;
2014 I32 items = SP - MARK;
2015 SP = MARK;
2016 XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
2017 RETURN;
2018}
2019
2020PP(pp_anonhash)
79072805
LW
2021{
2022 dSP; dMARK; dORIGMARK;
a0d0e21e
LW
2023 STRLEN len;
2024 HV* hv = (HV*)sv_2mortal((SV*)newHV());
2025
2026 while (MARK < SP) {
2027 SV* key = *++MARK;
a0d0e21e
LW
2028 SV *val = NEWSV(46, 0);
2029 if (MARK < SP)
2030 sv_setsv(val, *++MARK);
2031 else
2032 warn("Odd number of elements in hash list");
f12c7020 2033 (void)hv_store_ent(hv,key,val,0);
79072805 2034 }
a0d0e21e
LW
2035 SP = ORIGMARK;
2036 XPUSHs((SV*)hv);
79072805
LW
2037 RETURN;
2038}
2039
a0d0e21e 2040PP(pp_splice)
79072805 2041{
a0d0e21e
LW
2042 dSP; dMARK; dORIGMARK;
2043 register AV *ary = (AV*)*++MARK;
2044 register SV **src;
2045 register SV **dst;
2046 register I32 i;
2047 register I32 offset;
2048 register I32 length;
2049 I32 newlen;
2050 I32 after;
2051 I32 diff;
2052 SV **tmparyval = 0;
79072805 2053
a0d0e21e 2054 SP++;
79072805 2055
a0d0e21e
LW
2056 if (++MARK < SP) {
2057 offset = SvIVx(*MARK);
2058 if (offset < 0)
2059 offset += AvFILL(ary) + 1;
2060 else
2061 offset -= curcop->cop_arybase;
2062 if (++MARK < SP) {
2063 length = SvIVx(*MARK++);
2064 if (length < 0)
2065 length = 0;
79072805
LW
2066 }
2067 else
a0d0e21e 2068 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 2069 }
a0d0e21e
LW
2070 else {
2071 offset = 0;
2072 length = AvMAX(ary) + 1;
2073 }
2074 if (offset < 0) {
2075 length += offset;
2076 offset = 0;
2077 if (length < 0)
2078 length = 0;
2079 }
2080 if (offset > AvFILL(ary) + 1)
2081 offset = AvFILL(ary) + 1;
2082 after = AvFILL(ary) + 1 - (offset + length);
2083 if (after < 0) { /* not that much array */
2084 length += after; /* offset+length now in array */
2085 after = 0;
2086 if (!AvALLOC(ary))
2087 av_extend(ary, 0);
2088 }
2089
2090 /* At this point, MARK .. SP-1 is our new LIST */
2091
2092 newlen = SP - MARK;
2093 diff = newlen - length;
2094
2095 if (diff < 0) { /* shrinking the area */
2096 if (newlen) {
2097 New(451, tmparyval, newlen, SV*); /* so remember insertion */
2098 Copy(MARK, tmparyval, newlen, SV*);
79072805 2099 }
a0d0e21e
LW
2100
2101 MARK = ORIGMARK + 1;
2102 if (GIMME == G_ARRAY) { /* copy return vals to stack */
2103 MEXTEND(MARK, length);
2104 Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2105 if (AvREAL(ary)) {
2106 for (i = length, dst = MARK; i; i--)
2107 sv_2mortal(*dst++); /* free them eventualy */
2108 }
2109 MARK += length - 1;
79072805 2110 }
a0d0e21e
LW
2111 else {
2112 *MARK = AvARRAY(ary)[offset+length-1];
2113 if (AvREAL(ary)) {
2114 sv_2mortal(*MARK);
2115 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2116 SvREFCNT_dec(*dst++); /* free them now */
79072805 2117 }
a0d0e21e
LW
2118 }
2119 AvFILL(ary) += diff;
2120
2121 /* pull up or down? */
2122
2123 if (offset < after) { /* easier to pull up */
2124 if (offset) { /* esp. if nothing to pull */
2125 src = &AvARRAY(ary)[offset-1];
2126 dst = src - diff; /* diff is negative */
2127 for (i = offset; i > 0; i--) /* can't trust Copy */
2128 *dst-- = *src--;
79072805 2129 }
a0d0e21e
LW
2130 dst = AvARRAY(ary);
2131 SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2132 AvMAX(ary) += diff;
2133 }
2134 else {
2135 if (after) { /* anything to pull down? */
2136 src = AvARRAY(ary) + offset + length;
2137 dst = src + diff; /* diff is negative */
2138 Move(src, dst, after, SV*);
79072805 2139 }
a0d0e21e
LW
2140 dst = &AvARRAY(ary)[AvFILL(ary)+1];
2141 /* avoid later double free */
2142 }
2143 i = -diff;
2144 while (i)
2145 dst[--i] = &sv_undef;
2146
2147 if (newlen) {
2148 for (src = tmparyval, dst = AvARRAY(ary) + offset;
2149 newlen; newlen--) {
2150 *dst = NEWSV(46, 0);
2151 sv_setsv(*dst++, *src++);
79072805 2152 }
a0d0e21e
LW
2153 Safefree(tmparyval);
2154 }
2155 }
2156 else { /* no, expanding (or same) */
2157 if (length) {
2158 New(452, tmparyval, length, SV*); /* so remember deletion */
2159 Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
2160 }
2161
2162 if (diff > 0) { /* expanding */
2163
2164 /* push up or down? */
2165
2166 if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
2167 if (offset) {
2168 src = AvARRAY(ary);
2169 dst = src - diff;
2170 Move(src, dst, offset, SV*);
79072805 2171 }
a0d0e21e
LW
2172 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
2173 AvMAX(ary) += diff;
2174 AvFILL(ary) += diff;
79072805
LW
2175 }
2176 else {
a0d0e21e
LW
2177 if (AvFILL(ary) + diff >= AvMAX(ary)) /* oh, well */
2178 av_extend(ary, AvFILL(ary) + diff);
2179 AvFILL(ary) += diff;
2180
2181 if (after) {
2182 dst = AvARRAY(ary) + AvFILL(ary);
2183 src = dst - diff;
2184 for (i = after; i; i--) {
2185 *dst-- = *src--;
2186 }
79072805
LW
2187 }
2188 }
a0d0e21e
LW
2189 }
2190
2191 for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
2192 *dst = NEWSV(46, 0);
2193 sv_setsv(*dst++, *src++);
2194 }
2195 MARK = ORIGMARK + 1;
2196 if (GIMME == G_ARRAY) { /* copy return vals to stack */
2197 if (length) {
2198 Copy(tmparyval, MARK, length, SV*);
2199 if (AvREAL(ary)) {
2200 for (i = length, dst = MARK; i; i--)
2201 sv_2mortal(*dst++); /* free them eventualy */
79072805 2202 }
a0d0e21e 2203 Safefree(tmparyval);
79072805 2204 }
a0d0e21e
LW
2205 MARK += length - 1;
2206 }
2207 else if (length--) {
2208 *MARK = tmparyval[length];
2209 if (AvREAL(ary)) {
2210 sv_2mortal(*MARK);
2211 while (length-- > 0)
2212 SvREFCNT_dec(tmparyval[length]);
79072805 2213 }
a0d0e21e 2214 Safefree(tmparyval);
79072805 2215 }
a0d0e21e
LW
2216 else
2217 *MARK = &sv_undef;
79072805 2218 }
a0d0e21e 2219 SP = MARK;
79072805
LW
2220 RETURN;
2221}
2222
a0d0e21e 2223PP(pp_push)
79072805
LW
2224{
2225 dSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e
LW
2226 register AV *ary = (AV*)*++MARK;
2227 register SV *sv = &sv_undef;
79072805 2228
a0d0e21e
LW
2229 for (++MARK; MARK <= SP; MARK++) {
2230 sv = NEWSV(51, 0);
2231 if (*MARK)
2232 sv_setsv(sv, *MARK);
2233 av_push(ary, sv);
79072805
LW
2234 }
2235 SP = ORIGMARK;
a0d0e21e 2236 PUSHi( AvFILL(ary) + 1 );
79072805
LW
2237 RETURN;
2238}
2239
a0d0e21e 2240PP(pp_pop)
79072805
LW
2241{
2242 dSP;
a0d0e21e
LW
2243 AV *av = (AV*)POPs;
2244 SV *sv = av_pop(av);
2245 if (sv != &sv_undef && AvREAL(av))
2246 (void)sv_2mortal(sv);
2247 PUSHs(sv);
79072805 2248 RETURN;
79072805
LW
2249}
2250
a0d0e21e 2251PP(pp_shift)
79072805
LW
2252{
2253 dSP;
a0d0e21e
LW
2254 AV *av = (AV*)POPs;
2255 SV *sv = av_shift(av);
79072805 2256 EXTEND(SP, 1);
a0d0e21e 2257 if (!sv)
79072805 2258 RETPUSHUNDEF;
a0d0e21e
LW
2259 if (sv != &sv_undef && AvREAL(av))
2260 (void)sv_2mortal(sv);
2261 PUSHs(sv);
79072805 2262 RETURN;
79072805
LW
2263}
2264
a0d0e21e 2265PP(pp_unshift)
79072805 2266{
a0d0e21e
LW
2267 dSP; dMARK; dORIGMARK; dTARGET;
2268 register AV *ary = (AV*)*++MARK;
2269 register SV *sv;
2270 register I32 i = 0;
79072805 2271
a0d0e21e
LW
2272 av_unshift(ary, SP - MARK);
2273 while (MARK < SP) {
2274 sv = NEWSV(27, 0);
2275 sv_setsv(sv, *++MARK);
2276 (void)av_store(ary, i++, sv);
79072805 2277 }
79072805 2278
a0d0e21e
LW
2279 SP = ORIGMARK;
2280 PUSHi( AvFILL(ary) + 1 );
79072805 2281 RETURN;
79072805
LW
2282}
2283
a0d0e21e 2284PP(pp_reverse)
79072805 2285{
a0d0e21e
LW
2286 dSP; dMARK;
2287 register SV *tmp;
2288 SV **oldsp = SP;
79072805 2289
a0d0e21e
LW
2290 if (GIMME == G_ARRAY) {
2291 MARK++;
2292 while (MARK < SP) {
2293 tmp = *MARK;
2294 *MARK++ = *SP;
2295 *SP-- = tmp;
2296 }
2297 SP = oldsp;
79072805
LW
2298 }
2299 else {
a0d0e21e
LW
2300 register char *up;
2301 register char *down;
2302 register I32 tmp;
2303 dTARGET;
2304 STRLEN len;
79072805 2305
a0d0e21e
LW
2306 if (SP - MARK > 1)
2307 do_join(TARG, &sv_no, MARK, SP);
2308 else
2309 sv_setsv(TARG, *SP);
2310 up = SvPV_force(TARG, len);
2311 if (len > 1) {
2312 down = SvPVX(TARG) + len - 1;
2313 while (down > up) {
2314 tmp = *up;
2315 *up++ = *down;
2316 *down-- = tmp;
2317 }
2318 (void)SvPOK_only(TARG);
79072805 2319 }
a0d0e21e
LW
2320 SP = MARK + 1;
2321 SETTARG;
79072805 2322 }
a0d0e21e 2323 RETURN;
79072805
LW
2324}
2325
a0d0e21e
LW
2326/* Explosives and implosives. */
2327
2328PP(pp_unpack)
79072805
LW
2329{
2330 dSP;
a0d0e21e 2331 dPOPPOPssrl;
ed6116ce 2332 SV *sv;
a0d0e21e
LW
2333 STRLEN llen;
2334 STRLEN rlen;
2335 register char *pat = SvPV(left, llen);
2336 register char *s = SvPV(right, rlen);
2337 char *strend = s + rlen;
2338 char *strbeg = s;
2339 register char *patend = pat + llen;
2340 I32 datumtype;
2341 register I32 len;
2342 register I32 bits;
79072805 2343
a0d0e21e
LW
2344 /* These must not be in registers: */
2345 I16 ashort;
2346 int aint;
2347 I32 along;
ecfc5424
AD
2348#ifdef HAS_QUAD
2349 Quad_t aquad;
a0d0e21e
LW
2350#endif
2351 U16 aushort;
2352 unsigned int auint;
2353 U32 aulong;
ecfc5424
AD
2354#ifdef HAS_QUAD
2355 unsigned Quad_t auquad;
a0d0e21e
LW
2356#endif
2357 char *aptr;
2358 float afloat;
2359 double adouble;
2360 I32 checksum = 0;
2361 register U32 culong;
2362 double cdouble;
2363 static char* bitcount = 0;
79072805 2364
a0d0e21e
LW
2365 if (GIMME != G_ARRAY) { /* arrange to do first one only */
2366 /*SUPPRESS 530*/
2367 for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
748a9306 2368 if (strchr("aAbBhHP", *patend) || *pat == '%') {
a0d0e21e
LW
2369 patend++;
2370 while (isDIGIT(*patend) || *patend == '*')
2371 patend++;
2372 }
2373 else
2374 patend++;
79072805 2375 }
a0d0e21e
LW
2376 while (pat < patend) {
2377 reparse:
2378 datumtype = *pat++;
2379 if (pat >= patend)
2380 len = 1;
2381 else if (*pat == '*') {
2382 len = strend - strbeg; /* long enough */
2383 pat++;
2384 }
2385 else if (isDIGIT(*pat)) {
2386 len = *pat++ - '0';
2387 while (isDIGIT(*pat))
2388 len = (len * 10) + (*pat++ - '0');
2389 }
2390 else
2391 len = (datumtype != '@');
2392 switch(datumtype) {
2393 default:
2394 break;
2395 case '%':
2396 if (len == 1 && pat[-1] != '1')
2397 len = 16;
2398 checksum = len;
2399 culong = 0;
2400 cdouble = 0;
2401 if (pat < patend)
2402 goto reparse;
2403 break;
2404 case '@':
2405 if (len > strend - strbeg)
2406 DIE("@ outside of string");
2407 s = strbeg + len;
2408 break;
2409 case 'X':
2410 if (len > s - strbeg)
2411 DIE("X outside of string");
2412 s -= len;
2413 break;
2414 case 'x':
2415 if (len > strend - s)
2416 DIE("x outside of string");
2417 s += len;
2418 break;
2419 case 'A':
2420 case 'a':
2421 if (len > strend - s)
2422 len = strend - s;
2423 if (checksum)
2424 goto uchar_checksum;
2425 sv = NEWSV(35, len);
2426 sv_setpvn(sv, s, len);
2427 s += len;
2428 if (datumtype == 'A') {
2429 aptr = s; /* borrow register */
2430 s = SvPVX(sv) + len - 1;
2431 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
2432 s--;
2433 *++s = '\0';
2434 SvCUR_set(sv, s - SvPVX(sv));
2435 s = aptr; /* unborrow register */
2436 }
2437 XPUSHs(sv_2mortal(sv));
2438 break;
2439 case 'B':
2440 case 'b':
2441 if (pat[-1] == '*' || len > (strend - s) * 8)
2442 len = (strend - s) * 8;
2443 if (checksum) {
2444 if (!bitcount) {
2445 Newz(601, bitcount, 256, char);
2446 for (bits = 1; bits < 256; bits++) {
2447 if (bits & 1) bitcount[bits]++;
2448 if (bits & 2) bitcount[bits]++;
2449 if (bits & 4) bitcount[bits]++;
2450 if (bits & 8) bitcount[bits]++;
2451 if (bits & 16) bitcount[bits]++;
2452 if (bits & 32) bitcount[bits]++;
2453 if (bits & 64) bitcount[bits]++;
2454 if (bits & 128) bitcount[bits]++;
2455 }
2456 }
2457 while (len >= 8) {
2458 culong += bitcount[*(unsigned char*)s++];
2459 len -= 8;
2460 }
2461 if (len) {
2462 bits = *s;
2463 if (datumtype == 'b') {
2464 while (len-- > 0) {
2465 if (bits & 1) culong++;
2466 bits >>= 1;
2467 }
2468 }
2469 else {
2470 while (len-- > 0) {
2471 if (bits & 128) culong++;
2472 bits <<= 1;
2473 }
2474 }
2475 }
79072805
LW
2476 break;
2477 }
a0d0e21e
LW
2478 sv = NEWSV(35, len + 1);
2479 SvCUR_set(sv, len);
2480 SvPOK_on(sv);
2481 aptr = pat; /* borrow register */
2482 pat = SvPVX(sv);
2483 if (datumtype == 'b') {
2484 aint = len;
2485 for (len = 0; len < aint; len++) {
2486 if (len & 7) /*SUPPRESS 595*/
2487 bits >>= 1;
2488 else
2489 bits = *s++;
2490 *pat++ = '0' + (bits & 1);
2491 }
2492 }
2493 else {
2494 aint = len;
2495 for (len = 0; len < aint; len++) {
2496 if (len & 7)
2497 bits <<= 1;
2498 else
2499 bits = *s++;
2500 *pat++ = '0' + ((bits & 128) != 0);
2501 }
2502 }
2503 *pat = '\0';
2504 pat = aptr; /* unborrow register */
2505 XPUSHs(sv_2mortal(sv));
2506 break;
2507 case 'H':
2508 case 'h':
2509 if (pat[-1] == '*' || len > (strend - s) * 2)
2510 len = (strend - s) * 2;
2511 sv = NEWSV(35, len + 1);
2512 SvCUR_set(sv, len);
2513 SvPOK_on(sv);
2514 aptr = pat; /* borrow register */
2515 pat = SvPVX(sv);
2516 if (datumtype == 'h') {
2517 aint = len;
2518 for (len = 0; len < aint; len++) {
2519 if (len & 1)
2520 bits >>= 4;
2521 else
2522 bits = *s++;
2523 *pat++ = hexdigit[bits & 15];
2524 }
2525 }
2526 else {
2527 aint = len;
2528 for (len = 0; len < aint; len++) {
2529 if (len & 1)
2530 bits <<= 4;
2531 else
2532 bits = *s++;
2533 *pat++ = hexdigit[(bits >> 4) & 15];
2534 }
2535 }
2536 *pat = '\0';
2537 pat = aptr; /* unborrow register */
2538 XPUSHs(sv_2mortal(sv));
2539 break;
2540 case 'c':
2541 if (len > strend - s)
2542 len = strend - s;
2543 if (checksum) {
2544 while (len-- > 0) {
2545 aint = *s++;
2546 if (aint >= 128) /* fake up signed chars */
2547 aint -= 256;
2548 culong += aint;
2549 }
2550 }
2551 else {
2552 EXTEND(SP, len);
2553 while (len-- > 0) {
2554 aint = *s++;
2555 if (aint >= 128) /* fake up signed chars */
2556 aint -= 256;
2557 sv = NEWSV(36, 0);
2558 sv_setiv(sv, (I32)aint);
2559 PUSHs(sv_2mortal(sv));
2560 }
2561 }
2562 break;
2563 case 'C':
2564 if (len > strend - s)
2565 len = strend - s;
2566 if (checksum) {
2567 uchar_checksum:
2568 while (len-- > 0) {
2569 auint = *s++ & 255;
2570 culong += auint;
2571 }
2572 }
2573 else {
2574 EXTEND(SP, len);
2575 while (len-- > 0) {
2576 auint = *s++ & 255;
2577 sv = NEWSV(37, 0);
2578 sv_setiv(sv, (I32)auint);
2579 PUSHs(sv_2mortal(sv));
2580 }
2581 }
2582 break;
2583 case 's':
2584 along = (strend - s) / sizeof(I16);
2585 if (len > along)
2586 len = along;
2587 if (checksum) {
2588 while (len-- > 0) {
2589 Copy(s, &ashort, 1, I16);
2590 s += sizeof(I16);
2591 culong += ashort;
2592 }
2593 }
2594 else {
2595 EXTEND(SP, len);
2596 while (len-- > 0) {
2597 Copy(s, &ashort, 1, I16);
2598 s += sizeof(I16);
2599 sv = NEWSV(38, 0);
2600 sv_setiv(sv, (I32)ashort);
2601 PUSHs(sv_2mortal(sv));
2602 }
2603 }
2604 break;
2605 case 'v':
2606 case 'n':
2607 case 'S':
2608 along = (strend - s) / sizeof(U16);
2609 if (len > along)
2610 len = along;
2611 if (checksum) {
2612 while (len-- > 0) {
2613 Copy(s, &aushort, 1, U16);
2614 s += sizeof(U16);
2615#ifdef HAS_NTOHS
2616 if (datumtype == 'n')
2617 aushort = ntohs(aushort);
79072805 2618#endif
a0d0e21e
LW
2619#ifdef HAS_VTOHS
2620 if (datumtype == 'v')
2621 aushort = vtohs(aushort);
79072805 2622#endif
a0d0e21e
LW
2623 culong += aushort;
2624 }
2625 }
2626 else {
2627 EXTEND(SP, len);
2628 while (len-- > 0) {
2629 Copy(s, &aushort, 1, U16);
2630 s += sizeof(U16);
2631 sv = NEWSV(39, 0);
2632#ifdef HAS_NTOHS
2633 if (datumtype == 'n')
2634 aushort = ntohs(aushort);
79072805 2635#endif
a0d0e21e
LW
2636#ifdef HAS_VTOHS
2637 if (datumtype == 'v')
2638 aushort = vtohs(aushort);
79072805 2639#endif
a0d0e21e
LW
2640 sv_setiv(sv, (I32)aushort);
2641 PUSHs(sv_2mortal(sv));
2642 }
2643 }
2644 break;
2645 case 'i':
2646 along = (strend - s) / sizeof(int);
2647 if (len > along)
2648 len = along;
2649 if (checksum) {
2650 while (len-- > 0) {
2651 Copy(s, &aint, 1, int);
2652 s += sizeof(int);
2653 if (checksum > 32)
2654 cdouble += (double)aint;
2655 else
2656 culong += aint;
2657 }
2658 }
2659 else {
2660 EXTEND(SP, len);
2661 while (len-- > 0) {
2662 Copy(s, &aint, 1, int);
2663 s += sizeof(int);
2664 sv = NEWSV(40, 0);
2665 sv_setiv(sv, (I32)aint);
2666 PUSHs(sv_2mortal(sv));
2667 }
2668 }
2669 break;
2670 case 'I':
2671 along = (strend - s) / sizeof(unsigned int);
2672 if (len > along)
2673 len = along;
2674 if (checksum) {
2675 while (len-- > 0) {
2676 Copy(s, &auint, 1, unsigned int);
2677 s += sizeof(unsigned int);
2678 if (checksum > 32)
2679 cdouble += (double)auint;
2680 else
2681 culong += auint;
2682 }
2683 }
2684 else {
2685 EXTEND(SP, len);
2686 while (len-- > 0) {
2687 Copy(s, &auint, 1, unsigned int);
2688 s += sizeof(unsigned int);
2689 sv = NEWSV(41, 0);
2690 sv_setiv(sv, (I32)auint);
2691 PUSHs(sv_2mortal(sv));
2692 }
2693 }
2694 break;
2695 case 'l':
2696 along = (strend - s) / sizeof(I32);
2697 if (len > along)
2698 len = along;
2699 if (checksum) {
2700 while (len-- > 0) {
2701 Copy(s, &along, 1, I32);
2702 s += sizeof(I32);
2703 if (checksum > 32)
2704 cdouble += (double)along;
2705 else
2706 culong += along;
2707 }
2708 }
2709 else {
2710 EXTEND(SP, len);
2711 while (len-- > 0) {
2712 Copy(s, &along, 1, I32);
2713 s += sizeof(I32);
2714 sv = NEWSV(42, 0);
2715 sv_setiv(sv, (I32)along);
2716 PUSHs(sv_2mortal(sv));
2717 }
79072805 2718 }
a0d0e21e
LW
2719 break;
2720 case 'V':
2721 case 'N':
2722 case 'L':
2723 along = (strend - s) / sizeof(U32);
2724 if (len > along)
2725 len = along;
2726 if (checksum) {
2727 while (len-- > 0) {
2728 Copy(s, &aulong, 1, U32);
2729 s += sizeof(U32);
2730#ifdef HAS_NTOHL
2731 if (datumtype == 'N')
2732 aulong = ntohl(aulong);
79072805 2733#endif
a0d0e21e
LW
2734#ifdef HAS_VTOHL
2735 if (datumtype == 'V')
2736 aulong = vtohl(aulong);
79072805 2737#endif
a0d0e21e
LW
2738 if (checksum > 32)
2739 cdouble += (double)aulong;
2740 else
2741 culong += aulong;
2742 }
2743 }
2744 else {
2745 EXTEND(SP, len);
2746 while (len-- > 0) {
2747 Copy(s, &aulong, 1, U32);
2748 s += sizeof(U32);
2749 sv = NEWSV(43, 0);
2750#ifdef HAS_NTOHL
2751 if (datumtype == 'N')
2752 aulong = ntohl(aulong);
79072805 2753#endif
a0d0e21e
LW
2754#ifdef HAS_VTOHL
2755 if (datumtype == 'V')
2756 aulong = vtohl(aulong);
79072805 2757#endif
a0d0e21e
LW
2758 sv_setnv(sv, (double)aulong);
2759 PUSHs(sv_2mortal(sv));
2760 }
2761 }
2762 break;
2763 case 'p':
2764 along = (strend - s) / sizeof(char*);
2765 if (len > along)
2766 len = along;
2767 EXTEND(SP, len);
2768 while (len-- > 0) {
2769 if (sizeof(char*) > strend - s)
2770 break;
2771 else {
2772 Copy(s, &aptr, 1, char*);
2773 s += sizeof(char*);
2774 }
2775 sv = NEWSV(44, 0);
2776 if (aptr)
2777 sv_setpv(sv, aptr);
2778 PUSHs(sv_2mortal(sv));
2779 }
2780 break;
2781 case 'P':
2782 EXTEND(SP, 1);
2783 if (sizeof(char*) > strend - s)
2784 break;
2785 else {
2786 Copy(s, &aptr, 1, char*);
2787 s += sizeof(char*);
2788 }
2789 sv = NEWSV(44, 0);
2790 if (aptr)
2791 sv_setpvn(sv, aptr, len);
2792 PUSHs(sv_2mortal(sv));
2793 break;
ecfc5424 2794#ifdef HAS_QUAD
a0d0e21e
LW
2795 case 'q':
2796 EXTEND(SP, len);
2797 while (len-- > 0) {
ecfc5424 2798 if (s + sizeof(Quad_t) > strend)
a0d0e21e
LW
2799 aquad = 0;
2800 else {
ecfc5424
AD
2801 Copy(s, &aquad, 1, Quad_t);
2802 s += sizeof(Quad_t);
a0d0e21e
LW
2803 }
2804 sv = NEWSV(42, 0);
2805 sv_setiv(sv, (IV)aquad);
2806 PUSHs(sv_2mortal(sv));
2807 }
2808 break;
2809 case 'Q':
2810 EXTEND(SP, len);
2811 while (len-- > 0) {
ecfc5424 2812 if (s + sizeof(unsigned Quad_t) > strend)
a0d0e21e
LW
2813 auquad = 0;
2814 else {
ecfc5424
AD
2815 Copy(s, &auquad, 1, unsigned Quad_t);
2816 s += sizeof(unsigned Quad_t);
a0d0e21e
LW
2817 }
2818 sv = NEWSV(43, 0);
2819 sv_setiv(sv, (IV)auquad);
2820 PUSHs(sv_2mortal(sv));
2821 }
2822 break;
79072805 2823#endif
a0d0e21e
LW
2824 /* float and double added gnb@melba.bby.oz.au 22/11/89 */
2825 case 'f':
2826 case 'F':
2827 along = (strend - s) / sizeof(float);
2828 if (len > along)
2829 len = along;
2830 if (checksum) {
2831 while (len-- > 0) {
2832 Copy(s, &afloat, 1, float);
2833 s += sizeof(float);
2834 cdouble += afloat;
2835 }
2836 }
2837 else {
2838 EXTEND(SP, len);
2839 while (len-- > 0) {
2840 Copy(s, &afloat, 1, float);
2841 s += sizeof(float);
2842 sv = NEWSV(47, 0);
2843 sv_setnv(sv, (double)afloat);
2844 PUSHs(sv_2mortal(sv));
2845 }
2846 }
2847 break;
2848 case 'd':
2849 case 'D':
2850 along = (strend - s) / sizeof(double);
2851 if (len > along)
2852 len = along;
2853 if (checksum) {
2854 while (len-- > 0) {
2855 Copy(s, &adouble, 1, double);
2856 s += sizeof(double);
2857 cdouble += adouble;
2858 }
2859 }
2860 else {
2861 EXTEND(SP, len);
2862 while (len-- > 0) {
2863 Copy(s, &adouble, 1, double);
2864 s += sizeof(double);
2865 sv = NEWSV(48, 0);
2866 sv_setnv(sv, (double)adouble);
2867 PUSHs(sv_2mortal(sv));
2868 }
2869 }
2870 break;
2871 case 'u':
2872 along = (strend - s) * 3 / 4;
2873 sv = NEWSV(42, along);
f12c7020
PP
2874 if (along)
2875 SvPOK_on(sv);
a0d0e21e
LW
2876 while (s < strend && *s > ' ' && *s < 'a') {
2877 I32 a, b, c, d;
2878 char hunk[4];
79072805 2879
a0d0e21e
LW
2880 hunk[3] = '\0';
2881 len = (*s++ - ' ') & 077;
2882 while (len > 0) {
2883 if (s < strend && *s >= ' ')
2884 a = (*s++ - ' ') & 077;
2885 else
2886 a = 0;
2887 if (s < strend && *s >= ' ')
2888 b = (*s++ - ' ') & 077;
2889 else
2890 b = 0;
2891 if (s < strend && *s >= ' ')
2892 c = (*s++ - ' ') & 077;
2893 else
2894 c = 0;
2895 if (s < strend && *s >= ' ')
2896 d = (*s++ - ' ') & 077;
2897 else
2898 d = 0;
2899 hunk[0] = a << 2 | b >> 4;
2900 hunk[1] = b << 4 | c >> 2;
2901 hunk[2] = c << 6 | d;
2902 sv_catpvn(sv, hunk, len > 3 ? 3 : len);
2903 len -= 3;
2904 }
2905 if (*s == '\n')
2906 s++;
2907 else if (s[1] == '\n') /* possible checksum byte */
2908 s += 2;
79072805 2909 }
a0d0e21e
LW
2910 XPUSHs(sv_2mortal(sv));
2911 break;
79072805 2912 }
a0d0e21e
LW
2913 if (checksum) {
2914 sv = NEWSV(42, 0);
2915 if (strchr("fFdD", datumtype) ||
2916 (checksum > 32 && strchr("iIlLN", datumtype)) ) {
2917 double trouble;
79072805 2918
a0d0e21e
LW
2919 adouble = 1.0;
2920 while (checksum >= 16) {
2921 checksum -= 16;
2922 adouble *= 65536.0;
2923 }
2924 while (checksum >= 4) {
2925 checksum -= 4;
2926 adouble *= 16.0;
2927 }
2928 while (checksum--)
2929 adouble *= 2.0;
2930 along = (1 << checksum) - 1;
2931 while (cdouble < 0.0)
2932 cdouble += adouble;
2933 cdouble = modf(cdouble / adouble, &trouble) * adouble;
2934 sv_setnv(sv, cdouble);
2935 }
2936 else {
2937 if (checksum < 32) {
2938 along = (1 << checksum) - 1;
2939 culong &= (U32)along;
2940 }
2941 sv_setnv(sv, (double)culong);
2942 }
2943 XPUSHs(sv_2mortal(sv));
2944 checksum = 0;
79072805 2945 }
79072805 2946 }
79072805 2947 RETURN;
79072805
LW
2948}
2949
a0d0e21e
LW
2950static void
2951doencodes(sv, s, len)
2952register SV *sv;
2953register char *s;
2954register I32 len;
79072805 2955{
a0d0e21e 2956 char hunk[5];
79072805 2957
a0d0e21e
LW
2958 *hunk = len + ' ';
2959 sv_catpvn(sv, hunk, 1);
2960 hunk[4] = '\0';
2961 while (len > 0) {
2962 hunk[0] = ' ' + (077 & (*s >> 2));
2963 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
2964 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
2965 hunk[3] = ' ' + (077 & (s[2] & 077));
2966 sv_catpvn(sv, hunk, 4);
2967 s += 3;
2968 len -= 3;
2969 }
2970 for (s = SvPVX(sv); *s; s++) {
2971 if (*s == ' ')
2972 *s = '`';
2973 }
2974 sv_catpvn(sv, "\n", 1);
79072805
LW
2975}
2976
a0d0e21e 2977PP(pp_pack)
79072805 2978{
a0d0e21e
LW
2979 dSP; dMARK; dORIGMARK; dTARGET;
2980 register SV *cat = TARG;
2981 register I32 items;
2982 STRLEN fromlen;
2983 register char *pat = SvPVx(*++MARK, fromlen);
2984 register char *patend = pat + fromlen;
2985 register I32 len;
2986 I32 datumtype;
2987 SV *fromstr;
2988 /*SUPPRESS 442*/
2989 static char null10[] = {0,0,0,0,0,0,0,0,0,0};
2990 static char *space10 = " ";
79072805 2991
a0d0e21e
LW
2992 /* These must not be in registers: */
2993 char achar;
2994 I16 ashort;
2995 int aint;
2996 unsigned int auint;
2997 I32 along;
2998 U32 aulong;
ecfc5424
AD
2999#ifdef HAS_QUAD
3000 Quad_t aquad;
3001 unsigned Quad_t auquad;
79072805 3002#endif
a0d0e21e
LW
3003 char *aptr;
3004 float afloat;
3005 double adouble;
79072805 3006
a0d0e21e
LW
3007 items = SP - MARK;
3008 MARK++;
3009 sv_setpvn(cat, "", 0);
3010 while (pat < patend) {
3011#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
3012 datumtype = *pat++;
3013 if (*pat == '*') {
3014 len = strchr("@Xxu", datumtype) ? 0 : items;
3015 pat++;
3016 }
3017 else if (isDIGIT(*pat)) {
3018 len = *pat++ - '0';
3019 while (isDIGIT(*pat))
3020 len = (len * 10) + (*pat++ - '0');
3021 }
3022 else
3023 len = 1;
3024 switch(datumtype) {
3025 default:
3026 break;
3027 case '%':
3028 DIE("%% may only be used in unpack");
3029 case '@':
3030 len -= SvCUR(cat);
3031 if (len > 0)
3032 goto grow;
3033 len = -len;
3034 if (len > 0)
3035 goto shrink;
3036 break;
3037 case 'X':
3038 shrink:
3039 if (SvCUR(cat) < len)
3040 DIE("X outside of string");
3041 SvCUR(cat) -= len;
3042 *SvEND(cat) = '\0';
3043 break;
3044 case 'x':
3045 grow:
3046 while (len >= 10) {
3047 sv_catpvn(cat, null10, 10);
3048 len -= 10;
3049 }
3050 sv_catpvn(cat, null10, len);
3051 break;
3052 case 'A':
3053 case 'a':
3054 fromstr = NEXTFROM;
3055 aptr = SvPV(fromstr, fromlen);
3056 if (pat[-1] == '*')
3057 len = fromlen;
3058 if (fromlen > len)
3059 sv_catpvn(cat, aptr, len);
3060 else {
3061 sv_catpvn(cat, aptr, fromlen);
3062 len -= fromlen;
3063 if (datumtype == 'A') {
3064 while (len >= 10) {
3065 sv_catpvn(cat, space10, 10);
3066 len -= 10;
3067 }
3068 sv_catpvn(cat, space10, len);
3069 }
3070 else {
3071 while (len >= 10) {
3072 sv_catpvn(cat, null10, 10);
3073 len -= 10;
3074 }
3075 sv_catpvn(cat, null10, len);
3076 }
3077 }
3078 break;
3079 case 'B':
3080 case 'b':
3081 {
3082 char *savepat = pat;
3083 I32 saveitems;
79072805 3084
a0d0e21e
LW
3085 fromstr = NEXTFROM;
3086 saveitems = items;
3087 aptr = SvPV(fromstr, fromlen);
3088 if (pat[-1] == '*')
3089 len = fromlen;
3090 pat = aptr;
3091 aint = SvCUR(cat);
3092 SvCUR(cat) += (len+7)/8;
3093 SvGROW(cat, SvCUR(cat) + 1);
3094 aptr = SvPVX(cat) + aint;
3095 if (len > fromlen)
3096 len = fromlen;
3097 aint = len;
3098 items = 0;
3099 if (datumtype == 'B') {
3100 for (len = 0; len++ < aint;) {
3101 items |= *pat++ & 1;
3102 if (len & 7)
3103 items <<= 1;
3104 else {
3105 *aptr++ = items & 0xff;
3106 items = 0;
3107 }
3108 }
3109 }
3110 else {
3111 for (len = 0; len++ < aint;) {
3112 if (*pat++ & 1)
3113 items |= 128;
3114 if (len & 7)
3115 items >>= 1;
3116 else {
3117 *aptr++ = items & 0xff;
3118 items = 0;
3119 }
3120 }
3121 }
3122 if (aint & 7) {
3123 if (datumtype == 'B')
3124 items <<= 7 - (aint & 7);
3125 else
3126 items >>= 7 - (aint & 7);
3127 *aptr++ = items & 0xff;
3128 }
3129 pat = SvPVX(cat) + SvCUR(cat);
3130 while (aptr <= pat)
3131 *aptr++ = '\0';
79072805 3132
a0d0e21e
LW
3133 pat = savepat;
3134 items = saveitems;
3135 }
3136 break;
3137 case 'H':
3138 case 'h':
3139 {
3140 char *savepat = pat;
3141 I32 saveitems;
79072805 3142
a0d0e21e
LW
3143 fromstr = NEXTFROM;
3144 saveitems = items;
3145 aptr = SvPV(fromstr, fromlen);
3146 if (pat[-1] == '*')
3147 len = fromlen;
3148 pat = aptr;
3149 aint = SvCUR(cat);
3150 SvCUR(cat) += (len+1)/2;
3151 SvGROW(cat, SvCUR(cat) + 1);
3152 aptr = SvPVX(cat) + aint;
3153 if (len > fromlen)
3154 len = fromlen;
3155 aint = len;
3156 items = 0;
3157 if (datumtype == 'H') {
3158 for (len = 0; len++ < aint;) {
3159 if (isALPHA(*pat))
3160 items |= ((*pat++ & 15) + 9) & 15;
3161 else
3162 items |= *pat++ & 15;
3163 if (len & 1)
3164 items <<= 4;
3165 else {
3166 *aptr++ = items & 0xff;
3167 items = 0;
3168 }
3169 }
3170 }
3171 else {
3172 for (len = 0; len++ < aint;) {
3173 if (isALPHA(*pat))
3174 items |= (((*pat++ & 15) + 9) & 15) << 4;
3175 else
3176 items |= (*pat++ & 15) << 4;
3177 if (len & 1)
3178 items >>= 4;
3179 else {
3180 *aptr++ = items & 0xff;
3181 items = 0;
3182 }
3183 }
3184 }
3185 if (aint & 1)
3186 *aptr++ = items & 0xff;
3187 pat = SvPVX(cat) + SvCUR(cat);
3188 while (aptr <= pat)
3189 *aptr++ = '\0';
79072805 3190
a0d0e21e
LW
3191 pat = savepat;
3192 items = saveitems;
3193 }
3194 break;
3195 case 'C':
3196 case 'c':
3197 while (len-- > 0) {
3198 fromstr = NEXTFROM;
3199 aint = SvIV(fromstr);
3200 achar = aint;
3201 sv_catpvn(cat, &achar, sizeof(char));
3202 }
3203 break;
3204 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
3205 case 'f':
3206 case 'F':
3207 while (len-- > 0) {
3208 fromstr = NEXTFROM;
3209 afloat = (float)SvNV(fromstr);
3210 sv_catpvn(cat, (char *)&afloat, sizeof (float));
3211 }
3212 break;
3213 case 'd':
3214 case 'D':
3215 while (len-- > 0) {
3216 fromstr = NEXTFROM;
3217 adouble = (double)SvNV(fromstr);
3218 sv_catpvn(cat, (char *)&adouble, sizeof (double));
3219 }
3220 break;
3221 case 'n':
3222 while (len-- > 0) {
3223 fromstr = NEXTFROM;
3224 ashort = (I16)SvIV(fromstr);
3225#ifdef HAS_HTONS
3226 ashort = htons(ashort);
79072805 3227#endif
a0d0e21e
LW
3228 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3229 }
3230 break;
3231 case 'v':
3232 while (len-- > 0) {
3233 fromstr = NEXTFROM;
3234 ashort = (I16)SvIV(fromstr);
3235#ifdef HAS_HTOVS
3236 ashort = htovs(ashort);
79072805 3237#endif
a0d0e21e
LW
3238 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3239 }
3240 break;
3241 case 'S':
3242 case 's':
3243 while (len-- > 0) {
3244 fromstr = NEXTFROM;
3245 ashort = (I16)SvIV(fromstr);
3246 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3247 }
3248 break;
3249 case 'I':
3250 while (len-- > 0) {
3251 fromstr = NEXTFROM;
3252 auint = U_I(SvNV(fromstr));
3253 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
3254 }
3255 break;
3256 case 'i':
3257 while (len-- > 0) {
3258 fromstr = NEXTFROM;
3259 aint = SvIV(fromstr);
3260 sv_catpvn(cat, (char*)&aint, sizeof(int));
3261 }
3262 break;
3263 case 'N':
3264 while (len-- > 0) {
3265 fromstr = NEXTFROM;
3266 aulong = U_L(SvNV(fromstr));
3267#ifdef HAS_HTONL
3268 aulong = htonl(aulong);
79072805 3269#endif
a0d0e21e
LW
3270 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3271 }
3272 break;
3273 case 'V':
3274 while (len-- > 0) {
3275 fromstr = NEXTFROM;
3276 aulong = U_L(SvNV(fromstr));
3277#ifdef HAS_HTOVL
3278 aulong = htovl(aulong);
79072805 3279#endif
a0d0e21e
LW
3280 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3281 }
3282 break;
3283 case 'L':
3284 while (len-- > 0) {
3285 fromstr = NEXTFROM;
3286 aulong = U_L(SvNV(fromstr));
3287 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3288 }
3289 break;
3290 case 'l':
3291 while (len-- > 0) {
3292 fromstr = NEXTFROM;
3293 along = SvIV(fromstr);
3294 sv_catpvn(cat, (char*)&along, sizeof(I32));
3295 }
3296 break;
ecfc5424 3297#ifdef HAS_QUAD
a0d0e21e
LW
3298 case 'Q':
3299 while (len-- > 0) {
3300 fromstr = NEXTFROM;
ecfc5424
AD
3301 auquad = (unsigned Quad_t)SvIV(fromstr);
3302 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
a0d0e21e
LW
3303 }
3304 break;
3305 case 'q':
3306 while (len-- > 0) {
3307 fromstr = NEXTFROM;
ecfc5424
AD
3308 aquad = (Quad_t)SvIV(fromstr);
3309 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
a0d0e21e
LW
3310 }
3311 break;
ecfc5424 3312#endif /* HAS_QUAD */
a0d0e21e
LW
3313 case 'P':
3314 len = 1; /* assume SV is correct length */
3315 /* FALL THROUGH */
3316 case 'p':
3317 while (len-- > 0) {
3318 fromstr = NEXTFROM;
3319 aptr = SvPV_force(fromstr, na); /* XXX Error if TEMP? */
3320 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
3321 }
3322 break;
3323 case 'u':
3324 fromstr = NEXTFROM;
3325 aptr = SvPV(fromstr, fromlen);
3326 SvGROW(cat, fromlen * 4 / 3);
3327 if (len <= 1)
3328 len = 45;
3329 else
3330 len = len / 3 * 3;
3331 while (fromlen > 0) {
3332 I32 todo;
79072805 3333
a0d0e21e
LW
3334 if (fromlen > len)
3335 todo = len;
3336 else
3337 todo = fromlen;
3338 doencodes(cat, aptr, todo);
3339 fromlen -= todo;
3340 aptr += todo;
3341 }
3342 break;
3343 }
3344 }
3345 SvSETMAGIC(cat);
3346 SP = ORIGMARK;
3347 PUSHs(cat);
3348 RETURN;
79072805 3349}
a0d0e21e 3350#undef NEXTFROM
79072805 3351
a0d0e21e 3352PP(pp_split)
79072805 3353{
a0d0e21e
LW
3354 dSP; dTARG;
3355 AV *ary;
3356 register I32 limit = POPi; /* note, negative is forever */
3357 SV *sv = POPs;
3358 STRLEN len;
3359 register char *s = SvPV(sv, len);
3360 char *strend = s + len;
3361 register PMOP *pm = (PMOP*)POPs;
3362 register SV *dstr;
3363 register char *m;
3364 I32 iters = 0;
3365 I32 maxiters = (strend - s) + 10;
3366 I32 i;
3367 char *orig;
3368 I32 origlimit = limit;
3369 I32 realarray = 0;
3370 I32 base;
f12c7020 3371 AV *oldstack = curstack;
a0d0e21e
LW
3372 register REGEXP *rx = pm->op_pmregexp;
3373 I32 gimme = GIMME;
c07a80fd 3374 I32 oldsave = savestack_ix;
79072805 3375
a0d0e21e
LW
3376 if (!pm || !s)
3377 DIE("panic: do_split");
3378 if (pm->op_pmreplroot)
3379 ary = GvAVn((GV*)pm->op_pmreplroot);
3380 else if (gimme != G_ARRAY)
3381 ary = GvAVn(defgv);
79072805 3382 else
a0d0e21e
LW
3383 ary = Nullav;
3384 if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
3385 realarray = 1;
3386 if (!AvREAL(ary)) {
3387 AvREAL_on(ary);
3388 for (i = AvFILL(ary); i >= 0; i--)
3389 AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */
79072805 3390 }
a0d0e21e
LW
3391 av_extend(ary,0);
3392 av_clear(ary);
3393 /* temporarily switch stacks */
f12c7020 3394 SWITCHSTACK(curstack, ary);
79072805 3395 }
a0d0e21e
LW
3396 base = SP - stack_base;
3397 orig = s;
3398 if (pm->op_pmflags & PMf_SKIPWHITE) {
3399 while (isSPACE(*s))
3400 s++;
3401 }
c07a80fd
PP
3402 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3403 SAVEINT(multiline);
3404 multiline = pm->op_pmflags & PMf_MULTILINE;
3405 }
3406
a0d0e21e
LW
3407 if (!limit)
3408 limit = maxiters + 2;
3409 if (pm->op_pmflags & PMf_WHITE) {
3410 while (--limit) {
3411 /*SUPPRESS 530*/
3412 for (m = s; m < strend && !isSPACE(*m); m++) ;
3413 if (m >= strend)
3414 break;
3415 dstr = NEWSV(30, m-s);
3416 sv_setpvn(dstr, s, m-s);
3417 if (!realarray)
3418 sv_2mortal(dstr);
3419 XPUSHs(dstr);
3420 /*SUPPRESS 530*/
3421 for (s = m + 1; s < strend && isSPACE(*s); s++) ;
79072805
LW
3422 }
3423 }
a0d0e21e
LW
3424 else if (strEQ("^", rx->precomp)) {
3425 while (--limit) {
3426 /*SUPPRESS 530*/
3427 for (m = s; m < strend && *m != '\n'; m++) ;
3428 m++;
3429 if (m >= strend)
3430 break;
3431 dstr = NEWSV(30, m-s);
3432 sv_setpvn(dstr, s, m-s);
3433 if (!realarray)
3434 sv_2mortal(dstr);
3435 XPUSHs(dstr);
3436 s = m;
3437 }
3438 }
3439 else if (pm->op_pmshort) {
3440 i = SvCUR(pm->op_pmshort);
3441 if (i == 1) {
3442 I32 fold = (pm->op_pmflags & PMf_FOLD);
3443 i = *SvPVX(pm->op_pmshort);
3444 if (fold && isUPPER(i))
3445 i = toLOWER(i);
3446 while (--limit) {
3447 if (fold) {
3448 for ( m = s;
3449 m < strend && *m != i &&
3450 (!isUPPER(*m) || toLOWER(*m) != i);
3451 m++) /*SUPPRESS 530*/
3452 ;
3453 }
3454 else /*SUPPRESS 530*/
3455 for (m = s; m < strend && *m != i; m++) ;
3456 if (m >= strend)
3457 break;
3458 dstr = NEWSV(30, m-s);
3459 sv_setpvn(dstr, s, m-s);
3460 if (!realarray)
3461 sv_2mortal(dstr);
3462 XPUSHs(dstr);
3463 s = m + 1;
3464 }
3465 }
3466 else {
3467#ifndef lint
3468 while (s < strend && --limit &&
3469 (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
3470 pm->op_pmshort)) )
79072805 3471#endif
a0d0e21e
LW
3472 {
3473 dstr = NEWSV(31, m-s);
3474 sv_setpvn(dstr, s, m-s);
3475 if (!realarray)
3476 sv_2mortal(dstr);
3477 XPUSHs(dstr);
3478 s = m + i;
3479 }
463ee0b2 3480 }
463ee0b2 3481 }
a0d0e21e
LW
3482 else {
3483 maxiters += (strend - s) * rx->nparens;
3484 while (s < strend && --limit &&
e50aee73 3485 pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
a0d0e21e
LW
3486 if (rx->subbase
3487 && rx->subbase != orig) {
3488 m = s;
3489 s = orig;
3490 orig = rx->subbase;
3491 s = orig + (m - s);
3492 strend = s + (strend - m);
3493 }
3494 m = rx->startp[0];
3495 dstr = NEWSV(32, m-s);
3496 sv_setpvn(dstr, s, m-s);
3497 if (!realarray)
3498 sv_2mortal(dstr);
3499 XPUSHs(dstr);
3500 if (rx->nparens) {
3501 for (i = 1; i <= rx->nparens; i++) {
3502 s = rx->startp[i];
3503 m = rx->endp[i];
748a9306
LW
3504 if (m && s) {
3505 dstr = NEWSV(33, m-s);
3506 sv_setpvn(dstr, s, m-s);
3507 }
3508 else
3509 dstr = NEWSV(33, 0);
a0d0e21e
LW
3510 if (!realarray)
3511 sv_2mortal(dstr);
3512 XPUSHs(dstr);
3513 }
3514 }
3515 s = rx->endp[0];
3516 }
79072805 3517 }
c07a80fd 3518 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
3519 iters = (SP - stack_base) - base;
3520 if (iters > maxiters)
3521 DIE("Split loop");
3522
3523 /* keep field after final delim? */
3524 if (s < strend || (iters && origlimit)) {
3525 dstr = NEWSV(34, strend-s);
3526 sv_setpvn(dstr, s, strend-s);
3527 if (!realarray)
3528 sv_2mortal(dstr);
3529 XPUSHs(dstr);
3530 iters++;
79072805 3531 }
a0d0e21e 3532 else if (!origlimit) {
b1dadf13 3533 while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
a0d0e21e
LW
3534 iters--, SP--;
3535 }
3536 if (realarray) {
3537 SWITCHSTACK(ary, oldstack);
3538 if (gimme == G_ARRAY) {
3539 EXTEND(SP, iters);
3540 Copy(AvARRAY(ary), SP + 1, iters, SV*);
3541 SP += iters;
3542 RETURN;
3543 }
3544 }
3545 else {
3546 if (gimme == G_ARRAY)
3547 RETURN;
3548 }
3549 if (iters || !pm->op_pmreplroot) {
3550 GETTARGET;
3551 PUSHi(iters);
3552 RETURN;
3553 }
3554 RETPUSHUNDEF;
79072805 3555}
85e6fe83 3556