diff options
Diffstat (limited to 'src/data.c')
| -rw-r--r-- | src/data.c | 121 |
1 files changed, 99 insertions, 22 deletions
diff --git a/src/data.c b/src/data.c index 78bd454056d..a41ffe7a1f6 100644 --- a/src/data.c +++ b/src/data.c @@ -2326,33 +2326,110 @@ DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, return Qnil; } -/* Convert between long values and pairs of Lisp integers. - Note that long_to_cons returns a single Lisp integer - when the value fits in one. */ +/* Convert the cons-of-integers, integer, or float value C to an + unsigned value with maximum value MAX. Signal an error if C does not + have a valid format or is out of range. */ +uintmax_t +cons_to_unsigned (Lisp_Object c, uintmax_t max) +{ + int valid = 0; + uintmax_t val IF_LINT (= 0); + if (INTEGERP (c)) + { + valid = 0 <= XINT (c); + val = XINT (c); + } + else if (FLOATP (c)) + { + double d = XFLOAT_DATA (c); + if (0 <= d + && d < (max == UINTMAX_MAX ? (double) UINTMAX_MAX + 1 : max + 1)) + { + val = d; + valid = 1; + } + } + else if (CONSP (c) && NATNUMP (XCAR (c))) + { + uintmax_t top = XFASTINT (XCAR (c)); + Lisp_Object rest = XCDR (c); + if (top <= UINTMAX_MAX >> 24 >> 16 + && CONSP (rest) + && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 + && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + { + uintmax_t mid = XFASTINT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); + valid = 1; + } + else if (top <= UINTMAX_MAX >> 16) + { + if (CONSP (rest)) + rest = XCAR (rest); + if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16) + { + val = top << 16 | XFASTINT (rest); + valid = 1; + } + } + } -Lisp_Object -long_to_cons (long unsigned int i) -{ - unsigned long top = i >> 16; - unsigned int bot = i & 0xFFFF; - if (top == 0) - return make_number (bot); - if (top == (unsigned long)-1 >> 16) - return Fcons (make_number (-1), make_number (bot)); - return Fcons (make_number (top), make_number (bot)); + if (! (valid && val <= max)) + error ("Not an in-range integer, float, or cons of integers"); + return val; } -unsigned long -cons_to_long (Lisp_Object c) +/* Convert the cons-of-integers, integer, or float value C to a signed + value with extrema MIN and MAX. Signal an error if C does not have + a valid format or is out of range. */ +intmax_t +cons_to_signed (Lisp_Object c, intmax_t min, intmax_t max) { - Lisp_Object top, bot; + int valid = 0; + intmax_t val IF_LINT (= 0); if (INTEGERP (c)) - return XINT (c); - top = XCAR (c); - bot = XCDR (c); - if (CONSP (bot)) - bot = XCAR (bot); - return ((XINT (top) << 16) | XINT (bot)); + { + val = XINT (c); + valid = 1; + } + else if (FLOATP (c)) + { + double d = XFLOAT_DATA (c); + if (min <= d + && d < (max == INTMAX_MAX ? (double) INTMAX_MAX + 1 : max + 1)) + { + val = d; + valid = 1; + } + } + else if (CONSP (c) && INTEGERP (XCAR (c))) + { + intmax_t top = XINT (XCAR (c)); + Lisp_Object rest = XCDR (c); + if (INTMAX_MIN >> 24 >> 16 <= top && top <= INTMAX_MAX >> 24 >> 16 + && CONSP (rest) + && NATNUMP (XCAR (rest)) && XFASTINT (XCAR (rest)) < 1 << 24 + && NATNUMP (XCDR (rest)) && XFASTINT (XCDR (rest)) < 1 << 16) + { + intmax_t mid = XFASTINT (XCAR (rest)); + val = top << 24 << 16 | mid << 16 | XFASTINT (XCDR (rest)); + valid = 1; + } + else if (INTMAX_MIN >> 16 <= top && top <= INTMAX_MAX >> 16) + { + if (CONSP (rest)) + rest = XCAR (rest); + if (NATNUMP (rest) && XFASTINT (rest) < 1 << 16) + { + val = top << 16 | XFASTINT (rest); + valid = 1; + } + } + } + + if (! (valid && min <= val && val <= max)) + error ("Not an in-range integer, float, or cons of integers"); + return val; } DEFUN ("number-to-string", Fnumber_to_string, Snumber_to_string, 1, 1, 0, |