chiark - git - mdw - catacomb-perl/blob - mp.xs

   1 # ---?---
   2 #
   3 # $Id: mp.xs,v 1.2 2004/04/08 01:36:21 mdw Exp $
   4 #
   5 # Multiprecision interface
   6 #
   7 # (c) 2000 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 MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = mp_
  30
  31 mp *
  32 new(me, sv = 0, radix = 0)
  33         SV *me
  34         SV *sv
  35         int radix
  36         CODE:
  37         RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO;
  38         OUTPUT:
  39         RETVAL
  40
  41 mp *
  42 mp_copy(x)
  43         mp *x
  44
  45 mp *
  46 loadb(me, sv)
  47         SV *me
  48         SV *sv
  49         PREINIT:
  50         char *p;
  51         STRLEN len;
  52         CODE:
  53         p = SvPV(sv, len);
  54         RETVAL = mp_loadb(MP_NEW, p, len);
  55         OUTPUT:
  56         RETVAL
  57
  58 mp *
  59 loadl(me, sv)
  60         SV *me
  61         SV *sv
  62         PREINIT:
  63         char *p;
  64         STRLEN len;
  65         CODE:
  66         p = SvPV(sv, len);
  67         RETVAL = mp_loadl(MP_NEW, p, len);
  68         OUTPUT:
  69         RETVAL
  70
  71 int
  72 metrics(m)
  73         mp *m
  74         INTERFACE_MACRO:
  75         XSINTERFACE_FUNC
  76         XSINTERFACE_FUNC_SETMP
  77         INTERFACE:
  78         octets bits
  79
  80 SV *
  81 storeb(m, i = -1)
  82         mp *m
  83         int i
  84         PREINIT:
  85         size_t sz;
  86         CODE:
  87         sz = (i < 0) ? mp_octets(m) : i;
  88         RETVAL = NEWSV(0, sz ? sz : 1);
  89         mp_storeb(m, SvPVX(RETVAL), sz);
  90         SvCUR_set(RETVAL, sz);
  91         SvPOK_on(RETVAL);
  92         OUTPUT:
  93         RETVAL
  94
  95 SV *
  96 storel(m, i = -1)
  97         mp *m
  98         int i
  99         PREINIT:
 100         size_t sz;
 101         CODE:
 102         sz = (i < 0) ? mp_octets(m) : i;
 103         RETVAL = NEWSV(0, sz ? sz : 1);
 104         mp_storel(m, SvPVX(RETVAL), sz);
 105         SvCUR_set(RETVAL, sz);
 106         SvPOK_on(RETVAL);
 107         OUTPUT:
 108         RETVAL
 109
 110 SV *
 111 tostring(m, radix = 10)
 112         mp *m
 113         int radix
 114         CODE:
 115         RETVAL = NEWSV(0, 0);
 116         mp_writesv(m, RETVAL, radix);
 117         OUTPUT:
 118         RETVAL
 119
 120 SV *
 121 toint(m)
 122         mp *m
 123         CODE:
 124         RETVAL = newSViv(mp_toiv(m));
 125         OUTPUT:
 126         RETVAL
 127
 128 SV *
 129 DESTROY(m)
 130         mp *m
 131         CODE:
 132         mp_drop(m);
 133         XSRETURN_UNDEF;
 134
 135 mp *
 136 unop(a)
 137         mp *a
 138         C_ARGS:
 139         MP_NEW, a
 140         INTERFACE_MACRO:
 141         XSINTERFACE_FUNC
 142         XSINTERFACE_FUNC_SETMP
 143         INTERFACE:
 144         not sqr sqrt
 145
 146 mp *
 147 neg(a)
 148         mp *a
 149         CODE:
 150         mp_copy(a);
 151         RETVAL = mp_split(a);
 152         if (RETVAL->v < RETVAL->vl)
 153           RETVAL->f ^= MP_NEG;
 154         OUTPUT:
 155         RETVAL
 156
 157 mp *
 158 mp_factorial(me, x)
 159         SV *me
 160         IV x
 161         C_ARGS:
 162         x
 163
 164 mp *
 165 binop(a, b)
 166         mp *a
 167         mp *b
 168         C_ARGS:
 169         MP_NEW, a, b
 170         INTERFACE_MACRO:
 171         XSINTERFACE_FUNC
 172         XSINTERFACE_FUNC_SETMP
 173         INTERFACE:
 174         add sub mul and or xor
 175
 176 mp *
 177 shiftop(a, n)
 178         mp *a
 179         int n
 180         C_ARGS:
 181         MP_NEW, a, n
 182         INTERFACE_MACRO:
 183         XSINTERFACE_FUNC
 184         XSINTERFACE_FUNC_SETMP
 185         INTERFACE:
 186         lsl lsr
 187
 188 int
 189 mp_cmp(a, b)
 190         mp *a
 191         mp *b
 192
 193 int
 194 mp_eq(a, b)
 195         mp *a
 196         mp *b
 197
 198 int
 199 jacobi(a, n)
 200         mp *a
 201         mp *n
 202         CODE:
 203         if (!MP_LEN(n) || !(n->v[0] & 1))
 204           croak("n must be odd in Catacomb::MP::jacobi");
 205         RETVAL = mp_jacobi(a, n);
 206         OUTPUT:
 207         RETVAL
 208
 209 mp *
 210 mp_modsqrt(p, x)
 211         mp *p
 212         mp *x
 213         C_ARGS:
 214         MP_NEW, x, p
 215
 216 void
 217 div(a, b)
 218         mp *a
 219         mp *b
 220         PREINIT:
 221         mp *q = MP_NEW, *r = MP_NEW;
 222         PPCODE:
 223         if (MP_EQ(b, MP_ZERO))
 224           croak("Divide by zero in Catacomb::MP::div");
 225         q = MP_NEW;
 226         switch (GIMME_V) {
 227           case G_ARRAY:
 228             r = MP_NEW;
 229             mp_div(&q, &r, a, b);
 230             EXTEND(SP, 2);
 231             PUSHs(RET_MP(q));
 232             PUSHs(RET_MP(r));
 233             break;
 234           case G_VOID:
 235             break;
 236           default:
 237             mp_div(&q, &r, a, b);
 238             EXTEND(SP, 1);
 239             PUSHs(RET_MP(q));
 240             break;
 241         }
 242
 243 void
 244 gcd(a, b)
 245         mp *a
 246         mp *b
 247         PREINIT:
 248         mp *g = MP_NEW, *x = MP_NEW, *y = MP_NEW;
 249         PPCODE:
 250         switch (GIMME_V) {
 251           case G_ARRAY:
 252             mp_gcd(&g, &x, &y, a, b);
 253             EXTEND(SP, 3);
 254             PUSHs(RET_MP(g));
 255             PUSHs(RET_MP(x));
 256             PUSHs(RET_MP(y));
 257             break;
 258           case G_VOID:
 259             break;
 260           default:
 261             mp_gcd(&g, 0, 0, a, b);
 262             EXTEND(SP, 1);
 263             PUSHs(RET_MP(g));
 264             break;
 265         }
 266
 267 void
 268 odd(m)
 269         mp *m
 270         PREINIT:
 271         mp *t;
 272         size_t s;
 273         PPCODE:
 274         t = mp_odd(MP_NEW, m, &s);
 275         EXTEND(SP, 2);
 276         PUSHs(RET_MP(t));
 277         PUSHs(sv_2mortal(newSViv(s)));
 278
 279 int
 280 smallfactor(x)
 281         mp *x
 282         CODE:
 283         RETVAL = pfilt_smallfactor(x);
 284         OUTPUT:
 285         RETVAL
 286
 287 MP_Mont *
 288 mont(x)
 289         mp *x
 290         CODE:
 291         if (x->f & MP_NEG)
 292           croak("Argument to Catacomb::MP::mont must be positive");
 293         if (x->v == x->vl || !(x->v[0] & 1u))
 294           croak("Argument to Catacomb::MP::mont must be odd");
 295         RETVAL = CREATE(MP_Mont);
 296         mpmont_create(RETVAL, x);
 297         OUTPUT:
 298         RETVAL
 299
 300 MP_Barrett *
 301 barrett(x)
 302         mp *x
 303         CODE:
 304         if (x->f & MP_NEG)
 305           croak("Argument to Catacomb::MP::barrett must be positive");
 306         RETVAL = CREATE(mpbarrett);
 307         mpbarrett_create(RETVAL, x);
 308         OUTPUT:
 309         RETVAL
 310
 311 MP_Prime_Rabin *
 312 rabin(x)
 313         mp *x
 314         CODE:
 315         if (x->f & MP_NEG)
 316           croak("Argument to Catacomb::MP::rabin must be positive");
 317         if (x->v == x->vl || !(x->v[0] & 1u))
 318           croak("Argument to Catacomb::MP::rabin must be odd");
 319         RETVAL = CREATE(MP_Prime_Rabin);
 320         rabin_create(RETVAL, x);
 321         OUTPUT:
 322         RETVAL
 323
 324 MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_
 325
 326 MP_Mont *
 327 new(me, x)
 328         SV *me
 329         mp *x
 330         CODE:
 331         if (x->f & MP_NEG)
 332           croak("Argument to Catacomb::MP::Mont::new must be positive");
 333         if (x->v == x->vl || !(x->v[0] & 1u))
 334           croak("Argument to Catacomb::MP::Mont::new must be odd");
 335         RETVAL = CREATE(MP_Mont);
 336         mpmont_create(RETVAL, x);
 337         OUTPUT:
 338         RETVAL
 339
 340 SV *
 341 DESTROY(mm)
 342         MP_Mont *mm
 343         CODE:
 344         mpmont_destroy(mm);
 345         DESTROY(mm);
 346         XSRETURN_UNDEF;
 347
 348 mp *
 349 mpmont_reduce(mm, x)
 350         MP_Mont *mm
 351         mp *x
 352         C_ARGS:
 353         mm, MP_NEW, x
 354
 355 mp *
 356 mpmont_mul(mm, x, y)
 357         MP_Mont *mm
 358         mp *x
 359         mp *y
 360         C_ARGS:
 361         mm, MP_NEW, x, y
 362
 363 mp *
 364 mpmont_expr(mm, g, x)
 365         MP_Mont *mm
 366         mp *g
 367         mp *x
 368         C_ARGS:
 369         mm, MP_NEW, g, x
 370
 371 mp *
 372 mpmont_exp(mm, g, x)
 373         MP_Mont *mm
 374         mp *g
 375         mp *x
 376         C_ARGS:
 377         mm, MP_NEW, g, x
 378
 379 mp *
 380 mpmont_mexpr(mm, ...)
 381         MP_Mont *mm
 382         PREINIT:
 383         mp_expfactor *v;
 384         size_t i, j, n;
 385         CODE:
 386         if (items < 3 || !(items & 1)) {
 387           croak("Usage: Catacomb::MP::Mont::mexpr"
 388                 "(mm, g_0, x_0, g_1, x_1, ...");
 389         }
 390         n = (items - 1)/2;
 391         v = xmalloc(n * sizeof(mp_expfactor));
 392         for (i = 1, j = 0; i < items; i += 2, j++) {
 393           v[j].base = mp_fromsv(ST(i), "g_i", 0, 0);
 394           v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0);
 395         }
 396         RETVAL = mpmont_mexpr(mm, MP_NEW, v, n);
 397         xfree(v);
 398         OUTPUT:
 399         RETVAL
 400
 401 mp *
 402 mpmont_mexp(mm, ...)
 403         MP_Mont *mm
 404         PREINIT:
 405         mp_expfactor *v;
 406         size_t i, j, n;
 407         CODE:
 408         if (items < 3 || !(items & 1)) {
 409           croak("Usage: Catacomb::MP::Mont::mexp"
 410                 "(mm, g_0, x_0, g_1, x_1, ...");
 411         }
 412         n = (items - 1)/2;
 413         v = xmalloc(n * sizeof(mp_expfactor));
 414         for (i = 1, j = 0; i < items; i += 2, j++) {
 415           v[j].base = mp_fromsv(ST(i), "g_%lu", 0, 0, (unsigned long)i);
 416           v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", 0, 0, (unsigned long)i);
 417         }
 418         RETVAL = mpmont_mexp(mm, MP_NEW, v, n);
 419         xfree(v);
 420         OUTPUT:
 421         RETVAL
 422
 423 mp *
 424 r(mm)
 425         MP_Mont *mm
 426         CODE:
 427         RETVAL = mp_copy(mm->r);
 428         OUTPUT:
 429         RETVAL
 430
 431 mp *
 432 r2(mm)
 433         MP_Mont *mm
 434         CODE:
 435         RETVAL = mp_copy(mm->r2);
 436         OUTPUT:
 437         RETVAL
 438
 439 mp *
 440 m(mm)
 441         MP_Mont *mm
 442         CODE:
 443         RETVAL = mp_copy(mm->m);
 444         OUTPUT:
 445         RETVAL
 446
 447 MODULE = Catacomb PACKAGE = Catacomb::MP::Barrett PREFIX = mpbarrett_
 448
 449 MP_Barrett *
 450 new(me, x)
 451         SV *me
 452         mp *x
 453         CODE:
 454         if (x->f & MP_NEG)
 455           croak("Argument to Catacomb::MP::Barrett::new must be positive");
 456         RETVAL = CREATE(mpbarrett);
 457         mpbarrett_create(RETVAL, x);
 458         OUTPUT:
 459         RETVAL
 460
 461 SV *
 462 DESTROY(mb)
 463         MP_Barrett *mb
 464         CODE:
 465         mpbarrett_destroy(mb);
 466         DESTROY(mb);
 467         XSRETURN_UNDEF;
 468
 469 mp *
 470 mpbarrett_reduce(mb, x)
 471         MP_Barrett *mb
 472         mp *x
 473         C_ARGS:
 474         mb, MP_NEW, x
 475
 476 mp *
 477 mpbarrett_exp(mb, g, x)
 478         MP_Barrett *mb
 479         mp *g
 480         mp *x
 481         C_ARGS:
 482         mb, MP_NEW, g, x
 483
 484 mp *
 485 m(mb)
 486         MP_Barrett *mb
 487         CODE:
 488         RETVAL = mp_copy(mb->m);
 489         OUTPUT:
 490         RETVAL
 491
 492 MODULE = Catacomb PACKAGE = Catacomb::MP::CRT
 493
 494 MP_CRT *
 495 new(me, ...)
 496         SV *me
 497         PREINIT:
 498         mpcrt_mod *v;
 499         size_t n, i;
 500         CODE:
 501         if (items < 1)
 502           croak("Usage: Catacomb::MP::CRT::new(me, n_0, n_1, ...)");
 503         n = items - 1;
 504         v = xmalloc(n * sizeof(mpcrt_mod));
 505         for (i = 0; i < n; i++) {
 506           v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 0, 0,
 507                            (unsigned long)i));
 508         }
 509         RETVAL = CREATE(MP_CRT);
 510         mpcrt_create(RETVAL, v, n, 0);
 511         OUTPUT:
 512         RETVAL
 513
 514 SV *
 515 DESTROY(mc)
 516         MP_CRT *mc
 517         CODE:
 518         mpcrt_destroy(mc);
 519         xfree(mc->v);
 520         DESTROY(mc);
 521         XSRETURN_UNDEF;
 522
 523 mp *
 524 solve(mc, ...)
 525         MP_CRT *mc
 526         PREINIT:
 527         mp **v;
 528         size_t n, i;
 529         CODE:
 530         n = mc->k;
 531         if (items - 1 != n)
 532           croak("Wrong number of residues for this CRT context");
 533         for (i = 0; i < n; i++)
 534           v[i] = mp_fromsv(ST(i + 1), "r_%lu", 0, 0, (unsigned long)i);
 535         RETVAL = mpcrt_solve(mc, MP_NEW, v);
 536         xfree(v);
 537         OUTPUT:
 538         RETVAL
 539
 540 #----- That's all, folks ----------------------------------------------------