Much wider support for Catacomb in all its glory.

[catacomb-perl] / mpstuff.c

/* -*-c-*-
 *
 * $Id$
 *
 * MP manipulation stuff
 *
 * (c) 2001 Straylight/Edgeware
 */

/*----- Licensing notice --------------------------------------------------* 
 *
 * This file is part of the Perl interface to Catacomb.
 *
 * Catacomb/Perl is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * Catacomb/Perl is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with Catacomb/Perl; if not, write to the Free Software Foundation,
 * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 */

/*----- Header files ------------------------------------------------------*/

#include "catacomb-perl.h"

/*----- Main code ---------------------------------------------------------*/

/* --- Convert Perl integers to multiprecision --- */

mp *mp_fromiv(mp *d, IV iv)
{
  MP_FROMINT(d, IV, iv);
  return (d);
}

IV mp_toiv(mp *x)
{
  IV i;
  MP_TOINT(x, IV, IV_MAX, i);
  return (i);
}

/* --- Parse Perl strings into integers --- */

typedef struct mptext_svctx {
  SV *sv;
  STRLEN i;
} mptext_svctx;

static int svget(void *p)
{
  mptext_svctx *c = p;
  if (c->i >= SvCUR(c->sv))
    return (EOF);
  return ((unsigned char)SvPVX(c->sv)[c->i++]);
}

static void svunget(int ch, void *p)
{
  mptext_svctx *c = p;
  if (ch == EOF || c->i == 0)
    return;
  c->i--;
}

static int svput(const char *s, size_t sz, void *p)
{
  mptext_svctx *c = p;
  sv_catpvn(c->sv, (char *)s, sz);
  return (0);
}

static const mptext_ops mptext_svops = { svget, svunget, svput };

mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix)
{
  mptext_svctx c;
  STRLEN len;
  SvPV(sv, len);
  if (!SvPOK(sv))
    return (0);
  c.sv = sv;
  c.i = off ? *off : 0;
  m = mp_read(m, radix, &mptext_svops, &c);
  if (off)
    *off = c.i;
  return (m);
}

int group_writesv(group *g, ge *x, SV *sv)
{
  mptext_svctx c;
  int rc;
  STRLEN len;
  sv_setpvn(sv, "", 0);
  c.sv = sv;
  rc = G_WRITE(g, x, &mptext_svops, &c);
  return (rc);
}

int mp_writesv(mp *m, SV *sv, int radix)
{
  mptext_svctx c;
  int rc;
  STRLEN len;
  sv_setpvn(sv, "", 0);
  c.sv = sv;
  rc = mp_write(m, radix, &mptext_svops, &c);
  return (rc);
}

/* --- Conversion to and from SVs --- */

mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...)
{
  mp *m;
  if (SvROK(sv)) {
    if (sv_derived_from(sv, "Catacomb::MP"))
      m = (mp *)SvIV((SV *)SvRV(sv));
    else {
      va_list ap;
      SV *t = sv_newmortal();
      va_start(ap, keep);
      sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0);      
      croak("%s is not of type Catacomb::MP", SvPVX(t));
    }
    if (m && keep)
      MP_COPY(m);
  } else {
    if (SvIOK(sv))
      m = mp_fromiv(MP_NEW, SvIV(sv));
    else
      m = mp_readsv(MP_NEW, sv, 0, radix);
    if (m && !keep)
      RET_MP(m);			/* Kill temporary later */
  }
  return (m);
}

/*----- That's all, folks -------------------------------------------------*/