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 and or 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
 192
 193 int
 194 mp_cmp(a, b)
 195         mp *a
 196         mp *b
 197
 198 int
 199 mp_eq(a, b)
 200         mp *a
 201         mp *b
 202
 203 int
 204 jacobi(a, n)
 205         mp *a
 206         mp *n
 207         CODE:
 208         if (!MP_LEN(n) || !(n->v[0] & 1))
 209           croak("n must be odd in Catacomb::MP::jacobi");
 210         RETVAL = mp_jacobi(a, n);
 211         OUTPUT:
 212         RETVAL
 213
 214 mp *
 215 mp_modsqrt(p, x)
 216         mp *p
 217         mp *x
 218         C_ARGS:
 219         MP_NEW, x, p
 220
 221 void
 222 div(a, b)
 223         mp *a
 224         mp *b
 225         PREINIT:
 226         mp *q = MP_NEW, *r = MP_NEW;
 227         PPCODE:
 228         if (MP_EQ(b, MP_ZERO))
 229           croak("Divide by zero in Catacomb::MP::div");
 230         q = MP_NEW;
 231         switch (GIMME_V) {
 232           case G_ARRAY:
 233             r = MP_NEW;
 234             mp_div(&q, &r, a, b);
 235             EXTEND(SP, 2);
 236             PUSHs(RET_MP(q));
 237             PUSHs(RET_MP(r));
 238             break;
 239           case G_VOID:
 240             break;
 241           default:
 242             mp_div(&q, &r, a, b);
 243             EXTEND(SP, 1);
 244             PUSHs(RET_MP(q));
 245             break;
 246         }
 247
 248 void
 249 gcd(a, b)
 250         mp *a
 251         mp *b
 252         PREINIT:
 253         mp *g = MP_NEW, *x = MP_NEW, *y = MP_NEW;
 254         PPCODE:
 255         switch (GIMME_V) {
 256           case G_ARRAY:
 257             mp_gcd(&g, &x, &y, a, b);
 258             EXTEND(SP, 3);
 259             PUSHs(RET_MP(g));
 260             PUSHs(RET_MP(x));
 261             PUSHs(RET_MP(y));
 262             break;
 263           case G_VOID:
 264             break;
 265           default:
 266             mp_gcd(&g, 0, 0, a, b);
 267             EXTEND(SP, 1);
 268             PUSHs(RET_MP(g));
 269             break;
 270         }
 271
 272 void
 273 odd(m)
 274         mp *m
 275         PREINIT:
 276         mp *t;
 277         size_t s;
 278         PPCODE:
 279         t = mp_odd(MP_NEW, m, &s);
 280         EXTEND(SP, 2);
 281         PUSHs(RET_MP(t));
 282         PUSHs(sv_2mortal(newSViv(s)));
 283
 284 int
 285 smallfactor(x)
 286         mp *x
 287         CODE:
 288         RETVAL = pfilt_smallfactor(x);
 289         OUTPUT:
 290         RETVAL
 291
 292 MP_Reduce *
 293 makereduce(x)
 294         mp *x
 295         CODE:
 296         if (!MP_POSP(x))
 297           croak("Argument to Catacomb::MP::makereduce must be positive");
 298         RETVAL = CREATE(MP_Reduce);
 299         mpreduce_create(RETVAL, x);
 300         OUTPUT:
 301         RETVAL
 302
 303 MP_Mont *
 304 mont(x)
 305         mp *x
 306         CODE:
 307         if (!MP_POSP(x))
 308           croak("Argument to Catacomb::MP::mont must be positive");
 309         if (!MP_ODDP(x))
 310           croak("Argument to Catacomb::MP::mont must be odd");
 311         RETVAL = CREATE(MP_Mont);
 312         mpmont_create(RETVAL, x);
 313         OUTPUT:
 314         RETVAL
 315
 316 MP_Barrett *
 317 barrett(x)
 318         mp *x
 319         CODE:
 320         if (!MP_POSP(x))
 321           croak("Argument to Catacomb::MP::barrett must be positive");
 322         RETVAL = CREATE(mpbarrett);
 323         mpbarrett_create(RETVAL, x);
 324         OUTPUT:
 325         RETVAL
 326
 327 MP_Prime_Rabin *
 328 rabin(x)
 329         mp *x
 330         CODE:
 331         if (!MP_POSP(x))
 332           croak("Argument to Catacomb::MP::rabin must be positive");
 333         if (!MP_ODDP(x))
 334           croak("Argument to Catacomb::MP::rabin must be odd");
 335         RETVAL = CREATE(MP_Prime_Rabin);
 336         rabin_create(RETVAL, x);
 337         OUTPUT:
 338         RETVAL
 339
 340 MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_
 341
 342 MP_Mont *
 343 new(me, x)
 344         SV *me
 345         mp *x
 346         CODE:
 347         if (!MP_POSP(x))
 348           croak("Argument to Catacomb::MP::Mont::new must be positive");
 349         if (!MP_ODDP(x))
 350           croak("Argument to Catacomb::MP::Mont::new must be odd");
 351         RETVAL = CREATE(MP_Mont);
 352         mpmont_create(RETVAL, x);
 353         OUTPUT:
 354         RETVAL
 355
 356 SV *
 357 DESTROY(mm)
 358         MP_Mont *mm
 359         CODE:
 360         mpmont_destroy(mm);
 361         DESTROY(mm);
 362         XSRETURN_UNDEF;
 363
 364 mp *
 365 mpmont_reduce(mm, x)
 366         MP_Mont *mm
 367         mp *x
 368         C_ARGS:
 369         mm, MP_NEW, x
 370
 371 mp *
 372 mpmont_mul(mm, x, y)
 373         MP_Mont *mm
 374         mp *x
 375         mp *y
 376         C_ARGS:
 377         mm, MP_NEW, x, y
 378
 379 mp *
 380 mpmont_expr(mm, g, x)
 381         MP_Mont *mm
 382         mp *g
 383         mp *x
 384         C_ARGS:
 385         mm, MP_NEW, g, x
 386
 387 mp *
 388 mpmont_exp(mm, g, x)
 389         MP_Mont *mm
 390         mp *g
 391         mp *x
 392         C_ARGS:
 393         mm, MP_NEW, g, x
 394
 395 mp *
 396 mpmont_mexpr(mm, ...)
 397         MP_Mont *mm
 398         PREINIT:
 399         mp_expfactor *v;
 400         size_t i, j, n;
 401         CODE:
 402         if (items < 3 || !(items & 1)) {
 403           croak("Usage: Catacomb::MP::Mont::mexpr"
 404                 "(mm, g_0, x_0, g_1, x_1, ...");
 405         }
 406         n = (items - 1)/2;
 407         v = xmalloc(n * sizeof(mp_expfactor));
 408         for (i = 1, j = 0; i < items; i += 2, j++) {
 409           v[j].base = mp_fromsv(ST(i), "g_i", "Catacomb::MP", 0, 0);
 410           v[j].exp = mp_fromsv(ST(i + 1), "x_i", "Catacomb::MP", 0, 0);
 411         }
 412         RETVAL = mpmont_mexpr(mm, MP_NEW, v, n);
 413         xfree(v);
 414         OUTPUT:
 415         RETVAL
 416
 417 mp *
 418 mpmont_mexp(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::mexp"
 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_%lu",
 432                                 "Catacomb::MP", 0, 0, (unsigned long)i);
 433           v[j].exp = mp_fromsv(ST(i + 1), "x_%lu",
 434                                "Catacomb::MP", 0, 0, (unsigned long)i);
 435         }
 436         RETVAL = mpmont_mexp(mm, MP_NEW, v, n);
 437         xfree(v);
 438         OUTPUT:
 439         RETVAL
 440
 441 mp *
 442 r(mm)
 443         MP_Mont *mm
 444         CODE:
 445         RETVAL = MP_COPY(mm->r);
 446         OUTPUT:
 447         RETVAL
 448
 449 mp *
 450 r2(mm)
 451         MP_Mont *mm
 452         CODE:
 453         RETVAL = MP_COPY(mm->r2);
 454         OUTPUT:
 455         RETVAL
 456
 457 mp *
 458 m(mm)
 459         MP_Mont *mm
 460         CODE:
 461         RETVAL = MP_COPY(mm->m);
 462         OUTPUT:
 463         RETVAL
 464
 465 MODULE = Catacomb PACKAGE = Catacomb::MP::Barrett PREFIX = mpbarrett_
 466
 467 MP_Barrett *
 468 new(me, x)
 469         SV *me
 470         mp *x
 471         CODE:
 472         if (!MP_POSP(x))
 473           croak("Argument to Catacomb::MP::Barrett::new must be positive");
 474         RETVAL = CREATE(mpbarrett);
 475         mpbarrett_create(RETVAL, x);
 476         OUTPUT:
 477         RETVAL
 478
 479 SV *
 480 DESTROY(mb)
 481         MP_Barrett *mb
 482         CODE:
 483         mpbarrett_destroy(mb);
 484         DESTROY(mb);
 485         XSRETURN_UNDEF;
 486
 487 mp *
 488 mpbarrett_reduce(mb, x)
 489         MP_Barrett *mb
 490         mp *x
 491         C_ARGS:
 492         mb, MP_NEW, x
 493
 494 mp *
 495 mpbarrett_exp(mb, g, x)
 496         MP_Barrett *mb
 497         mp *g
 498         mp *x
 499         C_ARGS:
 500         mb, MP_NEW, g, x
 501
 502 mp *
 503 m(mb)
 504         MP_Barrett *mb
 505         CODE:
 506         RETVAL = MP_COPY(mb->m);
 507         OUTPUT:
 508         RETVAL
 509
 510 MODULE = Catacomb PACKAGE = Catacomb::MP::Reduce PREFIX = mpreduce_
 511
 512 MP_Reduce *
 513 new(me, x)
 514         SV *me
 515         mp *x
 516         CODE:
 517         if (!MP_POSP(x))
 518           croak("Argument to Catacomb::MP::Reduce::new must be positive");
 519         RETVAL = CREATE(mpreduce);
 520         mpreduce_create(RETVAL, x);
 521         OUTPUT:
 522         RETVAL
 523
 524 SV *
 525 DESTROY(r)
 526         MP_Reduce *r
 527         CODE:
 528         mpreduce_destroy(r);
 529         DESTROY(r);
 530         XSRETURN_UNDEF;
 531
 532 mp *
 533 reduce(r, x)
 534         MP_Reduce *r
 535         mp *x
 536         CODE:
 537         RETVAL = mpreduce_do(r, MP_NEW, x);
 538         OUTPUT:
 539         RETVAL
 540
 541 mp *
 542 mpreduce_exp(r, x, y)
 543         MP_Reduce *r
 544         mp *x
 545         mp *y
 546         C_ARGS:
 547         r, MP_NEW, x, y
 548
 549 mp *
 550 m(r)
 551         MP_Reduce *r
 552         CODE:
 553         RETVAL = MP_COPY(r->p);
 554         OUTPUT:
 555         RETVAL
 556
 557 MODULE = Catacomb PACKAGE = Catacomb::MP::CRT
 558
 559 MP_CRT *
 560 new(me, ...)
 561         SV *me
 562         PREINIT:
 563         mpcrt_mod *v;
 564         size_t n, i;
 565         CODE:
 566         if (items < 1)
 567           croak("Usage: Catacomb::MP::CRT::new(me, n_0, n_1, ...)");
 568         n = items - 1;
 569         v = xmalloc(n * sizeof(mpcrt_mod));
 570         for (i = 0; i < n; i++) {
 571           v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu",
 572                            "Catacomb::MP", 0, 0,
 573                            (unsigned long)i));
 574         }
 575         RETVAL = CREATE(MP_CRT);
 576         mpcrt_create(RETVAL, v, n, 0);
 577         OUTPUT:
 578         RETVAL
 579
 580 SV *
 581 DESTROY(mc)
 582         MP_CRT *mc
 583         CODE:
 584         mpcrt_destroy(mc);
 585         xfree(mc->v);
 586         DESTROY(mc);
 587         XSRETURN_UNDEF;
 588
 589 mp *
 590 solve(mc, ...)
 591         MP_CRT *mc
 592         PREINIT:
 593         mp **v;
 594         size_t n, i;
 595         CODE:
 596         n = mc->k;
 597         if (items - 1 != n)
 598           croak("Wrong number of residues for this CRT context");
 599         for (i = 0; i < n; i++) {
 600           v[i] = mp_fromsv(ST(i + 1), "r_%lu", "Catacomb::MP",
 601                            0, 0, (unsigned long)i);
 602         }
 603         RETVAL = mpcrt_solve(mc, MP_NEW, v);
 604         xfree(v);
 605         OUTPUT:
 606         RETVAL
 607
 608 #----- That's all, folks ----------------------------------------------------