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

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