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

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