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

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