1 /*
2 * Converts a string into a int128_t
3 *
4 * based on OpenBSD: strtoll.c,v 1.6 2005/11/10 10:00:17 espie Exp $
5 */
6
7 /*-
8 * Copyright (c) 1992 The Regents of the University of California.
9 * All rights reserved.
10 *
11 * Redistribution and use in source and binary forms, with or without
12 * modification, are permitted provided that the following conditions
13 * are met:
14 * 1. Redistributions of source code must retain the above copyright
15 * notice, this list of conditions and the following disclaimer.
16 * 2. Redistributions in binary form must reproduce the above copyright
17 * notice, this list of conditions and the following disclaimer in the
18 * documentation and/or other materials provided with the distribution.
19 * 3. Neither the name of the University nor the names of its contributors
20 * may be used to endorse or promote products derived from this software
21 * without specific prior written permission.
22 *
23 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
24 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
25 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
26 * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
27 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
28 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
29 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
30 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
32 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
33 * SUCH DAMAGE.
34 */
35
36 #include "perl.h"
37 #include <ctype.h>
38
39 /*
40 * Convert a string to an int128_t/uint128_t.
41 */
42
43 static uint128_t
strtoint128(pTHX_ const char * s,STRLEN len,int base,int sign)44 strtoint128(pTHX_ const char *s, STRLEN len, int base, int sign) {
45 uint128_t acc = 0;
46 int c, neg, between = 0;
47 const char *top = s + len;
48 uint128_t upper_mul_limit = 0;
49
50 /*
51 * Skip white space and pick up leading +/- sign if any.
52 * If base is 0, allow 0x for hex and 0 for octal, else
53 * assume decimal; if base is already 16, allow 0x.
54 */
55 do {
56 if (s >= top) return 0;
57 c = *s++;
58 } while (isspace(c));
59
60 if (c == '-') {
61 if (!sign) overflow(aTHX_ "negative sign found when parsing unsigned number");
62 if (s >= top) return 0;
63 neg = 1;
64 c = *s++;
65 } else {
66 neg = 0;
67 if (c == '+') {
68 if (s >= top) return 0;
69 c = *s++;
70 }
71 }
72 if (((base == 0) || (base == 16)) &&
73 (c == '0') &&
74 (s + 1 < top) && ((*s == 'x') || (*s == 'X'))) {
75 c = s[1];
76 s += 2;
77 base = 16;
78 }
79 if (base == 0)
80 base = ((c == '0') ? 8 : 10);
81
82 for (;s <= top; c = (unsigned char) *s++) {
83 if (isdigit(c))
84 c -= '0';
85 else if (isalpha(c))
86 c -= isupper(c) ? 'A' - 10 : 'a' - 10;
87 else if ((c == '_') && between)
88 continue; /* ignore underscores as Perl does */
89 else
90 break;
91 if (c >= base)
92 break;
93 if (may_die_on_overflow) {
94 redo:
95 if (acc > upper_mul_limit) {
96 if (!upper_mul_limit) {
97 upper_mul_limit = UINT128_MAX / base;
98 goto redo;
99 }
100 overflow(aTHX_ (sign ? out_of_bounds_error_s : out_of_bounds_error_u));
101 }
102 acc *= base;
103 if (UINT128_MAX - acc < c) overflow(aTHX_ (sign ? out_of_bounds_error_s : out_of_bounds_error_u));
104 acc += c;
105 }
106 else {
107 acc = acc * base + c;
108 }
109 between = 1;
110 }
111 if ( may_die_on_overflow && sign &&
112 ( acc > (neg ? (~(uint128_t)INT128_MIN + 1) : INT128_MAX) ) ) overflow(aTHX_ out_of_bounds_error_s);
113
114 return (neg ? ~acc + 1 : acc);
115 }
116
117