Release 2.1.2.
[u/mdw/catacomb] / calc / gfx.cal
CommitLineData
a2a74efe 1/* -*-apcalc-*-
2 *
b817bfc6 3 * $Id: gfx.cal,v 1.3 2004/04/08 01:36:15 mdw Exp $
a2a74efe 4 *
5 * Testbed for %$\gf{2}$% poltnomial arithmetic
6 *
7 * (c) 2000 Straylight/Edgeware
8 */
9
45c0fd36 10/*----- Licensing notice --------------------------------------------------*
a2a74efe 11 *
12 * This file is part of Catacomb.
13 *
14 * Catacomb is free software; you can redistribute it and/or modify
15 * it under the terms of the GNU Library General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
45c0fd36 18 *
a2a74efe 19 * Catacomb 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 Library General Public License for more details.
45c0fd36 23 *
a2a74efe 24 * You should have received a copy of the GNU Library General Public
25 * License along with Catacomb; if not, write to the Free
26 * Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
27 * MA 02111-1307, USA.
28 */
29
a2a74efe 30/*----- Object types ------------------------------------------------------*/
31
32obj gf { x };
33
34/*----- Static variables --------------------------------------------------*/
35
36static obj gf example_gf_object;
37
38/*----- Main code ---------------------------------------------------------*/
39
40dummy = config("lib_debug", -1);
41
42define gf(x)
43{
44 local obj gf g;
45 g.x = x;
46 return (g);
47}
48
49define gfint(x)
50{
51 if (istype(x, example_gf_object))
52 return (x.x);
53 else
54 return (x);
55}
56
57define gf_add(x, y) = gf(xor(gfint(x), gfint(y)));
58define gf_sub(x, y) = gf(xor(gfint(x), gfint(y)));
59define gf_neg(x) = x;
60
61define gf_mul(x, y)
62{
63 local a = gfint(x), b = gfint(y), z = 0, i, bits = highbit(a);
64 for (i = 0; i <= bits; i++) {
65 if (bit(a, i))
66 z = xor(z, b << i);
67 }
68 return gf(z);
69}
70
71define gfx_div(rx, dx)
72{
73 local r = gfint(rx), d = gfint(dx), i;
ceb3f0c0 74 local q = 0, dbits, rbits;
75 dbits = highbit(d);
76 rbits = highbit(r);
a2a74efe 77 for (i = rbits - dbits; i >= 0; i--) {
78 if (bit(r, i + dbits)) {
79 r = xor(r, d << i);
80 q |= (1 << i);
81 }
82 }
83 return list(q, r);
84}
85
86define gf_div(x, y)
87{
ceb3f0c0 88 local l;
89 l = gfx_div(x, y);
a2a74efe 90 return gf(l[[0]]);
91}
92
93define gf_mod(x, y)
94{
ceb3f0c0 95 local l;
96 l = gfx_div(x, y);
a2a74efe 97 return gf(l[[1]]);
98}
99
cf76bcbb 100define gf_gcd(a, b)
ceb3f0c0 101{
cf76bcbb
MW
102 local swap = 0;
103 local g, x = 1, X = 0, y = 0, Y = 1, q, r, t;
104 if (a.x < b.x) {
105 t = a; a = b; b = t;
106 swap = 1;
107 }
108 if (b == gf(0))
109 g = a;
ceb3f0c0 110 else {
111 while (b != gf(0)) {
cf76bcbb 112 q = gf_div(a, b); r = gf_mod(a, b);
ceb3f0c0 113 t = X * q + x; x = X; X = t;
114 t = Y * q + y; y = Y; Y = t;
cf76bcbb 115 a = b; b = r;
ceb3f0c0 116 }
117 g = a;
118 }
cf76bcbb
MW
119 if (swap) {
120 t = x; x = y; y = t;
121 }
122 return list(g, x, y);
123}
124
125define gf_inv(a, b)
126{
127 local l = gf_gcd(b, a);
128 if (l[[0]] != gf(1)) quit "not coprime in gf_inv";
129 return l[[2]];
ceb3f0c0 130}
131
a2a74efe 132/*----- That's all, folks -------------------------------------------------*/