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