1 /****************************************************************************
2 **
3 ** This file is part of GAP, a system for computational discrete algebra.
4 **
5 ** Copyright of GAP belongs to its developers, whose names are too numerous
6 ** to list here. Please refer to the COPYRIGHT file for details.
7 **
8 ** SPDX-License-Identifier: GPL-2.0-or-later
9 **
10 ** This file contains the C functions for free group elements. There are
11 ** basically three different (internal) types: 8 bits, 16 bits, and 32 bits
12 ** for the generator/exponent pairs. The number of bits used for the
13 ** generator numbers is determined by the number of free group generators in
14 ** the family. Any object of this type looks like:
15 **
16 ** +------+-----+-------+-------+-----+-----------+
17 ** | TYPE | len | g1/e1 | g2/e2 | ... | glen/elen |
18 ** +------+-----+-------+-------+-----+-----------+
19 **
20 ** where <len> is a GAP integer object and <gi>/<ei> occupies 8, 16, or 32
21 ** bits depending on the type. A TYPE of such an objects looks like:
22 **
23 ** +--------+-------+--------+----------+-------+------+------+
24 ** | FAMILY | FLAGS | SHARED | PURETYPE | EBITS | RANK | BITS |
25 ** +--------+-------+--------+----------+-------+------+------+
26 **
27 ** <PURETYPE> is the type of a result, <EBITS> is the number of bits used
28 ** for the exponent, <RANK> is number of free group generators. But instead
29 ** of accessing these entries directly you should use the following macros.
30 **
31 **
32 ** The file "objfgelm.h" defines the following functions and macros:
33 **
34 ** NewWord(( <type>, <npairs> )
35 ** returns a new objects of type <type> with room for <npairs>
36 ** generator/exponent pairs.
37 **
38 **
39 ** BITS_WORD( <word> )
40 ** returns the number of bits as C integers
41 **
42 ** DATA_WORD( <word> )
43 ** returns a pointer to the beginning of the data area
44 **
45 ** EBITS_WORD( <word> )
46 ** returns the ebits as C integer
47 **
48 ** NPAIRS_WORD( <word> )
49 ** returns the number of pairs as C integer
50 **
51 ** RANK_WORD( <word> )
52 ** returns the rank as C integer
53 **
54 ** PURETYPE_WORD( <word> )
55 ** returns the result type
56 **
57 **
58 ** BITS_WORDTYPE( <type> )
59 ** returns the number of bits as C integers
60 **
61 ** EBITS_WORDTYPE( <type> )
62 ** returns the ebits as C integer
63 **
64 ** RANK_WORDTYPE( <type> )
65 ** returns the rank as C integer
66 **
67 ** PURETYPE_WORDTYPE( <type> )
68 ** returns the result type
69 */
70
71 extern "C" {
72
73 #include "objfgelm.h"
74
75 #include "ariths.h"
76 #include "bool.h"
77 #include "error.h"
78 #include "gvars.h"
79 #include "lists.h"
80 #include "modules.h"
81 #include "opers.h"
82 #include "plist.h"
83 #include "stringobj.h"
84
85 #ifdef HPCGAP
86 #include "hpc/guards.h"
87 #endif
88
89 } // extern "C"
90
91
92 // OverflowType<UIntN> is a type which is larger enough to detect
93 // overflow of multiplication of two IntN values. For 8 and 16 bit
94 // inputs, we use `Int`, for 32 bit inputs we use Int8.
95 template <typename T>
96 struct OverflowType {
97 };
98 template <>
99 struct OverflowType<UInt1> {
100 typedef Int type;
101 };
102 template <>
103 struct OverflowType<UInt2> {
104 typedef Int type;
105 };
106 template <>
107 struct OverflowType<UInt4> {
108 typedef Int8 type;
109 };
110
111
NewWord(Obj type,UInt npairs)112 Obj NewWord(Obj type, UInt npairs)
113 {
114 Obj word;
115 #ifdef HPCGAP
116 ReadGuard(type);
117 #endif
118 word =
119 NewBag(T_DATOBJ, 2 * sizeof(Obj) + npairs * BITS_WORDTYPE(type) / 8L);
120 ADDR_OBJ(word)[1] = INTOBJ_INT(npairs);
121 SetTypeDatObj(word, type);
122 #ifdef HPCGAP
123 MakeBagReadOnly(word);
124 #endif
125 return word;
126 }
127
128
129 /****************************************************************************
130 **
131 *F FuncNBits_Equal( <self>, <l>, <r> )
132 */
133 template <typename UIntN>
NBits_Equal(Obj l,Obj r)134 static Obj NBits_Equal(Obj l, Obj r)
135 {
136 Int nl; /* number of pairs to consider in <l> */
137 Int nr; /* number of pairs in <r> */
138 const UIntN * pl; /* data area in <l> */
139 const UIntN * pr; /* data area in <r> */
140
141 /* if <l> or <r> is the identity it is easy */
142 nl = NPAIRS_WORD(l);
143 nr = NPAIRS_WORD(r);
144 if ( nl != nr ) {
145 return False;
146 }
147
148 /* compare the generator/exponent pairs */
149 pl = CONST_DATA_WORD(l);
150 pr = CONST_DATA_WORD(r);
151 for ( ; 0 < nl; nl--, pl++, pr++ ) {
152 if ( *pl != *pr ) {
153 return False;
154 }
155 }
156 return True;
157 }
158
Func8Bits_Equal(Obj self,Obj l,Obj r)159 static Obj Func8Bits_Equal(Obj self, Obj l, Obj r)
160 {
161 return NBits_Equal<UInt1>(l, r);
162 }
163
Func16Bits_Equal(Obj self,Obj l,Obj r)164 static Obj Func16Bits_Equal(Obj self, Obj l, Obj r)
165 {
166 return NBits_Equal<UInt2>(l, r);
167 }
168
Func32Bits_Equal(Obj self,Obj l,Obj r)169 static Obj Func32Bits_Equal(Obj self, Obj l, Obj r)
170 {
171 return NBits_Equal<UInt4>(l, r);
172 }
173
174
175 /****************************************************************************
176 **
177 *F FuncNBits_ExponentSums3( <self>, <obj>, <start>, <end> )
178 */
179 template <typename UIntN>
NBits_ExponentSums3(Obj obj,Obj vstart,Obj vend)180 static Obj NBits_ExponentSums3(Obj obj, Obj vstart, Obj vend)
181 {
182 Int start; /* the lowest generator number */
183 Int end; /* the highest generator number */
184 Obj sums; /* result, the exponent sums */
185 Int ebits; /* number of bits in the exponent */
186 UInt expm; /* signed exponent mask */
187 UInt exps; /* sign exponent mask */
188 Int num; /* number of gen/exp pairs in <data> */
189 Int i; /* loop variable for gen/exp pairs */
190 Int pos; /* current generator number */
191 Int exp; /* current exponent */
192 const UIntN * ptr; /* pointer into the data area of <obj> */
193
194 /* <start> must be positive */
195 start = GetPositiveSmallIntEx("NBits_ExponentSums3", vstart, "<start>");
196
197 /* <end> must be positive */
198 end = GetPositiveSmallIntEx("NBits_ExponentSums3", vend, "<end>");
199
200 /* <end> must be at least <start> */
201 if ( end < start ) {
202 sums = NewEmptyPlist();
203 return sums;
204 }
205
206 /* get the number of bits for exponents */
207 ebits = EBITS_WORD(obj);
208
209 /* get the exponent masks */
210 exps = 1UL << (ebits-1);
211 expm = exps - 1;
212
213 /* get the number of gen/exp pairs */
214 num = NPAIRS_WORD(obj);
215
216 /* create the zero vector */
217 sums = NEW_PLIST( T_PLIST_CYC, end-start+1 );
218 SET_LEN_PLIST( sums, end-start+1 );
219 for ( i = start; i <= end; i++ )
220 SET_ELM_PLIST( sums, i-start+1, 0 );
221
222 /* and unpack <obj> into <sums> */
223 ptr = CONST_DATA_WORD(obj);
224 for ( i = 1; i <= num; i++, ptr++ ) {
225 pos = ((*ptr) >> ebits)+1;
226 if ( start <= pos && pos <= end ) {
227 if ( (*ptr) & exps )
228 exp = ((*ptr)&expm)-exps;
229 else
230 exp = (*ptr)&expm;
231
232 /* this will not cause a garbage collection */
233 exp = exp + (Int) ELM_PLIST( sums, pos-start+1 );
234 SET_ELM_PLIST( sums, pos-start+1, (Obj) exp );
235 assert( ptr == CONST_DATA_WORD(obj) + (i-1) );
236 }
237 }
238
239 /* convert integers into values */
240 for ( i = start; i <= end; i++ ) {
241 exp = (Int) ELM_PLIST( sums, i-start+1 );
242 SET_ELM_PLIST( sums, i-start+1, INTOBJ_INT(exp) );
243 }
244
245 /* return the exponent sums */
246 return sums;
247 }
248
Func8Bits_ExponentSums3(Obj self,Obj obj,Obj vstart,Obj vend)249 static Obj Func8Bits_ExponentSums3(Obj self, Obj obj, Obj vstart, Obj vend)
250 {
251 return NBits_ExponentSums3<UInt1>(obj, vstart, vend);
252 }
253
Func16Bits_ExponentSums3(Obj self,Obj obj,Obj vstart,Obj vend)254 static Obj Func16Bits_ExponentSums3(Obj self, Obj obj, Obj vstart, Obj vend)
255 {
256 return NBits_ExponentSums3<UInt2>(obj, vstart, vend);
257 }
258
Func32Bits_ExponentSums3(Obj self,Obj obj,Obj vstart,Obj vend)259 static Obj Func32Bits_ExponentSums3(Obj self, Obj obj, Obj vstart, Obj vend)
260 {
261 return NBits_ExponentSums3<UInt4>(obj, vstart, vend);
262 }
263
264
265 /****************************************************************************
266 **
267 *F FuncNBits_ExponentSums1( <self>, <obj> )
268 */
Func8Bits_ExponentSums1(Obj self,Obj obj)269 static Obj Func8Bits_ExponentSums1(Obj self, Obj obj)
270 {
271 return NBits_ExponentSums3<UInt1>(obj, INTOBJ_INT(1), INTOBJ_INT(RANK_WORD(obj)));
272 }
273
Func16Bits_ExponentSums1(Obj self,Obj obj)274 static Obj Func16Bits_ExponentSums1(Obj self, Obj obj)
275 {
276 return NBits_ExponentSums3<UInt2>(obj, INTOBJ_INT(1), INTOBJ_INT(RANK_WORD(obj)));
277 }
278
Func32Bits_ExponentSums1(Obj self,Obj obj)279 static Obj Func32Bits_ExponentSums1(Obj self, Obj obj)
280 {
281 return NBits_ExponentSums3<UInt4>(obj, INTOBJ_INT(1), INTOBJ_INT(RANK_WORD(obj)));
282 }
283
284
285 /****************************************************************************
286 **
287 *F FuncNBits_ExponentSyllable( <self>, <w>, <i> )
288 */
289 template <typename UIntN>
NBits_ExponentSyllable(Obj w,Obj pos)290 static Obj NBits_ExponentSyllable(Obj w, Obj pos)
291 {
292 Int ebits; /* number of bits in the exponent */
293 UInt expm; /* signed exponent mask */
294 UInt exps; /* sign exponent mask */
295 Int num; /* number of gen/exp pairs in <data> */
296 Int i; /* integer corresponding to <vi> */
297 UIntN p; /* <i>th syllable */
298
299 /* check <i> */
300 num = NPAIRS_WORD(w);
301 i = GetPositiveSmallInt("NBits_ExponentSyllable", pos);
302 if (num < i)
303 ErrorMayQuit("<pos> must be an integer between 1 and %d", num, 0);
304
305 /* get the number of bits for exponents */
306 ebits = EBITS_WORD(w);
307
308 /* get the exponent masks */
309 exps = 1UL << (ebits-1);
310 expm = exps - 1;
311
312 /* return the <i> th exponent */
313 p = CONST_DATA_WORD(w)[i-1];
314 if ( p & exps )
315 return INTOBJ_INT((p&expm)-exps);
316 else
317 return INTOBJ_INT(p&expm);
318 }
319
Func8Bits_ExponentSyllable(Obj self,Obj w,Obj pos)320 static Obj Func8Bits_ExponentSyllable(Obj self, Obj w, Obj pos)
321 {
322 return NBits_ExponentSyllable<UInt1>(w, pos);
323 }
324
Func16Bits_ExponentSyllable(Obj self,Obj w,Obj pos)325 static Obj Func16Bits_ExponentSyllable(Obj self, Obj w, Obj pos)
326 {
327 return NBits_ExponentSyllable<UInt2>(w, pos);
328 }
329
Func32Bits_ExponentSyllable(Obj self,Obj w,Obj pos)330 static Obj Func32Bits_ExponentSyllable(Obj self, Obj w, Obj pos)
331 {
332 return NBits_ExponentSyllable<UInt4>(w, pos);
333 }
334
335
336 /****************************************************************************
337 **
338 *F FuncNBits_ExtRepOfObj( <self>, <obj> )
339 */
340 template <typename UIntN>
NBits_ExtRepOfObj(Obj obj)341 static Obj NBits_ExtRepOfObj(Obj obj)
342 {
343 Int ebits; /* number of bits in the exponent */
344 UInt expm; /* signed exponent mask */
345 UInt exps; /* sign exponent mask */
346 Int num; /* number of gen/exp pairs in <data> */
347 Int i; /* loop variable for gen/exp pairs */
348 Obj type; /* type of <obj> */
349 const UIntN * ptr; /* pointer into the data area of <obj> */
350 Obj lst; /* result */
351
352 /* get the type of <obj> */
353 type = TYPE_DATOBJ(obj);
354
355 /* get the number of bits for exponents */
356 ebits = EBITS_WORDTYPE(type);
357
358 /* get the exponent masks */
359 exps = 1UL << (ebits-1);
360 expm = exps - 1;
361
362 /* get the number of gen/exp pairs */
363 num = NPAIRS_WORD(obj);
364
365 /* construct a list with 2*<num> entries */
366 lst = NEW_PLIST( T_PLIST, 2*num );
367 SET_LEN_PLIST( lst, 2*num );
368
369 /* and unpack <obj> into <lst> */
370 ptr = CONST_DATA_WORD(obj);
371
372 /* this will not cause a garbage collection */
373 for ( i = 1; i <= num; i++, ptr++ ) {
374 SET_ELM_PLIST( lst, 2*i-1, INTOBJ_INT(((*ptr) >> ebits)+1) );
375 if ( (*ptr) & exps )
376 SET_ELM_PLIST( lst, 2*i, INTOBJ_INT(((*ptr)&expm)-exps) );
377 else
378 SET_ELM_PLIST( lst, 2*i, INTOBJ_INT((*ptr)&expm) );
379 assert( ptr == CONST_DATA_WORD(obj) + (i-1) );
380 }
381 CHANGED_BAG(lst);
382
383 /* return the gen/exp list */
384 return lst;
385 }
386
Func8Bits_ExtRepOfObj(Obj self,Obj obj)387 static Obj Func8Bits_ExtRepOfObj(Obj self, Obj obj)
388 {
389 return NBits_ExtRepOfObj<UInt1>(obj);
390 }
391
Func16Bits_ExtRepOfObj(Obj self,Obj obj)392 static Obj Func16Bits_ExtRepOfObj(Obj self, Obj obj)
393 {
394 return NBits_ExtRepOfObj<UInt2>(obj);
395 }
396
Func32Bits_ExtRepOfObj(Obj self,Obj obj)397 static Obj Func32Bits_ExtRepOfObj(Obj self, Obj obj)
398 {
399 return NBits_ExtRepOfObj<UInt4>(obj);
400 }
401
402
403 /****************************************************************************
404 **
405 *F FuncNBits_GeneratorSyllable( <self>, <w>, <i> )
406 */
407 template <typename UIntN>
NBits_GeneratorSyllable(Obj w,Obj pos)408 static Obj NBits_GeneratorSyllable(Obj w, Obj pos)
409 {
410 Int ebits; /* number of bits in the exponent */
411 Int num; /* number of gen/exp pairs in <data> */
412 Int i; /* integer corresponding to <vi> */
413 UIntN p; /* <i>th syllable */
414
415 /* check <i> */
416 num = NPAIRS_WORD(w);
417 i = GetPositiveSmallInt("NBits_GeneratorSyllable", pos);
418 if (num < i)
419 ErrorMayQuit("<pos> must be an integer between 1 and %d", num, 0);
420
421 /* get the number of bits for exponents */
422 ebits = EBITS_WORD(w);
423
424 /* return the <i> th generator */
425 p = CONST_DATA_WORD(w)[i-1];
426 return INTOBJ_INT((p >> ebits)+1);
427 }
428
Func8Bits_GeneratorSyllable(Obj self,Obj w,Obj pos)429 static Obj Func8Bits_GeneratorSyllable(Obj self, Obj w, Obj pos)
430 {
431 return NBits_GeneratorSyllable<UInt1>(w, pos);
432 }
433
Func16Bits_GeneratorSyllable(Obj self,Obj w,Obj pos)434 static Obj Func16Bits_GeneratorSyllable(Obj self, Obj w, Obj pos)
435 {
436 return NBits_GeneratorSyllable<UInt2>(w, pos);
437 }
438
Func32Bits_GeneratorSyllable(Obj self,Obj w,Obj pos)439 static Obj Func32Bits_GeneratorSyllable(Obj self, Obj w, Obj pos)
440 {
441 return NBits_GeneratorSyllable<UInt4>(w, pos);
442 }
443
444
445 /****************************************************************************
446 **
447 *F FuncNBits_HeadByNumber( <self>, <l>, <gen> )
448 */
449 template <typename UIntN>
NBits_HeadByNumber(Obj l,Obj r)450 static Obj NBits_HeadByNumber(Obj l, Obj r)
451 {
452 Int ebits; /* number of bits in the exponent */
453 UInt genm; /* generator mask */
454 Int sl; /* start position in <obj> */
455 Int nl; /* number of pairs to consider in <l> */
456 Int gr; /* value of <r> */
457 const UIntN * pl; /* data area in <l> */
458 Obj obj; /* the result */
459 UIntN * po; /* data area in <obj> */
460
461 /* get the generator number to stop */
462 gr = INT_INTOBJ(r) - 1;
463
464 /* get the number of bits for exponents */
465 ebits = EBITS_WORD(l);
466
467 /* get the generator mask */
468 genm = ((1UL << (8*sizeof(UIntN)-ebits)) - 1) << ebits;
469
470 /* if <l> is the identity return */
471 nl = NPAIRS_WORD(l);
472 if ( 0 == nl ) return l;
473
474 /* look closely at the generators */
475 sl = 0;
476 pl = CONST_DATA_WORD(l);
477 while ( sl < nl && ((*pl & genm) >> ebits) < gr ) {
478 sl++; pl++;
479 }
480 if ( sl == nl )
481 return l;
482
483 /* create a new word */
484 obj = NewWord(PURETYPE_WORD(l), sl);
485
486 /* copy the <l> part into the word */
487 po = DATA_WORD(obj);
488 pl = CONST_DATA_WORD(l);
489 while ( 0 < sl-- )
490 *po++ = *pl++;
491
492 return obj;
493 }
494
Func8Bits_HeadByNumber(Obj self,Obj l,Obj r)495 static Obj Func8Bits_HeadByNumber(Obj self, Obj l, Obj r)
496 {
497 return NBits_HeadByNumber<UInt1>(l, r);
498 }
499
Func16Bits_HeadByNumber(Obj self,Obj l,Obj r)500 static Obj Func16Bits_HeadByNumber(Obj self, Obj l, Obj r)
501 {
502 return NBits_HeadByNumber<UInt2>(l, r);
503 }
504
Func32Bits_HeadByNumber(Obj self,Obj l,Obj r)505 static Obj Func32Bits_HeadByNumber(Obj self, Obj l, Obj r)
506 {
507 return NBits_HeadByNumber<UInt4>(l, r);
508 }
509
510
511 /****************************************************************************
512 **
513 *F FuncNBits_Less( <self>, <l>, <r> )
514 **
515 ** This function implements a length-plus-lexicographic ordering on
516 ** associative words. This ordering is translation invariant, therefore,
517 ** we can skip common prefixes. This is done in the first loop of the
518 ** function. When a difference in the two words is encountered, it is
519 ** decided which is the lexicographically smaller. There are several case
520 ** that can occur:
521 **
522 ** The syllables where the difference occurs have different generators. In
523 ** this case it is sufficient to compare the two generators.
524 ** Example: x^3 < y^3.
525 **
526 ** The syllables have the same generator but one exponent is the negative of
527 ** the other. In this case the word with the negative exponent is smaller.
528 ** Example: x^-1 < x.
529 **
530 ** Now it suffices to compare the unsigned exponents. For the syllable
531 ** with the smaller exponent we have to take the next generator in that
532 ** word into account. This means that we are discarding the smaller
533 ** syllable as a common prefix. Note that if this happens at the end of
534 ** one of the two words, then this word (ignoring the common prefix) is the
535 ** empty word and we can immediately decide which word is the smaller.
536 ** Examples: y^3 x < y^2 z, y^3 x > y^2 x z, x^2 < x y^-1, x^2 < x^3.
537 **
538 */
539 template <typename UIntN>
NBits_Less(Obj l,Obj r)540 static Obj NBits_Less(Obj l, Obj r)
541 {
542 Int ebits; /* number of bits in the exponent */
543 UInt expm; /* signed exponent mask */
544 UInt exps; /* sign exponent mask */
545 UInt genm; /* generator mask */
546 Int exl; /* left exponent */
547 Int exr; /* right exponent */
548 Int nl; /* number of pairs to consider in <l> */
549 Int nr; /* number of pairs in <r> */
550 const UIntN * pl; /* data area in <l> */
551 const UIntN * pr; /* data area in <r> */
552 Obj lexico; /* lexicographic order of <l> and <r> */
553 Obj ll; /* length of <l> */
554 Obj lr; /* length of <r> */
555
556 /* if <l> or <r> is the identity it is easy */
557 nl = NPAIRS_WORD(l);
558 nr = NPAIRS_WORD(r);
559 if ( nl == 0 || nr == 0 ) {
560 return ( nr != 0 ) ? True : False;
561 }
562
563 /* get the number of bits for exponents */
564 ebits = EBITS_WORD(l);
565
566 /* get the exponent masks */
567 exps = 1UL << (ebits-1);
568 expm = exps - 1;
569
570 /* Skip the common prefix and determine if the first word is smaller */
571 /* with respect to the lexicographic ordering. */
572 pl = CONST_DATA_WORD(l);
573 pr = CONST_DATA_WORD(r);
574 for ( lexico = False; 0 < nl && 0 < nr; nl--, nr--, pl++, pr++ )
575 if ( *pl != *pr ) {
576 /* got a difference */
577
578 /* get the generator mask */
579 genm = ((1UL << (8*sizeof(UIntN)-ebits)) - 1) << ebits;
580
581 /* compare the generators */
582 if ( (*pl & genm) != (*pr & genm) ) {
583 lexico = ( (*pl & genm) < (*pr & genm) ) ? True : False;
584 break;
585 }
586
587 /* get the unsigned exponents */
588 exl = (*pl & exps) ? (exps - (*pl & expm)) : (*pl & expm);
589 exr = (*pr & exps) ? (exps - (*pr & expm)) : (*pr & expm);
590
591 /* compare the sign of the exponents */
592 if( exl == exr && (*pl & exps) != (*pr & exps) ) {
593 lexico = (*pl & exps) ? True : False;
594 break;
595 }
596
597 /* compare the exponents, and check the next generator. This */
598 /* amounts to stripping off the common prefix x^|expl-expr|. */
599 if( exl > exr ) {
600 if( nr > 1 ) {
601 lexico = (*pl & genm) < (*(pr+1) & genm) ? True : False;
602 break;
603 }
604 else
605 /* <r> is now essentially the empty word. */
606 return False;
607 }
608 if( nl > 1 ) { /* exl < exr */
609 lexico = (*(pl+1) & genm) < (*pr & genm) ? True : False;
610 break;
611 }
612 /* <l> is now essentially the empty word. */
613 return True;
614 }
615
616 /* compute the lengths of the rest */
617 for ( ll = INTOBJ_INT(0); 0 < nl; nl--, pl++ ) {
618 exl = (*pl & exps) ? (exps - (*pl & expm)) : (*pl & expm);
619 C_SUM_FIA(ll,ll,INTOBJ_INT(exl));
620 }
621 for ( lr = INTOBJ_INT(0); 0 < nr; nr--, pr++ ) {
622 exr = (*pr & exps) ? (exps - (*pr & expm)) : (*pr & expm);
623 C_SUM_FIA(lr,lr,INTOBJ_INT(exr));
624 }
625
626 if( EQ( ll, lr ) ) return lexico;
627
628 return LT( ll, lr ) ? True : False;
629 }
630
Func8Bits_Less(Obj self,Obj l,Obj r)631 static Obj Func8Bits_Less(Obj self, Obj l, Obj r)
632 {
633 return NBits_Less<UInt1>(l, r);
634 }
635
Func16Bits_Less(Obj self,Obj l,Obj r)636 static Obj Func16Bits_Less(Obj self, Obj l, Obj r)
637 {
638 return NBits_Less<UInt2>(l, r);
639 }
640
Func32Bits_Less(Obj self,Obj l,Obj r)641 static Obj Func32Bits_Less(Obj self, Obj l, Obj r)
642 {
643 return NBits_Less<UInt4>(l, r);
644 }
645
646
647 /****************************************************************************
648 **
649 *F FuncNBits_AssocWord( <self>, <type>, <data> )
650 */
651 template <typename UIntN>
NBits_AssocWord(Obj type,Obj data)652 static Obj NBits_AssocWord(Obj type, Obj data)
653 {
654 Int ebits; /* number of bits in the exponent */
655 UInt expm; /* unsigned exponent mask */
656 Int num; /* number of gen/exp pairs in <data> */
657 Int i; /* loop variable for gen/exp pairs */
658 Obj vexp; /* value of current exponent */
659 Int nexp; /* current exponent */
660 Obj vgen; /* value of current generator */
661 Int ngen; /* current generator */
662 Obj obj; /* result */
663 UIntN * ptr; /* pointer into the data area of <obj> */
664
665 /* get the number of bits for exponents */
666 ebits = EBITS_WORDTYPE(type);
667
668 /* get the exponent mask */
669 expm = (1UL << ebits) - 1;
670
671 /* construct a new object */
672 num = LEN_LIST(data)/2;
673 obj = NewWord(type, num);
674
675 ptr = DATA_WORD(obj);
676 for ( i = 1; i <= num; i++, ptr++ ) {
677
678 /* this will not cause a garbage collection */
679 vgen = ELMW_LIST( data, 2*i-1 );
680 ngen = INT_INTOBJ(vgen);
681 vexp = ELMW_LIST( data, 2*i );
682 if (!IS_INTOBJ(vexp) || vexp == INTOBJ_INT(0))
683 RequireArgument("NBits_AssocWord", vexp,
684 "must be a non-zero small integer");
685 nexp = INT_INTOBJ(vexp) & expm;
686 *ptr = ((ngen-1) << ebits) | nexp;
687 assert( ptr == DATA_WORD(obj) + (i-1) );
688 }
689 CHANGED_BAG(obj);
690
691 return obj;
692 }
693
Func8Bits_AssocWord(Obj self,Obj type,Obj data)694 static Obj Func8Bits_AssocWord(Obj self, Obj type, Obj data)
695 {
696 return NBits_AssocWord<UInt1>(type, data);
697 }
698
Func16Bits_AssocWord(Obj self,Obj type,Obj data)699 static Obj Func16Bits_AssocWord(Obj self, Obj type, Obj data)
700 {
701 return NBits_AssocWord<UInt2>(type, data);
702 }
703
Func32Bits_AssocWord(Obj self,Obj type,Obj data)704 static Obj Func32Bits_AssocWord(Obj self, Obj type, Obj data)
705 {
706 return NBits_AssocWord<UInt4>(type, data);
707 }
708
709
710 /****************************************************************************
711 **
712 *F FuncNBits_ObjByVector( <self>, <type>, <data> )
713 */
714 template <typename UIntN>
NBits_ObjByVector(Obj type,Obj data)715 static Obj NBits_ObjByVector(Obj type, Obj data)
716 {
717 Int ebits; /* number of bits in the exponent */
718 UInt expm; /* unsigned exponent mask */
719 Int num; /* number of gen/exp pairs in <data> */
720 Int i; /* loop variable for gen/exp pairs */
721 Int j; /* loop variable for exponent vector */
722 Int nexp; /* current exponent */
723 Obj vexp; /* value of current exponent */
724 Obj obj; /* result */
725 UIntN * ptr; /* pointer into the data area of <obj> */
726
727 /* get the number of bits for exponents */
728 ebits = EBITS_WORDTYPE(type);
729
730 /* get the exponent mask */
731 expm = (1UL << ebits) - 1;
732
733 /* count the number of non-zero entries */
734 for ( i = LEN_LIST(data), num = 0, j = 1; 0 < i; i-- ) {
735 vexp = ELMW_LIST(data,i);
736 RequireSmallInt("NBits_ObjByVector", vexp, "<vexp>");
737 if ( vexp != INTOBJ_INT(0) ) {
738 j = i;
739 num++;
740 }
741 }
742
743 /* construct a new object */
744 obj = NewWord(type, num);
745
746 ptr = DATA_WORD(obj);
747 for ( i = 1; i <= num; i++, ptr++, j++ ) {
748
749 /* this will not cause a garbage collection */
750 while ( ELMW_LIST(data,j) == INTOBJ_INT(0) )
751 j++;
752 vexp = ELMW_LIST( data, j );
753 nexp = INT_INTOBJ(vexp) & expm;
754 *ptr = ((j-1) << ebits) | nexp;
755 assert( ptr == DATA_WORD(obj) + (i-1) );
756 }
757 CHANGED_BAG(obj);
758
759 return obj;
760 }
761
Func8Bits_ObjByVector(Obj self,Obj type,Obj data)762 static Obj Func8Bits_ObjByVector(Obj self, Obj type, Obj data)
763 {
764 return NBits_ObjByVector<UInt1>(type, data);
765 }
766
Func16Bits_ObjByVector(Obj self,Obj type,Obj data)767 static Obj Func16Bits_ObjByVector(Obj self, Obj type, Obj data)
768 {
769 return NBits_ObjByVector<UInt2>(type, data);
770 }
771
Func32Bits_ObjByVector(Obj self,Obj type,Obj data)772 static Obj Func32Bits_ObjByVector(Obj self, Obj type, Obj data)
773 {
774 return NBits_ObjByVector<UInt4>(type, data);
775 }
776
777
778 /****************************************************************************
779 **
780 *F FuncNBits_Power( <self>, <l>, <r> )
781 */
782 template <typename UIntN>
NBits_Power(Obj l,Obj r)783 static Obj NBits_Power(Obj l, Obj r)
784 {
785 typedef typename OverflowType<UIntN>::type OInt;
786
787 Int ebits; /* number of bits in the exponent */
788 UInt expm; /* signed exponent mask */
789 UInt exps; /* sign exponent mask */
790 UInt genm; /* generator mask */
791 Int invm; /* mask used to invert exponent */
792 Obj obj; /* the result */
793 Int nl; /* number of pairs to consider in <l> */
794 Int sr; /* start position in <r> */
795 Int sl; /* start position in <obj> */
796 const UIntN * pl; /* data area in <l> */
797 UIntN * pr; /* data area in <obj> */
798 const UIntN * pe; /* end marker */
799 OInt ex = 0; /* meeting exponent */
800 Int pow; /* power to take */
801 Int apw; /* absolute value of <pow> */
802
803 /* get the number of bits for exponents */
804 ebits = EBITS_WORD(l);
805
806 /* get the exponent masks */
807 exps = 1UL << (ebits-1);
808 expm = exps - 1;
809 invm = (1UL<<ebits)-1;
810
811 /* get the generator mask */
812 genm = ((1UL << (8*sizeof(UIntN)-ebits)) - 1) << ebits;
813
814 /* if <l> is the identity return <l> */
815 nl = NPAIRS_WORD(l);
816 if ( 0 == nl )
817 return l;
818
819 /* if <pow> is zero return the identity */
820 pow = INT_INTOBJ(r);
821 if ( pow == 0 ) {
822 obj = NewWord(PURETYPE_WORD(l), 0);
823 return obj;
824 }
825
826 /* if <pow> is one return <l> */
827 if ( pow == 1 )
828 return l;
829
830 /* if <pow> is minus one invert <l> */
831 if ( pow == -1 ) {
832 obj = NewWord(PURETYPE_WORD(l), nl);
833 pl = CONST_DATA_WORD(l);
834 pr = DATA_WORD(obj) + (nl-1);
835 sl = nl;
836
837 /* exponents are symmetric, so we cannot get an overflow */
838 while ( 0 < sl-- ) {
839 *pr-- = ( *pl++ ^ invm ) + 1;
840 }
841 return obj;
842 }
843
844 /* split word into w * h * w^-1 */
845 pl = CONST_DATA_WORD(l);
846 pe = pl + (nl-1);
847 sl = 0;
848 sr = nl-1;
849 while ( (*pl & genm) == (*pe & genm) ) {
850 if ( (*pl&exps) == (*pe&exps) )
851 break;
852 if ( (*pl&expm) + (*pe&expm) != exps )
853 break;
854 pl++; sl++;
855 pe--; sr--;
856 }
857
858 /* special case: w * gi^n * w^-1 */
859 if ( sl == sr ) {
860 ex = (*pl&expm);
861 if ( *pl & exps ) ex -= exps;
862 ex = ex * pow;
863
864 /* check that n*pow fits into the exponent */
865 if ( ( 0 < ex && expm < ex ) || ( ex < 0 && expm < -ex ) ) {
866 return TRY_NEXT_METHOD;
867 }
868
869 /* copy <l> into <obj> */
870 obj = NewWord(PURETYPE_WORD(l), nl);
871 pl = CONST_DATA_WORD(l);
872 pr = DATA_WORD(obj);
873 sl = nl;
874 while ( 0 < sl-- ) {
875 *pr++ = *pl++;
876 }
877
878 /* and fix the exponent at position <sr> */
879 pr = DATA_WORD(obj);
880 pr[sr] = (pr[sr] & genm) | (ex & ((1UL<<ebits)-1));
881 return obj;
882 }
883
884 /* special case: w * gj^x * t * gj^y * w^-1, x != -y */
885 if ( (*pl & genm) == (*pe & genm) ) {
886 ex = (*pl&expm) + (*pe&expm);
887 if ( *pl & exps ) ex -= exps;
888 if ( *pe & exps ) ex -= exps;
889
890 /* check that <ex> fits into the exponent */
891 if ( ( 0 < ex && expm < ex ) || ( ex < 0 && expm < -ex ) ) {
892 return TRY_NEXT_METHOD;
893 }
894 if ( 0 < pow )
895 ex = ex & ((1UL<<ebits)-1);
896 else
897 ex = (-ex) & ((1UL<<ebits)-1);
898
899 /* create a new word */
900 apw = ( pow < 0 ) ? -pow : pow;
901 obj = NewWord(PURETYPE_WORD(l),
902 2 * (sl + 1) + apw * (sr - sl - 1) + (apw - 1));
903
904 /* copy the beginning w * gj^x into <obj> */
905 pl = CONST_DATA_WORD(l);
906 pr = DATA_WORD(obj);
907 pe = pl+sl;
908 while ( pl <= pe ) {
909 *pr++ = *pl++;
910 }
911
912 /* copy t * gj^<ex> <pow> times into <obj> */
913 if ( 0 < pow ) {
914 for ( ; 0 < apw; apw-- ) {
915 pl = CONST_DATA_WORD(l) + (sl+1);
916 pe = pl + (sr-sl-1);
917 while ( pl <= pe ) {
918 *pr++ = *pl++;
919 }
920 pr[-1] = (pr[-1] & genm) | ex;
921 }
922
923 /* copy tail gj^y * w^-1 into <obj> */
924 pr[-1] = pl[-1];
925 pe = CONST_DATA_WORD(l) + nl;
926 while ( pl < pe ) {
927 *pr++ = *pl++;
928 }
929 }
930
931 /* copy and invert t * gj^<ex> <pow> times into <obj> */
932 else {
933 pr[-1] = ( pl[sr-sl-1] ^ invm ) + 1;
934 for ( ; 0 < apw; apw-- ) {
935 pl = CONST_DATA_WORD(l) + (sr-1);
936 pe = pl + (sl-sr+1);
937 while ( pe <= pl ) {
938 *pr++ = ( *pl-- ^ invm ) + 1;
939 }
940 pr[-1] = (pr[-1] & genm) | ex;
941 }
942
943 /* copy tail gj^x * w^-1 into <obj> */
944 pr[-1] = ( pl[1] ^ invm ) + 1;
945 pl = CONST_DATA_WORD(l) + (sr+1);
946 pe = CONST_DATA_WORD(l) + nl;
947 while ( pl < pe ) {
948 *pr ++ = *pl++;
949 }
950 }
951 return obj;
952 }
953
954 /* general case: w * t * w^-1 */
955 else {
956
957 /* create a new word */
958 apw = ( pow < 0 ) ? -pow : pow;
959 obj = NewWord(PURETYPE_WORD(l), 2 * sl + apw * (sr - sl + 1));
960
961 /* copy the beginning w * gj^x into <obj> */
962 pl = CONST_DATA_WORD(l);
963 pr = DATA_WORD(obj);
964 pe = pl+sl;
965 while ( pl < pe ) {
966 *pr++ = *pl++;
967 }
968
969 /* copy t <pow> times into <obj> */
970 if ( 0 < pow ) {
971 for ( ; 0 < apw; apw-- ) {
972 pl = CONST_DATA_WORD(l) + sl;
973 pe = pl + (sr-sl);
974 while ( pl <= pe ) {
975 *pr++ = *pl++;
976 }
977 }
978
979 /* copy tail w^-1 into <obj> */
980 pe = CONST_DATA_WORD(l) + nl;
981 while ( pl < pe ) {
982 *pr++ = *pl++;
983 }
984 }
985
986 /* copy and invert t <pow> times into <obj> */
987 else {
988 for ( ; 0 < apw; apw-- ) {
989 pl = CONST_DATA_WORD(l) + sr;
990 pe = pl + (sl-sr);
991 while ( pe <= pl ) {
992 *pr++ = ( *pl-- ^ invm ) + 1;
993 }
994 }
995
996 /* copy tail w^-1 into <obj> */
997 pl = CONST_DATA_WORD(l) + (sr+1);
998 pe = CONST_DATA_WORD(l) + nl;
999 while ( pl < pe ) {
1000 *pr ++ = *pl++;
1001 }
1002 }
1003 return obj;
1004 }
1005 }
1006
Func8Bits_Power(Obj self,Obj l,Obj r)1007 static Obj Func8Bits_Power(Obj self, Obj l, Obj r)
1008 {
1009 return NBits_Power<UInt1>(l, r);
1010 }
1011
Func16Bits_Power(Obj self,Obj l,Obj r)1012 static Obj Func16Bits_Power(Obj self, Obj l, Obj r)
1013 {
1014 return NBits_Power<UInt2>(l, r);
1015 }
1016
Func32Bits_Power(Obj self,Obj l,Obj r)1017 static Obj Func32Bits_Power(Obj self, Obj l, Obj r)
1018 {
1019 return NBits_Power<UInt4>(l, r);
1020 }
1021
1022
1023 /****************************************************************************
1024 **
1025 *F FuncNBits_Product( <self>, <l>, <r> )
1026 */
1027 template <typename UIntN>
NBits_Product(Obj l,Obj r)1028 static Obj NBits_Product(Obj l, Obj r)
1029 {
1030 Int ebits; /* number of bits in the exponent */
1031 UInt expm; /* signed exponent mask */
1032 UInt exps; /* sign exponent mask */
1033 UInt genm; /* generator mask */
1034 Int nl; /* number of pairs to consider in <l> */
1035 Int nr; /* number of pairs in <r> */
1036 Int sr; /* start position in <r> */
1037 const UIntN * pl; /* data area in <l> */
1038 const UIntN * pr; /* data area in <r> */
1039 Obj obj; /* the result */
1040 UIntN * po; /* data area in <obj> */
1041 Int ex = 0; /* meeting exponent */
1042 Int over; /* overlap */
1043
1044 /* get the number of bits for exponents */
1045 ebits = EBITS_WORD(l);
1046
1047 /* get the exponent masks */
1048 exps = 1UL << (ebits-1);
1049 expm = exps - 1;
1050
1051 /* get the generator mask */
1052 genm = ((1UL << (8*sizeof(UIntN)-ebits)) - 1) << ebits;
1053
1054 /* if <l> or <r> is the identity return the other */
1055 nl = NPAIRS_WORD(l);
1056 if ( 0 == nl ) return r;
1057 nr = NPAIRS_WORD(r);
1058 if ( 0 == nr ) return l;
1059
1060 /* look closely at the meeting point */
1061 sr = 0;
1062 pl = CONST_DATA_WORD(l)+(nl-1);
1063 pr = CONST_DATA_WORD(r);
1064 while ( 0 < nl && sr < nr && (*pl & genm) == (*pr & genm) ) {
1065 if ( (*pl&exps) == (*pr&exps) )
1066 break;
1067 if ( (*pl&expm) + (*pr&expm) != exps )
1068 break;
1069 pr++; sr++;
1070 pl--; nl--;
1071 }
1072
1073 /* create a new word */
1074 over = ( 0 < nl && sr < nr && (*pl & genm) == (*pr & genm) ) ? 1 : 0;
1075 if ( over ) {
1076 ex = ( *pl & expm ) + ( *pr & expm );
1077 if ( *pl & exps ) ex -= exps;
1078 if ( *pr & exps ) ex -= exps;
1079 if ( ( 0 < ex && expm < ex ) || ( ex < 0 && expm < -ex ) ) {
1080 return TRY_NEXT_METHOD;
1081 }
1082 }
1083 obj = NewWord(PURETYPE_WORD(l), nl + (nr - sr) - over);
1084
1085 /* copy the <l> part into the word */
1086 po = DATA_WORD(obj);
1087 pl = CONST_DATA_WORD(l);
1088 while ( 0 < nl-- )
1089 *po++ = *pl++;
1090
1091 /* handle the overlap */
1092 if ( over ) {
1093 po[-1] = (po[-1] & genm) | (ex & ((1UL<<ebits)-1));
1094 sr++;
1095 }
1096
1097 /* copy the <r> part into the word */
1098 pr = CONST_DATA_WORD(r) + sr;
1099 while ( sr++ < nr )
1100 *po++ = *pr++;
1101 return obj;
1102 }
1103
Func8Bits_Product(Obj self,Obj l,Obj r)1104 static Obj Func8Bits_Product(Obj self, Obj l, Obj r)
1105 {
1106 return NBits_Product<UInt1>(l, r);
1107 }
1108
Func16Bits_Product(Obj self,Obj l,Obj r)1109 static Obj Func16Bits_Product(Obj self, Obj l, Obj r)
1110 {
1111 return NBits_Product<UInt2>(l, r);
1112 }
1113
Func32Bits_Product(Obj self,Obj l,Obj r)1114 static Obj Func32Bits_Product(Obj self, Obj l, Obj r)
1115 {
1116 return NBits_Product<UInt4>(l, r);
1117 }
1118
1119
1120 /****************************************************************************
1121 **
1122 *F FuncNBits_Quotient( <self>, <l>, <r> )
1123 */
1124 template <typename UIntN>
NBits_Quotient(Obj l,Obj r)1125 static Obj NBits_Quotient(Obj l, Obj r)
1126 {
1127 Int ebits; /* number of bits in the exponent */
1128 UInt expm; /* signed exponent mask */
1129 UInt sepm; /* unsigned exponent mask */
1130 UInt exps; /* sign exponent mask */
1131 UInt genm; /* generator mask */
1132 Int nl; /* number of pairs to consider in <l> */
1133 Int nr; /* number of pairs in <r> */
1134 const UIntN * pl; /* data area in <l> */
1135 const UIntN * pr; /* data area in <r> */
1136 Obj obj; /* the result */
1137 UIntN * po; /* data area in <obj> */
1138 Int ex = 0; /* meeting exponent */
1139 Int over; /* overlap */
1140
1141 /* get the number of bits for exponents */
1142 ebits = EBITS_WORD(l);
1143
1144 /* get the exponent masks */
1145 exps = 1UL << (ebits-1);
1146 expm = exps - 1;
1147 sepm = (1UL << ebits) - 1;
1148
1149 /* get the generator mask */
1150 genm = ((1UL << (8*sizeof(UIntN)-ebits)) - 1) << ebits;
1151
1152 /* if <r> is the identity return <l> */
1153 nl = NPAIRS_WORD(l);
1154 nr = NPAIRS_WORD(r);
1155 if ( 0 == nr ) return l;
1156
1157 /* look closely at the meeting point */
1158 pl = CONST_DATA_WORD(l)+(nl-1);
1159 pr = CONST_DATA_WORD(r)+(nr-1);
1160 while ( 0 < nl && 0 < nr && (*pl & genm) == (*pr & genm) ) {
1161 if ( (*pl&exps) != (*pr&exps) )
1162 break;
1163 if ( (*pl&expm) != (*pr&expm) )
1164 break;
1165 pr--; nr--;
1166 pl--; nl--;
1167 }
1168
1169 /* create a new word */
1170 over = ( 0 < nl && 0 < nr && (*pl & genm) == (*pr & genm) ) ? 1 : 0;
1171 if ( over ) {
1172 ex = ( *pl & expm ) - ( *pr & expm );
1173 if ( *pl & exps ) ex -= exps;
1174 if ( *pr & exps ) ex += exps;
1175 if ( ( 0 < ex && expm < ex ) || ( ex < 0 && expm < -ex ) ) {
1176 return TRY_NEXT_METHOD;
1177 }
1178 }
1179 obj = NewWord(PURETYPE_WORD(l), nl + nr - over);
1180
1181 /* copy the <l> part into the word */
1182 po = DATA_WORD(obj);
1183 pl = CONST_DATA_WORD(l);
1184 while ( 0 < nl-- )
1185 *po++ = *pl++;
1186
1187 /* handle the overlap */
1188 if ( over ) {
1189 po[-1] = (po[-1] & genm) | (ex & sepm);
1190 nr--;
1191 }
1192
1193 /* copy the <r> part into the word */
1194 pr = CONST_DATA_WORD(r) + (nr-1);
1195 while ( 0 < nr-- ) {
1196 *po++ = (*pr&genm) | (exps-(*pr&expm)) | (~*pr & exps);
1197 pr--;
1198 }
1199 return obj;
1200 }
1201
Func8Bits_Quotient(Obj self,Obj l,Obj r)1202 static Obj Func8Bits_Quotient(Obj self, Obj l, Obj r)
1203 {
1204 return NBits_Quotient<UInt1>(l, r);
1205 }
1206
Func16Bits_Quotient(Obj self,Obj l,Obj r)1207 static Obj Func16Bits_Quotient(Obj self, Obj l, Obj r)
1208 {
1209 return NBits_Quotient<UInt2>(l, r);
1210 }
1211
Func32Bits_Quotient(Obj self,Obj l,Obj r)1212 static Obj Func32Bits_Quotient(Obj self, Obj l, Obj r)
1213 {
1214 return NBits_Quotient<UInt4>(l, r);
1215 }
1216
1217
1218 /****************************************************************************
1219 **
1220 *F FuncNBits_LengthWord( <self>, <w> )
1221 */
1222 template <typename UIntN>
NBits_LengthWord(Obj w)1223 static Obj NBits_LengthWord(Obj w)
1224 {
1225 UInt npairs,i,ebits,exps,expm;
1226 Obj len, uexp;
1227 const UIntN *data;
1228 UIntN pair;
1229
1230 npairs = NPAIRS_WORD(w);
1231 ebits = EBITS_WORD(w);
1232 data = CONST_DATA_WORD(w);
1233
1234 /* get the exponent masks */
1235 exps = 1UL << (ebits-1);
1236 expm = exps - 1;
1237
1238 len = INTOBJ_INT(0);
1239 for (i = 0; i < npairs; i++)
1240 {
1241 pair = data[i];
1242 if (pair & exps)
1243 uexp = INTOBJ_INT(exps - (pair & expm));
1244 else
1245 uexp = INTOBJ_INT(pair & expm);
1246 C_SUM_FIA(len,len,uexp);
1247 }
1248 return len;
1249 }
1250
Func8Bits_LengthWord(Obj self,Obj w)1251 static Obj Func8Bits_LengthWord(Obj self, Obj w)
1252 {
1253 return NBits_LengthWord<UInt1>(w);
1254 }
1255
Func16Bits_LengthWord(Obj self,Obj w)1256 static Obj Func16Bits_LengthWord(Obj self, Obj w)
1257 {
1258 return NBits_LengthWord<UInt2>(w);
1259 }
1260
Func32Bits_LengthWord(Obj self,Obj w)1261 static Obj Func32Bits_LengthWord(Obj self, Obj w)
1262 {
1263 return NBits_LengthWord<UInt4>(w);
1264 }
1265
1266
1267 /****************************************************************************
1268 **
1269 *F * * * * * * * * * * * * * * * all bits words * * * * * * * * * * * * * * *
1270 */
1271
1272 /****************************************************************************
1273 **
1274 *F FuncNBits_NumberSyllables( <self>, <w> )
1275 */
FuncNBits_NumberSyllables(Obj self,Obj w)1276 static Obj FuncNBits_NumberSyllables(Obj self, Obj w)
1277 {
1278 /* return the number of syllables */
1279 return INTOBJ_INT( NPAIRS_WORD(w) );
1280 }
1281
1282
1283 /**************************************************************************
1284 * letter rep arithmetic */
1285 /**************************************************************************
1286 *F FuncMULT_WOR_LETTREP( <self>, <a>,<b> ) */
FuncMULT_WOR_LETTREP(Obj self,Obj a,Obj b)1287 static Obj FuncMULT_WOR_LETTREP(Obj self, Obj a, Obj b)
1288 {
1289 UInt l,m,i,j,newlen,as,bs,ae,be;
1290 Obj n;
1291 const Obj *p;
1292 Obj *q;
1293
1294 /* short check */
1295 RequirePlainList("MULT_WOR_LETTREP", a);
1296 RequirePlainList("MULT_WOR_LETTREP", b);
1297
1298 /* Find overlap */
1299 /* l:=Length(a); */
1300 l=LEN_PLIST(a);
1301 if (l==0) {
1302 return b;
1303 }
1304 /* m:=Length(b); */
1305 m=LEN_PLIST(b);
1306 if (m==0) {
1307 return a;
1308 }
1309 /* now we know both lists are length >0 */
1310
1311 /* i:=l; */
1312 i=l;
1313 /* j:=1; */
1314 j=1;
1315 /* while i>=1 and j<=m and a[i]=-b[j] do */
1316 while ((i>=1)&&(j<=m)&&
1317 (INT_INTOBJ(ELM_PLIST(a,i))==-INT_INTOBJ(ELM_PLIST(b,j)))) {
1318 /* i:=i-1; */
1319 i--;
1320 /* j:=j+1; */
1321 j++;
1322 /* od; */
1323 }
1324 /* if i=0 then */
1325 if (i==0) {
1326 /* if j>m then */
1327 if (j>m) {
1328 /* full cancellation */
1329 /* return false; */
1330 return False;
1331 }
1332 /* fi; */
1333 /* a:=b{[j..m]}; */
1334 as=1;
1335 ae=0;
1336 bs=j;
1337 be=m;
1338 newlen=m-j+1;
1339 }
1340 /* elif j>m then */
1341 else {
1342 if (j>m) {
1343 /* a:=a{[1..i]}; */
1344 as=1;
1345 ae=i;
1346 bs=1;
1347 be=0;
1348 newlen=i;
1349 }
1350 else {
1351 /* else */
1352 /* a:=Concatenation(a{[1..i]},b{[j..m]}); */
1353 as=1;
1354 ae=i;
1355 bs=j;
1356 be=m;
1357 newlen=m-j+1+i;
1358 }
1359 /* fi; */
1360 }
1361 /* make the new list */
1362 n=NEW_PLIST(T_PLIST_CYC,newlen);
1363 q=ADDR_OBJ(n);
1364 q++;
1365 j=as;
1366 /* a[as] position */
1367 p=CONST_ADDR_OBJ(a) + as;
1368 while (j<=ae) {
1369 *q++=*p++;
1370 j++;
1371 }
1372 j=bs;
1373 /* b[bs] position */
1374 p=CONST_ADDR_OBJ(b) + bs;
1375 while (j<=be) {
1376 *q++=*p++;
1377 j++;
1378 }
1379 SET_LEN_PLIST(n,newlen);
1380 CHANGED_BAG(n);
1381 /* return a; */
1382 return n;
1383 }
1384
1385 /*F FuncMULT_BYT_LETTREP( <self>, <a>,<b> ) */
FuncMULT_BYT_LETTREP(Obj self,Obj a,Obj b)1386 static Obj FuncMULT_BYT_LETTREP(Obj self, Obj a, Obj b)
1387 {
1388 UInt l,m,i,j,newlen,as,bs,ae,be;
1389 Obj n;
1390 const Char *p,*q;
1391
1392 /* short check, if necessary strings are compacted */
1393 RequireStringRep("MULT_BYT_LETTREP", a);
1394 RequireStringRep("MULT_BYT_LETTREP", b);
1395
1396 /* Find overlap */
1397 /* l:=Length(a); */
1398 l=GET_LEN_STRING(a);
1399 if (l==0) {
1400 return b;
1401 }
1402 /* m:=Length(b); */
1403 m=GET_LEN_STRING(b);
1404 if (m==0) {
1405 return a;
1406 }
1407 /* now we know both lists are length >0 */
1408
1409 /* i:=l; */
1410 i=l;
1411 /* j:=1; */
1412 j=1;
1413 /* while i>=1 and j<=m and a[i]=-b[j] do */
1414 p=CONST_CSTR_STRING(a);
1415 q=CONST_CSTR_STRING(b);
1416 while ((i>=1)&&(j<=m)&&
1417 (SINT_CHAR(p[i-1])==-SINT_CHAR(q[j-1]))) {
1418 /* i:=i-1; */
1419 i--;
1420 /* j:=j+1; */
1421 j++;
1422 /* od; */
1423 }
1424 /* if i=0 then */
1425 if (i==0) {
1426 /* if j>m then */
1427 if (j>m) {
1428 /* full cancellation */
1429 /* return false; */
1430 return False;
1431 }
1432 /* fi; */
1433 /* a:=b{[j..m]}; */
1434 as=1;
1435 ae=0;
1436 bs=j;
1437 be=m;
1438 newlen=m-j+1;
1439 }
1440 /* elif j>m then */
1441 else {
1442 if (j>m) {
1443 /* a:=a{[1..i]}; */
1444 as=1;
1445 ae=i;
1446 bs=1;
1447 be=0;
1448 newlen=i;
1449 }
1450 else {
1451 /* else */
1452 /* a:=Concatenation(a{[1..i]},b{[j..m]}); */
1453 as=1;
1454 ae=i;
1455 bs=j;
1456 be=m;
1457 newlen=m-j+1+i;
1458 }
1459 /* fi; */
1460 }
1461 /* make the new list */
1462 n=NEW_STRING(newlen);
1463 Char *dst = CSTR_STRING(n);
1464 p=CONST_CSTR_STRING(a);
1465 j=as;
1466 /* a[as] position */
1467 while (j<=ae) {
1468 *dst++=p[j-1];
1469 j++;
1470 }
1471 j=bs;
1472 p=CONST_CSTR_STRING(b);
1473 /* b[bs] position */
1474 while (j<=be) {
1475 *dst++=p[j-1];
1476 j++;
1477 }
1478 /* return a; */
1479 return n;
1480 }
1481
1482 /****************************************************************************
1483 **
1484 *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
1485 */
1486
1487 /****************************************************************************
1488 **
1489 *V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
1490 */
1491 static StructGVarFunc GVarFuncs[] = {
1492
1493 GVAR_FUNC(8Bits_Equal, 2, "8_bits_word, 8_bits_word"),
1494 GVAR_FUNC(8Bits_ExponentSums1, 1, "8_bits_word"),
1495 GVAR_FUNC(8Bits_ExponentSums3, 3, "8_bits_word, start, end"),
1496 GVAR_FUNC(8Bits_ExponentSyllable, 2, "8_bits_word, pos"),
1497 GVAR_FUNC(8Bits_ExtRepOfObj, 1, "8_bits_word"),
1498 GVAR_FUNC(8Bits_GeneratorSyllable, 2, "8_bits_word, pos"),
1499 GVAR_FUNC(8Bits_Less, 2, "8_bits_word, 8_bits_word"),
1500 GVAR_FUNC(8Bits_AssocWord, 2, "type, data"),
1501 GVAR_FUNC(8Bits_ObjByVector, 2, "type, data"),
1502 GVAR_FUNC(8Bits_HeadByNumber, 2, "16_bits_word, gen_num"),
1503 GVAR_FUNC(8Bits_Power, 2, "8_bits_word, small_integer"),
1504 GVAR_FUNC(8Bits_Product, 2, "8_bits_word, 8_bits_word"),
1505 GVAR_FUNC(8Bits_Quotient, 2, "8_bits_word, 8_bits_word"),
1506 GVAR_FUNC(8Bits_LengthWord, 1, "8_bits_word"),
1507
1508 GVAR_FUNC(16Bits_Equal, 2, "16_bits_word, 16_bits_word"),
1509 GVAR_FUNC(16Bits_ExponentSums1, 1, "16_bits_word"),
1510 GVAR_FUNC(16Bits_ExponentSums3, 3, "16_bits_word, start, end"),
1511 GVAR_FUNC(16Bits_ExponentSyllable, 2, "16_bits_word, pos"),
1512 GVAR_FUNC(16Bits_ExtRepOfObj, 1, "16_bits_word"),
1513 GVAR_FUNC(16Bits_GeneratorSyllable, 2, "16_bits_word, pos"),
1514 GVAR_FUNC(16Bits_Less, 2, "16_bits_word, 16_bits_word"),
1515 GVAR_FUNC(16Bits_AssocWord, 2, "type, data"),
1516 GVAR_FUNC(16Bits_ObjByVector, 2, "type, data"),
1517 GVAR_FUNC(16Bits_HeadByNumber, 2, "16_bits_word, gen_num"),
1518 GVAR_FUNC(16Bits_Power, 2, "16_bits_word, small_integer"),
1519 GVAR_FUNC(16Bits_Product, 2, "16_bits_word, 16_bits_word"),
1520 GVAR_FUNC(16Bits_Quotient, 2, "16_bits_word, 16_bits_word"),
1521 GVAR_FUNC(16Bits_LengthWord, 1, "16_bits_word"),
1522
1523 GVAR_FUNC(32Bits_Equal, 2, "32_bits_word, 32_bits_word"),
1524 GVAR_FUNC(32Bits_ExponentSums1, 1, "32_bits_word"),
1525 GVAR_FUNC(32Bits_ExponentSums3, 3, "32_bits_word, start, end"),
1526 GVAR_FUNC(32Bits_ExponentSyllable, 2, "32_bits_word, pos"),
1527 GVAR_FUNC(32Bits_ExtRepOfObj, 1, "32_bits_word"),
1528 GVAR_FUNC(32Bits_GeneratorSyllable, 2, "32_bits_word, pos"),
1529 GVAR_FUNC(32Bits_Less, 2, "32_bits_word, 32_bits_word"),
1530 GVAR_FUNC(32Bits_AssocWord, 2, "type, data"),
1531 GVAR_FUNC(32Bits_ObjByVector, 2, "type, data"),
1532 GVAR_FUNC(32Bits_HeadByNumber, 2, "16_bits_word, gen_num"),
1533 GVAR_FUNC(32Bits_Power, 2, "32_bits_word, small_integer"),
1534 GVAR_FUNC(32Bits_Product, 2, "32_bits_word, 32_bits_word"),
1535 GVAR_FUNC(32Bits_Quotient, 2, "32_bits_word, 32_bits_word"),
1536 GVAR_FUNC(32Bits_LengthWord, 1, "32_bits_word"),
1537
1538 GVAR_FUNC(NBits_NumberSyllables, 1, "N_bits_word"),
1539
1540 GVAR_FUNC(MULT_WOR_LETTREP, 2, "a, b"),
1541 GVAR_FUNC(MULT_BYT_LETTREP, 2, "a, b"),
1542
1543 { 0, 0, 0, 0, 0 }
1544
1545 };
1546
1547
1548 /****************************************************************************
1549 **
1550 *F InitKernel( <module> ) . . . . . . . . initialise kernel data structures
1551 */
InitKernel(StructInitInfo * module)1552 static Int InitKernel (
1553 StructInitInfo * module )
1554 {
1555 /* init filters and functions */
1556 InitHdlrFuncsFromTable( GVarFuncs );
1557
1558 /* return success */
1559 return 0;
1560 }
1561
1562
1563 /****************************************************************************
1564 **
1565 *F InitLibrary( <module> ) . . . . . . . initialise library data structures
1566 */
InitLibrary(StructInitInfo * module)1567 static Int InitLibrary (
1568 StructInitInfo * module )
1569 {
1570 /* export position numbers 'AWP_SOMETHING' */
1571 ExportAsConstantGVar(AWP_FIRST_ENTRY);
1572 ExportAsConstantGVar(AWP_PURE_TYPE);
1573 ExportAsConstantGVar(AWP_NR_BITS_EXP);
1574 ExportAsConstantGVar(AWP_NR_GENS);
1575 ExportAsConstantGVar(AWP_NR_BITS_PAIR);
1576 ExportAsConstantGVar(AWP_FUN_OBJ_BY_VECTOR);
1577 ExportAsConstantGVar(AWP_FUN_ASSOC_WORD);
1578 ExportAsConstantGVar(AWP_FIRST_FREE);
1579
1580 /* init filters and functions */
1581 InitGVarFuncsFromTable( GVarFuncs );
1582
1583 /* return success */
1584 return 0;
1585 }
1586
1587
1588 /****************************************************************************
1589 **
1590 *F InitInfoFreeGroupElements() . . . . . . . . . . . table of init functions
1591 */
1592 static StructInitInfo module = {
1593 /* type = */ MODULE_BUILTIN,
1594 /* name = */ "objfgelm",
1595 /* revision_c = */ 0,
1596 /* revision_h = */ 0,
1597 /* version = */ 0,
1598 /* crc = */ 0,
1599 /* initKernel = */ InitKernel,
1600 /* initLibrary = */ InitLibrary,
1601 /* checkInit = */ 0,
1602 /* preSave = */ 0,
1603 /* postSave = */ 0,
1604 /* postRestore = */ 0,
1605 /* moduleStateSize = */ 0,
1606 /* moduleStateOffsetPtr = */ 0,
1607 /* initModuleState = */ 0,
1608 /* destroyModuleState = */ 0,
1609 };
1610
InitInfoFreeGroupElements(void)1611 StructInitInfo * InitInfoFreeGroupElements ( void )
1612 {
1613 return &module;
1614 }
1615