Context Navigation

source: git/libpolys/polys/monomials/ring.cc @ a27116

fieker-DuValspielwiese

Last change on this file since a27116 was a27116, checked in by Hans Schoenemann <hannes@…>, 7 years ago
add: rHasTDeg (ring.cc)
Property mode set to `100644`
File size: 141.5 KB

Line
1	/****************************************
2	* Computer Algebra System SINGULAR *
3	****************************************/
4	/*
5	* ABSTRACT - the interpreter related ring operations
6	*/
7
8	/* includes */
9	#include <math.h>
10
11
12
13
14
15	#include <omalloc/omalloc.h>
16
17	#include <misc/auxiliary.h>
18	#include <misc/mylimits.h>
19	#include <misc/options.h>
20	#include <misc/int64vec.h>
21
22	#include <coeffs/numbers.h>
23	#include <coeffs/coeffs.h>
24
25	#include <polys/monomials/p_polys.h>
26	#include <polys/simpleideals.h>
27	// #include <???/febase.h>
28	// #include <???/intvec.h>
29	// #include <coeffs/ffields.h>
30	#include <polys/monomials/ring.h>
31	#include <polys/monomials/maps.h>
32	#include <polys/prCopy.h>
33	// #include "../Singular/ipshell.h"
34	#include <polys/templates/p_Procs.h>
35
36	#include <polys/matpol.h>
37
38	#include <polys/monomials/ring.h>
39
40	#ifdef HAVE_PLURAL
41	#include <polys/nc/nc.h>
42	#include <polys/nc/sca.h>
43	#endif
44	// #include <???/maps.h>
45	// #include <???/matpol.h>
46
47
48	#include "ext_fields/algext.h"
49	#include "ext_fields/transext.h"
50
51
52	#define BITS_PER_LONG 8*SIZEOF_LONG
53
54	omBin sip_sring_bin = omGetSpecBin(sizeof(ip_sring));
55	omBin char_ptr_bin = omGetSpecBin(sizeof(char*));
56
57
58	static const char * const ringorder_name[] =
59	{
60	" ?", ///< ringorder_no = 0,
61	"a", ///< ringorder_a,
62	"A", ///< ringorder_a64,
63	"c", ///< ringorder_c,
64	"C", ///< ringorder_C,
65	"M", ///< ringorder_M,
66	"S", ///< ringorder_S,
67	"s", ///< ringorder_s,
68	"lp", ///< ringorder_lp,
69	"dp", ///< ringorder_dp,
70	"rp", ///< ringorder_rp,
71	"Dp", ///< ringorder_Dp,
72	"wp", ///< ringorder_wp,
73	"Wp", ///< ringorder_Wp,
74	"ls", ///< ringorder_ls,
75	"ds", ///< ringorder_ds,
76	"Ds", ///< ringorder_Ds,
77	"ws", ///< ringorder_ws,
78	"Ws", ///< ringorder_Ws,
79	"am", ///< ringorder_am,
80	"L", ///< ringorder_L,
81	"aa", ///< ringorder_aa
82	"rs", ///< ringorder_rs,
83	"IS", ///< ringorder_IS
84	" _" ///< ringorder_unspec
85	};
86
87
88	const char * rSimpleOrdStr(int ord)
89	{
90	return ringorder_name[ord];
91	}
92
93	/// unconditionally deletes fields in r
94	void rDelete(ring r);
95	/// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
96	static void rSetVarL(ring r);
97	/// get r->divmask depending on bits per exponent
98	static unsigned long rGetDivMask(int bits);
99	/// right-adjust r->VarOffset
100	static void rRightAdjustVarOffset(ring r);
101	static void rOptimizeLDeg(ring r);
102
103	/0 implementation/
104	//BOOLEAN rField_is_R(ring r)
105	//{
106	// if (r->cf->ch== -1)
107	// {
108	// if (r->float_len==(short)0) return TRUE;
109	// }
110	// return FALSE;
111	//}
112
113	ring rDefault(const coeffs cf, int N, char *n,int ord_size, rRingOrder_t ord, int block0, int block1, int** wvhdl)
114	{
115	assume( cf != NULL);
116	ring r=(ring) omAlloc0Bin(sip_sring_bin);
117	r->N = N;
118	r->cf = cf;
119	/rPar(r) = 0; Alloc0 /
120	/names/
121	r->names = (char *) omAlloc0(N sizeof(char *));
122	int i;
123	for(i=0;i<N;i++)
124	{
125	r->names[i] = omStrDup(n[i]);
126	}
127	/weights: entries for 2 blocks: NULL/
128	if (wvhdl==NULL)
129	r->wvhdl = (int *)omAlloc0((ord_size+1) sizeof(int *));
130	else
131	r->wvhdl=wvhdl;
132	r->order = ord;
133	r->block0 = block0;
134	r->block1 = block1;
135
136	/* complete ring intializations */
137	rComplete(r);
138	return r;
139	}
140	ring rDefault(int ch, int N, char *n,int ord_size, rRingOrder_t ord, int block0, int block1,int ** wvhdl)
141	{
142	coeffs cf;
143	if (ch==0) cf=nInitChar(n_Q,NULL);
144	else cf=nInitChar(n_Zp,(void*)(long)ch);
145	assume( cf != NULL);
146	return rDefault(cf,N,n,ord_size,ord,block0,block1,wvhdl);
147	}
148	ring rDefault(const coeffs cf, int N, char **n, const rRingOrder_t o)
149	{
150	assume( cf != NULL);
151	/order: o=lp,0/
152	rRingOrder_t order = (rRingOrder_t ) omAlloc(2* sizeof(rRingOrder_t));
153	int block0 = (int )omAlloc0(2 * sizeof(int));
154	int block1 = (int )omAlloc0(2 * sizeof(int));
155	/* ringorder o=lp for the first block: var 1..N */
156	order[0] = o;
157	block0[0] = 1;
158	block1[0] = N;
159	/* the last block: everything is 0 */
160	order[1] = (rRingOrder_t)0;
161
162	return rDefault(cf,N,n,2,order,block0,block1);
163	}
164
165	ring rDefault(int ch, int N, char **n)
166	{
167	coeffs cf;
168	if (ch==0) cf=nInitChar(n_Q,NULL);
169	else cf=nInitChar(n_Zp,(void*)(long)ch);
170	assume( cf != NULL);
171	return rDefault(cf,N,n);
172	}
173
174	///////////////////////////////////////////////////////////////////////////
175	//
176	// rInit: define a new ring from sleftv's
177	//
178	//-> ipshell.cc
179
180	/////////////////////////////
181	// Auxillary functions
182	//
183
184	// check intvec, describing the ordering
185	BOOLEAN rCheckIV(const intvec *iv)
186	{
187	if ((iv->length()!=2)&&(iv->length()!=3))
188	{
189	WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
190	return TRUE;
191	}
192	return FALSE;
193	}
194
195	int rTypeOfMatrixOrder(const intvec* order)
196	{
197	int i=0,j,typ=1;
198	int sz = (int)sqrt((double)(order->length()-2));
199	if ((sz*sz)!=(order->length()-2))
200	{
201	WerrorS("Matrix order is not a square matrix");
202	typ=0;
203	}
204	while ((i<sz) && (typ==1))
205	{
206	j=0;
207	while ((j<sz) && ((order)[jsz+i+2]==0)) j++;
208	if (j>=sz)
209	{
210	typ = 0;
211	WerrorS("Matrix order not complete");
212	}
213	else if ((order)[jsz+i+2]<0)
214	typ = -1;
215	else
216	i++;
217	}
218	return typ;
219	}
220
221
222	int r_IsRingVar(const char n, char*names,int N)
223	{
224	if (names!=NULL)
225	{
226	for (int i=0; i<N; i++)
227	{
228	if (names[i]==NULL) return -1;
229	if (strcmp(n,names[i]) == 0) return (int)i;
230	}
231	}
232	return -1;
233	}
234
235
236	void rWrite(ring r, BOOLEAN details)
237	{
238	if ((r==NULL)\|\|(r->order==NULL))
239	return; /to avoid printing after errors..../
240
241	assume(r != NULL);
242	const coeffs C = r->cf;
243	assume(C != NULL);
244
245	int nblocks=rBlocks(r);
246
247	// omCheckAddrSize(r,sizeof(ip_sring));
248	omCheckAddrSize(r->order,nblocks*sizeof(int));
249	omCheckAddrSize(r->block0,nblocks*sizeof(int));
250	omCheckAddrSize(r->block1,nblocks*sizeof(int));
251	omCheckAddrSize(r->wvhdl,nblockssizeof(int ));
252	omCheckAddrSize(r->names,r->Nsizeof(char ));
253
254	nblocks--;
255
256
257	PrintS("// coefficients: ");
258	if( nCoeff_is_algExt(C) )
259	{
260	// NOTE: the following (non-thread-safe!) UGLYNESS
261	// (changing naRing->ShortOut for a while) is due to Hans!
262	// Just think of other ring using the VERY SAME naRing and possible
263	// side-effects...
264	ring R = C->extRing;
265	const BOOLEAN bSaveShortOut = rShortOut(R); R->ShortOut = rShortOut(r) & rCanShortOut(R);
266
267	n_CoeffWrite(C, details); // for correct printing of minpoly... WHAT AN UGLYNESS!!!
268
269	R->ShortOut = bSaveShortOut;
270	}
271	else
272	n_CoeffWrite(C, details);
273	PrintLn();
274	// {
275	// PrintS("// characteristic : ");
276	//
277	// char const * const * const params = rParameter(r);
278	//
279	// if (params!=NULL)
280	// {
281	// Print ("// %d parameter : ",rPar(r));
282	//
283	// char const * const * sp= params;
284	// int nop=0;
285	// while (nop<rPar(r))
286	// {
287	// PrintS(*sp);
288	// PrintS(" ");
289	// sp++; nop++;
290	// }
291	// PrintS("\n// minpoly : ");
292	// if ( rField_is_long_C(r) )
293	// {
294	// // i^2+1:
295	// Print("(%s^2+1)\n", params[0]);
296	// }
297	// else if (rMinpolyIsNULL(r))
298	// {
299	// PrintS("0\n");
300	// }
301	// else
302	// {
303	// StringSetS(""); n_Write(r->cf->minpoly, r); PrintS(StringEndS("\n")); // NOTE/TODO: use StringAppendS("\n"); omFree(s);
304	// }
305	// //if (r->qideal!=NULL)
306	// //{
307	// // iiWriteMatrix((matrix)r->qideal,"// minpolys",1,r,0);
308	// // PrintLn();
309	// //}
310	// }
311	// }
312	Print("// number of vars : %d",r->N);
313
314	//for (nblocks=0; r->order[nblocks]; nblocks++);
315	nblocks=rBlocks(r)-1;
316
317	for (int l=0, nlen=0 ; l<nblocks; l++)
318	{
319	int i;
320	Print("\n// block %3d : ",l+1);
321
322	Print("ordering %s", rSimpleOrdStr(r->order[l]));
323
324
325	if (r->order[l] == ringorder_s)
326	{
327	assume( l == 0 );
328	#ifndef SING_NDEBUG
329	Print(" syzcomp at %d",r->typ[l].data.syz.limit);
330	#endif
331	continue;
332	}
333	else if (r->order[l] == ringorder_IS)
334	{
335	assume( r->block0[l] == r->block1[l] );
336	const int s = r->block0[l];
337	assume( (-2 < s) && (s < 2) );
338	Print("(%d)", s); // 0 => prefix! +/-1 => suffix!
339	continue;
340	}
341	else if (
342	( (r->order[l] >= ringorder_lp)
343	\|\|(r->order[l] == ringorder_M)
344	\|\|(r->order[l] == ringorder_a)
345	\|\|(r->order[l] == ringorder_am)
346	\|\|(r->order[l] == ringorder_a64)
347	\|\|(r->order[l] == ringorder_aa) ) && (r->order[l] < ringorder_IS) )
348	{
349	PrintS("\n// : names ");
350	for (i = r->block0[l]-1; i<r->block1[l]; i++)
351	{
352	nlen = strlen(r->names[i]);
353	Print(" %s",r->names[i]);
354	}
355	}
356
357	if (r->wvhdl[l]!=NULL)
358	{
359	for (int j= 0;
360	j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
361	j+=i)
362	{
363	PrintS("\n// : weights ");
364	for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
365	{
366	if (r->order[l] == ringorder_a64)
367	{
368	int64 w=(int64 )r->wvhdl[l];
369	#if SIZEOF_LONG == 4
370	Print("%*lld " ,nlen,w[i+j]);
371	#else
372	Print(" %*ld" ,nlen,w[i+j]);
373	#endif
374	}
375	else
376	Print(" %*d" ,nlen,r->wvhdl[l][i+j]);
377	}
378	if (r->order[l]!=ringorder_M) break;
379	}
380	if (r->order[l]==ringorder_am)
381	{
382	int m=r->wvhdl[l][i];
383	Print("\n// : %d module weights ",m);
384	m+=i;i++;
385	for(;i<=m;i++) Print(" %*d" ,nlen,r->wvhdl[l][i]);
386	}
387	}
388	}
389	#ifdef HAVE_PLURAL
390	if(rIsPluralRing(r))
391	{
392	PrintS("\n// noncommutative relations:");
393	if( details )
394	{
395	poly pl=NULL;
396	int nl;
397	int i,j;
398	for (i = 1; i<r->N; i++)
399	{
400	for (j = i+1; j<=r->N; j++)
401	{
402	nl = n_IsOne(p_GetCoeff(MATELEM(r->GetNC()->C,i,j),r), r->cf);
403	if ( (MATELEM(r->GetNC()->D,i,j)!=NULL) \|\| (!nl) )
404	{
405	Print("\n// %s%s=",r->names[j-1],r->names[i-1]);
406	pl = MATELEM(r->GetNC()->MT[UPMATELEM(i,j,r->N)],1,1);
407	p_Write0(pl, r, r);
408	}
409	}
410	}
411	} else
412	PrintS(" ...");
413
414	#if MYTEST /Singularg should not differ from Singular except in error case/
415	Print("\n// noncommutative type:%d", (int)ncRingType(r));
416	Print("\n// is skew constant:%d",r->GetNC()->IsSkewConstant);
417	if( rIsSCA(r) )
418	{
419	Print("\n// alternating variables: [%d, %d]", scaFirstAltVar(r), scaLastAltVar(r));
420	const ideal Q = SCAQuotient(r); // resides within r!
421	PrintS("\n// quotient of sca by ideal");
422
423	if (Q!=NULL)
424	{
425	// if (r==currRing)
426	// {
427	// PrintLn();
428	iiWriteMatrix((matrix)Q,"scaQ",1,r,0);
429	// }
430	// else
431	// PrintS(" ...");
432	}
433	else
434	PrintS(" (NULL)");
435	}
436	#endif
437	}
438	#endif
439	if (r->qideal!=NULL)
440	{
441	PrintS("\n// quotient ring from ideal");
442	if( details )
443	{
444	PrintLn();
445	iiWriteMatrix((matrix)r->qideal,"_",1,r,0);
446	} else PrintS(" ...");
447	}
448	}
449
450	void rDelete(ring r)
451	{
452	int i, j;
453
454	if (r == NULL) return;
455
456	assume( r->ref <= 0 );
457
458	if( r->ref > 0 ) // ->ref means the number of Interpreter objects referring to the ring...
459	return; // this should never happen.
460
461	if( r->qideal != NULL )
462	{
463	ideal q = r->qideal;
464	r->qideal = NULL;
465	id_Delete(&q, r);
466	}
467
468	#ifdef HAVE_PLURAL
469	if (rIsPluralRing(r))
470	nc_rKill(r);
471	#endif
472
473	nKillChar(r->cf); r->cf = NULL;
474	rUnComplete(r);
475	// delete order stuff
476	if (r->order != NULL)
477	{
478	i=rBlocks(r);
479	assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
480	// delete order
481	omFreeSize((ADDRESS)r->order,i*sizeof(rRingOrder_t));
482	omFreeSize((ADDRESS)r->block0,i*sizeof(int));
483	omFreeSize((ADDRESS)r->block1,i*sizeof(int));
484	// delete weights
485	for (j=0; j<i; j++)
486	{
487	if (r->wvhdl[j]!=NULL)
488	omFree(r->wvhdl[j]);
489	}
490	omFreeSize((ADDRESS)r->wvhdl,isizeof(int ));
491	}
492	else
493	{
494	assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
495	}
496
497	// delete varnames
498	if(r->names!=NULL)
499	{
500	for (i=0; i<r->N; i++)
501	{
502	if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
503	}
504	omFreeSize((ADDRESS)r->names,r->Nsizeof(char ));
505	}
506
507	omFreeBin(r, sip_sring_bin);
508	}
509
510	rRingOrder_t rOrderName(char * ordername)
511	{
512	int order=ringorder_unspec;
513	while (order!= 0)
514	{
515	if (strcmp(ordername,rSimpleOrdStr(order))==0)
516	break;
517	order--;
518	}
519	if (order==0) Werror("wrong ring order `%s`",ordername);
520	omFree((ADDRESS)ordername);
521	return (rRingOrder_t)order;
522	}
523
524	char * rOrdStr(ring r)
525	{
526	if ((r==NULL)\|\|(r->order==NULL)) return omStrDup("");
527	int nblocks,l,i;
528
529	for (nblocks=0; r->order[nblocks]; nblocks++);
530	nblocks--;
531
532	StringSetS("");
533	for (l=0; ; l++)
534	{
535	StringAppendS((char *)rSimpleOrdStr(r->order[l]));
536	if (
537	(r->order[l] != ringorder_c)
538	&& (r->order[l] != ringorder_C)
539	&& (r->order[l] != ringorder_s)
540	&& (r->order[l] != ringorder_S)
541	&& (r->order[l] != ringorder_IS)
542	)
543	{
544	if (r->wvhdl[l]!=NULL)
545	{
546	StringAppendS("(");
547	for (int j= 0;
548	j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
549	j+=i+1)
550	{
551	char c=',';
552	if(r->order[l]==ringorder_a64)
553	{
554	int64 * w=(int64 *)r->wvhdl[l];
555	for (i = 0; i<r->block1[l]-r->block0[l]; i++)
556	{
557	StringAppend("%lld," ,w[i]);
558	}
559	StringAppend("%lld)" ,w[i]);
560	break;
561	}
562	else
563	{
564	for (i = 0; i<r->block1[l]-r->block0[l]; i++)
565	{
566	StringAppend("%d," ,r->wvhdl[l][i+j]);
567	}
568	}
569	if (r->order[l]!=ringorder_M)
570	{
571	StringAppend("%d)" ,r->wvhdl[l][i+j]);
572	break;
573	}
574	if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
575	c=')';
576	StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
577	}
578	}
579	else
580	StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
581	}
582	else if (r->order[l] == ringorder_IS)
583	{
584	assume( r->block0[l] == r->block1[l] );
585	const int s = r->block0[l];
586	assume( (-2 < s) && (s < 2) );
587
588	StringAppend("(%d)", s);
589	}
590
591	if (l==nblocks) return StringEndS();
592	StringAppendS(",");
593	}
594	}
595
596	char * rVarStr(ring r)
597	{
598	if ((r==NULL)\|\|(r->names==NULL)) return omStrDup("");
599	int i;
600	int l=2;
601	char *s;
602
603	for (i=0; i<r->N; i++)
604	{
605	l+=strlen(r->names[i])+1;
606	}
607	s=(char *)omAlloc((long)l);
608	s[0]='\0';
609	for (i=0; i<r->N-1; i++)
610	{
611	strcat(s,r->names[i]);
612	strcat(s,",");
613	}
614	strcat(s,r->names[i]);
615	return s;
616	}
617
618	/// TODO: make it a virtual method of coeffs, together with:
619	/// Decompose & Compose, rParameter & rPar
620	char * rCharStr(const ring r){ assume( r != NULL ); return nCoeffString(r->cf); }
621
622	char * rParStr(ring r)
623	{
624	if ((r==NULL)\|\|(rParameter(r)==NULL)) return omStrDup("");
625
626	char const * const * const params = rParameter(r);
627
628	int i;
629	int l=2;
630
631	for (i=0; i<rPar(r); i++)
632	{
633	l+=strlen(params[i])+1;
634	}
635	char s=(char )omAlloc((long)l);
636	s[0]='\0';
637	for (i=0; i<rPar(r)-1; i++)
638	{
639	strcat(s, params[i]);
640	strcat(s,",");
641	}
642	strcat(s, params[i]);
643	return s;
644	}
645
646	char * rString(ring r)
647	{
648	if ((r!=NULL)&&(r->cf!=NULL))
649	{
650	char *ch=rCharStr(r);
651	char *var=rVarStr(r);
652	char *ord=rOrdStr(r);
653	char res=(char )omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
654	sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
655	omFree((ADDRESS)ch);
656	omFree((ADDRESS)var);
657	omFree((ADDRESS)ord);
658	return res;
659	}
660	else
661	return omStrDup("undefined");
662	}
663
664
665	/*
666	// The fowolling function seems to be never used. Remove?
667	static int binaryPower (const int a, const int b)
668	{
669	// computes a^b according to the binary representation of b,
670	// i.e., a^7 = a^4 * a^2 * a^1. This saves some multiplications.
671	int result = 1;
672	int factor = a;
673	int bb = b;
674	while (bb != 0)
675	{
676	if (bb % 2 != 0) result = result * factor;
677	bb = bb / 2;
678	factor = factor * factor;
679	}
680	return result;
681	}
682	*/
683
684	/* we keep this otherwise superfluous method for compatibility reasons
685	towards the SINGULAR svn trunk */
686	int rChar(ring r) { return r->cf->ch; }
687
688	// typedef char * char_ptr;
689	// omBin char_ptr_bin = omGetSpecBin(sizeof(char_ptr)); // deallocation?
690
691
692	// creates a commutative nc extension; "converts" comm.ring to a Plural ring
693	#ifdef HAVE_PLURAL
694	ring nc_rCreateNCcomm_rCopy(ring r)
695	{
696	r = rCopy(r);
697	if (rIsPluralRing(r))
698	return r;
699
700	matrix C = mpNew(r->N,r->N); // ring-independent!?!
701	matrix D = mpNew(r->N,r->N);
702
703	for(int i=1; i<r->N; i++)
704	for(int j=i+1; j<=r->N; j++)
705	MATELEM(C,i,j) = p_One( r);
706
707	if (nc_CallPlural(C, D, NULL, NULL, r, false, true, false, r/??currRing??/, TRUE)) // TODO: what about quotient ideal?
708	WarnS("Error initializing multiplication!"); // No reaction!???
709
710	return r;
711	}
712	#endif
713
714
715	/*2
716	*returns -1 for not compatible, (sum is undefined)
717	* 1 for compatible (and sum)
718	*/
719	/* vartest: test for variable/paramter names
720	* dp_dp: 0:block ordering
721	* 1:for comm. rings: use block order dp + dp/ds/wp
722	* 2:order aa(..),dp
723	*/
724	int rSumInternal(ring r1, ring r2, ring &sum, BOOLEAN vartest, BOOLEAN dp_dp)
725	{
726
727	ip_sring tmpR;
728	memset(&tmpR,0,sizeof(tmpR));
729	/* check coeff. field =====================================================*/
730
731	if (r1->cf==r2->cf)
732	{
733	tmpR.cf=nCopyCoeff(r1->cf);
734	}
735	else /* different type */
736	{
737	if (getCoeffType(r1->cf)==n_Zp)
738	{
739	if (getCoeffType(r2->cf)==n_Q)
740	{
741	tmpR.cf=nCopyCoeff(r1->cf);
742	}
743	else if (nCoeff_is_Extension(r2->cf) && rChar(r2) == rChar(r1))
744	{
745	/*AlgExtInfo extParam;
746	extParam.r = r2->cf->extRing;
747	extParam.i = r2->cf->extRing->qideal;*/
748	tmpR.cf=nCopyCoeff(r2->cf);
749	}
750	else
751	{
752	WerrorS("Z/p+...");
753	return -1;
754	}
755	}
756	else if (getCoeffType(r1->cf)==n_R)
757	{
758	WerrorS("R+..");
759	return -1;
760	}
761	else if (getCoeffType(r1->cf)==n_Q)
762	{
763	if (getCoeffType(r2->cf)==n_Zp)
764	{
765	tmpR.cf=nCopyCoeff(r2->cf);
766	}
767	else if (nCoeff_is_Extension(r2->cf))
768	{
769	tmpR.cf=nCopyCoeff(r2->cf);
770	}
771	else
772	{
773	WerrorS("Q+...");
774	return -1;
775	}
776	}
777	else if (nCoeff_is_Extension(r1->cf))
778	{
779	if (r1->cf->extRing->cf==r2->cf)
780	{
781	tmpR.cf=nCopyCoeff(r1->cf);
782	}
783	else if (getCoeffType(r1->cf->extRing->cf)==n_Zp && getCoeffType(r2->cf)==n_Q) //r2->cf == n_Zp should have been handled above
784	{
785	tmpR.cf=nCopyCoeff(r1->cf);
786	}
787	else
788	{
789	WerrorS ("coeff sum of two extension fields not implemented");
790	return -1;
791	}
792	}
793	else
794	{
795	WerrorS("coeff sum not yet implemented");
796	return -1;
797	}
798	}
799	/* variable names ========================================================*/
800	int i,j,k;
801	int l=r1->N+r2->N;
802	char names=(char )omAlloc0(lsizeof(char ));
803	k=0;
804
805	// collect all varnames from r1, except those which are parameters
806	// of r2, or those which are the empty string
807	for (i=0;i<r1->N;i++)
808	{
809	BOOLEAN b=TRUE;
810
811	if (*(r1->names[i]) == '\0')
812	b = FALSE;
813	else if ((rParameter(r2)!=NULL) && (strlen(r1->names[i])==1))
814	{
815	if (vartest)
816	{
817	for(j=0;j<rPar(r2);j++)
818	{
819	if (strcmp(r1->names[i],rParameter(r2)[j])==0)
820	{
821	b=FALSE;
822	break;
823	}
824	}
825	}
826	}
827
828	if (b)
829	{
830	//Print("name : %d: %s\n",k,r1->names[i]);
831	names[k]=omStrDup(r1->names[i]);
832	k++;
833	}
834	//else
835	// Print("no name (par1) %s\n",r1->names[i]);
836	}
837	// Add variables from r2, except those which are parameters of r1
838	// those which are empty strings, and those which equal a var of r1
839	for(i=0;i<r2->N;i++)
840	{
841	BOOLEAN b=TRUE;
842
843	if (*(r2->names[i]) == '\0')
844	b = FALSE;
845	else if ((rParameter(r1)!=NULL) && (strlen(r2->names[i])==1))
846	{
847	if (vartest)
848	{
849	for(j=0;j<rPar(r1);j++)
850	{
851	if (strcmp(r2->names[i],rParameter(r1)[j])==0)
852	{
853	b=FALSE;
854	break;
855	}
856	}
857	}
858	}
859
860	if (b)
861	{
862	if (vartest)
863	{
864	for(j=0;j<r1->N;j++)
865	{
866	if (strcmp(r1->names[j],r2->names[i])==0)
867	{
868	b=FALSE;
869	break;
870	}
871	}
872	}
873	if (b)
874	{
875	//Print("name : %d : %s\n",k,r2->names[i]);
876	names[k]=omStrDup(r2->names[i]);
877	k++;
878	}
879	//else
880	// Print("no name (var): %s\n",r2->names[i]);
881	}
882	//else
883	// Print("no name (par): %s\n",r2->names[i]);
884	}
885	// check whether we found any vars at all
886	if (k == 0)
887	{
888	names[k]=omStrDup("");
889	k=1;
890	}
891	tmpR.N=k;
892	tmpR.names=names;
893	/* ordering ======================================================== /
894	tmpR.OrdSgn=0;
895	if ((dp_dp==2)
896	&& (r1->OrdSgn==1)
897	&& (r2->OrdSgn==1)
898	#ifdef HAVE_PLURAL
899	&& !rIsPluralRing(r1) && !rIsPluralRing(r2)
900	#endif
901	)
902	{
903	tmpR.order=(rRingOrder_t)omAlloc0(4sizeof(rRingOrder_t));
904	tmpR.block0=(int)omAlloc0(4sizeof(int));
905	tmpR.block1=(int)omAlloc0(4sizeof(int));
906	tmpR.wvhdl=(int*) omAlloc0(4sizeof(int**));
907	// ----
908	tmpR.block0[0] = 1;
909	tmpR.block1[0] = rVar(r1)+rVar(r2);
910	tmpR.order[0] = ringorder_aa;
911	tmpR.wvhdl[0]=(int)omAlloc0((rVar(r1)+rVar(r2) + 1)sizeof(int));
912	for(int i=0;i<rVar(r1);i++) tmpR.wvhdl[0][i]=1;
913	// ----
914	tmpR.block0[1] = 1;
915	tmpR.block1[1] = rVar(r1)+rVar(r2);
916	tmpR.order[1] = ringorder_dp;
917	// ----
918	tmpR.order[2] = ringorder_C;
919	}
920	else if (dp_dp
921	#ifdef HAVE_PLURAL
922	&& !rIsPluralRing(r1) && !rIsPluralRing(r2)
923	#endif
924	)
925	{
926	tmpR.order=(rRingOrder_t)omAlloc(4sizeof(rRingOrder_t));
927	tmpR.block0=(int)omAlloc0(4sizeof(int));
928	tmpR.block1=(int)omAlloc0(4sizeof(int));
929	tmpR.wvhdl=(int*)omAlloc0(4sizeof(int *));
930	tmpR.order[0]=ringorder_dp;
931	tmpR.block0[0]=1;
932	tmpR.block1[0]=rVar(r1);
933	if (r2->OrdSgn==1)
934	{
935	if ((r2->block0[0]==1)
936	&& (r2->block1[0]==rVar(r2))
937	&& ((r2->order[0]==ringorder_wp)
938	\|\| (r2->order[0]==ringorder_Wp)
939	\|\| (r2->order[0]==ringorder_Dp))
940	)
941	{
942	tmpR.order[1]=r2->order[0];
943	if (r2->wvhdl[0]!=NULL)
944	tmpR.wvhdl[1]=(int *)omMemDup(r2->wvhdl[0]);
945	}
946	else
947	tmpR.order[1]=ringorder_dp;
948	}
949	else
950	{
951	tmpR.order[1]=ringorder_ds;
952	tmpR.OrdSgn=-1;
953	}
954	tmpR.block0[1]=rVar(r1)+1;
955	tmpR.block1[1]=rVar(r1)+rVar(r2);
956	tmpR.order[2]=ringorder_C;
957	tmpR.order[3]=(rRingOrder_t)0;
958	}
959	else
960	{
961	if ((r1->order[0]==ringorder_unspec)
962	&& (r2->order[0]==ringorder_unspec))
963	{
964	tmpR.order=(rRingOrder_t)omAlloc(3sizeof(rRingOrder_t));
965	tmpR.block0=(int)omAlloc(3sizeof(int));
966	tmpR.block1=(int)omAlloc(3sizeof(int));
967	tmpR.wvhdl=(int*)omAlloc0(3sizeof(int *));
968	tmpR.order[0]=ringorder_unspec;
969	tmpR.order[1]=ringorder_C;
970	tmpR.order[2]=(rRingOrder_t)0;
971	tmpR.block0[0]=1;
972	tmpR.block1[0]=tmpR.N;
973	}
974	else if (l==k) /* r3=r1+r2 */
975	{
976	int b;
977	ring rb;
978	if (r1->order[0]==ringorder_unspec)
979	{
980	/* extend order of r2 to r3 */
981	b=rBlocks(r2);
982	rb=r2;
983	tmpR.OrdSgn=r2->OrdSgn;
984	}
985	else if (r2->order[0]==ringorder_unspec)
986	{
987	/* extend order of r1 to r3 */
988	b=rBlocks(r1);
989	rb=r1;
990	tmpR.OrdSgn=r1->OrdSgn;
991	}
992	else
993	{
994	b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
995	rb=NULL;
996	}
997	tmpR.order=(rRingOrder_t)omAlloc0(bsizeof(rRingOrder_t));
998	tmpR.block0=(int)omAlloc0(bsizeof(int));
999	tmpR.block1=(int)omAlloc0(bsizeof(int));
1000	tmpR.wvhdl=(int*)omAlloc0(bsizeof(int *));
1001	/* weights not implemented yet ...*/
1002	if (rb!=NULL)
1003	{
1004	for (i=0;i<b;i++)
1005	{
1006	tmpR.order[i]=rb->order[i];
1007	tmpR.block0[i]=rb->block0[i];
1008	tmpR.block1[i]=rb->block1[i];
1009	if (rb->wvhdl[i]!=NULL)
1010	WarnS("rSum: weights not implemented");
1011	}
1012	tmpR.block0[0]=1;
1013	}
1014	else /* ring sum for complete rings */
1015	{
1016	for (i=0;r1->order[i]!=0;i++)
1017	{
1018	tmpR.order[i]=r1->order[i];
1019	tmpR.block0[i]=r1->block0[i];
1020	tmpR.block1[i]=r1->block1[i];
1021	if (r1->wvhdl[i]!=NULL)
1022	tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1023	}
1024	j=i;
1025	i--;
1026	if ((r1->order[i]==ringorder_c)
1027	\|\|(r1->order[i]==ringorder_C))
1028	{
1029	j--;
1030	tmpR.order[b-2]=r1->order[i];
1031	}
1032	for (i=0;r2->order[i]!=0;i++)
1033	{
1034	if ((r2->order[i]!=ringorder_c)
1035	&&(r2->order[i]!=ringorder_C))
1036	{
1037	tmpR.order[j]=r2->order[i];
1038	tmpR.block0[j]=r2->block0[i]+rVar(r1);
1039	tmpR.block1[j]=r2->block1[i]+rVar(r1);
1040	if (r2->wvhdl[i]!=NULL)
1041	{
1042	tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1043	}
1044	j++;
1045	}
1046	}
1047	if((r1->OrdSgn==-1)\|\|(r2->OrdSgn==-1))
1048	tmpR.OrdSgn=-1;
1049	}
1050	}
1051	else if ((k==rVar(r1)) && (k==rVar(r2))) /* r1 and r2 are "quite"
1052	the same ring */
1053	/* copy r1, because we have the variables from r1 */
1054	{
1055	int b=rBlocks(r1);
1056
1057	tmpR.order=(rRingOrder_t)omAlloc0(bsizeof(rRingOrder_t));
1058	tmpR.block0=(int)omAlloc0(bsizeof(int));
1059	tmpR.block1=(int)omAlloc0(bsizeof(int));
1060	tmpR.wvhdl=(int*)omAlloc0(bsizeof(int *));
1061	/* weights not implemented yet ...*/
1062	for (i=0;i<b;i++)
1063	{
1064	tmpR.order[i]=r1->order[i];
1065	tmpR.block0[i]=r1->block0[i];
1066	tmpR.block1[i]=r1->block1[i];
1067	if (r1->wvhdl[i]!=NULL)
1068	{
1069	tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1070	}
1071	}
1072	tmpR.OrdSgn=r1->OrdSgn;
1073	}
1074	else
1075	{
1076	for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1077	omFreeSize((ADDRESS)names,tmpR.Nsizeof(char ));
1078	Werror("variables must not overlap (# of vars: %d,%d -> %d)",rVar(r1),rVar(r2),k);
1079	return -1;
1080	}
1081	}
1082	tmpR.bitmask=si_max(r1->bitmask,r2->bitmask);
1083	sum=(ring)omAllocBin(sip_sring_bin);
1084	memcpy(sum,&tmpR,sizeof(ip_sring));
1085	rComplete(sum);
1086
1087	//#ifdef RDEBUG
1088	// rDebugPrint(sum);
1089	//#endif
1090
1091
1092
1093	#ifdef HAVE_PLURAL
1094	if(1)
1095	{
1096	// ring old_ring = currRing;
1097
1098	BOOLEAN R1_is_nc = rIsPluralRing(r1);
1099	BOOLEAN R2_is_nc = rIsPluralRing(r2);
1100
1101	if ( (R1_is_nc) \|\| (R2_is_nc))
1102	{
1103	ring R1 = nc_rCreateNCcomm_rCopy(r1);
1104	assume( rIsPluralRing(R1) );
1105
1106	#if 0
1107	#ifdef RDEBUG
1108	rWrite(R1);
1109	rDebugPrint(R1);
1110	#endif
1111	#endif
1112	ring R2 = nc_rCreateNCcomm_rCopy(r2);
1113	#if 0
1114	#ifdef RDEBUG
1115	rWrite(R2);
1116	rDebugPrint(R2);
1117	#endif
1118	#endif
1119
1120	// rChangeCurrRing(sum); // ?
1121
1122	// Projections from R_i into Sum:
1123	/* multiplication matrices business: */
1124	/* find permutations of vars and pars */
1125	int perm1 = (int )omAlloc0((rVar(R1)+1)*sizeof(int));
1126	int *par_perm1 = NULL;
1127	if (rPar(R1)!=0) par_perm1=(int )omAlloc0((rPar(R1)+1)sizeof(int));
1128
1129	int perm2 = (int )omAlloc0((rVar(R2)+1)*sizeof(int));
1130	int *par_perm2 = NULL;
1131	if (rPar(R2)!=0) par_perm2=(int )omAlloc0((rPar(R2)+1)sizeof(int));
1132
1133	maFindPerm(R1->names, rVar(R1), rParameter(R1), rPar(R1),
1134	sum->names, rVar(sum), rParameter(sum), rPar(sum),
1135	perm1, par_perm1, sum->cf->type);
1136
1137	maFindPerm(R2->names, rVar(R2), rParameter(R2), rPar(R2),
1138	sum->names, rVar(sum), rParameter(sum), rPar(sum),
1139	perm2, par_perm2, sum->cf->type);
1140
1141
1142	matrix C1 = R1->GetNC()->C, C2 = R2->GetNC()->C;
1143	matrix D1 = R1->GetNC()->D, D2 = R2->GetNC()->D;
1144
1145	// !!!! BUG? C1 and C2 might live in different baserings!!!
1146
1147	int l = rVar(R1) + rVar(R2);
1148
1149	matrix C = mpNew(l,l);
1150	matrix D = mpNew(l,l);
1151
1152	for (i = 1; i <= rVar(R1); i++)
1153	for (j= rVar(R1)+1; j <= l; j++)
1154	MATELEM(C,i,j) = p_One(sum); // in 'sum'
1155
1156	id_Test((ideal)C, sum);
1157
1158	nMapFunc nMap1 = n_SetMap(R1->cf,sum->cf); /* can change something global: not usable
1159	after the next nSetMap call :( */
1160	// Create blocked C and D matrices:
1161	for (i=1; i<= rVar(R1); i++)
1162	for (j=i+1; j<=rVar(R1); j++)
1163	{
1164	assume(MATELEM(C1,i,j) != NULL);
1165	MATELEM(C,i,j) = p_PermPoly(MATELEM(C1,i,j), perm1, R1, sum, nMap1, par_perm1, rPar(R1)); // need ADD + CMP ops.
1166
1167	if (MATELEM(D1,i,j) != NULL)
1168	MATELEM(D,i,j) = p_PermPoly(MATELEM(D1,i,j), perm1, R1, sum, nMap1, par_perm1, rPar(R1));
1169	}
1170
1171	id_Test((ideal)C, sum);
1172	id_Test((ideal)D, sum);
1173
1174
1175	nMapFunc nMap2 = n_SetMap(R2->cf,sum->cf); /* can change something global: not usable
1176	after the next nSetMap call :( */
1177	for (i=1; i<= rVar(R2); i++)
1178	for (j=i+1; j<=rVar(R2); j++)
1179	{
1180	assume(MATELEM(C2,i,j) != NULL);
1181	MATELEM(C,rVar(R1)+i,rVar(R1)+j) = p_PermPoly(MATELEM(C2,i,j),perm2,R2,sum, nMap2,par_perm2,rPar(R2));
1182
1183	if (MATELEM(D2,i,j) != NULL)
1184	MATELEM(D,rVar(R1)+i,rVar(R1)+j) = p_PermPoly(MATELEM(D2,i,j),perm2,R2,sum, nMap2,par_perm2,rPar(R2));
1185	}
1186
1187	id_Test((ideal)C, sum);
1188	id_Test((ideal)D, sum);
1189
1190	// Now sum is non-commutative with blocked structure constants!
1191	if (nc_CallPlural(C, D, NULL, NULL, sum, false, false, true, sum))
1192	WarnS("Error initializing non-commutative multiplication!");
1193
1194	/* delete R1, R2*/
1195
1196	#if 0
1197	#ifdef RDEBUG
1198	rWrite(sum);
1199	rDebugPrint(sum);
1200
1201	Print("\nRefs: R1: %d, R2: %d\n", R1->GetNC()->ref, R2->GetNC()->ref);
1202
1203	#endif
1204	#endif
1205
1206
1207	rDelete(R1);
1208	rDelete(R2);
1209
1210	/* delete perm arrays */
1211	if (perm1!=NULL) omFree((ADDRESS)perm1);
1212	if (perm2!=NULL) omFree((ADDRESS)perm2);
1213	if (par_perm1!=NULL) omFree((ADDRESS)par_perm1);
1214	if (par_perm2!=NULL) omFree((ADDRESS)par_perm2);
1215
1216	// rChangeCurrRing(old_ring);
1217	}
1218
1219	}
1220	#endif
1221
1222	ideal Q=NULL;
1223	ideal Q1=NULL, Q2=NULL;
1224	if (r1->qideal!=NULL)
1225	{
1226	// rChangeCurrRing(sum);
1227	// if (r2->qideal!=NULL)
1228	// {
1229	// WerrorS("todo: qring+qring");
1230	// return -1;
1231	// }
1232	// else
1233	// {}
1234	/* these were defined in the Plural Part above... */
1235	int perm1 = (int )omAlloc0((rVar(r1)+1)*sizeof(int));
1236	int *par_perm1 = NULL;
1237	if (rPar(r1)!=0) par_perm1=(int )omAlloc0((rPar(r1)+1)sizeof(int));
1238	maFindPerm(r1->names, rVar(r1), rParameter(r1), rPar(r1),
1239	sum->names, rVar(sum), rParameter(sum), rPar(sum),
1240	perm1, par_perm1, sum->cf->type);
1241	nMapFunc nMap1 = n_SetMap(r1->cf,sum->cf);
1242	Q1 = idInit(IDELEMS(r1->qideal),1);
1243
1244	for (int for_i=0;for_i<IDELEMS(r1->qideal);for_i++)
1245	Q1->m[for_i] = p_PermPoly(
1246	r1->qideal->m[for_i], perm1,
1247	r1, sum,
1248	nMap1,
1249	par_perm1, rPar(r1));
1250
1251	omFree((ADDRESS)perm1);
1252	}
1253
1254	if (r2->qideal!=NULL)
1255	{
1256	//if (currRing!=sum)
1257	// rChangeCurrRing(sum);
1258	int perm2 = (int )omAlloc0((rVar(r2)+1)*sizeof(int));
1259	int *par_perm2 = NULL;
1260	if (rPar(r2)!=0) par_perm2=(int )omAlloc0((rPar(r2)+1)sizeof(int));
1261	maFindPerm(r2->names, rVar(r2), rParameter(r2), rPar(r2),
1262	sum->names, rVar(sum), rParameter(sum), rPar(sum),
1263	perm2, par_perm2, sum->cf->type);
1264	nMapFunc nMap2 = n_SetMap(r2->cf,sum->cf);
1265	Q2 = idInit(IDELEMS(r2->qideal),1);
1266
1267	for (int for_i=0;for_i<IDELEMS(r2->qideal);for_i++)
1268	Q2->m[for_i] = p_PermPoly(
1269	r2->qideal->m[for_i], perm2,
1270	r2, sum,
1271	nMap2,
1272	par_perm2, rPar(r2));
1273
1274	omFree((ADDRESS)perm2);
1275	}
1276	if (Q1!=NULL)
1277	{
1278	if ( Q2!=NULL)
1279	Q = id_SimpleAdd(Q1,Q2,sum);
1280	else
1281	Q=id_Copy(Q1,sum);
1282	}
1283	else
1284	{
1285	if ( Q2!=NULL)
1286	Q = id_Copy(Q2,sum);
1287	else
1288	Q=NULL;
1289	}
1290	sum->qideal = Q;
1291
1292	#ifdef HAVE_PLURAL
1293	if( rIsPluralRing(sum) )
1294	nc_SetupQuotient( sum );
1295	#endif
1296	return 1;
1297	}
1298
1299	/*2
1300	*returns -1 for not compatible, (sum is undefined)
1301	* 0 for equal, (and sum)
1302	* 1 for compatible (and sum)
1303	*/
1304	int rSum(ring r1, ring r2, ring &sum)
1305	{
1306	if ((r1==NULL)\|\|(r2==NULL)
1307	\|\|(r1->cf==NULL)\|\|(r2->cf==NULL))
1308	return -1;
1309	if (r1==r2)
1310	{
1311	sum=r1;
1312	r1->ref++;
1313	return 0;
1314	}
1315	return rSumInternal(r1,r2,sum,TRUE,FALSE);
1316	}
1317
1318	/*2
1319	* create a copy of the ring r
1320	* used for qring definition,..
1321	* DOES NOT CALL rComplete
1322	*/
1323	ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
1324	{
1325	if (r == NULL) return NULL;
1326	int i,j;
1327	ring res=(ring)omAlloc0Bin(sip_sring_bin);
1328	//memset: res->idroot=NULL; /* local objects */
1329	//ideal minideal;
1330	res->options=r->options; /* ring dependent options */
1331
1332	//memset: res->ordsgn=NULL;
1333	//memset: res->typ=NULL;
1334	//memset: res->VarOffset=NULL;
1335	//memset: res->firstwv=NULL;
1336
1337	//struct omBin PolyBin; /* Bin from where monoms are allocated */
1338	//memset: res->PolyBin=NULL; // rComplete
1339	res->cf=nCopyCoeff(r->cf); /* coeffs */
1340
1341	//memset: res->ref=0; /* reference counter to the ring */
1342
1343	res->N=rVar(r); /* number of vars */
1344
1345	res->firstBlockEnds=r->firstBlockEnds;
1346	#ifdef HAVE_PLURAL
1347	res->real_var_start=r->real_var_start;
1348	res->real_var_end=r->real_var_end;
1349	#endif
1350
1351	#ifdef HAVE_SHIFTBBA
1352	res->isLPring=r->isLPring; /* 0 for non-letterplace rings, otherwise the number of LP blocks, at least 1, known also as lV */
1353	#endif
1354
1355	res->VectorOut=r->VectorOut;
1356	res->ShortOut=r->ShortOut;
1357	res->CanShortOut=r->CanShortOut;
1358
1359	//memset: res->ExpL_Size=0;
1360	//memset: res->CmpL_Size=0;
1361	//memset: res->VarL_Size=0;
1362	//memset: res->pCompIndex=0;
1363	//memset: res->pOrdIndex=0;
1364	//memset: res->OrdSize=0;
1365	//memset: res->VarL_LowIndex=0;
1366	//memset: res->NegWeightL_Size=0;
1367	//memset: res->NegWeightL_Offset=NULL;
1368	//memset: res->VarL_Offset=NULL;
1369
1370	// the following are set by rComplete unless predefined
1371	// therefore, we copy these values: maybe they are non-standard
1372	/* mask for getting single exponents */
1373	res->bitmask=r->bitmask;
1374	res->divmask=r->divmask;
1375	res->BitsPerExp = r->BitsPerExp;
1376	res->ExpPerLong = r->ExpPerLong;
1377
1378	//memset: res->p_Procs=NULL;
1379	//memset: res->pFDeg=NULL;
1380	//memset: res->pLDeg=NULL;
1381	//memset: res->pFDegOrig=NULL;
1382	//memset: res->pLDegOrig=NULL;
1383	//memset: res->p_Setm=NULL;
1384	//memset: res->cf=NULL;
1385
1386	/*
1387	if (r->extRing!=NULL)
1388	r->extRing->ref++;
1389
1390	res->extRing=r->extRing;
1391	//memset: res->qideal=NULL;
1392	*/
1393
1394
1395	if (copy_ordering == TRUE)
1396	{
1397	res->LexOrder=r->LexOrder; // TRUE if the monomial ordering has polynomial and power series blocks
1398	res->MixedOrder=r->MixedOrder; // TRUE for mixed (global/local) ordering, FALSE otherwise,
1399	i=rBlocks(r);
1400	res->wvhdl = (int *)omAlloc(i sizeof(int *));
1401	res->order = (rRingOrder_t ) omAlloc(i sizeof(rRingOrder_t));
1402	res->block0 = (int ) omAlloc(i sizeof(int));
1403	res->block1 = (int ) omAlloc(i sizeof(int));
1404	for (j=0; j<i; j++)
1405	{
1406	if (r->wvhdl[j]!=NULL)
1407	{
1408	res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1409	}
1410	else
1411	res->wvhdl[j]=NULL;
1412	}
1413	memcpy(res->order,r->order,i * sizeof(rRingOrder_t));
1414	memcpy(res->block0,r->block0,i * sizeof(int));
1415	memcpy(res->block1,r->block1,i * sizeof(int));
1416	}
1417	//memset: else
1418	//memset: {
1419	//memset: res->wvhdl = NULL;
1420	//memset: res->order = NULL;
1421	//memset: res->block0 = NULL;
1422	//memset: res->block1 = NULL;
1423	//memset: }
1424
1425	res->names = (char *)omAlloc0(rVar(r) sizeof(char *));
1426	for (i=0; i<rVar(res); i++)
1427	{
1428	res->names[i] = omStrDup(r->names[i]);
1429	}
1430	if (r->qideal!=NULL)
1431	{
1432	if (copy_qideal)
1433	{
1434	#ifndef SING_NDEBUG
1435	if (!copy_ordering)
1436	WerrorS("internal error: rCopy0(Q,TRUE,FALSE)");
1437	else
1438	#endif
1439	{
1440	#ifndef SING_NDEBUG
1441	WarnS("internal bad stuff: rCopy0(Q,TRUE,TRUE)");
1442	#endif
1443	rComplete(res);
1444	res->qideal= idrCopyR_NoSort(r->qideal, r, res);
1445	rUnComplete(res);
1446	}
1447	}
1448	//memset: else res->qideal = NULL;
1449	}
1450	//memset: else res->qideal = NULL;
1451	//memset: res->GetNC() = NULL; // copy is purely commutative!!!
1452	return res;
1453	}
1454
1455	/*2
1456	* create a copy of the ring r
1457	* used for qring definition,..
1458	* DOES NOT CALL rComplete
1459	*/
1460	ring rCopy0AndAddA(const ring r, int64vec *wv64, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
1461	{
1462	if (r == NULL) return NULL;
1463	int i,j;
1464	ring res=(ring)omAlloc0Bin(sip_sring_bin);
1465	//memcpy(res,r,sizeof(ip_sring));
1466	//memset: res->idroot=NULL; /* local objects */
1467	//ideal minideal;
1468	res->options=r->options; /* ring dependent options */
1469
1470	//memset: res->ordsgn=NULL;
1471	//memset: res->typ=NULL;
1472	//memset: res->VarOffset=NULL;
1473	//memset: res->firstwv=NULL;
1474
1475	//struct omBin PolyBin; /* Bin from where monoms are allocated */
1476	//memset: res->PolyBin=NULL; // rComplete
1477	res->cf=nCopyCoeff(r->cf); /* coeffs */
1478
1479	//memset: res->ref=0; /* reference counter to the ring */
1480
1481	res->N=rVar(r); /* number of vars */
1482
1483	res->firstBlockEnds=r->firstBlockEnds;
1484	#ifdef HAVE_PLURAL
1485	res->real_var_start=r->real_var_start;
1486	res->real_var_end=r->real_var_end;
1487	#endif
1488
1489	#ifdef HAVE_SHIFTBBA
1490	res->isLPring=r->isLPring; /* 0 for non-letterplace rings, otherwise the number of LP blocks, at least 1, known also as lV */
1491	#endif
1492
1493	res->VectorOut=r->VectorOut;
1494	res->ShortOut=r->ShortOut;
1495	res->CanShortOut=r->CanShortOut;
1496	res->LexOrder=r->LexOrder; // TRUE if the monomial ordering has polynomial and power series blocks
1497	res->MixedOrder=r->MixedOrder; // TRUE for mixed (global/local) ordering, FALSE otherwise,
1498
1499	//memset: res->ExpL_Size=0;
1500	//memset: res->CmpL_Size=0;
1501	//memset: res->VarL_Size=0;
1502	//memset: res->pCompIndex=0;
1503	//memset: res->pOrdIndex=0;
1504	//memset: res->OrdSize=0;
1505	//memset: res->VarL_LowIndex=0;
1506	//memset: res->NegWeightL_Size=0;
1507	//memset: res->NegWeightL_Offset=NULL;
1508	//memset: res->VarL_Offset=NULL;
1509
1510	// the following are set by rComplete unless predefined
1511	// therefore, we copy these values: maybe they are non-standard
1512	/* mask for getting single exponents */
1513	res->bitmask=r->bitmask;
1514	res->divmask=r->divmask;
1515	res->BitsPerExp = r->BitsPerExp;
1516	res->ExpPerLong = r->ExpPerLong;
1517
1518	//memset: res->p_Procs=NULL;
1519	//memset: res->pFDeg=NULL;
1520	//memset: res->pLDeg=NULL;
1521	//memset: res->pFDegOrig=NULL;
1522	//memset: res->pLDegOrig=NULL;
1523	//memset: res->p_Setm=NULL;
1524	//memset: res->cf=NULL;
1525
1526	/*
1527	if (r->extRing!=NULL)
1528	r->extRing->ref++;
1529
1530	res->extRing=r->extRing;
1531	//memset: res->qideal=NULL;
1532	*/
1533
1534
1535	if (copy_ordering == TRUE)
1536	{
1537	i=rBlocks(r)+1; // DIFF to rCopy0
1538	res->wvhdl = (int *)omAlloc(i sizeof(int *));
1539	res->order = (rRingOrder_t ) omAlloc(i sizeof(rRingOrder_t));
1540	res->block0 = (int ) omAlloc(i sizeof(int));
1541	res->block1 = (int ) omAlloc(i sizeof(int));
1542	for (j=0; j<i-1; j++)
1543	{
1544	if (r->wvhdl[j]!=NULL)
1545	{
1546	res->wvhdl[j+1] = (int*) omMemDup(r->wvhdl[j]); //DIFF
1547	}
1548	else
1549	res->wvhdl[j+1]=NULL; //DIFF
1550	}
1551	memcpy(&(res->order[1]),r->order,(i-1) * sizeof(rRingOrder_t)); //DIFF
1552	memcpy(&(res->block0[1]),r->block0,(i-1) * sizeof(int)); //DIFF
1553	memcpy(&(res->block1[1]),r->block1,(i-1) * sizeof(int)); //DIFF
1554	}
1555	//memset: else
1556	//memset: {
1557	//memset: res->wvhdl = NULL;
1558	//memset: res->order = NULL;
1559	//memset: res->block0 = NULL;
1560	//memset: res->block1 = NULL;
1561	//memset: }
1562
1563	//the added A
1564	res->order[0]=ringorder_a64;
1565	int length=wv64->rows();
1566	int64 A=(int64 )omAlloc(length*sizeof(int64));
1567	for(j=length-1;j>=0;j--)
1568	{
1569	A[j]=(*wv64)[j];
1570	}
1571	res->wvhdl[0]=(int *)A;
1572	res->block0[0]=1;
1573	res->block1[0]=length;
1574	//
1575
1576	res->names = (char *)omAlloc0(rVar(r) sizeof(char *));
1577	for (i=0; i<rVar(res); i++)
1578	{
1579	res->names[i] = omStrDup(r->names[i]);
1580	}
1581	if (r->qideal!=NULL)
1582	{
1583	if (copy_qideal)
1584	{
1585	#ifndef SING_NDEBUG
1586	if (!copy_ordering)
1587	WerrorS("internal error: rCopy0(Q,TRUE,FALSE)");
1588	else
1589	#endif
1590	{
1591	#ifndef SING_NDEBUG
1592	WarnS("internal bad stuff: rCopy0(Q,TRUE,TRUE)");
1593	#endif
1594	rComplete(res);
1595	res->qideal= idrCopyR_NoSort(r->qideal, r, res);
1596	rUnComplete(res);
1597	}
1598	}
1599	//memset: else res->qideal = NULL;
1600	}
1601	//memset: else res->qideal = NULL;
1602	//memset: res->GetNC() = NULL; // copy is purely commutative!!!
1603	return res;
1604	}
1605
1606	/*2
1607	* create a copy of the ring r, which must be equivalent to currRing
1608	* used for qring definition,..
1609	* (i.e.: normal rings: same nCopy as currRing;
1610	* qring: same nCopy, same idCopy as currRing)
1611	*/
1612	ring rCopy(ring r)
1613	{
1614	if (r == NULL) return NULL;
1615	ring res=rCopy0(r,FALSE,TRUE);
1616	rComplete(res, 1); // res is purely commutative so far
1617	if (r->qideal!=NULL) res->qideal=idrCopyR_NoSort(r->qideal, r, res);
1618
1619	#ifdef HAVE_PLURAL
1620	if (rIsPluralRing(r))
1621	if( nc_rCopy(res, r, true) ) {}
1622	#endif
1623
1624	return res;
1625	}
1626
1627	BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1628	{
1629	if (r1 == r2) return TRUE;
1630	if (r1 == NULL \|\| r2 == NULL) return FALSE;
1631	if (r1->cf!=r2->cf) return FALSE;
1632	if (rVar(r1)!=rVar(r2)) return FALSE;
1633
1634	if( !rSamePolyRep(r1, r2) )
1635	return FALSE;
1636
1637	int i/, j/;
1638
1639	for (i=0; i<rVar(r1); i++)
1640	{
1641	if ((r1->names[i] != NULL) && (r2->names[i] != NULL))
1642	{
1643	if (strcmp(r1->names[i], r2->names[i])) return FALSE;
1644	}
1645	else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1646	{
1647	return FALSE;
1648	}
1649	}
1650
1651	if (qr)
1652	{
1653	if (r1->qideal != NULL)
1654	{
1655	ideal id1 = r1->qideal, id2 = r2->qideal;
1656	int i, n;
1657	poly m1, m2;
1658
1659	if (id2 == NULL) return FALSE;
1660	if ((n = IDELEMS(id1)) != IDELEMS(id2)) return FALSE;
1661
1662	{
1663	m1 = id1->m;
1664	m2 = id2->m;
1665	for (i=0; i<n; i++)
1666	if (! p_EqualPolys(m1[i],m2[i], r1, r2)) return FALSE;
1667	}
1668	}
1669	else if (r2->qideal != NULL) return FALSE;
1670	}
1671
1672	return TRUE;
1673	}
1674
1675	BOOLEAN rSamePolyRep(ring r1, ring r2)
1676	{
1677	int i, j;
1678
1679	if (r1 == r2) return TRUE;
1680
1681	if (r1 == NULL \|\| r2 == NULL) return FALSE;
1682
1683	if ((r1->cf != r2->cf)
1684	\|\| (rVar(r1) != rVar(r2))
1685	\|\| (r1->OrdSgn != r2->OrdSgn))
1686	return FALSE;
1687
1688	i=0;
1689	while (r1->order[i] != 0)
1690	{
1691	if (r2->order[i] == 0) return FALSE;
1692	if ((r1->order[i] != r2->order[i])
1693	\|\| (r1->block0[i] != r2->block0[i])
1694	\|\| (r1->block1[i] != r2->block1[i]))
1695	return FALSE;
1696	if (r1->wvhdl[i] != NULL)
1697	{
1698	if (r2->wvhdl[i] == NULL)
1699	return FALSE;
1700	for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1701	if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1702	return FALSE;
1703	}
1704	else if (r2->wvhdl[i] != NULL) return FALSE;
1705	i++;
1706	}
1707	if (r2->order[i] != 0) return FALSE;
1708
1709	// we do not check variable names
1710	// we do not check minpoly/minideal
1711	// we do not check qideal
1712
1713	return TRUE;
1714	}
1715
1716	rOrderType_t rGetOrderType(ring r)
1717	{
1718	// check for simple ordering
1719	if (rHasSimpleOrder(r))
1720	{
1721	if ((r->order[1] == ringorder_c)
1722	\|\| (r->order[1] == ringorder_C))
1723	{
1724	switch(r->order[0])
1725	{
1726	case ringorder_dp:
1727	case ringorder_wp:
1728	case ringorder_ds:
1729	case ringorder_ws:
1730	case ringorder_ls:
1731	case ringorder_unspec:
1732	if (r->order[1] == ringorder_C
1733	\|\| r->order[0] == ringorder_unspec)
1734	return rOrderType_ExpComp;
1735	return rOrderType_Exp;
1736
1737	default:
1738	assume(r->order[0] == ringorder_lp \|\|
1739	r->order[0] == ringorder_rs \|\|
1740	r->order[0] == ringorder_Dp \|\|
1741	r->order[0] == ringorder_Wp \|\|
1742	r->order[0] == ringorder_Ds \|\|
1743	r->order[0] == ringorder_Ws);
1744
1745	if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1746	return rOrderType_Exp;
1747	}
1748	}
1749	else
1750	{
1751	assume((r->order[0]==ringorder_c)\|\|(r->order[0]==ringorder_C));
1752	return rOrderType_CompExp;
1753	}
1754	}
1755	else
1756	return rOrderType_General;
1757	}
1758
1759	BOOLEAN rHas_c_Ordering(const ring r)
1760	{
1761	return (r->order[0] == ringorder_c);
1762	}
1763	BOOLEAN rHasSimpleOrder(const ring r)
1764	{
1765	if (r->order[0] == ringorder_unspec) return TRUE;
1766	int blocks = rBlocks(r) - 1;
1767	assume(blocks >= 1);
1768	if (blocks == 1) return TRUE;
1769
1770	int s = 0;
1771	while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1772	{
1773	s++;
1774	blocks--;
1775	}
1776
1777	if ((blocks - s) > 2) return FALSE;
1778
1779	assume( blocks == s + 2 );
1780
1781	if (
1782	(r->order[s] != ringorder_c)
1783	&& (r->order[s] != ringorder_C)
1784	&& (r->order[s+1] != ringorder_c)
1785	&& (r->order[s+1] != ringorder_C)
1786	)
1787	return FALSE;
1788	if ((r->order[s+1] == ringorder_M)
1789	\|\| (r->order[s] == ringorder_M))
1790	return FALSE;
1791	return TRUE;
1792	}
1793
1794	// returns TRUE, if simple lp or ls ordering
1795	BOOLEAN rHasSimpleLexOrder(const ring r)
1796	{
1797	return rHasSimpleOrder(r) &&
1798	(r->order[0] == ringorder_ls \|\|
1799	r->order[0] == ringorder_lp \|\|
1800	r->order[1] == ringorder_ls \|\|
1801	r->order[1] == ringorder_lp);
1802	}
1803
1804	BOOLEAN rOrder_is_DegOrdering(const rRingOrder_t order)
1805	{
1806	switch(order)
1807	{
1808	case ringorder_dp:
1809	case ringorder_Dp:
1810	case ringorder_ds:
1811	case ringorder_Ds:
1812	case ringorder_Ws:
1813	case ringorder_Wp:
1814	case ringorder_ws:
1815	case ringorder_wp:
1816	return TRUE;
1817
1818	default:
1819	return FALSE;
1820	}
1821	}
1822
1823	BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1824	{
1825	switch(order)
1826	{
1827	case ringorder_Ws:
1828	case ringorder_Wp:
1829	case ringorder_ws:
1830	case ringorder_wp:
1831	return TRUE;
1832
1833	default:
1834	return FALSE;
1835	}
1836	}
1837
1838	BOOLEAN rHasSimpleOrderAA(ring r)
1839	{
1840	if (r->order[0] == ringorder_unspec) return TRUE;
1841	int blocks = rBlocks(r) - 1;
1842	assume(blocks >= 1);
1843	if (blocks == 1) return TRUE;
1844
1845	int s = 0;
1846	while( (s < blocks) && (r->order[s] == ringorder_IS) && (r->order[blocks-1] == ringorder_IS) )
1847	{
1848	s++;
1849	blocks--;
1850	}
1851
1852	if ((blocks - s) > 3) return FALSE;
1853
1854	// if ((blocks > 3) \|\| (blocks < 2)) return FALSE;
1855	if ((blocks - s) == 3)
1856	{
1857	return (((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M) &&
1858	((r->order[s+2] == ringorder_c) \|\| (r->order[s+2] == ringorder_C))) \|\|
1859	(((r->order[s] == ringorder_c) \|\| (r->order[s] == ringorder_C)) &&
1860	(r->order[s+1] == ringorder_aa) && (r->order[s+2] != ringorder_M)));
1861	}
1862	else
1863	{
1864	return ((r->order[s] == ringorder_aa) && (r->order[s+1] != ringorder_M));
1865	}
1866	}
1867
1868	// return TRUE if p_SetComp requires p_Setm
1869	BOOLEAN rOrd_SetCompRequiresSetm(const ring r)
1870	{
1871	if (r->typ != NULL)
1872	{
1873	int pos;
1874	for (pos=0;pos<r->OrdSize;pos++)
1875	{
1876	sro_ord* o=&(r->typ[pos]);
1877	if ( (o->ord_typ == ro_syzcomp)
1878	\|\| (o->ord_typ == ro_syz)
1879	\|\| (o->ord_typ == ro_is)
1880	\|\| (o->ord_typ == ro_am)
1881	\|\| (o->ord_typ == ro_isTemp))
1882	return TRUE;
1883	}
1884	}
1885	return FALSE;
1886	}
1887
1888	// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
1889	BOOLEAN rOrd_is_Totaldegree_Ordering(const ring r)
1890	{
1891	// Hmm.... what about Syz orderings?
1892	return (rVar(r) > 1 &&
1893	((rHasSimpleOrder(r) &&
1894	(rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) \|\|
1895	rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) \|\|
1896	(rHasSimpleOrderAA(r) &&
1897	(rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) \|\|
1898	rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
1899	}
1900
1901	// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
1902	BOOLEAN rOrd_is_WeightedDegree_Ordering(const ring r )
1903	{
1904	// Hmm.... what about Syz orderings?
1905	return ((rVar(r) > 1) &&
1906	rHasSimpleOrder(r) &&
1907	(rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) \|\|
1908	rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
1909	}
1910
1911	BOOLEAN rIsPolyVar(int v,const ring r)
1912	{
1913	int i=0;
1914	while(r->order[i]!=0)
1915	{
1916	if((r->block0[i]<=v)
1917	&& (r->block1[i]>=v))
1918	{
1919	switch(r->order[i])
1920	{
1921	case ringorder_a:
1922	return (r->wvhdl[i][v-r->block0[i]]>0);
1923	case ringorder_M:
1924	return 2; /don't know/
1925	case ringorder_a64: /* assume: all weight are non-negative!*/
1926	case ringorder_lp:
1927	case ringorder_rs:
1928	case ringorder_dp:
1929	case ringorder_Dp:
1930	case ringorder_wp:
1931	case ringorder_Wp:
1932	return TRUE;
1933	case ringorder_ls:
1934	case ringorder_ds:
1935	case ringorder_Ds:
1936	case ringorder_ws:
1937	case ringorder_Ws:
1938	return FALSE;
1939	default:
1940	break;
1941	}
1942	}
1943	i++;
1944	}
1945	return 3; /* could not find var v*/
1946	}
1947
1948	#ifdef RDEBUG
1949	// This should eventually become a full-fledge ring check, like pTest
1950	BOOLEAN rDBTest(ring r, const char* fn, const int l)
1951	{
1952	int i,j;
1953
1954	if (r == NULL)
1955	{
1956	dReportError("Null ring in %s:%d", fn, l);
1957	return FALSE;
1958	}
1959
1960
1961	if (r->N == 0) return TRUE;
1962
1963	if ((r->OrdSgn!=1) && (r->OrdSgn!= -1))
1964	{
1965	dReportError("missing OrdSgn in %s:%d", fn, l);
1966	return FALSE;
1967	}
1968
1969	// omCheckAddrSize(r,sizeof(ip_sring));
1970	#if OM_CHECK > 0
1971	i=rBlocks(r);
1972	omCheckAddrSize(r->order,i*sizeof(int));
1973	omCheckAddrSize(r->block0,i*sizeof(int));
1974	omCheckAddrSize(r->block1,i*sizeof(int));
1975	for(int j=0;j<=i;j++)
1976	{
1977	if((r->order[j]<0)\|\|(r->order[j]>ringorder_unspec))
1978	dError("wrong order in r->order");
1979	}
1980	if (r->wvhdl!=NULL)
1981	{
1982	omCheckAddrSize(r->wvhdl,isizeof(int ));
1983	for (j=0;j<i; j++)
1984	{
1985	if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
1986	}
1987	}
1988	#endif
1989	if (r->VarOffset == NULL)
1990	{
1991	dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
1992	return FALSE;
1993	}
1994	omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
1995
1996	if ((r->OrdSize==0)!=(r->typ==NULL))
1997	{
1998	dReportError("mismatch OrdSize and typ-pointer in %s:%d");
1999	return FALSE;
2000	}
2001	omcheckAddrSize(r->typ,r->OrdSizesizeof((r->typ)));
2002	omCheckAddrSize(r->VarOffset,(r->N+1)sizeof((r->VarOffset)));
2003	// test assumptions:
2004	for(i=0;i<=r->N;i++) // for all variables (i = 0..N)
2005	{
2006	if(r->typ!=NULL)
2007	{
2008	for(j=0;j<r->OrdSize;j++) // for all ordering blocks (j =0..OrdSize-1)
2009	{
2010	if(r->typ[j].ord_typ == ro_isTemp)
2011	{
2012	const int p = r->typ[j].data.isTemp.suffixpos;
2013
2014	if(p <= j)
2015	dReportError("ordrec prefix %d is unmatched",j);
2016
2017	assume( p < r->OrdSize );
2018
2019	if(r->typ[p].ord_typ != ro_is)
2020	dReportError("ordrec prefix %d is unmatched (suffix: %d is wrong!!!)",j, p);
2021
2022	// Skip all intermediate blocks for undone variables:
2023	if(r->typ[j].data.isTemp.pVarOffset[i] != -1) // Check i^th variable
2024	{
2025	j = p - 1; // SKIP ALL INTERNAL BLOCKS...???
2026	continue; // To make for check OrdSize bound...
2027	}
2028	}
2029	else if (r->typ[j].ord_typ == ro_is)
2030	{
2031	// Skip all intermediate blocks for undone variables:
2032	if(r->typ[j].data.is.pVarOffset[i] != -1)
2033	{
2034	// TODO???
2035	}
2036
2037	}
2038	else
2039	{
2040	if (r->typ[j].ord_typ==ro_cp)
2041	{
2042	if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2043	dReportError("ordrec %d conflicts with var %d",j,i);
2044	}
2045	else
2046	if ((r->typ[j].ord_typ!=ro_syzcomp)
2047	&& (r->VarOffset[i] == r->typ[j].data.dp.place))
2048	dReportError("ordrec %d conflicts with var %d",j,i);
2049	}
2050	}
2051	}
2052	int tmp;
2053	tmp=r->VarOffset[i] & 0xffffff;
2054	#if SIZEOF_LONG == 8
2055	if ((r->VarOffset[i] >> 24) >63)
2056	#else
2057	if ((r->VarOffset[i] >> 24) >31)
2058	#endif
2059	dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
2060	if (i > 0 && ((tmp<0) \|\|(tmp>r->ExpL_Size-1)))
2061	{
2062	dReportError("varoffset out of range for var %d: %d",i,tmp);
2063	}
2064	}
2065	if(r->typ!=NULL)
2066	{
2067	for(j=0;j<r->OrdSize;j++)
2068	{
2069	if ((r->typ[j].ord_typ==ro_dp)
2070	\|\| (r->typ[j].ord_typ==ro_wp)
2071	\|\| (r->typ[j].ord_typ==ro_wp_neg))
2072	{
2073	if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2074	dReportError("in ordrec %d: start(%d) > end(%d)",j,
2075	r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2076	if ((r->typ[j].data.dp.start < 1)
2077	\|\| (r->typ[j].data.dp.end > r->N))
2078	dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
2079	r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2080	}
2081	}
2082	}
2083
2084	assume(r != NULL);
2085	assume(r->cf != NULL);
2086
2087	if (nCoeff_is_algExt(r->cf))
2088	{
2089	assume(r->cf->extRing != NULL);
2090	assume(r->cf->extRing->qideal != NULL);
2091	omCheckAddr(r->cf->extRing->qideal->m[0]);
2092	}
2093
2094	//assume(r->cf!=NULL);
2095
2096	return TRUE;
2097	}
2098	#endif
2099
2100	static void rO_Align(int &place, int &bitplace)
2101	{
2102	// increment place to the next aligned one
2103	// (count as Exponent_t,align as longs)
2104	if (bitplace!=BITS_PER_LONG)
2105	{
2106	place++;
2107	bitplace=BITS_PER_LONG;
2108	}
2109	}
2110
2111	static void rO_TDegree(int &place, int &bitplace, int start, int end,
2112	long *o, sro_ord &ord_struct)
2113	{
2114	// degree (aligned) of variables v_start..v_end, ordsgn 1
2115	rO_Align(place,bitplace);
2116	ord_struct.ord_typ=ro_dp;
2117	ord_struct.data.dp.start=start;
2118	ord_struct.data.dp.end=end;
2119	ord_struct.data.dp.place=place;
2120	o[place]=1;
2121	place++;
2122	rO_Align(place,bitplace);
2123	}
2124
2125	static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2126	long *o, sro_ord &ord_struct)
2127	{
2128	// degree (aligned) of variables v_start..v_end, ordsgn -1
2129	rO_Align(place,bitplace);
2130	ord_struct.ord_typ=ro_dp;
2131	ord_struct.data.dp.start=start;
2132	ord_struct.data.dp.end=end;
2133	ord_struct.data.dp.place=place;
2134	o[place]=-1;
2135	place++;
2136	rO_Align(place,bitplace);
2137	}
2138
2139	static void rO_WDegree(int &place, int &bitplace, int start, int end,
2140	long o, sro_ord &ord_struct, int weights)
2141	{
2142	// weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2143	while((start<end) && (weights[0]==0)) { start++; weights++; }
2144	while((start<end) && (weights[end-start]==0)) { end--; }
2145	int i;
2146	int pure_tdeg=1;
2147	for(i=start;i<=end;i++)
2148	{
2149	if(weights[i-start]!=1)
2150	{
2151	pure_tdeg=0;
2152	break;
2153	}
2154	}
2155	if (pure_tdeg)
2156	{
2157	rO_TDegree(place,bitplace,start,end,o,ord_struct);
2158	return;
2159	}
2160	rO_Align(place,bitplace);
2161	ord_struct.ord_typ=ro_wp;
2162	ord_struct.data.wp.start=start;
2163	ord_struct.data.wp.end=end;
2164	ord_struct.data.wp.place=place;
2165	ord_struct.data.wp.weights=weights;
2166	o[place]=1;
2167	place++;
2168	rO_Align(place,bitplace);
2169	for(i=start;i<=end;i++)
2170	{
2171	if(weights[i-start]<0)
2172	{
2173	ord_struct.ord_typ=ro_wp_neg;
2174	break;
2175	}
2176	}
2177	}
2178
2179	static void rO_WMDegree(int &place, int &bitplace, int start, int end,
2180	long o, sro_ord &ord_struct, int weights)
2181	{
2182	assume(weights != NULL);
2183
2184	// weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2185	// while((start<end) && (weights[0]==0)) { start++; weights++; }
2186	// while((start<end) && (weights[end-start]==0)) { end--; }
2187	rO_Align(place,bitplace);
2188	ord_struct.ord_typ=ro_am;
2189	ord_struct.data.am.start=start;
2190	ord_struct.data.am.end=end;
2191	ord_struct.data.am.place=place;
2192	ord_struct.data.am.weights=weights;
2193	ord_struct.data.am.weights_m = weights + (end-start+1);
2194	ord_struct.data.am.len_gen=weights[end-start+1];
2195	assume( ord_struct.data.am.weights_m[0] == ord_struct.data.am.len_gen );
2196	o[place]=1;
2197	place++;
2198	rO_Align(place,bitplace);
2199	}
2200
2201	static void rO_WDegree64(int &place, int &bitplace, int start, int end,
2202	long o, sro_ord &ord_struct, int64 weights)
2203	{
2204	// weighted degree (aligned) of variables v_start..v_end, ordsgn 1,
2205	// reserved 2 places
2206	rO_Align(place,bitplace);
2207	ord_struct.ord_typ=ro_wp64;
2208	ord_struct.data.wp64.start=start;
2209	ord_struct.data.wp64.end=end;
2210	ord_struct.data.wp64.place=place;
2211	ord_struct.data.wp64.weights64=weights;
2212	o[place]=1;
2213	place++;
2214	o[place]=1;
2215	place++;
2216	rO_Align(place,bitplace);
2217	}
2218
2219	static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2220	long o, sro_ord &ord_struct, int weights)
2221	{
2222	// weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2223	while((start<end) && (weights[0]==0)) { start++; weights++; }
2224	while((start<end) && (weights[end-start]==0)) { end--; }
2225	rO_Align(place,bitplace);
2226	ord_struct.ord_typ=ro_wp;
2227	ord_struct.data.wp.start=start;
2228	ord_struct.data.wp.end=end;
2229	ord_struct.data.wp.place=place;
2230	ord_struct.data.wp.weights=weights;
2231	o[place]=-1;
2232	place++;
2233	rO_Align(place,bitplace);
2234	int i;
2235	for(i=start;i<=end;i++)
2236	{
2237	if(weights[i-start]<0)
2238	{
2239	ord_struct.ord_typ=ro_wp_neg;
2240	break;
2241	}
2242	}
2243	}
2244
2245	static void rO_LexVars(int &place, int &bitplace, int start, int end,
2246	int &prev_ord, long o,int v, int bits, int opt_var)
2247	{
2248	// a block of variables v_start..v_end with lex order, ordsgn 1
2249	int k;
2250	int incr=1;
2251	if(prev_ord==-1) rO_Align(place,bitplace);
2252
2253	if (start>end)
2254	{
2255	incr=-1;
2256	}
2257	for(k=start;;k+=incr)
2258	{
2259	bitplace-=bits;
2260	if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2261	o[place]=1;
2262	v[k]= place \| (bitplace << 24);
2263	if (k==end) break;
2264	}
2265	prev_ord=1;
2266	if (opt_var!= -1)
2267	{
2268	assume((opt_var == end+1) \|\|(opt_var == end-1));
2269	if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2270	int save_bitplace=bitplace;
2271	bitplace-=bits;
2272	if (bitplace < 0)
2273	{
2274	bitplace=save_bitplace;
2275	return;
2276	}
2277	// there is enough space for the optional var
2278	v[opt_var]=place \| (bitplace << 24);
2279	}
2280	}
2281
2282	static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2283	int &prev_ord, long o,int v, int bits, int opt_var)
2284	{
2285	// a block of variables v_start..v_end with lex order, ordsgn -1
2286	int k;
2287	int incr=1;
2288	if(prev_ord==1) rO_Align(place,bitplace);
2289
2290	if (start>end)
2291	{
2292	incr=-1;
2293	}
2294	for(k=start;;k+=incr)
2295	{
2296	bitplace-=bits;
2297	if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2298	o[place]=-1;
2299	v[k]=place \| (bitplace << 24);
2300	if (k==end) break;
2301	}
2302	prev_ord=-1;
2303	// #if 0
2304	if (opt_var!= -1)
2305	{
2306	assume((opt_var == end+1) \|\|(opt_var == end-1));
2307	if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2308	int save_bitplace=bitplace;
2309	bitplace-=bits;
2310	if (bitplace < 0)
2311	{
2312	bitplace=save_bitplace;
2313	return;
2314	}
2315	// there is enough space for the optional var
2316	v[opt_var]=place \| (bitplace << 24);
2317	}
2318	// #endif
2319	}
2320
2321	static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2322	long *o, sro_ord &ord_struct)
2323	{
2324	// ordering is derived from component number
2325	rO_Align(place,bitplace);
2326	ord_struct.ord_typ=ro_syzcomp;
2327	ord_struct.data.syzcomp.place=place;
2328	ord_struct.data.syzcomp.Components=NULL;
2329	ord_struct.data.syzcomp.ShiftedComponents=NULL;
2330	o[place]=1;
2331	prev_ord=1;
2332	place++;
2333	rO_Align(place,bitplace);
2334	}
2335
2336	static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2337	long *o, sro_ord &ord_struct)
2338	{
2339	// ordering is derived from component number
2340	// let's reserve one Exponent_t for it
2341	if ((prev_ord== 1) \|\| (bitplace!=BITS_PER_LONG))
2342	rO_Align(place,bitplace);
2343	ord_struct.ord_typ=ro_syz;
2344	ord_struct.data.syz.place=place;
2345	ord_struct.data.syz.limit=0;
2346	ord_struct.data.syz.syz_index = NULL;
2347	ord_struct.data.syz.curr_index = 1;
2348	o[place]= -1;
2349	prev_ord=-1;
2350	place++;
2351	}
2352
2353	#ifndef SING_NDEBUG
2354	# define MYTEST 0
2355	#else /* ifndef SING_NDEBUG */
2356	# define MYTEST 0
2357	#endif /* ifndef SING_NDEBUG */
2358
2359	static void rO_ISPrefix(int &place, int &bitplace, int &prev_ord,
2360	long o, int /N/, int v, sro_ord &ord_struct)
2361	{
2362	if ((prev_ord== 1) \|\| (bitplace!=BITS_PER_LONG))
2363	rO_Align(place,bitplace);
2364	// since we add something afterwards - it's better to start with anew!?
2365
2366	ord_struct.ord_typ = ro_isTemp;
2367	ord_struct.data.isTemp.start = place;
2368	ord_struct.data.isTemp.pVarOffset = (int *)omMemDup(v);
2369	ord_struct.data.isTemp.suffixpos = -1;
2370
2371	// We will act as rO_Syz on our own!!!
2372	// Here we allocate an exponent as a level placeholder
2373	o[place]= -1;
2374	prev_ord=-1;
2375	place++;
2376	}
2377	static void rO_ISSuffix(int &place, int &bitplace, int &prev_ord, long *o,
2378	int N, int v, sro_ord tmp_typ, int &typ_i, int sgn)
2379	{
2380
2381	// Let's find previous prefix:
2382	int typ_j = typ_i - 1;
2383	while(typ_j >= 0)
2384	{
2385	if( tmp_typ[typ_j].ord_typ == ro_isTemp)
2386	break;
2387	typ_j --;
2388	}
2389
2390	assume( typ_j >= 0 );
2391
2392	if( typ_j < 0 ) // Found NO prefix!!! :(
2393	return;
2394
2395	assume( tmp_typ[typ_j].ord_typ == ro_isTemp );
2396
2397	// Get saved state:
2398	const int start = tmp_typ[typ_j].data.isTemp.start;
2399	int *pVarOffset = tmp_typ[typ_j].data.isTemp.pVarOffset;
2400
2401	/*
2402	// shift up all blocks
2403	while(typ_j < (typ_i-1))
2404	{
2405	tmp_typ[typ_j] = tmp_typ[typ_j+1];
2406	typ_j++;
2407	}
2408	typ_j = typ_i - 1; // No increment for typ_i
2409	*/
2410	tmp_typ[typ_j].data.isTemp.suffixpos = typ_i;
2411
2412	// Let's keep that dummy for now...
2413	typ_j = typ_i; // the typ to change!
2414	typ_i++; // Just for now...
2415
2416
2417	for( int i = 0; i <= N; i++ ) // Note [0] == component !!! No Skip?
2418	{
2419	// Was i-th variable allocated inbetween?
2420	if( v[i] != pVarOffset[i] )
2421	{
2422	pVarOffset[i] = v[i]; // Save for later...
2423	v[i] = -1; // Undo!
2424	assume( pVarOffset[i] != -1 );
2425	}
2426	else
2427	pVarOffset[i] = -1; // No change here...
2428	}
2429
2430	if( pVarOffset[0] != -1 )
2431	pVarOffset[0] &= 0x0fff;
2432
2433	sro_ord &ord_struct = tmp_typ[typ_j];
2434
2435
2436	ord_struct.ord_typ = ro_is;
2437	ord_struct.data.is.start = start;
2438	ord_struct.data.is.end = place;
2439	ord_struct.data.is.pVarOffset = pVarOffset;
2440
2441
2442	// What about component???
2443	// if( v[0] != -1 ) // There is a component already...???
2444	// if( o[ v[0] & 0x0fff ] == sgn )
2445	// {
2446	// pVarOffset[0] = -1; // NEVER USED Afterwards...
2447	// return;
2448	// }
2449
2450
2451	// Moreover: we need to allocate the module component (v[0]) here!
2452	if( v[0] == -1) // It's possible that there was module component v0 at the begining (before prefix)!
2453	{
2454	// Start with a whole long exponent
2455	if( bitplace != BITS_PER_LONG )
2456	rO_Align(place, bitplace);
2457
2458	assume( bitplace == BITS_PER_LONG );
2459	bitplace -= BITS_PER_LONG;
2460	assume(bitplace == 0);
2461	v[0] = place \| (bitplace << 24); // Never mind whether pVarOffset[0] > 0!!!
2462	o[place] = sgn; // Singnum for component ordering
2463	prev_ord = sgn;
2464	}
2465	}
2466
2467
2468	static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2469	{
2470	if (bitmask == 0)
2471	{
2472	bits=16; bitmask=0xffff;
2473	}
2474	else if (bitmask <= 1L)
2475	{
2476	bits=1; bitmask = 1L;
2477	}
2478	else if (bitmask <= 3L)
2479	{
2480	bits=2; bitmask = 3L;
2481	}
2482	else if (bitmask <= 7L)
2483	{
2484	bits=3; bitmask=7L;
2485	}
2486	else if (bitmask <= 0xfL)
2487	{
2488	bits=4; bitmask=0xfL;
2489	}
2490	else if (bitmask <= 0x1fL)
2491	{
2492	bits=5; bitmask=0x1fL;
2493	}
2494	else if (bitmask <= 0x3fL)
2495	{
2496	bits=6; bitmask=0x3fL;
2497	}
2498	#if SIZEOF_LONG == 8
2499	else if (bitmask <= 0x7fL)
2500	{
2501	bits=7; bitmask=0x7fL; /* 64 bit longs only */
2502	}
2503	#endif
2504	else if (bitmask <= 0xffL)
2505	{
2506	bits=8; bitmask=0xffL;
2507	}
2508	#if SIZEOF_LONG == 8
2509	else if (bitmask <= 0x1ffL)
2510	{
2511	bits=9; bitmask=0x1ffL; /* 64 bit longs only */
2512	}
2513	#endif
2514	else if (bitmask <= 0x3ffL)
2515	{
2516	bits=10; bitmask=0x3ffL;
2517	}
2518	#if SIZEOF_LONG == 8
2519	else if (bitmask <= 0xfffL)
2520	{
2521	bits=12; bitmask=0xfff; /* 64 bit longs only */
2522	}
2523	#endif
2524	else if (bitmask <= 0xffffL)
2525	{
2526	bits=16; bitmask=0xffffL;
2527	}
2528	#if SIZEOF_LONG == 8
2529	else if (bitmask <= 0xfffffL)
2530	{
2531	bits=20; bitmask=0xfffffL; /* 64 bit longs only */
2532	}
2533	else if (bitmask <= 0xffffffffL)
2534	{
2535	bits=32; bitmask=0xffffffffL;
2536	}
2537	else if (bitmask <= 0x7fffffffffffffffL)
2538	{
2539	bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2540	}
2541	else
2542	{
2543	bits=63; bitmask=0x7fffffffffffffffL; /* for overflow tests*/
2544	}
2545	#else
2546	else if (bitmask <= 0x7fffffff)
2547	{
2548	bits=31; bitmask=0x7fffffff; /* for overflow tests*/
2549	}
2550	else
2551	{
2552	bits=31; bitmask=0x7fffffffL; /* for overflow tests*/
2553	}
2554	#endif
2555	return bitmask;
2556	}
2557
2558	/*2
2559	* optimize rGetExpSize for a block of N variables, exp <=bitmask
2560	*/
2561	static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2562	{
2563	#if SIZEOF_LONG == 8
2564	if (N<4) N=4;
2565	#else
2566	if (N<2) N=2;
2567	#endif
2568	bitmask =rGetExpSize(bitmask, bits);
2569	int vars_per_long=BIT_SIZEOF_LONG/bits;
2570	int bits1;
2571	loop
2572	{
2573	if (bits == BIT_SIZEOF_LONG-1)
2574	{
2575	bits = BIT_SIZEOF_LONG - 1;
2576	return LONG_MAX;
2577	}
2578	unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2579	int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2580	if ((((N+vars_per_long-1)/vars_per_long) ==
2581	((N+vars_per_long1-1)/vars_per_long1)))
2582	{
2583	vars_per_long=vars_per_long1;
2584	bits=bits1;
2585	bitmask=bitmask1;
2586	}
2587	else
2588	{
2589	return bitmask; /* and bits */
2590	}
2591	}
2592	}
2593
2594
2595	/*2
2596	* create a copy of the ring r, which must be equivalent to currRing
2597	* used for std computations
2598	* may share data structures with currRing
2599	* DOES CALL rComplete
2600	*/
2601	ring rModifyRing(ring r, BOOLEAN omit_degree,
2602	BOOLEAN try_omit_comp,
2603	unsigned long exp_limit)
2604	{
2605	assume (r != NULL );
2606	assume (exp_limit > 1);
2607	BOOLEAN need_other_ring;
2608	BOOLEAN omitted_degree = FALSE;
2609
2610	int iNeedInducedOrderingSetup = 0; ///< How many induced ordering block do we have?
2611	int bits;
2612
2613	exp_limit=rGetExpSize(exp_limit, bits, r->N);
2614	need_other_ring = (exp_limit != r->bitmask);
2615
2616	int nblocks=rBlocks(r);
2617	rRingOrder_t order=(rRingOrder_t)omAlloc0((nblocks+1)*sizeof(rRingOrder_t));
2618	int block0=(int)omAlloc0((nblocks+1)*sizeof(int));
2619	int block1=(int)omAlloc0((nblocks+1)*sizeof(int));
2620	int wvhdl=(int)omAlloc0((nblocks+1)sizeof(int ));
2621
2622	int i=0;
2623	int j=0; /* i index in r, j index in res */
2624
2625	for( rRingOrder_t r_ord=r->order[i]; (r_ord != (rRingOrder_t)0) && (i < nblocks); j++, r_ord=r->order[++i])
2626	{
2627	BOOLEAN copy_block_index=TRUE;
2628
2629	if (r->block0[i]==r->block1[i])
2630	{
2631	switch(r_ord)
2632	{
2633	case ringorder_wp:
2634	case ringorder_dp:
2635	case ringorder_Wp:
2636	case ringorder_Dp:
2637	r_ord=ringorder_lp;
2638	break;
2639	case ringorder_Ws:
2640	case ringorder_Ds:
2641	case ringorder_ws:
2642	case ringorder_ds:
2643	r_ord=ringorder_ls;
2644	break;
2645	default:
2646	break;
2647	}
2648	}
2649	switch(r_ord)
2650	{
2651	case ringorder_S:
2652	{
2653	#ifndef SING_NDEBUG
2654	Warn("Error: unhandled ordering in rModifyRing: ringorder_S = [%d]", r_ord);
2655	#endif
2656	order[j]=r_ord; /r->order[i];/
2657	break;
2658	}
2659	case ringorder_C:
2660	case ringorder_c:
2661	if (!try_omit_comp)
2662	{
2663	order[j]=r_ord; /r->order[i]/;
2664	}
2665	else
2666	{
2667	j--;
2668	need_other_ring=TRUE;
2669	try_omit_comp=FALSE;
2670	copy_block_index=FALSE;
2671	}
2672	break;
2673	case ringorder_wp:
2674	case ringorder_dp:
2675	case ringorder_ws:
2676	case ringorder_ds:
2677	if(!omit_degree)
2678	{
2679	order[j]=r_ord; /r->order[i]/;
2680	}
2681	else
2682	{
2683	order[j]=ringorder_rs;
2684	need_other_ring=TRUE;
2685	omit_degree=FALSE;
2686	omitted_degree = TRUE;
2687	}
2688	break;
2689	case ringorder_Wp:
2690	case ringorder_Dp:
2691	case ringorder_Ws:
2692	case ringorder_Ds:
2693	if(!omit_degree)
2694	{
2695	order[j]=r_ord; /r->order[i];/
2696	}
2697	else
2698	{
2699	order[j]=ringorder_lp;
2700	need_other_ring=TRUE;
2701	omit_degree=FALSE;
2702	omitted_degree = TRUE;
2703	}
2704	break;
2705	case ringorder_IS:
2706	{
2707	if (try_omit_comp)
2708	{
2709	// tried, but cannot omit component due to the ordering block [%d]: %d (ringorder_IS)", i, r_ord
2710	try_omit_comp = FALSE;
2711	}
2712	order[j]=r_ord; /r->order[i];/
2713	iNeedInducedOrderingSetup++;
2714	break;
2715	}
2716	case ringorder_s:
2717	{
2718	assume((i == 0) && (j == 0));
2719	if (try_omit_comp)
2720	{
2721	// tried, but cannot omit component due to the ordering block [%d]: %d (ringorder_s)", i, r_ord
2722	try_omit_comp = FALSE;
2723	}
2724	order[j]=r_ord; /r->order[i];/
2725	break;
2726	}
2727	default:
2728	order[j]=r_ord; /r->order[i];/
2729	break;
2730	}
2731	if (copy_block_index)
2732	{
2733	block0[j]=r->block0[i];
2734	block1[j]=r->block1[i];
2735	wvhdl[j]=r->wvhdl[i];
2736	}
2737
2738	// order[j]=ringorder_no; // done by omAlloc0
2739	}
2740	if(!need_other_ring)
2741	{
2742	omFreeSize(order,(nblocks+1)*sizeof(rRingOrder_t));
2743	omFreeSize(block0,(nblocks+1)*sizeof(int));
2744	omFreeSize(block1,(nblocks+1)*sizeof(int));
2745	omFreeSize(wvhdl,(nblocks+1)sizeof(int ));
2746	return r;
2747	}
2748	ring res=(ring)omAlloc0Bin(sip_sring_bin);
2749	res = r;
2750
2751	#ifdef HAVE_PLURAL
2752	res->GetNC() = NULL;
2753	#endif
2754
2755	// res->qideal, res->idroot ???
2756	res->wvhdl=wvhdl;
2757	res->order=order;
2758	res->block0=block0;
2759	res->block1=block1;
2760	res->bitmask=exp_limit;
2761	//int tmpref=r->cf->ref0;
2762	rComplete(res, 1);
2763	//r->cf->ref=tmpref;
2764
2765	// adjust res->pFDeg: if it was changed globally, then
2766	// it must also be changed for new ring
2767	if (r->pFDegOrig != res->pFDegOrig &&
2768	rOrd_is_WeightedDegree_Ordering(r))
2769	{
2770	// still might need adjustment for weighted orderings
2771	// and omit_degree
2772	res->firstwv = r->firstwv;
2773	res->firstBlockEnds = r->firstBlockEnds;
2774	res->pFDeg = res->pFDegOrig = p_WFirstTotalDegree;
2775	}
2776	if (omitted_degree)
2777	res->pLDeg = r->pLDegOrig;
2778
2779	rOptimizeLDeg(res); // also sets res->pLDegOrig
2780
2781	// set syzcomp
2782	if (res->typ != NULL)
2783	{
2784	if( res->typ[0].ord_typ == ro_syz) // "s" Always on [0] place!
2785	{
2786	res->typ[0] = r->typ[0]; // Copy struct!? + setup the same limit!
2787
2788	if (r->typ[0].data.syz.limit > 0)
2789	{
2790	res->typ[0].data.syz.syz_index
2791	= (int) omAlloc((r->typ[0].data.syz.limit +1)sizeof(int));
2792	memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2793	(r->typ[0].data.syz.limit +1)*sizeof(int));
2794	}
2795	}
2796
2797	if( iNeedInducedOrderingSetup > 0 )
2798	{
2799	for(j = 0, i = 0; (i < nblocks) && (iNeedInducedOrderingSetup > 0); i++)
2800	if( res->typ[i].ord_typ == ro_is ) // Search for suffixes!
2801	{
2802	ideal F = idrHeadR(r->typ[i].data.is.F, r, res); // Copy F from r into res!
2803	assume(
2804	rSetISReference( res,
2805	F, // WILL BE COPIED!
2806	r->typ[i].data.is.limit,
2807	j++
2808	)
2809	);
2810	id_Delete(&F, res);
2811	iNeedInducedOrderingSetup--;
2812	}
2813	} // Process all induced Ordering blocks! ...
2814	}
2815	// the special case: homog (omit_degree) and 1 block rs: that is global:
2816	// it comes from dp
2817	res->OrdSgn=r->OrdSgn;
2818
2819
2820	#ifdef HAVE_PLURAL
2821	if (rIsPluralRing(r))
2822	{
2823	if ( nc_rComplete(r, res, false) ) // no qideal!
2824	{
2825	#ifndef SING_NDEBUG
2826	WarnS("error in nc_rComplete");
2827	#endif
2828	// cleanup?
2829
2830	// rDelete(res);
2831	// return r;
2832
2833	// just go on..
2834	}
2835
2836	if( rIsSCA(r) )
2837	{
2838	if( !sca_Force(res, scaFirstAltVar(r), scaLastAltVar(r)) )
2839	WarnS("error in sca_Force!");
2840	}
2841	}
2842	#endif
2843
2844	return res;
2845	}
2846
2847	// construct Wp,C ring
2848	ring rModifyRing_Wp(ring r, int* weights)
2849	{
2850	ring res=(ring)omAlloc0Bin(sip_sring_bin);
2851	res = r;
2852	#ifdef HAVE_PLURAL
2853	res->GetNC() = NULL;
2854	#endif
2855
2856	/weights: entries for 3 blocks: NULL/
2857	res->wvhdl = (int *)omAlloc0(3 sizeof(int *));
2858	/order: Wp,C,0/
2859	res->order = (rRingOrder_t ) omAlloc(3 sizeof(rRingOrder_t *));
2860	res->block0 = (int )omAlloc0(3 sizeof(int *));
2861	res->block1 = (int )omAlloc0(3 sizeof(int *));
2862	/* ringorder Wp for the first block: var 1..r->N */
2863	res->order[0] = ringorder_Wp;
2864	res->block0[0] = 1;
2865	res->block1[0] = r->N;
2866	res->wvhdl[0] = weights;
2867	/* ringorder C for the second block: no vars */
2868	res->order[1] = ringorder_C;
2869	/* the last block: everything is 0 */
2870	res->order[2] = (rRingOrder_t)0;
2871
2872	//int tmpref=r->cf->ref;
2873	rComplete(res, 1);
2874	//r->cf->ref=tmpref;
2875	#ifdef HAVE_PLURAL
2876	if (rIsPluralRing(r))
2877	{
2878	if ( nc_rComplete(r, res, false) ) // no qideal!
2879	{
2880	#ifndef SING_NDEBUG
2881	WarnS("error in nc_rComplete");
2882	#endif
2883	// cleanup?
2884
2885	// rDelete(res);
2886	// return r;
2887
2888	// just go on..
2889	}
2890	}
2891	#endif
2892	return res;
2893	}
2894
2895	// construct lp, C ring with r->N variables, r->names vars....
2896	ring rModifyRing_Simple(ring r, BOOLEAN ommit_degree, BOOLEAN ommit_comp, unsigned long exp_limit, BOOLEAN &simple)
2897	{
2898	simple=TRUE;
2899	if (!rHasSimpleOrder(r))
2900	{
2901	simple=FALSE; // sorting needed
2902	assume (r != NULL );
2903	assume (exp_limit > 1);
2904	int bits;
2905
2906	exp_limit=rGetExpSize(exp_limit, bits, r->N);
2907
2908	int nblocks=1+(ommit_comp!=0);
2909	rRingOrder_t order=(rRingOrder_t)omAlloc0((nblocks+1)*sizeof(rRingOrder_t));
2910	int block0=(int)omAlloc0((nblocks+1)*sizeof(int));
2911	int block1=(int)omAlloc0((nblocks+1)*sizeof(int));
2912	int wvhdl=(int)omAlloc0((nblocks+1)sizeof(int ));
2913
2914	order[0]=ringorder_lp;
2915	block0[0]=1;
2916	block1[0]=r->N;
2917	if (!ommit_comp)
2918	{
2919	order[1]=ringorder_C;
2920	}
2921	ring res=(ring)omAlloc0Bin(sip_sring_bin);
2922	res = r;
2923	#ifdef HAVE_PLURAL
2924	res->GetNC() = NULL;
2925	#endif
2926	// res->qideal, res->idroot ???
2927	res->wvhdl=wvhdl;
2928	res->order=order;
2929	res->block0=block0;
2930	res->block1=block1;
2931	res->bitmask=exp_limit;
2932	//int tmpref=r->cf->ref;
2933	rComplete(res, 1);
2934	//r->cf->ref=tmpref;
2935
2936	#ifdef HAVE_PLURAL
2937	if (rIsPluralRing(r))
2938	{
2939	if ( nc_rComplete(r, res, false) ) // no qideal!
2940	{
2941	#ifndef SING_NDEBUG
2942	WarnS("error in nc_rComplete");
2943	#endif
2944	// cleanup?
2945
2946	// rDelete(res);
2947	// return r;
2948
2949	// just go on..
2950	}
2951	}
2952	#endif
2953
2954	rOptimizeLDeg(res);
2955
2956	return res;
2957	}
2958	return rModifyRing(r, ommit_degree, ommit_comp, exp_limit);
2959	}
2960
2961	void rKillModifiedRing_Simple(ring r)
2962	{
2963	rKillModifiedRing(r);
2964	}
2965
2966
2967	void rKillModifiedRing(ring r)
2968	{
2969	rUnComplete(r);
2970	omFree(r->order);
2971	omFree(r->block0);
2972	omFree(r->block1);
2973	omFree(r->wvhdl);
2974	omFreeBin(r,sip_sring_bin);
2975	}
2976
2977	void rKillModified_Wp_Ring(ring r)
2978	{
2979	rUnComplete(r);
2980	omFree(r->order);
2981	omFree(r->block0);
2982	omFree(r->block1);
2983	omFree(r->wvhdl[0]);
2984	omFree(r->wvhdl);
2985	omFreeBin(r,sip_sring_bin);
2986	}
2987
2988	static void rSetOutParams(ring r)
2989	{
2990	r->VectorOut = (r->order[0] == ringorder_c);
2991	r->CanShortOut = TRUE;
2992	{
2993	int i;
2994	if (rParameter(r)!=NULL)
2995	{
2996	for (i=0;i<rPar(r);i++)
2997	{
2998	if(strlen(rParameter(r)[i])>1)
2999	{
3000	r->CanShortOut=FALSE;
3001	break;
3002	}
3003	}
3004	}
3005	if (r->CanShortOut)
3006	{
3007	// Hmm... sometimes (e.g., from maGetPreimage) new variables
3008	// are introduced, but their names are never set
3009	// hence, we do the following awkward trick
3010	int N = omSizeOfAddr(r->names)/sizeof(char*);
3011	if (r->N < N) N = r->N;
3012
3013	for (i=(N-1);i>=0;i--)
3014	{
3015	if(r->names[i] != NULL && strlen(r->names[i])>1)
3016	{
3017	r->CanShortOut=FALSE;
3018	break;
3019	}
3020	}
3021	}
3022	}
3023	r->ShortOut = r->CanShortOut;
3024
3025	assume( !( !r->CanShortOut && r->ShortOut ) );
3026	}
3027
3028	static void rSetFirstWv(ring r, int i, rRingOrder_t* order, int* block1, int** wvhdl)
3029	{
3030	// cheat for ringorder_aa
3031	if (order[i] == ringorder_aa)
3032	i++;
3033	if(block1[i]!=r->N) r->LexOrder=TRUE;
3034	r->firstBlockEnds=block1[i];
3035	r->firstwv = wvhdl[i];
3036	if ((order[i]== ringorder_ws)
3037	\|\| (order[i]==ringorder_Ws)
3038	\|\| (order[i]== ringorder_wp)
3039	\|\| (order[i]==ringorder_Wp)
3040	\|\| (order[i]== ringorder_a)
3041	/\|\| (order[i]==ringorder_A)/)
3042	{
3043	int j;
3044	for(j=block1[i]-r->block0[i];j>=0;j--)
3045	{
3046	if (r->firstwv[j]==0) r->LexOrder=TRUE;
3047	}
3048	}
3049	else if (order[i]==ringorder_a64)
3050	{
3051	int j;
3052	int64 *w=rGetWeightVec(r);
3053	for(j=block1[i]-r->block0[i];j>=0;j--)
3054	{
3055	if (w[j]==0) r->LexOrder=TRUE;
3056	}
3057	}
3058	}
3059
3060	static void rOptimizeLDeg(ring r)
3061	{
3062	if (r->pFDeg == p_Deg)
3063	{
3064	if (r->pLDeg == pLDeg1)
3065	r->pLDeg = pLDeg1_Deg;
3066	if (r->pLDeg == pLDeg1c)
3067	r->pLDeg = pLDeg1c_Deg;
3068	}
3069	else if (r->pFDeg == p_Totaldegree)
3070	{
3071	if (r->pLDeg == pLDeg1)
3072	r->pLDeg = pLDeg1_Totaldegree;
3073	if (r->pLDeg == pLDeg1c)
3074	r->pLDeg = pLDeg1c_Totaldegree;
3075	}
3076	else if (r->pFDeg == p_WFirstTotalDegree)
3077	{
3078	if (r->pLDeg == pLDeg1)
3079	r->pLDeg = pLDeg1_WFirstTotalDegree;
3080	if (r->pLDeg == pLDeg1c)
3081	r->pLDeg = pLDeg1c_WFirstTotalDegree;
3082	}
3083	r->pLDegOrig = r->pLDeg;
3084	}
3085
3086	// set pFDeg, pLDeg, requires OrdSgn already set
3087	static void rSetDegStuff(ring r)
3088	{
3089	rRingOrder_t* order = r->order;
3090	int* block0 = r->block0;
3091	int* block1 = r->block1;
3092	int** wvhdl = r->wvhdl;
3093
3094	if (order[0]==ringorder_S \|\|order[0]==ringorder_s \|\| order[0]==ringorder_IS)
3095	{
3096	order++;
3097	block0++;
3098	block1++;
3099	wvhdl++;
3100	}
3101	r->LexOrder = FALSE;
3102	r->pFDeg = p_Totaldegree;
3103	r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
3104
3105	/======== ordering type is (am,_) ==================/
3106	if (order[0]==ringorder_am)
3107	{
3108	for(int ii=block0[0];ii<=block1[0];ii++)
3109	if (wvhdl[0][ii-1]<0) { r->MixedOrder=2;break;}
3110	r->LexOrder=FALSE;
3111	for(int ii=block0[0];ii<=block1[0];ii++)
3112	if (wvhdl[0][ii-1]==0) { r->LexOrder=TRUE;break;}
3113	if ((block0[0]==1)&&(block1[0]==r->N))
3114	{
3115	r->pFDeg = p_Deg;
3116	r->pLDeg = pLDeg1c_Deg;
3117	}
3118	else
3119	{
3120	r->pFDeg = p_WTotaldegree;
3121	r->LexOrder=TRUE;
3122	r->pLDeg = pLDeg1c_WFirstTotalDegree;
3123	}
3124	r->firstwv = wvhdl[0];
3125	}
3126	/======== ordering type is (_,c) =========================/
3127	else if ((order[0]==ringorder_unspec) \|\| (order[1] == 0)
3128	\|\|(
3129	((order[1]==ringorder_c)\|\|(order[1]==ringorder_C)
3130	\|\|(order[1]==ringorder_S)
3131	\|\|(order[1]==ringorder_s))
3132	&& (order[0]!=ringorder_M)
3133	&& (order[2]==0))
3134	)
3135	{
3136	if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
3137	if ((order[0] == ringorder_lp)
3138	\|\| (order[0] == ringorder_ls)
3139	\|\| (order[0] == ringorder_rp)
3140	\|\| (order[0] == ringorder_rs))
3141	{
3142	r->LexOrder=TRUE;
3143	r->pLDeg = pLDeg1c;
3144	r->pFDeg = p_Totaldegree;
3145	}
3146	else if ((order[0] == ringorder_a)
3147	\|\| (order[0] == ringorder_wp)
3148	\|\| (order[0] == ringorder_Wp))
3149	{
3150	r->pFDeg = p_WFirstTotalDegree;
3151	}
3152	else if ((order[0] == ringorder_ws)
3153	\|\| (order[0] == ringorder_Ws))
3154	{
3155	for(int ii=block0[0];ii<=block1[0];ii++)
3156	{
3157	if (wvhdl[0][ii-1]<0) { r->MixedOrder=2;break;}
3158	}
3159	if (r->MixedOrder==0)
3160	{
3161	if ((block0[0]==1)&&(block1[0]==r->N))
3162	r->pFDeg = p_WTotaldegree;
3163	else
3164	r->pFDeg = p_WFirstTotalDegree;
3165	}
3166	else
3167	r->pFDeg = p_Totaldegree;
3168	}
3169	r->firstBlockEnds=block1[0];
3170	r->firstwv = wvhdl[0];
3171	}
3172	/======== ordering type is (c,_) =========================/
3173	else if (((order[0]==ringorder_c)
3174	\|\|(order[0]==ringorder_C)
3175	\|\|(order[0]==ringorder_S)
3176	\|\|(order[0]==ringorder_s))
3177	&& (order[1]!=ringorder_M)
3178	&& (order[2]==0))
3179	{
3180	if ((order[1] == ringorder_lp)
3181	\|\| (order[1] == ringorder_ls)
3182	\|\| (order[1] == ringorder_rp)
3183	\|\| order[1] == ringorder_rs)
3184	{
3185	r->LexOrder=TRUE;
3186	r->pLDeg = pLDeg1c;
3187	r->pFDeg = p_Totaldegree;
3188	}
3189	r->firstBlockEnds=block1[1];
3190	if (wvhdl!=NULL) r->firstwv = wvhdl[1];
3191	if ((order[1] == ringorder_a)
3192	\|\| (order[1] == ringorder_wp)
3193	\|\| (order[1] == ringorder_Wp))
3194	r->pFDeg = p_WFirstTotalDegree;
3195	else if ((order[1] == ringorder_ws)
3196	\|\| (order[1] == ringorder_Ws))
3197	{
3198	for(int ii=block0[1];ii<=block1[1];ii++)
3199	if (wvhdl[1][ii-1]<0) { r->MixedOrder=2;break;}
3200	if (r->MixedOrder==FALSE)
3201	r->pFDeg = p_WFirstTotalDegree;
3202	else
3203	r->pFDeg = p_Totaldegree;
3204	}
3205	}
3206	/------- more than one block ----------------------/
3207	else
3208	{
3209	if ((r->VectorOut)\|\|(order[0]==ringorder_C)\|\|(order[0]==ringorder_S)\|\|(order[0]==ringorder_s))
3210	{
3211	rSetFirstWv(r, 1, order, block1, wvhdl);
3212	}
3213	else
3214	rSetFirstWv(r, 0, order, block1, wvhdl);
3215
3216	if ((order[0]!=ringorder_c)
3217	&& (order[0]!=ringorder_C)
3218	&& (order[0]!=ringorder_S)
3219	&& (order[0]!=ringorder_s))
3220	{
3221	r->pLDeg = pLDeg1c;
3222	}
3223	else
3224	{
3225	r->pLDeg = pLDeg1;
3226	}
3227	r->pFDeg = p_WTotaldegree; // may be improved: p_Totaldegree for lp/dp/ls/.. blocks
3228	}
3229
3230	if (rOrd_is_Totaldegree_Ordering(r)
3231	\|\| rOrd_is_WeightedDegree_Ordering(r))
3232	{
3233	if(r->MixedOrder==FALSE)
3234	r->pFDeg = p_Deg;
3235	else
3236	r->pFDeg = p_Totaldegree;
3237	}
3238
3239	if( rGetISPos(0, r) != -1 ) // Are there Schreyer induced blocks?
3240	{
3241	#ifndef SING_NDEBUG
3242	assume( r->pFDeg == p_Deg \|\| r->pFDeg == p_WTotaldegree \|\| r->pFDeg == p_Totaldegree);
3243	#endif
3244
3245	r->pLDeg = pLDeg1; // ?
3246	}
3247
3248	r->pFDegOrig = r->pFDeg;
3249	// NOTE: this leads to wrong ecart during std
3250	// in Old/sre.tst
3251	rOptimizeLDeg(r); // also sets r->pLDegOrig
3252	}
3253
3254	/*2
3255	* set NegWeightL_Size, NegWeightL_Offset
3256	*/
3257	static void rSetNegWeight(ring r)
3258	{
3259	int i,l;
3260	if (r->typ!=NULL)
3261	{
3262	l=0;
3263	for(i=0;i<r->OrdSize;i++)
3264	{
3265	if((r->typ[i].ord_typ==ro_wp_neg)
3266	\|\|(r->typ[i].ord_typ==ro_am))
3267	l++;
3268	}
3269	if (l>0)
3270	{
3271	r->NegWeightL_Size=l;
3272	r->NegWeightL_Offset=(int ) omAlloc(lsizeof(int));
3273	l=0;
3274	for(i=0;i<r->OrdSize;i++)
3275	{
3276	if(r->typ[i].ord_typ==ro_wp_neg)
3277	{
3278	r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
3279	l++;
3280	}
3281	else if(r->typ[i].ord_typ==ro_am)
3282	{
3283	r->NegWeightL_Offset[l]=r->typ[i].data.am.place;
3284	l++;
3285	}
3286	}
3287	return;
3288	}
3289	}
3290	r->NegWeightL_Size = 0;
3291	r->NegWeightL_Offset = NULL;
3292	}
3293
3294	static void rSetOption(ring r)
3295	{
3296	// set redthrough
3297	if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
3298	r->options \|= Sy_bit(OPT_REDTHROUGH);
3299	else
3300	r->options &= ~Sy_bit(OPT_REDTHROUGH);
3301
3302	// set intStrategy
3303	if ( (r->cf->extRing!=NULL)
3304	\|\| rField_is_Q(r)
3305	\|\| rField_is_Ring(r)
3306	)
3307	r->options \|= Sy_bit(OPT_INTSTRATEGY);
3308	else
3309	r->options &= ~Sy_bit(OPT_INTSTRATEGY);
3310
3311	// set redTail
3312	if (r->LexOrder \|\| r->OrdSgn == -1 \|\| (r->cf->extRing!=NULL))
3313	r->options &= ~Sy_bit(OPT_REDTAIL);
3314	else
3315	r->options \|= Sy_bit(OPT_REDTAIL);
3316	}
3317
3318	static void rCheckOrdSgn(ring r,int i/last block/);
3319
3320	/* -------------------------------------------------------- */
3321	/*2
3322	* change all global variables to fit the description of the new ring
3323	*/
3324
3325	void p_SetGlobals(const ring r, BOOLEAN complete)
3326	{
3327	// // // if (r->ppNoether!=NULL) p_Delete(&r->ppNoether,r); // ???
3328
3329	r->pLexOrder=r->LexOrder;
3330	if (complete)
3331	{
3332	si_opt_1 &= ~ TEST_RINGDEP_OPTS;
3333	si_opt_1 \|= r->options;
3334	}
3335	}
3336
3337	static inline int sign(int x) { return (x > 0) - (x < 0);}
3338	BOOLEAN rOrd_is_MixedDegree_Ordering(ring r)
3339	{
3340	int i;
3341	poly p=p_One(r);
3342	p_SetExp(p,1,1,r);
3343	p_Setm(p,r);
3344	int vz=sign(p_FDeg(p,r));
3345	for(i=2;i<=rVar(r);i++)
3346	{
3347	p_SetExp(p,i-1,0,r);
3348	p_SetExp(p,i,1,r);
3349	p_Setm(p,r);
3350	if (sign(p_FDeg(p,r))!=vz)
3351	{
3352	p_Delete(&p,r);
3353	return TRUE;
3354	}
3355	}
3356	p_Delete(&p,r);
3357	return FALSE;
3358	}
3359
3360	BOOLEAN rComplete(ring r, int force)
3361	{
3362	if (r->VarOffset!=NULL && force == 0) return FALSE;
3363	rSetOutParams(r);
3364	int n=rBlocks(r)-1;
3365	int i;
3366	int bits;
3367	r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
3368	r->BitsPerExp = bits;
3369	r->ExpPerLong = BIT_SIZEOF_LONG / bits;
3370	r->divmask=rGetDivMask(bits);
3371
3372	// will be used for ordsgn:
3373	long tmp_ordsgn=(long )omAlloc0(3(n+r->N)sizeof(long));
3374	// will be used for VarOffset:
3375	int v=(int )omAlloc((r->N+1)*sizeof(int));
3376	for(i=r->N; i>=0 ; i--)
3377	{
3378	v[i]=-1;
3379	}
3380	sro_ord tmp_typ=(sro_ord )omAlloc0(3(n+r->N)sizeof(sro_ord));
3381	int typ_i=0;
3382	int prev_ordsgn=0;
3383
3384	// fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
3385	int j=0;
3386	int j_bits=BITS_PER_LONG;
3387
3388	BOOLEAN need_to_add_comp=FALSE; // Only for ringorder_s and ringorder_S!
3389
3390	for(i=0;i<n;i++)
3391	{
3392	tmp_typ[typ_i].order_index=i;
3393	switch (r->order[i])
3394	{
3395	case ringorder_a:
3396	case ringorder_aa:
3397	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3398	r->wvhdl[i]);
3399	typ_i++;
3400	break;
3401
3402	case ringorder_am:
3403	rO_WMDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3404	r->wvhdl[i]);
3405	typ_i++;
3406	break;
3407
3408	case ringorder_a64:
3409	rO_WDegree64(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3410	tmp_typ[typ_i], (int64 *)(r->wvhdl[i]));
3411	typ_i++;
3412	break;
3413
3414	case ringorder_c:
3415	rO_Align(j, j_bits);
3416	rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3417	r->ComponentOrder=1;
3418	break;
3419
3420	case ringorder_C:
3421	rO_Align(j, j_bits);
3422	rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3423	r->ComponentOrder=-1;
3424	break;
3425
3426	case ringorder_M:
3427	{
3428	int k,l;
3429	k=r->block1[i]-r->block0[i]+1; // number of vars
3430	for(l=0;l<k;l++)
3431	{
3432	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3433	tmp_typ[typ_i],
3434	r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
3435	typ_i++;
3436	}
3437	break;
3438	}
3439
3440	case ringorder_lp:
3441	rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3442	tmp_ordsgn,v,bits, -1);
3443	break;
3444
3445	case ringorder_ls:
3446	rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3447	tmp_ordsgn,v, bits, -1);
3448	break;
3449
3450	case ringorder_rs:
3451	rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3452	tmp_ordsgn,v, bits, -1);
3453	break;
3454
3455	case ringorder_rp:
3456	rO_LexVars(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3457	tmp_ordsgn,v, bits, -1);
3458	break;
3459
3460	case ringorder_dp:
3461	if (r->block0[i]==r->block1[i])
3462	{
3463	rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3464	tmp_ordsgn,v, bits, -1);
3465	}
3466	else
3467	{
3468	rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3469	tmp_typ[typ_i]);
3470	typ_i++;
3471	rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3472	prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3473	}
3474	break;
3475
3476	case ringorder_Dp:
3477	if (r->block0[i]==r->block1[i])
3478	{
3479	rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3480	tmp_ordsgn,v, bits, -1);
3481	}
3482	else
3483	{
3484	rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3485	tmp_typ[typ_i]);
3486	typ_i++;
3487	rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3488	tmp_ordsgn,v, bits, r->block1[i]);
3489	}
3490	break;
3491
3492	case ringorder_ds:
3493	if (r->block0[i]==r->block1[i])
3494	{
3495	rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
3496	tmp_ordsgn,v,bits, -1);
3497	}
3498	else
3499	{
3500	rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3501	tmp_typ[typ_i]);
3502	typ_i++;
3503	rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3504	prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3505	}
3506	break;
3507
3508	case ringorder_Ds:
3509	if (r->block0[i]==r->block1[i])
3510	{
3511	rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
3512	tmp_ordsgn,v, bits, -1);
3513	}
3514	else
3515	{
3516	rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3517	tmp_typ[typ_i]);
3518	typ_i++;
3519	rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3520	tmp_ordsgn,v, bits, r->block1[i]);
3521	}
3522	break;
3523
3524	case ringorder_wp:
3525	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3526	tmp_typ[typ_i], r->wvhdl[i]);
3527	typ_i++;
3528	{ // check for weights <=0
3529	int jj;
3530	BOOLEAN have_bad_weights=FALSE;
3531	for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3532	{
3533	if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3534	}
3535	if (have_bad_weights)
3536	{
3537	rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3538	tmp_typ[typ_i]);
3539	typ_i++;
3540	}
3541	}
3542	if (r->block1[i]!=r->block0[i])
3543	{
3544	rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3545	tmp_ordsgn, v,bits, r->block0[i]);
3546	}
3547	break;
3548
3549	case ringorder_Wp:
3550	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3551	tmp_typ[typ_i], r->wvhdl[i]);
3552	typ_i++;
3553	{ // check for weights <=0
3554	int jj;
3555	BOOLEAN have_bad_weights=FALSE;
3556	for(jj=r->block1[i]-r->block0[i];jj>=0; jj--)
3557	{
3558	if (r->wvhdl[i][jj]<=0) have_bad_weights=TRUE;
3559	}
3560	if (have_bad_weights)
3561	{
3562	rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3563	tmp_typ[typ_i]);
3564	typ_i++;
3565	}
3566	}
3567	if (r->block1[i]!=r->block0[i])
3568	{
3569	rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3570	tmp_ordsgn,v, bits, r->block1[i]);
3571	}
3572	break;
3573
3574	case ringorder_ws:
3575	rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3576	tmp_typ[typ_i], r->wvhdl[i]);
3577	typ_i++;
3578	if (r->block1[i]!=r->block0[i])
3579	{
3580	rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3581	tmp_ordsgn, v,bits, r->block0[i]);
3582	}
3583	break;
3584
3585	case ringorder_Ws:
3586	rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3587	tmp_typ[typ_i], r->wvhdl[i]);
3588	typ_i++;
3589	if (r->block1[i]!=r->block0[i])
3590	{
3591	rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3592	tmp_ordsgn,v, bits, r->block1[i]);
3593	}
3594	break;
3595
3596	case ringorder_S:
3597	assume(typ_i == 1); // For LaScala3 only: on the 2nd place ([1])!
3598	// TODO: for K[x]: it is 0...?!
3599	rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3600	need_to_add_comp=TRUE;
3601	r->ComponentOrder=-1;
3602	typ_i++;
3603	break;
3604
3605	case ringorder_s:
3606	assume(typ_i == 0 && j == 0);
3607	rO_Syz(j, j_bits, prev_ordsgn, tmp_ordsgn, tmp_typ[typ_i]); // set syz-limit?
3608	need_to_add_comp=TRUE;
3609	r->ComponentOrder=-1;
3610	typ_i++;
3611	break;
3612
3613	case ringorder_IS:
3614	{
3615
3616	assume( r->block0[i] == r->block1[i] );
3617	const int s = r->block0[i];
3618	assume( -2 < s && s < 2);
3619
3620	if(s == 0) // Prefix IS
3621	rO_ISPrefix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ[typ_i++]); // What about prev_ordsgn?
3622	else // s = +1 or -1 // Note: typ_i might be incrimented here inside!
3623	{
3624	rO_ISSuffix(j, j_bits, prev_ordsgn, tmp_ordsgn, r->N, v, tmp_typ, typ_i, s); // Suffix.
3625	need_to_add_comp=FALSE;
3626	}
3627
3628	break;
3629	}
3630	case ringorder_unspec:
3631	case ringorder_no:
3632	default:
3633	dReportError("undef. ringorder used\n");
3634	break;
3635	}
3636	}
3637	rCheckOrdSgn(r,n-1);
3638
3639	int j0=j; // save j
3640	int j_bits0=j_bits; // save jbits
3641	rO_Align(j,j_bits);
3642	r->CmpL_Size = j;
3643
3644	j_bits=j_bits0; j=j0;
3645
3646	// fill in some empty slots with variables not already covered
3647	// v0 is special, is therefore normally already covered
3648	// now we do have rings without comp...
3649	if((need_to_add_comp) && (v[0]== -1))
3650	{
3651	if (prev_ordsgn==1)
3652	{
3653	rO_Align(j, j_bits);
3654	rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3655	}
3656	else
3657	{
3658	rO_Align(j, j_bits);
3659	rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3660	}
3661	}
3662	// the variables
3663	for(i=1 ; i<=r->N ; i++)
3664	{
3665	if(v[i]==(-1))
3666	{
3667	if (prev_ordsgn==1)
3668	{
3669	rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3670	}
3671	else
3672	{
3673	rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3674	}
3675	}
3676	}
3677
3678	rO_Align(j,j_bits);
3679	// ----------------------------
3680	// finished with constructing the monomial, computing sizes:
3681
3682	r->ExpL_Size=j;
3683	r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
3684	assume(r->PolyBin != NULL);
3685
3686	// ----------------------------
3687	// indices and ordsgn vector for comparison
3688	//
3689	// r->pCompHighIndex already set
3690	r->ordsgn=(long )omAlloc0(r->ExpL_Sizesizeof(long));
3691
3692	for(j=0;j<r->CmpL_Size;j++)
3693	{
3694	r->ordsgn[j] = tmp_ordsgn[j];
3695	}
3696
3697	omFreeSize((ADDRESS)tmp_ordsgn,(3(n+r->N)sizeof(long)));
3698
3699	// ----------------------------
3700	// description of orderings for setm:
3701	//
3702	r->OrdSize=typ_i;
3703	if (typ_i==0) r->typ=NULL;
3704	else
3705	{
3706	r->typ=(sro_ord)omAlloc(typ_isizeof(sro_ord));
3707	memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3708	}
3709	omFreeSize((ADDRESS)tmp_typ,(3(n+r->N)sizeof(sro_ord)));
3710
3711	// ----------------------------
3712	// indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3713	r->VarOffset=v;
3714
3715	// ----------------------------
3716	// other indicies
3717	r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
3718	i=0; // position
3719	j=0; // index in r->typ
3720	if (i==r->pCompIndex) i++; // IS???
3721	while ((j < r->OrdSize)
3722	&& ((r->typ[j].ord_typ==ro_syzcomp) \|\|
3723	(r->typ[j].ord_typ==ro_syz) \|\| (r->typ[j].ord_typ==ro_isTemp) \|\| (r->typ[j].ord_typ==ro_is) \|\|
3724	(r->order[r->typ[j].order_index] == ringorder_aa)))
3725	{
3726	i++; j++;
3727	}
3728
3729	if (i==r->pCompIndex) i++;
3730	r->pOrdIndex=i;
3731
3732	// ----------------------------
3733	rSetDegStuff(r); // OrdSgn etc already set
3734	rSetOption(r);
3735	// ----------------------------
3736	// r->p_Setm
3737	r->p_Setm = p_GetSetmProc(r);
3738
3739	// ----------------------------
3740	// set VarL_*
3741	rSetVarL(r);
3742
3743	// ----------------------------
3744	// right-adjust VarOffset
3745	rRightAdjustVarOffset(r);
3746
3747	// ----------------------------
3748	// set NegWeightL*
3749	rSetNegWeight(r);
3750
3751	// ----------------------------
3752	// p_Procs: call AFTER NegWeightL
3753	r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3754	p_ProcsSet(r, r->p_Procs);
3755
3756	// use totaldegree on crazy oderings:
3757	if ((r->pFDeg==p_WTotaldegree) && rOrd_is_MixedDegree_Ordering(r))
3758	r->pFDeg = p_Totaldegree;
3759	return FALSE;
3760	}
3761
3762	static void rCheckOrdSgn(ring r,int b/last block/)
3763	{ // set r->OrdSgn, r->MixedOrder
3764	// for each variable:
3765	int nonpos=0;
3766	int nonneg=0;
3767	for(int i=1;i<=r->N;i++)
3768	{
3769	int found=0;
3770	// for all blocks:
3771	for(int j=0;(j<=b) && (found==0);j++)
3772	{
3773	// search the first block containing var(i)
3774	if ((r->block0[j]<=i)&&(r->block1[j]>=i))
3775	{
3776	// what kind if block is it?
3777	if ((r->order[j]==ringorder_ls)
3778	\|\| (r->order[j]==ringorder_ds)
3779	\|\| (r->order[j]==ringorder_Ds)
3780	\|\| (r->order[j]==ringorder_ws)
3781	\|\| (r->order[j]==ringorder_Ws)
3782	\|\| (r->order[j]==ringorder_rs))
3783	{
3784	r->OrdSgn=-1;
3785	nonpos++;
3786	found=1;
3787	}
3788	else if((r->order[j]==ringorder_a)
3789	\|\|(r->order[j]==ringorder_aa))
3790	{
3791	// <0: local/mixed ordering
3792	// >0: var(i) is okay, look at other vars
3793	// ==0: look at other blocks for var(i)
3794	if(r->wvhdl[j][i-r->block0[j]]<0)
3795	{
3796	r->OrdSgn=-1;
3797	nonpos++;
3798	found=1;
3799	}
3800	else if(r->wvhdl[j][i-r->block0[j]]>0)
3801	{
3802	nonneg++;
3803	found=1;
3804	}
3805	}
3806	else if(r->order[j]==ringorder_M)
3807	{
3808	// <0: local/mixed ordering
3809	// >0: var(i) is okay, look at other vars
3810	// ==0: look at other blocks for var(i)
3811	if(r->wvhdl[j][i-r->block0[j]]<0)
3812	{
3813	r->OrdSgn=-1;
3814	nonpos++;
3815	found=1;
3816	}
3817	else if(r->wvhdl[j][i-r->block0[j]]>0)
3818	{
3819	nonneg++;
3820	found=1;
3821	}
3822	else
3823	{
3824	// very bad:
3825	nonpos++;
3826	nonneg++;
3827	found=1;
3828	}
3829	}
3830	else if ((r->order[j]==ringorder_lp)
3831	\|\| (r->order[j]==ringorder_dp)
3832	\|\| (r->order[j]==ringorder_Dp)
3833	\|\| (r->order[j]==ringorder_wp)
3834	\|\| (r->order[j]==ringorder_Wp)
3835	\|\| (r->order[j]==ringorder_rp))
3836	{
3837	found=1;
3838	nonneg++;
3839	}
3840	}
3841	}
3842	}
3843	if (nonpos>0)
3844	{
3845	r->OrdSgn=-1;
3846	if (nonneg>0) r->MixedOrder=1;
3847	}
3848	else
3849	{
3850	r->OrdSgn=1;
3851	r->MixedOrder=0;
3852	}
3853	}
3854
3855	void rUnComplete(ring r)
3856	{
3857	if (r == NULL) return;
3858	if (r->VarOffset != NULL)
3859	{
3860	if (r->OrdSize!=0 && r->typ != NULL)
3861	{
3862	for(int i = 0; i < r->OrdSize; i++)
3863	if( r->typ[i].ord_typ == ro_is) // Search for suffixes! (prefix have the same VarOffset)
3864	{
3865	id_Delete(&r->typ[i].data.is.F, r);
3866	r->typ[i].data.is.F = NULL; // ?
3867
3868	if( r->typ[i].data.is.pVarOffset != NULL )
3869	{
3870	omFreeSize((ADDRESS)r->typ[i].data.is.pVarOffset, (r->N +1)*sizeof(int));
3871	r->typ[i].data.is.pVarOffset = NULL; // ?
3872	}
3873	}
3874	else if (r->typ[i].ord_typ == ro_syz)
3875	{
3876	if(r->typ[i].data.syz.limit > 0)
3877	omFreeSize(r->typ[i].data.syz.syz_index, ((r->typ[i].data.syz.limit) +1)*sizeof(int));
3878	r->typ[i].data.syz.syz_index = NULL;
3879	}
3880	else if (r->typ[i].ord_typ == ro_syzcomp)
3881	{
3882	assume( r->typ[i].data.syzcomp.ShiftedComponents == NULL );
3883	assume( r->typ[i].data.syzcomp.Components == NULL );
3884	// WarnS( "rUnComplete : ord_typ == ro_syzcomp was unhandled!!! Possibly memory leak!!!" );
3885	#ifndef SING_NDEBUG
3886	// assume(0);
3887	#endif
3888	}
3889
3890	omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord)); r->typ = NULL;
3891	}
3892
3893	if (r->PolyBin != NULL)
3894	omUnGetSpecBin(&(r->PolyBin));
3895
3896	omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3897
3898	if (r->ordsgn != NULL && r->CmpL_Size != 0)
3899	omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
3900	if (r->p_Procs != NULL)
3901	omFreeSize(r->p_Procs, sizeof(p_Procs_s));
3902	omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
3903	}
3904	if (r->NegWeightL_Offset!=NULL)
3905	{
3906	omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
3907	r->NegWeightL_Offset=NULL;
3908	}
3909	}
3910
3911	// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
3912	static void rSetVarL(ring r)
3913	{
3914	int min = MAX_INT_VAL, min_j = -1;
3915	int* VarL_Number = (int) omAlloc0(r->ExpL_Sizesizeof(int));
3916
3917	int i,j;
3918
3919	// count how often a var long is occupied by an exponent
3920	for (i=1; i<=r->N; i++)
3921	{
3922	VarL_Number[r->VarOffset[i] & 0xffffff]++;
3923	}
3924
3925	// determine how many and min
3926	for (i=0, j=0; i<r->ExpL_Size; i++)
3927	{
3928	if (VarL_Number[i] != 0)
3929	{
3930	if (min > VarL_Number[i])
3931	{
3932	min = VarL_Number[i];
3933	min_j = j;
3934	}
3935	j++;
3936	}
3937	}
3938
3939	r->VarL_Size = j; // number of long with exp. entries in
3940	// in p->exp
3941	r->VarL_Offset = (int) omAlloc(r->VarL_Sizesizeof(int));
3942	r->VarL_LowIndex = 0;
3943
3944	// set VarL_Offset
3945	for (i=0, j=0; i<r->ExpL_Size; i++)
3946	{
3947	if (VarL_Number[i] != 0)
3948	{
3949	r->VarL_Offset[j] = i;
3950	if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
3951	r->VarL_LowIndex = -1;
3952	j++;
3953	}
3954	}
3955	if (r->VarL_LowIndex >= 0)
3956	r->VarL_LowIndex = r->VarL_Offset[0];
3957
3958	if (min_j != 0)
3959	{
3960	j = r->VarL_Offset[min_j];
3961	r->VarL_Offset[min_j] = r->VarL_Offset[0];
3962	r->VarL_Offset[0] = j;
3963	}
3964	omFree(VarL_Number);
3965	}
3966
3967	static void rRightAdjustVarOffset(ring r)
3968	{
3969	int* shifts = (int) omAlloc(r->ExpL_Sizesizeof(int));
3970	int i;
3971	// initialize shifts
3972	for (i=0;i<r->ExpL_Size;i++)
3973	shifts[i] = BIT_SIZEOF_LONG;
3974
3975	// find minimal bit shift in each long exp entry
3976	for (i=1;i<=r->N;i++)
3977	{
3978	if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3979	shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3980	}
3981	// reset r->VarOffset: set the minimal shift to 0
3982	for (i=1;i<=r->N;i++)
3983	{
3984	if (shifts[r->VarOffset[i] & 0xffffff] != 0)
3985	r->VarOffset[i]
3986	= (r->VarOffset[i] & 0xffffff) \|
3987	(((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
3988	}
3989	omFree(shifts);
3990	}
3991
3992	// get r->divmask depending on bits per exponent
3993	static unsigned long rGetDivMask(int bits)
3994	{
3995	unsigned long divmask = 1;
3996	int i = bits;
3997
3998	while (i < BIT_SIZEOF_LONG)
3999	{
4000	divmask \|= (((unsigned long) 1) << (unsigned long) i);
4001	i += bits;
4002	}
4003	return divmask;
4004	}
4005
4006	#ifdef RDEBUG
4007	void rDebugPrint(const ring r)
4008	{
4009	if (r==NULL)
4010	{
4011	PrintS("NULL ?\n");
4012	return;
4013	}
4014	// corresponds to ro_typ from ring.h:
4015	const char *TYP[]={"ro_dp","ro_wp","ro_am","ro_wp64","ro_wp_neg","ro_cp",
4016	"ro_syzcomp", "ro_syz", "ro_isTemp", "ro_is", "ro_none"};
4017	int i,j;
4018
4019	Print("ExpL_Size:%d ",r->ExpL_Size);
4020	Print("CmpL_Size:%d ",r->CmpL_Size);
4021	Print("VarL_Size:%d\n",r->VarL_Size);
4022	Print("bitmask=0x%lx (expbound=%ld) \n",r->bitmask, r->bitmask);
4023	Print("divmask=%lx\n", r->divmask);
4024	Print("BitsPerExp=%d ExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->VarL_Offset[0]);
4025
4026	Print("VarL_LowIndex: %d\n", r->VarL_LowIndex);
4027	PrintS("VarL_Offset:\n");
4028	if (r->VarL_Offset==NULL) PrintS(" NULL");
4029	else
4030	for(j = 0; j < r->VarL_Size; j++)
4031	Print(" VarL_Offset[%d]: %d ", j, r->VarL_Offset[j]);
4032	PrintLn();
4033
4034
4035	PrintS("VarOffset:\n");
4036	if (r->VarOffset==NULL) PrintS(" NULL\n");
4037	else
4038	for(j=0;j<=r->N;j++)
4039	Print(" v%d at e-pos %d, bit %d\n",
4040	j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
4041	PrintS("ordsgn:\n");
4042	for(j=0;j<r->CmpL_Size;j++)
4043	Print(" ordsgn %ld at pos %d\n",r->ordsgn[j],j);
4044	Print("OrdSgn:%d\n",r->OrdSgn);
4045	PrintS("ordrec:\n");
4046	for(j=0;j<r->OrdSize;j++)
4047	{
4048	Print(" typ %s", TYP[r->typ[j].ord_typ]);
4049	if (r->typ[j].ord_typ==ro_syz)
4050	{
4051	const short place = r->typ[j].data.syz.place;
4052	const int limit = r->typ[j].data.syz.limit;
4053	const int curr_index = r->typ[j].data.syz.curr_index;
4054	const int* syz_index = r->typ[j].data.syz.syz_index;
4055
4056	Print(" limit %d (place: %d, curr_index: %d), syz_index: ", limit, place, curr_index);
4057
4058	if( syz_index == NULL )
4059	PrintS("(NULL)");
4060	else
4061	{
4062	PrintS("{");
4063	for( i=0; i <= limit; i++ )
4064	Print("%d ", syz_index[i]);
4065	PrintS("}");
4066	}
4067
4068	}
4069	else if (r->typ[j].ord_typ==ro_isTemp)
4070	{
4071	Print(" start (level) %d, suffixpos: %d, VO: ",r->typ[j].data.isTemp.start, r->typ[j].data.isTemp.suffixpos);
4072
4073	}
4074	else if (r->typ[j].ord_typ==ro_is)
4075	{
4076	Print(" start %d, end: %d: ",r->typ[j].data.is.start, r->typ[j].data.is.end);
4077
4078	// for( int k = 0; k <= r->N; k++) if (r->typ[j].data.is.pVarOffset[k] != -1) Print("[%2d]: %04x; ", k, r->typ[j].data.is.pVarOffset[k]);
4079
4080	Print(" limit %d",r->typ[j].data.is.limit);
4081	#ifndef SING_NDEBUG
4082	//PrintS(" F: ");idShow(r->typ[j].data.is.F, r, r, 1);
4083	#endif
4084
4085	PrintLn();
4086	}
4087	else if (r->typ[j].ord_typ==ro_am)
4088	{
4089	Print(" place %d",r->typ[j].data.am.place);
4090	Print(" start %d",r->typ[j].data.am.start);
4091	Print(" end %d",r->typ[j].data.am.end);
4092	Print(" len_gen %d",r->typ[j].data.am.len_gen);
4093	PrintS(" w:");
4094	int l=0;
4095	for(l=r->typ[j].data.am.start;l<=r->typ[j].data.am.end;l++)
4096	Print(" %d",r->typ[j].data.am.weights[l-r->typ[j].data.am.start]);
4097	l=r->typ[j].data.am.end+1;
4098	int ll=r->typ[j].data.am.weights[l-r->typ[j].data.am.start];
4099	PrintS(" m:");
4100	for(int lll=l+1;lll<l+ll+1;lll++)
4101	Print(" %d",r->typ[j].data.am.weights[lll-r->typ[j].data.am.start]);
4102	}
4103	else
4104	{
4105	Print(" place %d",r->typ[j].data.dp.place);
4106
4107	if (r->typ[j].ord_typ!=ro_syzcomp && r->typ[j].ord_typ!=ro_syz)
4108	{
4109	Print(" start %d",r->typ[j].data.dp.start);
4110	Print(" end %d",r->typ[j].data.dp.end);
4111	if ((r->typ[j].ord_typ==ro_wp)
4112	\|\| (r->typ[j].ord_typ==ro_wp_neg))
4113	{
4114	PrintS(" w:");
4115	for(int l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
4116	Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
4117	}
4118	else if (r->typ[j].ord_typ==ro_wp64)
4119	{
4120	PrintS(" w64:");
4121	int l;
4122	for(l=r->typ[j].data.wp64.start;l<=r->typ[j].data.wp64.end;l++)
4123	Print(" %ld",(long)(((int64*)r->typ[j].data.wp64.weights64)+l-r->typ[j].data.wp64.start));
4124	}
4125	}
4126	}
4127	PrintLn();
4128	}
4129	Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
4130	Print("OrdSize:%d\n",r->OrdSize);
4131	PrintS("--------------------\n");
4132	for(j=0;j<r->ExpL_Size;j++)
4133	{
4134	Print("L[%d]: ",j);
4135	if (j< r->CmpL_Size)
4136	Print("ordsgn %ld ", r->ordsgn[j]);
4137	else
4138	PrintS("no comp ");
4139	i=1;
4140	for(;i<=r->N;i++)
4141	{
4142	if( (r->VarOffset[i] & 0xffffff) == j )
4143	{ Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
4144	r->VarOffset[i] >>24 ); }
4145	}
4146	if( r->pCompIndex==j ) PrintS("v0; ");
4147	for(i=0;i<r->OrdSize;i++)
4148	{
4149	if (r->typ[i].data.dp.place == j)
4150	{
4151	Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
4152	r->typ[i].data.dp.start, r->typ[i].data.dp.end);
4153	}
4154	}
4155
4156	if (j==r->pOrdIndex)
4157	PrintS("pOrdIndex\n");
4158	else
4159	PrintLn();
4160	}
4161	Print("LexOrder:%d, MixedOrder:%d\n",r->LexOrder, r->MixedOrder);
4162
4163	Print("NegWeightL_Size: %d, NegWeightL_Offset: ", r->NegWeightL_Size);
4164	if (r->NegWeightL_Offset==NULL) PrintS(" NULL");
4165	else
4166	for(j = 0; j < r->NegWeightL_Size; j++)
4167	Print(" [%d]: %d ", j, r->NegWeightL_Offset[j]);
4168	PrintLn();
4169
4170	// p_Procs stuff
4171	p_Procs_s proc_names;
4172	const char* field;
4173	const char* length;
4174	const char* ord;
4175	p_Debug_GetProcNames(r, &proc_names); // changes p_Procs!!!
4176	p_Debug_GetSpecNames(r, field, length, ord);
4177
4178	Print("p_Spec : %s, %s, %s\n", field, length, ord);
4179	PrintS("p_Procs :\n");
4180	for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
4181	{
4182	Print(" %s,\n", ((char**) &proc_names)[i]);
4183	}
4184
4185	{
4186	PrintLn();
4187	PrintS("pFDeg : ");
4188	#define pFDeg_CASE(A) if(r->pFDeg == A) PrintS( "" #A "" )
4189	pFDeg_CASE(p_Totaldegree); else
4190	pFDeg_CASE(p_WFirstTotalDegree); else
4191	pFDeg_CASE(p_WTotaldegree); else
4192	pFDeg_CASE(p_Deg); else
4193	#undef pFDeg_CASE
4194	Print("(%p)", r->pFDeg); // default case
4195
4196	PrintLn();
4197	Print("pLDeg : (%p)", r->pLDeg);
4198	PrintLn();
4199	}
4200	PrintS("pSetm:");
4201	void p_Setm_Dummy(poly p, const ring r);
4202	void p_Setm_TotalDegree(poly p, const ring r);
4203	void p_Setm_WFirstTotalDegree(poly p, const ring r);
4204	void p_Setm_General(poly p, const ring r);
4205	if (r->p_Setm==p_Setm_General) PrintS("p_Setm_General\n");
4206	else if (r->p_Setm==p_Setm_Dummy) PrintS("p_Setm_Dummy\n");
4207	else if (r->p_Setm==p_Setm_TotalDegree) PrintS("p_Setm_Totaldegree\n");
4208	else if (r->p_Setm==p_Setm_WFirstTotalDegree) PrintS("p_Setm_WFirstTotalDegree\n");
4209	else Print("%p\n",r->p_Setm);
4210	}
4211
4212	void p_DebugPrint(poly p, const ring r)
4213	{
4214	int i,j;
4215	p_Write(p,r);
4216	j=2;
4217	while(p!=NULL)
4218	{
4219	Print("\nexp[0..%d]\n",r->ExpL_Size-1);
4220	for(i=0;i<r->ExpL_Size;i++)
4221	Print("%ld ",p->exp[i]);
4222	PrintLn();
4223	Print("v0:%ld ",p_GetComp(p, r));
4224	for(i=1;i<=r->N;i++) Print(" v%d:%ld",i,p_GetExp(p,i, r));
4225	PrintLn();
4226	pIter(p);
4227	j--;
4228	if (j==0) { PrintS("...\n"); break; }
4229	}
4230	}
4231
4232	#endif // RDEBUG
4233
4234	/// debug-print monomial poly/vector p, assuming that it lives in the ring R
4235	static inline void m_DebugPrint(const poly p, const ring R)
4236	{
4237	Print("\nexp[0..%d]\n", R->ExpL_Size - 1);
4238	for(int i = 0; i < R->ExpL_Size; i++)
4239	Print("%09lx ", p->exp[i]);
4240	PrintLn();
4241	Print("v0:%9ld ", p_GetComp(p, R));
4242	for(int i = 1; i <= R->N; i++) Print(" v%d:%5ld",i, p_GetExp(p, i, R));
4243	PrintLn();
4244	}
4245
4246
4247	// F = system("ISUpdateComponents", F, V, MIN );
4248	// // replace gen(i) -> gen(MIN + V[i-MIN]) for all i > MIN in all terms from F!
4249	void pISUpdateComponents(ideal F, const intvec *const V, const int MIN, const ring r )
4250	{
4251	assume( V != NULL );
4252	assume( MIN >= 0 );
4253
4254	if( F == NULL )
4255	return;
4256
4257	for( int j = (F->ncols*F->nrows) - 1; j >= 0; j-- )
4258	{
4259	#ifdef PDEBUG
4260	Print("F[%d]:", j);
4261	p_wrp(F->m[j], r);
4262	#endif
4263
4264	for( poly p = F->m[j]; p != NULL; pIter(p) )
4265	{
4266	int c = p_GetComp(p, r);
4267
4268	if( c > MIN )
4269	{
4270	#ifdef PDEBUG
4271	Print("gen[%d] -> gen(%d)\n", c, MIN + (*V)[ c - MIN - 1 ]);
4272	#endif
4273
4274	p_SetComp( p, MIN + (*V)[ c - MIN - 1 ], r );
4275	}
4276	}
4277	#ifdef PDEBUG
4278	Print("new F[%d]:", j);
4279	p_Test(F->m[j], r);
4280	p_wrp(F->m[j], r);
4281	#endif
4282	}
4283	}
4284
4285	/*2
4286	* asssume that rComplete was called with r
4287	* assume that the first block ist ringorder_S
4288	* change the block to reflect the sequence given by appending v
4289	*/
4290	static inline void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
4291	{
4292	assume(r->typ[1].ord_typ == ro_syzcomp);
4293
4294	r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
4295	r->typ[1].data.syzcomp.Components = currComponents;
4296	}
4297
4298	static inline void rNGetSComps(int currComponents, long currShiftedComponents, ring r)
4299	{
4300	assume(r->typ[1].ord_typ == ro_syzcomp);
4301
4302	*currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
4303	*currComponents = r->typ[1].data.syzcomp.Components;
4304	}
4305	#ifdef PDEBUG
4306	static inline void rDBChangeSComps(int* currComponents,
4307	long* currShiftedComponents,
4308	int length,
4309	ring r)
4310	{
4311	assume(r->typ[1].ord_typ == ro_syzcomp);
4312
4313	r->typ[1].data.syzcomp.length = length;
4314	rNChangeSComps( currComponents, currShiftedComponents, r);
4315	}
4316	static inline void rDBGetSComps(int** currComponents,
4317	long** currShiftedComponents,
4318	int *length,
4319	ring r)
4320	{
4321	assume(r->typ[1].ord_typ == ro_syzcomp);
4322
4323	*length = r->typ[1].data.syzcomp.length;
4324	rNGetSComps( currComponents, currShiftedComponents, r);
4325	}
4326	#endif
4327
4328	void rChangeSComps(int* currComponents, long* currShiftedComponents, int length, ring r)
4329	{
4330	#ifdef PDEBUG
4331	rDBChangeSComps(currComponents, currShiftedComponents, length, r);
4332	#else
4333	rNChangeSComps(currComponents, currShiftedComponents, r);
4334	#endif
4335	}
4336
4337	void rGetSComps(int currComponents, long currShiftedComponents, int *length, ring r)
4338	{
4339	#ifdef PDEBUG
4340	rDBGetSComps(currComponents, currShiftedComponents, length, r);
4341	#else
4342	rNGetSComps(currComponents, currShiftedComponents, r);
4343	#endif
4344	}
4345
4346
4347	/////////////////////////////////////////////////////////////////////////////
4348	//
4349	// The following routines all take as input a ring r, and return R
4350	// where R has a certain property. R might be equal r in which case r
4351	// had already this property
4352	//
4353	ring rAssure_SyzOrder(const ring r, BOOLEAN complete)
4354	{
4355	if ( r->order[0] == ringorder_c ) return r;
4356	return rAssure_SyzComp(r,complete);
4357	}
4358	ring rAssure_SyzComp(const ring r, BOOLEAN complete)
4359	{
4360	if ( r->order[0] == ringorder_s ) return r;
4361
4362	if ( r->order[0] == ringorder_IS )
4363	{
4364	#ifndef SING_NDEBUG
4365	WarnS("rAssure_SyzComp: input ring has an IS-ordering!");
4366	#endif
4367	// return r;
4368	}
4369	ring res=rCopy0(r, FALSE, FALSE);
4370	int i=rBlocks(r);
4371	int j;
4372
4373	res->order=(rRingOrder_t )omAlloc((i+1)sizeof(rRingOrder_t));
4374	res->block0=(int )omAlloc0((i+1)sizeof(int));
4375	res->block1=(int )omAlloc0((i+1)sizeof(int));
4376	int wvhdl =(int )omAlloc0((i+1)sizeof(int*));
4377	for(j=i;j>0;j--)
4378	{
4379	res->order[j]=r->order[j-1];
4380	res->block0[j]=r->block0[j-1];
4381	res->block1[j]=r->block1[j-1];
4382	if (r->wvhdl[j-1] != NULL)
4383	{
4384	wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
4385	}
4386	}
4387	res->order[0]=ringorder_s;
4388
4389	res->wvhdl = wvhdl;
4390
4391	if (complete)
4392	{
4393	rComplete(res, 1);
4394
4395	#ifdef HAVE_PLURAL
4396	if (rIsPluralRing(r))
4397	{
4398	if ( nc_rComplete(r, res, false) ) // no qideal!
4399	{
4400	#ifndef SING_NDEBUG
4401	WarnS("error in nc_rComplete"); // cleanup?// rDelete(res);// return r; // just go on..
4402	#endif
4403	}
4404	}
4405	assume(rIsPluralRing(r) == rIsPluralRing(res));
4406	#endif
4407
4408	#ifdef HAVE_PLURAL
4409	ring old_ring = r;
4410	#endif
4411
4412	if (r->qideal!=NULL)
4413	{
4414	res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4415
4416	assume(id_RankFreeModule(res->qideal, res) == 0);
4417
4418	#ifdef HAVE_PLURAL
4419	if( rIsPluralRing(res) )
4420	if( nc_SetupQuotient(res, r, true) )
4421	{
4422	// WarnS("error in nc_SetupQuotient"); // cleanup? rDelete(res); return r; // just go on...?
4423	}
4424
4425	#endif
4426	assume(id_RankFreeModule(res->qideal, res) == 0);
4427	}
4428
4429	#ifdef HAVE_PLURAL
4430	assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4431	assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4432	assume(rIsSCA(res) == rIsSCA(old_ring));
4433	assume(ncRingType(res) == ncRingType(old_ring));
4434	#endif
4435	}
4436	return res;
4437	}
4438
4439	BOOLEAN rHasTDeg(ring r)
4440	{
4441	int i;
4442	if (r->typ!=NULL)
4443	{
4444	for(i=r->OrdSize-1;i>=0;i--)
4445	{
4446	if ((r->typ[i].ord_typ==ro_dp)
4447	&& (r->typ[i].data.dp.start==1)
4448	&& (r->typ[i].data.dp.end==r->N))
4449	{
4450	return TRUE;
4451	}
4452	}
4453	}
4454	return FALSE;
4455	}
4456
4457	ring rAssure_TDeg(ring r, int &pos)
4458	{
4459	int i;
4460	if (r->typ!=NULL)
4461	{
4462	for(i=r->OrdSize-1;i>=0;i--)
4463	{
4464	if ((r->typ[i].ord_typ==ro_dp)
4465	&& (r->typ[i].data.dp.start==1)
4466	&& (r->typ[i].data.dp.end==r->N))
4467	{
4468	pos=r->typ[i].data.dp.place;
4469	//printf("no change, pos=%d\n",pos);
4470	return r;
4471	}
4472	}
4473	}
4474
4475	#ifdef HAVE_PLURAL
4476	nc_struct* save=r->GetNC();
4477	r->GetNC()=NULL;
4478	#endif
4479	ring res=rCopy(r);
4480	if (res->qideal!=NULL)
4481	{
4482	id_Delete(&res->qideal,r);
4483	}
4484
4485	i=rBlocks(r);
4486	int j;
4487
4488	res->ExpL_Size=r->ExpL_Size+1; // one word more in each monom
4489	res->PolyBin=omGetSpecBin(POLYSIZE + (res->ExpL_Size)*sizeof(long));
4490	omFree((ADDRESS)res->ordsgn);
4491	res->ordsgn=(long )omAlloc0(res->ExpL_Sizesizeof(long));
4492	for(j=0;j<r->CmpL_Size;j++)
4493	{
4494	res->ordsgn[j] = r->ordsgn[j];
4495	}
4496	res->OrdSize=r->OrdSize+1; // one block more for pSetm
4497	if (r->typ!=NULL)
4498	omFree((ADDRESS)res->typ);
4499	res->typ=(sro_ord)omAlloc0(res->OrdSizesizeof(sro_ord));
4500	if (r->typ!=NULL)
4501	memcpy(res->typ,r->typ,r->OrdSize*sizeof(sro_ord));
4502	// the additional block for pSetm: total degree at the last word
4503	// but not included in the compare part
4504	res->typ[res->OrdSize-1].ord_typ=ro_dp;
4505	res->typ[res->OrdSize-1].data.dp.start=1;
4506	res->typ[res->OrdSize-1].data.dp.end=res->N;
4507	res->typ[res->OrdSize-1].data.dp.place=res->ExpL_Size-1;
4508	pos=res->ExpL_Size-1;
4509	//res->pOrdIndex=pos; //NO: think of a(1,0),dp !
4510	extern void p_Setm_General(poly p, ring r);
4511	res->p_Setm=p_Setm_General;
4512	// ----------------------------
4513	omFree((ADDRESS)res->p_Procs);
4514	res->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
4515
4516	p_ProcsSet(res, res->p_Procs);
4517	#ifdef HAVE_PLURAL
4518	r->GetNC()=save;
4519	if (rIsPluralRing(r))
4520	{
4521	if ( nc_rComplete(r, res, false) ) // no qideal!
4522	{
4523	#ifndef SING_NDEBUG
4524	WarnS("error in nc_rComplete");
4525	#endif
4526	// just go on..
4527	}
4528	}
4529	#endif
4530	if (r->qideal!=NULL)
4531	{
4532	res->qideal=idrCopyR_NoSort(r->qideal,r, res);
4533	#ifdef HAVE_PLURAL
4534	if (rIsPluralRing(res))
4535	{
4536	// nc_SetupQuotient(res, currRing);
4537	nc_SetupQuotient(res, r); // ?
4538	}
4539	assume((res->qideal==NULL) == (r->qideal==NULL));
4540	#endif
4541	}
4542
4543	#ifdef HAVE_PLURAL
4544	assume(rIsPluralRing(res) == rIsPluralRing(r));
4545	assume(rIsSCA(res) == rIsSCA(r));
4546	assume(ncRingType(res) == ncRingType(r));
4547	#endif
4548
4549	return res;
4550	}
4551
4552	ring rAssure_HasComp(const ring r)
4553	{
4554	int last_block;
4555	int i=0;
4556	do
4557	{
4558	if (r->order[i] == ringorder_c \|\|
4559	r->order[i] == ringorder_C) return r;
4560	if (r->order[i] == 0)
4561	break;
4562	i++;
4563	} while (1);
4564	//WarnS("re-creating ring with comps");
4565	last_block=i-1;
4566
4567	ring new_r = rCopy0(r, FALSE, FALSE);
4568	i+=2;
4569	new_r->wvhdl=(int *)omAlloc0(i sizeof(int *));
4570	new_r->order = (rRingOrder_t ) omAlloc0(i sizeof(rRingOrder_t));
4571	new_r->block0 = (int ) omAlloc0(i sizeof(int));
4572	new_r->block1 = (int ) omAlloc0(i sizeof(int));
4573	memcpy(new_r->order,r->order,(i-1) * sizeof(rRingOrder_t));
4574	memcpy(new_r->block0,r->block0,(i-1) * sizeof(int));
4575	memcpy(new_r->block1,r->block1,(i-1) * sizeof(int));
4576	for (int j=0; j<=last_block; j++)
4577	{
4578	if (r->wvhdl[j]!=NULL)
4579	{
4580	new_r->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
4581	}
4582	}
4583	last_block++;
4584	new_r->order[last_block]=ringorder_C;
4585	//new_r->block0[last_block]=0;
4586	//new_r->block1[last_block]=0;
4587	//new_r->wvhdl[last_block]=NULL;
4588
4589	rComplete(new_r, 1);
4590
4591	#ifdef HAVE_PLURAL
4592	if (rIsPluralRing(r))
4593	{
4594	if ( nc_rComplete(r, new_r, false) ) // no qideal!
4595	{
4596	#ifndef SING_NDEBUG
4597	WarnS("error in nc_rComplete"); // cleanup?// rDelete(res);// return r; // just go on..
4598	#endif
4599	}
4600	}
4601	assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4602	#endif
4603
4604	return new_r;
4605	}
4606
4607	ring rAssure_CompLastBlock(ring r, BOOLEAN complete)
4608	{
4609	int last_block = rBlocks(r) - 2;
4610	if (r->order[last_block] != ringorder_c &&
4611	r->order[last_block] != ringorder_C)
4612	{
4613	int c_pos = 0;
4614	int i;
4615
4616	for (i=0; i< last_block; i++)
4617	{
4618	if (r->order[i] == ringorder_c \|\| r->order[i] == ringorder_C)
4619	{
4620	c_pos = i;
4621	break;
4622	}
4623	}
4624	if (c_pos != -1)
4625	{
4626	ring new_r = rCopy0(r, FALSE, TRUE);
4627	for (i=c_pos+1; i<=last_block; i++)
4628	{
4629	new_r->order[i-1] = new_r->order[i];
4630	new_r->block0[i-1] = new_r->block0[i];
4631	new_r->block1[i-1] = new_r->block1[i];
4632	new_r->wvhdl[i-1] = new_r->wvhdl[i];
4633	}
4634	new_r->order[last_block] = r->order[c_pos];
4635	new_r->block0[last_block] = r->block0[c_pos];
4636	new_r->block1[last_block] = r->block1[c_pos];
4637	new_r->wvhdl[last_block] = r->wvhdl[c_pos];
4638	if (complete)
4639	{
4640	rComplete(new_r, 1);
4641
4642	#ifdef HAVE_PLURAL
4643	if (rIsPluralRing(r))
4644	{
4645	if ( nc_rComplete(r, new_r, false) ) // no qideal!
4646	{
4647	#ifndef SING_NDEBUG
4648	WarnS("error in nc_rComplete"); // cleanup?// rDelete(res);// return r; // just go on..
4649	#endif
4650	}
4651	}
4652	assume(rIsPluralRing(r) == rIsPluralRing(new_r));
4653	#endif
4654	}
4655	return new_r;
4656	}
4657	}
4658	return r;
4659	}
4660
4661	// Moves _c or _C ordering to the last place AND adds _s on the 1st place
4662	ring rAssure_SyzComp_CompLastBlock(const ring r, BOOLEAN)
4663	{
4664	rTest(r);
4665
4666	ring new_r_1 = rAssure_CompLastBlock(r, FALSE); // due to this FALSE - no completion!
4667	ring new_r = rAssure_SyzComp(new_r_1, FALSE); // new_r_1 is used only here!!!
4668
4669	if (new_r == r)
4670	return r;
4671
4672	ring old_r = r;
4673	if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
4674
4675	rComplete(new_r, TRUE);
4676	#ifdef HAVE_PLURAL
4677	if (rIsPluralRing(old_r))
4678	{
4679	if ( nc_rComplete(old_r, new_r, false) ) // no qideal!
4680	{
4681	# ifndef SING_NDEBUG
4682	WarnS("error in nc_rComplete"); // cleanup? rDelete(res); return r; // just go on...?
4683	# endif
4684	}
4685	}
4686	#endif
4687
4688	///? rChangeCurrRing(new_r);
4689	if (old_r->qideal != NULL)
4690	{
4691	new_r->qideal = idrCopyR(old_r->qideal, old_r, new_r);
4692	}
4693
4694	#ifdef HAVE_PLURAL
4695	if( rIsPluralRing(old_r) )
4696	if( nc_SetupQuotient(new_r, old_r, true) )
4697	{
4698	#ifndef SING_NDEBUG
4699	WarnS("error in nc_SetupQuotient"); // cleanup? rDelete(res); return r; // just go on...?
4700	#endif
4701	}
4702	#endif
4703
4704	#ifdef HAVE_PLURAL
4705	assume((new_r->qideal==NULL) == (old_r->qideal==NULL));
4706	assume(rIsPluralRing(new_r) == rIsPluralRing(old_r));
4707	assume(rIsSCA(new_r) == rIsSCA(old_r));
4708	assume(ncRingType(new_r) == ncRingType(old_r));
4709	#endif
4710
4711	rTest(new_r);
4712	rTest(old_r);
4713	return new_r;
4714	}
4715
4716	// use this for global orderings consisting of two blocks
4717	static ring rAssure_Global(rRingOrder_t b1, rRingOrder_t b2, const ring r)
4718	{
4719	int r_blocks = rBlocks(r);
4720
4721	assume(b1 == ringorder_c \|\| b1 == ringorder_C \|\|
4722	b2 == ringorder_c \|\| b2 == ringorder_C \|\|
4723	b2 == ringorder_S);
4724	if ((r_blocks == 3) &&
4725	(r->order[0] == b1) &&
4726	(r->order[1] == b2) &&
4727	(r->order[2] == 0))
4728	return r;
4729	ring res = rCopy0(r, TRUE, FALSE);
4730	res->order = (rRingOrder_t)omAlloc0(3sizeof(rRingOrder_t));
4731	res->block0 = (int)omAlloc0(3sizeof(int));
4732	res->block1 = (int)omAlloc0(3sizeof(int));
4733	res->wvhdl = (int*)omAlloc0(3sizeof(int*));
4734	res->order[0] = b1;
4735	res->order[1] = b2;
4736	if (b1 == ringorder_c \|\| b1 == ringorder_C)
4737	{
4738	res->block0[1] = 1;
4739	res->block1[1] = r->N;
4740	}
4741	else
4742	{
4743	res->block0[0] = 1;
4744	res->block1[0] = r->N;
4745	}
4746	rComplete(res, 1);
4747	#ifdef HAVE_PLURAL
4748	if (rIsPluralRing(r))
4749	{
4750	if ( nc_rComplete(r, res, false) ) // no qideal!
4751	{
4752	#ifndef SING_NDEBUG
4753	WarnS("error in nc_rComplete");
4754	#endif
4755	}
4756	}
4757	#endif
4758	// rChangeCurrRing(res);
4759	return res;
4760	}
4761
4762	ring rAssure_InducedSchreyerOrdering(const ring r, BOOLEAN complete/* = TRUE/, int sgn/ = 1*/)
4763	{ // TODO: ???? Add leading Syz-comp ordering here...????
4764
4765	#if MYTEST
4766	Print("rAssure_InducedSchreyerOrdering(r, complete = %d, sgn = %d): r: \n", complete, sgn);
4767	rWrite(r);
4768	#ifdef RDEBUG
4769	rDebugPrint(r);
4770	#endif
4771	PrintLn();
4772	#endif
4773	assume((sgn == 1) \|\| (sgn == -1));
4774
4775	ring res=rCopy0(r, FALSE, FALSE); // No qideal & ordering copy.
4776
4777	int n = rBlocks(r); // Including trailing zero!
4778
4779	// Create 2 more blocks for prefix/suffix:
4780	res->order=(rRingOrder_t )omAlloc0((n+2)sizeof(rRingOrder_t)); // 0 .. n+1
4781	res->block0=(int )omAlloc0((n+2)sizeof(int));
4782	res->block1=(int )omAlloc0((n+2)sizeof(int));
4783	int wvhdl =(int )omAlloc0((n+2)sizeof(int*));
4784
4785	// Encapsulate all existing blocks between induced Schreyer ordering markers: prefix and suffix!
4786	// Note that prefix and suffix have the same ringorder marker and only differ in block[] parameters!
4787
4788	// new 1st block
4789	int j = 0;
4790	res->order[j] = ringorder_IS; // Prefix
4791	res->block0[j] = res->block1[j] = 0;
4792	// wvhdl[j] = NULL;
4793	j++;
4794
4795	for(int i = 0; (i <= n) && (r->order[i] != 0); i++, j++) // i = [0 .. n-1] <- non-zero old blocks
4796	{
4797	res->order [j] = r->order [i];
4798	res->block0[j] = r->block0[i];
4799	res->block1[j] = r->block1[i];
4800
4801	if (r->wvhdl[i] != NULL)
4802	{
4803	wvhdl[j] = (int*) omMemDup(r->wvhdl[i]);
4804	} // else wvhdl[j] = NULL;
4805	}
4806
4807	// new last block
4808	res->order [j] = ringorder_IS; // Suffix
4809	res->block0[j] = res->block1[j] = sgn; // Sign of v[o]: 1 for C, -1 for c
4810	// wvhdl[j] = NULL;
4811	j++;
4812
4813	// res->order [j] = 0; // The End!
4814	res->wvhdl = wvhdl;
4815
4816	// j == the last zero block now!
4817	assume(j == (n+1));
4818	assume(res->order[0]==ringorder_IS);
4819	assume(res->order[j-1]==ringorder_IS);
4820	assume(res->order[j]==0);
4821
4822
4823	if (complete)
4824	{
4825	rComplete(res, 1);
4826
4827	#ifdef HAVE_PLURAL
4828	if (rIsPluralRing(r))
4829	{
4830	if ( nc_rComplete(r, res, false) ) // no qideal!
4831	{
4832	#ifndef SING_NDEBUG
4833	WarnS("error in nc_rComplete"); // cleanup?// rDelete(res);// return r; // just go on..
4834	#endif
4835	}
4836	}
4837	assume(rIsPluralRing(r) == rIsPluralRing(res));
4838	#endif
4839
4840
4841	#ifdef HAVE_PLURAL
4842	ring old_ring = r;
4843	#endif
4844
4845	if (r->qideal!=NULL)
4846	{
4847	res->qideal= idrCopyR_NoSort(r->qideal, r, res);
4848
4849	assume(id_RankFreeModule(res->qideal, res) == 0);
4850
4851	#ifdef HAVE_PLURAL
4852	if( rIsPluralRing(res) )
4853	if( nc_SetupQuotient(res, r, true) )
4854	{
4855	// WarnS("error in nc_SetupQuotient"); // cleanup? rDelete(res); return r; // just go on...?
4856	}
4857
4858	#endif
4859	assume(id_RankFreeModule(res->qideal, res) == 0);
4860	}
4861
4862	#ifdef HAVE_PLURAL
4863	assume((res->qideal==NULL) == (old_ring->qideal==NULL));
4864	assume(rIsPluralRing(res) == rIsPluralRing(old_ring));
4865	assume(rIsSCA(res) == rIsSCA(old_ring));
4866	assume(ncRingType(res) == ncRingType(old_ring));
4867	#endif
4868	}
4869
4870	return res;
4871	}
4872
4873	ring rAssure_dp_S(const ring r)
4874	{
4875	return rAssure_Global(ringorder_dp, ringorder_S, r);
4876	}
4877
4878	ring rAssure_dp_C(const ring r)
4879	{
4880	return rAssure_Global(ringorder_dp, ringorder_C, r);
4881	}
4882
4883	ring rAssure_C_dp(const ring r)
4884	{
4885	return rAssure_Global(ringorder_C, ringorder_dp, r);
4886	}
4887
4888	ring rAssure_c_dp(const ring r)
4889	{
4890	return rAssure_Global(ringorder_c, ringorder_dp, r);
4891	}
4892
4893
4894
4895	/// Finds p^th IS ordering, and returns its position in r->typ[]
4896	/// returns -1 if something went wrong!
4897	/// p - starts with 0!
4898	int rGetISPos(const int p, const ring r)
4899	{
4900	// Put the reference set F into the ring -ordering -recor
4901	#if MYTEST
4902	Print("rIsIS(p: %d)\nF:", p);
4903	PrintLn();
4904	#endif
4905
4906	if (r->typ==NULL)
4907	{
4908	// dReportError("'rIsIS:' Error: wrong ring! (typ == NULL)");
4909	return -1;
4910	}
4911
4912	int j = p; // Which IS record to use...
4913	for( int pos = 0; pos < r->OrdSize; pos++ )
4914	if( r->typ[pos].ord_typ == ro_is)
4915	if( j-- == 0 )
4916	return pos;
4917
4918	return -1;
4919	}
4920
4921
4922
4923
4924
4925
4926	/// Changes r by setting induced ordering parameters: limit and reference leading terms
4927	/// F belong to r, we will DO a copy!
4928	/// We will use it AS IS!
4929	/// returns true is everything was allright!
4930	BOOLEAN rSetISReference(const ring r, const ideal F, const int i, const int p)
4931	{
4932	// Put the reference set F into the ring -ordering -recor
4933
4934	if (r->typ==NULL)
4935	{
4936	dReportError("Error: WRONG USE of rSetISReference: wrong ring! (typ == NULL)");
4937	return FALSE;
4938	}
4939
4940
4941	int pos = rGetISPos(p, r);
4942
4943	if( pos == -1 )
4944	{
4945	dReportError("Error: WRONG USE of rSetISReference: specified ordering block was not found!!!" );
4946	return FALSE;
4947	}
4948
4949	#if MYTEST
4950	if( i != r->typ[pos].data.is.limit )
4951	Print("Changing record on pos: %d\nOld limit: %d --->> New Limit: %d\n", pos, r->typ[pos].data.is.limit, i);
4952	#endif
4953
4954	const ideal FF = idrHeadR(F, r, r); // id_Copy(F, r); // ???
4955
4956
4957	if( r->typ[pos].data.is.F != NULL)
4958	{
4959	#if MYTEST
4960	PrintS("Deleting old reference set F... \n"); // idShow(r->typ[pos].data.is.F, r); PrintLn();
4961	#endif
4962	id_Delete(&r->typ[pos].data.is.F, r);
4963	r->typ[pos].data.is.F = NULL;
4964	}
4965
4966	assume(r->typ[pos].data.is.F == NULL);
4967
4968	r->typ[pos].data.is.F = FF; // F is owened by ring now! TODO: delete at the end!
4969
4970	r->typ[pos].data.is.limit = i; // First induced component
4971
4972	#if MYTEST
4973	PrintS("New reference set FF : \n"); idShow(FF, r, r, 1); PrintLn();
4974	#endif
4975
4976	return TRUE;
4977	}
4978
4979	#ifdef PDEBUG
4980	int pDBsyzComp=0;
4981	#endif
4982
4983
4984	void rSetSyzComp(int k, const ring r)
4985	{
4986	if(k < 0)
4987	{
4988	dReportError("rSetSyzComp with negative limit!");
4989	return;
4990	}
4991
4992	assume( k >= 0 );
4993	if (TEST_OPT_PROT) Print("{%d}", k);
4994	if ((r->typ!=NULL) && (r->typ[0].ord_typ==ro_syz))
4995	{
4996	if( k == r->typ[0].data.syz.limit )
4997	return; // nothing to do
4998
4999	int i;
5000	if (r->typ[0].data.syz.limit == 0)
5001	{
5002	r->typ[0].data.syz.syz_index = (int) omAlloc0((k+1)sizeof(int));
5003	r->typ[0].data.syz.syz_index[0] = 0;
5004	r->typ[0].data.syz.curr_index = 1;
5005	}
5006	else
5007	{
5008	r->typ[0].data.syz.syz_index = (int*)
5009	omReallocSize(r->typ[0].data.syz.syz_index,
5010	(r->typ[0].data.syz.limit+1)*sizeof(int),
5011	(k+1)*sizeof(int));
5012	}
5013	for (i=r->typ[0].data.syz.limit + 1; i<= k; i++)
5014	{
5015	r->typ[0].data.syz.syz_index[i] =
5016	r->typ[0].data.syz.curr_index;
5017	}
5018	if(k < r->typ[0].data.syz.limit) // ?
5019	{
5020	#ifndef SING_NDEBUG
5021	Warn("rSetSyzComp called with smaller limit (%d) as before (%d)", k, r->typ[0].data.syz.limit);
5022	#endif
5023	r->typ[0].data.syz.curr_index = 1 + r->typ[0].data.syz.syz_index[k];
5024	}
5025
5026
5027	r->typ[0].data.syz.limit = k;
5028	r->typ[0].data.syz.curr_index++;
5029	}
5030	else if(
5031	(r->typ!=NULL) &&
5032	(r->typ[0].ord_typ==ro_isTemp)
5033	)
5034	{
5035	// (r->typ[currRing->typ[0].data.isTemp.suffixpos].data.is.limit == k)
5036	#ifndef SING_NDEBUG
5037	Warn("rSetSyzComp(%d) in an IS ring! Be careful!", k);
5038	#endif
5039	}
5040	else
5041	if ((r->order[0]!=ringorder_c) && (k!=0)) // ???
5042	{
5043	dReportError("syzcomp in incompatible ring");
5044	}
5045	#ifdef PDEBUG
5046	extern int pDBsyzComp;
5047	pDBsyzComp=k;
5048	#endif
5049	}
5050
5051	// return the max-comonent wchich has syzIndex i
5052	int rGetMaxSyzComp(int i, const ring r)
5053	{
5054	if ((r->typ!=NULL) && (r->typ[0].ord_typ==ro_syz) &&
5055	r->typ[0].data.syz.limit > 0 && i > 0)
5056	{
5057	assume(i <= r->typ[0].data.syz.limit);
5058	int j;
5059	for (j=0; j<r->typ[0].data.syz.limit; j++)
5060	{
5061	if (r->typ[0].data.syz.syz_index[j] == i &&
5062	r->typ[0].data.syz.syz_index[j+1] != i)
5063	{
5064	assume(r->typ[0].data.syz.syz_index[j+1] == i+1);
5065	return j;
5066	}
5067	}
5068	return r->typ[0].data.syz.limit;
5069	}
5070	else
5071	{
5072	return 0;
5073	}
5074	}
5075
5076	BOOLEAN rRing_is_Homog(ring r)
5077	{
5078	if (r == NULL) return FALSE;
5079	int i, j, nb = rBlocks(r);
5080	for (i=0; i<nb; i++)
5081	{
5082	if (r->wvhdl[i] != NULL)
5083	{
5084	int length = r->block1[i] - r->block0[i];
5085	int* wvhdl = r->wvhdl[i];
5086	if (r->order[i] == ringorder_M) length *= length;
5087	assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
5088
5089	for (j=0; j< length; j++)
5090	{
5091	if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
5092	}
5093	}
5094	}
5095	return TRUE;
5096	}
5097
5098	BOOLEAN rRing_has_CompLastBlock(ring r)
5099	{
5100	assume(r != NULL);
5101	int lb = rBlocks(r) - 2;
5102	return (r->order[lb] == ringorder_c \|\| r->order[lb] == ringorder_C);
5103	}
5104
5105	n_coeffType rFieldType(ring r)
5106	{
5107	return (r->cf->type);
5108	if (rField_is_Zp(r)) return n_Zp;
5109	if (rField_is_Q(r)) return n_Q;
5110	if (rField_is_R(r)) return n_R;
5111	if (rField_is_GF(r)) return n_GF;
5112	if (rField_is_long_R(r)) return n_long_R;
5113	if (rField_is_Zp_a(r)) return getCoeffType(r->cf);
5114	if (rField_is_Q_a(r)) return getCoeffType(r->cf);
5115	if (rField_is_long_C(r)) return n_long_C;
5116	if (rField_is_Ring_Z(r)) return n_Z;
5117	if (rField_is_Ring_ModN(r)) return n_Zn;
5118	if (rField_is_Ring_PtoM(r)) return n_Znm;
5119	if (rField_is_Ring_2toM(r)) return n_Z2m;
5120
5121	return n_unknown;
5122	}
5123
5124	int64 * rGetWeightVec(const ring r)
5125	{
5126	assume(r!=NULL);
5127	assume(r->OrdSize>0);
5128	int i=0;
5129	while((r->typ[i].ord_typ!=ro_wp64) && (r->typ[i].ord_typ>0)) i++;
5130	assume(r->typ[i].ord_typ==ro_wp64);
5131	return (int64*)(r->typ[i].data.wp64.weights64);
5132	}
5133
5134	void rSetWeightVec(ring r, int64 *wv)
5135	{
5136	assume(r!=NULL);
5137	assume(r->OrdSize>0);
5138	assume(r->typ[0].ord_typ==ro_wp64);
5139	memcpy(r->typ[0].data.wp64.weights64,wv,r->N*sizeof(int64));
5140	}
5141
5142	#include <ctype.h>
5143
5144	static int rRealloc1(ring r, int size, int pos)
5145	{
5146	r->order=(rRingOrder_t)omReallocSize(r->order, sizesizeof(rRingOrder_t), (size+1)*sizeof(rRingOrder_t));
5147	r->block0=(int)omReallocSize(r->block0, sizesizeof(int), (size+1)*sizeof(int));
5148	r->block1=(int)omReallocSize(r->block1, sizesizeof(int), (size+1)*sizeof(int));
5149	r->wvhdl=(int *)omReallocSize(r->wvhdl,sizesizeof(int ), (size+1)sizeof(int *));
5150	for(int k=size; k>pos; k--) r->wvhdl[k]=r->wvhdl[k-1];
5151	r->order[size]=(rRingOrder_t)0;
5152	size++;
5153	return size;
5154	}
5155	#if 0 // currently unused
5156	static int rReallocM1(ring r, int size, int pos)
5157	{
5158	r->order=(int)omReallocSize(r->order, sizesizeof(int), (size-1)*sizeof(int));
5159	r->block0=(int)omReallocSize(r->block0, sizesizeof(int), (size-1)*sizeof(int));
5160	r->block1=(int)omReallocSize(r->block1, sizesizeof(int), (size-1)*sizeof(int));
5161	r->wvhdl=(int *)omReallocSize(r->wvhdl,sizesizeof(int ), (size-1)sizeof(int *));
5162	for(int k=pos+1; k<size; k++) r->wvhdl[k]=r->wvhdl[k+1];
5163	size--;
5164	return size;
5165	}
5166	#endif
5167	static void rOppWeight(int *w, int l)
5168	{
5169	int i2=(l+1)/2;
5170	for(int j=0; j<=i2; j++)
5171	{
5172	int t=w[j];
5173	w[j]=w[l-j];
5174	w[l-j]=t;
5175	}
5176	}
5177
5178	#define rOppVar(R,I) (rVar(R)+1-I)
5179
5180	ring rOpposite(ring src)
5181	/* creates an opposite algebra of R */
5182	/* that is R^opp, where f (^opp) g = gf */
5183	/* treats the case of qring */
5184	{
5185	if (src == NULL) return(NULL);
5186
5187	#ifdef RDEBUG
5188	rTest(src);
5189	#endif
5190
5191	//rChangeCurrRing(src);
5192
5193	#ifdef RDEBUG
5194	rTest(src);
5195	// rWrite(src);
5196	// rDebugPrint(src);
5197	#endif
5198
5199
5200	ring r = rCopy0(src,FALSE); /* qideal will be deleted later on!!! */
5201
5202	// change vars v1..vN -> vN..v1
5203	int i;
5204	int i2 = (rVar(r)-1)/2;
5205	for(i=i2; i>=0; i--)
5206	{
5207	// index: 0..N-1
5208	//Print("ex var names: %d <-> %d\n",i,rOppVar(r,i));
5209	// exchange names
5210	char *p;
5211	p = r->names[rVar(r)-1-i];
5212	r->names[rVar(r)-1-i] = r->names[i];
5213	r->names[i] = p;
5214	}
5215	// i2=(rVar(r)+1)/2;
5216	// for(int i=i2; i>0; i--)
5217	// {
5218	// // index: 1..N
5219	// //Print("ex var places: %d <-> %d\n",i,rVar(r)+1-i);
5220	// // exchange VarOffset
5221	// int t;
5222	// t=r->VarOffset[i];
5223	// r->VarOffset[i]=r->VarOffset[rOppVar(r,i)];
5224	// r->VarOffset[rOppVar(r,i)]=t;
5225	// }
5226	// change names:
5227	for (i=rVar(r)-1; i>=0; i--)
5228	{
5229	char *p=r->names[i];
5230	if(isupper(p)) p = tolower(*p);
5231	else p = toupper(p);
5232	}
5233	// change ordering: listing
5234	// change ordering: compare
5235	// for(i=0; i<r->OrdSize; i++)
5236	// {
5237	// int t,tt;
5238	// switch(r->typ[i].ord_typ)
5239	// {
5240	// case ro_dp:
5241	// //
5242	// t=r->typ[i].data.dp.start;
5243	// r->typ[i].data.dp.start=rOppVar(r,r->typ[i].data.dp.end);
5244	// r->typ[i].data.dp.end=rOppVar(r,t);
5245	// break;
5246	// case ro_wp:
5247	// case ro_wp_neg:
5248	// {
5249	// t=r->typ[i].data.wp.start;
5250	// r->typ[i].data.wp.start=rOppVar(r,r->typ[i].data.wp.end);
5251	// r->typ[i].data.wp.end=rOppVar(r,t);
5252	// // invert r->typ[i].data.wp.weights
5253	// rOppWeight(r->typ[i].data.wp.weights,
5254	// r->typ[i].data.wp.end-r->typ[i].data.wp.start);
5255	// break;
5256	// }
5257	// //case ro_wp64:
5258	// case ro_syzcomp:
5259	// case ro_syz:
5260	// WerrorS("not implemented in rOpposite");
5261	// // should not happen
5262	// break;
5263	//
5264	// case ro_cp:
5265	// t=r->typ[i].data.cp.start;
5266	// r->typ[i].data.cp.start=rOppVar(r,r->typ[i].data.cp.end);
5267	// r->typ[i].data.cp.end=rOppVar(r,t);
5268	// break;
5269	// case ro_none:
5270	// default:
5271	// Werror("unknown type in rOpposite(%d)",r->typ[i].ord_typ);
5272	// break;
5273	// }
5274	// }
5275	// Change order/block structures (needed for rPrint, rAdd etc.)
5276	int j=0;
5277	int l=rBlocks(src);
5278	for(i=0; src->order[i]!=0; i++)
5279	{
5280	switch (src->order[i])
5281	{
5282	case ringorder_c: /* c-> c */
5283	case ringorder_C: /* C-> C */
5284	case ringorder_no /=0/: /* end-of-block */
5285	r->order[j]=src->order[i];
5286	j++; break;
5287	case ringorder_lp: /* lp -> rp */
5288	r->order[j]=ringorder_rp;
5289	r->block0[j]=rOppVar(r, src->block1[i]);
5290	r->block1[j]=rOppVar(r, src->block0[i]);
5291	break;
5292	case ringorder_rp: /* rp -> lp */
5293	r->order[j]=ringorder_lp;
5294	r->block0[j]=rOppVar(r, src->block1[i]);
5295	r->block1[j]=rOppVar(r, src->block0[i]);
5296	break;
5297	case ringorder_dp: /* dp -> a(1..1),ls */
5298	{
5299	l=rRealloc1(r,l,j);
5300	r->order[j]=ringorder_a;
5301	r->block0[j]=rOppVar(r, src->block1[i]);
5302	r->block1[j]=rOppVar(r, src->block0[i]);
5303	r->wvhdl[j]=(int)omAlloc((r->block1[j]-r->block0[j]+1)sizeof(int));
5304	for(int k=r->block0[j]; k<=r->block1[j]; k++)
5305	r->wvhdl[j][k-r->block0[j]]=1;
5306	j++;
5307	r->order[j]=ringorder_ls;
5308	r->block0[j]=rOppVar(r, src->block1[i]);
5309	r->block1[j]=rOppVar(r, src->block0[i]);
5310	j++;
5311	break;
5312	}
5313	case ringorder_Dp: /* Dp -> a(1..1),rp */
5314	{
5315	l=rRealloc1(r,l,j);
5316	r->order[j]=ringorder_a;
5317	r->block0[j]=rOppVar(r, src->block1[i]);
5318	r->block1[j]=rOppVar(r, src->block0[i]);
5319	r->wvhdl[j]=(int)omAlloc((r->block1[j]-r->block0[j]+1)sizeof(int));
5320	for(int k=r->block0[j]; k<=r->block1[j]; k++)
5321	r->wvhdl[j][k-r->block0[j]]=1;
5322	j++;
5323	r->order[j]=ringorder_rp;
5324	r->block0[j]=rOppVar(r, src->block1[i]);
5325	r->block1[j]=rOppVar(r, src->block0[i]);
5326	j++;
5327	break;
5328	}
5329	case ringorder_wp: /* wp -> a(...),ls */
5330	{
5331	l=rRealloc1(r,l,j);
5332	r->order[j]=ringorder_a;
5333	r->block0[j]=rOppVar(r, src->block1[i]);
5334	r->block1[j]=rOppVar(r, src->block0[i]);
5335	r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=NULL;
5336	rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5337	j++;
5338	r->order[j]=ringorder_ls;
5339	r->block0[j]=rOppVar(r, src->block1[i]);
5340	r->block1[j]=rOppVar(r, src->block0[i]);
5341	j++;
5342	break;
5343	}
5344	case ringorder_Wp: /* Wp -> a(...),rp */
5345	{
5346	l=rRealloc1(r,l,j);
5347	r->order[j]=ringorder_a;
5348	r->block0[j]=rOppVar(r, src->block1[i]);
5349	r->block1[j]=rOppVar(r, src->block0[i]);
5350	r->wvhdl[j]=r->wvhdl[j+1]; r->wvhdl[j+1]=NULL;
5351	rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5352	j++;
5353	r->order[j]=ringorder_rp;
5354	r->block0[j]=rOppVar(r, src->block1[i]);
5355	r->block1[j]=rOppVar(r, src->block0[i]);
5356	j++;
5357	break;
5358	}
5359	case ringorder_M: /* M -> M */
5360	{
5361	r->order[j]=ringorder_M;
5362	r->block0[j]=rOppVar(r, src->block1[i]);
5363	r->block1[j]=rOppVar(r, src->block0[i]);
5364	int n=r->block1[j]-r->block0[j];
5365	/* M is a (n+1)x(n+1) matrix */
5366	for (int nn=0; nn<=n; nn++)
5367	{
5368	rOppWeight(&(r->wvhdl[j][nn(n+1)]), n /r->block1[j]-r->block0[j]*/);
5369	}
5370	j++;
5371	break;
5372	}
5373	case ringorder_a: /* a(...),ls -> wp/dp */
5374	{
5375	r->block0[j]=rOppVar(r, src->block1[i]);
5376	r->block1[j]=rOppVar(r, src->block0[i]);
5377	rOppWeight(r->wvhdl[j], r->block1[j]-r->block0[j]);
5378	if (src->order[i+1]==ringorder_ls)
5379	{
5380	r->order[j]=ringorder_wp;
5381	i++;
5382	//l=rReallocM1(r,l,j);
5383	}
5384	else
5385	{
5386	r->order[j]=ringorder_a;
5387	}
5388	j++;
5389	break;
5390	}
5391	// not yet done:
5392	case ringorder_ls:
5393	case ringorder_rs:
5394	case ringorder_ds:
5395	case ringorder_Ds:
5396	case ringorder_ws:
5397	case ringorder_Ws:
5398	// should not occur:
5399	case ringorder_S:
5400	case ringorder_IS:
5401	case ringorder_s:
5402	case ringorder_aa:
5403	case ringorder_L:
5404	case ringorder_unspec:
5405	Werror("order %s not (yet) supported", rSimpleOrdStr(src->order[i]));
5406	break;
5407	}
5408	}
5409	rComplete(r);
5410
5411
5412	#ifdef RDEBUG
5413	rTest(r);
5414	#endif
5415
5416	//rChangeCurrRing(r);
5417
5418	#ifdef RDEBUG
5419	rTest(r);
5420	// rWrite(r);
5421	// rDebugPrint(r);
5422	#endif
5423
5424
5425	#ifdef HAVE_PLURAL
5426	// now, we initialize a non-comm structure on r
5427	if (rIsPluralRing(src))
5428	{
5429	// assume( currRing == r);
5430
5431	int perm = (int )omAlloc0((rVar(r)+1)*sizeof(int));
5432	int *par_perm = NULL;
5433	nMapFunc nMap = n_SetMap(src->cf,r->cf);
5434	int ni,nj;
5435	for(i=1; i<=r->N; i++)
5436	{
5437	perm[i] = rOppVar(r,i);
5438	}
5439
5440	matrix C = mpNew(rVar(r),rVar(r));
5441	matrix D = mpNew(rVar(r),rVar(r));
5442
5443	for (i=1; i< rVar(r); i++)
5444	{
5445	for (j=i+1; j<=rVar(r); j++)
5446	{
5447	ni = r->N +1 - i;
5448	nj = r->N +1 - j; /* i<j ==> nj < ni */
5449
5450	assume(MATELEM(src->GetNC()->C,i,j) != NULL);
5451	MATELEM(C,nj,ni) = p_PermPoly(MATELEM(src->GetNC()->C,i,j),perm,src,r, nMap,par_perm,rPar(src));
5452
5453	if(MATELEM(src->GetNC()->D,i,j) != NULL)
5454	MATELEM(D,nj,ni) = p_PermPoly(MATELEM(src->GetNC()->D,i,j),perm,src,r, nMap,par_perm,rPar(src));
5455	}
5456	}
5457
5458	id_Test((ideal)C, r);
5459	id_Test((ideal)D, r);
5460
5461	if (nc_CallPlural(C, D, NULL, NULL, r, false, false, true, r)) // no qring setup!
5462	WarnS("Error initializing non-commutative multiplication!");
5463
5464	#ifdef RDEBUG
5465	rTest(r);
5466	// rWrite(r);
5467	// rDebugPrint(r);
5468	#endif
5469
5470	assume( r->GetNC()->IsSkewConstant == src->GetNC()->IsSkewConstant);
5471
5472	omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
5473	}
5474	#endif /* HAVE_PLURAL */
5475
5476	/* now oppose the qideal for qrings */
5477	if (src->qideal != NULL)
5478	{
5479	id_Delete(&(r->qideal), r);
5480
5481	#ifdef HAVE_PLURAL
5482	r->qideal = idOppose(src, src->qideal, r); // into the currRing: r
5483	#else
5484	r->qideal = id_Copy(src->qideal, r); // ?
5485	#endif
5486
5487	#ifdef HAVE_PLURAL
5488	if( rIsPluralRing(r) )
5489	{
5490	nc_SetupQuotient(r);
5491	#ifdef RDEBUG
5492	rTest(r);
5493	// rWrite(r);
5494	// rDebugPrint(r);
5495	#endif
5496	}
5497	#endif
5498	}
5499	#ifdef HAVE_PLURAL
5500	if( rIsPluralRing(r) )
5501	assume( ncRingType(r) == ncRingType(src) );
5502	#endif
5503	rTest(r);
5504
5505	return r;
5506	}
5507
5508	ring rEnvelope(ring R)
5509	/* creates an enveloping algebra of R */
5510	/* that is R^e = R \tensor_K R^opp */
5511	{
5512	ring Ropp = rOpposite(R);
5513	ring Renv = NULL;
5514	int stat = rSum(R, Ropp, Renv); /* takes care of qideals */
5515	if ( stat <=0 )
5516	WarnS("Error in rEnvelope at rSum");
5517	rTest(Renv);
5518	return Renv;
5519	}
5520
5521	#ifdef HAVE_PLURAL
5522	BOOLEAN nc_rComplete(const ring src, ring dest, bool bSetupQuotient)
5523	/* returns TRUE is there were errors */
5524	/* dest is actualy equals src with the different ordering */
5525	/* we map src->nc correctly to dest->src */
5526	/* to be executed after rComplete, before rChangeCurrRing */
5527	{
5528	// NOTE: Originally used only by idElimination to transfer NC structure to dest
5529	// ring created by dirty hack (without nc_CallPlural)
5530	rTest(src);
5531
5532	assume(!rIsPluralRing(dest)); // destination must be a newly constructed commutative ring
5533
5534	if (!rIsPluralRing(src))
5535	{
5536	return FALSE;
5537	}
5538
5539	const int N = dest->N;
5540
5541	assume(src->N == N);
5542
5543	// ring save = currRing;
5544
5545	// if (dest != save)
5546	// rChangeCurrRing(dest);
5547
5548	const ring srcBase = src;
5549
5550	assume( n_SetMap(srcBase->cf,dest->cf) == n_SetMap(dest->cf,dest->cf) ); // currRing is important here!
5551
5552	matrix C = mpNew(N,N); // ring independent
5553	matrix D = mpNew(N,N);
5554
5555	matrix C0 = src->GetNC()->C;
5556	matrix D0 = src->GetNC()->D;
5557
5558	// map C and D into dest
5559	for (int i = 1; i < N; i++)
5560	{
5561	for (int j = i + 1; j <= N; j++)
5562	{
5563	const number n = n_Copy(p_GetCoeff(MATELEM(C0,i,j), srcBase), srcBase->cf); // src, mapping for coeffs into currRing = dest!
5564	const poly p = p_NSet(n, dest);
5565	MATELEM(C,i,j) = p;
5566	if (MATELEM(D0,i,j) != NULL)
5567	MATELEM(D,i,j) = prCopyR(MATELEM(D0,i,j), srcBase, dest); // ?
5568	}
5569	}
5570	/* One must test C and D _only_ in r->GetNC()->basering!!! not in r!!! */
5571
5572	id_Test((ideal)C, dest);
5573	id_Test((ideal)D, dest);
5574
5575	if (nc_CallPlural(C, D, NULL, NULL, dest, bSetupQuotient, false, true, dest)) // also takes care about quotient ideal
5576	{
5577	//WarnS("Error transferring non-commutative structure");
5578	// error message should be in the interpreter interface
5579
5580	mp_Delete(&C, dest);
5581	mp_Delete(&D, dest);
5582
5583	// if (currRing != save)
5584	// rChangeCurrRing(save);
5585
5586	return TRUE;
5587	}
5588
5589	// mp_Delete(&C, dest); // used by nc_CallPlural!
5590	// mp_Delete(&D, dest);
5591
5592	// if (dest != save)
5593	// rChangeCurrRing(save);
5594
5595	assume(rIsPluralRing(dest));
5596	return FALSE;
5597	}
5598	#endif
5599
5600	void rModify_a_to_A(ring r)
5601	// to be called BEFORE rComplete:
5602	// changes every Block with a(...) to A(...)
5603	{
5604	int i=0;
5605	int j;
5606	while(r->order[i]!=0)
5607	{
5608	if (r->order[i]==ringorder_a)
5609	{
5610	r->order[i]=ringorder_a64;
5611	int *w=r->wvhdl[i];
5612	int64 w64=(int64 )omAlloc((r->block1[i]-r->block0[i]+1)*sizeof(int64));
5613	for(j=r->block1[i]-r->block0[i];j>=0;j--)
5614	w64[j]=(int64)w[j];
5615	r->wvhdl[i]=(int*)w64;
5616	omFreeSize(w,(r->block1[i]-r->block0[i]+1)*sizeof(int));
5617	}
5618	i++;
5619	}
5620	}
5621
5622
5623	poly rGetVar(const int varIndex, const ring r)
5624	{
5625	poly p = p_ISet(1, r);
5626	p_SetExp(p, varIndex, 1, r);
5627	p_Setm(p, r);
5628	return p;
5629	}
5630
5631
5632	/// TODO: rewrite somehow...
5633	int n_IsParam(const number m, const ring r)
5634	{
5635	assume(r != NULL);
5636	const coeffs C = r->cf;
5637	assume(C != NULL);
5638
5639	assume( nCoeff_is_Extension(C) );
5640
5641	const n_coeffType _filed_type = getCoeffType(C);
5642
5643	if(( _filed_type == n_algExt )\|\|( _filed_type == n_polyExt ))
5644	return naIsParam(m, C);
5645
5646	if( _filed_type == n_transExt )
5647	return ntIsParam(m, C);
5648
5649	Werror("n_IsParam: IsParam is not to be used for (coeff_type = %d)",getCoeffType(C));
5650
5651	return 0;
5652	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: