git.gag.com Git - debian/amanda/blob - perl/amglue/bigint.c

   1 /*
   2  * Copyright (c) 2007-2012 Zmanda, Inc.  All Rights Reserved.
   3  *
   4  * This program is free software; you can redistribute it and/or modify it
   5  * under the terms of the GNU General Public License version 2 as published
   6  * by the Free Software Foundation.
   7  *
   8  * This program is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11  * for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License along
  14  * with this program; if not, write to the Free Software Foundation, Inc.,
  15  * 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16  *
  17  * Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  18  * Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
  19  */
  20
  21 #include "amglue.h"
  22 #include "stdint.h"
  23
  24 /*
  25  * C -> Perl
  26  */
  27
  28 /* these functions are only needed if Perl has 32-bit IV's */
  29 /* Make sure Math::BigInt is loaded
  30  */
  31 static void
  32 load_Math_BigInt(void)
  33 {
  34     static int loaded = 0;
  35
  36     if (loaded) return;
  37
  38     eval_pv("use Math::BigInt; use Amanda::BigIntCompat;", 1);
  39     loaded = 1;
  40 }
  41
  42 /* Given a string, create a Math::BigInt representing its value.
  43  *
  44  * @param num: string representation of a number
  45  * @returns: BigInt representation of the same number
  46  */
  47 static SV *
  48 str2bigint(char *num)
  49 {
  50     int count;
  51     SV *rv;
  52     dSP;
  53
  54     ENTER;
  55     SAVETMPS;
  56
  57     load_Math_BigInt();
  58     SPAGAIN;
  59
  60     EXTEND(SP, 2);
  61     PUSHMARK(SP);
  62     XPUSHs(sv_2mortal(newSVpv("Math::BigInt", 0)));
  63     XPUSHs(sv_2mortal(newSVpv(num, 0)));
  64     PUTBACK;
  65
  66     count = call_method("new", G_SCALAR);
  67
  68     SPAGAIN;
  69
  70     if (count != 1)
  71         croak("Expected a result from Math::Bigint->new");
  72
  73     rv = POPs;
  74     SvREFCNT_inc(rv);
  75
  76     PUTBACK;
  77     FREETMPS;
  78     LEAVE;
  79
  80     return rv;
  81 }
  82
  83 SV *
  84 amglue_newSVi64(gint64 v)
  85 {
  86     char numstr[25];
  87     g_snprintf(numstr, sizeof(numstr), "%jd", (intmax_t)v);
  88     numstr[sizeof(numstr)-1] = '\0';
  89     return str2bigint(numstr);
  90 }
  91
  92 SV *
  93 amglue_newSVu64(guint64 v)
  94 {
  95     char numstr[25];
  96     g_snprintf(numstr, sizeof(numstr), "%ju", (uintmax_t)v);
  97     numstr[sizeof(numstr)-1] = '\0';
  98     return str2bigint(numstr);
  99 }
 100
 101 /*
 102  * Perl -> C
 103  */
 104
 105 /* Conversion from Perl values handles BigInts regardless of whether
 106  * Perl's IVs are 32- or 64-bit, for completeness' sake.
 107  */
 108
 109 /* Convert a bigint to a signed integer, or croak trying.
 110  *
 111  * @param bigint: the perl object to convert
 112  * @returns: signed integer
 113  */
 114 static gint64
 115 bigint2int64(SV *bigint)
 116 {
 117     SV *sv;
 118     char *str;
 119     guint64 absval;
 120     gboolean negative = FALSE;
 121     int count;
 122     dSP;
 123
 124     /* first, see if it's a BigInt */
 125     if (!sv_isobject(bigint) || !sv_derived_from(bigint, "Math::BigInt"))
 126         croak("Expected an integer or a Math::BigInt; cannot convert");
 127
 128     ENTER;
 129     SAVETMPS;
 130
 131     /* get the value:
 132      * strtoull($bigint->bstr()) */
 133
 134     PUSHMARK(SP);
 135     XPUSHs(bigint);
 136     PUTBACK;
 137
 138     count = call_method("Math::BigInt::bstr", G_SCALAR);
 139
 140     SPAGAIN;
 141
 142     if (count != 1)
 143         croak("Expected a result from Math::BigInt::bstr");
 144
 145     sv = POPs;
 146     str = SvPV_nolen(sv);
 147     if (!str)
 148         croak("Math::BigInt::bstr did not return a string");
 149
 150     if (str[0] == '-') {
 151         negative = TRUE;
 152         str++;
 153     }
 154
 155     errno = 0;
 156     absval = g_ascii_strtoull(str, NULL, 0);
 157     /* (the last branch of this || depends on G_MININT64 = -G_MAXINT64-1) */
 158     if ((absval == G_MAXUINT64 && errno == ERANGE)
 159         || (!negative && absval > (guint64)(G_MAXINT64))
 160         || (negative && absval > (guint64)(G_MAXINT64)+1))
 161         croak("Expected a signed 64-bit value or smaller; value '%s' out of range", str);
 162     if (errno)
 163         croak("Math::BigInt->bstr returned invalid number '%s'", str);
 164
 165     PUTBACK;
 166     FREETMPS;
 167     LEAVE;
 168
 169     if (negative) return -absval;
 170     return absval;
 171 }
 172
 173 /* Convert bigint to an unsigned integer, or croak trying.
 174  *
 175  * @param bigint: the perl object to convert
 176  * @returns: unsigned integer
 177  */
 178 static guint64
 179 bigint2uint64(SV *bigint)
 180 {
 181     SV *sv;
 182     char *str;
 183     guint64 rv;
 184     int count;
 185     dSP;
 186
 187     /* first, see if it's a BigInt */
 188     if (!sv_isobject(bigint) || !sv_derived_from(bigint, "Math::BigInt"))
 189         croak("Expected an integer or a Math::BigInt; cannot convert");
 190
 191     ENTER;
 192     SAVETMPS;
 193
 194     /* make sure the bigint is positive:
 195      * croak(..) unless $bigint->sign() eq "+"; */
 196
 197     PUSHMARK(SP);
 198     XPUSHs(bigint);
 199     PUTBACK;
 200
 201     count = call_method("Math::BigInt::sign", G_SCALAR);
 202
 203     SPAGAIN;
 204
 205     if (count != 1)
 206         croak("Expected a result from Math::BigInt::sign");
 207
 208     sv = POPs;
 209     str = SvPV_nolen(sv);
 210     if (!str)
 211         croak("Math::BigInt::sign did not return a string");
 212
 213     if (strcmp(str, "+") != 0)
 214         croak("Expected a positive number; value out of range");
 215
 216     /* get the value:
 217      * strtoull($bigint->bstr()) */
 218
 219     PUSHMARK(SP);
 220     XPUSHs(bigint);
 221     PUTBACK;
 222
 223     count = call_method("Math::BigInt::bstr", G_SCALAR);
 224
 225     SPAGAIN;
 226
 227     if (count != 1)
 228         croak("Expected a result from Math::BigInt::bstr");
 229
 230     sv = POPs;
 231     str = SvPV_nolen(sv);
 232     if (!str)
 233         croak("Math::BigInt::bstr did not return a string");
 234
 235     errno = 0;
 236     rv = g_ascii_strtoull(str, NULL, 0);
 237     if (rv == G_MAXUINT64 && errno == ERANGE)
 238         croak("Expected an unsigned 64-bit value or smaller; value '%s' out of range", str);
 239     if (errno)
 240         croak("Math::BigInt->bstr returned invalid number '%s'", str);
 241
 242     PUTBACK;
 243     FREETMPS;
 244     LEAVE;
 245
 246     return rv;
 247 }
 248
 249 gint64 amglue_SvI64(SV *sv)
 250 {
 251     if (SvIOK(sv)) {
 252         if (SvIsUV(sv)) {
 253             return SvUV(sv);
 254         } else {
 255             return SvIV(sv);
 256         }
 257     } else if (SvNOK(sv)) {
 258         double dv = SvNV(sv);
 259
 260         /* preprocessor constants seem to have trouble here, so we convert to gint64 and
 261          * back, and if the result differs, then we have lost something.  Note that this will
 262          * also error out on integer truncation .. which is probably OK */
 263         gint64 iv = (gint64)dv;
 264         if (dv != (double)iv) {
 265             croak("Expected a signed 64-bit value or smaller; value '%.0f' out of range", (float)dv);
 266             return 0;
 267         } else {
 268             return iv;
 269         }
 270     } else {
 271         return bigint2int64(sv);
 272     }
 273 }
 274
 275 guint64 amglue_SvU64(SV *sv)
 276 {
 277     if (SvIOK(sv)) {
 278         if (SvIsUV(sv)) {
 279             return SvUV(sv);
 280         } else if (SvIV(sv) < 0) {
 281             croak("Expected an unsigned value, got a negative integer");
 282             return 0;
 283         } else {
 284             return (guint64)SvIV(sv);
 285         }
 286     } else if (SvNOK(sv)) {
 287         double dv = SvNV(sv);
 288         if (dv < 0.0) {
 289             croak("Expected an unsigned value, got a negative integer");
 290             return 0;
 291         } else if (dv > (double)G_MAXUINT64) {
 292             croak("Expected an unsigned 64-bit value or smaller; value out of range");
 293             return 0;
 294         } else {
 295             return (guint64)dv;
 296         }
 297     } else {
 298         return bigint2uint64(sv);
 299     }
 300 }
 301
 302 gint32 amglue_SvI32(SV *sv)
 303 {
 304     gint64 v64 = amglue_SvI64(sv);
 305     if (v64 < G_MININT32 || v64 > G_MAXINT32) {
 306         croak("Expected a 32-bit integer; value out of range");
 307         return 0;
 308     } else {
 309         return (gint32)v64;
 310     }
 311 }
 312
 313 guint32 amglue_SvU32(SV *sv)
 314 {
 315     guint64 v64 = amglue_SvU64(sv);
 316     if (v64 > G_MAXUINT32) {
 317         croak("Expected a 32-bit unsigned integer; value out of range");
 318         return 0;
 319     } else {
 320         return (guint32)v64;
 321     }
 322 }
 323
 324 gint16 amglue_SvI16(SV *sv)
 325 {
 326     gint64 v64 = amglue_SvI64(sv);
 327     if (v64 < G_MININT16 || v64 > G_MAXINT16) {
 328         croak("Expected a 16-bit integer; value out of range");
 329         return 0;
 330     } else {
 331         return (gint16)v64;
 332     }
 333 }
 334
 335 guint16 amglue_SvU16(SV *sv)
 336 {
 337     guint64 v64 = amglue_SvU64(sv);
 338     if (v64 > G_MAXUINT16) {
 339         croak("Expected a 16-bit unsigned integer; value out of range");
 340         return 0;
 341     } else {
 342         return (guint16)v64;
 343     }
 344 }
 345
 346 gint8 amglue_SvI8(SV *sv)
 347 {
 348     gint64 v64 = amglue_SvI64(sv);
 349     if (v64 < G_MININT8 || v64 > G_MAXINT8) {
 350         croak("Expected a 8-bit integer; value out of range");
 351         return 0;
 352     } else {
 353         return (gint8)v64;
 354     }
 355 }
 356
 357 guint8 amglue_SvU8(SV *sv)
 358 {
 359     guint64 v64 = amglue_SvU64(sv);
 360     if (v64 > G_MAXUINT8) {
 361         croak("Expected a 8-bit unsigned integer; value out of range");
 362         return 0;
 363     } else {
 364         return (guint8)v64;
 365     }
 366 }
 367