Context Navigation

source: git/Singular/ring.cc @ 24d587

spielwiese

Last change on this file since 24d587 was 24d587, checked in by Olaf Bachmann <obachman@…>, 23 years ago
* clean-up[ of LDeg/FDeg stuff * tailRing for local homg git-svn-id: file:///usr/local/Singular/svn/trunk@4960 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 92.1 KB

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

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

Download in other formats: