Context Navigation

source: git/Singular/ring.cc @ 0b5f43

spielwiese

Last change on this file since 0b5f43 was 0b5f43, checked in by Mathias Schulze <mschulze@…>, 23 years ago
*hannes: rAssureSyzComp +rHighSet git-svn-id: file:///usr/local/Singular/svn/trunk@5550 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 95.7 KB

Line
1	/****************************************
2	* Computer Algebra System SINGULAR *
3	****************************************/
4	/* $Id: ring.cc,v 1.167 2001-07-30 08:02:39 mschulze 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	}
131
132	/------------ change the global ring -----------------------/
133	rChangeCurrRing(rg);
134	currRingHdl = h;
135	}
136
137	idhdl rDefault(char *s)
138	{
139	idhdl tmp=NULL;
140
141	if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
142	if (tmp==NULL) return NULL;
143
144	if (ppNoether!=NULL) pDelete(&ppNoether);
145	if (sLastPrinted.RingDependend())
146	{
147	sLastPrinted.CleanUp();
148	}
149
150	ring r = IDRING(tmp);
151
152	r->ch = 32003;
153	r->N = 3;
154	/r->P = 0; Alloc0 in idhdl::set, ipid.cc/
155	/names/
156	r->names = (char *) omAlloc0(3 sizeof(char_ptr));
157	r->names[0] = omStrDup("x");
158	r->names[1] = omStrDup("y");
159	r->names[2] = omStrDup("z");
160	/weights: entries for 3 blocks: NULL/
161	r->wvhdl = (int *)omAlloc0(3 sizeof(int_ptr));
162	/order: dp,C,0/
163	r->order = (int ) omAlloc(3 sizeof(int *));
164	r->block0 = (int )omAlloc0(3 sizeof(int *));
165	r->block1 = (int )omAlloc0(3 sizeof(int *));
166	/* ringorder dp for the first block: var 1..3 */
167	r->order[0] = ringorder_dp;
168	r->block0[0] = 1;
169	r->block1[0] = 3;
170	/* ringorder C for the second block: no vars */
171	r->order[1] = ringorder_C;
172	/* the last block: everything is 0 */
173	r->order[2] = 0;
174	/polynomial ring/
175	r->OrdSgn = 1;
176
177	/* complete ring intializations */
178	rComplete(r);
179	rSetHdl(tmp);
180	return currRingHdl;
181	}
182
183	ring rDefault(int ch, int N, char **n)
184	{
185	ring r=(ring) omAlloc0Bin(sip_sring_bin);
186	r->ch = ch;
187	r->N = N;
188	/r->P = 0; Alloc0 /
189	/names/
190	r->names = (char *) omAlloc0(N sizeof(char_ptr));
191	int i;
192	for(i=0;i<N;i++)
193	{
194	r->names[i] = omStrDup(n[i]);
195	}
196	/weights: entries for 2 blocks: NULL/
197	r->wvhdl = (int *)omAlloc0(2 sizeof(int_ptr));
198	/order: lp,0/
199	r->order = (int ) omAlloc(2 sizeof(int *));
200	r->block0 = (int )omAlloc0(2 sizeof(int *));
201	r->block1 = (int )omAlloc0(2 sizeof(int *));
202	/* ringorder dp for the first block: var 1..N */
203	r->order[0] = ringorder_lp;
204	r->block0[0] = 1;
205	r->block1[0] = N;
206	/* the last block: everything is 0 */
207	r->order[1] = 0;
208	/polynomial ring/
209	r->OrdSgn = 1;
210
211	/* complete ring intializations */
212	rComplete(r);
213	return r;
214	}
215
216	///////////////////////////////////////////////////////////////////////////
217	//
218	// rInit: define a new ring from sleftv's
219	//
220
221	/////////////////////////////
222	// Auxillary functions
223	//
224
225	// check intvec, describing the ordering
226	static BOOLEAN rCheckIV(intvec *iv)
227	{
228	if ((iv->length()!=2)&&(iv->length()!=3))
229	{
230	WerrorS("weights only for orderings wp,ws,Wp,Ws,a,M");
231	return TRUE;
232	}
233	return FALSE;
234	}
235
236	static int rTypeOfMatrixOrder(intvec * order)
237	{
238	int i=0,j,typ=1;
239	int sz = (int)sqrt((double)(order->length()-2));
240
241	while ((i<sz) && (typ==1))
242	{
243	j=0;
244	while ((j<sz) && ((order)[jsz+i+2]==0)) j++;
245	if (j>=sz)
246	{
247	typ = 0;
248	WerrorS("Matrix order not complete");
249	}
250	else if ((order)[jsz+i+2]<0)
251	typ = -1;
252	else
253	i++;
254	}
255	return typ;
256	}
257
258	// set R->order, R->block, R->wvhdl, r->OrdSgn from sleftv
259	static BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
260	{
261	int last = 0, o=0, n = 1, i=0, typ = 1, j;
262	sleftv *sl = ord;
263
264	// determine nBlocks
265	while (sl!=NULL)
266	{
267	intvec iv = (intvec )(sl->data);
268	if (((iv)[1]==ringorder_c)\|\|((iv)[1]==ringorder_C)) i++;
269	else if ((*iv)[1]==ringorder_L)
270	{
271	R->bitmask=(*iv)[2];
272	n--;
273	}
274	else if ((*iv)[1]!=ringorder_a) o++;
275	n++;
276	sl=sl->next;
277	}
278	// check whether at least one real ordering
279	if (o==0)
280	{
281	WerrorS("invalid combination of orderings");
282	return TRUE;
283	}
284	// if no c/C ordering is given, increment n
285	if (i==0) n++;
286	else if (i != 1)
287	{
288	// throw error if more than one is given
289	WerrorS("more than one ordering c/C specified");
290	return TRUE;
291	}
292
293	// initialize fields of R
294	R->order=(int )omAlloc0(nsizeof(int));
295	R->block0=(int )omAlloc0(nsizeof(int));
296	R->block1=(int )omAlloc0(nsizeof(int));
297	R->wvhdl=(int*)omAlloc0(nsizeof(int_ptr));
298
299	// init order, so that rBlocks works correctly
300	for (j=0; j < n-1; j++)
301	R->order[j] = (int) ringorder_unspec;
302	// set last _C order, if no c/C order was given
303	if (i == 0) R->order[n-2] = ringorder_C;
304
305	/* init orders */
306	sl=ord;
307	n=-1;
308	while (sl!=NULL)
309	{
310	intvec *iv;
311	iv = (intvec *)(sl->data);
312	if ((*iv)[1]!=ringorder_L)
313	{
314	n++;
315
316	/* the format of an ordering:
317	* iv[0]: factor
318	* iv[1]: ordering
319	* iv[2..end]: weights
320	*/
321	R->order[n] = (*iv)[1];
322	switch ((*iv)[1])
323	{
324	case ringorder_ws:
325	case ringorder_Ws:
326	typ=-1;
327	case ringorder_wp:
328	case ringorder_Wp:
329	R->wvhdl[n]=(int)omAlloc((iv->length()-1)sizeof(int));
330	for (i=2; i<iv->length(); i++)
331	R->wvhdl[n][i-2] = (*iv)[i];
332	R->block0[n] = last+1;
333	last += iv->length()-2;
334	R->block1[n] = last;
335	break;
336	case ringorder_ls:
337	case ringorder_ds:
338	case ringorder_Ds:
339	typ=-1;
340	case ringorder_lp:
341	case ringorder_dp:
342	case ringorder_Dp:
343	case ringorder_rp:
344	R->block0[n] = last+1;
345	if (iv->length() == 3) last+=(*iv)[2];
346	else last += (*iv)[0];
347	R->block1[n] = last;
348	if (rCheckIV(iv)) return TRUE;
349	break;
350	case ringorder_S:
351	case ringorder_c:
352	case ringorder_C:
353	if (rCheckIV(iv)) return TRUE;
354	break;
355	case ringorder_aa:
356	case ringorder_a:
357	R->block0[n] = last+1;
358	R->block1[n] = min(last+iv->length()-2 , R->N);
359	R->wvhdl[n] = (int)omAlloc((iv->length()-1)sizeof(int));
360	for (i=2; i<iv->length(); i++)
361	{
362	R->wvhdl[n][i-2]=(*iv)[i];
363	if ((*iv)[i]<0) typ=-1;
364	}
365	break;
366	case ringorder_M:
367	{
368	int Mtyp=rTypeOfMatrixOrder(iv);
369	if (Mtyp==0) return TRUE;
370	if (Mtyp==-1) typ = -1;
371
372	R->wvhdl[n] =( int )omAlloc((iv->length()-1)sizeof(int));
373	for (i=2; i<iv->length();i++)
374	R->wvhdl[n][i-2]=(*iv)[i];
375
376	R->block0[n] = last+1;
377	last += (int)sqrt((double)(iv->length()-2));
378	R->block1[n] = last;
379	break;
380	}
381
382	case ringorder_no:
383	R->order[n] = ringorder_unspec;
384	return TRUE;
385
386	default:
387	Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
388	R->order[n] = ringorder_unspec;
389	return TRUE;
390	}
391	}
392	sl=sl->next;
393	}
394
395	// check for complete coverage
396	if ((R->order[n]==ringorder_c) \|\| (R->order[n]==ringorder_C)) n--;
397	if (R->block1[n] != R->N)
398	{
399	if (((R->order[n]==ringorder_dp) \|\|
400	(R->order[n]==ringorder_ds) \|\|
401	(R->order[n]==ringorder_Dp) \|\|
402	(R->order[n]==ringorder_Ds) \|\|
403	(R->order[n]==ringorder_rp) \|\|
404	(R->order[n]==ringorder_lp) \|\|
405	(R->order[n]==ringorder_ls))
406	&&
407	R->block0[n] <= R->N)
408	{
409	R->block1[n] = R->N;
410	}
411	else
412	{
413	Werror("mismatch of number of vars (%d) and ordering (%d vars)",
414	R->N,R->block1[n]);
415	return TRUE;
416	}
417	}
418	R->OrdSgn = typ;
419	return FALSE;
420	}
421
422	// get array of strings from list of sleftv's
423	static BOOLEAN rSleftvList2StringArray(sleftv* sl, char** p)
424	{
425
426	while(sl!=NULL)
427	{
428	if (sl->Name() == sNoName)
429	{
430	if (sl->Typ()==POLY_CMD)
431	{
432	sleftv s_sl;
433	iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
434	if (s_sl.Name() != sNoName)
435	*p = omStrDup(s_sl.Name());
436	else
437	*p = NULL;
438	sl->next = s_sl.next;
439	s_sl.next = NULL;
440	s_sl.CleanUp();
441	if (*p == NULL) return TRUE;
442	}
443	else
444	return TRUE;
445	}
446	else
447	*p = omStrDup(sl->Name());
448	p++;
449	sl=sl->next;
450	}
451	return FALSE;
452	}
453
454
455	////////////////////
456	//
457	// rInit itself:
458	//
459	// INPUT: s: name, pn: ch & parameter (names), rv: variable (names)
460	// ord: ordering
461	// RETURN: currRingHdl on success
462	// NULL on error
463	// NOTE: * makes new ring to current ring, on success
464	// * considers input sleftv's as read-only
465	//idhdl rInit(char s, sleftv pn, sleftv* rv, sleftv* ord)
466	ring rInit(sleftv* pn, sleftv* rv, sleftv* ord)
467	{
468	int ch;
469	int float_len=0;
470	int float_len2=0;
471	ring R = NULL;
472	idhdl tmp = NULL;
473	BOOLEAN ffChar=FALSE;
474	int typ = 1;
475
476	/* ch -------------------------------------------------------*/
477	// get ch of ground field
478	int numberOfAllocatedBlocks;
479
480	if (pn->Typ()==INT_CMD)
481	{
482	ch=(int)pn->Data();
483	}
484	else if ((pn->name != NULL)
485	&& ((strcmp(pn->name,"real")==0) \|\| (strcmp(pn->name,"complex")==0)))
486	{
487	BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
488	ch=-1;
489	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
490	{
491	float_len=(int)pn->next->Data();
492	float_len2=float_len;
493	pn=pn->next;
494	if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
495	{
496	float_len2=(int)pn->next->Data();
497	pn=pn->next;
498	}
499	}
500	if ((pn->next==NULL) && complex_flag)
501	{
502	pn->next=(leftv)omAlloc0Bin(sleftv_bin);
503	pn->next->name=omStrDup("i");
504	}
505	}
506	else
507	{
508	Werror("Wrong ground field specification");
509	goto rInitError;
510	}
511	pn=pn->next;
512
513	int l, last;
514	sleftv * sl;
515	/every entry in the new ring is initialized to 0/
516
517	/* characteristic -----------------------------------------------*/
518	/* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
519	* 0 1 : Q(a,...) *names FALSE
520	* 0 -1 : R NULL FALSE 0
521	* 0 -1 : R NULL FALSE prec. >6
522	* 0 -1 : C *names FALSE prec. 0..?
523	* p p : Fp NULL FALSE
524	* p -p : Fp(a) *names FALSE
525	* q q : GF(q=p^n) *names TRUE
526	*/
527	if (ch!=-1)
528	{
529	int l = 0;
530
531	if (ch!=0 && (ch<2) \|\| (ch > 32003))
532	{
533	Warn("%d is invalid characteristic of ground field. 32003 is used.", ch);
534	ch=32003;
535	}
536	// load fftable, if necessary
537	if (pn!=NULL)
538	{
539	while ((ch!=fftable[l]) && (fftable[l])) l++;
540	if (fftable[l]==0) ch = IsPrime(ch);
541	else
542	{
543	char m[1]={(char )sNoName};
544	nfSetChar(ch,m);
545	if (errorreported) goto rInitError;
546	else ffChar=TRUE;
547	}
548	}
549	else
550	ch = IsPrime(ch);
551	}
552	// allocated ring and set ch
553	R = (ring) omAlloc0Bin(sip_sring_bin);
554	R->ch = ch;
555	if (ch == -1)
556	{
557	R->float_len= min(float_len,32767);
558	R->float_len2= min(float_len2,32767);
559	}
560
561	/* parameter -------------------------------------------------------*/
562	if (pn!=NULL)
563	{
564	R->P=pn->listLength();
565	//if ((ffChar\|\| (ch == 1)) && (R->P > 1))
566	if ((R->P > 1) && (ffChar \|\| (ch == -1)))
567	{
568	WerrorS("too many parameters");
569	goto rInitError;
570	}
571	R->parameter=(char*)omAlloc0(R->Psizeof(char_ptr));
572	if (rSleftvList2StringArray(pn, R->parameter))
573	{
574	WerrorS("parameter expected");
575	goto rInitError;
576	}
577	if (ch>1 && !ffChar) R->ch=-ch;
578	else if (ch==0) R->ch=1;
579	}
580	else if (ffChar)
581	{
582	WerrorS("need one parameter");
583	goto rInitError;
584	}
585	/* post-processing of field description */
586	// we have short reals, but no short complex
587	if ((R->ch == - 1)
588	&& (R->parameter !=NULL)
589	&& (R->float_len < SHORT_REAL_LENGTH))
590	{
591	R->float_len = SHORT_REAL_LENGTH;
592	R->float_len2 = SHORT_REAL_LENGTH;
593	}
594
595	/* names and number of variables-------------------------------------*/
596	R->N = rv->listLength();
597	R->names = (char *)omAlloc0(R->N sizeof(char_ptr));
598	if (rSleftvList2StringArray(rv, R->names))
599	{
600	WerrorS("name of ring variable expected");
601	goto rInitError;
602	}
603
604	/* check names and parameters for conflicts ------------------------- */
605	{
606	int i,j;
607	for(i=0;i<R->P; i++)
608	{
609	for(j=0;j<R->N;j++)
610	{
611	if (strcmp(R->parameter[i],R->names[j])==0)
612	{
613	Werror("parameter %d conflicts with variable %d",i+1,j+1);
614	goto rInitError;
615	}
616	}
617	}
618	}
619	/* ordering -------------------------------------------------------------*/
620	if (rSleftvOrdering2Ordering(ord, R))
621	goto rInitError;
622
623	// Complete the initialization
624	if (rComplete(R,1))
625	goto rInitError;
626
627	rTest(R);
628
629	// try to enter the ring into the name list
630	// need to clean up sleftv here, before this ring can be set to
631	// new currRing or currRing can be killed beacuse new ring has
632	// same name
633	if (pn != NULL) pn->CleanUp();
634	if (rv != NULL) rv->CleanUp();
635	if (ord != NULL) ord->CleanUp();
636	//if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
637	// goto rInitError;
638
639	//memcpy(IDRING(tmp),R,sizeof(*R));
640	// set current ring
641	//omFreeBin(R, ip_sring_bin);
642	//return tmp;
643	return R;
644
645	// error case:
646	rInitError:
647	if (R != NULL) rDelete(R);
648	if (pn != NULL) pn->CleanUp();
649	if (rv != NULL) rv->CleanUp();
650	if (ord != NULL) ord->CleanUp();
651	return NULL;
652	}
653
654	/*2
655	* set a new ring from the data:
656	s: name, chr: ch, varnames: rv, ordering: ord, typ: typ
657	*/
658
659	int r_IsRingVar(char *n, ring r)
660	{
661	if ((r!=NULL) && (r->names!=NULL))
662	{
663	for (int i=0; i<r->N; i++)
664	{
665	if (r->names[i]==NULL) return -1;
666	if (strcmp(n,r->names[i]) == 0) return (int)i;
667	}
668	}
669	return -1;
670	}
671
672
673	void rWrite(ring r)
674	{
675	if ((r==NULL)\|\|(r->order==NULL))
676	return; /to avoid printing after errors..../
677
678	int nblocks=rBlocks(r);
679
680	// omCheckAddrSize(r,sizeof(ip_sring));
681	omCheckAddrSize(r->order,nblocks*sizeof(int));
682	omCheckAddrSize(r->block0,nblocks*sizeof(int));
683	omCheckAddrSize(r->block1,nblocks*sizeof(int));
684	omCheckAddrSize(r->wvhdl,nblocks*sizeof(int_ptr));
685	omCheckAddrSize(r->names,r->N*sizeof(char_ptr));
686
687
688	nblocks--;
689
690
691	if (rField_is_GF(r))
692	{
693	Print("// # ground field : %d\n",rInternalChar(r));
694	Print("// primitive element : %s\n", r->parameter[0]);
695	if (r==currRing)
696	{
697	StringSetS("// minpoly : ");
698	nfShowMipo();PrintS(StringAppendS("\n"));
699	}
700	}
701	else
702	{
703	PrintS("// characteristic : ");
704	if ( rField_is_R(r) ) PrintS("0 (real)\n"); /* R */
705	else if ( rField_is_long_R(r) )
706	Print("0 (real:%d digits, additional %d digits)\n",
707	r->float_len,r->float_len2); /* long R */
708	else if ( rField_is_long_C(r) )
709	Print("0 (complex:%d digits, additional %d digits)\n",
710	r->float_len, r->float_len2); /* long C */
711	else
712	Print ("%d\n",rChar(r)); /* Fp(a) */
713	if (r->parameter!=NULL)
714	{
715	Print ("// %d parameter : ",rPar(r));
716	char **sp=r->parameter;
717	int nop=0;
718	while (nop<rPar(r))
719	{
720	PrintS(*sp);
721	PrintS(" ");
722	sp++; nop++;
723	}
724	PrintS("\n// minpoly : ");
725	if ( rField_is_long_C(r) )
726	{
727	// i^2+1:
728	Print("(%s^2+1)\n",r->parameter[0]);
729	}
730	else if (r->minpoly==NULL)
731	{
732	PrintS("0\n");
733	}
734	else if (r==currRing)
735	{
736	StringSetS(""); nWrite(r->minpoly); PrintS(StringAppendS("\n"));
737	}
738	else
739	{
740	PrintS("...\n");
741	}
742	}
743	}
744	Print("// number of vars : %d",r->N);
745
746	//for (nblocks=0; r->order[nblocks]; nblocks++);
747	nblocks=rBlocks(r)-1;
748
749	for (int l=0, nlen=0 ; l<nblocks; l++)
750	{
751	int i;
752	Print("\n// block %3d : ",l+1);
753
754	Print("ordering %s", rSimpleOrdStr(r->order[l]));
755
756	if ((r->order[l] >= ringorder_lp)
757	\|\|(r->order[l] == ringorder_M)
758	\|\|(r->order[l] == ringorder_a)
759	\|\|(r->order[l] == ringorder_aa))
760	{
761	PrintS("\n// : names ");
762	for (i = r->block0[l]-1; i<r->block1[l]; i++)
763	{
764	nlen = strlen(r->names[i]);
765	Print("%s ",r->names[i]);
766	}
767	}
768	#ifndef NDEBUG
769	else if (r->order[l] == ringorder_s)
770	{
771	Print(" syzcomp at %d",r->typ[l].data.syz.limit);
772	}
773	#endif
774
775	if (r->wvhdl[l]!=NULL)
776	{
777	for (int j= 0;
778	j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
779	j+=i)
780	{
781	PrintS("\n// : weights ");
782	for (i = 0; i<=r->block1[l]-r->block0[l]; i++)
783	{
784	Print("%*d " ,nlen,r->wvhdl[l][i+j],i+j);
785	}
786	if (r->order[l]!=ringorder_M) break;
787	}
788	}
789	}
790	if (r->qideal!=NULL)
791	{
792	PrintS("\n// quotient ring from ideal");
793	if (r==currRing)
794	{
795	PrintLn();
796	iiWriteMatrix((matrix)r->qideal,"_",1);
797	}
798	else PrintS(" ...");
799	}
800	}
801
802	static void rDelete(ring r)
803	{
804	int i, j;
805
806	if (r == NULL) return;
807
808	rUnComplete(r);
809	// delete order stuff
810	if (r->order != NULL)
811	{
812	i=rBlocks(r);
813	assume(r->block0 != NULL && r->block1 != NULL && r->wvhdl != NULL);
814	// delete order
815	omFreeSize((ADDRESS)r->order,i*sizeof(int));
816	omFreeSize((ADDRESS)r->block0,i*sizeof(int));
817	omFreeSize((ADDRESS)r->block1,i*sizeof(int));
818	// delete weights
819	for (j=0; j<i; j++)
820	{
821	if (r->wvhdl[j]!=NULL)
822	omFree(r->wvhdl[j]);
823	}
824	omFreeSize((ADDRESS)r->wvhdl,isizeof(short ));
825	}
826	else
827	{
828	assume(r->block0 == NULL && r->block1 == NULL && r->wvhdl == NULL);
829	}
830
831	// delete varnames
832	if(r->names!=NULL)
833	{
834	for (i=0; i<r->N; i++)
835	{
836	if (r->names[i] != NULL) omFree((ADDRESS)r->names[i]);
837	}
838	omFreeSize((ADDRESS)r->names,r->N*sizeof(char_ptr));
839	}
840
841	// delete parameter
842	if (r->parameter!=NULL)
843	{
844	char **s=r->parameter;
845	j = 0;
846	while (j < rPar(r))
847	{
848	if (s != NULL) omFree((ADDRESS)s);
849	s++;
850	j++;
851	}
852	omFreeSize((ADDRESS)r->parameter,rPar(r)*sizeof(char_ptr));
853	}
854	omFreeBin(r, ip_sring_bin);
855	}
856
857	void rKill(ring r)
858	{
859	if ((r->ref<=0)&&(r->order!=NULL))
860	{
861	#ifdef RDEBUG
862	if (traceit &TRACE_SHOW_RINGS) Print("kill ring %x\n",r);
863	#endif
864	if (r==currRing)
865	{
866	if (r->qideal!=NULL)
867	{
868	idDelete(&r->qideal);
869	r->qideal=NULL;
870	currQuotient=NULL;
871	}
872	if (ppNoether!=NULL) pDelete(&ppNoether);
873	if (sLastPrinted.RingDependend())
874	{
875	sLastPrinted.CleanUp();
876	}
877	if ((myynest>0) && (iiRETURNEXPR[myynest].RingDependend()))
878	{
879	WerrorS("return value depends on local ring variable (export missing ?)");
880	iiRETURNEXPR[myynest].CleanUp();
881	}
882	currRing=NULL;
883	currRingHdl=NULL;
884	}
885	else if (r->qideal!=NULL)
886	{
887	id_Delete(&r->qideal, r);
888	r->qideal = NULL;
889	}
890	nKillChar(r);
891	int i=1;
892	int j;
893	int *pi=r->order;
894	#ifdef USE_IILOCALRING
895	for (j=0;j<iiRETURNEXPR_len;j++)
896	{
897	if (iiLocalRing[j]==r)
898	{
899	if (j<myynest) Warn("killing the basering for level %d",j);
900	iiLocalRing[j]=NULL;
901	}
902	}
903	#else /* USE_IILOCALRING */
904	{
905	namehdl nshdl = namespaceroot;
906
907	for(nshdl=namespaceroot; nshdl->isroot != TRUE; nshdl = nshdl->next) {
908	//Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
909	if (nshdl->currRing==r)
910	{
911	if (nshdl->myynest<myynest)
912	// Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
913	Warn("killing the basering for level %d",nshdl->myynest);
914	nshdl->currRing=NULL;
915	}
916	}
917	if (nshdl->currRing==r)
918	{
919	//Print("NSstack: %s:%d, nesting=%d\n", nshdl->name, nshdl->lev, nshdl->myynest);
920	if (nshdl->myynest<myynest)
921	// Warn("killing the basering for level %d/%d",nshdl->lev,nshdl->myynest);
922	Warn("killing the basering for level %d",nshdl->myynest);
923	nshdl->currRing=NULL;
924	}
925	}
926	#endif /* USE_IILOCALRING */
927
928	rDelete(r);
929	return;
930	}
931	r->ref--;
932	}
933
934	void rKill(idhdl h)
935	{
936	#ifndef HAVE_NAMESPACES1
937	ring r = IDRING(h);
938	if (r!=NULL) rKill(r);
939	if (h==currRingHdl)
940	{
941	#ifdef HAVE_NAMESPACES
942	namehdl nsHdl = namespaceroot;
943	while(nsHdl!=NULL) {
944	currRingHdl=NSROOT(nsHdl);
945	#else /* HAVE_NAMESPACES */
946	currRingHdl=IDROOT;
947	#endif /* HAVE_NAMESPACES */
948	while (currRingHdl!=NULL)
949	{
950	if ((currRingHdl!=h)
951	&& (IDTYP(currRingHdl)==IDTYP(h))
952	&& (h->data.uring==currRingHdl->data.uring))
953	break;
954	currRingHdl=IDNEXT(currRingHdl);
955	}
956	#ifdef HAVE_NAMESPACES
957	if ((currRingHdl != NULL) && (currRingHdl!=h)
958	&& (IDTYP(currRingHdl)==IDTYP(h))
959	&& (h->data.uring==currRingHdl->data.uring))
960	break;
961	nsHdl = nsHdl->next;
962	}
963	#endif /* HAVE_NAMESPACES */
964	}
965	#else
966	if(currRingHdl==NULL)
967	{
968	namehdl ns = namespaceroot;
969	BOOLEAN found=FALSE;
970
971	while(!ns->isroot)
972	{
973	currRingHdl=NSROOT(namespaceroot->next);
974	while (currRingHdl!=NULL)
975	{
976	if ((currRingHdl!=h)
977	&& (IDTYP(currRingHdl)==IDTYP(h))
978	&& (h->data.uring==currRingHdl->data.uring))
979	{ found=TRUE; break; }
980
981	currRingHdl=IDNEXT(currRingHdl);
982	}
983	if(found) break;
984	ns=IDNEXT(ns);
985	}
986	}
987	if(currRingHdl == NULL \|\| IDRING(h) != IDRING(currRingHdl))
988	{
989	currRingHdl = namespaceroot->currRingHdl;
990
991	/* PrintS("Running rFind()\n");
992	currRingHdl = rFindHdl(IDRING(h), NULL, NULL);
993	if(currRingHdl == NULL)
994	{
995	PrintS("rFind()return 0\n");
996	}
997	else
998	{
999	PrintS("Huppi rfind return an currRingHDL\n");
1000	Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1001	}
1002	*/
1003	}
1004	else
1005	{
1006	//PrintS("Huppi found an currRingHDL\n");
1007	//Print("%x, %x\n", IDRING(h),IDRING(currRingHdl) );
1008
1009	}
1010	#endif /* HAVE_NAMESPACES */
1011	}
1012
1013	idhdl rFindHdl(ring r, idhdl n, idhdl w)
1014	{
1015	#ifdef HAVE_NAMESPACES
1016	idhdl h;
1017	namehdl ns = namespaceroot;
1018
1019	while(!ns->isroot) {
1020	h = NSROOT(ns);
1021	if(w != NULL) h = w;
1022	while (h!=NULL)
1023	{
1024	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1025	&& (h->data.uring==r)
1026	&& (h!=n))
1027	return h;
1028	h=IDNEXT(h);
1029	}
1030	ns = ns->next;
1031	}
1032	h = NSROOT(ns);
1033	if(w != NULL) h = w;
1034	while (h!=NULL)
1035	{
1036	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1037	&& (h->data.uring==r)
1038	&& (h!=n))
1039	return h;
1040	h=IDNEXT(h);
1041	}
1042	#if 0
1043	if(namespaceroot->isroot) h = IDROOT;
1044	else h = NSROOT(namespaceroot->next);
1045	if(w != NULL) h = w;
1046	while (h!=NULL)
1047	{
1048	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1049	&& (h->data.uring==r)
1050	&& (h!=n))
1051	return h;
1052	h=IDNEXT(h);
1053	}
1054	#endif
1055	#else
1056	idhdl h=IDROOT;
1057	if(w != NULL) h = w;
1058	while (h!=NULL)
1059	{
1060	if (((IDTYP(h)==RING_CMD)\|\|(IDTYP(h)==QRING_CMD))
1061	&& (h->data.uring==r)
1062	&& (h!=n))
1063	return h;
1064	h=IDNEXT(h);
1065	}
1066	#endif
1067	return NULL;
1068	}
1069
1070	int rOrderName(char * ordername)
1071	{
1072	int order=ringorder_unspec;
1073	while (order!= 0)
1074	{
1075	if (strcmp(ordername,rSimpleOrdStr(order))==0)
1076	break;
1077	order--;
1078	}
1079	if (order==0) Werror("wrong ring order `%s`",ordername);
1080	omFree((ADDRESS)ordername);
1081	return order;
1082	}
1083
1084	char * rOrdStr(ring r)
1085	{
1086	int nblocks,l,i;
1087
1088	for (nblocks=0; r->order[nblocks]; nblocks++);
1089	nblocks--;
1090
1091	StringSetS("");
1092	for (l=0; ; l++)
1093	{
1094	StringAppend((char *)rSimpleOrdStr(r->order[l]));
1095	if ((r->order[l] != ringorder_c) && (r->order[l] != ringorder_C))
1096	{
1097	if (r->wvhdl[l]!=NULL)
1098	{
1099	StringAppendS("(");
1100	for (int j= 0;
1101	j<(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1);
1102	j+=i+1)
1103	{
1104	char c=',';
1105	for (i = 0; i<r->block1[l]-r->block0[l]; i++)
1106	{
1107	StringAppend("%d," ,r->wvhdl[l][i+j]);
1108	}
1109	if (r->order[l]!=ringorder_M)
1110	{
1111	StringAppend("%d)" ,r->wvhdl[l][i+j]);
1112	break;
1113	}
1114	if (j+i+1==(r->block1[l]-r->block0[l]+1)*(r->block1[l]-r->block0[l]+1))
1115	c=')';
1116	StringAppend("%d%c" ,r->wvhdl[l][i+j],c);
1117	}
1118	}
1119	else
1120	StringAppend("(%d)",r->block1[l]-r->block0[l]+1);
1121	}
1122	if (l==nblocks) return omStrDup(StringAppendS(""));
1123	StringAppendS(",");
1124	}
1125	}
1126
1127	char * rVarStr(ring r)
1128	{
1129	int i;
1130	int l=2;
1131	char *s;
1132
1133	for (i=0; i<r->N; i++)
1134	{
1135	l+=strlen(r->names[i])+1;
1136	}
1137	s=(char *)omAlloc(l);
1138	s[0]='\0';
1139	for (i=0; i<r->N-1; i++)
1140	{
1141	strcat(s,r->names[i]);
1142	strcat(s,",");
1143	}
1144	strcat(s,r->names[i]);
1145	return s;
1146	}
1147
1148	char * rCharStr(ring r)
1149	{
1150	char *s;
1151	int i;
1152
1153	if (r->parameter==NULL)
1154	{
1155	i=r->ch;
1156	if(i==-1)
1157	s=omStrDup("real"); /* R */
1158	else
1159	{
1160	s=(char *)omAlloc(6);
1161	sprintf(s,"%d",i); /* Q, Z/p */
1162	}
1163	return s;
1164	}
1165	int l=0;
1166	for(i=0; i<rPar(r);i++)
1167	{
1168	l+=(strlen(r->parameter[i])+1);
1169	}
1170	s=(char *)omAlloc(l+6);
1171	s[0]='\0';
1172	if (r->ch<0) sprintf(s,"%d",-r->ch); /* Fp(a) */
1173	else if (r->ch==1) sprintf(s,"0"); /* Q(a) */
1174	else
1175	{
1176	sprintf(s,"%d,%s",r->ch,r->parameter[0]); /* Fq */
1177	return s;
1178	}
1179	char tt[2];
1180	tt[0]=',';
1181	tt[1]='\0';
1182	for(i=0; i<rPar(r);i++)
1183	{
1184	strcat(s,tt);
1185	strcat(s,r->parameter[i]);
1186	}
1187	return s;
1188	}
1189
1190	char * rParStr(ring r)
1191	{
1192	if (r->parameter==NULL) return omStrDup("");
1193
1194	int i;
1195	int l=2;
1196
1197	for (i=0; i<rPar(r); i++)
1198	{
1199	l+=strlen(r->parameter[i])+1;
1200	}
1201	char s=(char )omAlloc(l);
1202	s[0]='\0';
1203	for (i=0; i<rPar(r)-1; i++)
1204	{
1205	strcat(s,r->parameter[i]);
1206	strcat(s,",");
1207	}
1208	strcat(s,r->parameter[i]);
1209	return s;
1210	}
1211
1212	char * rString(ring r)
1213	{
1214	char *ch=rCharStr(r);
1215	char *var=rVarStr(r);
1216	char *ord=rOrdStr(r);
1217	char res=(char )omAlloc(strlen(ch)+strlen(var)+strlen(ord)+9);
1218	sprintf(res,"(%s),(%s),(%s)",ch,var,ord);
1219	omFree((ADDRESS)ch);
1220	omFree((ADDRESS)var);
1221	omFree((ADDRESS)ord);
1222	return res;
1223	}
1224
1225	int rChar(ring r)
1226	{
1227	if (r->ch==-1)
1228	return 0;
1229	if (r->parameter==NULL) /* Q, Fp */
1230	return r->ch;
1231	if (r->ch<0) /* Fp(a) */
1232	return -r->ch;
1233	if (r->ch==1) /* Q(a) */
1234	return 0;
1235	/else/ /* GF(p,n) */
1236	{
1237	if ((r->ch & 1)==0) return 2;
1238	int i=3;
1239	while ((r->ch % i)!=0) i+=2;
1240	return i;
1241	}
1242	}
1243
1244	int rIsExtension(ring r)
1245	{
1246	if (r->parameter==NULL) /* Q, Fp */
1247	return FALSE;
1248	else
1249	return TRUE;
1250	}
1251
1252	int rIsExtension()
1253	{
1254	return rIsExtension( currRing );
1255	}
1256
1257	/*2
1258	*returns -1 for not compatible, (sum is undefined)
1259	* 0 for equal, (and sum)
1260	* 1 for compatible (and sum)
1261	*/
1262	int rSum(ring r1, ring r2, ring &sum)
1263	{
1264	if (r1==r2)
1265	{
1266	sum=r1;
1267	r1->ref++;
1268	return 0;
1269	}
1270	ring save=currRing;
1271	ip_sring tmpR;
1272	memset(&tmpR,0,sizeof(tmpR));
1273	/* check coeff. field =====================================================*/
1274	if (rInternalChar(r1)==rInternalChar(r2))
1275	{
1276	tmpR.ch=rInternalChar(r1);
1277	if (rField_is_Q(r1)\|\|rField_is_Zp(r1)\|\|rField_is_GF(r1)) /Q, Z/p, GF(p,n)/
1278	{
1279	if (r1->parameter!=NULL)
1280	{
1281	if (strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1282	{
1283	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1284	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1285	tmpR.P=1;
1286	}
1287	else
1288	{
1289	WerrorS("GF(p,n)+GF(p,n)");
1290	return -1;
1291	}
1292	}
1293	}
1294	else if ((r1->ch==1)\|\|(r1->ch<-1)) /* Q(a),Z/p(a) */
1295	{
1296	if (r1->minpoly!=NULL)
1297	{
1298	if (r2->minpoly!=NULL)
1299	{
1300	// HANNES: TODO: delete nSetChar
1301	rChangeCurrRing(r1);
1302	if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1303	&& n_Equal(r1->minpoly,r2->minpoly, r1))
1304	{
1305	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1306	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1307	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1308	tmpR.P=1;
1309	// HANNES: TODO: delete nSetChar
1310	rChangeCurrRing(save);
1311	}
1312	else
1313	{
1314	// HANNES: TODO: delete nSetChar
1315	rChangeCurrRing(save);
1316	WerrorS("different minpolys");
1317	return -1;
1318	}
1319	}
1320	else
1321	{
1322	if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1323	&& (rPar(r2)==1))
1324	{
1325	tmpR.parameter=(char **)omAlloc0Bin(char_ptr_bin);
1326	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1327	tmpR.P=1;
1328	// HANNES: TODO: delete nSetChar
1329	rChangeCurrRing(r1);
1330	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1331	rChangeCurrRing(save);
1332	}
1333	else
1334	{
1335	WerrorS("different parameters and minpoly!=0");
1336	return -1;
1337	}
1338	}
1339	}
1340	else /* r1->minpoly==NULL */
1341	{
1342	if (r2->minpoly!=NULL)
1343	{
1344	if ((strcmp(r1->parameter[0],r2->parameter[0])==0) /* 1 char */
1345	&& (rPar(r1)==1))
1346	{
1347	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1348	tmpR.parameter[0]=omStrDup(r1->parameter[0]);
1349	tmpR.P=1;
1350	// HANNES: TODO: delete nSetChar
1351	rChangeCurrRing(r2);
1352	tmpR.minpoly=n_Copy(r2->minpoly, r2);
1353	rChangeCurrRing(save);
1354	}
1355	else
1356	{
1357	WerrorS("different parameters and minpoly!=0");
1358	return -1;
1359	}
1360	}
1361	else
1362	{
1363	int len=rPar(r1)+rPar(r2);
1364	tmpR.parameter=(char *)omAlloc(lensizeof(char_ptr));
1365	int i;
1366	for (i=0;i<rPar(r1);i++)
1367	{
1368	tmpR.parameter[i]=omStrDup(r1->parameter[i]);
1369	}
1370	int j,l;
1371	for(j=0;j<rPar(r2);j++)
1372	{
1373	for(l=0;l<i;l++)
1374	{
1375	if(strcmp(tmpR.parameter[l],r2->parameter[j])==0)
1376	break;
1377	}
1378	if (l==i)
1379	{
1380	tmpR.parameter[i]=omStrDup(r2->parameter[j]);
1381	i++;
1382	}
1383	}
1384	if (i!=len)
1385	{
1386	omReallocSize(tmpR.parameter,lensizeof(char_ptr),isizeof(char_ptr));
1387	}
1388	}
1389	}
1390	}
1391	}
1392	else /* r1->ch!=r2->ch */
1393	{
1394	if (r1->ch<-1) /* Z/p(a) */
1395	{
1396	if ((r2->ch==0) /* Q */
1397	\|\| (r2->ch==-r1->ch)) /* Z/p */
1398	{
1399	tmpR.ch=rInternalChar(r1);
1400	tmpR.parameter=(char *)omAlloc(rPar(r1)sizeof(char_ptr));
1401	tmpR.P=rPar(r1);
1402	memcpy(tmpR.parameter,r1->parameter,rPar(r1)*sizeof(char_ptr));
1403	if (r1->minpoly!=NULL)
1404	{
1405	// HANNES: TODO: delete nSetChar
1406	rChangeCurrRing(r1);
1407	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1408	rChangeCurrRing(save);
1409	}
1410	}
1411	else /* R, Q(a),Z/q,Z/p(a),GF(p,n) */
1412	{
1413	WerrorS("Z/p(a)+(R,Q(a),Z/q(a),GF(q,n))");
1414	return -1;
1415	}
1416	}
1417	else if (r1->ch==-1) /* R */
1418	{
1419	WerrorS("R+..");
1420	return -1;
1421	}
1422	else if (r1->ch==0) /* Q */
1423	{
1424	if ((r2->ch<-1)\|\|(r2->ch==1)) /* Z/p(a),Q(a) */
1425	{
1426	tmpR.ch=rInternalChar(r2);
1427	tmpR.P=rPar(r2);
1428	tmpR.parameter=(char *)omAlloc(rPar(r2)sizeof(char_ptr));
1429	memcpy(tmpR.parameter,r2->parameter,rPar(r2)*sizeof(char_ptr));
1430	if (r2->minpoly!=NULL)
1431	{
1432	// HANNES: TODO: delete nSetChar
1433	rChangeCurrRing(r1);
1434	tmpR.minpoly=n_Copy(r2->minpoly, r2);
1435	rChangeCurrRing(save);
1436	}
1437	}
1438	else if (r2->ch>1) /* Z/p,GF(p,n) */
1439	{
1440	tmpR.ch=r2->ch;
1441	if (r2->parameter!=NULL)
1442	{
1443	tmpR.parameter=(char **)omAllocBin(char_ptr_bin);
1444	tmpR.P=1;
1445	tmpR.parameter[0]=omStrDup(r2->parameter[0]);
1446	}
1447	}
1448	else
1449	{
1450	WerrorS("Q+R");
1451	return -1; /* R */
1452	}
1453	}
1454	else if (r1->ch==1) /* Q(a) */
1455	{
1456	if (r2->ch==0) /* Q */
1457	{
1458	tmpR.ch=rInternalChar(r1);
1459	tmpR.P=rPar(r1);
1460	tmpR.parameter=(char *)omAlloc0(rPar(r1)sizeof(char_ptr));
1461	int i;
1462	for(i=0;i<rPar(r1);i++)
1463	{
1464	tmpR.parameter[i]=omStrDup(r1->parameter[i]);
1465	}
1466	if (r1->minpoly!=NULL)
1467	{
1468	// HANNES: TODO: delete nSetChar
1469	rChangeCurrRing(r1);
1470	tmpR.minpoly=n_Copy(r1->minpoly, r1);
1471	rChangeCurrRing(currRing);
1472	}
1473	}
1474	else /* R, Z/p,GF(p,n) */
1475	{
1476	WerrorS("Q(a)+(R,Z/p,GF(p,n))");
1477	return -1;
1478	}
1479	}
1480	else /* r1->ch >=2 , Z/p */
1481	{
1482	if (r2->ch==0) /* Q */
1483	{
1484	tmpR.ch=r1->ch;
1485	}
1486	else if (r2->ch==-r1->ch) /* Z/p(a) */
1487	{
1488	tmpR.ch=rInternalChar(r2);
1489	tmpR.P=rPar(r2);
1490	tmpR.parameter=(char *)omAlloc(rPar(r2)sizeof(char_ptr));
1491	int i;
1492	for(i=0;i<rPar(r2);i++)
1493	{
1494	tmpR.parameter[i]=omStrDup(r2->parameter[i]);
1495	}
1496	if (r2->minpoly!=NULL)
1497	{
1498	// HANNES: TODO: delete nSetChar
1499	rChangeCurrRing(r2);
1500	tmpR.minpoly=n_Copy(r2->minpoly, r2);
1501	rChangeCurrRing(save);
1502	}
1503	}
1504	else
1505	{
1506	WerrorS("Z/p+(GF(q,n),Z/q(a),R,Q(a))");
1507	return -1; /* GF(p,n),Z/q(a),R,Q(a) */
1508	}
1509	}
1510	}
1511	/* variable names ========================================================*/
1512	int i,j,k;
1513	int l=r1->N+r2->N;
1514	char names=(char )omAlloc0(l*sizeof(char_ptr));
1515	k=0;
1516
1517	// collect all varnames from r1, except those which are parameters
1518	// of r2, or those which are the empty string
1519	for (i=0;i<r1->N;i++)
1520	{
1521	BOOLEAN b=TRUE;
1522
1523	if (*(r1->names[i]) == '\0')
1524	b = FALSE;
1525	else if ((r2->parameter!=NULL) && (strlen(r1->names[i])==1))
1526	{
1527	for(j=0;j<rPar(r2);j++)
1528	{
1529	if (strcmp(r1->names[i],r2->parameter[j])==0)
1530	{
1531	b=FALSE;
1532	break;
1533	}
1534	}
1535	}
1536
1537	if (b)
1538	{
1539	//Print("name : %d: %s\n",k,r1->names[i]);
1540	names[k]=omStrDup(r1->names[i]);
1541	k++;
1542	}
1543	//else
1544	// Print("no name (par1) %s\n",r1->names[i]);
1545	}
1546	// Add variables from r2, except those which are parameters of r1
1547	// those which are empty strings, and those which equal a var of r1
1548	for(i=0;i<r2->N;i++)
1549	{
1550	BOOLEAN b=TRUE;
1551
1552	if (*(r2->names[i]) == '\0')
1553	b = FALSE;
1554	else if ((r1->parameter!=NULL) && (strlen(r2->names[i])==1))
1555	{
1556	for(j=0;j<rPar(r1);j++)
1557	{
1558	if (strcmp(r2->names[i],r1->parameter[j])==0)
1559	{
1560	b=FALSE;
1561	break;
1562	}
1563	}
1564	}
1565
1566	if (b)
1567	{
1568	for(j=0;j<r1->N;j++)
1569	{
1570	if (strcmp(r1->names[j],r2->names[i])==0)
1571	{
1572	b=FALSE;
1573	break;
1574	}
1575	}
1576	if (b)
1577	{
1578	//Print("name : %d : %s\n",k,r2->names[i]);
1579	names[k]=omStrDup(r2->names[i]);
1580	k++;
1581	}
1582	//else
1583	// Print("no name (var): %s\n",r2->names[i]);
1584	}
1585	//else
1586	// Print("no name (par): %s\n",r2->names[i]);
1587	}
1588	// check whether we found any vars at all
1589	if (k == 0)
1590	{
1591	names[k]=omStrDup("");
1592	k=1;
1593	}
1594	tmpR.N=k;
1595	tmpR.names=names;
1596	/* ordering ======================================================== /
1597	tmpR.OrdSgn=1;
1598	if ((r1->order[0]==ringorder_unspec)
1599	&& (r2->order[0]==ringorder_unspec))
1600	{
1601	tmpR.order=(int)omAlloc(3sizeof(int));
1602	tmpR.block0=(int)omAlloc(3sizeof(int));
1603	tmpR.block1=(int)omAlloc(3sizeof(int));
1604	tmpR.wvhdl=(int*)omAlloc0(3sizeof(int_ptr));
1605	tmpR.order[0]=ringorder_unspec;
1606	tmpR.order[1]=ringorder_C;
1607	tmpR.order[2]=0;
1608	tmpR.block0[0]=1;
1609	tmpR.block1[0]=tmpR.N;
1610	}
1611	else if (l==k) /* r3=r1+r2 */
1612	{
1613	int b;
1614	ring rb;
1615	if (r1->order[0]==ringorder_unspec)
1616	{
1617	/* extend order of r2 to r3 */
1618	b=rBlocks(r2);
1619	rb=r2;
1620	tmpR.OrdSgn=r2->OrdSgn;
1621	}
1622	else if (r2->order[0]==ringorder_unspec)
1623	{
1624	/* extend order of r1 to r3 */
1625	b=rBlocks(r1);
1626	rb=r1;
1627	tmpR.OrdSgn=r1->OrdSgn;
1628	}
1629	else
1630	{
1631	b=rBlocks(r1)+rBlocks(r2)-2; /* for only one order C, only one 0 */
1632	rb=NULL;
1633	}
1634	tmpR.order=(int)omAlloc0(bsizeof(int));
1635	tmpR.block0=(int)omAlloc0(bsizeof(int));
1636	tmpR.block1=(int)omAlloc0(bsizeof(int));
1637	tmpR.wvhdl=(int*)omAlloc0(bsizeof(int_ptr));
1638	/* weights not implemented yet ...*/
1639	if (rb!=NULL)
1640	{
1641	for (i=0;i<b;i++)
1642	{
1643	tmpR.order[i]=rb->order[i];
1644	tmpR.block0[i]=rb->block0[i];
1645	tmpR.block1[i]=rb->block1[i];
1646	if (rb->wvhdl[i]!=NULL)
1647	WarnS("rSum: weights not implemented");
1648	}
1649	tmpR.block0[0]=1;
1650	}
1651	else /* ring sum for complete rings */
1652	{
1653	for (i=0;r1->order[i]!=0;i++)
1654	{
1655	tmpR.order[i]=r1->order[i];
1656	tmpR.block0[i]=r1->block0[i];
1657	tmpR.block1[i]=r1->block1[i];
1658	if (r1->wvhdl[i]!=NULL)
1659	tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1660	}
1661	j=i;
1662	i--;
1663	if ((r1->order[i]==ringorder_c)
1664	\|\|(r1->order[i]==ringorder_C))
1665	{
1666	j--;
1667	tmpR.order[b-2]=r1->order[i];
1668	}
1669	for (i=0;r2->order[i]!=0;i++)
1670	{
1671	if ((r2->order[i]!=ringorder_c)
1672	&&(r2->order[i]!=ringorder_C))
1673	{
1674	tmpR.order[j]=r2->order[i];
1675	tmpR.block0[j]=r2->block0[i]+r1->N;
1676	tmpR.block1[j]=r2->block1[i]+r1->N;
1677	if (r2->wvhdl[i]!=NULL)
1678	{
1679	tmpR.wvhdl[j] = (int*) omMemDup(r2->wvhdl[i]);
1680	}
1681	j++;
1682	}
1683	}
1684	if((r1->OrdSgn==-1)\|\|(r2->OrdSgn==-1))
1685	tmpR.OrdSgn=-1;
1686	}
1687	}
1688	else if ((k==r1->N) && (k==r2->N)) /* r1 and r2 are "quite" the same ring */
1689	/* copy r1, because we have the variables from r1 */
1690	{
1691	int b=rBlocks(r1);
1692
1693	tmpR.order=(int)omAlloc0(bsizeof(int));
1694	tmpR.block0=(int)omAlloc0(bsizeof(int));
1695	tmpR.block1=(int)omAlloc0(bsizeof(int));
1696	tmpR.wvhdl=(int*)omAlloc0(bsizeof(int_ptr));
1697	/* weights not implemented yet ...*/
1698	for (i=0;i<b;i++)
1699	{
1700	tmpR.order[i]=r1->order[i];
1701	tmpR.block0[i]=r1->block0[i];
1702	tmpR.block1[i]=r1->block1[i];
1703	if (r1->wvhdl[i]!=NULL)
1704	{
1705	tmpR.wvhdl[i] = (int*) omMemDup(r1->wvhdl[i]);
1706	}
1707	}
1708	tmpR.OrdSgn=r1->OrdSgn;
1709	}
1710	else
1711	{
1712	for(i=0;i<k;i++) omFree((ADDRESS)tmpR.names[i]);
1713	omFreeSize((ADDRESS)names,tmpR.N*sizeof(char_ptr));
1714	Werror("difficulties with variables: %d,%d -> %d",r1->N,r2->N,k);
1715	return -1;
1716	}
1717	sum=(ring)omAllocBin(ip_sring_bin);
1718	memcpy(sum,&tmpR,sizeof(ip_sring));
1719	rComplete(sum);
1720	return 1;
1721	}
1722	/*2
1723	* create a copy of the ring r, which must be equivalent to currRing
1724	* used for qring definition,..
1725	* (i.e.: normal rings: same nCopy as currRing;
1726	* qring: same nCopy, same idCopy as currRing)
1727	* DOES NOT CALL rComplete
1728	*/
1729	static ring rCopy0(ring r, BOOLEAN copy_qideal = TRUE,
1730	BOOLEAN copy_ordering = TRUE)
1731	{
1732	if (r == NULL) return NULL;
1733	int i,j;
1734	ring res=(ring)omAllocBin(ip_sring_bin);
1735
1736	memcpy4(res,r,sizeof(ip_sring));
1737	res->VarOffset = NULL;
1738	res->ref=0;
1739	if (r->algring!=NULL)
1740	r->algring->ref++;
1741	if (r->parameter!=NULL)
1742	{
1743	res->minpoly=nCopy(r->minpoly);
1744	int l=rPar(r);
1745	res->parameter=(char *)omAlloc(lsizeof(char_ptr));
1746	int i;
1747	for(i=0;i<rPar(r);i++)
1748	{
1749	res->parameter[i]=omStrDup(r->parameter[i]);
1750	}
1751	}
1752	if (copy_ordering == TRUE)
1753	{
1754	i=rBlocks(r);
1755	res->wvhdl = (int *)omAlloc(i sizeof(int_ptr));
1756	res->order = (int ) omAlloc(i sizeof(int));
1757	res->block0 = (int ) omAlloc(i sizeof(int));
1758	res->block1 = (int ) omAlloc(i sizeof(int));
1759	for (j=0; j<i; j++)
1760	{
1761	if (r->wvhdl[j]!=NULL)
1762	{
1763	res->wvhdl[j] = (int*) omMemDup(r->wvhdl[j]);
1764	}
1765	else
1766	res->wvhdl[j]=NULL;
1767	}
1768	memcpy4(res->order,r->order,i * sizeof(int));
1769	memcpy4(res->block0,r->block0,i * sizeof(int));
1770	memcpy4(res->block1,r->block1,i * sizeof(int));
1771	}
1772	else
1773	{
1774	res->wvhdl = NULL;
1775	res->order = NULL;
1776	res->block0 = NULL;
1777	res->block1 = NULL;
1778	}
1779
1780	res->names = (char *)omAlloc0(r->N sizeof(char_ptr));
1781	for (i=0; i<res->N; i++)
1782	{
1783	res->names[i] = omStrDup(r->names[i]);
1784	}
1785	res->idroot = NULL;
1786	if (r->qideal!=NULL)
1787	{
1788	if (copy_qideal) res->qideal= idrCopyR_NoSort(r->qideal, r);
1789	else res->qideal = NULL;
1790	}
1791	return res;
1792	}
1793
1794	/*2
1795	* create a copy of the ring r, which must be equivalent to currRing
1796	* used for qring definition,..
1797	* (i.e.: normal rings: same nCopy as currRing;
1798	* qring: same nCopy, same idCopy as currRing)
1799	*/
1800	ring rCopy(ring r)
1801	{
1802	if (r == NULL) return NULL;
1803	ring res=rCopy0(r);
1804	rComplete(res, 1);
1805	return res;
1806	}
1807
1808	// returns TRUE, if r1 equals r2 FALSE, otherwise Equality is
1809	// determined componentwise, if qr == 1, then qrideal equality is
1810	// tested, as well
1811	BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
1812	{
1813	int i, j;
1814
1815	if (r1 == r2) return 1;
1816
1817	if (r1 == NULL \|\| r2 == NULL) return 0;
1818
1819	if ((rInternalChar(r1) != rInternalChar(r2))
1820	\|\| (r1->float_len != r2->float_len)
1821	\|\| (r1->float_len2 != r2->float_len2)
1822	\|\| (r1->N != r2->N)
1823	\|\| (r1->OrdSgn != r2->OrdSgn)
1824	\|\| (rPar(r1) != rPar(r2)))
1825	return 0;
1826
1827	for (i=0; i<r1->N; i++)
1828	{
1829	if (r1->names[i] != NULL && r2->names[i] != NULL)
1830	{
1831	if (strcmp(r1->names[i], r2->names[i])) return 0;
1832	}
1833	else if ((r1->names[i] != NULL) ^ (r2->names[i] != NULL))
1834	{
1835	return 0;
1836	}
1837	}
1838
1839	i=0;
1840	while (r1->order[i] != 0)
1841	{
1842	if (r2->order[i] == 0) return 0;
1843	if ((r1->order[i] != r2->order[i]) \|\|
1844	(r1->block0[i] != r2->block0[i]) \|\| (r2->block0[i] != r1->block0[i]))
1845	return 0;
1846	if (r1->wvhdl[i] != NULL)
1847	{
1848	if (r2->wvhdl[i] == NULL)
1849	return 0;
1850	for (j=0; j<r1->block1[i]-r1->block0[i]+1; j++)
1851	if (r2->wvhdl[i][j] != r1->wvhdl[i][j])
1852	return 0;
1853	}
1854	else if (r2->wvhdl[i] != NULL) return 0;
1855	i++;
1856	}
1857
1858	for (i=0; i<rPar(r1);i++)
1859	{
1860	if (strcmp(r1->parameter[i], r2->parameter[i])!=0)
1861	return 0;
1862	}
1863
1864	if (r1->minpoly != NULL)
1865	{
1866	if (r2->minpoly == NULL) return 0;
1867	if (currRing == r1 \|\| currRing == r2)
1868	{
1869	if (! nEqual(r1->minpoly, r2->minpoly)) return 0;
1870	}
1871	}
1872	else if (r2->minpoly != NULL) return 0;
1873
1874	if (qr)
1875	{
1876	if (r1->qideal != NULL)
1877	{
1878	ideal id1 = r1->qideal, id2 = r2->qideal;
1879	int i, n;
1880	poly m1, m2;
1881
1882	if (id2 == NULL) return 0;
1883	if ((n = IDELEMS(id1)) != IDELEMS(id2)) return 0;
1884
1885	if (currRing == r1 \|\| currRing == r2)
1886	{
1887	m1 = id1->m;
1888	m2 = id2->m;
1889	for (i=0; i<n; i++)
1890	if (! pEqualPolys(m1[i],m2[i])) return 0;
1891	}
1892	}
1893	else if (r2->qideal != NULL) return 0;
1894	}
1895
1896	return 1;
1897	}
1898
1899	rOrderType_t rGetOrderType(ring r)
1900	{
1901	// check for simple ordering
1902	if (rHasSimpleOrder(r))
1903	{
1904	if ((r->order[1] == ringorder_c) \|\| (r->order[1] == ringorder_C))
1905	{
1906	switch(r->order[0])
1907	{
1908	case ringorder_dp:
1909	case ringorder_wp:
1910	case ringorder_ds:
1911	case ringorder_ws:
1912	case ringorder_ls:
1913	case ringorder_unspec:
1914	if (r->order[1] == ringorder_C \|\| r->order[0] == ringorder_unspec)
1915	return rOrderType_ExpComp;
1916	return rOrderType_Exp;
1917
1918	default:
1919	assume(r->order[0] == ringorder_lp \|\|
1920	r->order[0] == ringorder_rp \|\|
1921	r->order[0] == ringorder_Dp \|\|
1922	r->order[0] == ringorder_Wp \|\|
1923	r->order[0] == ringorder_Ds \|\|
1924	r->order[0] == ringorder_Ws);
1925
1926	if (r->order[1] == ringorder_c) return rOrderType_ExpComp;
1927	return rOrderType_Exp;
1928	}
1929	}
1930	else
1931	{
1932	assume((r->order[0]==ringorder_c)\|\|(r->order[0]==ringorder_C));
1933	return rOrderType_CompExp;
1934	}
1935	}
1936	else
1937	return rOrderType_General;
1938	}
1939
1940	BOOLEAN rHasSimpleOrder(ring r)
1941	{
1942	if (r->order[0] == ringorder_unspec) return TRUE;
1943	int blocks = rBlocks(r) - 1;
1944	assume(blocks >= 1);
1945	if (blocks == 1) return TRUE;
1946	if (blocks > 2) return FALSE;
1947	if (r->order[0] != ringorder_c && r->order[0] != ringorder_C &&
1948	r->order[1] != ringorder_c && r->order[1] != ringorder_C)
1949	return FALSE;
1950	if (r->order[1] == ringorder_M \|\| r->order[0] == ringorder_M)
1951	return FALSE;
1952	return TRUE;
1953	}
1954
1955	// returns TRUE, if simple lp or ls ordering
1956	BOOLEAN rHasSimpleLexOrder(ring r)
1957	{
1958	return rHasSimpleOrder(r) &&
1959	(r->order[0] == ringorder_ls \|\|
1960	r->order[0] == ringorder_lp \|\|
1961	r->order[1] == ringorder_ls \|\|
1962	r->order[1] == ringorder_lp);
1963	}
1964
1965	BOOLEAN rOrder_is_DegOrdering(rRingOrder_t order)
1966	{
1967	switch(order)
1968	{
1969	case ringorder_dp:
1970	case ringorder_Dp:
1971	case ringorder_ds:
1972	case ringorder_Ds:
1973	case ringorder_Ws:
1974	case ringorder_Wp:
1975	case ringorder_ws:
1976	case ringorder_wp:
1977	return TRUE;
1978
1979	default:
1980	return FALSE;
1981	}
1982	}
1983
1984	BOOLEAN rOrder_is_WeightedOrdering(rRingOrder_t order)
1985	{
1986	switch(order)
1987	{
1988	case ringorder_Ws:
1989	case ringorder_Wp:
1990	case ringorder_ws:
1991	case ringorder_wp:
1992	return TRUE;
1993
1994	default:
1995	return FALSE;
1996	}
1997	}
1998
1999	BOOLEAN rHasSimpleOrderAA(ring r)
2000	{
2001	int blocks = rBlocks(r) - 1;
2002	if (blocks > 3 \|\| blocks < 2) return FALSE;
2003	if (blocks == 3)
2004	{
2005	return ((r->order[0] == ringorder_aa && r->order[1] != ringorder_M &&
2006	(r->order[2] == ringorder_c \|\| r->order[2] == ringorder_C)) \|\|
2007	((r->order[0] == ringorder_c \|\| r->order[0] == ringorder_C) &&
2008	r->order[1] == ringorder_aa && r->order[2] != ringorder_M));
2009	}
2010	else
2011	{
2012	return (r->order[0] == ringorder_aa && r->order[1] != ringorder_M);
2013	}
2014	}
2015
2016	// return TRUE if p_SetComp requires p_Setm
2017	BOOLEAN rOrd_SetCompRequiresSetm(ring r)
2018	{
2019	if (r->typ != NULL)
2020	{
2021	int pos;
2022	for (pos=0;pos<r->OrdSize;pos++)
2023	{
2024	sro_ord* o=&(r->typ[pos]);
2025	if (o->ord_typ == ro_syzcomp \|\| o->ord_typ == ro_syz) return TRUE;
2026	}
2027	}
2028	return FALSE;
2029	}
2030
2031	// return TRUE if p->exp[r->pOrdIndex] holds total degree of p */
2032	BOOLEAN rOrd_is_Totaldegree_Ordering(ring r =currRing)
2033	{
2034	// Hmm.... what about Syz orderings?
2035	return (r->N > 1 &&
2036	((rHasSimpleOrder(r) &&
2037	(rOrder_is_DegOrdering((rRingOrder_t)r->order[0]) \|\|
2038	rOrder_is_DegOrdering(( rRingOrder_t)r->order[1]))) \|\|
2039	(rHasSimpleOrderAA(r) &&
2040	(rOrder_is_DegOrdering((rRingOrder_t)r->order[1]) \|\|
2041	rOrder_is_DegOrdering((rRingOrder_t)r->order[2])))));
2042	}
2043
2044	// return TRUE if p->exp[r->pOrdIndex] holds a weighted degree of p */
2045	BOOLEAN rOrd_is_WeightedDegree_Ordering(ring r =currRing)
2046	{
2047	// Hmm.... what about Syz orderings?
2048	return (r->N > 1 &&
2049	rHasSimpleOrder(r) &&
2050	(rOrder_is_WeightedOrdering((rRingOrder_t)r->order[0]) \|\|
2051	rOrder_is_WeightedOrdering(( rRingOrder_t)r->order[1])));
2052	}
2053
2054	BOOLEAN rIsPolyVar(int v, ring r)
2055	{
2056	int i=0;
2057	while(r->order[i]!=0)
2058	{
2059	if((r->block0[i]<=v)
2060	&& (r->block1[i]>=v))
2061	{
2062	switch(r->order[i])
2063	{
2064	case ringorder_a:
2065	return (r->wvhdl[i][v-r->block0[i]]>0);
2066	case ringorder_M:
2067	return 2; /don't know/
2068	case ringorder_lp:
2069	case ringorder_rp:
2070	case ringorder_dp:
2071	case ringorder_Dp:
2072	case ringorder_wp:
2073	case ringorder_Wp:
2074	return TRUE;
2075	case ringorder_ls:
2076	case ringorder_ds:
2077	case ringorder_Ds:
2078	case ringorder_ws:
2079	case ringorder_Ws:
2080	return FALSE;
2081	default:
2082	break;
2083	}
2084	}
2085	i++;
2086	}
2087	return 3; /* could not find var v*/
2088	}
2089
2090	#ifdef RDEBUG
2091	// This should eventually become a full-fledge ring check, like pTest
2092	BOOLEAN rDBTest(ring r, char* fn, int l)
2093	{
2094	int i,j;
2095
2096	if (r == NULL)
2097	{
2098	dReportError("Null ring in %s:%d", fn, l);
2099	return FALSE;
2100	}
2101
2102
2103	if (r->N == 0) return TRUE;
2104
2105	// omCheckAddrSize(r,sizeof(ip_sring));
2106	#if OM_CHECK > 0
2107	i=rBlocks(r);
2108	omCheckAddrSize(r->order,i*sizeof(int));
2109	omCheckAddrSize(r->block0,i*sizeof(int));
2110	omCheckAddrSize(r->block1,i*sizeof(int));
2111	omCheckAddrSize(r->wvhdl,isizeof(int ));
2112	for (j=0;j<i; j++)
2113	{
2114	if (r->wvhdl[j] != NULL) omCheckAddr(r->wvhdl[j]);
2115	}
2116	#endif
2117	if (r->VarOffset == NULL)
2118	{
2119	dReportError("Null ring VarOffset -- no rComplete (?) in n %s:%d", fn, l);
2120	return FALSE;
2121	}
2122	omCheckAddrSize(r->VarOffset,(r->N+1)*sizeof(int));
2123
2124	if ((r->OrdSize==0)!=(r->typ==NULL))
2125	{
2126	dReportError("mismatch OrdSize and typ-pointer in %s:%d");
2127	return FALSE;
2128	}
2129	omcheckAddrSize(r->typ,r->OrdSizesizeof((r->typ)));
2130	omCheckAddrSize(r->VarOffset,(r->N+1)sizeof((r->VarOffset)));
2131	// test assumptions:
2132	for(i=0;i<=r->N;i++)
2133	{
2134	if(r->typ!=NULL)
2135	{
2136	for(j=0;j<r->OrdSize;j++)
2137	{
2138	if (r->typ[j].ord_typ==ro_cp)
2139	{
2140	if(((short)r->VarOffset[i]) == r->typ[j].data.cp.place)
2141	dReportError("ordrec %d conflicts with var %d",j,i);
2142	}
2143	else
2144	if ((r->typ[j].ord_typ!=ro_syzcomp)
2145	&& (r->VarOffset[i] == r->typ[j].data.dp.place))
2146	dReportError("ordrec %d conflicts with var %d",j,i);
2147	}
2148	}
2149	int tmp;
2150	tmp=r->VarOffset[i] & 0xffffff;
2151	#if SIZEOF_LONG == 8
2152	if ((r->VarOffset[i] >> 24) >63)
2153	#else
2154	if ((r->VarOffset[i] >> 24) >31)
2155	#endif
2156	dReportError("bit_start out of range:%d",r->VarOffset[i] >> 24);
2157	if (i > 0 && ((tmp<0) \|\|(tmp>r->ExpL_Size-1)))
2158	{
2159	dReportError("varoffset out of range for var %d: %d",i,tmp);
2160	}
2161	}
2162	if(r->typ!=NULL)
2163	{
2164	for(j=0;j<r->OrdSize;j++)
2165	{
2166	if ((r->typ[j].ord_typ==ro_dp)
2167	\|\| (r->typ[j].ord_typ==ro_wp)
2168	\|\| (r->typ[j].ord_typ==ro_wp_neg))
2169	{
2170	if (r->typ[j].data.dp.start > r->typ[j].data.dp.end)
2171	dReportError("in ordrec %d: start(%d) > end(%d)",j,
2172	r->typ[j].data.dp.start, r->typ[j].data.dp.end);
2173	if ((r->typ[j].data.dp.start < 1)
2174	\|\| (r->typ[j].data.dp.end > r->N))
2175	dReportError("in ordrec %d: start(%d)<1 or end(%d)>vars(%d)",j,
2176	r->typ[j].data.dp.start, r->typ[j].data.dp.end,r->N);
2177	}
2178	}
2179	}
2180	//assume(r->cf!=NULL);
2181
2182	return TRUE;
2183	}
2184	#endif
2185
2186	static void rO_Align(int &place, int &bitplace)
2187	{
2188	// increment place to the next aligned one
2189	// (count as Exponent_t,align as longs)
2190	if (bitplace!=BITS_PER_LONG)
2191	{
2192	place++;
2193	bitplace=BITS_PER_LONG;
2194	}
2195	}
2196
2197	static void rO_TDegree(int &place, int &bitplace, int start, int end,
2198	long *o, sro_ord &ord_struct)
2199	{
2200	// degree (aligned) of variables v_start..v_end, ordsgn 1
2201	rO_Align(place,bitplace);
2202	ord_struct.ord_typ=ro_dp;
2203	ord_struct.data.dp.start=start;
2204	ord_struct.data.dp.end=end;
2205	ord_struct.data.dp.place=place;
2206	o[place]=1;
2207	place++;
2208	rO_Align(place,bitplace);
2209	}
2210
2211	static void rO_TDegree_neg(int &place, int &bitplace, int start, int end,
2212	long *o, sro_ord &ord_struct)
2213	{
2214	// degree (aligned) of variables v_start..v_end, ordsgn -1
2215	rO_Align(place,bitplace);
2216	ord_struct.ord_typ=ro_dp;
2217	ord_struct.data.dp.start=start;
2218	ord_struct.data.dp.end=end;
2219	ord_struct.data.dp.place=place;
2220	o[place]=-1;
2221	place++;
2222	rO_Align(place,bitplace);
2223	}
2224
2225	static void rO_WDegree(int &place, int &bitplace, int start, int end,
2226	long o, sro_ord &ord_struct, int weights)
2227	{
2228	// weighted degree (aligned) of variables v_start..v_end, ordsgn 1
2229	rO_Align(place,bitplace);
2230	ord_struct.ord_typ=ro_wp;
2231	ord_struct.data.wp.start=start;
2232	ord_struct.data.wp.end=end;
2233	ord_struct.data.wp.place=place;
2234	ord_struct.data.wp.weights=weights;
2235	o[place]=1;
2236	place++;
2237	rO_Align(place,bitplace);
2238	int i;
2239	for(i=start;i<=end;i++)
2240	{
2241	if(weights[i-start]<0)
2242	{
2243	ord_struct.ord_typ=ro_wp_neg;
2244	break;
2245	}
2246	}
2247	}
2248
2249	static void rO_WDegree_neg(int &place, int &bitplace, int start, int end,
2250	long o, sro_ord &ord_struct, int weights)
2251	{
2252	// weighted degree (aligned) of variables v_start..v_end, ordsgn -1
2253	rO_Align(place,bitplace);
2254	ord_struct.ord_typ=ro_wp;
2255	ord_struct.data.wp.start=start;
2256	ord_struct.data.wp.end=end;
2257	ord_struct.data.wp.place=place;
2258	ord_struct.data.wp.weights=weights;
2259	o[place]=-1;
2260	place++;
2261	rO_Align(place,bitplace);
2262	int i;
2263	for(i=start;i<=end;i++)
2264	{
2265	if(weights[i-start]<0)
2266	{
2267	ord_struct.ord_typ=ro_wp_neg;
2268	break;
2269	}
2270	}
2271	}
2272
2273	static void rO_LexVars(int &place, int &bitplace, int start, int end,
2274	int &prev_ord, long o,int v, int bits, int opt_var)
2275	{
2276	// a block of variables v_start..v_end with lex order, ordsgn 1
2277	int k;
2278	int incr=1;
2279	if(prev_ord==-1) rO_Align(place,bitplace);
2280
2281	if (start>end)
2282	{
2283	incr=-1;
2284	}
2285	for(k=start;;k+=incr)
2286	{
2287	bitplace-=bits;
2288	if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2289	o[place]=1;
2290	v[k]= place \| (bitplace << 24);
2291	if (k==end) break;
2292	}
2293	prev_ord=1;
2294	if (opt_var!= -1)
2295	{
2296	assume((opt_var == end+1) \|\|(opt_var == end-1));
2297	if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-2");
2298	int save_bitplace=bitplace;
2299	bitplace-=bits;
2300	if (bitplace < 0)
2301	{
2302	bitplace=save_bitplace;
2303	return;
2304	}
2305	// there is enough space for the optional var
2306	v[opt_var]=place \| (bitplace << 24);
2307	}
2308	}
2309
2310	static void rO_LexVars_neg(int &place, int &bitplace, int start, int end,
2311	int &prev_ord, long o,int v, int bits, int opt_var)
2312	{
2313	// a block of variables v_start..v_end with lex order, ordsgn -1
2314	int k;
2315	int incr=1;
2316	if(prev_ord==1) rO_Align(place,bitplace);
2317
2318	if (start>end)
2319	{
2320	incr=-1;
2321	}
2322	for(k=start;;k+=incr)
2323	{
2324	bitplace-=bits;
2325	if (bitplace < 0) { bitplace=BITS_PER_LONG-bits; place++; }
2326	o[place]=-1;
2327	v[k]=place \| (bitplace << 24);
2328	if (k==end) break;
2329	}
2330	prev_ord=-1;
2331	// #if 0
2332	if (opt_var!= -1)
2333	{
2334	assume((opt_var == end+1) \|\|(opt_var == end-1));
2335	if((opt_var != end+1) &&(opt_var != end-1)) WarnS("hier-1");
2336	int save_bitplace=bitplace;
2337	bitplace-=bits;
2338	if (bitplace < 0)
2339	{
2340	bitplace=save_bitplace;
2341	return;
2342	}
2343	// there is enough space for the optional var
2344	v[opt_var]=place \| (bitplace << 24);
2345	}
2346	// #endif
2347	}
2348
2349	static void rO_Syzcomp(int &place, int &bitplace, int &prev_ord,
2350	long *o, sro_ord &ord_struct)
2351	{
2352	// ordering is derived from component number
2353	rO_Align(place,bitplace);
2354	ord_struct.ord_typ=ro_syzcomp;
2355	ord_struct.data.syzcomp.place=place;
2356	ord_struct.data.syzcomp.Components=NULL;
2357	ord_struct.data.syzcomp.ShiftedComponents=NULL;
2358	o[place]=1;
2359	prev_ord=1;
2360	place++;
2361	rO_Align(place,bitplace);
2362	}
2363
2364	static void rO_Syz(int &place, int &bitplace, int &prev_ord,
2365	long *o, sro_ord &ord_struct)
2366	{
2367	// ordering is derived from component number
2368	// let's reserve one Exponent_t for it
2369	if ((prev_ord== 1) \|\| (bitplace!=BITS_PER_LONG))
2370	rO_Align(place,bitplace);
2371	ord_struct.ord_typ=ro_syz;
2372	ord_struct.data.syz.place=place;
2373	ord_struct.data.syz.limit=0;
2374	ord_struct.data.syz.syz_index = NULL;
2375	ord_struct.data.syz.curr_index = 1;
2376	o[place]= -1;
2377	prev_ord=-1;
2378	place++;
2379	}
2380
2381	static unsigned long rGetExpSize(unsigned long bitmask, int & bits)
2382	{
2383	if (bitmask == 0)
2384	{
2385	bits=16; bitmask=0xffff;
2386	}
2387	else if (bitmask <= 1)
2388	{
2389	bits=1; bitmask = 1;
2390	}
2391	else if (bitmask <= 3)
2392	{
2393	bits=2; bitmask = 3;
2394	}
2395	else if (bitmask <= 7)
2396	{
2397	bits=3; bitmask=7;
2398	}
2399	else if (bitmask <= 0xf)
2400	{
2401	bits=4; bitmask=0xf;
2402	}
2403	else if (bitmask <= 0x1f)
2404	{
2405	bits=5; bitmask=0x1f;
2406	}
2407	else if (bitmask <= 0x3f)
2408	{
2409	bits=6; bitmask=0x3f;
2410	}
2411	#if SIZEOF_LONG == 8
2412	else if (bitmask <= 0x7f)
2413	{
2414	bits=7; bitmask=0x7f; /* 64 bit longs only */
2415	}
2416	#endif
2417	else if (bitmask <= 0xff)
2418	{
2419	bits=8; bitmask=0xff;
2420	}
2421	#if SIZEOF_LONG == 8
2422	else if (bitmask <= 0x1ff)
2423	{
2424	bits=9; bitmask=0x1ff; /* 64 bit longs only */
2425	}
2426	#endif
2427	else if (bitmask <= 0x3ff)
2428	{
2429	bits=10; bitmask=0x3ff;
2430	}
2431	#if SIZEOF_LONG == 8
2432	else if (bitmask <= 0xfff)
2433	{
2434	bits=12; bitmask=0xfff; /* 64 bit longs only */
2435	}
2436	#endif
2437	else if (bitmask <= 0xffff)
2438	{
2439	bits=16; bitmask=0xffff;
2440	}
2441	#if SIZEOF_LONG == 8
2442	else if (bitmask <= 0xfffff)
2443	{
2444	bits=20; bitmask=0xfffff; /* 64 bit longs only */
2445	}
2446	else if (bitmask <= 0xffffffff)
2447	{
2448	bits=32; bitmask=0xffffffff;
2449	}
2450	else
2451	{
2452	bits=64; bitmask=0xffffffffffffffff;
2453	}
2454	#else
2455	else
2456	{
2457	bits=32; bitmask=0xffffffff;
2458	}
2459	#endif
2460	return bitmask;
2461	}
2462
2463	/*2
2464	* optimize rGetExpSize for a block of N variables, exp <=bitmask
2465	*/
2466	static unsigned long rGetExpSize(unsigned long bitmask, int & bits, int N)
2467	{
2468	bitmask =rGetExpSize(bitmask, bits);
2469	int vars_per_long=BIT_SIZEOF_LONG/bits;
2470	int bits1;
2471	loop
2472	{
2473	if (bits == BIT_SIZEOF_LONG)
2474	{
2475	bits = BIT_SIZEOF_LONG - 1;
2476	return LONG_MAX;
2477	}
2478	unsigned long bitmask1 =rGetExpSize(bitmask+1, bits1);
2479	int vars_per_long1=BIT_SIZEOF_LONG/bits1;
2480	if ((((N+vars_per_long-1)/vars_per_long) ==
2481	((N+vars_per_long1-1)/vars_per_long1)))
2482	{
2483	vars_per_long=vars_per_long1;
2484	bits=bits1;
2485	bitmask=bitmask1;
2486	}
2487	else
2488	{
2489	return bitmask; /* and bits */
2490	}
2491	}
2492	}
2493
2494	/*2
2495	* create a copy of the ring r, which must be equivalent to currRing
2496	* used for std computations
2497	* may share data structures with currRing
2498	* DOES CALL rComplete
2499	*/
2500	ring rModifyRing(ring r, BOOLEAN omit_degree,
2501	BOOLEAN omit_comp,
2502	unsigned long exp_limit)
2503	{
2504	assume (r != NULL );
2505	assume (exp_limit > 1);
2506	BOOLEAN need_other_ring;
2507	BOOLEAN omitted_degree = FALSE;
2508	int bits;
2509
2510	exp_limit=rGetExpSize(exp_limit, bits, r->N);
2511	need_other_ring = (exp_limit != r->bitmask);
2512
2513	int nblocks=rBlocks(r);
2514	int order=(int)omAlloc0((nblocks+1)*sizeof(int));
2515	int block0=(int)omAlloc0((nblocks+1)*sizeof(int));
2516	int block1=(int)omAlloc0((nblocks+1)*sizeof(int));
2517	int wvhdl=(int)omAlloc0((nblocks+1)*sizeof(int_ptr));
2518
2519	int i=0;
2520	int j=0; /* i index in r, j index in res */
2521	loop
2522	{
2523	BOOLEAN copy_block_index=TRUE;
2524	int r_ord=r->order[i];
2525	if (r->block0[i]==r->block1[i])
2526	{
2527	switch(r_ord)
2528	{
2529	case ringorder_wp:
2530	case ringorder_dp:
2531	case ringorder_Wp:
2532	case ringorder_Dp:
2533	r_ord=ringorder_lp;
2534	break;
2535	case ringorder_Ws:
2536	case ringorder_Ds:
2537	case ringorder_ws:
2538	case ringorder_ds:
2539	r_ord=ringorder_ls;
2540	break;
2541	default:
2542	break;
2543	}
2544	}
2545	switch(r_ord)
2546	{
2547	case ringorder_C:
2548	case ringorder_c:
2549	if (!omit_comp)
2550	{
2551	order[j]=r_ord; /r->order[i]/;
2552	}
2553	else
2554	{
2555	j--;
2556	need_other_ring=TRUE;
2557	omit_comp=FALSE;
2558	copy_block_index=FALSE;
2559	}
2560	break;
2561	case ringorder_wp:
2562	case ringorder_dp:
2563	case ringorder_ws:
2564	case ringorder_ds:
2565	if(!omit_degree)
2566	{
2567	order[j]=r_ord; /r->order[i]/;
2568	}
2569	else
2570	{
2571	order[j]=ringorder_rp;
2572	need_other_ring=TRUE;
2573	omit_degree=FALSE;
2574	omitted_degree = TRUE;
2575	}
2576	break;
2577	case ringorder_Wp:
2578	case ringorder_Dp:
2579	case ringorder_Ws:
2580	case ringorder_Ds:
2581	if(!omit_degree)
2582	{
2583	order[j]=r_ord; /r->order[i];/
2584	}
2585	else
2586	{
2587	order[j]=ringorder_lp;
2588	need_other_ring=TRUE;
2589	omit_degree=FALSE;
2590	omitted_degree = TRUE;
2591	}
2592	break;
2593	default:
2594	order[j]=r_ord; /r->order[i];/
2595	break;
2596	}
2597	if (copy_block_index)
2598	{
2599	block0[j]=r->block0[i];
2600	block1[j]=r->block1[i];
2601	wvhdl[j]=r->wvhdl[i];
2602	}
2603	i++;j++;
2604	// order[j]=ringorder_no; // done by omAlloc0
2605	if (i==nblocks) break;
2606	}
2607	if(!need_other_ring)
2608	{
2609	omFreeSize(order,(nblocks+1)*sizeof(int));
2610	omFreeSize(block0,(nblocks+1)*sizeof(int));
2611	omFreeSize(block1,(nblocks+1)*sizeof(int));
2612	omFreeSize(wvhdl,(nblocks+1)*sizeof(int_ptr));
2613	return r;
2614	}
2615	ring res=(ring)omAlloc0Bin(ip_sring_bin);
2616	res = r;
2617	// res->qideal, res->idroot ???
2618	res->wvhdl=wvhdl;
2619	res->order=order;
2620	res->block0=block0;
2621	res->block1=block1;
2622	res->bitmask=exp_limit;
2623	int tmpref=r->cf->ref;
2624	rComplete(res, 1);
2625	r->cf->ref=tmpref;
2626
2627	// adjust res->pFDeg: if it was changed globally, then
2628	// it must also be changed for new ring
2629	if (r->pFDegOrig != res->pFDegOrig &&
2630	rOrd_is_WeightedDegree_Ordering(r))
2631	{
2632	// still might need adjustment for weighted orderings
2633	// and omit_degree
2634	res->firstwv = r->firstwv;
2635	res->firstBlockEnds = r->firstBlockEnds;
2636	res->pFDeg = res->pFDegOrig = pWFirstTotalDegree;
2637	}
2638	if (omitted_degree)
2639	res->pLDeg = res->pLDegOrig = r->pLDegOrig;
2640
2641	rOptimizeLDeg(res);
2642
2643	// set syzcomp
2644	if (res->typ != NULL && res->typ[0].ord_typ == ro_syz)
2645	{
2646	res->typ[0] = r->typ[0];
2647	if (r->typ[0].data.syz.limit > 0)
2648	{
2649	res->typ[0].data.syz.syz_index
2650	= (int) omAlloc((r->typ[0].data.syz.limit +1)sizeof(int));
2651	memcpy(res->typ[0].data.syz.syz_index, r->typ[0].data.syz.syz_index,
2652	(r->typ[0].data.syz.limit +1)*sizeof(int));
2653	}
2654	}
2655	return res;
2656	}
2657
2658	void rKillModifiedRing(ring r)
2659	{
2660	rUnComplete(r);
2661	omFree(r->order);
2662	omFree(r->block0);
2663	omFree(r->block1);
2664	omFree(r->wvhdl);
2665	omFreeBin(r,ip_sring_bin);
2666	}
2667
2668	static void rSetOutParams(ring r)
2669	{
2670	r->VectorOut = (r->order[0] == ringorder_c);
2671	r->ShortOut = TRUE;
2672	#ifdef HAVE_TCL
2673	if (tcllmode)
2674	{
2675	r->ShortOut = FALSE;
2676	}
2677	else
2678	#endif
2679	{
2680	int i;
2681	if ((r->parameter!=NULL) && (r->ch<2))
2682	{
2683	for (i=0;i<rPar(r);i++)
2684	{
2685	if(strlen(r->parameter[i])>1)
2686	{
2687	r->ShortOut=FALSE;
2688	break;
2689	}
2690	}
2691	}
2692	if (r->ShortOut)
2693	{
2694	// Hmm... sometimes (e.g., from maGetPreimage) new variables
2695	// are intorduced, but their names are never set
2696	// hence, we do the following awkward trick
2697	int N = omSizeWOfAddr(r->names);
2698	if (r->N < N) N = r->N;
2699
2700	for (i=(N-1);i>=0;i--)
2701	{
2702	if(r->names[i] != NULL && strlen(r->names[i])>1)
2703	{
2704	r->ShortOut=FALSE;
2705	break;
2706	}
2707	}
2708	}
2709	}
2710	r->CanShortOut = r->ShortOut;
2711	}
2712
2713	/*2
2714	* sets pMixedOrder and pComponentOrder for orderings with more than one block
2715	* block of variables (ip is the block number, o_r the number of the ordering)
2716	* o is the position of the orderingering in r
2717	*/
2718	static void rHighSet(ring r, int o_r, int o)
2719	{
2720	switch(o_r)
2721	{
2722	case ringorder_lp:
2723	case ringorder_dp:
2724	case ringorder_Dp:
2725	case ringorder_wp:
2726	case ringorder_Wp:
2727	case ringorder_rp:
2728	case ringorder_a:
2729	case ringorder_aa:
2730	if (r->OrdSgn==-1) r->MixedOrder=TRUE;
2731	break;
2732	case ringorder_ls:
2733	case ringorder_ds:
2734	case ringorder_Ds:
2735	case ringorder_s:
2736	break;
2737	case ringorder_ws:
2738	case ringorder_Ws:
2739	{
2740	if (r->wvhdl[o]!=NULL)
2741	{
2742	int i;
2743	for(i=r->block1[o]-r->block0[o];i>=0;i--)
2744	if (r->wvhdl[o][i]<0) { r->MixedOrder=TRUE; break; }
2745	}
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: