3 * Copyright (c) 1991-2002, Larry Wall
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.
11 * He still hopefully carried some of his gear in his pack: a small tinder-box,
12 * two small shallow pans, the smaller fitting into the larger; inside them a
13 * wooden spoon, a short two-pronged fork and some skewers were stowed; and
14 * hidden at the bottom of the pack in a flat wooden box a dwindling treasure,
19 #define PERL_IN_PP_PACK_C
23 * The compiler on Concurrent CX/UX systems has a subtle bug which only
24 * seems to show up when compiling pp.c - it generates the wrong double
25 * precision constant value for (double)UV_MAX when used inline in the body
26 * of the code below, so this makes a static variable up front (which the
27 * compiler seems to get correct) and uses it in place of UV_MAX below.
29 #ifdef CXUX_BROKEN_CONSTANT_CONVERT
30 static double UV_MAX_cxux = ((double)UV_MAX);
34 * Offset for integer pack/unpack.
36 * On architectures where I16 and I32 aren't really 16 and 32 bits,
37 * which for now are all Crays, pack and unpack have to play games.
41 * These values are required for portability of pack() output.
42 * If they're not right on your machine, then pack() and unpack()
43 * wouldn't work right anyway; you'll need to apply the Cray hack.
44 * (I'd like to check them with #if, but you can't use sizeof() in
45 * the preprocessor.) --???
48 The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
49 defines are now in config.h. --Andy Dougherty April 1998
54 /* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
57 #if SHORTSIZE != SIZE16 || LONGSIZE != SIZE32
58 # define PERL_NATINT_PACK
61 #if LONGSIZE > 4 && defined(_CRAY)
62 # if BYTEORDER == 0x12345678
63 # define OFF16(p) (char*)(p)
64 # define OFF32(p) (char*)(p)
66 # if BYTEORDER == 0x87654321
67 # define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16))
68 # define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32))
70 }}}} bad cray byte order
73 # define COPY16(s,p) (*(p) = 0, Copy(s, OFF16(p), SIZE16, char))
74 # define COPY32(s,p) (*(p) = 0, Copy(s, OFF32(p), SIZE32, char))
75 # define COPYNN(s,p,n) (*(p) = 0, Copy(s, (char *)(p), n, char))
76 # define CAT16(sv,p) sv_catpvn(sv, OFF16(p), SIZE16)
77 # define CAT32(sv,p) sv_catpvn(sv, OFF32(p), SIZE32)
79 # define COPY16(s,p) Copy(s, p, SIZE16, char)
80 # define COPY32(s,p) Copy(s, p, SIZE32, char)
81 # define COPYNN(s,p,n) Copy(s, (char *)(p), n, char)
82 # define CAT16(sv,p) sv_catpvn(sv, (char*)(p), SIZE16)
83 # define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32)
87 S_mul128(pTHX_ SV *sv, U8 m)
90 char *s = SvPV(sv, len);
94 if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
95 SV *tmpNew = newSVpvn("0000000000", 10);
98 SvREFCNT_dec(sv); /* free old sv */
103 while (!*t) /* trailing '\0'? */
106 i = ((*t - '0') << 7) + m;
107 *(t--) = '0' + (char)(i % 10);
113 /* Explosives and implosives. */
115 #if 'I' == 73 && 'J' == 74
116 /* On an ASCII/ISO kind of system */
117 #define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
120 Some other sort of character set - use memchr() so we don't match
123 #define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ')
126 #define UNPACK_ONLY_ONE 0x1
127 #define UNPACK_DO_UTF8 0x2
130 S_group_end(pTHX_ register char *pat, register char *patend, char ender)
132 while (pat < patend) {
140 while (pat < patend && *pat != '\n')
144 pat = group_end(pat, patend, ')') + 1;
146 pat = group_end(pat, patend, ']') + 1;
148 Perl_croak(aTHX_ "No group ending character `%c' found", ender);
152 #define TYPE_IS_SHRIEKING 0x100
154 /* Returns the sizeof() struct described by pat */
156 S_measure_struct(pTHX_ char *pat, register char *patend)
160 register I32 total = 0;
162 int star; /* 1 if count is *, -1 if no count given, -2 for / */
163 #ifdef PERL_NATINT_PACK
164 int natint; /* native integer */
165 int unatint; /* unsigned native integer */
170 while ((pat = next_symbol(pat, patend)) < patend) {
171 datumtype = *pat++ & 0xFF;
172 #ifdef PERL_NATINT_PACK
176 static const char *natstr = "sSiIlLxX";
178 if (strchr(natstr, datumtype)) {
179 if (datumtype == 'x' || datumtype == 'X') {
180 datumtype |= TYPE_IS_SHRIEKING;
181 } else { /* XXXX Should be redone similarly! */
182 #ifdef PERL_NATINT_PACK
189 Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
191 len = find_count(&pat, patend, &star);
193 Perl_croak(aTHX_ "%s not allowed in length fields", "count *");
194 else if (star < 0) /* No explicit len */
195 len = datumtype != '@';
199 Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
202 case 'U': /* XXXX Is it correct? */
205 buf[0] = (char)datumtype;
207 Perl_croak(aTHX_ "%s not allowed in length fields", buf);
208 case ',': /* grandfather in commas but with a warning */
209 if (commas++ == 0 && ckWARN(WARN_UNPACK))
210 Perl_warner(aTHX_ packWARN(WARN_UNPACK),
211 "Invalid type in unpack: '%c'", (int)datumtype);
218 char *beg = pat, *end;
221 Perl_croak(aTHX_ "()-group starts with a count");
222 end = group_end(beg, patend, ')');
224 len = find_count(&pat, patend, &star);
225 if (star < 0) /* No count */
227 else if (star > 0) /* Star */
228 Perl_croak(aTHX_ "%s not allowed in length fields", "count *");
229 /* XXXX Theoretically, we need to measure many times at different
230 positions, since the subexpression may contain
231 alignment commands, but be not of aligned length.
232 Need to detect this and croak(). */
233 size = measure_struct(beg, end);
236 case 'X' | TYPE_IS_SHRIEKING:
237 /* XXXX Is this useful? Then need to treat MEASURE_BACKWARDS. */
238 if (!len) /* Avoid division by 0 */
240 len = total % len; /* Assumed: the start is aligned. */
245 Perl_croak(aTHX_ "X outside of string");
247 case 'x' | TYPE_IS_SHRIEKING:
248 if (!len) /* Avoid division by 0 */
250 star = total % len; /* Assumed: the start is aligned. */
251 if (star) /* Other portable ways? */
275 #if SHORTSIZE == SIZE16
278 size = (natint ? sizeof(short) : SIZE16);
284 #if SHORTSIZE == SIZE16
287 unatint = natint && datumtype == 'S';
288 size = (unatint ? sizeof(unsigned short) : SIZE16);
295 size = sizeof(unsigned int);
304 #if LONGSIZE == SIZE32
307 size = (natint ? sizeof(long) : SIZE32);
313 #if LONGSIZE == SIZE32
316 unatint = natint && datumtype == 'L';
317 size = (unatint ? sizeof(unsigned long) : SIZE32);
324 size = sizeof(char*);
328 size = sizeof(Quad_t);
331 size = sizeof(Uquad_t);
335 size = sizeof(float);
338 size = sizeof(double);
343 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
345 size = LONG_DOUBLESIZE;
354 /* Returns -1 on no count or on star */
356 S_find_count(pTHX_ char **ppat, register char *patend, int *star)
364 else if (*pat == '*') {
369 else if (isDIGIT(*pat)) {
371 while (isDIGIT(*pat)) {
372 len = (len * 10) + (*pat++ - '0');
373 if (len < 0) /* 50% chance of catching... */
374 Perl_croak(aTHX_ "Repeat count in pack/unpack overflows");
377 else if (*pat == '[') {
378 char *end = group_end(++pat, patend, ']');
383 return find_count(&pat, end, star);
384 return measure_struct(pat, end);
393 S_next_symbol(pTHX_ register char *pat, register char *patend)
395 while (pat < patend) {
398 else if (*pat == '#') {
400 while (pat < patend && *pat != '\n')
412 =for apidoc unpack_str
414 The engine implementing unpack() Perl function.
419 Perl_unpack_str(pTHX_ char *pat, register char *patend, register char *s, char *strbeg, char *strend, char **new_s, I32 ocnt, U32 flags)
424 register I32 bits = 0;
427 I32 start_sp_offset = SP - PL_stack_base;
429 /* These must not be in registers: */
448 const int bits_in_uv = 8 * sizeof(cuv);
450 int star; /* 1 if count is *, -1 if no count given, -2 for / */
451 #ifdef PERL_NATINT_PACK
452 int natint; /* native integer */
453 int unatint; /* unsigned native integer */
458 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
459 long double aldouble;
461 bool do_utf8 = (flags & UNPACK_DO_UTF8) != 0;
463 while ((pat = next_symbol(pat, patend)) < patend) {
464 datumtype = *pat++ & 0xFF;
465 #ifdef PERL_NATINT_PACK
468 /* do first one only unless in list context
469 / is implemented by unpacking the count, then poping it from the
470 stack, so must check that we're not in the middle of a / */
471 if ( (flags & UNPACK_ONLY_ONE)
472 && (SP - PL_stack_base == start_sp_offset + 1)
473 && (datumtype != '/') )
476 static const char natstr[] = "sSiIlLxX";
478 if (strchr(natstr, datumtype)) {
479 if (datumtype == 'x' || datumtype == 'X') {
480 datumtype |= TYPE_IS_SHRIEKING;
481 } else { /* XXXX Should be redone similarly! */
482 #ifdef PERL_NATINT_PACK
489 Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
491 len = find_count(&pat, patend, &star);
493 len = strend - strbeg; /* long enough */
494 else if (star < 0) /* No explicit len */
495 len = datumtype != '@';
500 Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
501 case ',': /* grandfather in commas but with a warning */
502 if (commas++ == 0 && ckWARN(WARN_UNPACK))
503 Perl_warner(aTHX_ packWARN(WARN_UNPACK),
504 "Invalid type in unpack: '%c'", (int)datumtype);
507 if (len == 1 && pat[-1] != '1' && pat[-1] != ']')
508 len = 16; /* len is not specified */
517 char *ss = s; /* Move from register */
520 Perl_croak(aTHX_ "()-group starts with a count");
521 aptr = group_end(beg, patend, ')');
524 len = find_count(&pat, patend, &star);
525 if (star < 0) /* No count */
527 else if (star > 0) /* Star */
528 len = strend - strbeg; /* long enough? */
532 unpack_str(beg, aptr, ss, strbeg, strend, &ss,
533 ocnt + SP - PL_stack_base - start_sp_offset, flags);
534 if (star > 0 && ss == strend)
535 break; /* No way to continue */
542 if (len > strend - strbeg)
543 Perl_croak(aTHX_ "@ outside of string");
546 case 'X' | TYPE_IS_SHRIEKING:
547 if (!len) /* Avoid division by 0 */
549 len = (s - strbeg) % len;
552 if (len > s - strbeg)
553 Perl_croak(aTHX_ "X outside of string");
556 case 'x' | TYPE_IS_SHRIEKING:
557 if (!len) /* Avoid division by 0 */
559 aint = (s - strbeg) % len;
560 if (aint) /* Other portable ways? */
566 if (len > strend - s)
567 Perl_croak(aTHX_ "x outside of string");
571 if (ocnt + SP - PL_stack_base - start_sp_offset <= 0)
572 Perl_croak(aTHX_ "/ must follow a numeric type");
575 pat++; /* ignore '*' for compatibility with pack */
577 Perl_croak(aTHX_ "/ cannot take a count" );
584 if (len > strend - s)
589 sv_setpvn(sv, s, len);
590 if (datumtype == 'A' || datumtype == 'Z') {
591 aptr = s; /* borrow register */
592 if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
596 if (star > 0) /* exact for 'Z*' */
597 len = s - SvPVX(sv) + 1;
599 else { /* 'A' strips both nulls and spaces */
600 s = SvPVX(sv) + len - 1;
601 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
605 SvCUR_set(sv, s - SvPVX(sv));
606 s = aptr; /* unborrow register */
609 XPUSHs(sv_2mortal(sv));
613 if (star > 0 || len > (strend - s) * 8)
614 len = (strend - s) * 8;
617 Newz(601, PL_bitcount, 256, char);
618 for (bits = 1; bits < 256; bits++) {
619 if (bits & 1) PL_bitcount[bits]++;
620 if (bits & 2) PL_bitcount[bits]++;
621 if (bits & 4) PL_bitcount[bits]++;
622 if (bits & 8) PL_bitcount[bits]++;
623 if (bits & 16) PL_bitcount[bits]++;
624 if (bits & 32) PL_bitcount[bits]++;
625 if (bits & 64) PL_bitcount[bits]++;
626 if (bits & 128) PL_bitcount[bits]++;
630 cuv += PL_bitcount[*(unsigned char*)s++];
635 if (datumtype == 'b') {
643 if (bits & 128) cuv++;
650 sv = NEWSV(35, len + 1);
654 if (datumtype == 'b') {
656 for (len = 0; len < aint; len++) {
657 if (len & 7) /*SUPPRESS 595*/
661 *str++ = '0' + (bits & 1);
666 for (len = 0; len < aint; len++) {
671 *str++ = '0' + ((bits & 128) != 0);
675 XPUSHs(sv_2mortal(sv));
679 if (star > 0 || len > (strend - s) * 2)
680 len = (strend - s) * 2;
681 sv = NEWSV(35, len + 1);
685 if (datumtype == 'h') {
687 for (len = 0; len < aint; len++) {
692 *str++ = PL_hexdigit[bits & 15];
697 for (len = 0; len < aint; len++) {
702 *str++ = PL_hexdigit[(bits >> 4) & 15];
706 XPUSHs(sv_2mortal(sv));
709 if (len > strend - s)
714 if (aint >= 128) /* fake up signed chars */
716 if (checksum > bits_in_uv)
723 if (len && (flags & UNPACK_ONLY_ONE))
729 if (aint >= 128) /* fake up signed chars */
732 sv_setiv(sv, (IV)aint);
733 PUSHs(sv_2mortal(sv));
738 unpack_C: /* unpack U will jump here if not UTF-8 */
743 if (len > strend - s)
753 if (len && (flags & UNPACK_ONLY_ONE))
760 sv_setiv(sv, (IV)auint);
761 PUSHs(sv_2mortal(sv));
772 if (len > strend - s)
775 while (len-- > 0 && s < strend) {
777 auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV));
780 if (checksum > bits_in_uv)
781 cdouble += (NV)auint;
787 if (len && (flags & UNPACK_ONLY_ONE))
791 while (len-- > 0 && s < strend) {
793 auint = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &alen, ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANYUV));
797 sv_setuv(sv, (UV)auint);
798 PUSHs(sv_2mortal(sv));
803 #if SHORTSIZE == SIZE16
804 along = (strend - s) / SIZE16;
806 along = (strend - s) / (natint ? sizeof(short) : SIZE16);
811 #if SHORTSIZE != SIZE16
815 COPYNN(s, &ashort, sizeof(short));
817 if (checksum > bits_in_uv)
818 cdouble += (NV)ashort;
829 #if SHORTSIZE > SIZE16
834 if (checksum > bits_in_uv)
835 cdouble += (NV)ashort;
842 if (len && (flags & UNPACK_ONLY_ONE))
846 #if SHORTSIZE != SIZE16
850 COPYNN(s, &ashort, sizeof(short));
853 sv_setiv(sv, (IV)ashort);
854 PUSHs(sv_2mortal(sv));
862 #if SHORTSIZE > SIZE16
868 sv_setiv(sv, (IV)ashort);
869 PUSHs(sv_2mortal(sv));
877 #if SHORTSIZE == SIZE16
878 along = (strend - s) / SIZE16;
880 unatint = natint && datumtype == 'S';
881 along = (strend - s) / (unatint ? sizeof(unsigned short) : SIZE16);
886 #if SHORTSIZE != SIZE16
888 unsigned short aushort;
890 COPYNN(s, &aushort, sizeof(unsigned short));
891 s += sizeof(unsigned short);
892 if (checksum > bits_in_uv)
893 cdouble += (NV)aushort;
905 if (datumtype == 'n')
906 aushort = PerlSock_ntohs(aushort);
909 if (datumtype == 'v')
910 aushort = vtohs(aushort);
912 if (checksum > bits_in_uv)
913 cdouble += (NV)aushort;
920 if (len && (flags & UNPACK_ONLY_ONE))
924 #if SHORTSIZE != SIZE16
926 unsigned short aushort;
928 COPYNN(s, &aushort, sizeof(unsigned short));
929 s += sizeof(unsigned short);
931 sv_setiv(sv, (UV)aushort);
932 PUSHs(sv_2mortal(sv));
943 if (datumtype == 'n')
944 aushort = PerlSock_ntohs(aushort);
947 if (datumtype == 'v')
948 aushort = vtohs(aushort);
950 sv_setiv(sv, (UV)aushort);
951 PUSHs(sv_2mortal(sv));
957 along = (strend - s) / sizeof(int);
962 Copy(s, &aint, 1, int);
964 if (checksum > bits_in_uv)
971 if (len && (flags & UNPACK_ONLY_ONE))
976 Copy(s, &aint, 1, int);
980 /* Without the dummy below unpack("i", pack("i",-1))
981 * return 0xFFffFFff instead of -1 for Digital Unix V4.0
982 * cc with optimization turned on.
984 * The bug was detected in
985 * DEC C V5.8-009 on Digital UNIX V4.0 (Rev. 1091) (V4.0E)
986 * with optimization (-O4) turned on.
987 * DEC C V5.2-040 on Digital UNIX V4.0 (Rev. 564) (V4.0B)
988 * does not have this problem even with -O4.
990 * This bug was reported as DECC_BUGS 1431
991 * and tracked internally as GEM_BUGS 7775.
993 * The bug is fixed in
994 * Tru64 UNIX V5.0: Compaq C V6.1-006 or later
995 * UNIX V4.0F support: DEC C V5.9-006 or later
996 * UNIX V4.0E support: DEC C V5.8-011 or later
999 * See also few lines later for the same bug.
1002 sv_setiv(sv, (IV)aint) :
1004 sv_setiv(sv, (IV)aint);
1005 PUSHs(sv_2mortal(sv));
1010 along = (strend - s) / sizeof(unsigned int);
1015 Copy(s, &auint, 1, unsigned int);
1016 s += sizeof(unsigned int);
1017 if (checksum > bits_in_uv)
1018 cdouble += (NV)auint;
1024 if (len && (flags & UNPACK_ONLY_ONE))
1029 Copy(s, &auint, 1, unsigned int);
1030 s += sizeof(unsigned int);
1033 /* Without the dummy below unpack("I", pack("I",0xFFFFFFFF))
1034 * returns 1.84467440737096e+19 instead of 0xFFFFFFFF.
1035 * See details few lines earlier. */
1037 sv_setuv(sv, (UV)auint) :
1039 sv_setuv(sv, (UV)auint);
1040 PUSHs(sv_2mortal(sv));
1045 along = (strend - s) / IVSIZE;
1050 Copy(s, &aiv, 1, IV);
1052 if (checksum > bits_in_uv)
1059 if (len && (flags & UNPACK_ONLY_ONE))
1064 Copy(s, &aiv, 1, IV);
1068 PUSHs(sv_2mortal(sv));
1073 along = (strend - s) / UVSIZE;
1078 Copy(s, &auv, 1, UV);
1080 if (checksum > bits_in_uv)
1087 if (len && (flags & UNPACK_ONLY_ONE))
1092 Copy(s, &auv, 1, UV);
1096 PUSHs(sv_2mortal(sv));
1101 #if LONGSIZE == SIZE32
1102 along = (strend - s) / SIZE32;
1104 along = (strend - s) / (natint ? sizeof(long) : SIZE32);
1109 #if LONGSIZE != SIZE32
1112 COPYNN(s, &along, sizeof(long));
1114 if (checksum > bits_in_uv)
1115 cdouble += (NV)along;
1124 #if LONGSIZE > SIZE32 && INTSIZE == SIZE32
1128 #if LONGSIZE > SIZE32
1129 if (along > 2147483647)
1130 along -= 4294967296;
1133 if (checksum > bits_in_uv)
1134 cdouble += (NV)along;
1141 if (len && (flags & UNPACK_ONLY_ONE))
1145 #if LONGSIZE != SIZE32
1148 COPYNN(s, &along, sizeof(long));
1151 sv_setiv(sv, (IV)along);
1152 PUSHs(sv_2mortal(sv));
1159 #if LONGSIZE > SIZE32 && INTSIZE == SIZE32
1163 #if LONGSIZE > SIZE32
1164 if (along > 2147483647)
1165 along -= 4294967296;
1169 sv_setiv(sv, (IV)along);
1170 PUSHs(sv_2mortal(sv));
1178 #if LONGSIZE == SIZE32
1179 along = (strend - s) / SIZE32;
1181 unatint = natint && datumtype == 'L';
1182 along = (strend - s) / (unatint ? sizeof(unsigned long) : SIZE32);
1187 #if LONGSIZE != SIZE32
1189 unsigned long aulong;
1191 COPYNN(s, &aulong, sizeof(unsigned long));
1192 s += sizeof(unsigned long);
1193 if (checksum > bits_in_uv)
1194 cdouble += (NV)aulong;
1206 if (datumtype == 'N')
1207 aulong = PerlSock_ntohl(aulong);
1210 if (datumtype == 'V')
1211 aulong = vtohl(aulong);
1213 if (checksum > bits_in_uv)
1214 cdouble += (NV)aulong;
1221 if (len && (flags & UNPACK_ONLY_ONE))
1225 #if LONGSIZE != SIZE32
1227 unsigned long aulong;
1229 COPYNN(s, &aulong, sizeof(unsigned long));
1230 s += sizeof(unsigned long);
1232 sv_setuv(sv, (UV)aulong);
1233 PUSHs(sv_2mortal(sv));
1243 if (datumtype == 'N')
1244 aulong = PerlSock_ntohl(aulong);
1247 if (datumtype == 'V')
1248 aulong = vtohl(aulong);
1251 sv_setuv(sv, (UV)aulong);
1252 PUSHs(sv_2mortal(sv));
1258 along = (strend - s) / sizeof(char*);
1264 if (sizeof(char*) > strend - s)
1267 Copy(s, &aptr, 1, char*);
1273 PUSHs(sv_2mortal(sv));
1277 if (len && (flags & UNPACK_ONLY_ONE))
1285 while ((len > 0) && (s < strend)) {
1286 auv = (auv << 7) | (*s & 0x7f);
1287 /* UTF8_IS_XXXXX not right here - using constant 0x80 */
1288 if ((U8)(*s++) < 0x80) {
1292 PUSHs(sv_2mortal(sv));
1296 else if (++bytes >= sizeof(UV)) { /* promote to string */
1300 sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (int)TYPE_DIGITS(UV), auv);
1301 while (s < strend) {
1302 sv = mul128(sv, (U8)(*s & 0x7f));
1303 if (!(*s++ & 0x80)) {
1312 PUSHs(sv_2mortal(sv));
1317 if ((s >= strend) && bytes)
1318 Perl_croak(aTHX_ "Unterminated compressed integer");
1323 Perl_croak(aTHX_ "P must have an explicit size");
1325 if (sizeof(char*) > strend - s)
1328 Copy(s, &aptr, 1, char*);
1333 sv_setpvn(sv, aptr, len);
1334 PUSHs(sv_2mortal(sv));
1338 along = (strend - s) / sizeof(Quad_t);
1343 Copy(s, &aquad, 1, Quad_t);
1344 s += sizeof(Quad_t);
1345 if (checksum > bits_in_uv)
1346 cdouble += (NV)aquad;
1352 if (len && (flags & UNPACK_ONLY_ONE))
1357 if (s + sizeof(Quad_t) > strend)
1360 Copy(s, &aquad, 1, Quad_t);
1361 s += sizeof(Quad_t);
1364 if (aquad >= IV_MIN && aquad <= IV_MAX)
1365 sv_setiv(sv, (IV)aquad);
1367 sv_setnv(sv, (NV)aquad);
1368 PUSHs(sv_2mortal(sv));
1373 along = (strend - s) / sizeof(Uquad_t);
1378 Copy(s, &auquad, 1, Uquad_t);
1379 s += sizeof(Uquad_t);
1380 if (checksum > bits_in_uv)
1381 cdouble += (NV)auquad;
1387 if (len && (flags & UNPACK_ONLY_ONE))
1392 if (s + sizeof(Uquad_t) > strend)
1395 Copy(s, &auquad, 1, Uquad_t);
1396 s += sizeof(Uquad_t);
1399 if (auquad <= UV_MAX)
1400 sv_setuv(sv, (UV)auquad);
1402 sv_setnv(sv, (NV)auquad);
1403 PUSHs(sv_2mortal(sv));
1408 /* float and double added gnb@melba.bby.oz.au 22/11/89 */
1410 along = (strend - s) / sizeof(float);
1415 Copy(s, &afloat, 1, float);
1421 if (len && (flags & UNPACK_ONLY_ONE))
1426 Copy(s, &afloat, 1, float);
1429 sv_setnv(sv, (NV)afloat);
1430 PUSHs(sv_2mortal(sv));
1435 along = (strend - s) / sizeof(double);
1440 Copy(s, &adouble, 1, double);
1441 s += sizeof(double);
1446 if (len && (flags & UNPACK_ONLY_ONE))
1451 Copy(s, &adouble, 1, double);
1452 s += sizeof(double);
1454 sv_setnv(sv, (NV)adouble);
1455 PUSHs(sv_2mortal(sv));
1460 along = (strend - s) / NVSIZE;
1465 Copy(s, &anv, 1, NV);
1471 if (len && (flags & UNPACK_ONLY_ONE))
1476 Copy(s, &anv, 1, NV);
1480 PUSHs(sv_2mortal(sv));
1484 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
1486 along = (strend - s) / LONG_DOUBLESIZE;
1491 Copy(s, &aldouble, 1, long double);
1492 s += LONG_DOUBLESIZE;
1493 cdouble += aldouble;
1497 if (len && (flags & UNPACK_ONLY_ONE))
1502 Copy(s, &aldouble, 1, long double);
1503 s += LONG_DOUBLESIZE;
1505 sv_setnv(sv, (NV)aldouble);
1506 PUSHs(sv_2mortal(sv));
1513 * Initialise the decode mapping. By using a table driven
1514 * algorithm, the code will be character-set independent
1515 * (and just as fast as doing character arithmetic)
1517 if (PL_uudmap['M'] == 0) {
1520 for (i = 0; i < sizeof(PL_uuemap); i += 1)
1521 PL_uudmap[(U8)PL_uuemap[i]] = i;
1523 * Because ' ' and '`' map to the same value,
1524 * we need to decode them both the same.
1529 along = (strend - s) * 3 / 4;
1530 sv = NEWSV(42, along);
1533 while (s < strend && *s > ' ' && ISUUCHAR(*s)) {
1538 len = PL_uudmap[*(U8*)s++] & 077;
1540 if (s < strend && ISUUCHAR(*s))
1541 a = PL_uudmap[*(U8*)s++] & 077;
1544 if (s < strend && ISUUCHAR(*s))
1545 b = PL_uudmap[*(U8*)s++] & 077;
1548 if (s < strend && ISUUCHAR(*s))
1549 c = PL_uudmap[*(U8*)s++] & 077;
1552 if (s < strend && ISUUCHAR(*s))
1553 d = PL_uudmap[*(U8*)s++] & 077;
1556 hunk[0] = (char)((a << 2) | (b >> 4));
1557 hunk[1] = (char)((b << 4) | (c >> 2));
1558 hunk[2] = (char)((c << 6) | d);
1559 sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
1564 else /* possible checksum byte */
1565 if (s + 1 < strend && s[1] == '\n')
1568 XPUSHs(sv_2mortal(sv));
1573 if (strchr("fFdD", datumtype) ||
1574 (checksum > bits_in_uv &&
1575 strchr("csSiIlLnNUvVqQjJ", datumtype)) ) {
1578 adouble = (NV) (1 << (checksum & 15));
1579 while (checksum >= 16) {
1583 while (cdouble < 0.0)
1585 cdouble = Perl_modf(cdouble / adouble, &trouble) * adouble;
1586 sv_setnv(sv, cdouble);
1589 if (checksum < bits_in_uv) {
1590 UV mask = ((UV)1 << checksum) - 1;
1596 XPUSHs(sv_2mortal(sv));
1603 return SP - PL_stack_base - start_sp_offset;
1609 SV *right = (MAXARG > 1) ? POPs : GvSV(PL_defgv);
1611 I32 gimme = GIMME_V;
1614 register char *pat = SvPV(left, llen);
1615 #ifdef PACKED_IS_OCTETS
1616 /* Packed side is assumed to be octets - so force downgrade if it
1617 has been UTF-8 encoded by accident
1619 register char *s = SvPVbyte(right, rlen);
1621 register char *s = SvPV(right, rlen);
1623 char *strend = s + rlen;
1624 register char *patend = pat + llen;
1628 cnt = unpack_str(pat, patend, s, s, strend, NULL, 0,
1629 ((gimme == G_SCALAR) ? UNPACK_ONLY_ONE : 0)
1630 | (DO_UTF8(right) ? UNPACK_DO_UTF8 : 0));
1632 if ( !cnt && gimme == G_SCALAR )
1633 PUSHs(&PL_sv_undef);
1638 S_doencodes(pTHX_ register SV *sv, register char *s, register I32 len)
1642 *hunk = PL_uuemap[len];
1643 sv_catpvn(sv, hunk, 1);
1646 hunk[0] = PL_uuemap[(077 & (*s >> 2))];
1647 hunk[1] = PL_uuemap[(077 & (((*s << 4) & 060) | ((s[1] >> 4) & 017)))];
1648 hunk[2] = PL_uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))];
1649 hunk[3] = PL_uuemap[(077 & (s[2] & 077))];
1650 sv_catpvn(sv, hunk, 4);
1655 char r = (len > 1 ? s[1] : '\0');
1656 hunk[0] = PL_uuemap[(077 & (*s >> 2))];
1657 hunk[1] = PL_uuemap[(077 & (((*s << 4) & 060) | ((r >> 4) & 017)))];
1658 hunk[2] = PL_uuemap[(077 & ((r << 2) & 074))];
1659 hunk[3] = PL_uuemap[0];
1660 sv_catpvn(sv, hunk, 4);
1662 sv_catpvn(sv, "\n", 1);
1666 S_is_an_int(pTHX_ char *s, STRLEN l)
1669 SV *result = newSVpvn(s, l);
1670 char *result_c = SvPV(result, n_a); /* convenience */
1671 char *out = result_c;
1681 SvREFCNT_dec(result);
1704 SvREFCNT_dec(result);
1710 SvCUR_set(result, out - result_c);
1714 /* pnum must be '\0' terminated */
1716 S_div128(pTHX_ SV *pnum, bool *done)
1719 char *s = SvPV(pnum, len);
1728 i = m * 10 + (*t - '0');
1730 r = (i >> 7); /* r < 10 */
1737 SvCUR_set(pnum, (STRLEN) (t - s));
1741 #define PACK_CHILD 0x1
1744 =for apidoc pack_cat
1746 The engine implementing pack() Perl function.
1751 Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1759 static char null10[] = {0,0,0,0,0,0,0,0,0,0};
1760 static char *space10 = " ";
1763 /* These must not be in registers: */
1773 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
1774 long double aldouble;
1784 #ifdef PERL_NATINT_PACK
1785 int natint; /* native integer */
1788 items = endlist - beglist;
1789 #ifndef PACKED_IS_OCTETS
1790 pat = next_symbol(pat, patend);
1791 if (pat < patend && *pat == 'U' && !flags)
1794 while ((pat = next_symbol(pat, patend)) < patend) {
1795 SV *lengthcode = Nullsv;
1796 #define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *beglist++ : &PL_sv_no)
1797 datumtype = *pat++ & 0xFF;
1798 #ifdef PERL_NATINT_PACK
1802 static const char natstr[] = "sSiIlLxX";
1804 if (strchr(natstr, datumtype)) {
1805 if (datumtype == 'x' || datumtype == 'X') {
1806 datumtype |= TYPE_IS_SHRIEKING;
1807 } else { /* XXXX Should be redone similarly! */
1808 #ifdef PERL_NATINT_PACK
1815 Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
1817 len = find_count(&pat, patend, &star);
1818 if (star > 0) /* Count is '*' */
1819 len = strchr("@Xxu", datumtype) ? 0 : items;
1820 else if (star < 0) /* Default len */
1822 if (*pat == '/') { /* doing lookahead how... */
1824 if ((*pat != 'a' && *pat != 'A' && *pat != 'Z') || pat[1] != '*')
1825 Perl_croak(aTHX_ "/ must be followed by a*, A* or Z*");
1826 lengthcode = sv_2mortal(newSViv(sv_len(items > 0
1827 ? *beglist : &PL_sv_no)
1828 + (*pat == 'Z' ? 1 : 0)));
1832 Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
1833 case ',': /* grandfather in commas but with a warning */
1834 if (commas++ == 0 && ckWARN(WARN_PACK))
1835 Perl_warner(aTHX_ packWARN(WARN_PACK),
1836 "Invalid type in pack: '%c'", (int)datumtype);
1839 Perl_croak(aTHX_ "%% may only be used in unpack");
1851 SV **savebeglist = beglist; /* beglist de-register-ed */
1854 Perl_croak(aTHX_ "()-group starts with a count");
1855 aptr = group_end(beg, patend, ')');
1858 len = find_count(&pat, patend, &star);
1859 if (star < 0) /* No count */
1861 else if (star > 0) /* Star */
1862 len = items; /* long enough? */
1865 pack_cat(cat, beg, aptr, savebeglist, endlist,
1866 &savebeglist, PACK_CHILD);
1867 if (star > 0 && savebeglist == endlist)
1868 break; /* No way to continue */
1870 beglist = savebeglist;
1873 case 'X' | TYPE_IS_SHRIEKING:
1874 if (!len) /* Avoid division by 0 */
1876 len = (SvCUR(cat)) % len;
1880 if ((I32)SvCUR(cat) < len)
1881 Perl_croak(aTHX_ "X outside of string");
1885 case 'x' | TYPE_IS_SHRIEKING:
1886 if (!len) /* Avoid division by 0 */
1888 aint = (SvCUR(cat)) % len;
1889 if (aint) /* Other portable ways? */
1897 sv_catpvn(cat, null10, 10);
1900 sv_catpvn(cat, null10, len);
1906 aptr = SvPV(fromstr, fromlen);
1907 if (star > 0) { /* -2 after '/' */
1909 if (datumtype == 'Z')
1912 if ((I32)fromlen >= len) {
1913 sv_catpvn(cat, aptr, len);
1914 if (datumtype == 'Z')
1915 *(SvEND(cat)-1) = '\0';
1918 sv_catpvn(cat, aptr, fromlen);
1920 if (datumtype == 'A') {
1922 sv_catpvn(cat, space10, 10);
1925 sv_catpvn(cat, space10, len);
1929 sv_catpvn(cat, null10, 10);
1932 sv_catpvn(cat, null10, len);
1944 str = SvPV(fromstr, fromlen);
1948 SvCUR(cat) += (len+7)/8;
1949 SvGROW(cat, SvCUR(cat) + 1);
1950 aptr = SvPVX(cat) + aint;
1951 if (len > (I32)fromlen)
1955 if (datumtype == 'B') {
1956 for (len = 0; len++ < aint;) {
1957 items |= *str++ & 1;
1961 *aptr++ = items & 0xff;
1967 for (len = 0; len++ < aint;) {
1973 *aptr++ = items & 0xff;
1979 if (datumtype == 'B')
1980 items <<= 7 - (aint & 7);
1982 items >>= 7 - (aint & 7);
1983 *aptr++ = items & 0xff;
1985 str = SvPVX(cat) + SvCUR(cat);
2000 str = SvPV(fromstr, fromlen);
2004 SvCUR(cat) += (len+1)/2;
2005 SvGROW(cat, SvCUR(cat) + 1);
2006 aptr = SvPVX(cat) + aint;
2007 if (len > (I32)fromlen)
2011 if (datumtype == 'H') {
2012 for (len = 0; len++ < aint;) {
2014 items |= ((*str++ & 15) + 9) & 15;
2016 items |= *str++ & 15;
2020 *aptr++ = items & 0xff;
2026 for (len = 0; len++ < aint;) {
2028 items |= (((*str++ & 15) + 9) & 15) << 4;
2030 items |= (*str++ & 15) << 4;
2034 *aptr++ = items & 0xff;
2040 *aptr++ = items & 0xff;
2041 str = SvPVX(cat) + SvCUR(cat);
2052 switch (datumtype) {
2054 aint = SvIV(fromstr);
2055 if ((aint < 0 || aint > 255) &&
2057 Perl_warner(aTHX_ packWARN(WARN_PACK),
2058 "Character in \"C\" format wrapped");
2060 sv_catpvn(cat, &achar, sizeof(char));
2063 aint = SvIV(fromstr);
2064 if ((aint < -128 || aint > 127) &&
2066 Perl_warner(aTHX_ packWARN(WARN_PACK),
2067 "Character in \"c\" format wrapped");
2069 sv_catpvn(cat, &achar, sizeof(char));
2077 auint = UNI_TO_NATIVE(SvUV(fromstr));
2078 SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1);
2080 (char*)uvchr_to_utf8_flags((U8*)SvEND(cat),
2083 0 : UNICODE_ALLOW_ANY)
2088 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
2093 /* VOS does not automatically map a floating-point overflow
2094 during conversion from double to float into infinity, so we
2095 do it by hand. This code should either be generalized for
2096 any OS that needs it, or removed if and when VOS implements
2097 posix-976 (suggestion to support mapping to infinity).
2098 Paul.Green@stratus.com 02-04-02. */
2099 if (SvNV(fromstr) > FLT_MAX)
2100 afloat = _float_constants[0]; /* single prec. inf. */
2101 else if (SvNV(fromstr) < -FLT_MAX)
2102 afloat = _float_constants[0]; /* single prec. inf. */
2103 else afloat = (float)SvNV(fromstr);
2105 # if defined(VMS) && !defined(__IEEE_FP)
2106 /* IEEE fp overflow shenanigans are unavailable on VAX and optional
2107 * on Alpha; fake it if we don't have them.
2109 if (SvNV(fromstr) > FLT_MAX)
2111 else if (SvNV(fromstr) < -FLT_MAX)
2113 else afloat = (float)SvNV(fromstr);
2115 afloat = (float)SvNV(fromstr);
2118 sv_catpvn(cat, (char *)&afloat, sizeof (float));
2125 /* VOS does not automatically map a floating-point overflow
2126 during conversion from long double to double into infinity,
2127 so we do it by hand. This code should either be generalized
2128 for any OS that needs it, or removed if and when VOS
2129 implements posix-976 (suggestion to support mapping to
2130 infinity). Paul.Green@stratus.com 02-04-02. */
2131 if (SvNV(fromstr) > DBL_MAX)
2132 adouble = _double_constants[0]; /* double prec. inf. */
2133 else if (SvNV(fromstr) < -DBL_MAX)
2134 adouble = _double_constants[0]; /* double prec. inf. */
2135 else adouble = (double)SvNV(fromstr);
2137 # if defined(VMS) && !defined(__IEEE_FP)
2138 /* IEEE fp overflow shenanigans are unavailable on VAX and optional
2139 * on Alpha; fake it if we don't have them.
2141 if (SvNV(fromstr) > DBL_MAX)
2143 else if (SvNV(fromstr) < -DBL_MAX)
2145 else adouble = (double)SvNV(fromstr);
2147 adouble = (double)SvNV(fromstr);
2150 sv_catpvn(cat, (char *)&adouble, sizeof (double));
2156 anv = SvNV(fromstr);
2157 sv_catpvn(cat, (char *)&anv, NVSIZE);
2160 #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)
2164 aldouble = (long double)SvNV(fromstr);
2165 sv_catpvn(cat, (char *)&aldouble, LONG_DOUBLESIZE);
2172 ashort = (I16)SvIV(fromstr);
2174 ashort = PerlSock_htons(ashort);
2176 CAT16(cat, &ashort);
2182 ashort = (I16)SvIV(fromstr);
2184 ashort = htovs(ashort);
2186 CAT16(cat, &ashort);
2190 #if SHORTSIZE != SIZE16
2192 unsigned short aushort;
2196 aushort = SvUV(fromstr);
2197 sv_catpvn(cat, (char *)&aushort, sizeof(unsigned short));
2207 aushort = (U16)SvUV(fromstr);
2208 CAT16(cat, &aushort);
2214 #if SHORTSIZE != SIZE16
2220 ashort = SvIV(fromstr);
2221 sv_catpvn(cat, (char *)&ashort, sizeof(short));
2229 ashort = (I16)SvIV(fromstr);
2230 CAT16(cat, &ashort);
2237 auint = SvUV(fromstr);
2238 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
2244 aiv = SvIV(fromstr);
2245 sv_catpvn(cat, (char*)&aiv, IVSIZE);
2251 auv = SvUV(fromstr);
2252 sv_catpvn(cat, (char*)&auv, UVSIZE);
2258 anv = SvNV(fromstr);
2261 Perl_croak(aTHX_ "Cannot compress negative numbers");
2263 /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0,
2264 which is == UV_MAX_P1. IOK is fine (instead of UV_only), as
2265 any negative IVs will have already been got by the croak()
2266 above. IOK is untrue for fractions, so we test them
2267 against UV_MAX_P1. */
2268 if (SvIOK(fromstr) || anv < UV_MAX_P1)
2270 char buf[(sizeof(UV)*8)/7+1];
2271 char *in = buf + sizeof(buf);
2272 UV auv = SvUV(fromstr);
2275 *--in = (char)((auv & 0x7f) | 0x80);
2278 buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
2279 sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
2281 else if (SvPOKp(fromstr)) { /* decimal string arithmetics */
2282 char *from, *result, *in;
2287 /* Copy string and check for compliance */
2288 from = SvPV(fromstr, len);
2289 if ((norm = is_an_int(from, len)) == NULL)
2290 Perl_croak(aTHX_ "Can only compress unsigned integers");
2292 New('w', result, len, char);
2296 *--in = div128(norm, &done) | 0x80;
2297 result[len - 1] &= 0x7F; /* clear continue bit */
2298 sv_catpvn(cat, in, (result + len) - in);
2300 SvREFCNT_dec(norm); /* free norm */
2302 else if (SvNOKp(fromstr)) {
2303 /* 10**NV_MAX_10_EXP is the largest power of 10
2304 so 10**(NV_MAX_10_EXP+1) is definately unrepresentable
2305 given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x:
2306 x = (NV_MAX_10_EXP+1) * log (10) / log (128)
2307 And with that many bytes only Inf can overflow.
2309 #ifdef NV_MAX_10_EXP
2310 char buf[1 + (int)((NV_MAX_10_EXP + 1) * 0.47456)];
2312 char buf[1 + (int)((308 + 1) * 0.47456)];
2314 char *in = buf + sizeof(buf);
2316 anv = Perl_floor(anv);
2318 NV next = Perl_floor(anv / 128);
2319 if (in <= buf) /* this cannot happen ;-) */
2320 Perl_croak(aTHX_ "Cannot compress integer");
2321 *--in = (unsigned char)(anv - (next * 128)) | 0x80;
2324 buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
2325 sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
2328 char *from, *result, *in;
2333 /* Copy string and check for compliance */
2334 from = SvPV(fromstr, len);
2335 if ((norm = is_an_int(from, len)) == NULL)
2336 Perl_croak(aTHX_ "Can only compress unsigned integers");
2338 New('w', result, len, char);
2342 *--in = div128(norm, &done) | 0x80;
2343 result[len - 1] &= 0x7F; /* clear continue bit */
2344 sv_catpvn(cat, in, (result + len) - in);
2346 SvREFCNT_dec(norm); /* free norm */
2353 aint = SvIV(fromstr);
2354 sv_catpvn(cat, (char*)&aint, sizeof(int));
2360 aulong = SvUV(fromstr);
2362 aulong = PerlSock_htonl(aulong);
2364 CAT32(cat, &aulong);
2370 aulong = SvUV(fromstr);
2372 aulong = htovl(aulong);
2374 CAT32(cat, &aulong);
2378 #if LONGSIZE != SIZE32
2380 unsigned long aulong;
2384 aulong = SvUV(fromstr);
2385 sv_catpvn(cat, (char *)&aulong, sizeof(unsigned long));
2393 aulong = SvUV(fromstr);
2394 CAT32(cat, &aulong);
2399 #if LONGSIZE != SIZE32
2405 along = SvIV(fromstr);
2406 sv_catpvn(cat, (char *)&along, sizeof(long));
2414 along = SvIV(fromstr);
2423 auquad = (Uquad_t)SvUV(fromstr);
2424 sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
2430 aquad = (Quad_t)SvIV(fromstr);
2431 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
2436 len = 1; /* assume SV is correct length */
2441 if (fromstr == &PL_sv_undef)
2445 /* XXX better yet, could spirit away the string to
2446 * a safe spot and hang on to it until the result
2447 * of pack() (and all copies of the result) are
2450 if (ckWARN(WARN_PACK) && (SvTEMP(fromstr)
2451 || (SvPADTMP(fromstr)
2452 && !SvREADONLY(fromstr))))
2454 Perl_warner(aTHX_ packWARN(WARN_PACK),
2455 "Attempt to pack pointer to temporary value");
2457 if (SvPOK(fromstr) || SvNIOK(fromstr))
2458 aptr = SvPV(fromstr,n_a);
2460 aptr = SvPV_force(fromstr,n_a);
2462 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
2467 aptr = SvPV(fromstr, fromlen);
2468 SvGROW(cat, fromlen * 4 / 3);
2473 while (fromlen > 0) {
2476 if ((I32)fromlen > len)
2480 doencodes(cat, aptr, todo);
2488 *next_in_list = beglist;
2495 dSP; dMARK; dORIGMARK; dTARGET;
2496 register SV *cat = TARG;
2498 register char *pat = SvPVx(*++MARK, fromlen);
2499 register char *patend = pat + fromlen;
2502 sv_setpvn(cat, "", 0);
2504 pack_cat(cat, pat, patend, MARK, SP + 1, NULL, 0);