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

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