Context Navigation

source: git/Singular/ring.cc @ 7f96f2

spielwiese

Last change on this file since 7f96f2 was 7f96f2, checked in by Hans Schönemann <hannes@…>, 22 years ago
*hannes: changes from 2-0-branch git-svn-id: file:///usr/local/Singular/svn/trunk@5551 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 95.8 KB

Line
1	/****************************************
2	* Computer Algebra System SINGULAR *
3	****************************************/
4	/* $Id: ring.cc,v 1.168 2001-07-30 08:48:36 Singular Exp $ */
5
6	/*
7	* ABSTRACT - the interpreter related ring operations
8	*/
9
10	/* includes */
11	#include <math.h>
12	#include "mod2.h"
13	#include "structs.h"
14	#include "omalloc.h"
15	#include "tok.h"
16	#include "ipid.h"
17	#include "polys.h"
18	#include "numbers.h"
19	#include "febase.h"
20	#include "ipshell.h"
21	#include "ipconv.h"
22	#include "intvec.h"
23	#include "longalg.h"
24	#include "ffields.h"
25	#include "subexpr.h"
26	#include "ideals.h"
27	#include "lists.h"
28	#include "ring.h"
29	#include "prCopy.h"
30	#include "p_Procs.h"
31
32	#define BITS_PER_LONG 8*SIZEOF_LONG
33
34	static const char * const ringorder_name[] =
35	{
36	" ?", //ringorder_no = 0,
37	"a", //ringorder_a,
38	"c", //ringorder_c,
39	"C", //ringorder_C,
40	"M", //ringorder_M,
41	"S", //ringorder_S,
42	"s", //ringorder_s,
43	"lp", //ringorder_lp,
44	"dp", //ringorder_dp,
45	"rp", //ringorder_rp,
46	"Dp", //ringorder_Dp,
47	"wp", //ringorder_wp,
48	"Wp", //ringorder_Wp,
49	"ls", //ringorder_ls,
50	"ds", //ringorder_ds,
51	"Ds", //ringorder_Ds,
52	"ws", //ringorder_ws,
53	"Ws", //ringorder_Ws,
54	"L", //ringorder_L,
55	"aa", //ringorder_aa
56	" _" //ringorder_unspec
57	};
58
59	static inline const char * rSimpleOrdStr(int ord)
60	{
61	return ringorder_name[ord];
62	}
63
64	// unconditionally deletes fields in r
65	static void rDelete(ring r);
66	// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
67	static void rSetVarL(ring r);
68	// get r->divmask depending on bits per exponent
69	static unsigned long rGetDivMask(int bits);
70	// right-adjust r->VarOffset
71	static void rRightAdjustVarOffset(ring r);
72	static void rOptimizeLDeg(ring r);
73
74	/0 implementation/
75	//BOOLEAN rField_is_R(ring r=currRing)
76	//{
77	// if (r->ch== -1)
78	// {
79	// if (r->float_len==(short)0) return TRUE;
80	// }
81	// return FALSE;
82	//}
83
84	// internally changes the gloabl ring and resets the relevant
85	// global variables:
86	// complete == FALSE : only delete operations are enabled
87	// complete == TRUE : full reset of all variables
88	void rChangeCurrRing(ring r)
89	{
90	/------------ set global ring vars --------------------------------/
91	currRing = r;
92	currQuotient=NULL;
93	if (r != NULL)
94	{
95	rTest(r);
96	/------------ set global ring vars --------------------------------/
97	currQuotient=r->qideal;
98
99	/------------ global variables related to coefficients ------------/
100	nSetChar(r);
101
102	/------------ global variables related to polys -------------------/
103	pSetGlobals(r);
104
105	/------------ set naMinimalPoly -----------------------------------/
106	if (r->minpoly!=NULL)
107	{
108	naMinimalPoly=((lnumber)r->minpoly)->z;
109	}
110	}
111	}
112
113	void rSetHdl(idhdl h)
114	{
115	int i;
116	ring rg = NULL;
117	if (h!=NULL)
118	{
119	rg = IDRING(h);
120	omCheckAddrSize((ADDRESS)h,sizeof(idrec));
121	if (IDID(h)) // OB: ????
122	omCheckAddr((ADDRESS)IDID(h));
123	rTest(rg);
124	}
125
126	// clean up history
127	if (sLastPrinted.RingDependend())
128	{
129	sLastPrinted.CleanUp();
130	memset(&sLastPrinted,0,sizeof(sleftv));
131	}
132
133	/------------ change the global ring -----------------------/
134	rChangeCurrRing(rg);
135	currRingHdl = h;
136	}
137
138	idhdl rDefault(char *s)
139	{
140	idhdl tmp=NULL;
141
142	if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
143	if (tmp==NULL) return NULL;
144
145	if (ppNoether!=NULL) pDelete(&ppNoether);
146	if (sLastPrinted.RingDependend())
147	{
148	sLastPrinted.CleanUp();
149	memset(&sLastPrinted,0,sizeof(sleftv));
150	}
151
152	ring r = IDRING(tmp);
153
154	r->ch = 32003;
155	r->N = 3;
156	/r->P = 0; Alloc0 in idhdl::set, ipid.cc/
157	/names/
158	r->names = (char *) omAlloc0(3 sizeof(char_ptr));
159	r->names[0] = omStrDup("x");
160	r->names[1] = omStrDup("y");
161	r->names[2] = omStrDup("z");
162	/weights: entries for 3 blocks: NULL/
163	r->wvhdl = (int *)omAlloc0(3 sizeof(int_ptr));
164	/order: dp,C,0/
165	r->order = (int ) omAlloc(3 sizeof(int *));
166	r->block0 = (int )omAlloc0(3 sizeof(int *));
167	r->block1 = (int )omAlloc0(3 sizeof(int *));
168	/* ringorder dp for the first block: var 1..3 */
169	r->order[0] = ringorder_dp;
170	r->block0[0] = 1;
171	r->block1[0] = 3;
172	/* ringorder C for the second block: no vars */
173	r->order[1] = ringorder_C;
174	/* the last block: everything is 0 */
175	r->order[2] = 0;
176	/polynomial ring/
177	r->OrdSgn = 1;
178
179	/* complete ring intializations */
180	rComplete(r);
181	rSetHdl(tmp);
182	return currRingHdl;
183	}
184
185	ring rDefault(int ch, int N, char **n)
186	{
187	ring r=(ring) omAlloc0Bin(sip_sring_bin);
188	r->ch = ch;
189	r->N = N;
190	/r->P = 0; Alloc0 /
191	/names/
192	r->names = (char *) omAlloc0(N sizeof(char_ptr));
193	int i;
194	for(i=0;i<N;i++)
195	{
196	r->names[i] = omStrDup(n[i]);
197	}
198	/weights: entries for 2 blocks: NULL/
199	r->wvhdl = (int *)omAlloc0(2 sizeof(int_ptr));
200	/order: lp,0/
201	r->order = (int ) omAlloc(2 sizeof(int *));
202	r->block0 = (int )omAlloc0(2 sizeof(int *));
203	r->block1 = (int )omAlloc0(2 sizeof(int *));
204	/* ringorder dp for the first block: var 1..N */
205	r->order[0] = ringorder_lp;
206	r->block0[0] = 1;
207	r->block1[0] = N;
208	/* the last block: everything is 0 */
209	r->order[1] = 0;
210	/polynomial ring/
211	r->OrdSgn = 1;
212
213	/* complete ring intializations */
214	rComplete(r);
215	return r;
216	}
217
218	///////////////////////////////////////////////////////////////////////////
219	//
220	// rInit: define a new ring from sleftv's
221	//
222
223	/////////////////////////////
224	// Auxillary functions
225	//
226
227	// check intvec, describing the ordering
228	static BOOLEAN rCheckIV(intvec *iv)
229	{
230	if ((iv->length()!=2)&&(iv->length()!=3))
231	{
232	WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
233	return TRUE;
234	}
235	return FALSE;
236	}
237
238	static int rTypeOfMatrixOrder(intvec * order)
239	{
240	int i=0,j,typ=1;
241	int sz = (int)sqrt((double)(order->length()-2));
242
243	while ((i<sz) && (typ==1))
244	{
245	j=0;
246	while ((j<sz) && ((order)[jsz+i+2]==0)) j++;
247	if (j>=sz)
248	{
249	typ = 0;
250	WerrorS("Matrix order not complete");
251	}
252	else if ((order)[jsz+i+2]<0)
253	typ = -1;
254	else
255	i++;
256	}
257	return typ;
258	}
259
260	// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
261	static BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
262	{
263	int last = 0, o=0, n = 1, i=0, typ = 1, j;
264	sleftv *sl = ord;
265
266	// determine nBlocks
267	while (sl!=NULL)
268	{
269	intvec iv = (intvec )(sl->data);
270	if (((iv)[1]==ringorder_c)\|\|((iv)[1]==ringorder_C)) i++;
271	else if ((*iv)[1]==ringorder_L)
272	{
273	R->bitmask=(*iv)[2];
274	n--;
275	}
276	else if ((*iv)[1]!=ringorder_a) o++;
277	n++;
278	sl=sl->next;
279	}
280	// check whether at least one real ordering
281	if (o==0)
282	{
283	WerrorS("invalid combination of orderings");
284	return TRUE;
285	}
286	// if no c/C ordering is given, increment n
287	if (i==0) n++;
288	else if (i != 1)
289	{
290	// throw error if more than one is given
291	WerrorS("more than one ordering c/C specified");
292	return TRUE;
293	}
294
295	// initialize fields of R
296	R->order=(int )omAlloc0(nsizeof(int));
297	R->block0=(int )omAlloc0(nsizeof(int));
298	R->block1=(int )omAlloc0(nsizeof(int));
299	R->wvhdl=(int*)omAlloc0(nsizeof(int_ptr));
300
301	// init order, so that rBlocks works correctly
302	for (j=0; j < n-1; j++)
303	R->order[j] = (int) ringorder_unspec;
304	// set last _C order, if no c/C order was given
305	if (i == 0) R->order[n-2] = ringorder_C;
306
307	/* init orders */
308	sl=ord;
309	n=-1;
310	while (sl!=NULL)
311	{
312	intvec *iv;
313	iv = (intvec *)(sl->data);
314	if ((*iv)[1]!=ringorder_L)
315	{
316	n++;
317
318	/* the format of an ordering:
319	* iv[0]: factor
320	* iv[1]: ordering
321	* iv[2..end]: weights
322	*/
323	R->order[n] = (*iv)[1];
324	switch ((*iv)[1])
325	{
326	case ringorder_ws:
327	case ringorder_Ws:
328	typ=-1;
329	case ringorder_wp:
330	case ringorder_Wp:
331	R->wvhdl[n]=(int)omAlloc((iv->length()-1)sizeof(int));
332	for (i=2; i<iv->length(); i++)
333	R->wvhdl[n][i-2] = (*iv)[i];
334	R->block0[n] = last+1;
335	last += iv->length()-2;
336	R->block1[n] = last;
337	break;
338	case ringorder_ls:
339	case ringorder_ds:
340	case ringorder_Ds:
341	typ=-1;
342	case ringorder_lp:
343	case ringorder_dp:
344	case ringorder_Dp:
345	case ringorder_rp:
346	R->block0[n] = last+1;
347	if (iv->length() == 3) last+=(*iv)[2];
348	else last += (*iv)[0];
349	R->block1[n] = last;
350	if (rCheckIV(iv)) return TRUE;
351	break;
352	case ringorder_S:
353	case ringorder_c:
354	case ringorder_C:
355	if (rCheckIV(iv)) return TRUE;
356	break;
357	case ringorder_aa:
358	case ringorder_a:
359	R->block0[n] = last+1;
360	R->block1[n] = min(last+iv->length()-2 , R->N);
361	R->wvhdl[n] = (int)omAlloc((iv->length()-1)sizeof(int));
362	for (i=2; i<iv->length(); i++)
363	{
364	R->wvhdl[n][i-2]=(*iv)[i];
365	if ((*iv)[i]<0) typ=-1;
366	}
367	break;
368	case ringorder_M:
369	{
370	int Mtyp=rTypeOfMatrixOrder(iv);
371	if (Mtyp==0) return TRUE;
372	if (Mtyp==-1) typ = -1;
373
374	R->wvhdl[n] =( int )omAlloc((iv->length()-1)sizeof(int));
375	for (i=2; i<iv->length();i++)
376	R->wvhdl[n][i-2]=(*iv)[i];
377
378	R->block0[n] = last+1;
379	last += (int)sqrt((double)(iv->length()-2));
380	R->block1[n] = last;
381	break;
382	}
383
384	case ringorder_no:
385	R->order[n] = ringorder_unspec;
386	return TRUE;
387
388	default:
389	Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
390	R->order[n] = ringorder_unspec;
391	return TRUE;
392	}
393	}
394	sl=sl->next;
395	}
396
397	// check for complete coverage
398	if ((R->order[n]==ringorder_c) \|\| (R->order[n]==ringorder_C)) n--;
399	if (R->block1[n] != R->N)
400	{
401	if (((R->order[n]==ringorder_dp) \|\|
402	(R->order[n]==ringorder_ds) \|\|
403	(R->order[n]==ringorder_Dp) \|\|
404	(R->order[n]==ringorder_Ds) \|\|
405	(R->order[n]==ringorder_rp) \|\|
406	(R->order[n]==ringorder_lp) \|\|
407	(R->order[n]==ringorder_ls))
408	&&
409	R->block0[n] <= R->N)
410	{
411	R->block1[n] = R->N;
412	}
413	else
414	{
415	Werror("mismatch of number of vars (%d) and ordering (%d vars)",
416	R->N,R->block1[n]);
417	return TRUE;
418	}
419	}
420	R->OrdSgn = typ;
421	return FALSE;
422	}
423
424	// get array of strings from list of sleftv's
425	static BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p)
426	{
427
428	while(sl!=NULL)
429	{
430	if (sl->Name() == sNoName)
431	{
432	if (sl->Typ()==POLY_CMD)
433	{
434	sleftv s_sl;
435	iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
436	if (s_sl.Name() != sNoName)
437	*p = omStrDup(s_sl.Name());
438	else
439	*p = NULL;
440	sl->next = s_sl.next;
441	s_sl.next = NULL;
442	s_sl.CleanUp();
443	if (*p == NULL) return TRUE;
444	}
445	else
446	return TRUE;
447	}
448	else
449	*p = omStrDup(sl->Name());
450	p++;
451	sl=sl->next;
452	}
453	return FALSE;
454	}
455
456
457	////////////////////
458	//
459	// rInit itself:
460	//
461	// INPUT: s: name, pn: ch & parameter (names), rv: variable (names)
462	// ord: ordering
463	// RETURN: currRingHdl on success
464	// NULL on error
465	// NOTE: * makes new ring to current ring, on success
466	// * considers input sleftv's as read-only
467	//idhdl rInit(char s, sleftv pn, sleftv* rv, sleftv* ord)
468	ring rInit(sleftv* pn, sleftv* rv, sleftv* ord)
469	{
470	int ch;
471	int float_len=0;
472	int float_len2=0;
473	ring R = NULL;
474	idhdl tmp = NULL;
475	BOOLEAN ffChar=FALSE;
476	int typ = 1;
477
478	/* ch -------------------------------------------------------*/
479	// get ch of ground field
480	int numberOfAllocatedBlocks;
481
482	if (pn->Typ()==INT_CMD)
483	{
484	ch=(int)pn->Data();
485	}
486	else if ((pn->name != NULL)
487	&& ((strcmp(pn->name,"real")==0) \|\| (strcmp(pn->name,"complex")==0)))
488	{
489	BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
490	ch=-1;
491	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
492	{
493	float_len=(int)pn->next->Data();
494	float_len2=float_len;
495	pn=pn->next;
496	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
497	{
498	float_len2=(int)pn->next->Data();
499	pn=pn->next;
500	}
501	}
502	if ((pn->next==NULL) && complex_flag)
503	{
504	pn->next=(leftv)omAlloc0Bin(sleftv_bin);
505	pn->next->name=omStrDup("i");
506	}
507	}
508	else
509	{
510	Werror("Wrong ground field specification");
511	goto rInitError;
512	}
513	pn=pn->next;
514
515	int l, last;
516	sleftv * sl;
517	/every entry in the new ring is initialized to 0/
518
519	/* characteristic -----------------------------------------------*/
520	/* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
521	* 0 1 : Q(a,...) *names FALSE
522	* 0 -1 : R NULL FALSE 0
523	* 0 -1 : R NULL FALSE prec. >6
524	* 0 -1 : C *names FALSE prec. 0..?
525	* p p : Fp NULL FALSE
526	* p -p : Fp(a) *names FALSE
527	* q q : GF(q=p^n) *names TRUE
528	*/
529	if (ch!=-1)
530	{
531	int l = 0;
532
533	if (ch!=0 && (ch<2) \|\| (ch > 32003))
534	{
535	Warn("%d is invalid characteristic of ground field. 32003 is used.", ch);
536	ch=32003;
537	}
538	// load fftable, if necessary
539	if (pn!=NULL)
540	{
541	while ((ch!=fftable[l]) && (fftable[l])) l++;
542	if (fftable[l]==0) ch = IsPrime(ch);
543	else
544	{
545	char m[1]={(char )sNoName};
546	nfSetChar(ch,m);
547	if (errorreported) goto rInitError;
548	else ffChar=TRUE;
549	}
550	}
551	else
552	ch = IsPrime(ch);
553	}
554	// allocated ring and set ch
555	R = (ring) omAlloc0Bin(sip_sring_bin);
556	R->ch = ch;
557	if (ch == -1)
558	{
559	R->float_len= min(float_len,32767);
560	R->float_len2= min(float_len2,32767);
561	}
562
563	/* parameter -------------------------------------------------------*/
564	if (pn!=NULL)
565	{
566	R->P=pn->listLength();
567	//if ((ffChar\|\| (ch == 1)) && (R->P > 1))
568	if ((R->P > 1) && (ffChar \|\| (ch == -1)))
569	{
570	WerrorS("too many parameters");
571	goto rInitError;
572	}
573	R->parameter=(char*)omAlloc0(R->Psizeof(char_ptr));
574	if (rSleftvList2StringArray(pn, R->parameter))
575	{
576	WerrorS("parameter expected");
577	goto rInitError;
578	}
579	if (ch>1 && !ffChar) R->ch=-ch;
580	else if (ch==0) R->ch=1;
581	}
582	else if (ffChar)
583	{
584	WerrorS("need one parameter");
585	goto rInitError;
586	}
587	/* post-processing of field description */
588	// we have short reals, but no short complex
589	if ((R->ch == - 1)
590	&& (R->parameter !=NULL)
591	&& (R->float_len < SHORT_REAL_LENGTH))
592	{
593	R->float_len = SHORT_REAL_LENGTH;
594	R->float_len2 = SHORT_REAL_LENGTH;
595	}
596
597	/* names and number of variables-------------------------------------*/
598	R->N = rv->listLength();
599	R->names = (char *)omAlloc0(R->N sizeof(char_ptr));
600	if (rSleftvList2StringArray(rv, R->names))
601	{
602	WerrorS("name of ring variable expected");
603	goto rInitError;
604	}
605
606	/* check names and parameters for conflicts ------------------------- */
607	{
608	int i,j;
609	for(i=0;i<R->P; i++)
610	{
611	for(j=0;j<R->N;j++)
612	{
613	if (strcmp(R->parameter[i],R->names[j])==0)
614	{
615	Werror("parameter %d conflicts with variable %d",i+1,j+1);
616	goto rInitError;
617	}
618	}
619	}
620	}
621	/* ordering -------------------------------------------------------------*/
622	if (rSleftvOrdering2Ordering(ord, R))
623	goto rInitError;
624
625	// Complete the initialization
626	if (rComplete(R,1))
627	goto rInitError;
628
629	rTest(R);
630
631	// try to enter the ring into the name list
632	// need to clean up sleftv here, before this ring can be set to
633	// new currRing or currRing can be killed beacuse new ring has
634	// same name
635	if (pn != NULL) pn->CleanUp();
636	if (rv != NULL) rv->CleanUp();
637	if (ord != NULL) ord->CleanUp();
638	//if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
639	// goto rInitError;
640
641	//memcpy(IDRING(tmp),R,sizeof(*R));
642	// set current ring
643	//omFreeBin(R, ip_sring_bin);
644	//return tmp;
645	return R;
646
647	// error case:
648	rInitError:
649	if (R != NULL) rDelete(R);
650	if (pn != NULL) pn->CleanUp();
651	if (rv != NULL) rv->CleanUp();
652	if (ord != NULL) ord->CleanUp();
653	return NULL;
654	}
655
656	/*2
657	* set a new ring from the data:
658	s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
659	*/
660
661	int r_IsRingVar(char *n, ring r)
662	{
663	if ((r!=NULL) && (r->names!=NULL))
664	{
665	for (int i=0; i<r->N; i++)
666	{
667	if (r->names[i]==NULL) return -1;
668	if (strcmp(n,r->names[i]) == 0) return (int)i;
669	}
670	}
671	return -1;
672	}
673
674
675	void rWrite(ring r)
676	{
677	if ((r==NULL)\|\|(r->order==NULL))
678	return; /to avoid printing after errors..../
679
680	int nblocks=rBlocks(r);
681
682	// omCheckAddrSize(r,sizeof(ip_sring));
683	omCheckAddrSize(r->order,nblocks*sizeof(int));
684	omCheckAddrSize(r->block0,nblocks*sizeof(int));
685	omCheckAddrSize(r->block1,nblocks*sizeof(int));
686	omCheckAddrSize(r->wvhdl,nblocks*sizeof(int_ptr));
687	omCheckAddrSize(r->names,r->N*sizeof(char_ptr));
688
689
690	nblocks--;
691
692
693	if (rField_is_GF(r))
694	{
695	Print("// # ground field : %d\n",rInternalChar(r));
696	Print("// primitive element : %s\n", r->parameter[0]);
697	if (r==currRing)
698	{
699	StringSetS("// minpoly : ");
700	nfShowMipo();PrintS(StringAppendS("\n"));
701	}
702	}
703	else
704	{
705	PrintS("// characteristic : ");
706	if ( rField_is_R(r) ) PrintS("0 (real)\n"); /* R */
707	else if ( rField_is_long_R(r) )
708	Print("0 (real:%d digits, additional %d digits)\n",
709	r->float_len,r->float_len2); /* long R */
710	else if ( rField_is_long_C(r) )
711	Print("0 (complex:%d digits, additional %d digits)\n",
712	r->float_len, r->float_len2); /* long C */
713	else
714	Print ("%d\n",rChar(r)); /* Fp(a) */
715	if (r->parameter!=NULL)
716	{
717	Print ("// %d parameter : ",rPar(r));
718	char **sp=r->parameter;
719	int nop=0;
720	while (nop<rPar(r))
721	{
722	PrintS(*sp);
723	PrintS(" ");
724	sp++; nop++;
725	}
726	PrintS("\n// minpoly : ");
727	if ( rField_is_long_C(r) )
728	{
729	// i^2+1:
730	Print("(%s^2+1)\n",r->parameter[0]);
731	}
732	else if (r->minpoly==NULL)
733	{
734	PrintS("0\n");
735	}
736	else if (r==currRing)
737	{
738	StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
739	}
740	else
741	{
742	PrintS("...\n");
743	}
744	}
745	}
746	Print("// number of vars : %d",r->N);
747
748	//for (nblocks=0; r->order[nblocks]; nblocks++);
749	nblocks=rBlocks(r)-1;
750
751	for (int l=0, nlen=0 ; l<nblocks; l++)
752	{
753	int i;
754	Print("\n// block %3d : ",l+1);
755
756	Print("ordering %s", rSimpleOrdStr(r->order[l]));
757
758	if ((r->order[l] >= ringorder_lp)
759	\|\|(r->order[l] == ringorder_M)
760	\|\|(r->order[l] == ringorder_a)
761	\|\|(r->order[l] == ringorder_aa))
762	{
763	PrintS("\n// : names ");
764	for (i = r->block0[l]-1; i<r->block1[l]; i++)
765	{
766	nlen = strlen(r->names[i]);
767	Print("%s ",r->names[i]);
768	}
769	}
770	#ifndef NDEBUG
771	else if (r->order[l] == ringorder_s)
772	{
773	Print(" syzcomp at %d",r->typ[l].data.syz.limit);
774	}
775	#endif
776
777	if (r->wvhdl[l]!=NULL)
778	{
779	for (int j= 0;
780	j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
781	j+=i)
782	{
783	PrintS("\n// : weights ");
784	for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
785	{
786	Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
787	}
788	if (r->order[l]!=ringorder_M) break;
789	}
790	}
791	}
792	if (r->qideal!=NULL)
793	{
794	PrintS("\n// quotient ring from ideal");
795	if (r==currRing)
796	{
797	PrintLn();
798	iiWriteMatrix((matrix)r->qideal,"_",1);
799	}
800	else PrintS(" ...");
801	}
802	}
803
804	static void rDelete(ring r)
805	{
806	int i, j;
807
808	if (r == NULL) return;
809
810	rUnComplete(r);
811	// delete order stuff
812	if (r->order != NULL)
813	{
814	i=rBlocks(r);
815	assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
816	// delete order
817	omFreeSize((ADDRESS)r->order,i*sizeof(int));
818	omFreeSize((ADDRESS)r->block0,i*sizeof(int));
819	omFreeSize((ADDRESS)r->block1,i*sizeof(int));
820	// delete weights
821	for (j=0; j<i; j++)
822	{
823	if (r->wvhdl[j]!=NULL)
824	omFree(r->wvhdl[j]);
825	}
826	omFreeSize((ADDRESS)r->wvhdl,isizeof(short ));
827	}
828	else
829	{
830	assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
831	}
832
833	// delete varnames
834	if(r->names!=NULL)
835	{
836	for (i=0; i<r->N; i++)
837	{
838	if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
839	}
840	omFreeSize((ADDRESS)r->names,r->N*sizeof(char_ptr));
841	}
842
843	// delete parameter
844	if (r->parameter!=NULL)
845	{
846	char **s=r->parameter;
847	j = 0;
848	while (j < rPar(r))
849	{
850	if (s != NULL) omFree((ADDRESS)s);
851	s++;
852	j++;
853	}
854	omFreeSize((ADDRESS)r->parameter,rPar(r)*sizeof(char_ptr));
855	}
856	omFreeBin(r, ip_sring_bin);
857	}
858
859	void rKill(ring r)
860	{
861	if ((r->ref<=0)&&(r->order!=NULL))
862	{
863	#ifdef RDEBUG
864	if (traceit &TRACE_SHOW_RINGS) Print("kill ring %x\n",r);
865	#endif
866	if (r==currRing)
867	{
868	if (r->qideal!=NULL)
869	{
870	idDelete(&r->qideal);
871	r->qideal=NULL;
872	currQuotient=NULL;
873	}
874	if (ppNoether!=NULL) pDelete(&ppNoether);
875	if (sLastPrinted.RingDependend())
876	{
877	sLastPrinted.CleanUp();
878	}
879	if ((myynest>0) && (iiRETURNEXPR[myynest].RingDependend()))
880	{
881	WerrorS("return value depends on local ring variable (export missing ?)");
882	iiRETURNEXPR[myynest].CleanUp();
883	}
884	currRing=NULL;
885	currRingHdl=NULL;
886	}
887	else if (r->qideal!=NULL)
888	{
889	id_Delete(&r->qideal, r);
890	r->qideal = NULL;
891	}
892	nKillChar(r);
893	int i=1;
894	int j;
895	int *pi=r->order;
896	#ifdef USE_IILOCALRING
897	for (j=0;j<iiRETURNEXPR_len;j++)
898	{
899	if (iiLocalRing[j]==r)
900	{
901	if (j<myynest) Warn("killing the basering for level %d",j);
902	iiLocalRing[j]=NULL;
903	}
904	}
905	#else /* USE_IILOCALRING */
906	{
907	namehdl nshdl = namespaceroot;
908
909	for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
910	//Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
911	if (nshdl->currRing==r)
912	{
913	if (nshdl->myynest<myynest)
914	// Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
915	Warn("killing the basering for level %d",nshdl->myynest);
916	nshdl->currRing=NULL;
917	}
918	}
919	if (nshdl->currRing==r)
920	{
921	//Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
922	if (nshdl->myynest<myynest)
923	// Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
924	Warn("killing the basering for level %d",nshdl->myynest);
925	nshdl->currRing=NULL;
926	}
927	}
928	#endif /* USE_IILOCALRING */
929
930	rDelete(r);
931	return;
932	}
933	r->ref--;
934	}
935
936	void rKill(idhdl h)
937	{
938	#ifndef HAVE_NAMESPACES1
939	ring r = IDRING(h);
940	if (r!=NULL) rKill(r);
941	if (h==currRingHdl)
942	{
943	#ifdef HAVE_NAMESPACES
944	namehdl nsHdl = namespaceroot;
945	while(nsHdl!=NULL) {
946	currRingHdl=NSROOT(nsHdl);
947	#else /* HAVE_NAMESPACES */
948	currRingHdl=IDROOT;
949	#endif /* HAVE_NAMESPACES */
950	while (currRingHdl!=NULL)
951	{
952	if ((currRingHdl!=h)
953	&& (IDTYP(currRingHdl)==IDTYP(h))
954	&& (h->data.uring==currRingHdl->data.uring))
955	break;
956	currRingHdl=IDNEXT(currRingHdl);
957	}
958	#ifdef HAVE_NAMESPACES
959	if ((currRingHdl != NULL) && (currRingHdl!=h)
960	&& (IDTYP(currRingHdl)==IDTYP(h))
961	&& (h->data.uring==currRingHdl->data.uring))
962	break;
963	nsHdl = nsHdl->next;
964	}
965	#endif /* HAVE_NAMESPACES */
966	}
967	#else
968	if(currRingHdl==NULL)
969	{
970	namehdl ns = namespaceroot;
971	BOOLEAN found=FALSE;
972
973	while(!ns->isroot)
974	{
975	currRingHdl=NSROOT(namespaceroot->next);
976	while (currRingHdl!=NULL)
977	{
978	if ((currRingHdl!=h)
979	&& (IDTYP(currRingHdl)==IDTYP(h))
980	&& (h->data.uring==currRingHdl->data.uring))
981	{ found=TRUE; break; }
982
983	currRingHdl=IDNEXT(currRingHdl);
984	}
985	if(found) break;
986	ns=IDNEXT(ns);
987	}
988	}
989	if(currRingHdl == NULL \|\| IDRING(h) != IDRING(currRingHdl))
990	{
991	currRingHdl = namespaceroot->currRingHdl;
992
993	/* PrintS("Running rFind()\n");
994	currRingHdl = rFindHdl(IDRING(h), NULL, NULL);
995	if(currRingHdl == NULL)
996	{
997	PrintS("rFind()return 0\n");
998	}
999	else
1000	{
1001	PrintS("Huppi rfind return an currRingHDL\n");
1002	Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1003	}
1004	*/
1005	}
1006	else
1007	{
1008	//PrintS("Huppi found an currRingHDL\n");
1009	//Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1010
1011	}
1012	#endif /* HAVE_NAMESPACES */
1013	}
1014
1015	idhdl rFindHdl(ring r, idhdl n, idhdl w)
1016	{
1017	#ifdef HAVE_NAMESPACES
1018	idhdl h;
1019	namehdl ns = namespaceroot;
1020
1021	while(!ns->isroot) {
1022	h = NSROOT(ns);
1023	if(w != NULL) h = w;
1024	while (h!=NULL)
1025	{
1026	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1027	&& (h->data.uring==r)
1028	&& (h!=n))
1029	return h;
1030	h=IDNEXT(h);
1031	}
1032	ns = ns->next;
1033	}
1034	h = NSROOT(ns);
1035	if(w != NULL) h = w;
1036	while (h!=NULL)
1037	{
1038	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1039	&& (h->data.uring==r)
1040	&& (h!=n))
1041	return h;
1042	h=IDNEXT(h);
1043	}
1044	#if 0
1045	if(namespaceroot->isroot) h = IDROOT;
1046	else h = NSROOT(namespaceroot->next);
1047	if(w != NULL) h = w;
1048	while (h!=NULL)
1049	{
1050	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1051	&& (h->data.uring==r)
1052	&& (h!=n))
1053	return h;
1054	h=IDNEXT(h);
1055	}
1056	#endif
1057	#else
1058	idhdl h=IDROOT;
1059	if(w != NULL) h = w;
1060	while (h!=NULL)
1061	{
1062	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1063	&& (h->data.uring==r)
1064	&& (h!=n))
1065	return h;
1066	h=IDNEXT(h);
1067	}
1068	#endif
1069	return NULL;
1070	}
1071
1072	int rOrderName(char * ordername)
1073	{
1074	int order=ringorder_unspec;
1075	while (order!= 0)
1076	{
1077	if (strcmp(ordername,rSimpleOrdStr(order))==0)
1078	break;
1079	order--;
1080	}
1081	if (order==0) Werror("wrong ring order `%s`",ordername);
1082	omFree((ADDRESS)ordername);
1083	return order;
1084	}
1085
1086	char * rOrdStr(ring r)
1087	{
1088	int nblocks,l,i;
1089
1090	for (nblocks=0; r->order[nblocks]; nblocks++);
1091	nblocks--;
1092
1093	StringSetS("");
1094	for (l=0; ; l++)
1095	{
1096	StringAppend((char *)rSimpleOrdStr(r->order[l]));
1097	if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1098	{
1099	if (r->wvhdl[l]!=NULL)
1100	{
1101	StringAppendS("(");
1102	for (int j= 0;
1103	j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1104	j+=i+1)
1105	{
1106	char c=',';
1107	for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1108	{
1109	StringAppend("%d," ,r->wvhdl[l][i+j]);
1110	}
1111	if (r->order[l]!=ringorder_M)
1112	{
1113	StringAppend("%d)" ,r->wvhdl[l][i+j]);
1114	break;
1115	}
1116	if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1117	c=')';
1118	StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1119	}
1120	}
1121	else
1122	StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1123	}
1124	if (l==nblocks) return omStrDup(StringAppendS(""));
1125	StringAppendS(",");
1126	}
1127	}
1128
1129	char * rVarStr(ring r)
1130	{
1131	int i;
1132	int l=2;
1133	char *s;
1134
1135	for (i=0; i<r->N; i++)
1136	{
1137	l+=strlen(r->names[i])+1;
1138	}
1139	s=(char *)omAlloc(l);
1140	s[0]='\0';
1141	for (i=0; i<r->N-1; i++)
1142	{
1143	strcat(s,r->names[i]);
1144	strcat(s,",");
1145	}
1146	strcat(s,r->names[i]);
1147	return s;
1148	}
1149
1150	char * rCharStr(ring r)
1151	{
1152	char *s;
1153	int i;
1154
1155	if (r->parameter==NULL)
1156	{
1157	i=r->ch;
1158	if(i==-1)
1159	s=omStrDup("real"); /* R */
1160	else
1161	{
1162	s=(char *)omAlloc(6);
1163	sprintf(s,"%d",i); /* Q, Z/p */
1164	}
1165	return s;
1166	}
1167	int l=0;
1168	for(i=0; i<rPar(r);i++)
1169	{
1170	l+=(strlen(r->parameter[i])+1);
1171	}
1172	s=(char *)omAlloc(l+6);
1173	s[0]='\0';
1174	if (r->ch<0) sprintf(s,"%d",-r->ch); /* Fp(a) */
1175	else if (r->ch==1) sprintf(s,"0"); /* Q(a) */
1176	else
1177	{
1178	sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq */
1179	return s;
1180	}
1181	char tt[2];
1182	tt[0]=',';
1183	tt[1]='\0';
1184	for(i=0; i<rPar(r);i++)
1185	{
1186	strcat(s,tt);
1187	strcat(s,r->parameter[i]);
1188	}
1189	return s;
1190	}
1191
1192	char * rParStr(ring r)
1193	{
1194	if (r->parameter==NULL) return omStrDup("");
1195
1196	int i;
1197	int l=2;
1198
1199	for (i=0; i<rPar(r); i++)
1200	{
1201	l+=strlen(r->parameter[i])+1;
1202	}
1203	char s=(char )omAlloc(l);
1204	s[0]='\0';
1205	for (i=0; i<rPar(r)-1; i++)
1206	{
1207	strcat(s,r->parameter[i]);
1208	strcat(s,",");
1209	}
1210	strcat(s,r->parameter[i]);
1211	return s;
1212	}
1213
1214	char * rString(ring r)
1215	{
1216	char *ch=rCharStr(r);
1217	char *var=rVarStr(r);
1218	char *ord=rOrdStr(r);
1219	char res=(char )omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
1220	sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1221	omFree((ADDRESS)ch);
1222	omFree((ADDRESS)var);
1223	omFree((ADDRESS)ord);
1224	return res;
1225	}
1226
1227	int rChar(ring r)
1228	{
1229	if (r->ch==-1)
1230	return 0;
1231	if (r->parameter==NULL) /* Q, Fp */
1232	return r->ch;
1233	if (r->ch<0) /* Fp(a) */
1234	return -r->ch;
1235	if (r->ch==1) /* Q(a) */
1236	return 0;
1237	/else/ /* GF(p,n) */
1238	{
1239	if ((r->ch & 1)==0) return 2;
1240	int i=3;
1241	while ((r->ch % i)!=0) i+=2;
1242	return i;
1243	}
1244	}
1245
1246	int rIsExtension(ring r)
1247	{
1248	if (r->parameter==NULL) /* Q, Fp */
1249	return FALSE;
1250	else
1251	return TRUE;
1252	}
1253
1254	int rIsExtension()
1255	{
1256	return rIsExtension( currRing );
1257	}
1258
1259	/*2
1260	*returns -1 for not compatible, (sum is undefined)
1261	* 0 for equal, (and sum)
1262	* 1 for compatible (and sum)
1263	*/
1264	int rSum(ring r1, ring r2, ring &sum)
1265	{
1266	if (r1==r2)
1267	{
1268	sum=r1;
1269	r1->ref++;
1270	return 0;
1271	}
1272	ring save=currRing;
1273	ip_sring tmpR;
1274	memset(&tmpR,0,sizeof(tmpR));
1275	/* check coeff. field =====================================================*/
1276	if (rInternalChar(r1)==rInternalChar(r2))
1277	{
1278	tmpR.ch=rInternalChar(r1);
1279	if (rField_is_Q(r1)\|\|rField_is_Zp(r1)\|\|rField_is_GF(r1)) /Q, Z/p, GF(p,n)/
1280	{
1281	if (r1->parameter!=NULL)
1282	{
1283	if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1284	{
1285	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1286	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1287	tmpR.P=1;
1288	}
1289	else
1290	{
1291	WerrorS("GF(p,n)+GF(p,n)");
1292	return -1;
1293	}
1294	}
1295	}
1296	else if ((r1->ch==1)\|\|(r1->ch<-1)) /* Q(a),Z/p(a) */
1297	{
1298	if (r1->minpoly!=NULL)
1299	{
1300	if (r2->minpoly!=NULL)
1301	{
1302	// HANNES: TODO: delete nSetChar
1303	rChangeCurrRing(r1);
1304	if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1305	&& n_Equal(r1->minpoly,r2->minpoly, r1))
1306	{
1307	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1308	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1309	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1310	tmpR.P=1;
1311	// HANNES: TODO: delete nSetChar
1312	rChangeCurrRing(save);
1313	}
1314	else
1315	{
1316	// HANNES: TODO: delete nSetChar
1317	rChangeCurrRing(save);
1318	WerrorS("different minpolys");
1319	return -1;
1320	}
1321	}
1322	else
1323	{
1324	if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1325	&& (rPar(r2)==1))
1326	{
1327	tmpR.parameter=(char **)omAlloc0Bin(char_ptr_bin);
1328	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1329	tmpR.P=1;
1330	// HANNES: TODO: delete nSetChar
1331	rChangeCurrRing(r1);
1332	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1333	rChangeCurrRing(save);
1334	}
1335	else
1336	{
1337	WerrorS("different parameters and minpoly!=0");
1338	return -1;
1339	}
1340	}
1341	}
1342	else /* r1->minpoly==NULL */
1343	{
1344	if (r2->minpoly!=NULL)
1345	{
1346	if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1347	&& (rPar(r1)==1))
1348	{
1349	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1350	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1351	tmpR.P=1;
1352	// HANNES: TODO: delete nSetChar
1353	rChangeCurrRing(r2);
1354	tmpR.minpoly=n_Copy(r2->minpoly, r2);
1355	rChangeCurrRing(save);
1356	}
1357	else
1358	{
1359	WerrorS("different parameters and minpoly!=0");
1360	return -1;
1361	}
1362	}
1363	else
1364	{
1365	int len=rPar(r1)+rPar(r2);
1366	tmpR.parameter=(char *)omAlloc(lensizeof(char_ptr));
1367	int i;
1368	for (i=0;i<rPar(r1);i++)
1369	{
1370	tmpR.parameter[i]=omStrDup(r1->parameter[i]);
1371	}
1372	int j,l;
1373	for(j=0;j<rPar(r2);j++)
1374	{
1375	for(l=0;l<i;l++)
1376	{
1377	if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
1378	break;
1379	}
1380	if (l==i)
1381	{
1382	tmpR.parameter[i]=omStrDup(r2->parameter[j]);
1383	i++;
1384	}
1385	}
1386	if (i!=len)
1387	{
1388	omReallocSize(tmpR.parameter,lensizeof(char_ptr),isizeof(char_ptr));
1389	}
1390	}
1391	}
1392	}
1393	}
1394	else /* r1->ch!=r2->ch */
1395	{
1396	if (r1->ch<-1) /* Z/p(a) */
1397	{
1398	if ((r2->ch==0) /* Q */
1399	\|\| (r2->ch==-r1->ch)) /* Z/p */
1400	{
1401	tmpR.ch=rInternalChar(r1);
1402	tmpR.parameter=(char *)omAlloc(rPar(r1)sizeof(char_ptr));
1403	tmpR.P=rPar(r1);
1404	memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char_ptr));
1405	if (r1->minpoly!=NULL)
1406	{
1407	// HANNES: TODO: delete nSetChar
1408	rChangeCurrRing(r1);
1409	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1410	rChangeCurrRing(save);
1411	}
1412	}
1413	else /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1414	{
1415	WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1416	return -1;
1417	}
1418	}
1419	else if (r1->ch==-1) /* R */
1420	{
1421	WerrorS("R+..");
1422	return -1;
1423	}
1424	else if (r1->ch==0) /* Q */
1425	{
1426	if ((r2->ch<-1)\|\|(r2->ch==1)) /* Z/p(a),Q(a) */
1427	{
1428	tmpR.ch=rInternalChar(r2);
1429	tmpR.P=rPar(r2);
1430	tmpR.parameter=(char *)omAlloc(rPar(r2)sizeof(char_ptr));
1431	memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char_ptr));
1432	if (r2->minpoly!=NULL)
1433	{
1434	// HANNES: TODO: delete nSetChar
1435	rChangeCurrRing(r1);
1436	tmpR.minpoly=n_Copy(r2->minpoly, r2);
1437	rChangeCurrRing(save);
1438	}
1439	}
1440	else if (r2->ch>1) /* Z/p,GF(p,n) */
1441	{
1442	tmpR.ch=r2->ch;
1443	if (r2->parameter!=NULL)
1444	{
1445	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1446	tmpR.P=1;
1447	tmpR.parameter[0]=omStrDup(r2->parameter[0]);
1448	}
1449	}
1450	else
1451	{
1452	WerrorS("Q+R");
1453	return -1; /* R */
1454	}
1455	}
1456	else if (r1->ch==1) /* Q(a) */
1457	{
1458	if (r2->ch==0) /* Q */
1459	{
1460	tmpR.ch=rInternalChar(r1);
1461	tmpR.P=rPar(r1);
1462	tmpR.parameter=(char *)omAlloc0(rPar(r1)sizeof(char_ptr));
1463	int i;
1464	for(i=0;i<rPar(r1);i++)
1465	{
1466	tmpR.parameter[i]=omStrDup(r1->parameter[i]);
1467	}
1468	if (r1->minpoly!=NULL)
1469	{
1470	// HANNES: TODO: delete nSetChar
1471	rChangeCurrRing(r1);
1472	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1473	rChangeCurrRing(currRing);
1474	}
1475	}
1476	else /* R, Z/p,GF(p,n) */
1477	{
1478	WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1479	return -1;
1480	}
1481	}
1482	else /* r1->ch >=2 , Z/p */
1483	{
1484	if (r2->ch==0) /* Q */
1485	{
1486	tmpR.ch=r1->ch;
1487	}
1488	else if (r2->ch==-r1->ch) /* Z/p(a) */
1489	{
1490	tmpR.ch=rInternalChar(r2);
1491	tmpR.P=rPar(r2);
1492	tmpR.parameter=(char *)omAlloc(rPar(r2)sizeof(char_ptr));
1493	int i;
1494	for(i=0;i<rPar(r2);i++)
1495	{
1496	tmpR.parameter[i]=omStrDup(r2->parameter[i]);
1497	}
1498	if (r2->minpoly!=NULL)
1499	{
1500	// HANNES: TODO: delete nSetChar
1501	rChangeCurrRing(r2);
1502	tmpR.minpoly=n_Copy(r2->minpoly, r2);
1503	rChangeCurrRing(save);
1504	}
1505	}
1506	else
1507	{
1508	WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1509	return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1510	}
1511	}
1512	}
1513	/* variable names ========================================================*/
1514	int i,j,k;
1515	int l=r1->N+r2->N;
1516	char names=(char )omAlloc0(l*sizeof(char_ptr));
1517	k=0;
1518
1519	// collect all varnames from r1, except those which are parameters
1520	// of r2, or those which are the empty string
1521	for (i=0;i<r1->N;i++)
1522	{
1523	BOOLEAN b=TRUE;
1524
1525	if (*(r1->names[i]) == '\0')
1526	b = FALSE;
1527	else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1528	{
1529	for(j=0;j<rPar(r2);j++)
1530	{
1531	if (strcmp(r1->names[i],r2->parameter[j])==0)
1532	{
1533	b=FALSE;
1534	break;
1535	}
1536	}
1537	}
1538
1539	if (b)
1540	{
1541	//Print("name : %d: %s\n",k,r1->names[i]);
1542	names[k]=omStrDup(r1->names[i]);
1543	k++;
1544	}
1545	//else
1546	// Print("no name (par1) %s\n",r1->names[i]);
1547	}
1548	// Add variables from r2, except those which are parameters of r1
1549	// those which are empty strings, and those which equal a var of r1
1550	for(i=0;i<r2->N;i++)
1551	{
1552	BOOLEAN b=TRUE;
1553
1554	if (*(r2->names[i]) == '\0')
1555	b = FALSE;
1556	else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1557	{
1558	for(j=0;j<rPar(r1);j++)
1559	{
1560	if (strcmp(r2->names[i],r1->parameter[j])==0)
1561	{
1562	b=FALSE;
1563	break;
1564	}
1565	}
1566	}
1567
1568	if (b)
1569	{
1570	for(j=0;j<r1->N;j++)
1571	{
1572	if (strcmp(r1->names[j],r2->names[i])==0)
1573	{
1574	b=FALSE;
1575	break;
1576	}
1577	}
1578	if (b)
1579	{
1580	//Print("name : %d : %s\n",k,r2->names[i]);
1581	names[k]=omStrDup(r2->names[i]);
1582	k++;
1583	}
1584	//else
1585	// Print("no name (var): %s\n",r2->names[i]);
1586	}
1587	//else
1588	// Print("no name (par): %s\n",r2->names[i]);
1589	}
1590	// check whether we found any vars at all
1591	if (k == 0)
1592	{
1593	names[k]=omStrDup("");
1594	k=1;
1595	}
1596	tmpR.N=k;
1597	tmpR.names=names;
1598	/* ordering ======================================================== /
1599	tmpR.OrdSgn=1;
1600	if ((r1->order[0]==ringorder_unspec)
1601	&& (r2->order[0]==ringorder_unspec))
1602	{
1603	tmpR.order=(int)omAlloc(3sizeof(int));
1604	tmpR.block0=(int)omAlloc(3sizeof(int));
1605	tmpR.block1=(int)omAlloc(3sizeof(int));
1606	tmpR.wvhdl=(int*)omAlloc0(3sizeof(int_ptr));
1607	tmpR.order[0]=ringorder_unspec;
1608	tmpR.order[1]=ringorder_C;
1609	tmpR.order[2]=0;
1610	tmpR.block0[0]=1;
1611	tmpR.block1[0]=tmpR.N;
1612	}
1613	else if (l==k) /* r3=r1+r2 */
1614	{
1615	int b;
1616	ring rb;
1617	if (r1->order[0]==ringorder_unspec)
1618	{
1619	/* extend order of r2 to r3 */
1620	b=rBlocks(r2);
1621	rb=r2;
1622	tmpR.OrdSgn=r2->OrdSgn;
1623	}
1624	else if (r2->order[0]==ringorder_unspec)
1625	{
1626	/* extend order of r1 to r3 */
1627	b=rBlocks(r1);
1628	rb=r1;
1629	tmpR.OrdSgn=r1->OrdSgn;
1630	}
1631	else
1632	{
1633	b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1634	rb=NULL;
1635	}
1636	tmpR.order=(int)omAlloc0(bsizeof(int));
1637	tmpR.block0=(int)omAlloc0(bsizeof(int));
1638	tmpR.block1=(int)omAlloc0(bsizeof(int));
1639	tmpR.wvhdl=(int*)omAlloc0(bsizeof(int_ptr));
1640	/* weights not implemented yet ...*/
1641	if (rb!=NULL)
1642	{
1643	for (i=0;i<b;i++)
1644	{
1645	tmpR.order[i]=rb->order[i];
1646	tmpR.block0[i]=rb->block0[i];
1647	tmpR.block1[i]=rb->block1[i];
1648	if (rb->wvhdl[i]!=NULL)
1649	WarnS("rSum: weights not implemented");
1650	}
1651	tmpR.block0[0]=1;
1652	}
1653	else /* ring sum for complete rings */
1654	{
1655	for (i=0;r1->order[i]!=0;i++)
1656	{
1657	tmpR.order[i]=r1->order[i];
1658	tmpR.block0[i]=r1->block0[i];
1659	tmpR.block1[i]=r1->block1[i];
1660	if (r1->wvhdl[i]!=NULL)
1661	tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1662	}
1663	j=i;
1664	i--;
1665	if ((r1->order[i]==ringorder_c)
1666	\|\|(r1->order[i]==ringorder_C))
1667	{
1668	j--;
1669	tmpR.order[b-2]=r1->order[i];
1670	}
1671	for (i=0;r2->order[i]!=0;i++)
1672	{
1673	if ((r2->order[i]!=ringorder_c)
1674	&&(r2->order[i]!=ringorder_C))
1675	{
1676	tmpR.order[j]=r2->order[i];
1677	tmpR.block0[j]=r2->block0[i]+r1->N;
1678	tmpR.block1[j]=r2->block1[i]+r1->N;
1679	if (r2->wvhdl[i]!=NULL)
1680	{
1681	tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1682	}
1683	j++;
1684	}
1685	}
1686	if((r1->OrdSgn==-1)\|\|(r2->OrdSgn==-1))
1687	tmpR.OrdSgn=-1;
1688	}
1689	}
1690	else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1691	/* copy r1, because we have the variables from r1 */
1692	{
1693	int b=rBlocks(r1);
1694
1695	tmpR.order=(int)omAlloc0(bsizeof(int));
1696	tmpR.block0=(int)omAlloc0(bsizeof(int));
1697	tmpR.block1=(int)omAlloc0(bsizeof(int));
1698	tmpR.wvhdl=(int*)omAlloc0(bsizeof(int_ptr));
1699	/* weights not implemented yet ...*/
1700	for (i=0;i<b;i++)
1701	{
1702	tmpR.order[i]=r1->order[i];
1703	tmpR.block0[i]=r1->block0[i];
1704	tmpR.block1[i]=r1->block1[i];
1705	if (r1->wvhdl[i]!=NULL)
1706	{
1707	tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1708	}
1709	}
1710	tmpR.OrdSgn=r1->OrdSgn;
1711	}
1712	else
1713	{
1714	for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1715	omFreeSize((ADDRESS)names,tmpR.N*sizeof(char_ptr));
1716	Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1717	return -1;
1718	}
1719	sum=(ring)omAllocBin(ip_sring_bin);
1720	memcpy(sum,&tmpR,sizeof(ip_sring));
1721	rComplete(sum);
1722	return 1;
1723	}
1724	/*2
1725	* create a copy of the ring r, which must be equivalent to currRing
1726	* used for qring definition,..
1727	* (i.e.: normal rings: same nCopy as currRing;
1728	* qring: same nCopy, same idCopy as currRing)
1729	* DOES NOT CALL rComplete
1730	*/
1731	static ring rCopy0(ring r, BOOLEAN copy_qideal = TRUE,
1732	BOOLEAN copy_ordering = TRUE)
1733	{
1734	if (r == NULL) return NULL;
1735	int i,j;
1736	ring res=(ring)omAllocBin(ip_sring_bin);
1737
1738	memcpy4(res,r,sizeof(ip_sring));
1739	res->VarOffset = NULL;
1740	res->ref=0;
1741	if (r->algring!=NULL)
1742	r->algring->ref++;
1743	if (r->parameter!=NULL)
1744	{
1745	res->minpoly=nCopy(r->minpoly);
1746	int l=rPar(r);
1747	res->parameter=(char *)omAlloc(lsizeof(char_ptr));
1748	int i;
1749	for(i=0;i<rPar(r);i++)
1750	{
1751	res->parameter[i]=omStrDup(r->parameter[i]);
1752	}
1753	}
1754	if (copy_ordering == TRUE)
1755	{
1756	i=rBlocks(r);
1757	res->wvhdl = (int *)omAlloc(i sizeof(int_ptr));
1758	res->order = (int ) omAlloc(i sizeof(int));
1759	res->block0 = (int ) omAlloc(i sizeof(int));
1760	res->block1 = (int ) omAlloc(i sizeof(int));
1761	for (j=0; j<i; j++)
1762	{
1763	if (r->wvhdl[j]!=NULL)
1764	{
1765	res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1766	}
1767	else
1768	res->wvhdl[j]=NULL;
1769	}
1770	memcpy4(res->order,r->order,i * sizeof(int));
1771	memcpy4(res->block0,r->block0,i * sizeof(int));
1772	memcpy4(res->block1,r->block1,i * sizeof(int));
1773	}
1774	else
1775	{
1776	res->wvhdl = NULL;
1777	res->order = NULL;
1778	res->block0 = NULL;
1779	res->block1 = NULL;
1780	}
1781
1782	res->names = (char *)omAlloc0(r->N sizeof(char_ptr));
1783	for (i=0; i<res->N; i++)
1784	{
1785	res->names[i] = omStrDup(r->names[i]);
1786	}
1787	res->idroot = NULL;
1788	if (r->qideal!=NULL)
1789	{
1790	if (copy_qideal) res->qideal= idrCopyR_NoSort(r->qideal, r);
1791	else res->qideal = NULL;
1792	}
1793	return res;
1794	}
1795
1796	/*2
1797	* create a copy of the ring r, which must be equivalent to currRing
1798	* used for qring definition,..
1799	* (i.e.: normal rings: same nCopy as currRing;
1800	* qring: same nCopy, same idCopy as currRing)
1801	*/
1802	ring rCopy(ring r)
1803	{
1804	if (r == NULL) return NULL;
1805	ring res=rCopy0(r);
1806	rComplete(res, 1);
1807	return res;
1808	}
1809
1810	// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1811	// determined componentwise, if qr == 1, then qrideal equality is
1812	// tested, as well
1813	BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1814	{
1815	int i, j;
1816
1817	if (r1 == r2) return 1;
1818
1819	if (r1 == NULL \|\| r2 == NULL) return 0;
1820
1821	if ((rInternalChar(r1) != rInternalChar(r2))
1822	\|\| (r1->float_len != r2->float_len)
1823	\|\| (r1->float_len2 != r2->float_len2)
1824	\|\| (r1->N != r2->N)
1825	\|\| (r1->OrdSgn != r2->OrdSgn)
1826	\|\| (rPar(r1) != rPar(r2)))
1827	return 0;
1828
1829	for (i=0; i<r1->N; i++)
1830	{
1831	if (r1->names[i] != NULL && r2->names[i] != NULL)
1832	{
1833	if (strcmp(r1->names[i], r2->names[i])) return 0;
1834	}
1835	else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1836	{
1837	return 0;
1838	}
1839	}
1840
1841	i=0;
1842	while (r1->order[i] != 0)
1843	{
1844	if (r2->order[i] == 0) return 0;
1845	if ((r1->order[i] != r2->order[i]) \|\|
1846	(r1->block0[i] != r2->block0[i]) \|\| (r2->block0[i] != r1->block0[i]))
1847	return 0;
1848	if (r1->wvhdl[i] != NULL)
1849	{
1850	if (r2->wvhdl[i] == NULL)
1851	return 0;
1852	for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1853	if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1854	return 0;
1855	}
1856	else if (r2->wvhdl[i] != NULL) return 0;
1857	i++;
1858	}
1859
1860	for (i=0; i<rPar(r1);i++)
1861	{
1862	if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
1863	return 0;
1864	}
1865
1866	if (r1->minpoly != NULL)
1867	{
1868	if (r2->minpoly == NULL) return 0;
1869	if (currRing == r1 \|\| currRing == r2)
1870	{
1871	if (! nEqual(r1->minpoly, r2->minpoly)) return 0;
1872	}
1873	}
1874	else if (r2->minpoly != NULL) return 0;
1875
1876	if (qr)
1877	{
1878	if (r1->qideal != NULL)
1879	{
1880	ideal id1 = r1->qideal, id2 = r2->qideal;
1881	int i, n;
1882	poly m1, m2;
1883
1884	if (id2 == NULL) return 0;
1885	if ((n = IDELEMS(id1)) != IDELEMS(id2)) return 0;
1886
1887	if (currRing == r1 \|\| currRing == r2)
1888	{
1889	m1 = id1->m;
1890	m2 = id2->m;
1891	for (i=0; i<n; i++)
1892	if (! pEqualPolys(m1[i],m2[i])) return 0;
1893	}
1894	}
1895	else if (r2->qideal != NULL) return 0;
1896	}
1897
1898	return 1;
1899	}
1900
1901	rOrderType_t rGetOrderType(ring r)
1902	{
1903	// check for simple ordering
1904	if (rHasSimpleOrder(r))
1905	{
1906	if ((r->order[1] == ringorder_c) \|\| (r->order[1] == ringorder_C))
1907	{
1908	switch(r->order[0])
1909	{
1910	case ringorder_dp:
1911	case ringorder_wp:
1912	case ringorder_ds:
1913	case ringorder_ws:
1914	case ringorder_ls:
1915	case ringorder_unspec:
1916	if (r->order[1] == ringorder_C \|\| r->order[0] == ringorder_unspec)
1917	return rOrderType_ExpComp;
1918	return rOrderType_Exp;
1919
1920	default:
1921	assume(r->order[0] == ringorder_lp \|\|
1922	r->order[0] == ringorder_rp \|\|
1923	r->order[0] == ringorder_Dp \|\|
1924	r->order[0] == ringorder_Wp \|\|
1925	r->order[0] == ringorder_Ds \|\|
1926	r->order[0] == ringorder_Ws);
1927
1928	if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1929	return rOrderType_Exp;
1930	}
1931	}
1932	else
1933	{
1934	assume((r->order[0]==ringorder_c)\|\|(r->order[0]==ringorder_C));
1935	return rOrderType_CompExp;
1936	}
1937	}
1938	else
1939	return rOrderType_General;
1940	}
1941
1942	BOOLEAN rHasSimpleOrder(ring r)
1943	{
1944	if (r->order[0] == ringorder_unspec) return TRUE;
1945	int blocks = rBlocks(r) - 1;
1946	assume(blocks >= 1);
1947	if (blocks == 1) return TRUE;
1948	if (blocks > 2) return FALSE;
1949	if (r->order[0] != ringorder_c && r->order[0] != ringorder_C &&
1950	r->order[1] != ringorder_c && r->order[1] != ringorder_C)
1951	return FALSE;
1952	if (r->order[1] == ringorder_M \|\| r->order[0] == ringorder_M)
1953	return FALSE;
1954	return TRUE;
1955	}
1956
1957	// returns TRUE, if simple lp or ls ordering
1958	BOOLEAN rHasSimpleLexOrder(ring r)
1959	{
1960	return rHasSimpleOrder(r) &&
1961	(r->order[0] == ringorder_ls \|\|
1962	r->order[0] == ringorder_lp \|\|
1963	r->order[1] == ringorder_ls \|\|
1964	r->order[1] == ringorder_lp);
1965	}
1966
1967	BOOLEAN rOrder_is_DegOrdering(rRingOrder_t order)
1968	{
1969	switch(order)
1970	{
1971	case ringorder_dp:
1972	case ringorder_Dp:
1973	case ringorder_ds:
1974	case ringorder_Ds:
1975	case ringorder_Ws:
1976	case ringorder_Wp:
1977	case ringorder_ws:
1978	case ringorder_wp:
1979	return TRUE;
1980
1981	default:
1982	return FALSE;
1983	}
1984	}
1985
1986	BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1987	{
1988	switch(order)
1989	{
1990	case ringorder_Ws:
1991	case ringorder_Wp:
1992	case ringorder_ws:
1993	case ringorder_wp:
1994	return TRUE;
1995
1996	default:
1997	return FALSE;
1998	}
1999	}
2000
2001	BOOLEAN rHasSimpleOrderAA(ring r)
2002	{
2003	int blocks = rBlocks(r) - 1;
2004	if (blocks > 3 \|\| blocks < 2) return FALSE;
2005	if (blocks == 3)
2006	{
2007	return ((r->order[0] == ringorder_aa && r->order[1] != ringorder_M &&
2008	(r->order[2] == ringorder_c \|\| r->order[2] == ringorder_C)) \|\|
2009	((r->order[0] == ringorder_c \|\| r->order[0] == ringorder_C) &&
2010	r->order[1] == ringorder_aa && r->order[2] != ringorder_M));
2011	}
2012	else
2013	{
2014	return (r->order[0] == ringorder_aa && r->order[1] != ringorder_M);
2015	}
2016	}
2017
2018	// return TRUE if p_SetComp requires p_Setm
2019	BOOLEAN rOrd_SetCompRequiresSetm(ring r)
2020	{
2021	if (r->typ != NULL)
2022	{
2023	int pos;
2024	for (pos=0;pos<r->OrdSize;pos++)
2025	{
2026	sro_ord* o=&(r->typ[pos]);
2027	if (o->ord_typ == ro_syzcomp \|\| o->ord_typ == ro_syz) return TRUE;
2028	}
2029	}
2030	return FALSE;
2031	}
2032
2033	// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
2034	BOOLEAN rOrd_is_Totaldegree_Ordering(ring r)
2035	{
2036	// Hmm.... what about Syz orderings?
2037	return (r->N > 1 &&
2038	((rHasSimpleOrder(r) &&
2039	(rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) \|\|
2040	rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) \|\|
2041	(rHasSimpleOrderAA(r) &&
2042	(rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) \|\|
2043	rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
2044	}
2045
2046	// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
2047	BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r =currRing)
2048	{
2049	// Hmm.... what about Syz orderings?
2050	return (r->N > 1 &&
2051	rHasSimpleOrder(r) &&
2052	(rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) \|\|
2053	rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
2054	}
2055
2056	BOOLEAN rIsPolyVar(int v, ring r)
2057	{
2058	int i=0;
2059	while(r->order[i]!=0)
2060	{
2061	if((r->block0[i]<=v)
2062	&& (r->block1[i]>=v))
2063	{
2064	switch(r->order[i])
2065	{
2066	case ringorder_a:
2067	return (r->wvhdl[i][v-r->block0[i]]>0);
2068	case ringorder_M:
2069	return 2; /don't know/
2070	case ringorder_lp:
2071	case ringorder_rp:
2072	case ringorder_dp:
2073	case ringorder_Dp:
2074	case ringorder_wp:
2075	case ringorder_Wp:
2076	return TRUE;
2077	case ringorder_ls:
2078	case ringorder_ds:
2079	case ringorder_Ds:
2080	case ringorder_ws:
2081	case ringorder_Ws:
2082	return FALSE;
2083	default:
2084	break;
2085	}
2086	}
2087	i++;
2088	}
2089	return 3; /* could not find var v*/
2090	}
2091
2092	#ifdef RDEBUG
2093	// This should eventually become a full-fledge ring check, like pTest
2094	BOOLEAN rDBTest(ring r, char* fn, int l)
2095	{
2096	int i,j;
2097
2098	if (r == NULL)
2099	{
2100	dReportError("Null ring in %s:%d", fn, l);
2101	return FALSE;
2102	}
2103
2104
2105	if (r->N == 0) return TRUE;
2106
2107	// omCheckAddrSize(r,sizeof(ip_sring));
2108	#if OM_CHECK > 0
2109	i=rBlocks(r);
2110	omCheckAddrSize(r->order,i*sizeof(int));
2111	omCheckAddrSize(r->block0,i*sizeof(int));
2112	omCheckAddrSize(r->block1,i*sizeof(int));
2113	omCheckAddrSize(r->wvhdl,isizeof(int ));
2114	for (j=0;j<i; j++)
2115	{
2116	if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
2117	}
2118	#endif
2119	if (r->VarOffset == NULL)
2120	{
2121	dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
2122	return FALSE;
2123	}
2124	omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
2125
2126	if ((r->OrdSize==0)!=(r->typ==NULL))
2127	{
2128	dReportError("mismatch OrdSize and typ-pointer in %s:%d");
2129	return FALSE;
2130	}
2131	omcheckAddrSize(r->typ,r->OrdSizesizeof((r->typ)));
2132	omCheckAddrSize(r->VarOffset,(r->N+1)sizeof((r->VarOffset)));
2133	// test assumptions:
2134	for(i=0;i<=r->N;i++)
2135	{
2136	if(r->typ!=NULL)
2137	{
2138	for(j=0;j<r->OrdSize;j++)
2139	{
2140	if (r->typ[j].ord_typ==ro_cp)
2141	{
2142	if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2143	dReportError("ordrec %d conflicts with var %d",j,i);
2144	}
2145	else
2146	if ((r->typ[j].ord_typ!=ro_syzcomp)
2147	&& (r->VarOffset[i] == r->typ[j].data.dp.place))
2148	dReportError("ordrec %d conflicts with var %d",j,i);
2149	}
2150	}
2151	int tmp;
2152	tmp=r->VarOffset[i] & 0xffffff;
2153	#if SIZEOF_LONG == 8
2154	if ((r->VarOffset[i] >> 24) >63)
2155	#else
2156	if ((r->VarOffset[i] >> 24) >31)
2157	#endif
2158	dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
2159	if (i > 0 && ((tmp<0) \|\|(tmp>r->ExpL_Size-1)))
2160	{
2161	dReportError("varoffset out of range for var %d: %d",i,tmp);
2162	}
2163	}
2164	if(r->typ!=NULL)
2165	{
2166	for(j=0;j<r->OrdSize;j++)
2167	{
2168	if ((r->typ[j].ord_typ==ro_dp)
2169	\|\| (r->typ[j].ord_typ==ro_wp)
2170	\|\| (r->typ[j].ord_typ==ro_wp_neg))
2171	{
2172	if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2173	dReportError("in ordrec %d: start(%d) > end(%d)",j,
2174	r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2175	if ((r->typ[j].data.dp.start < 1)
2176	\|\| (r->typ[j].data.dp.end > r->N))
2177	dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
2178	r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2179	}
2180	}
2181	}
2182	//assume(r->cf!=NULL);
2183
2184	return TRUE;
2185	}
2186	#endif
2187
2188	static void rO_Align(int &place, int &bitplace)
2189	{
2190	// increment place to the next aligned one
2191	// (count as Exponent_t,align as longs)
2192	if (bitplace!=BITS_PER_LONG)
2193	{
2194	place++;
2195	bitplace=BITS_PER_LONG;
2196	}
2197	}
2198
2199	static void rO_TDegree(int &place, int &bitplace, int start, int end,
2200	long *o, sro_ord &ord_struct)
2201	{
2202	// degree (aligned) of variables v_start..v_end, ordsgn 1
2203	rO_Align(place,bitplace);
2204	ord_struct.ord_typ=ro_dp;
2205	ord_struct.data.dp.start=start;
2206	ord_struct.data.dp.end=end;
2207	ord_struct.data.dp.place=place;
2208	o[place]=1;
2209	place++;
2210	rO_Align(place,bitplace);
2211	}
2212
2213	static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2214	long *o, sro_ord &ord_struct)
2215	{
2216	// degree (aligned) of variables v_start..v_end, ordsgn -1
2217	rO_Align(place,bitplace);
2218	ord_struct.ord_typ=ro_dp;
2219	ord_struct.data.dp.start=start;
2220	ord_struct.data.dp.end=end;
2221	ord_struct.data.dp.place=place;
2222	o[place]=-1;
2223	place++;
2224	rO_Align(place,bitplace);
2225	}
2226
2227	static void rO_WDegree(int &place, int &bitplace, int start, int end,
2228	long o, sro_ord &ord_struct, int weights)
2229	{
2230	// weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2231	rO_Align(place,bitplace);
2232	ord_struct.ord_typ=ro_wp;
2233	ord_struct.data.wp.start=start;
2234	ord_struct.data.wp.end=end;
2235	ord_struct.data.wp.place=place;
2236	ord_struct.data.wp.weights=weights;
2237	o[place]=1;
2238	place++;
2239	rO_Align(place,bitplace);
2240	int i;
2241	for(i=start;i<=end;i++)
2242	{
2243	if(weights[i-start]<0)
2244	{
2245	ord_struct.ord_typ=ro_wp_neg;
2246	break;
2247	}
2248	}
2249	}
2250
2251	static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2252	long o, sro_ord &ord_struct, int weights)
2253	{
2254	// weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2255	rO_Align(place,bitplace);
2256	ord_struct.ord_typ=ro_wp;
2257	ord_struct.data.wp.start=start;
2258	ord_struct.data.wp.end=end;
2259	ord_struct.data.wp.place=place;
2260	ord_struct.data.wp.weights=weights;
2261	o[place]=-1;
2262	place++;
2263	rO_Align(place,bitplace);
2264	int i;
2265	for(i=start;i<=end;i++)
2266	{
2267	if(weights[i-start]<0)
2268	{
2269	ord_struct.ord_typ=ro_wp_neg;
2270	break;
2271	}
2272	}
2273	}
2274
2275	static void rO_LexVars(int &place, int &bitplace, int start, int end,
2276	int &prev_ord, long o,int v, int bits, int opt_var)
2277	{
2278	// a block of variables v_start..v_end with lex order, ordsgn 1
2279	int k;
2280	int incr=1;
2281	if(prev_ord==-1) rO_Align(place,bitplace);
2282
2283	if (start>end)
2284	{
2285	incr=-1;
2286	}
2287	for(k=start;;k+=incr)
2288	{
2289	bitplace-=bits;
2290	if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2291	o[place]=1;
2292	v[k]= place \| (bitplace << 24);
2293	if (k==end) break;
2294	}
2295	prev_ord=1;
2296	if (opt_var!= -1)
2297	{
2298	assume((opt_var == end+1) \|\|(opt_var == end-1));
2299	if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2300	int save_bitplace=bitplace;
2301	bitplace-=bits;
2302	if (bitplace < 0)
2303	{
2304	bitplace=save_bitplace;
2305	return;
2306	}
2307	// there is enough space for the optional var
2308	v[opt_var]=place \| (bitplace << 24);
2309	}
2310	}
2311
2312	static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2313	int &prev_ord, long o,int v, int bits, int opt_var)
2314	{
2315	// a block of variables v_start..v_end with lex order, ordsgn -1
2316	int k;
2317	int incr=1;
2318	if(prev_ord==1) rO_Align(place,bitplace);
2319
2320	if (start>end)
2321	{
2322	incr=-1;
2323	}
2324	for(k=start;;k+=incr)
2325	{
2326	bitplace-=bits;
2327	if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2328	o[place]=-1;
2329	v[k]=place \| (bitplace << 24);
2330	if (k==end) break;
2331	}
2332	prev_ord=-1;
2333	// #if 0
2334	if (opt_var!= -1)
2335	{
2336	assume((opt_var == end+1) \|\|(opt_var == end-1));
2337	if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2338	int save_bitplace=bitplace;
2339	bitplace-=bits;
2340	if (bitplace < 0)
2341	{
2342	bitplace=save_bitplace;
2343	return;
2344	}
2345	// there is enough space for the optional var
2346	v[opt_var]=place \| (bitplace << 24);
2347	}
2348	// #endif
2349	}
2350
2351	static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2352	long *o, sro_ord &ord_struct)
2353	{
2354	// ordering is derived from component number
2355	rO_Align(place,bitplace);
2356	ord_struct.ord_typ=ro_syzcomp;
2357	ord_struct.data.syzcomp.place=place;
2358	ord_struct.data.syzcomp.Components=NULL;
2359	ord_struct.data.syzcomp.ShiftedComponents=NULL;
2360	o[place]=1;
2361	prev_ord=1;
2362	place++;
2363	rO_Align(place,bitplace);
2364	}
2365
2366	static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2367	long *o, sro_ord &ord_struct)
2368	{
2369	// ordering is derived from component number
2370	// let's reserve one Exponent_t for it
2371	if ((prev_ord== 1) \|\| (bitplace!=BITS_PER_LONG))
2372	rO_Align(place,bitplace);
2373	ord_struct.ord_typ=ro_syz;
2374	ord_struct.data.syz.place=place;
2375	ord_struct.data.syz.limit=0;
2376	ord_struct.data.syz.syz_index = NULL;
2377	ord_struct.data.syz.curr_index = 1;
2378	o[place]= -1;
2379	prev_ord=-1;
2380	place++;
2381	}
2382
2383	static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2384	{
2385	if (bitmask == 0)
2386	{
2387	bits=16; bitmask=0xffff;
2388	}
2389	else if (bitmask <= 1)
2390	{
2391	bits=1; bitmask = 1;
2392	}
2393	else if (bitmask <= 3)
2394	{
2395	bits=2; bitmask = 3;
2396	}
2397	else if (bitmask <= 7)
2398	{
2399	bits=3; bitmask=7;
2400	}
2401	else if (bitmask <= 0xf)
2402	{
2403	bits=4; bitmask=0xf;
2404	}
2405	else if (bitmask <= 0x1f)
2406	{
2407	bits=5; bitmask=0x1f;
2408	}
2409	else if (bitmask <= 0x3f)
2410	{
2411	bits=6; bitmask=0x3f;
2412	}
2413	#if SIZEOF_LONG == 8
2414	else if (bitmask <= 0x7f)
2415	{
2416	bits=7; bitmask=0x7f; /* 64 bit longs only */
2417	}
2418	#endif
2419	else if (bitmask <= 0xff)
2420	{
2421	bits=8; bitmask=0xff;
2422	}
2423	#if SIZEOF_LONG == 8
2424	else if (bitmask <= 0x1ff)
2425	{
2426	bits=9; bitmask=0x1ff; /* 64 bit longs only */
2427	}
2428	#endif
2429	else if (bitmask <= 0x3ff)
2430	{
2431	bits=10; bitmask=0x3ff;
2432	}
2433	#if SIZEOF_LONG == 8
2434	else if (bitmask <= 0xfff)
2435	{
2436	bits=12; bitmask=0xfff; /* 64 bit longs only */
2437	}
2438	#endif
2439	else if (bitmask <= 0xffff)
2440	{
2441	bits=16; bitmask=0xffff;
2442	}
2443	#if SIZEOF_LONG == 8
2444	else if (bitmask <= 0xfffff)
2445	{
2446	bits=20; bitmask=0xfffff; /* 64 bit longs only */
2447	}
2448	else if (bitmask <= 0xffffffff)
2449	{
2450	bits=32; bitmask=0xffffffff;
2451	}
2452	else
2453	{
2454	bits=64; bitmask=0xffffffffffffffff;
2455	}
2456	#else
2457	else
2458	{
2459	bits=32; bitmask=0xffffffff;
2460	}
2461	#endif
2462	return bitmask;
2463	}
2464
2465	/*2
2466	* optimize rGetExpSize for a block of N variables, exp <=bitmask
2467	*/
2468	static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2469	{
2470	bitmask =rGetExpSize(bitmask, bits);
2471	int vars_per_long=BIT_SIZEOF_LONG/bits;
2472	int bits1;
2473	loop
2474	{
2475	if (bits == BIT_SIZEOF_LONG)
2476	{
2477	bits = BIT_SIZEOF_LONG - 1;
2478	return LONG_MAX;
2479	}
2480	unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2481	int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2482	if ((((N+vars_per_long-1)/vars_per_long) ==
2483	((N+vars_per_long1-1)/vars_per_long1)))
2484	{
2485	vars_per_long=vars_per_long1;
2486	bits=bits1;
2487	bitmask=bitmask1;
2488	}
2489	else
2490	{
2491	return bitmask; /* and bits */
2492	}
2493	}
2494	}
2495
2496	/*2
2497	* create a copy of the ring r, which must be equivalent to currRing
2498	* used for std computations
2499	* may share data structures with currRing
2500	* DOES CALL rComplete
2501	*/
2502	ring rModifyRing(ring r, BOOLEAN omit_degree,
2503	BOOLEAN omit_comp,
2504	unsigned long exp_limit)
2505	{
2506	assume (r != NULL );
2507	assume (exp_limit > 1);
2508	BOOLEAN need_other_ring;
2509	BOOLEAN omitted_degree = FALSE;
2510	int bits;
2511
2512	exp_limit=rGetExpSize(exp_limit, bits, r->N);
2513	need_other_ring = (exp_limit != r->bitmask);
2514
2515	int nblocks=rBlocks(r);
2516	int order=(int)omAlloc0((nblocks+1)*sizeof(int));
2517	int block0=(int)omAlloc0((nblocks+1)*sizeof(int));
2518	int block1=(int)omAlloc0((nblocks+1)*sizeof(int));
2519	int wvhdl=(int)omAlloc0((nblocks+1)*sizeof(int_ptr));
2520
2521	int i=0;
2522	int j=0; /* i index in r, j index in res */
2523	loop
2524	{
2525	BOOLEAN copy_block_index=TRUE;
2526	int r_ord=r->order[i];
2527	if (r->block0[i]==r->block1[i])
2528	{
2529	switch(r_ord)
2530	{
2531	case ringorder_wp:
2532	case ringorder_dp:
2533	case ringorder_Wp:
2534	case ringorder_Dp:
2535	r_ord=ringorder_lp;
2536	break;
2537	case ringorder_Ws:
2538	case ringorder_Ds:
2539	case ringorder_ws:
2540	case ringorder_ds:
2541	r_ord=ringorder_ls;
2542	break;
2543	default:
2544	break;
2545	}
2546	}
2547	switch(r_ord)
2548	{
2549	case ringorder_C:
2550	case ringorder_c:
2551	if (!omit_comp)
2552	{
2553	order[j]=r_ord; /r->order[i]/;
2554	}
2555	else
2556	{
2557	j--;
2558	need_other_ring=TRUE;
2559	omit_comp=FALSE;
2560	copy_block_index=FALSE;
2561	}
2562	break;
2563	case ringorder_wp:
2564	case ringorder_dp:
2565	case ringorder_ws:
2566	case ringorder_ds:
2567	if(!omit_degree)
2568	{
2569	order[j]=r_ord; /r->order[i]/;
2570	}
2571	else
2572	{
2573	order[j]=ringorder_rp;
2574	need_other_ring=TRUE;
2575	omit_degree=FALSE;
2576	omitted_degree = TRUE;
2577	}
2578	break;
2579	case ringorder_Wp:
2580	case ringorder_Dp:
2581	case ringorder_Ws:
2582	case ringorder_Ds:
2583	if(!omit_degree)
2584	{
2585	order[j]=r_ord; /r->order[i];/
2586	}
2587	else
2588	{
2589	order[j]=ringorder_lp;
2590	need_other_ring=TRUE;
2591	omit_degree=FALSE;
2592	omitted_degree = TRUE;
2593	}
2594	break;
2595	default:
2596	order[j]=r_ord; /r->order[i];/
2597	break;
2598	}
2599	if (copy_block_index)
2600	{
2601	block0[j]=r->block0[i];
2602	block1[j]=r->block1[i];
2603	wvhdl[j]=r->wvhdl[i];
2604	}
2605	i++;j++;
2606	// order[j]=ringorder_no; // done by omAlloc0
2607	if (i==nblocks) break;
2608	}
2609	if(!need_other_ring)
2610	{
2611	omFreeSize(order,(nblocks+1)*sizeof(int));
2612	omFreeSize(block0,(nblocks+1)*sizeof(int));
2613	omFreeSize(block1,(nblocks+1)*sizeof(int));
2614	omFreeSize(wvhdl,(nblocks+1)*sizeof(int_ptr));
2615	return r;
2616	}
2617	ring res=(ring)omAlloc0Bin(ip_sring_bin);
2618	res = r;
2619	// res->qideal, res->idroot ???
2620	res->wvhdl=wvhdl;
2621	res->order=order;
2622	res->block0=block0;
2623	res->block1=block1;
2624	res->bitmask=exp_limit;
2625	int tmpref=r->cf->ref;
2626	rComplete(res, 1);
2627	r->cf->ref=tmpref;
2628
2629	// adjust res->pFDeg: if it was changed globally, then
2630	// it must also be changed for new ring
2631	if (r->pFDegOrig != res->pFDegOrig &&
2632	rOrd_is_WeightedDegree_Ordering(r))
2633	{
2634	// still might need adjustment for weighted orderings
2635	// and omit_degree
2636	res->firstwv = r->firstwv;
2637	res->firstBlockEnds = r->firstBlockEnds;
2638	res->pFDeg = res->pFDegOrig = pWFirstTotalDegree;
2639	}
2640	if (omitted_degree)
2641	res->pLDeg = res->pLDegOrig = r->pLDegOrig;
2642
2643	rOptimizeLDeg(res);
2644
2645	// set syzcomp
2646	if (res->typ != NULL && res->typ[0].ord_typ == ro_syz)
2647	{
2648	res->typ[0] = r->typ[0];
2649	if (r->typ[0].data.syz.limit > 0)
2650	{
2651	res->typ[0].data.syz.syz_index
2652	= (int) omAlloc((r->typ[0].data.syz.limit +1)sizeof(int));
2653	memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2654	(r->typ[0].data.syz.limit +1)*sizeof(int));
2655	}
2656	}
2657	return res;
2658	}
2659
2660	void rKillModifiedRing(ring r)
2661	{
2662	rUnComplete(r);
2663	omFree(r->order);
2664	omFree(r->block0);
2665	omFree(r->block1);
2666	omFree(r->wvhdl);
2667	omFreeBin(r,ip_sring_bin);
2668	}
2669
2670	static void rSetOutParams(ring r)
2671	{
2672	r->VectorOut = (r->order[0] == ringorder_c);
2673	r->ShortOut = TRUE;
2674	#ifdef HAVE_TCL
2675	if (tcllmode)
2676	{
2677	r->ShortOut = FALSE;
2678	}
2679	else
2680	#endif
2681	{
2682	int i;
2683	if ((r->parameter!=NULL) && (r->ch<2))
2684	{
2685	for (i=0;i<rPar(r);i++)
2686	{
2687	if(strlen(r->parameter[i])>1)
2688	{
2689	r->ShortOut=FALSE;
2690	break;
2691	}
2692	}
2693	}
2694	if (r->ShortOut)
2695	{
2696	// Hmm... sometimes (e.g., from maGetPreimage) new variables
2697	// are intorduced, but their names are never set
2698	// hence, we do the following awkward trick
2699	int N = omSizeWOfAddr(r->names);
2700	if (r->N < N) N = r->N;
2701
2702	for (i=(N-1);i>=0;i--)
2703	{
2704	if(r->names[i] != NULL && strlen(r->names[i])>1)
2705	{
2706	r->ShortOut=FALSE;
2707	break;
2708	}
2709	}
2710	}
2711	}
2712	r->CanShortOut = r->ShortOut;
2713	}
2714
2715	/*2
2716	* sets pMixedOrder and pComponentOrder for orderings with more than one block
2717	* block of variables (ip is the block number, o_r the number of the ordering)
2718	* o is the position of the orderingering in r
2719	*/
2720	static void rHighSet(ring r, int o_r, int o)
2721	{
2722	switch(o_r)
2723	{
2724	case ringorder_lp:
2725	case ringorder_dp:
2726	case ringorder_Dp:
2727	case ringorder_wp:
2728	case ringorder_Wp:
2729	case ringorder_rp:
2730	case ringorder_a:
2731	case ringorder_aa:
2732	if (r->OrdSgn==-1) r->MixedOrder=TRUE;
2733	break;
2734	case ringorder_ls:
2735	case ringorder_ds:
2736	case ringorder_Ds:
2737	case ringorder_s:
2738	break;
2739	case ringorder_ws:
2740	case ringorder_Ws:
2741	if (r->wvhdl[o]!=NULL)
2742	{
2743	int i;
2744	for(i=r->block1[o]-r->block0[o];i>=0;i--)
2745	if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
2746	}
2747	break;
2748	case ringorder_c:
2749	r->ComponentOrder=1;
2750	break;
2751	case ringorder_C:
2752	case ringorder_S:
2753	r->ComponentOrder=-1;
2754	break;
2755	case ringorder_M:
2756	r->MixedOrder=TRUE;
2757	break;
2758	default:
2759	dReportError("wrong internal ordering:%d at %s, l:%d\n",o_r,__FILE__,__LINE__);
2760	}
2761	}
2762
2763	static void rSetFirstWv(ring r, int i, int* order, int* block1, int** wvhdl)
2764	{
2765	// cheat for ringorder_aa
2766	if (order[i] == ringorder_aa)
2767	i++;
2768	if(block1[i]!=r->N) r->LexOrder=TRUE;
2769	r->firstBlockEnds=block1[i];
2770	r->firstwv = wvhdl[i];
2771	if ((order[i]== ringorder_ws) \|\| (order[i]==ringorder_Ws))
2772	{
2773	int j;
2774	for(j=block1[i]-r->block0[i];j>=0;j--)
2775	if (r->firstwv[j]<0) { r->MixedOrder=TRUE; break; }
2776	}
2777	}
2778
2779	static void rOptimizeLDeg(ring r)
2780	{
2781	if (r->pFDeg == pDeg)
2782	{
2783	if (r->pLDeg == pLDeg1)
2784	r->pLDeg = pLDeg1_Deg;
2785	if (r->pLDeg == pLDeg1c)
2786	r->pLDeg = pLDeg1c_Deg;
2787	}
2788	else if (r->pFDeg == pTotaldegree)
2789	{
2790	if (r->pLDeg == pLDeg1)
2791	r->pLDeg = pLDeg1_Totaldegree;
2792	if (r->pLDeg == pLDeg1c)
2793	r->pLDeg = pLDeg1c_Totaldegree;
2794	}
2795	else if (r->pFDeg == pWFirstTotalDegree)
2796	{
2797	if (r->pLDeg == pLDeg1)
2798	r->pLDeg = pLDeg1_WFirstTotalDegree;
2799	if (r->pLDeg == pLDeg1c)
2800	r->pLDeg = pLDeg1c_WFirstTotalDegree;
2801	}
2802	}
2803
2804	// set pFDeg, pLDeg, MixOrder, ComponentOrder, etc
2805	static void rSetDegStuff(ring r)
2806	{
2807	int* order = r->order;
2808	int* block0 = r->block0;
2809	int* block1 = r->block1;
2810	int** wvhdl = r->wvhdl;
2811
2812	if (order[0]==ringorder_S \|\|order[0]==ringorder_s)
2813	{
2814	order++;
2815	block0++;
2816	block1++;
2817	wvhdl++;
2818	}
2819	r->LexOrder = FALSE;
2820	r->MixedOrder = FALSE;
2821	r->ComponentOrder = 1;
2822	r->pFDeg = pTotaldegree;
2823	r->pLDeg = (r->OrdSgn == 1 ? pLDegb : pLDeg0);
2824
2825	/======== ordering type is (_,c) =========================/
2826	if ((order[0]==ringorder_unspec) \|\| (order[1] == 0)
2827	\|\|(
2828	((order[1]==ringorder_c)\|\|(order[1]==ringorder_C)
2829	\|\|(order[1]==ringorder_S)
2830	\|\|(order[1]==ringorder_s))
2831	&& (order[0]!=ringorder_M)
2832	&& (order[2]==0))
2833	)
2834	{
2835	if ((order[0]!=ringorder_unspec)
2836	&& ((order[1]==ringorder_C)\|\|(order[1]==ringorder_S)\|\|
2837	(order[1]==ringorder_s)))
2838	r->ComponentOrder=-1;
2839	if (r->OrdSgn == -1) r->pLDeg = pLDeg0c;
2840	if ((order[0] == ringorder_lp) \|\| (order[0] == ringorder_ls) \|\| order[0] == ringorder_rp)
2841	{
2842	r->LexOrder=TRUE;
2843	r->pLDeg = pLDeg1c;
2844	}
2845	if (order[0] == ringorder_wp \|\| order[0] == ringorder_Wp \|\|
2846	order[0] == ringorder_ws \|\| order[0] == ringorder_Ws)
2847	r->pFDeg = pWFirstTotalDegree;
2848	r->firstBlockEnds=block1[0];
2849	r->firstwv = wvhdl[0];
2850	}
2851	/======== ordering type is (c,_) =========================/
2852	else if (((order[0]==ringorder_c)
2853	\|\|(order[0]==ringorder_C)
2854	\|\|(order[0]==ringorder_S)
2855	\|\|(order[0]==ringorder_s))
2856	&& (order[1]!=ringorder_M)
2857	&& (order[2]==0))
2858	{
2859	if ((order[0]==ringorder_C)\|\|(order[0]==ringorder_S)\|\|
2860	order[0]==ringorder_s)
2861	r->ComponentOrder=-1;
2862	if ((order[1] == ringorder_lp) \|\| (order[1] == ringorder_ls) \|\| order[1] == ringorder_rp)
2863	{
2864	r->LexOrder=TRUE;
2865	r->pLDeg = pLDeg1c;
2866	}
2867	r->firstBlockEnds=block1[1];
2868	r->firstwv = wvhdl[1];
2869	if (order[1] == ringorder_wp \|\| order[1] == ringorder_Wp \|\|
2870	order[1] == ringorder_ws \|\| order[1] == ringorder_Ws)
2871	r->pFDeg = pWFirstTotalDegree;
2872	}
2873	/------- more than one block ----------------------/
2874	else
2875	{
2876	if ((r->VectorOut)\|\|(order[0]==ringorder_C)\|\|(order[0]==ringorder_S)\|\|(order[0]==ringorder_s))
2877	{
2878	rSetFirstWv(r, 1, order, block1, wvhdl);
2879	}
2880	else
2881	rSetFirstWv(r, 0, order, block1, wvhdl);
2882
2883	/the number of orderings:/
2884	int i = 0;
2885	while (order[++i] != 0);
2886	do
2887	{
2888	i--;
2889	rHighSet(r, order[i],i);
2890	}
2891	while (i != 0);
2892
2893	if ((order[0]!=ringorder_c)
2894	&& (order[0]!=ringorder_C)
2895	&& (order[0]!=ringorder_S)
2896	&& (order[0]!=ringorder_s))
2897	{
2898	r->pLDeg = pLDeg1c;
2899	}
2900	else
2901	{
2902	r->pLDeg = pLDeg1;
2903	}
2904	r->pFDeg = pWTotaldegree; // may be improved: pTotaldegree for lp/dp/ls/.. blocks
2905	}
2906	if (rOrd_is_Totaldegree_Ordering(r) \|\| rOrd_is_WeightedDegree_Ordering(r))
2907	r->pFDeg = pDeg;
2908
2909	r->pFDegOrig = r->pFDeg;
2910	r->pLDegOrig = r->pLDeg;
2911	rOptimizeLDeg(r);
2912	}
2913
2914	/*2
2915	* set NegWeightL_Size, NegWeightL_Offset
2916	*/
2917	static void rSetNegWeight(ring r)
2918	{
2919	int i,l;
2920	if (r->typ!=NULL)
2921	{
2922	l=0;
2923	for(i=0;i<r->OrdSize;i++)
2924	{
2925	if(r->typ[i].ord_typ==ro_wp_neg) l++;
2926	}
2927	if (l>0)
2928	{
2929	r->NegWeightL_Size=l;
2930	r->NegWeightL_Offset=(int ) omAlloc(lsizeof(int));
2931	l=0;
2932	for(i=0;i<r->OrdSize;i++)
2933	{
2934	if(r->typ[i].ord_typ==ro_wp_neg)
2935	{
2936	r->NegWeightL_Offset[l]=r->typ[i].data.wp.place;
2937	l++;
2938	}
2939	}
2940	return;
2941	}
2942	}
2943	r->NegWeightL_Size = 0;
2944	r->NegWeightL_Offset = NULL;
2945	}
2946
2947	static void rSetOption(ring r)
2948	{
2949	// set redthrough
2950	if (!TEST_OPT_OLDSTD && r->OrdSgn == 1 && ! r->LexOrder)
2951	r->options \|= Sy_bit(OPT_REDTHROUGH);
2952	else
2953	r->options &= ~Sy_bit(OPT_REDTHROUGH);
2954
2955	// set intStrategy
2956	if (rField_is_Extension(r) \|\| rField_is_Q(r))
2957	r->options \|= Sy_bit(OPT_INTSTRATEGY);
2958	else
2959	r->options &= ~Sy_bit(OPT_INTSTRATEGY);
2960
2961	// set redTail
2962	if (r->LexOrder \|\| r->OrdSgn == -1 \|\| rField_is_Extension(r))
2963	r->options &= ~Sy_bit(OPT_REDTAIL);
2964	else
2965	r->options \|= Sy_bit(OPT_REDTAIL);
2966	}
2967
2968	BOOLEAN rComplete(ring r, int force)
2969	{
2970	if (r->VarOffset!=NULL && force == 0) return FALSE;
2971	nInitChar(r);
2972	rSetOutParams(r);
2973	int n=rBlocks(r)-1;
2974	int i;
2975	int bits;
2976	r->bitmask=rGetExpSize(r->bitmask,bits,r->N);
2977	r->BitsPerExp = bits;
2978	r->ExpPerLong = BIT_SIZEOF_LONG / bits;
2979	r->divmask=rGetDivMask(bits);
2980
2981	// will be used for ordsgn:
2982	long tmp_ordsgn=(long )omAlloc0(2(n+r->N)sizeof(long));
2983	// will be used for VarOffset:
2984	int v=(int )omAlloc((r->N+1)*sizeof(int));
2985	for(i=r->N; i>=0 ; i--)
2986	{
2987	v[i]=-1;
2988	}
2989	sro_ord tmp_typ=(sro_ord )omAlloc0(2(n+r->N)sizeof(sro_ord));
2990	int typ_i=0;
2991	int prev_ordsgn=0;
2992
2993	// fill in v, tmp_typ, tmp_ordsgn, determine typ_i (== ordSize)
2994	int j=0;
2995	int j_bits=BITS_PER_LONG;
2996	BOOLEAN need_to_add_comp=FALSE;
2997	for(i=0;i<n;i++)
2998	{
2999	tmp_typ[typ_i].order_index=i;
3000	switch (r->order[i])
3001	{
3002	case ringorder_a:
3003	case ringorder_aa:
3004	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,tmp_typ[typ_i],
3005	r->wvhdl[i]);
3006	typ_i++;
3007	break;
3008
3009	case ringorder_c:
3010	rO_Align(j, j_bits);
3011	rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3012	break;
3013
3014	case ringorder_C:
3015	rO_Align(j, j_bits);
3016	rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3017	break;
3018
3019	case ringorder_M:
3020	{
3021	int k,l;
3022	k=r->block1[i]-r->block0[i]+1; // number of vars
3023	for(l=0;l<k;l++)
3024	{
3025	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3026	tmp_typ[typ_i],
3027	r->wvhdl[i]+(r->block1[i]-r->block0[i]+1)*l);
3028	typ_i++;
3029	}
3030	break;
3031	}
3032
3033	case ringorder_lp:
3034	rO_LexVars(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3035	tmp_ordsgn,v,bits, -1);
3036	break;
3037
3038	case ringorder_ls:
3039	rO_LexVars_neg(j, j_bits, r->block0[i],r->block1[i], prev_ordsgn,
3040	tmp_ordsgn,v, bits, -1);
3041	break;
3042
3043	case ringorder_rp:
3044	rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i], prev_ordsgn,
3045	tmp_ordsgn,v, bits, -1);
3046	break;
3047
3048	case ringorder_dp:
3049	if (r->block0[i]==r->block1[i])
3050	{
3051	rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3052	tmp_ordsgn,v, bits, -1);
3053	}
3054	else
3055	{
3056	rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3057	tmp_typ[typ_i]);
3058	typ_i++;
3059	rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3060	prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3061	}
3062	break;
3063
3064	case ringorder_Dp:
3065	if (r->block0[i]==r->block1[i])
3066	{
3067	rO_LexVars(j, j_bits, r->block0[i],r->block0[i], prev_ordsgn,
3068	tmp_ordsgn,v, bits, -1);
3069	}
3070	else
3071	{
3072	rO_TDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3073	tmp_typ[typ_i]);
3074	typ_i++;
3075	rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3076	tmp_ordsgn,v, bits, r->block1[i]);
3077	}
3078	break;
3079
3080	case ringorder_ds:
3081	if (r->block0[i]==r->block1[i])
3082	{
3083	rO_LexVars_neg(j, j_bits,r->block0[i],r->block1[i],prev_ordsgn,
3084	tmp_ordsgn,v,bits, -1);
3085	}
3086	else
3087	{
3088	rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3089	tmp_typ[typ_i]);
3090	typ_i++;
3091	rO_LexVars_neg(j, j_bits, r->block1[i],r->block0[i]+1,
3092	prev_ordsgn,tmp_ordsgn,v,bits, r->block0[i]);
3093	}
3094	break;
3095
3096	case ringorder_Ds:
3097	if (r->block0[i]==r->block1[i])
3098	{
3099	rO_LexVars_neg(j, j_bits, r->block0[i],r->block0[i],prev_ordsgn,
3100	tmp_ordsgn,v, bits, -1);
3101	}
3102	else
3103	{
3104	rO_TDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3105	tmp_typ[typ_i]);
3106	typ_i++;
3107	rO_LexVars(j, j_bits, r->block0[i],r->block1[i]-1, prev_ordsgn,
3108	tmp_ordsgn,v, bits, r->block1[i]);
3109	}
3110	break;
3111
3112	case ringorder_wp:
3113	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3114	tmp_typ[typ_i], r->wvhdl[i]);
3115	typ_i++;
3116	if (r->block1[i]!=r->block0[i])
3117	{
3118	rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3119	tmp_ordsgn, v,bits, r->block0[i]);
3120	}
3121	break;
3122
3123	case ringorder_Wp:
3124	rO_WDegree(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3125	tmp_typ[typ_i], r->wvhdl[i]);
3126	typ_i++;
3127	if (r->block1[i]!=r->block0[i])
3128	{
3129	rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3130	tmp_ordsgn,v, bits, r->block1[i]);
3131	}
3132	break;
3133
3134	case ringorder_ws:
3135	rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3136	tmp_typ[typ_i], r->wvhdl[i]);
3137	typ_i++;
3138	if (r->block1[i]!=r->block0[i])
3139	{
3140	rO_LexVars_neg(j, j_bits,r->block1[i],r->block0[i]+1, prev_ordsgn,
3141	tmp_ordsgn, v,bits, r->block0[i]);
3142	}
3143	break;
3144
3145	case ringorder_Ws:
3146	rO_WDegree_neg(j,j_bits,r->block0[i],r->block1[i],tmp_ordsgn,
3147	tmp_typ[typ_i], r->wvhdl[i]);
3148	typ_i++;
3149	if (r->block1[i]!=r->block0[i])
3150	{
3151	rO_LexVars(j, j_bits,r->block0[i],r->block1[i]-1, prev_ordsgn,
3152	tmp_ordsgn,v, bits, r->block1[i]);
3153	}
3154	break;
3155
3156	case ringorder_S:
3157	rO_Syzcomp(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3158	need_to_add_comp=TRUE;
3159	typ_i++;
3160	break;
3161
3162	case ringorder_s:
3163	rO_Syz(j, j_bits,prev_ordsgn, tmp_ordsgn,tmp_typ[typ_i]);
3164	need_to_add_comp=TRUE;
3165	typ_i++;
3166	break;
3167
3168	case ringorder_unspec:
3169	case ringorder_no:
3170	default:
3171	dReportError("undef. ringorder used\n");
3172	break;
3173	}
3174	}
3175
3176	int j0=j; // save j
3177	int j_bits0=j_bits; // save jbits
3178	rO_Align(j,j_bits);
3179	r->CmpL_Size = j;
3180
3181	j_bits=j_bits0; j=j0;
3182
3183	// fill in some empty slots with variables not already covered
3184	// v0 is special, is therefore normally already covered
3185	// now we do have rings without comp...
3186	if((need_to_add_comp) && (v[0]== -1))
3187	{
3188	if (prev_ordsgn==1)
3189	{
3190	rO_Align(j, j_bits);
3191	rO_LexVars(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3192	}
3193	else
3194	{
3195	rO_Align(j, j_bits);
3196	rO_LexVars_neg(j, j_bits, 0,0, prev_ordsgn,tmp_ordsgn,v,BITS_PER_LONG, -1);
3197	}
3198	}
3199	// the variables
3200	for(i=1 ; i<r->N+1 ; i++)
3201	{
3202	if(v[i]==(-1))
3203	{
3204	if (prev_ordsgn==1)
3205	{
3206	rO_LexVars(j, j_bits, i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3207	}
3208	else
3209	{
3210	rO_LexVars_neg(j,j_bits,i,i, prev_ordsgn,tmp_ordsgn,v,bits, -1);
3211	}
3212	}
3213	}
3214
3215	rO_Align(j,j_bits);
3216	// ----------------------------
3217	// finished with constructing the monomial, computing sizes:
3218
3219	r->ExpL_Size=j;
3220	r->PolyBin = omGetSpecBin(POLYSIZE + (r->ExpL_Size)*sizeof(long));
3221	assume(r->PolyBin != NULL);
3222
3223	// ----------------------------
3224	// indices and ordsgn vector for comparison
3225	//
3226	// r->pCompHighIndex already set
3227	r->ordsgn=(long )omAlloc0(r->ExpL_Sizesizeof(long));
3228
3229	for(j=0;j<r->CmpL_Size;j++)
3230	{
3231	r->ordsgn[j] = tmp_ordsgn[j];
3232	}
3233
3234	omFreeSize((ADDRESS)tmp_ordsgn,(2(n+r->N)sizeof(long)));
3235
3236	// ----------------------------
3237	// description of orderings for setm:
3238	//
3239	r->OrdSize=typ_i;
3240	if (typ_i==0) r->typ=NULL;
3241	else
3242	{
3243	r->typ=(sro_ord)omAlloc(typ_isizeof(sro_ord));
3244	memcpy(r->typ,tmp_typ,typ_i*sizeof(sro_ord));
3245	}
3246	omFreeSize((ADDRESS)tmp_typ,(2(n+r->N)sizeof(sro_ord)));
3247
3248	// ----------------------------
3249	// indices for (first copy of ) variable entries in exp.e vector (VarOffset):
3250	r->VarOffset=v;
3251
3252	// ----------------------------
3253	// other indicies
3254	r->pCompIndex=(r->VarOffset[0] & 0xffff); //r->VarOffset[0];
3255	i=0; // position
3256	j=0; // index in r->typ
3257	if (i==r->pCompIndex) i++;
3258	while ((j < r->OrdSize)
3259	&& ((r->typ[j].ord_typ==ro_syzcomp) \|\|
3260	(r->typ[j].ord_typ==ro_syz) \|\|
3261	(r->order[r->typ[j].order_index] == ringorder_aa)))
3262	{
3263	i++; j++;
3264	}
3265	if (i==r->pCompIndex) i++;
3266	r->pOrdIndex=i;
3267
3268	// ----------------------------
3269	rSetDegStuff(r);
3270	rSetOption(r);
3271	// ----------------------------
3272	// r->p_Setm
3273	r->p_Setm = p_GetSetmProc(r);
3274
3275	// ----------------------------
3276	// set VarL_*
3277	rSetVarL(r);
3278
3279	// ----------------------------
3280	// right-adjust VarOffset
3281	rRightAdjustVarOffset(r);
3282
3283	// ----------------------------
3284	// set NegWeightL*
3285	rSetNegWeight(r);
3286
3287	// ----------------------------
3288	// p_Procs: call AFTER NegWeightL
3289	r->p_Procs = (p_Procs_s*)omAlloc(sizeof(p_Procs_s));
3290	p_ProcsSet(r, r->p_Procs);
3291
3292	return FALSE;
3293	}
3294
3295	void rUnComplete(ring r)
3296	{
3297	if (r == NULL) return;
3298	if (r->VarOffset != NULL)
3299	{
3300	if (r->PolyBin != NULL)
3301	omUnGetSpecBin(&(r->PolyBin));
3302
3303	omFreeSize((ADDRESS)r->VarOffset, (r->N +1)*sizeof(int));
3304	if (r->order != NULL)
3305	{
3306	if (r->order[0] == ringorder_s && r->typ[0].data.syz.limit > 0)
3307	{
3308	omFreeSize(r->typ[0].data.syz.syz_index,
3309	(r->typ[0].data.syz.limit +1)*sizeof(int));
3310	}
3311	}
3312	if (r->OrdSize!=0 && r->typ != NULL)
3313	{
3314	omFreeSize((ADDRESS)r->typ,r->OrdSize*sizeof(sro_ord));
3315	}
3316	if (r->ordsgn != NULL && r->CmpL_Size != 0)
3317	omFreeSize((ADDRESS)r->ordsgn,r->ExpL_Size*sizeof(long));
3318	if (r->p_Procs != NULL)
3319	omFreeSize(r->p_Procs, sizeof(p_Procs_s));
3320	omfreeSize(r->VarL_Offset, r->VarL_Size*sizeof(int));
3321	}
3322	if (r->NegWeightL_Offset!=NULL)
3323	{
3324	omFreeSize(r->NegWeightL_Offset, r->NegWeightL_Size*sizeof(int));
3325	r->NegWeightL_Offset=NULL;
3326	}
3327	}
3328
3329	// set r->VarL_Size, r->VarL_Offset, r->VarL_LowIndex
3330	static void rSetVarL(ring r)
3331	{
3332	int min = INT_MAX, min_j = -1;
3333	int* VarL_Number = (int) omAlloc0(r->ExpL_Sizesizeof(int));
3334
3335	int i,j;
3336
3337	// count how often a var long is occupied by an exponent
3338	for (i=1; i<=r->N; i++)
3339	{
3340	VarL_Number[r->VarOffset[i] & 0xffffff]++;
3341	}
3342
3343	// determine how many and min
3344	for (i=0, j=0; i<r->ExpL_Size; i++)
3345	{
3346	if (VarL_Number[i] != 0)
3347	{
3348	if (min > VarL_Number[i])
3349	{
3350	min = VarL_Number[i];
3351	min_j = j;
3352	}
3353	j++;
3354	}
3355	}
3356
3357	r->VarL_Size = j;
3358	r->VarL_Offset = (int) omAlloc(r->VarL_Sizesizeof(int));
3359	r->VarL_LowIndex = 0;
3360
3361	// set VarL_Offset
3362	for (i=0, j=0; i<r->ExpL_Size; i++)
3363	{
3364	if (VarL_Number[i] != 0)
3365	{
3366	r->VarL_Offset[j] = i;
3367	if (j > 0 && r->VarL_Offset[j-1] != r->VarL_Offset[j] - 1)
3368	r->VarL_LowIndex = -1;
3369	j++;
3370	}
3371	}
3372	if (r->VarL_LowIndex >= 0)
3373	r->VarL_LowIndex = r->VarL_Offset[0];
3374
3375	r->MinExpPerLong = min;
3376	if (min_j != 0)
3377	{
3378	j = r->VarL_Offset[min_j];
3379	r->VarL_Offset[min_j] = r->VarL_Offset[0];
3380	r->VarL_Offset[0] = j;
3381	}
3382	omFree(VarL_Number);
3383	}
3384
3385	static void rRightAdjustVarOffset(ring r)
3386	{
3387	int* shifts = (int) omAlloc(r->ExpL_Sizesizeof(int));
3388	int i;
3389	// initialize shifts
3390	for (i=0;i<r->ExpL_Size;i++)
3391	shifts[i] = BIT_SIZEOF_LONG;
3392
3393	// find minimal bit in each long var
3394	for (i=1;i<=r->N;i++)
3395	{
3396	if (shifts[r->VarOffset[i] & 0xffffff] > r->VarOffset[i] >> 24)
3397	shifts[r->VarOffset[i] & 0xffffff] = r->VarOffset[i] >> 24;
3398	}
3399	// reset r->VarOffset
3400	for (i=1;i<=r->N;i++)
3401	{
3402	if (shifts[r->VarOffset[i] & 0xffffff] != 0)
3403	r->VarOffset[i]
3404	= (r->VarOffset[i] & 0xffffff) \|
3405	(((r->VarOffset[i] >> 24) - shifts[r->VarOffset[i] & 0xffffff]) << 24);
3406	}
3407	omFree(shifts);
3408	}
3409
3410	// get r->divmask depending on bits per exponent
3411	static unsigned long rGetDivMask(int bits)
3412	{
3413	unsigned long divmask = 1;
3414	int i = bits;
3415
3416	while (i < BIT_SIZEOF_LONG)
3417	{
3418	divmask \|= (((unsigned long) 1) << (unsigned long) i);
3419	i += bits;
3420	}
3421	return divmask;
3422	}
3423
3424	#ifdef RDEBUG
3425	void rDebugPrint(ring r)
3426	{
3427	if (r==NULL)
3428	{
3429	PrintS("NULL ?\n");
3430	return;
3431	}
3432	char *TYP[]={"ro_dp","ro_wp","ro_wp_neg","ro_cp",
3433	"ro_syzcomp", "ro_syz", "ro_none"};
3434	int i,j;
3435
3436	Print("ExpL_Size:%d ",r->ExpL_Size);
3437	Print("CmpL_Size:%d ",r->CmpL_Size);
3438	Print("VarL_Size:%d\n",r->VarL_Size);
3439	Print("bitmask=0x%x (expbound=%d) \n",r->bitmask, r->bitmask);
3440	Print("BitsPerExp=%d ExpPerLong=%d MinExpPerLong=%d at L[%d]\n", r->BitsPerExp, r->ExpPerLong, r->MinExpPerLong, r->VarL_Offset[0]);
3441	PrintS("varoffset:\n");
3442	if (r->VarOffset==NULL) PrintS(" NULL\n");
3443	else
3444	for(j=0;j<=r->N;j++)
3445	Print(" v%d at e-pos %d, bit %d\n",
3446	j,r->VarOffset[j] & 0xffffff, r->VarOffset[j] >>24);
3447	Print("divmask=%p\n", r->divmask);
3448	PrintS("ordsgn:\n");
3449	for(j=0;j<r->CmpL_Size;j++)
3450	Print(" ordsgn %d at pos %d\n",r->ordsgn[j],j);
3451	Print("OrdSgn:%d\n",r->OrdSgn);
3452	PrintS("ordrec:\n");
3453	for(j=0;j<r->OrdSize;j++)
3454	{
3455	Print(" typ %s",TYP[r->typ[j].ord_typ]);
3456	Print(" place %d",r->typ[j].data.dp.place);
3457	if (r->typ[j].ord_typ!=ro_syzcomp)
3458	{
3459	Print(" start %d",r->typ[j].data.dp.start);
3460	Print(" end %d",r->typ[j].data.dp.end);
3461	if (r->typ[j].ord_typ==ro_wp)
3462	{
3463	Print(" w:");
3464	int l;
3465	for(l=r->typ[j].data.wp.start;l<=r->typ[j].data.wp.end;l++)
3466	Print(" %d",r->typ[j].data.wp.weights[l-r->typ[j].data.wp.start]);
3467	}
3468	}
3469	PrintLn();
3470	}
3471	Print("pOrdIndex:%d pCompIndex:%d\n", r->pOrdIndex, r->pCompIndex);
3472	Print("OrdSize:%d\n",r->OrdSize);
3473	PrintS("--------------------\n");
3474	for(j=0;j<r->ExpL_Size;j++)
3475	{
3476	Print("L[%d]: ",j);
3477	if (j< r->CmpL_Size)
3478	Print("ordsgn %d ", r->ordsgn[j]);
3479	else
3480	PrintS("no comp ");
3481	i=1;
3482	for(;i<=r->N;i++)
3483	{
3484	if( (r->VarOffset[i] & 0xffffff) == j )
3485	{ Print("v%d at e[%d], bit %d; ", i,r->VarOffset[i] & 0xffffff,
3486	r->VarOffset[i] >>24 ); }
3487	}
3488	if( r->pCompIndex==j ) PrintS("v0; ");
3489	for(i=0;i<r->OrdSize;i++)
3490	{
3491	if (r->typ[i].data.dp.place == j)
3492	{
3493	Print("ordrec:%s (start:%d, end:%d) ",TYP[r->typ[i].ord_typ],
3494	r->typ[i].data.dp.start, r->typ[i].data.dp.end);
3495	}
3496	}
3497
3498	if (j==r->pOrdIndex)
3499	PrintS("pOrdIndex\n");
3500	else
3501	PrintLn();
3502	}
3503
3504	// p_Procs stuff
3505	p_Procs_s proc_names;
3506	char* field;
3507	char* length;
3508	char* ord;
3509	p_Debug_GetProcNames(r, &proc_names);
3510	p_Debug_GetSpecNames(r, field, length, ord);
3511
3512	Print("p_Spec : %s, %s, %s\n", field, length, ord);
3513	PrintS("p_Procs :\n");
3514	for (i=0; i<(int) (sizeof(p_Procs_s)/sizeof(void*)); i++)
3515	{
3516	Print(" %s,\n", ((char**) &proc_names)[i]);
3517	}
3518	}
3519
3520	void pDebugPrintR(poly p, ring r)
3521	{
3522	int i,j;
3523	pWrite(p);
3524	j=2;
3525	while(p!=NULL)
3526	{
3527	Print("\nexp[0..%d]\n",r->ExpL_Size-1);
3528	for(i=0;i<r->ExpL_Size;i++)
3529	Print("%d ",p->exp[i]);
3530	PrintLn();
3531	Print("v0:%d ",p_GetComp(p, r));
3532	for(i=1;i<=r->N;i++) Print(" v%d:%d",i,p_GetExp(p,i, r));
3533	PrintLn();
3534	pIter(p);
3535	j--;
3536	if (j==0) { PrintS("...\n"); break; }
3537	}
3538	}
3539
3540	void pDebugPrint(poly p)
3541	{
3542	pDebugPrintR(p, currRing);
3543	}
3544	#endif // RDEBUG
3545
3546
3547	/*2
3548	* asssume that rComplete was called with r
3549	* assume that the first block ist ringorder_S
3550	* change the block to reflect the sequence given by appending v
3551	*/
3552
3553	#ifdef PDEBUG
3554	void rDBChangeSComps(int* currComponents,
3555	long* currShiftedComponents,
3556	int length,
3557	ring r)
3558	{
3559	r->typ[1].data.syzcomp.length = length;
3560	rNChangeSComps( currComponents, currShiftedComponents, r);
3561	}
3562	void rDBGetSComps(int** currComponents,
3563	long** currShiftedComponents,
3564	int *length,
3565	ring r)
3566	{
3567	*length = r->typ[1].data.syzcomp.length;
3568	rNGetSComps( currComponents, currShiftedComponents, r);
3569	}
3570	#endif
3571
3572	void rNChangeSComps(int* currComponents, long* currShiftedComponents, ring r)
3573	{
3574	assume(r->order[1]==ringorder_S);
3575
3576	r->typ[1].data.syzcomp.ShiftedComponents = currShiftedComponents;
3577	r->typ[1].data.syzcomp.Components = currComponents;
3578	}
3579
3580	void rNGetSComps(int currComponents, long currShiftedComponents, ring r)
3581	{
3582	assume(r->order[1]==ringorder_S);
3583
3584	*currShiftedComponents = r->typ[1].data.syzcomp.ShiftedComponents;
3585	*currComponents = r->typ[1].data.syzcomp.Components;
3586	}
3587
3588	/////////////////////////////////////////////////////////////////////////////
3589	//
3590	// The following routines all take as input a ring r, and return R
3591	// where R has a certain property. P might be equal r in which case r
3592	// had already this property
3593	//
3594	// Without argument, these functions work on currRing and change it,
3595	// if necessary
3596
3597	// for the time being, this is still here
3598	static ring rAssure_SyzComp(ring r, BOOLEAN complete = TRUE);
3599
3600	ring rCurrRingAssure_SyzComp()
3601	{
3602	ring r = rAssure_SyzComp(currRing);
3603	if (r != currRing)
3604	{
3605	ring old_ring = currRing;
3606	rChangeCurrRing(r);
3607	if (old_ring->qideal != NULL)
3608	{
3609	r->qideal = idrCopyR_NoSort(old_ring->qideal, old_ring);
3610	assume(idRankFreeModule(r->qideal) == 0);
3611	currQuotient = r->qideal;
3612	}
3613	}
3614	return r;
3615	}
3616
3617	static ring rAssure_SyzComp(ring r, BOOLEAN complete)
3618	{
3619	if (r->order[0] == ringorder_s) return r;
3620	ring res=rCopy0(r, FALSE, FALSE);
3621	int i=rBlocks(r);
3622	int j;
3623
3624	res->order=(int )omAlloc0((i+1)sizeof(int));
3625	for(j=i;j>0;j--) res->order[j]=r->order[j-1];
3626	res->order[0]=ringorder_s;
3627
3628	res->block0=(int )omAlloc0((i+1)sizeof(int));
3629	for(j=i;j>0;j--) res->block0[j]=r->block0[j-1];
3630
3631	res->block1=(int )omAlloc0((i+1)sizeof(int));
3632	for(j=i;j>0;j--) res->block1[j]=r->block1[j-1];
3633
3634	int wvhdl =(int )omAlloc0((i+1)sizeof(int*));
3635	for(j=i;j>0;j--)
3636	{
3637	if (r->wvhdl[j-1] != NULL)
3638	{
3639	wvhdl[j] = (int*) omMemDup(r->wvhdl[j-1]);
3640	}
3641	}
3642	res->wvhdl = wvhdl;
3643
3644	if (complete) rComplete(res, 1);
3645	return res;
3646	}
3647
3648	static ring rAssure_CompLastBlock(ring r, BOOLEAN complete = TRUE)
3649	{
3650	int last_block = rBlocks(r) - 2;
3651	if (r->order[last_block] != ringorder_c &&
3652	r->order[last_block] != ringorder_C)
3653	{
3654	int c_pos = 0;
3655	int i;
3656
3657	for (i=0; i< last_block; i++)
3658	{
3659	if (r->order[i] == ringorder_c \|\| r->order[i] == ringorder_C)
3660	{
3661	c_pos = i;
3662	break;
3663	}
3664	}
3665	if (c_pos != -1)
3666	{
3667	ring new_r = rCopy0(r, FALSE, TRUE);
3668	for (i=c_pos+1; i<=last_block; i++)
3669	{
3670	new_r->order[i-1] = new_r->order[i];
3671	new_r->block0[i-1] = new_r->block0[i];
3672	new_r->block1[i-1] = new_r->block1[i];
3673	new_r->wvhdl[i-1] = new_r->wvhdl[i];
3674	}
3675	new_r->order[last_block] = r->order[c_pos];
3676	new_r->block0[last_block] = r->block0[c_pos];
3677	new_r->block1[last_block] = r->block1[c_pos];
3678	new_r->wvhdl[last_block] = r->wvhdl[c_pos];
3679	if (complete) rComplete(new_r, 1);
3680	return new_r;
3681	}
3682	}
3683	return r;
3684	}
3685
3686	ring rCurrRingAssure_CompLastBlock()
3687	{
3688	ring new_r = rAssure_CompLastBlock(currRing);
3689	if (currRing != new_r)
3690	{
3691	ring old_r = currRing;
3692	rChangeCurrRing(new_r);
3693	if (old_r->qideal != NULL)
3694	{
3695	new_r->qideal = idrCopyR(old_r->qideal, old_r);
3696	currQuotient = new_r->qideal;
3697	}
3698	}
3699	return new_r;
3700	}
3701
3702	ring rCurrRingAssure_SyzComp_CompLastBlock()
3703	{
3704	ring new_r_1 = rAssure_CompLastBlock(currRing, FALSE);
3705	ring new_r = rAssure_SyzComp(new_r_1, FALSE);
3706
3707	if (new_r != currRing)
3708	{
3709	ring old_r = currRing;
3710	if (new_r_1 != new_r && new_r_1 != old_r) rDelete(new_r_1);
3711	rComplete(new_r, 1);
3712	rChangeCurrRing(new_r);
3713	if (old_r->qideal != NULL)
3714	{
3715	new_r->qideal = idrCopyR(old_r->qideal, old_r);
3716	currQuotient = new_r->qideal;
3717	}
3718	rTest(new_r);
3719	rTest(old_r);
3720	}
3721	return new_r;
3722	}
3723
3724	// use this for global orderings consisting of two blocks
3725	static ring rCurrRingAssure_Global(rRingOrder_t b1, rRingOrder_t b2)
3726	{
3727	int r_blocks = rBlocks(currRing);
3728	int i;
3729
3730	assume(b1 == ringorder_c \|\| b1 == ringorder_C \|\|
3731	b2 == ringorder_c \|\| b2 == ringorder_C \|\|
3732	b2 == ringorder_S);
3733	if ((r_blocks == 3) &&
3734	(currRing->order[0] == b1) &&
3735	(currRing->order[1] == b2) &&
3736	(currRing->order[2] == 0))
3737	return currRing;
3738	ring res = rCopy0(currRing, TRUE, FALSE);
3739	res->order = (int)omAlloc0(3sizeof(int));
3740	res->block0 = (int)omAlloc0(3sizeof(int));
3741	res->block1 = (int)omAlloc0(3sizeof(int));
3742	res->wvhdl = (int*)omAlloc0(3sizeof(int*));
3743	res->order[0] = b1;
3744	res->order[1] = b2;
3745	if (b1 == ringorder_c \|\| b1 == ringorder_C)
3746	{
3747	res->block0[1] = 1;
3748	res->block1[1] = currRing->N;
3749	}
3750	else
3751	{
3752	res->block0[0] = 1;
3753	res->block1[0] = currRing->N;
3754	}
3755	// HANNES: This sould be set in rComplete
3756	res->OrdSgn = 1;
3757	rComplete(res, 1);
3758	rChangeCurrRing(res);
3759	return res;
3760	}
3761
3762
3763	ring rCurrRingAssure_dp_S()
3764	{
3765	return rCurrRingAssure_Global(ringorder_dp, ringorder_S);
3766	}
3767
3768	ring rCurrRingAssure_dp_C()
3769	{
3770	return rCurrRingAssure_Global(ringorder_dp, ringorder_C);
3771	}
3772
3773	ring rCurrRingAssure_C_dp()
3774	{
3775	return rCurrRingAssure_Global(ringorder_C, ringorder_dp);
3776	}
3777
3778
3779	void rSetSyzComp(int k)
3780	{
3781	if (TEST_OPT_PROT) Print("{%d}", k);
3782	if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz))
3783	{
3784	assume(k > currRing->typ[0].data.syz.limit);
3785	int i;
3786	if (currRing->typ[0].data.syz.limit == 0)
3787	{
3788	currRing->typ[0].data.syz.syz_index = (int) omAlloc0((k+1)sizeof(int));
3789	currRing->typ[0].data.syz.syz_index[0] = 0;
3790	currRing->typ[0].data.syz.curr_index = 1;
3791	}
3792	else
3793	{
3794	currRing->typ[0].data.syz.syz_index = (int*)
3795	omReallocSize(currRing->typ[0].data.syz.syz_index,
3796	(currRing->typ[0].data.syz.limit+1)*sizeof(int),
3797	(k+1)*sizeof(int));
3798	}
3799	for (i=currRing->typ[0].data.syz.limit + 1; i<= k; i++)
3800	{
3801	currRing->typ[0].data.syz.syz_index[i] =
3802	currRing->typ[0].data.syz.curr_index;
3803	}
3804	currRing->typ[0].data.syz.limit = k;
3805	currRing->typ[0].data.syz.curr_index++;
3806	}
3807	else if ((currRing->order[0]!=ringorder_c) && (k!=0))
3808	{
3809	dReportError("syzcomp in incompatible ring");
3810	}
3811	#ifdef PDEBUG
3812	extern int pDBsyzComp;
3813	pDBsyzComp=k;
3814	#endif
3815	}
3816
3817	// return the max-comonent wchich has syzIndex i
3818	int rGetMaxSyzComp(int i)
3819	{
3820	if ((currRing->typ!=NULL) && (currRing->typ[0].ord_typ==ro_syz) &&
3821	currRing->typ[0].data.syz.limit > 0 && i > 0)
3822	{
3823	assume(i <= currRing->typ[0].data.syz.limit);
3824	int j;
3825	for (j=0; j<currRing->typ[0].data.syz.limit; j++)
3826	{
3827	if (currRing->typ[0].data.syz.syz_index[j] == i &&
3828	currRing->typ[0].data.syz.syz_index[j+1] != i)
3829	{
3830	assume(currRing->typ[0].data.syz.syz_index[j+1] == i+1);
3831	return j;
3832	}
3833	}
3834	return currRing->typ[0].data.syz.limit;
3835	}
3836	else
3837	{
3838	return 0;
3839	}
3840	}
3841
3842	BOOLEAN rRing_is_Homog(ring r)
3843	{
3844	if (r == NULL) return FALSE;
3845	int i, j, nb = rBlocks(r);
3846	for (i=0; i<nb; i++)
3847	{
3848	if (r->wvhdl[i] != NULL)
3849	{
3850	int length = r->block1[i] - r->block0[i];
3851	int* wvhdl = r->wvhdl[i];
3852	if (r->order[i] == ringorder_M) length *= length;
3853	assume(omSizeOfAddr(wvhdl) >= length*sizeof(int));
3854
3855	for (j=0; j< length; j++)
3856	{
3857	if (wvhdl[j] != 0 && wvhdl[j] != 1) return FALSE;
3858	}
3859	}
3860	}
3861	return TRUE;
3862	}
3863
3864	BOOLEAN rRing_has_CompLastBlock(ring r)
3865	{
3866	assume(r != NULL);
3867	int lb = rBlocks(r) - 2;
3868	return (r->order[lb] == ringorder_c \|\| r->order[lb] == ringorder_C);
3869	}
3870
3871	n_coeffType rFieldType(ring r)
3872	{
3873	if (rField_is_Zp(r)) return n_Zp;
3874	if (rField_is_Q(r)) return n_Q;
3875	if (rField_is_R(r)) return n_R;
3876	if (rField_is_GF(r)) return n_GF;
3877	if (rField_is_long_R(r)) return n_long_R;
3878	if (rField_is_Zp_a(r)) return n_Zp_a;
3879	if (rField_is_Q_a(r)) return n_Q_a;
3880	if (rField_is_long_C(r)) return n_long_C;
3881	return n_unknown;
3882	}
3883
3884	int * rGetWeightVec(ring r)
3885	{
3886	assume(r!=NULL);
3887	assume(r->OrdSize>0);
3888	assume(r->typ[0].ord_typ==ro_wp);
3889	return (r->typ[0].data.wp.weights);
3890	}
3891
3892	void rSetWeightVec(ring r, int *wv)
3893	{
3894	assume(r!=NULL);
3895	assume(r->OrdSize>0);
3896	assume(r->typ[0].ord_typ==ro_wp);
3897	memcpy(r->typ[0].data.wp.weights,wv,r->N*sizeof(int));
3898	}
3899
3900	lists rDecompose(ring r)
3901	{
3902	// 0: char/ cf - ring
3903	// 1: list (var)
3904	// 3: list (ord)
3905	// 4: qideal
3906	lists L=(lists)omAlloc0Bin(slists_bin);
3907	L->Init(4);
3908	// ----------------------------------------
3909	#if 0 /* TODO */
3910	if (rIsExtension(r))
3911	rDecomposeCF(&(L->m[0]),r);
3912	else
3913	#endif
3914	{
3915	L->m[0].rtyp=INT_CMD;
3916	L->m[0].data=(void *)r->ch;
3917	}
3918	// ----------------------------------------
3919	lists LL=(lists)omAlloc0Bin(slists_bin);
3920	L->m[1].rtyp=LIST_CMD;
3921	L->m[1].data=(void *)LL;
3922	LL->Init(r->N);
3923	int i;
3924	for(i=0; i<r->N; i++)
3925	{
3926	LL->m[i].rtyp=STRING_CMD;
3927	LL->m[i].data=(void *)omStrDup(r->names[i]);
3928	}
3929	// ----------------------------------------
3930	LL=(lists)omAlloc0Bin(slists_bin);
3931	L->m[2].rtyp=LIST_CMD;
3932	L->m[2].data=(void *)LL;
3933	LL->Init((i=rBlocks(r)-1));
3934	lists LLL;
3935	for(; i>=0; i--)
3936	{
3937	intvec *iv;
3938	int j;
3939	LL->m[i].rtyp=LIST_CMD;
3940	LLL=(lists)omAlloc0Bin(slists_bin);
3941	LLL->Init(2);
3942	LLL->m[0].rtyp=STRING_CMD;
3943	LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
3944	LLL->m[1].rtyp=INTVEC_CMD;
3945	j=r->block1[i]-r->block0[i];
3946	iv=new intvec(j+1);
3947	LLL->m[1].data=(void *)iv;
3948	if (r->block1[i]-r->block0[i] >=0 )
3949	{
3950	if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
3951	{
3952	for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
3953	}
3954	else switch (r->order[i])
3955	{
3956	case ringorder_dp:
3957	case ringorder_Dp:
3958	case ringorder_ds:
3959	case ringorder_Ds:
3960	case ringorder_lp:
3961	for(;j>=0; j--) (*iv)[j]=1;
3962	break;
3963	default: /* do nothing */;
3964	}
3965	}
3966	LL->m[i].data=(void *)LLL;
3967	}
3968	// ----------------------------------------
3969	L->m[3].rtyp=IDEAL_CMD;
3970	if (r->qideal==NULL)
3971	L->m[3].data=(void *)idInit(1,1);
3972	else
3973	L->m[3].data=(void *)idCopy(r->qideal);
3974	return L;
3975	}

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

Download in other formats: