Context Navigation

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

spielwiese

Last change on this file since 7a45adb was 7a45adb, checked in by Hans Schönemann <hannes@…>, 24 years ago
*hannes: rComplete: better space utilization git-svn-id: file:///usr/local/Singular/svn/trunk@4590 2c84dea3-7e68-4137-9b89-c4e89433aadc
Property mode set to `100644`
File size: 78.6 KB

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

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

Download in other formats: