Context Navigation

source: git/Singular/ring.cc @ db19b8d

fieker-DuValspielwiese

Last change on this file since db19b8d was db19b8d, checked in by Hans Schönemann <hannes@…>, 24 years ago
* hannes: rModilfyRing: case of dp and 1 var. git-svn-id: file:///usr/local/Singular/svn/trunk@4703 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 87.0 KB

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

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

Download in other formats: