chiark - git - mdw - catacomb-perl/blob - mpstuff.c

   1 /* -*-c-*-
   2  *
   3  * $Id$
   4  *
   5  * MP manipulation stuff
   6  *
   7  * (c) 2001 Straylight/Edgeware
   8  */
   9
  10 /*----- Licensing notice --------------------------------------------------*
  11  *
  12  * This file is part of the Perl interface to Catacomb.
  13  *
  14  * Catacomb/Perl is free software; you can redistribute it and/or modify
  15  * it under the terms of the GNU General Public License as published by
  16  * the Free Software Foundation; either version 2 of the License, or
  17  * (at your option) any later version.
  18  *
  19  * Catacomb/Perl is distributed in the hope that it will be useful,
  20  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  21  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22  * GNU General Public License for more details.
  23  *
  24  * You should have received a copy of the GNU General Public License
  25  * along with Catacomb/Perl; if not, write to the Free Software Foundation,
  26  * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27  */
  28
  29 /*----- Header files ------------------------------------------------------*/
  30
  31 #include "catacomb-perl.h"
  32
  33 /*----- Main code ---------------------------------------------------------*/
  34
  35 /* --- Convert Perl integers to multiprecision --- */
  36
  37 mp *mp_fromiv(mp *d, IV iv)
  38 {
  39   MP_FROMINT(d, IV, iv);
  40   return (d);
  41 }
  42
  43 IV mp_toiv(mp *x)
  44 {
  45   IV i;
  46   MP_TOINT(x, IV, IV_MAX, i);
  47   return (i);
  48 }
  49
  50 /* --- Parse Perl strings into integers --- */
  51
  52 typedef struct mptext_svctx {
  53   SV *sv;
  54   STRLEN i;
  55 } mptext_svctx;
  56
  57 static int svget(void *p)
  58 {
  59   mptext_svctx *c = p;
  60   if (c->i >= SvCUR(c->sv))
  61     return (EOF);
  62   return ((unsigned char)SvPVX(c->sv)[c->i++]);
  63 }
  64
  65 static void svunget(int ch, void *p)
  66 {
  67   mptext_svctx *c = p;
  68   if (ch == EOF || c->i == 0)
  69     return;
  70   c->i--;
  71 }
  72
  73 static int svput(const char *s, size_t sz, void *p)
  74 {
  75   mptext_svctx *c = p;
  76   sv_catpvn(c->sv, (char *)s, sz);
  77   return (0);
  78 }
  79
  80 static const mptext_ops mptext_svops = { svget, svunget, svput };
  81
  82 mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix)
  83 {
  84   mptext_svctx c;
  85   STRLEN len;
  86   SvPV(sv, len);
  87   if (!SvPOK(sv))
  88     return (0);
  89   c.sv = sv;
  90   c.i = off ? *off : 0;
  91   m = mp_read(m, radix, &mptext_svops, &c);
  92   if (off)
  93     *off = c.i;
  94   return (m);
  95 }
  96
  97 int mp_writesv(mp *m, SV *sv, int radix)
  98 {
  99   mptext_svctx c;
 100   int rc;
 101   STRLEN len;
 102   SvPV(sv, len);
 103   c.sv = sv;
 104   rc = mp_write(m, radix, &mptext_svops, &c);
 105   return (rc);
 106 }
 107
 108 /* --- Conversion to and from SVs --- */
 109
 110 mp *mp_fromsv(SV *sv, const char *what, const char *ty,
 111               int radix, int keep, ...)
 112 {
 113   mp *m;
 114   if (SvROK(sv)) {
 115     if (sv_derived_from(sv, "Catacomb::MP"))
 116       m = (mp *)SvIV((SV *)SvRV(sv));
 117     else {
 118       va_list ap;
 119       SV *t = sv_newmortal();
 120       va_start(ap, keep);
 121       sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0);
 122       croak("%s is not of type %s", SvPVX(t), ty);
 123     }
 124     if (m && keep)
 125       MP_COPY(m);
 126   } else {
 127     if (SvIOK(sv))
 128       m = mp_fromiv(MP_NEW, SvIV(sv));
 129     else
 130       m = mp_readsv(MP_NEW, sv, 0, radix);
 131     if (m && !keep)
 132       RET(m, ty);                       /* Kill temporary later */
 133   }
 134   return (m);
 135 }
 136
 137 /*----- That's all, folks -------------------------------------------------*/