chiark - git - mdw - catacomb-perl/blob - gf.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::GF PREFIX = gf_
  30
  31 gf *
  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 gf *
  42 copy(x)
  43         gf *x
  44         CODE:
  45         RETVAL = MP_COPY(x);
  46         OUTPUT:
  47         RETVAL
  48
  49 gf *
  50 loadb(me, sv)
  51         SV *me
  52         SV *sv
  53         PREINIT:
  54         char *p;
  55         STRLEN len;
  56         CODE:
  57         p = SvPV(sv, len);
  58         RETVAL = mp_loadb(MP_NEW, p, len);
  59         OUTPUT:
  60         RETVAL
  61
  62 gf *
  63 loadl(me, sv)
  64         SV *me
  65         SV *sv
  66         PREINIT:
  67         char *p;
  68         STRLEN len;
  69         CODE:
  70         p = SvPV(sv, len);
  71         RETVAL = mp_loadl(MP_NEW, p, len);
  72         OUTPUT:
  73         RETVAL
  74
  75 mp *
  76 gf_sqr(a)
  77         gf *a
  78         C_ARGS:
  79         MP_NEW, a
  80         INTERFACE_MACRO:
  81         XSINTERFACE_FUNC
  82         XSINTERFACE_FUNC_SETGF
  83         INTERFACE:
  84         sqr
  85
  86 mp *
  87 binop(a, b)
  88         gf *a
  89         gf *b
  90         C_ARGS:
  91         MP_NEW, a, b
  92         INTERFACE_MACRO:
  93         XSINTERFACE_FUNC
  94         XSINTERFACE_FUNC_SETGF
  95         INTERFACE:
  96         add sub mul
  97
  98 mp *
  99 logop(a, b)
 100         gf *a
 101         gf *b
 102         C_ARGS:
 103         MP_NEW, a, b
 104         INTERFACE_MACRO:
 105         XSINTERFACE_FUNC
 106         XSINTERFACE_FUNC_SETMP
 107         INTERFACE:
 108         and or xor nand nor
 109
 110 mp *
 111 unop(a)
 112         gf *a
 113         C_ARGS:
 114         MP_NEW, a
 115         INTERFACE_MACRO:
 116         XSINTERFACE_FUNC
 117         XSINTERFACE_FUNC_SETMP
 118         INTERFACE:
 119         not
 120
 121 gf *
 122 shiftop(a, n)
 123         gf *a
 124         int n
 125         C_ARGS:
 126         MP_NEW, a, n
 127         INTERFACE_MACRO:
 128         XSINTERFACE_FUNC
 129         XSINTERFACE_FUNC_SETMP
 130         INTERFACE:
 131         lsl lsr
 132
 133 gf *
 134 flipbits(a, n)
 135         gf *a
 136         unsigned long n
 137         C_ARGS:
 138         MP_NEW, a, n
 139         INTERFACE_MACRO:
 140         XSINTERFACE_FUNC
 141         XSINTERFACE_FUNC_SETMP
 142         INTERFACE:
 143         setbit clearbit
 144
 145 int
 146 gf_irreduciblep(a)
 147         gf *a
 148
 149 void
 150 div(a, b)
 151         mp *a
 152         mp *b
 153         PREINIT:
 154         mp *q = MP_NEW, *r = MP_NEW;
 155         PPCODE:
 156         if (MP_EQ(b, MP_ZERO))
 157           croak("Divide by zero in Catacomb::GF::div");
 158         q = MP_NEW;
 159         switch (GIMME_V) {
 160           case G_ARRAY:
 161             r = MP_NEW;
 162             mp_div(&q, &r, a, b);
 163             EXTEND(SP, 2);
 164             PUSHs(RET_GF(q));
 165             PUSHs(RET_GF(r));
 166             break;
 167           case G_VOID:
 168             break;
 169           default:
 170             mp_div(&q, &r, a, b);
 171             EXTEND(SP, 1);
 172             PUSHs(RET_GF(q));
 173             break;
 174         }
 175
 176 void
 177 gcd(a, b)
 178         gf *a
 179         gf *b
 180         PREINIT:
 181         gf *g = MP_NEW, *x = MP_NEW, *y = MP_NEW;
 182         PPCODE:
 183         switch (GIMME_V) {
 184           case G_ARRAY:
 185             gf_gcd(&g, &x, &y, a, b);
 186             EXTEND(SP, 3);
 187             PUSHs(RET_GF(g));
 188             PUSHs(RET_GF(x));
 189             PUSHs(RET_GF(y));
 190             break;
 191           case G_VOID:
 192             break;
 193           default:
 194             gf_gcd(&g, 0, 0, a, b);
 195             EXTEND(SP, 1);
 196             PUSHs(RET_GF(g));
 197             break;
 198         }
 199
 200 MODULE = Catacomb PACKAGE = Catacomb::GF::Reduce PREFIX = gfreduce_
 201
 202 GF_Reduce *
 203 new(me, x)
 204         gf *x
 205         CODE:
 206         RETVAL = CREATE(GF_Reduce);
 207         gfreduce_create(RETVAL, x);
 208         OUTPUT:
 209         RETVAL
 210
 211 SV *
 212 DESTROY(r)
 213         GF_Reduce *r
 214         CODE:
 215         gfreduce_destroy(r);
 216         DESTROY(r);
 217         XSRETURN_UNDEF;
 218
 219 gf *
 220 reduce(r, x)
 221         GF_Reduce *r
 222         gf *x
 223         CODE:
 224         RETVAL = gfreduce_do(r, MP_NEW, x);
 225         OUTPUT:
 226         RETVAL
 227
 228 gf *
 229 sqrt(r, x)
 230         GF_Reduce *r
 231         gf *x
 232         CODE:
 233         if ((RETVAL = gfreduce_sqrt(r, MP_NEW, x)) == 0)
 234           XSRETURN_UNDEF;
 235         OUTPUT:
 236         RETVAL
 237
 238 int
 239 gfreduce_trace(r, x)
 240         GF_Reduce *r
 241         gf *x
 242
 243 gf *
 244 gfreduce_halftrace(r, x)
 245         GF_Reduce *r
 246         gf *x
 247         C_ARGS:
 248         r, MP_NEW, x
 249
 250 gf *
 251 quadsolve(r, x)
 252         GF_Reduce *r
 253         gf *x
 254         CODE:
 255         if ((RETVAL = gfreduce_quadsolve(r, MP_NEW, x)) == 0)
 256           XSRETURN_UNDEF;
 257         OUTPUT:
 258         RETVAL
 259
 260 gf *
 261 m(r)
 262         GF_Reduce *r
 263         CODE:
 264         RETVAL = MP_COPY(r->p);
 265         OUTPUT:
 266         RETVAL
 267
 268 gf *
 269 gfreduce_exp(r, x, y)
 270         GF_Reduce *r
 271         gf *x
 272         gf *y
 273         C_ARGS:
 274         r, MP_NEW, x, y
 275
 276 #----- That's all, folks ----------------------------------------------------