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

   1 /* -*-c-*-
   2  *
   3  * $Id: mpstuff.c,v 1.1 2004/04/02 18:04:01 mdw Exp $
   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 /*----- Revision history --------------------------------------------------*
  30  *
  31  * $Log: mpstuff.c,v $
  32  * Revision 1.1  2004/04/02 18:04:01  mdw
  33  * Initial checkin.
  34  *
  35  */
  36
  37 /*----- Header files ------------------------------------------------------*/
  38
  39 #include "catacomb-perl.h"
  40
  41 /*----- Main code ---------------------------------------------------------*/
  42
  43 /* --- Convert Perl integers to multiprecision --- */
  44
  45 mp *mp_fromiv(mp *d, IV iv)
  46 {
  47   MP_FROMINT(d, IV, iv);
  48   return (d);
  49 }
  50
  51 IV mp_toiv(mp *x)
  52 {
  53   IV i;
  54   MP_TOINT(x, IV, IV_MAX, i);
  55   return (i);
  56 }
  57
  58 /* --- Parse Perl strings into integers --- */
  59
  60 typedef struct mptext_svctx {
  61   SV *sv;
  62   STRLEN i;
  63 } mptext_svctx;
  64
  65 static int svget(void *p)
  66 {
  67   mptext_svctx *c = p;
  68   if (c->i >= SvCUR(c->sv))
  69     return (EOF);
  70   return ((unsigned char)SvPVX(c->sv)[c->i++]);
  71 }
  72
  73 static void svunget(int ch, void *p)
  74 {
  75   mptext_svctx *c = p;
  76   if (ch == EOF || c->i == 0)
  77     return;
  78   c->i--;
  79 }
  80
  81 static int svput(const char *s, size_t sz, void *p)
  82 {
  83   mptext_svctx *c = p;
  84   sv_catpvn(c->sv, (char *)s, sz);
  85   return (0);
  86 }
  87
  88 static const mptext_ops mptext_svops = { svget, svunget, svput };
  89
  90 mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix)
  91 {
  92   mptext_svctx c;
  93   STRLEN len;
  94   SvPV(sv, len);
  95   if (!SvPOK(sv))
  96     return (0);
  97   c.sv = sv;
  98   c.i = off ? *off : 0;
  99   m = mp_read(m, radix, &mptext_svops, &c);
 100   if (off)
 101     *off = c.i;
 102   return (m);
 103 }
 104
 105 int mp_writesv(mp *m, SV *sv, int radix)
 106 {
 107   mptext_svctx c;
 108   int rc;
 109   STRLEN len;
 110   SvPV(sv, len);
 111   c.sv = sv;
 112   rc = mp_write(m, radix, &mptext_svops, &c);
 113   return (rc);
 114 }
 115
 116 /* --- Conversion to and from SVs --- */
 117
 118 mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...)
 119 {
 120   mp *m;
 121   if (SvROK(sv)) {
 122     if (sv_derived_from(sv, "Catacomb::MP"))
 123       m = (mp *)SvIV((SV *)SvRV(sv));
 124     else {
 125       va_list ap;
 126       SV *t = NEWSV(0, 0);
 127       va_start(ap, keep);
 128       sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0);
 129       croak("%s is not of type Catacomb::MP", SvPVX(t));
 130       SvREFCNT_dec(t);
 131     }
 132   } else {
 133     if (SvIOK(sv))
 134       m = mp_fromiv(MP_NEW, SvIV(sv));
 135     else
 136       m = mp_readsv(MP_NEW, sv, 0, radix);
 137     if (m && !keep)
 138       RET_MP(m);                        /* Kill temporary later */
 139   }
 140   return (m);
 141 }
 142
 143 /*----- That's all, folks -------------------------------------------------*/