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