/* SYMMETRICA file:rest.c */
#include "def.h"
#include "macro.h"

#define MEMDEBUG
#undef MEMDEBUG

#ifdef SKEWPARTTRUE
static struct skewpartition * callocskewpartition();
#endif /* SKEWPARTTRUE */
#ifdef WORDTRUE
static INT coroutine250488();
#endif /* WORDTRUE */

#ifdef MEMCHECK

static INT mem_callocobject;
#define MEMTRACENUMBER 100
static OP callocobject_trace_pointer[MEMTRACENUMBER];

INT mem_callocobject_inc()
/* AK */
{
	mem_callocobject++;
	return OK;
}

INT mem_callocobject_dec()
{
	mem_callocobject--;
	return OK;
}

INT callocobject_anfang()
{        
	int l;
	for (l=0;l<MEMTRACENUMBER;l++)
                {
                callocobject_trace_pointer[l]=NULL;
                }
	mem_callocobject = 0L;
	return OK;
}

INT callocobject_ende()
{
	int i;
	if (mem_callocobject != 0L)
		{
		fprintf(stderr,"mem_callocobject: %ld\n",mem_callocobject);
		error("mem_callocobject: memory problem");
		}
	for (i=0;i<MEMTRACENUMBER;i++)
                {
                if (callocobject_trace_pointer[i] != NULL)
                        printf("traced memory %d left\n",callocobject_trace_pointer[i]);
                }
	return OK;
}
#endif /* MEMCHECK */

INT check_equal_3(a,b,c,f,e) OP a,b,c; INT (*f)(), *e;
/* the OP a and b and c are compared 
   return : EQUAL if a == c or b==c , is in this case the function was 
		evaluated in *e we have the return value
	b is freed
*/
/* AK 240398 V2.0 */
{
	if ((a==c) && (b == c))
		{
		OP d = callocobject();
		*d = *c;
		C_O_K(c,EMPTY);
		*e = (*f)(d,d,c);
		*e += freeall(d);
		return EQUAL;
		}
	else if (a==c)
		{
		OP d = callocobject();
		*d = *c;
		C_O_K(c,EMPTY);
		*e = (*f)(d,b,c);
		*e += freeall(d);
		return EQUAL;
		}
	else if (b==c)
		{
		OP d = callocobject();
		*d = *c;
		C_O_K(c,EMPTY);
		*e = (*f)(a,d,c);
		*e += freeall(d);
		return EQUAL;
		}
	else 
		{
		*e = OK;
		if (c != NULL)
		if (not EMPTYP(c))
			*e += freeself(c);
		return OK;
		}
}
INT check_equal_4(a,b,c,d,f,e) OP a,b,c,d; INT (*f)(), *e;
/* the OP a and b and c are compared 
   return : EQUAL if a == d or b==d or d==c, is in this case the function was 
		evaluated in *e we have the return value
*/
{
	if (a==d)
		{
		OP dd = callocobject();
		*dd = *d;
		C_O_K(d,EMPTY);
		*e = (*f)(dd,b,c,d);
		*e += freeall(dd);
		return EQUAL;
		}
	else if (b==d)
		{
		OP dd = callocobject();
		*dd = *d;
		C_O_K(d,EMPTY);
		*e = (*f)(a,dd,c,d);
		*e += freeall(dd);
		return EQUAL;
		}
	else if (c==d)
		{
		OP dd = callocobject();
		*dd = *d;
		C_O_K(d,EMPTY);
		*e = (*f)(a,b,dd,d);
		*e += freeall(dd);
		return EQUAL;
		}
	else 
		{
		*e = OK;
		if (d != NULL)
		if (not EMPTYP(d))
			*e += freeself(d);
		return OK;
		}
}

INT check_equal_2(a,b,f,e) OP a,b; INT (*f)(), *e;
/* the OP a and b are compared 
   return : EQUAL if a == b , is in this case the function was 
		evaluated in *e we have the return value
	b is freed
*/
{
	if (a==b)
		{
		OP c = callocobject();
		*c = *b;
		C_O_K(b,EMPTY);
		*e = (*f)(c,b);
		*e += freeall(c);
		return EQUAL;
		}
	else 
		{
		*e = OK;
		if (not EMPTYP(b))
			*e += freeself(b);
		return OK;
		}
}
INT check_equal_2a(a,b,f,e) OP a,b; INT (*f)(), *e;
/* apply version, work with copy of a */
/* the OP a and b are compared 
   return : EQUAL if a == b , is in this case the function was 
		evaluated in *e we have the return value
	b is freed
*/
/* AK 240398 V2.0 */
{
	if (a==b)
		{
		OP c = callocobject();
		*e = copy(a,c);
		*e += (*f)(c,b);
		*e += freeall(c);
		return EQUAL;
		}
	else 
		{
		*e = OK;
		return OK;
		}
}


#define SYMDIR "./symresults"
INT sym_no_results=0; 	/* 0 == stored results will be used */
			/* 1 == stored results will not be used */

static FILE *check_fopen(f,r) char *f, *r;
/* AK 240398 V2.0 */
{
	char t1[300];
	if (sym_no_results==1) 
		return NULL;
	sprintf(t1,"%s/%s",SYMDIR,f);
	return fopen(t1,r);
}

INT check_result_1(a,t,c) OP a,c; char *t;
/* testet ob ein vorberechnetes result da ist */
/* AK 020996 */
/* AK 240398 V2.0 */
{
	char t1[100],t3[100];
	FILE *fp;
	INT erg = OK;
	sprint(t1,a);
	sprintf(t3,"%s_%s",t,t1);
	fp = check_fopen(t3,"r");
	if (fp == NULL) 
		return NORESULT;
	erg += objectread(fp,c);
	fclose(fp);
	ENDR("check_result_1");
}

INT check_result_2(a,b,t,c) OP a,b,c; char *t;
/* testet ob ein vorberechnetes result da ist */
/* AK 020996 */
/* AK 240398 V2.0 */
{
	char t1[100],t2[100],t3[100];
	FILE *fp;
	INT erg = OK;
	sprint(t1,a);
	sprint(t2,b);
	sprintf(t3,"%s_%s_%s",t,t1,t2);
	fp = check_fopen(t3,"r");
	if (fp == NULL) 
		return NORESULT;
	erg += objectread(fp,c);
	fclose(fp);
	ENDR("check_result_2");
}

INT check_result_3(a,b,d,t,c) OP a,b,d,c; char *t;
/* testet ob ein vorberechnetes result da ist */
/* AK 020996 */
/* AK 240398 V2.0 */
{
	char t1[100],t2[100],t3[100],t4[100];
	FILE *fp;
	INT erg = OK;
	sprint(t1,a);
	sprint(t2,b);
	sprint(t4,d);
	sprintf(t3,"%s_%s_%s_%s",t,t1,t2,t4);
	fp = check_fopen(t3,"r");
	if (fp == NULL) 
		return NORESULT;
	erg += objectread(fp,c);
	fclose(fp);
	ENDR("check_result_3");
}



INT store_result_1(a,t,c) OP a,c; char *t; 
/* speichere ein berechnetes result  zu einem parameter */ /* AK 020996 */
/* AK 240398 V2.0 */
{
	char t1[100],t3[100];
	FILE *fp;
	INT erg = OK;
	sprint(t1,a);
	sprintf(t3,"%s_%s",t,t1);
	fp = check_fopen(t3,"w");
	if (fp == NULL)  { goto endr_ende; } /* nicht gespeichert */
	erg += objectwrite(fp,c);
	fclose(fp);
	ENDR("store_result_1");
}

INT store_result_2(a,b,t,c) OP a,b,c; char *t;
/* speichere ein berechnetes result  zu zwei parametern */
/* AK 020996 */
/* AK 240398 V2.0 */
{
	char t1[100],t2[100],t3[100];
	FILE *fp;
	INT erg = OK;
	sprint(t1,a);
	sprint(t2,b);
	sprintf(t3,"%s_%s_%s",t,t1,t2);
	fp = check_fopen(t3,"w");
	if (fp == NULL)  {  goto endr_ende; } /* nicht gespeichert */
	erg += objectwrite(fp,c);
	fclose(fp);
	ENDR("store_result_2");
}

INT store_result_3(a,b,d,t,c) OP d,a,b,c; char *t;
/* speichere ein berechnetes result  zu zwei parametern */
/* AK 020996 */
/* AK 240398 V2.0 */
{
	char t1[100],t2[100],t3[100],t4[100];
	FILE *fp;
	INT erg = OK;
	sprint(t1,a);
	sprint(t2,b);
	sprint(t4,d);
	sprintf(t3,"%s_%s_%s_%s",t,t1,t2,t4);
	fp = check_fopen(t3,"w");
	if (fp == NULL)  {  goto endr_ende; } 
		/* nicht gespeichert */
	erg += objectwrite(fp,c);
	fclose(fp);
	ENDR("store_result_2");
}


INT empty_object(t) char *t;
/* AK 220997 */
/* AK 240398 V2.0 */
	{
	fprintf(stderr,"function: %s \n",t);
	return error("empty object as parameter");
	}

INT null_object(t) char *t;
/* AK 211093 */
/* AK 240398 V2.0 */
	{
	fprintf(stderr,"function: %s \n",t);
	return error("null object as parameter");
	}

INT not_yet_implemented(t) char *t;
/* AK 211093 */
/* AK 240398 V2.0 */
	{
	fprintf(stderr,"function: %s \n",t);
	return error("not yet implemented");
	}

INT equal_2_error() {
	fprintf(stderr,"internal error: two parameter equal, this should not happen");
	return I2PE;
	}
INT error_during_computation(t) char *t;
/* AK 090393 */ /* AK 240398 V2.0 */
	{
	INT err;
	fprintf(stderr,"function: %s \n",t);
	err = error("error during computation");
	return ERROR;
	}
INT error_during_computation_code(t,code) char *t; INT code;
/* AK 170698 V2.0 */
        {
        INT err;
        fprintf(stderr,"function: %s code: %ld \n",t,code);
        err = error("error during computation");
        return ERROR;
        }


INT wrong_type_twoparameter(t,a,b) char *t; OP a,b;
/* AK 090393 */
/* AK 240398 V2.0 */
	{
	fprintf(stderr,"function: %s not definied for object types:\n",t);
	fprintf(stderr,"type of first parameter:");
	printobjectkind(a);
	fprintf(stderr,"type of second parameter:");
	printobjectkind(b);
	return error("function with wrong input types");
	}

INT wrong_type_oneparameter(t,a) char *t; OP a;
/* AK 090393 */
/* AK 240398 V2.0 */
	{
	fprintf(stderr,"function: %s not definied for object type:\n",t);
	printobjectkind(a);
	return error("function with wrong input type");
	}

INT swap(a,b) OP a,b;
/* AK 280388 */ /* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
/* a becomes b and b becomes a */
/* AK 240398 V2.0 */
	{
	struct object c;
	if (a == b)
		return error("swap:identical");
	c = *a; 
	*a = *b; 
	*b = c; 
	return(OK);
	}

INT rz(a,b) OP a, b;
/* AK 261087 berechnet die reduzierte Zerlegung */
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 120391 V1.2 */
/* AK 210891 V1.3 */
/* AK 240398 V2.0 */
	{
	INT erg = OK;
	COP("rz",a);
	CE2(a,b,rz);
	if (EMPTYP(a))	
		goto endr_ende;

	switch(S_O_K(a))
		{
#ifdef PERMTRUE
		case PERMUTATION : 
			switch(S_P_K(a))
				{
				case VECTOR: 
					erg += rz_perm(a,b);break;
				case BAR: 
					erg += rz_bar(a,b);break;
				}
			break;
		case INTEGERVECTOR:
		case VECTOR: 
			switch(S_O_K(S_V_I(a,0L)))
				{
				case INTEGER: 
					erg += rz_lehmercode(a,b);
					break;
				case VECTOR: 
					erg += rz_lehmercode_bar(a,b);
					break;
				}
			break;
#endif /* PERMTRUE */
		default: 
			erg+= WTO("rz",a); 
			break;
			
		};
	ENDR("rz");
}
 
INT lastof(a,res) OP a,res;
/* AK 280689 V1.0 */ /* AK 090790 V1.1 */ /* AK 200691 V1.2 */
/* AK 210891 V1.3 */
/* AK 020398 V2.0 */
/* input: ..
   output: a copy of the last elemnent */
	{
	INT erg = OK; 
	CE2(a,res,lastof);
	switch(S_O_K(a))
		{
#ifdef PARTTRUE
		case PARTITION: 
			erg+=lastof_partition(a,res);
			break;
#endif /* PARTTRUE */
#ifdef SKEWPARTTRUE
		case SKEWPARTITION : 
			erg+=lastof_skewpartition(a,res);
			break;
#endif /* SKEWPARTTRUE */
#ifdef VECTORTRUE
		case INTEGERVECTOR:
		case VECTOR : 
			erg+=lastof_vector(a,res);
			break;
#endif /* VECTORTRUE */
		default: 
			erg+= WTO("lastof",a); 
			break;
		};
	ENDR("lastof");
	}

INT freeall(a) OP a;
/* AK 101286 */ /* AK 280689 V1.0 */ /* AK 071289 V1.1 */
/* AK 270291 V1.2 */ /* AK 050891 V1.3 */
	{ 
	INT erg = OK;

	COP("freeall",a);
	if (S_O_K(a) == INFREELIST) /* AK 210995 */
		{
		error("freeall:call to already free object");
		goto fe;
		}
#ifdef MEMCHECK
        {
        int i;
        for (i=0;i<MEMTRACENUMBER;i++)
                {
                if (callocobject_trace_pointer[i]==a)
                        {
                        printf("freeall traced %d \n",a);
                        callocobject_trace_pointer[i]=NULL;
                        }
                }
        }
#endif
	if (not EMPTYP(a)) 
	if (S_O_K(a) != INTEGER) /* AK 071091 */
		erg += freeself(a); 

	if (speicherposition+1L < SPEICHERSIZE) /* AK 111091 */
		{
		C_O_K(a,INFREELIST);
		speicher[++speicherposition] = a;
#ifdef MEMDEBUG
		printf("speicher(put):%ld\n",a);
#endif /* MEMDEBUG */
		}
	else
		SYM_free(a); 

#ifdef MEMCHECK
	mem_callocobject_dec();
#endif /* MEMCHECK */
fe:
	ENDR("freeall");
	}


INT freeself(a) OP a;
/* AK 061186 */ /* AK 280689 V1.0 */ /* AK 041289 V1.1 */ /* AK 050891 V1.3 */
/* AK 070498 V2.0 */
	{
	INT erg=OK;
	COP("freeself",a);
	if (EMPTYP(a)) 
		goto endr_ende;
	else switch(S_O_K(a))
		{
#ifdef BINTREETRUE
		case BINTREE : 
			erg += freeself_bintree(a); 
			break;
#endif /* BINTREETRUE */
#ifdef BRUCHTRUE
		case BRUCH : 
			erg += freeself_bruch(a); 
			break;
#endif /* BRUCHTRUE */
#ifdef FFTRUE
		case FF :
			erg += freeself_ff(a); 
			break;
#endif /* FFTRUE */
		case INTEGER : erg += FREESELF_INTEGER(a);break;
#ifdef LISTTRUE
		case GRAL: case HOM_SYM: case POW_SYM: case MONOPOLY:
		case POLYNOM: case SCHUR: case SCHUBERT: case ELM_SYM:
		case LIST: case MONOMIAL:
			erg += freeself_list(a); break; 
#endif /* LISTTRUE */
#ifdef LONGINTTRUE
		case LONGINT : erg += freeself_longint(a); break; 
#endif /* LONGINTTRUE */
#ifdef MATRIXTRUE
		case KRANZTYPUS : erg += freeself_kranztypus(a);break;
		case KOSTKA :
		case MATRIX : erg += freeself_matrix(a); break;
		case INTEGERMATRIX: erg += freeself_integermatrix(a); break;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
		case MONOM : erg += freeself_monom(a); break;
#endif /* MONOMTRUE */
#ifdef NUMBERTRUE
		case SQ_RADICAL:
		case CYCLOTOMIC: erg += freeself_number(a);break;
#endif /* NUMBERTRUE */
#ifdef PARTTRUE
		case AUG_PART : 
		case CHARPARTITION:
		case PARTITION : erg += freeself_partition(a); break;
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION : erg += freeself_permutation(a);break;
#endif /* PERMTRUE */
#ifdef REIHETRUE
		case REIHE : erg += freeself_reihe(a);break;
#endif /* REIHETRUE */
#ifdef SKEWPARTTRUE
		case SKEWPARTITION : erg += freeself_skewpartition(a); break;
#endif /* PERMTRUE */
#ifdef CHARTRUE
		case SYMCHAR : erg += freeself_symchar(a); break;
#endif /* CHARTRUE */
#ifdef TABLEAUXTRUE
		case TABLEAUX : erg += freeself_tableaux(a); break;
#endif /* TABLEAUXTRUE */
#ifdef VECTORTRUE
		case KRANZ: case WORD: case VECTOR: 
		case LAURENT: case HASHTABLE:
			erg += freeself_vector(a);break;
		case BITVECTOR:
			erg += freeself_bitvector(a); break;
		case SUBSET:
		case INTEGERVECTOR:
		case COMP:
			erg += freeself_integervector(a); break;
#endif /* VECTORTRUE */
		default: 
			erg +=  WTO("freeself",a); 
			break;
		};
	C_O_K(a,EMPTY);
	ENDR("freeself");
	}

INT copy(a,b) OP a, b;
/* AK 280689 V1.0 */ /* AK 201289 V1.1 */ /* AK 050891 V1.3 */
	{
	INT erg = OK;
	if (sym_timelimit > 0L)
		check_time();
	if (a == b) 
		return(OK);
	COP("copy",a);
	COP("copy",b);

	if (not EMPTYP(b)) 
		erg += freeself(b);
	if (EMPTYP(a))	
		goto endr_ende;
	switch(S_O_K(a))
		{
#ifdef BINTREETRUE
		case BINTREE : erg += copy_bintree(a,b);break;
#endif /* BINTREETRUE */
#ifdef BRUCHTRUE
		case BRUCH : erg += copy_bruch(a,b);break;
#endif /* BRUCHTRUE */
#ifdef FFTRUE
		case FF: erg += copy_ff(a,b);break;
#endif /* FFTRUE */
#ifdef INTEGERTRUE
		case INTEGER : erg += COPY_INTEGER(a,b);break;	
#endif /* INTEGERTRUE */
#ifdef LISTTRUE
		case POLYNOM: case GRAL: case HOM_SYM: case ELM_SYM:
		case POW_SYM: case MONOMIAL: case SCHUR : case MONOPOLY:
		case SCHUBERT: case LIST : 
			erg += copy_list(a,b);break;
#endif /* LISTTRUE */
#ifdef LONGINTTRUE
		case LONGINT : erg += copy_longint(a,b);break;
#endif /* LONGINTTRUE */
#ifdef MATRIXTRUE
		case INTEGERMATRIX: erg += copy_integermatrix(a,b);break;
		case KRANZTYPUS : erg += copy_kranztypus(a,b);break;
		case KOSTKA :
		case MATRIX : erg += copy_matrix(a,b);break;
			
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
		case MONOM : erg += copy_monom(a,b);break;
#endif /* MONOMTRUE */
#ifdef NUMBERTRUE
		case SQ_RADICAL:
		case CYCLOTOMIC: erg += copy_number(a,b);break;
#endif /* NUMBERTRUE */
#ifdef PARTTRUE
		case AUG_PART :
		case PARTITION : erg += copy_partition(a,b);break;
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION : erg += copy_permutation(a,b);break;
#endif /* PERMTRUE */
#ifdef REIHETRUE
		case REIHE : erg += copy_reihe(a,b);break;
#endif /* REIHETRUE */
#ifdef SKEWPARTTRUE
		case SKEWPARTITION : erg += copy_skewpartition(a,b);break;
#endif /* SKEWPARTTRUE */
#ifdef CHARTRUE
		case SYMCHAR : erg += copy_symchar(a,b);break;
#endif /* CHARTRUE */
#ifdef TABLEAUXTRUE
		case TABLEAUX : erg += copy_tableaux(a,b);break;
#endif /* TABLEAUXTRUE */
#ifdef VECTORTRUE
		case HASHTABLE:
			INC_INTEGER(S_V_L(a)); 
			copy_vector(a,b);
			DEC_INTEGER(S_V_L(a)); DEC_INTEGER(S_V_L(b));
			break;
		case COMP: case KRANZ: case WORD: case VECTOR:   
		case SUBSET:
		case LAURENT:
			erg += copy_vector(a,b);break;
		case INTEGERVECTOR:
			erg += copy_integervector(a,b); break;
		case BITVECTOR:
			erg += copy_bitvector(a,b); break;
#endif /* VECTORTRUE */
		default: erg+= WTO("copy",a);break;
		};

	ENDR("copy");
	}

INT append(a,b,e) OP a,b,e;
/* AK 280689 V1.0 */ /* AK 221289 V1.1 */
/* AK 190291 V1.2 */ /* AK 090891 V1.3 */
	{
	INT erg = OK;
	COP("append",a);
	COP("append",b);

	/* integer objecte werden in einen vector umgewandelt AK 260887 */

        if (INTEGERP(a))
        	{
        	OP 	c = callocobject();
        	erg += m_o_v(a,c);
        	erg += append(c,b,e);
		erg += freeall(c);
        	goto endr_ende;
        	};

        if (INTEGERP(b))
        	{
        	OP 	c = callocobject();
        	erg += m_o_v(b,c);
        	erg += append(a,c,e);
		erg += freeall(c);
        	goto endr_ende;
        	};

	if (EMPTYP(a)) return(copy(b,e));
	if (EMPTYP(b)) return(copy(a,e));
    
	CE3(a,b,e,append);

	switch(S_O_K(a))
		{
#ifdef PARTTRUE
		case PARTITION :  erg += append_part_part(a,b,e);
			break;
#endif /* PARTTRUE */
#ifdef VECTORTRUE
		case INTEGERVECTOR:
		case WORD:
		case COMP:
		case SUBSET:
		case VECTOR :  erg += append_vector(a,b,e);
			break;
#endif /* VECTORTRUE */
		default: erg+= WTO("append",a); break;
		};
	ENDR("append");
	}


INT scalarp(a) OP a;
/* test ob scalarer datentyp
 Fri Mar  3 12:43:30 MEZ 1989
AK wahr falls INTEGER,LONGINT,BRUCH */
/* AK 280689 V1.0 */ /* AK 221289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("scalarp",a);
	switch(S_O_K(a))
		{
		case BRUCH:
		case INTEGER:
		case LONGINT:
			return(TRUE);
		default:
			return(FALSE);
		}
	ENDR("scalarp");
	}

INT dynamicp(a) OP a;
/* test ob dynamische datenstruktur */
/* Tue Jan 10 07:16:33 MEZ 1989 */
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 050891 V1.3 */
	{
	INT erg = OK;
	COP("dynamicp",a);
	switch (S_O_K(a))
		{
		case GRAL: case HOM_SYM: case POW_SYM: case BINTREE:
		case MONOPOLY: case SCHUR: case SCHUBERT: case LIST:
		case ELM_SYM: case MONOMIAL:
			return(TRUE);
		default:
			return(FALSE);
		}
	ENDR("dynamicp");
	}



INT nullp(a) OP a;
/* 290388  aus macro */ /* AK 280689 V1.0 */ /* AK 081289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("nullp",a);
	switch (S_O_K(a))
		{
		case EMPTY: return TRUE;
#ifdef BRUCHTRUE
		case BRUCH: return(NULLP_BRUCH(a));
#endif /* BRUCHTRUE */
		case INTEGER:  return (NULLP_INTEGER(a)); 
#ifdef FFTRUE
		case FF:  return nullp_ff(a);
#endif /* FFTRUE */
#ifdef LONGINTTRUE
		case LONGINT: return nullp_longint(a);
#endif /* LONGINTTRUE */
#ifdef CYCLOTRUE
		case CYCLOTOMIC: return nullp_cyclo(a);
#endif /* CYCLOTRUE */
#ifdef MONOPOLYTRUE
		case MONOPOLY: return nullp_monopoly(a); /* AK 290395 */
#endif /* MONOPOLYTRUE */
#ifdef MATRIXTRUE
		case MATRIX: return nullp_matrix(a);
#endif /* MATRIXTRUE */
#ifdef SQRADTRUE
		case SQ_RADICAL: return nullp_sqrad(a);
#endif /* SQRADTRUE */
#ifdef SCHUBERTTRUE
		case SCHUBERT: return nullp_schubert(a); /* AL 180393 */
#endif /* SCHUBERTTRUE */
#ifdef SCHURTRUE
		case ELM_SYM:
		case POW_SYM:
		case HOM_SYM:
		case MONOMIAL:
		case SCHUR: return nullp_schur(a);
#endif /* SCHURTRUE */
#ifdef CHARTRUE
		case SYMCHAR: return nullp_symchar(a); /* AK 010692 */
#endif /* CHARTRUE */
#ifdef POLYTRUE
		case POLYNOM: return nullp_polynom(a);
#endif /* POLYTRUE */
#ifdef REIHETRUE
		case REIHE: return nullp_reihe(a);
#endif /* REIHETRUE */
#ifdef VECTORTRUE  /* AK 311091 */
		case INTEGERVECTOR: return nullp_integervector(a);
		case VECTOR: return nullp_vector(a);
		case BITVECTOR: return nullp_bitvector(a);
		case HASHTABLE: return nullp_integer(S_V_I(a,S_V_LI(a)));
#endif /* VECTORTRUE */
		default:  return(FALSE);
		};
	ENDR("nullp");
	}

INT einsp(a) OP a;
/* TRUE if a is unity */
/* 290388  aus macro */ /* AK 280689 V1.0 */ /* AK 081289 V1.1 */
/* AK 250291 V1.2 */ /* AK 210891 V1.3 */
/* AK 040398 V2.0 */
	{
	INT erg = OK;
	COP("einsp",a);
	switch (S_O_K(a)) {
#ifdef BRUCHTRUE
		case BRUCH:  return einsp_bruch(a);
#endif /* BRUCHTRUE */
#ifdef FFTRUE
		case FF:  return einsp_ff(a);
#endif /* FFTRUE */
		case INTEGER:  return einsp_integer(a);
#ifdef LONGINTTRUE
		case LONGINT:  return einsp_longint(a);
#endif /* LONGINTTRUE */
#ifdef MATRIXTRUE
		case MATRIX: return einsp_matrix(a);
#endif /* MATRIXTRUE */
#ifdef REIHETRUE
		case REIHE: return einsp_reihe(a);
#endif /* REIHETRUE */
#ifdef PERMTRUE
		case PERMUTATION:  return einsp_permutation(a);
#endif /* PERMTRUE */
#ifdef POLYTRUE
		case POLYNOM:  return einsp_polynom(a);
		case GRAL:
		case MONOPOLY: return einsp_monopoly(a);
#endif
#ifdef SCHUBERTTRUE
		case SCHUBERT: return einsp_schubert(a);
#endif /* SCHUBERTTRUE */
#ifdef VECTORTRUE
		case INTEGERVECTOR:
			return einsp_integervector(a); 
		case VECTOR: return einsp_vector(a); 
#endif
#ifdef CHARTRUE
		case SYMCHAR: return einsp_symchar(a); 
#endif /* CHARTRUE */
		default:  return(FALSE);
		};
	ENDR("einsp");
	}

INT negeinsp(a) OP a;
/* AK 181289 V1.1 */ /* AK 250291 V1.2 */
/* AK 210891 V1.3 */
	{
        INT erg = OK;
        COP("negeinsp",a);

	switch (S_O_K(a))
		{
#ifdef INTEGERTRUE
		case INTEGER:  return(NEGEINSP_INTEGER(a));
#endif /* INTEGERTRUE */
#ifdef BRUCHTRUE
		case BRUCH:  return(negeinsp_bruch(a));
#endif /* BRUCHTRUE */
		default:  return(FALSE);
		};
        ENDR("negeinsp");
	}

INT vexillaryp(a,part) OP a,part;
/* AK 290986 */
/* part ist die Partition zugehoerig zur permutation */
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	switch(S_O_K(a))
		{
#ifdef PERMTRUE
		case PERMUTATION : erg+=vexillaryp_permutation(a,part);break;
#endif /* PERMTRUE */
		default: erg+= WTO("vexillary",a); break;
		};
	return erg;
	}

INT lastp(a) OP a;
/*  AK 250986 */ /* AK 280689 V1.0 */ /* AK 181289 V1.1 */
/* AK 200691 V1.2 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	switch(S_O_K(a)) {
#ifdef LISTTRUE
		case HOM_SYM : case POW_SYM : case GRAL : case POLYNOM : 	
		case MONOPOLY: case SCHUBERT : case SCHUR :  case ELM_SYM:
		case MONOMIAL: case LIST : 
			{
			return(lastp_list(a));
			/* AK 210688 */
			}
#endif /* LISTTRUE */
		default:  WTO("lastp",a);goto endr_ende;
		};
	ENDR("lastp");
	}
	
INT odd(a) OP a;
/* AK 210291 V1.2 */ /* AK 210891 V1.3 */
	{
	return not even(a);
	}

INT even(a) OP a;
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210291 V1.2 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	switch(S_O_K(a))
		{
#ifdef INTEGERTRUE
		case INTEGER : return even_integer(a);
#endif /* INTEGERTRUE */
#ifdef LONGINTTRUE
		case LONGINT : return even_longint(a);
#endif /* LONGINTTRUE */
#ifdef PARTTRUE
		case PARTITION : return even_partition(a); /* AK 300992 */
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION : return even_permutation(a); /* AK 010692 */
#endif /* PERMTRUE */
		default: WTO("even",a);goto endr_ende;
		};
	ENDR("even");
	}

INT negp(a) OP a;
/* AK 190888 */ /* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
/* AK V2.0 221298 */
/* true if a < 0 */
	{
	INT erg = OK;
	COP("negp",a);
	switch(S_O_K(a))
		{
#ifdef BRUCHTRUE
		case BRUCH : return negp_bruch(a);
#endif /* BRUCHTRUE */
#ifdef INTEGERTRUE
		case INTEGER : return negp_integer(a);
#endif /* INTEGERTRUE */
#ifdef LONGINTTRUE
		case LONGINT : return negp_longint(a);
#endif /* LONGINTTRUE */
#ifdef POLYTRUE		/* AK V2.0 221298 */
			/* true if all coeffs < 0 */
		case SCHUBERT:
		case GRAL:
		case SCHUR:
		case ELM_SYM:
		case POW_SYM:
		case HOM_SYM:
		case MONOMIAL:
		case MONOPOLY:
		case POLYNOM:
				return negp_polynom(a);
#endif /* POLYTRUE */

		default: WTO("negp",a);goto endr_ende;
		};

	ENDR("negp");
	}

INT posp(a) OP a;
/* AK 190888 */ /* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
/* AK 190298 V2.0 */
/* TRUE if >= 0 */
	{
	INT erg = OK;
	COP("posp",a);
	switch(S_O_K(a))
		{
#ifdef BRUCHTRUE
		case BRUCH : return posp_bruch(a) ;
#endif /* BRUCHTRUE */
#ifdef INTEGERTRUE
		case INTEGER : return POSP_INTEGER(a) ;
#endif /* INTEGERTRUE */
#ifdef LONGINTTRUE
		case LONGINT : return posp_longint(a) ;
#endif /* LONGINTTRUE */
#ifdef VECTORTRUE
		case INTEGERVECTOR:
		case VECTOR : return posp_vector(a) ;
#endif /* VECTORTRUE */
#ifdef POLYTRUE		/* AK V2.0 221298 */
			/* true if all coeffs >= 0 */
		case SCHUBERT:
		case GRAL:
		case SCHUR:
		case ELM_SYM:
		case POW_SYM:
		case HOM_SYM:
		case MONOMIAL:
		case MONOPOLY:
		case POLYNOM:
				return posp_polynom(a);
#endif /* POLYTRUE */
		default: 
			erg +=  WTO("posp",a); 
			goto endr_ende;
		};
	ENDR("posp");
	}

INT comp(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 281289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("comp",a);
	COP("comp",b);
	if (EMPTYP(a) && EMPTYP(b)) return(0L);
	else if (EMPTYP(a)) return(-1L);
	else if (EMPTYP(b)) return(1L);
	else switch(S_O_K(a)){
#ifdef BRUCHTRUE
		case BRUCH : return comp_bruch(a,b);
#endif /* BRUCHTRUE */
#ifdef FFTRUE
		case FF :	return comp_ff(a,b);
#endif /* FFTRUE */
#ifdef INTEGERTRUE
		case INTEGER : 
			if (S_O_K(b) == INTEGER)
				return ( S_I_I(a) > S_I_I(b) ? 1L : 
					 S_I_I(a) == S_I_I(b) ? 0L : -1L );
			else
			return comp_integer(a,b);
#endif /* INTEGERTRUE */
#ifdef LONGINTTRUE
		case LONGINT : return comp_longint(a,b);
#endif /* LONGINTTRUE */
#ifdef MATRIXTRUE
		case KRANZTYPUS :return comp_kranztafel(a,b);
		case MATRIX : return comp_matrix(a,b);
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
		case MONOM :	return comp_monom(a,b);
#endif /* MONOMTRUE */
#ifdef LISTTRUE
		case SCHUBERT:
		case GRAL:
		case SCHUR:
		case ELM_SYM:
		case POW_SYM:
		case HOM_SYM:
		case MONOMIAL:
		case MONOPOLY:
		case LIST : return comp_list(a,b);
		case POLYNOM:
				return comp_polynom(a,b);
#endif /* LISTTRUE */
#ifdef PARTTRUE
		case PARTITION: return comp_partition(a,b);
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION: return comp_permutation(a,b);
#endif /* PERMTRUE */
#ifdef REIHETRUE
		case REIHE: return comp_reihe(a,b);
#endif /* REIHETRUE */
#ifdef SKEWPARTTRUE
		case SKEWPARTITION: return comp_skewpartition(a,b);
#endif /* SKEWPARTTRUE */
#ifdef CHARTRUE
		case SYMCHAR: return comp_symchar(a,b);
#endif /* CHARTRUE */
#ifdef TABLEAUXTRUE
		case TABLEAUX :	/* 060588 */
			return comp_tableaux(a,b);
#endif /* TABLEAUXTRUE */
#ifdef WORDTRUE
		case WORD:/* AK 060588 */return COMP_WORD(a,b);
#endif /* WORDTRUE */
#ifdef VECTORTRUE
		case BITVECTOR: /* AK 200395 */
			return comp_bv(a,b);
		case COMP: 
		case VECTOR: 
			return comp_vector(a,b);
		case INTEGERVECTOR:
		case SUBSET:
			return comp_integervector(a,b);
#endif /* VECTORTRUE */
		default: return WTT("comp",a,b);
		}
	ENDR("comp");
	}

INT lt(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("lt",a);
	COP("lt",b);
	if (comp(a,b) < 0L) return(TRUE);
	return(FALSE);
	ENDR("lt");
	}

INT eq(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("eq",a);
	COP("eq",b);
	if (comp(a,b) == 0L) return(TRUE);
	return(FALSE);
	ENDR("eq");
	}

INT neq(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	if (comp(a,b) != 0L) return(TRUE);
	return(FALSE);
	}

INT gr(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	if (comp(a,b) > 0L) return(TRUE);
	return(FALSE);
	}

INT ge(a,b) OP a,b;
/* AK 260789 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	if (comp(a,b) >= 0L) return(TRUE);
	return(FALSE);
	}

INT gt(a,b) OP a,b;
/* AK 010889 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	if (comp(a,b) > 0L) return(TRUE);
	return(FALSE);
	}

INT le(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	if (comp(a,b) > 0L) return(FALSE);
	return(TRUE);
	}

INT listp(a) OP a;
/* AK 030789 V1.0 */ /* AK 160890 V1.1 */ /* AK 060891 V1.3 */
	{
	OBJECTKIND kind = S_O_K(a);
	if (	kind == LIST || 
		kind == POLYNOM || 
		kind == MONOPOLY || 
		kind == GRAL || 
		kind == HOM_SYM || 
		kind == POW_SYM || 
		kind == ELM_SYM || 
		kind == MONOMIAL || 
		kind == SCHUR || 
		kind == SCHUBERT
            ) return(TRUE);
	else return(FALSE);
	}
	    
#ifdef INTEGERTRUE
INT factorize_integer(a,b) OP a,b;
/* AK 060690 V1.1 */ /* AK 060891 V1.3 */
/* AK 220998 V2.0 */
/* input: INTEGER object a
   output:INTEGERVECTOR of prim factors */
{
	INT ai = S_I_I(a);
	INT i=2L;
	INT erg = OK;
	CTO(INTEGER,"factorize_integer",a);
	CE2(a,b,factorize_integer);
	if (not EMPTYP(b)) 
		erg += freeself(b);
	m_il_v((INT)0,b);
	while (i <= ai) 
		{
		if (ai % i == 0L) {
			erg += inc(b);
			erg += m_i_i(i,S_V_I(b,S_V_LI(b)-1L));
			ai = ai / i; continue; }
		i++;
		}
	ENDR("factorize_integer");
}
#endif /* INTEGERTRUE */


#ifdef BRUCHTRUE
INT invers_apply_integer(a) OP a;
/* AK 140591 V1.2 */ /* AK 060891 V1.3 */
	{ 
	return m_ioiu_b(1L, S_I_I(a), a);
	}
#endif /* BRUCHTRUE */

INT addinvers_apply_integer(a) OP a;
/* AK 201289 V1.1 */ /* AK 140591 V1.2 */ /* AK 060891 V1.3 */
	{ 
	M_I_I(- S_I_I(a), a);
	return OK;  
	}


INT addinvers_integer(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 131289 V1.1 */ /* AK 060891 V1.3 */
	{ 
	M_I_I(- S_I_I(a), b);
	return OK;  
	}

INT inc_integer(a) OP a;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{ 
	C_I_I(a,S_I_I(a)+1L); 
	return(OK); 
	}

INT dec_integer(a) OP a;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{ 
	C_I_I(a,S_I_I(a)-1L); 
	return(OK); 
	}

INT mult_integer_integer(a,b,d) OP a,b,d;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{
	INT l,erg = OK;
	l=intlog(a) + intlog(b);
	if ( l> 7L) 
			{
#ifdef LONGINTTRUE
			OP c= callocobject(); 
			OP e= callocobject(); 
			erg += t_int_longint(b,e);
			erg += t_int_longint(a,c);
			erg += mult_longint_longint(c,e,d); 
			erg += freeall(c); 
			erg += freeall(e);
#else /* LONGINTTRUE */
			erg += error("mult_integer_integer:no LONGINT");
#endif /* LONGINTTRUE */
			goto m1;
			}

	M_I_I(S_I_I(a)*S_I_I(b),d);
m1:
	ENDR("mult_integer_integer");
	}

INT mult_integer(a,b,d) OP a,b,d;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{
	INT erg=OK;
	OP c;

	CTO(INTEGER,"mult_integer",a);
	switch(S_O_K(b)) {
#ifdef BRUCHTRUE
		case BRUCH: erg += mult_bruch_integer(b,a,d);break;
#endif /* BRUCHTRUE */
		case INTEGER: erg += mult_integer_integer(a,b,d);break;
#ifdef LONGINTTRUE
		case LONGINT: erg += mult_longint_integer(b,a,d);break;
#endif /* LONGINTTRUE */
#ifdef MATRIXTRUE
		case KRANZTYPUS :
		case MATRIX:  erg += mult_scalar_matrix(a,b,d);break;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
		case MONOM: erg += mult_scalar_monom(a,b,d);break;
#endif /* MONOMTRUE */
#ifdef POLYTRUE
		case POW_SYM:
		case ELM_SYM:
		case HOM_SYM:
		case MONOMIAL:
		case SCHUR:
		case SCHUBERT:
		case GRAL:
		case POLYNOM: erg += mult_scalar_polynom(a,b,d);break;
#endif /* POLYTRUE */
#ifdef LAURENTTRUE
		case LAURENT:
			c = callocobject();
			erg += t_INTEGER_LAURENT(a,c);
			erg += mult_laurent(c,b,d);
			erg += freeall(c);
			break;
#endif /* LAURENTTRUE */
#ifdef CHARTRUE
		case SYMCHAR: erg += mult_scalar_symchar(a,b,d);break;
#endif /* CHARTRUE */
#ifdef VECTORTRUE
		case INTEGERVECTOR:
		case VECTOR: erg += mult_scalar_vector(a,b,d);break;
#endif /* VECTORTRUE */
#ifdef PERMTRUE
		case PERMUTATION:
			if (NULLP_INTEGER(a)) 
				erg+= m_i_i(0L,d); 
			else 
			{
			printobjectkind(b);
			erg += error("mult_integer:wrong second kind");
			}
			break;
#endif /* PERMTRUE */
#ifdef FFTRUE
		case FF:
			erg += cast_apply_ff(a);
			erg += mult_ff(a,b,d);
			break;
#endif /* FFTRUE */
		default:
			{
			printobjectkind(b);
			error("mult_integer:wrong second kind");
			return(ERROR);
			}
		}
	ENDR("mult_integer");
	}

INT even_integer(a) OP a;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{ 
	return(S_I_I(a) %2L == 0L); 
	}

INT posp_integer(a) OP a;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{ 
	return(S_I_I(a) >= (INT) 0);
	}

INT negp_integer(a) OP a;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{ 
	return(S_I_I(a) < 0L); 
	}

INT mod_integer(a,b,c) OP a,b,c;
	{
	INT erg = OK;
	erg += m_i_i(S_I_I(a) % S_I_I(b),c);
	ENDR("mod_integer");
	}

INT add_integer_integer(a,b,c) OP a,b,c;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{
	if 	((S_I_I(b) >1000000L)|| (S_I_I(b) < -1000000L))
		{
#ifdef LONGINTTRUE
		OP d = callocobject(); 
		m_i_longint(S_I_I(b),d);
		add(a,d,c); 
		freeall(d); 
		return(OK);
#else /* LONGINTTRUE */
		return error("add_integer_integer:overflow no LONGINT");
#endif /* LONGINTTRUE */
		};
	M_I_I(S_I_I(a)+S_I_I(b),c);
	return OK;
	}

INT add_integer(a,b,c) OP a,b,c;
/* das erste object ist vom typ INTEGER, das ergebnis ist ein leere
object */
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */ /* AK 280291 V1.2 */
/* AK 060891 V1.3 */
	{
	INT erg = OK;
#ifdef LONGINTTRUE
	if ( (S_I_I(a) >1000000L) || (S_I_I(a) < -1000000L))
		{
		OP d = callocobject(); 
		erg += m_i_longint(S_I_I(a),d);
		erg += add(d,b,c); 
		erg += freeall(d); 
		goto aiende;
		}
#endif /* LONGINTTRUE */

	switch(S_O_K(b))
		{
#ifdef BRUCHTRUE
		case BRUCH: erg += add_bruch_scalar(b,a,c); break;
#endif /* BRUCHTRUE */
		case INTEGER: erg += add_integer_integer(a,b,c); break;
#ifdef LONGINTTRUE
		case LONGINT: erg += add_longint(b,a,c); break;
#endif  /* LONGINTTRUE */
#ifdef POLYTRUE   /* AK 060891 */
		case POLYNOM: erg += add_scalar_polynom(a,b,c); break;
#endif /* POLYTRUE */
		default :
			{
			if (NULLP_INTEGER(a)) 
				{
				erg += copy(b,c);
				goto aiende;
				}
			erg += WTT("add_integer",a,b);
			};
		}
aiende:
	ENDR("add_integer");
	}

INT comp_integer_integer(a,b) OP a,b;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
/* AK 281098 V2.0 */
	{
	INT ai = S_I_I(a);
	INT bi = S_I_I(b);
	if (ai == bi) return(0L);
	if (ai > bi) return(1L);
	return(-1L);
	}

INT comp_integer(a,b) OP a,b; 
/* AK 280888 */ /* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
/* AK 040298 V2.0 */
/* a is of type INTEGER
   type of b is from
		BRUCH, INTEGER, LONGINT, POLYNOM */
	{
	INT erg = OK;
	CTO(INTEGER,"comp_integer",a);
	switch (S_O_K(b))
		{
#ifdef BRUCHTRUE
		case BRUCH: return -1 * comp_bruch_scalar(b,a);
#endif /* BRUCHTRUE */
		case INTEGER:return COMP_INTEGER_INTEGER(a,b); 
#ifdef LONGINTTRUE
		case LONGINT: return -1 * comp_longint(b,a);
#endif /* LONGINTTRUE */
#ifdef POLYTRUE
		case POLYNOM: return -1 * comp_polynom_scalar(b,a);
#endif /* POLYTRUE */
		default:
			 WTT("comp_integer",a,b);goto endr_ende;
		}
	ENDR("comp_integer");
	} 



INT quores_integer(a,b,c,d) OP a,b,c,d;
/* AK 280888 */ /* AK 270689 V1.0 */ /* AK 081289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	switch(S_O_K(b))
		{
		case INTEGER: 
			{
			M_I_I(S_I_I(a) / S_I_I(b), c);
                        M_I_I(S_I_I(a) % S_I_I(b), d);
			if ((S_I_I(d) < 0L) && (S_I_I(b) < 0L))
				{
				M_I_I(S_I_I(d)-S_I_I(b),d);
				erg += inc(c);
				}
			if ((S_I_I(d) < 0L) && (S_I_I(b) > 0L))
				{
				M_I_I(S_I_I(d)+S_I_I(b),d);
				erg += dec(c);
				}
			goto endr_ende;
			}
#ifdef LONGINTTRUE
		case LONGINT:
			{
			OP e = callocobject(); 
			erg += m_i_longint(S_I_I(a),e);
			erg += quores_longint(e,b,c,d);
			erg += freeall(e);
			goto endr_ende;
			};
#endif /* LONGINTTRUE */
		default: WTT("quores_integer",a,b); goto endr_ende;
		}
	ENDR("quores_integer");
	}

INT nullp_integer(a) OP a;
/* AK 280689 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{ 
	INT erg = OK;
	CTO( INTEGER,"nullp_integer",a);
	return(S_I_I(a) == 0L); 
	ENDR("nullp_integer");
	}

INT einsp_integer(a) OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{ 
	INT erg = OK;
	CTO( INTEGER,"einsp_integer",a);
	return(S_I_I(a) == 1L); 
	ENDR("einsp_integer");
	}

INT negeinsp_integer(a) OP a;
/* AK 070789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{ 
	INT erg = OK;
	CTO( INTEGER,"negeinsp_integer",a);
	return(S_I_I(a) == -1L); 
	ENDR("negeinsp_integer");
	}

INT copy_integer(a,b) OP a,b;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{ 
	INT erg = OK;
	CTO( INTEGER,"copy_integer",a);
	M_I_I(S_I_I(a),b);
	return OK;
	ENDR("copy_integer");
	}
	
#ifdef BRUCHTRUE
INT invers_integer(a,b) OP a,b;
/* AK 031286 */ /* AK 220888 gilt auch bei longint */
/* AK 270689 V1.0 */ /* AK 151289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	CTO(INTEGER,"invers_integer",a);
	if (EINSP_INTEGER(a)) 
		{
		erg += copy(a,b);
		goto endr_ende;
		}
	if (NEGEINSP_INTEGER(a)) 
		{
		erg += copy(a,b);
		goto endr_ende;
		}
	erg += m_ou_b(cons_eins,a,b);
	ENDR("invers_integer");
	}
#endif  /* BRUCHTRUE */


INT random_integer(res,para_eins,para_zwei) OP res,para_eins,para_zwei; 
/* AK 150587 */ /* AK 090688 geaendert, angepasst an random */
/* para_eins = untergrenze, para_zwei= obergrenze */
/* ergibt zufallszahl zwischen untergrnze <
ergebnis < obergrenze */
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT untergrenze,obergrenze;
	INT erg = OK;

	if (para_eins==NULL) untergrenze=0L;
	else if (S_O_K(para_eins) != INTEGER)
		{
		WTT("random_integer",para_eins,para_zwei);
		goto endr_ende;
		}
	else untergrenze = S_I_I(para_eins);


	if (para_zwei==NULL) obergrenze=untergrenze + 10L;
	else if (S_O_K(para_zwei) != INTEGER)
		{
#ifdef LONGINTTRUE
		if (S_O_K(para_zwei)==LONGINT) /* AK 151092 */
			{
			OP c = callocobject();
			erg += copy(para_zwei,c);
			if (para_eins != NULL) 
				erg += sub(c,para_eins,c);
			
			if (S_O_K(c) == LONGINT)
				erg += random_longint(res,c);
			else	{
				erg += random_integer(res,NULL,c);
				}
			if (para_eins != NULL) 
				erg += add_apply(para_eins,res);
			freeall(c);
			goto endr_ende;
			}
		else
#endif /* LONGINTTRU */
			{
			printobjectkind(para_zwei);
			erg += error("para_zwei != INTEGER in randominteger");
			goto endr_ende;
			}
		}
	else obergrenze = S_I_I(para_zwei);

	erg += m_i_i( untergrenze + (INT)(
		  ( (rand()%32767)/32767.0 )
		* (obergrenze - untergrenze)
			) ,res);
	ENDR("random_integer");
	}

INT tex_integer(a) OP a;
/* AK 101187 */ /* AK 270689 V1.0 */ /* AK 181289 V1.1 */
/* AK 070291 V1.2 prints to texout instead of stdout */
/* AK 210891 V1.3 */
	{
	INT ts = texmath_yn; /* AK 190892 */
	texposition +=  /* AK 210291 */ intlog(a);
	if (S_I_I(a) <0L) texposition++; 
	if (ts == 0L)
	{
		fprintf(texout," $%ld$ ",S_I_I(a)); 
		texposition += 4L;
	}
	else
		fprintf(texout," %ld ",S_I_I(a)); 
	return OK;
	}


INT scan_integer(ergebnis) OP ergebnis;
/* liest ein integerobject ein AK 270787 */
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 080591 V1.2 */
/* AK 210891 V1.3 */
	{
	char c;
	INT eingabe,erg = OK;
	INT numberofmatches;

sia:
	scan_printeingabe("integerobject ");
	skip_comment();
	numberofmatches = (INT)scanf("%ld",&eingabe);
	if (numberofmatches != (INT)1) 
		{
		while ((c = getchar()) != '\n');
		error("scan_integer:I did not recognize a number");
		goto sia;
		}
	M_I_I(eingabe,ergebnis);
	ENDR("scan_integer");
	}

INT skip_integer(t)  char *t;
/* AK 300998 */
{
	INT erg = OK;
	char *oldt = t;

	while (*t == ' ') t++;
	if (*t == '-') t++;
	if (not isdigit(*t))
		{
		error("skip_integer:not a INTEGER");
		erg = -10;
		goto endr_ende;
		}
	while (isdigit(*t)) t++;
	return (INT)(t-oldt);
	ENDR("skip_integer");
}

INT sscan_integer(t,a) OP a; char *t;
/* AK 301293 */
{
	long i;
	sscanf(t,"%ld",&i);
	m_i_i((INT)i,a);
	return OK;
}

INT objectread_integer(filename,obj) FILE *filename; OP obj;
/* AK 131086 */ /* AK 270689 V1.0 */ /* AK 181289 V1.1 */
/* AK 020591 V1.2 */ /* AK 210891 V1.3 */
	{
	INT eingabe;
	INT erg = OK;
	fscanf(filename,"%ld",&eingabe); 
	M_I_I(eingabe,obj); 
	ENDR("objectread_integer");
	}

INT objectwrite_integer(filename,obj) FILE *filename; OP obj;
/* AK 131086 */ /* AK 270689 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{ 
	INT erg = OK;
	fprintf(filename," %ld %ld\n",(INT)INTEGER,S_I_I(obj)); 
	ENDR("objectwrite_integer");
	}

INT sprint_integer(string,a) char *string; OP a;
/* AK 020295 */
/* AK 240398 V2.0 */
	{
	INT erg = OK;
	CTO(INTEGER,"sprint_integer",a);
	sprintf(string,"%ld",S_I_I(a)); 
	ENDR("sprint_integer");
	}

INT fprint_integer(f,a) FILE *f; OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
/* AK 190298 V2.0 */
	{
	INT erg = OK,length;
	CTO(INTEGER,"fprint_integer",a);
	if (f == NULL)
		{
		erg += error("fprint_integer:NULL file pointer");
		goto endr_ende;
		}
	if (f == stdout) 
		{ 
		length = intlog(a);
		zeilenposition +=  length;

		if (length < integer_format) 
			{
			/* we need leading blanks */
			length = integer_format-length;
			zeilenposition +=  length;
			while (length--) putchar(' ');
			}
		if (S_I_I(a) < (INT)0) 
			zeilenposition++;  /* for the leading sign */
		}
	fprintf(f,"%ld",S_I_I(a)); 
	if (f == stdout) 
		if (zeilenposition >= row_length)
			{
			fprintf(f,"\n");
			zeilenposition = (INT)0;
		}
	ENDR("fprint_integer");
	}

INT s_i_i(a) OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{ 
	INT erg = OK;
	CTO(INTEGER,"s_i_i",a);
	return a->ob_self.ob_INT; 
	ENDR("s_i_i");
	}

INT c_i_i(a,b) OP a;INT b;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	CTO(INTEGER,"c_i_i",a);
	a->ob_self.ob_INT=b;
        ENDR("c_i_i");
	}

INT m_i_i(a,b) INT a;OP b;
/* AK 270689 V1.0 AK 181289 V1.1 AK 110291 V1.2 AK 060891 V1.3 */
	{  
	INT erg=OK;
	COP("m_i_i",b);
	erg += freeself(b);
	C_O_K(b,INTEGER); 
	C_I_I(b,a); 
	ENDR("m_i_i");
	}

INT freeself_integer(a) OP a;
/* AK 270689 V1.0 AK 181289 V1.1 AK 210891 V1.3 */
	{ 
	C_O_K(a,EMPTY); 
	return(OK); 
	}

INT test_integer()
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	OP a=callocobject();
	OP b=callocobject();
	OP c=callocobject();
	INT erg;

	m_i_i(5L,a);
	printf("test_integer:m_i_i(5L,a)\n"); 
	debugprint_object(a);
	C_I_I(a,7L);
	printf("test_integer:c_i_i(a,7L)\n"); 
	debugprint_object(a);
	printf("test_integer:fprint_integer(stdout,a)\n"); 
	fprint_integer(stdout,a);
	printf("\n");
	printf("test_integer:tex_integer(a)\n"); 
	tex_integer(a);
	printf("\n");
	printf("test_integer:copy_integer(a,b)\n"); 
	copy_integer(a,b);
	printf("b=");
	println(b);
	printf("test_integer:comp_integer_integer(a,b)\n");
	erg=comp_integer_integer(a,b);
	printf("%ld\n",erg);
	printf("test_integer:binom(a=5L,b=4L,c)\n");
	m_i_i(5L,a); 
	m_i_i(4L,b); 
	binom(a,b,c); 
	println(c);
	freeall(a);
	freeall(b);
	freeall(c);
	return(OK);
	}

#ifdef POLYTRUE 
INT add_apply_scalar_polynom(a,b) OP a,b;
/* AK 110990 V1.1 */ /* AK 270291 V1.2 */ /* AK 080891 V1.3 */
/* AK 260298 V2.0 */
/* input: a = INTEGER or 
              BRUCH or 
              LONGINT */
{
	INT erg = OK;
	OP c;
	CE2A(a,b,add_apply_scalar_polynom);
	c = callocobject();
	erg += m_scalar_polynom(a,c);
	erg += add_apply(c,b);
	erg += freeall(c);
	ENDR("add_apply_scalar_polynom");
}
#endif /* POLYTRUE */

INT add_apply_integer(a,b) OP a,b;
/* AK 120390 V1.1 */ /* AK 080891 V1.3 */
/* AK 260298 V2.0 */
{
	INT erg=OK;
	OP d;
	CE2A(a,b,add_apply_integer);
	switch(S_O_K(b)) {
#ifdef BRUCHTRUE 
		case BRUCH:  
			erg += add_apply_scalar_bruch(a,b);
			break;
#endif /* BRUCHTRUE */
		case INTEGER: 
			erg += add_apply_integer_integer(a,b);
			break;
#ifdef LONGINTTRUE 
		case LONGINT: 
			erg += add_apply_integer_longint(a,b);
			break;
#endif /* LONGINTTRUE */
#ifdef POLYTRUE
		case SCHUR:
			d = callocobject();
			erg += m_scalar_schur(a,d);
			erg += add_apply(d,b);
			erg += freeall(d);
			break;
		case SCHUBERT:
		case POLYNOM:
			erg += add_apply_scalar_polynom(a,b);
			break;
#endif /* POLYTRUE */
		default: 
			{
			OP c;
			c = callocobject();
			*c = *b;
			C_O_K(b,EMPTY);
			erg += add(a,c,b);
			erg += freeall(c); 
			}
			break;
		}
	ENDR("add_apply_integer");
}	


#ifdef MATRIXTRUE
INT mult_apply_integer_matrix(a,b) OP a,b;
/* b = b* a */ /* AK 220390 V1.1 */ /* AK 250291 V1.2 */
/* AK 080891 V1.3 */
/* AK 260298 V2.0 */
	{
	OP z = S_M_S(b);
	INT i = S_M_HI(b)*S_M_LI(b);
	INT erg = OK;
	CE2A(a,b,mult_apply_integer_matrix);

	for(;i>0L;i--,z++) 
		erg += mult_apply_integer(a,z);
	ENDR("mult_apply_integer_matrix");
	}
#endif /* MATRIXTRUE */

#ifdef BRUCHTRUE
INT mult_apply_integer_bruch(a,b) OP a,b;
/* b = b* a */ /* AK 220390 V1.1 */ /* AK 250291 V1.2 */
/* AK 210891 V1.3 */
/* AK 260298 V2.0 */
	{
	INT erg = OK;
	CE2A(a,b,mult_apply_integer_bruch);
	erg += mult_apply_integer(a,S_B_O(b));
	C_B_I(b,NGEKUERZT);
	erg += kuerzen(b);
	ENDR("mult_apply_integer_bruch");
	}
#endif /* BRUCHTRUE */

INT mult_apply_integer(a,b) OP a,b;
/* b = b* a */ /* AK 201289 V1.1 */ /* AK 250291 V1.2 */
/* AK 210891 V1.3 */
/* AK 260298 V2.0 */
{
	INT erg = OK,i;
	CE2A(a,b,mult_apply_integer);
	switch(S_O_K(b)) {
#ifdef BRUCHTRUE
		case BRUCH:
			erg += mult_apply_integer_bruch(a,b);
			break;
#endif /* BRUCHTRUE */
		case INTEGER:
			erg += mult_apply_integer_integer(a,b);
			break;
#ifdef LONGINTTRUE
		case LONGINT:
			erg += mult_apply_integer_longint(a,b);
			break;
#endif /* LONGINTTRUE */
		case KRANZTYPUS :
#ifdef MATRIXTRUE
		case MATRIX:
			erg += mult_apply_integer_matrix(a,b);
			break;
#endif /* MATRIXTRUE */
#ifdef CHARTRUE
		case SYMCHAR:
			erg += mult_apply_scalar_symchar(a,b);
                        break;
#endif /* CHARTRUE */
#ifdef POLYTRUE
		case MONOM:
			erg += mult_apply_scalar_monom(a,b);
			break;
		case SCHUR:
		case POW_SYM:
		case ELM_SYM:
		case HOM_SYM:
		case MONOMIAL:
		case SCHUBERT:
		case GRAL:
		case POLYNOM:
		case MONOPOLY:
			erg += mult_apply_scalar_polynom(a,b);
			break;
#endif /* POLYTRUE */
#ifdef NUMBERTRUE
		case SQ_RADICAL:
			erg +=  mult_apply_scalar_sqrad(a,b);
			break;
		case CYCLOTOMIC:
			erg += mult_apply_scalar_cyclo(a,b);
			break;
#endif /* NUMBERTRUE */
#ifdef VECTORTRUE 
		case VECTOR:
			erg += mult_apply_scalar_vector(a,b);
			break;
#endif /* VECTORTRUE */
		default: 
			if (S_I_I(a) == (INT)1) { }
			else if (S_I_I(a) == (INT)-1)
				{
				erg += addinvers_apply(b);
				}
			else
				erg += WTO("mult_apply_integer: wrong second type",b);
		}
	ENDR("mult_apply_integer");
}

INT mult_apply_integer_integer(a,b) OP a,b;
/* AK 201289 V1.1 */ /* AK 250291 V1.2 */
/* AK 210891 V1.3 */
/* AK 270298 V2.0 */
{ 
	OP c;
	INT l,erg = OK;;
	if ( 
		(S_I_I(a) < 10000L) && (S_I_I(a) > -10000L)
		&&
		(S_I_I(b) < 10000L) && (S_I_I(b) > -10000L)
	    )  
		return( M_I_I(S_I_I(a)*S_I_I(b),b) ); 
	else
		l=intlog(a) + intlog(b);
	if ( l > 8L )
		{
		t_int_longint(b,b);
		return mult_apply_integer_longint(a,b);
		}
	else 
		return( M_I_I(S_I_I(a)*S_I_I(b),b) ); 
}


INT add_apply_integer_integer(a,b) OP a,b;
/* AK 120390 V1.1 */ /* AK 250291 V1.2 */ /* AK 210891 V1.3 */
/* AK 270298 V2.0 */
{ 
	INT erg = OK;
	if ( 
		(S_I_I(a) >1000000L) ||  (S_I_I(b) > 1000000L) ||
		(S_I_I(a) < -1000000L) ||  (S_I_I(b) < -1000000L) )
		{
#ifdef LONGINTTRUE
		OP c;
		c = callocobject();
		erg += t_int_longint(b,c);
		erg += freeself(b);
		*b = *c; 
		C_O_K(c,EMPTY);
		erg += freeall(c);
		erg += add_apply_integer_longint(a,b);
#else /* LONGINTTRUE */
		erg += error("add_apply_integer_integer:Overflow no LONGINT");
#endif /* LONGINTTRUE */
		}
	else	{
		C_I_I(b,	S_I_I(a)+S_I_I(b)	); 
		}
	ENDR("add_apply_integer_integer");
}

INT intlog(a) OP a;
/* anzahl stellen */ /* AK 150290 V1.1 */ /* AK 250291 V1.2 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	INT ai;
	CTO(INTEGER,"intlog",a);
	ai = S_I_I(a);
	if (ai < 0L) ai = -ai;
	if (ai >= 1000000000L) return(10L);
	if (ai >= 100000000L) return(9L);
	if (ai >= 10000000L) return(8L);
	if (ai >= 1000000L) return(7L);
	if (ai >= 100000L) return(6L);
	if (ai >= 10000L) return(5L);
	if (ai >= 1000L) return(4L);
	if (ai >= 100L) return(3L);
	if (ai >= 10L) return(2L);
	return(1L);
	ENDR("intlog");
	}

INT init(kind,a) OBJECTKIND kind; OP a;
/* AK 300588 */ /* AK 030789 V1.0 */ /* AK 060390 V1.1 */ /* AK 250291 V1.2 */
/* AK 050891 V1.3 */
	{
	INT erg=OK;
	if (not EMPTYP(a)) 
		erg += freeself(a);
	switch (kind) {
		case EMPTY:
				break;
#ifdef BINTREETRUE
		case BINTREE: erg +=  init_bintree(a); break;
#endif /* BINTREETRUE */
#ifdef BRUCHTRUE
		case BRUCH: erg += b_ou_b(callocobject(),callocobject(),a);
				break;
#endif /* BRUCHTRUE */
		case INTEGER: break;
#ifdef KRANZTRUE
		case KRANZ:  erg+= init_kranz(a);
			break;
#endif /* KRANZTRUE */
#ifdef LONGINTTRUE
		case LONGINT: erg += init_longint(a); break;
#endif /* LONGINTTRUE */
#ifdef MONOMTRUE
		case MONOM: erg += b_sk_mo(callocobject(),callocobject(),a);
				break;
#endif /* MONOMMTRUE */
#ifdef NUMBERTRUE 
		case CYCLOTOMIC: 
			erg += init_cyclo(a);
			break;
		case SQ_RADICAL:
			/* MD */
			erg += init_sqrad(a);
			break;
#endif /* NUMBERTRUE */
#ifdef PARTTRUE
		case PARTITION: 
			erg+= b_ks_pa(VECTOR,callocobject(),a);break;
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION: 
			erg+=b_ks_p(VECTOR,callocobject(),a);break;
#endif /* PERMTRUE */
#ifdef REIHETRUE
		case REIHE: erg+=init_reihe(a);break;
#endif /* REIHETRUE */
#ifdef LISTTRUE
		case GRAL: case POW_SYM: case HOM_SYM: case MONOPOLY:
		case POLYNOM: case ELM_SYM: case MONOMIAL: case SCHUBERT: 
		case SCHUR:  case LIST: 
			erg += b_sn_l(NULL,NULL,a);
			C_O_K(a,kind); 
			break;
#endif /* LISTTRUE */
#ifdef TABLEAUXTRUE
		case TABLEAUX:
			erg+=b_us_t(callocobject(),callocobject(),a); break;
#endif /* TABLEAUXTRUE */
#ifdef VECTORTRUE  
		case BITVECTOR:
			erg += m_il_bv((INT)0,a);break;
		case INTEGERVECTOR:
		case WORD: 
		case VECTOR: 
		case COMP: 
		case SUBSET:
			erg += m_il_v((INT)0,a);
			C_O_K(a,kind);
			break;
#endif /* VECTORTRUE */
		default: 
			fprintf(stderr,"kind = %ld\n",(INT) kind);
			return error("init:wrong kind");
		}
	
	ENDR("init");
}

INT next_apply(obj) OP obj;
/* AK 300997 */
	{
	INT erg = OK;
	switch(S_O_K(obj))
		{
#ifdef PARTTRUE
		case COMP:
			return((next_apply_composition(obj)
				== 
				LASTCOMP)?
						FALSE : TRUE);
		case PARTITION: {
			return((next_partition_apply(obj) 
				== 
				LASTPARTITION)?
						FALSE : TRUE);
			}
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION: return next(obj,obj);
#endif /* PERMTRUE */
		default: 
			erg+= WTO("next_apply",obj);
			break;
		}
	ENDR("next_apply");
	}

INT next(von,nach) OP von, nach;
/* AK 220488 */ /* AK 030789 V1.0 */ /* AK 081289 V1.1 */ /* AK 250291 V1.2 */
/* AK 050891 V1.3 */
	{
	INT erg = OK;

	EOP("next",von);
	/* nicht CE2 wg. return value */
	if (check_equal_2(von,nach,next,&erg) == EQUAL)
                return erg;

	switch(S_O_K(von))
		{
#ifdef FFTRUE
		case FF: /* AK 170194 */
			erg = next_ff(von,nach);
			if (erg == ERROR)
				goto endr_ende;
			return (erg == LAST_FF ? FALSE : TRUE );
#endif /* FFTRUE */
#ifdef PARTTRUE
		case PARTITION: {
			return((next_partition(von,nach) 
				== 
				LASTPARTITION)?
						FALSE : TRUE);
			}
		case COMP: {
			return((next_composition(von,nach) 
				== 
				LASTCOMP)?
						FALSE : TRUE);
			}
		case SUBSET: {
			return((next_subset(von,nach) 
				== 
				LASTSUBSET)?
						FALSE : TRUE);
			}
#endif /* PARTTRUE */
#ifdef PERMTRUE
		case PERMUTATION: {
			if (S_P_K(von) == BAR)
			return((next_bar(von,nach) == LASTPERMUTATION)?
				FALSE : TRUE);
			else if (S_P_K(von) == VECTOR)
			return((next_permutation(von,nach) == LASTPERMUTATION)?
				FALSE : TRUE);
			else
				return error("next: wrong kind of permutation");
			}
#endif /* PERMTRUE */
		default: erg+= WTO("next",von);
			break;
		}
	ENDR("next");
	}



INT insert(a,c,eh,cf) OP a,c; INT (*eh)(),(*cf)();
/* AK 221286*/ /* AK 030789 V1.0 */ /* AK 221289 V1.1 */ /* AK 250291 V1.2 */
/* AK 060891 V1.3 */
/* inserts a into c */
/* AK 060498 V2.0 */
	{
	INT erg = OK;
	if (a == NULL) 
		{
		erg += error("insert:first == NULL");
		goto endr_ende;
		}
	if (a == c) 
		{
		erg += error("insert:first == ERGEBNIS");
		goto endr_ende;
		}
	if (EMPTYP(a))  
		{
		erg += freeall(a);
		goto endr_ende;
		}
		

	switch(S_O_K(c))
		{
#ifdef VECTORTRUE
		case HASHTABLE:
			erg = insert_hashtable(a,c, eh,cf,hash);
			goto endr_ende;
#endif
#ifdef BINTREETRUE
		case BINTREE: 
			erg = insert_bintree(a,c, eh,cf);
			switch (erg) {
				case INSERTOK:
				case INSERTEQ:
					return erg;
					}
			goto endr_ende;
#endif /* BINTREETRUE */
#ifdef LISTTRUE
		case LIST: 
			erg += insert_list(a,c,eh,cf);
			goto endr_ende;
#endif /* LISTTRUE */
		case MONOPOLY: 
		case SCHUR: 
		case SCHUBERT: 
		case POW_SYM: 
		case HOM_SYM: 
		case GRAL: 
		case POLYNOM: 
		case ELM_SYM:
		case MONOMIAL:
#ifdef LISTTRUE
			if (cf == NULL)
				cf= comp_monomvector_monomvector;
			if (eh == NULL)
				eh = add_koeff;
			erg += insert_list(a,c, eh,cf);
			goto endr_ende;
#endif /* LISTTRUE */
		default:
			;
		};

	switch(S_O_K(a))
		{
#ifdef POLYTRUE
		case GRAL: 
		case HOM_SYM: 
		case POW_SYM: 
		case MONOPOLY:
		case SCHUBERT: 
		case SCHUR: 
		case POLYNOM: 
		case ELM_SYM:
		case MONOMIAL:
			if (cf == NULL)
				cf= comp_monomvector_monomvector;
			if (eh == NULL)
				eh = add_koeff;
			erg += insert_list(a,c, eh,cf);
			goto endr_ende;
#endif /* POLYTRUE */
		default: 
			erg += WTT("insert",a,c); 
			goto endr_ende;
		};
	ENDR("insert");
	}


INT first(kind,res,para_eins) OBJECTKIND kind; OP res,para_eins;
/* AK 270788 */ /* AK 030789 V1.0 */ /* AK 060390 V1.1 */ /* AK 200691 V1.2 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	CE2(res,para_eins,first);
	if (not EMPTYP(res)) 
		erg += freeself(res);
	switch (kind)
		{
#ifdef PERMTRUE
		case PERMUTATION:  erg += first_permutation(para_eins,res);
			break; 
#endif /* PERMTRUE */
#ifdef PARTTRUE
		case PARTITION:  erg += first_partition(para_eins,res);
			break; 
#endif /* PARTTRUE */
		default: return error("first:wrong kind");
		};
	ENDR("first");
	}

INT b_ks_o(kind,self,object) OBJECTKIND kind; OBJECTSELF self; OP object;
/* build_kind_self_object */ /* AK 061086 */
/* erzeugt ein object der art kind (z.B. VECTOR)
und einen pointer auf self, das eigentliche
object (z.B. struct vector) 270787/ */
/* AK 270689 V1.0 */ /* AK 060390 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("b_ks_o",object);
	if (not EMPTYP(object))
		erg += freeself(object);
	C_O_K(object,kind); 
	C_O_S(object,self); 
	ENDR("b_ks_o");
	}


/* must be with offset */ INT (*check_time_co)();


INT check_time()
{ 
	static INT l_callocobject;
	if (check_time_co != NULL)
		{
		(*check_time_co)();
		}
	runtime(&l_callocobject);
	if (l_callocobject > sym_timelimit)
		{
		fprintf(stderr,"SYMMETRICA stopped due to timelimit\n");
		exit(ERROR_TIMELIMIT);
		}
	return OK;
}

#ifdef MEMCHECK
OP callocobject_trace()
{
	OP res = callocobject();
	int i;
        for (i=0;i<MEMTRACENUMBER;i++)
                {
                if (callocobject_trace_pointer[i]==NULL)
                        {
                        printf("callocobject traced %d \n",res);
                        callocobject_trace_pointer[i]=res;
                        return res;
                        }
                }
        error("no trace space left in callocobject");
}
#endif /* MEMCHECK */
OP callocobject()
/* erzeugt den speicherplatz fuer ein object 270787 */
/* AK 270689 V1.0 */ /* AK 170190 V1.1 */ /* AK 060891 V1.3 */
	{
	OP c;
	if (sym_timelimit > 0L)
		check_time();

	if (speicherposition >= 0L) /* AK 111091 */
		{
		c = speicher[speicherposition--];
#ifdef MEMDEBUG
		printf("speicher(get):%ld\n",c);
#endif /* MEMDEBUG */
		}
	else

		c = (OP) SYM_malloc(sizeof(struct object));

	if (c == NULL) 
		error("callocobject:NULL object");
#ifdef MEMCHECK
	mem_callocobject_inc();
#endif /* MEMCHECK */
	C_O_K(c,EMPTY);
	return c;
	}

OBJECTSELF s_o_s(a) OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 060891 V1.3 */
	{
	if (a==NULL) 
		{
		error("s_o_s:object == NULL");
		}
	return(a->ob_self);
	}

OBJECTKIND s_o_k(a) OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	if (a==NULL) {return((OBJECTKIND) error("s_o_k:object == NULL"));}
	return(a->ob_kind);
	}

INT c_o_k(a,b) OP a; OBJECTKIND b;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("c_o_k",a);
	a->ob_kind = b;
	ENDR("c_o_k");
	}

INT c_o_s(a,b) OP a; OBJECTSELF b;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK;
	COP("c_o_s",a);
	a->ob_self = b; 
	ENDR("c_o_s");
	}

INT emptyp(a) OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{ 
	return(s_o_k(a) == EMPTY); 
	}

INT test_callocobject()
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	OP a = callocobject();
	printf("test_callocobject: sizeof(OP)=%d\n",sizeof(a));
	printf("test_callocobject: sizeof(*OP)=%d\n",sizeof(*a));
	printf("test_callocobject: sizeof(struct object)=%d\n",sizeof(struct object));
	if (a==NULL) {
	printf("test_callocobject: NULL-object");return(OK);}
	printf("test_callocobject: a=%ld\n",a);
	printf("test_callocobject: a->ob_kind=%d\n",a->ob_kind);
	printf("test_callocobject: a->ob_self.ob_INT=%ld\n",
						(a->ob_self).ob_INT);
	SYM_free(a);
	return(OK);
	}

INT debugprint_object(a) OP a;
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	if (a==NULL) {
	fprintf(stderr,"debugprint_object: NULL-object");return(OK);}
	fprintf(stderr,"debugprint_object: a=%ld\n",a);
	fprintf(stderr,"debugprint_object: kind=%d\n",a->ob_kind);
	fprintf(stderr,"debugprint_object: self.INT=%ld\n",a->ob_self.ob_INT);
	return(OK);
	}

INT test_object()
/* AK 270689 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	OP a=callocobject();
	OBJECTSELF d;
	printf("test von callocobject()\n");
	test_callocobject();
	printf("\nobject vor c_o_k()\n");
	debugprint_object(a);
	c_o_k(a,(OBJECTKIND)5);
	printf("\nobject nach c_o_k(a,5)\n");
	debugprint_object(a);
	d.ob_INT = 12345L;
	c_o_s(a,d);
	printf("\nobject nach c_o_s(a,12345L)\n");
	debugprint_object(a);
	SYM_free(a);
	return(OK);
	}


#ifdef SKEWPARTTRUE
OP s_spa_g(a) OP a;
/* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{ 
	OBJECTSELF b; 
	INT erg = OK;
	CTO(SKEWPARTITION,"s_spa_g",a);
	b = s_o_s(a); 
	return b.ob_skewpartition->spa_gross; 
	ENDO("s_spa_g");
	}

INT c_spa_g(a,b) OP a,b;
/* AK 280789 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{ 
	OBJECTSELF c;
	c=s_o_s(a);
	c.ob_skewpartition->spa_gross=b;
	return(OK); 
	}

OP s_spa_k(a) OP a;
/* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{ 
	OBJECTSELF c; 
	c = s_o_s(a); 
	return(c.ob_skewpartition->spa_klein); 
	}

INT c_spa_k(a,b) OP a,b;
/* AK 280789 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
{ 
	OBJECTSELF c;
	c=s_o_s(a);
	c.ob_skewpartition->spa_klein=b;
	return(OK);
}

OP s_spa_gi(a,i) OP a; INT i;
/* AK 260789 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{ return(s_pa_i(s_spa_g(a),i)); }

OP s_spa_ki(a,i) OP a; INT i;
/* AK 260789 V1.1 */ /* AK 210891 V1.3 */
	{ return(s_pa_i(s_spa_k(a),i)); }

INT s_spa_gii(a,i) OP a; INT i;
/* AK 260789 V1.1 */
/* AK 210891 V1.3 */
	{ return(s_pa_ii(s_spa_g(a),i)); }

INT s_spa_gli(a) OP a;
/* AK 260789 V1.1 */ /* AK 210891 V1.3 */
	{ return(s_pa_li(s_spa_g(a))); }

INT s_spa_kii(a,i) OP a; INT i;
/* AK 260789 V1.1 */ /* AK 210891 V1.3 */
	{ return(s_pa_ii(s_spa_k(a),i)); }

INT s_spa_kli(a) OP a; 
/* AK 260789 V1.1 */ /* AK 210891 V1.3 */
	{ return(s_pa_li(s_spa_k(a))); }
#endif

INT comp_skewpartition(a,b) OP a,b;
{
	INT erg=OK;
	CTO(SKEWPARTITION,"comp_skewpartition",b);
	erg = comp(S_SPA_G(a), S_SPA_G(b));
	if (erg != 0)
		return erg;
	return comp(S_SPA_K(a), S_SPA_K(b));
	ENDR("comp_skewpartition");
}

INT lastof_skewpartition(a,b) OP a,b;
/* AK 280789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
#ifdef SKEWPARTTRUE
	return(lastof(S_SPA_G(a),b));
#else
	return error("lastof_skewpartition:SKEWPARTITION not available");
#endif
	}

#ifdef SKEWPARTTRUE
INT length_skewpartition(a,b) OP a,b;
/* AK 280789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	return length(S_SPA_G(a),b);
	}

INT freeself_skewpartition(a) OP a;
/* AK 280789 V1.1 */ /* AK 210891 V1.3 */
	{
	OBJECTSELF c;
	INT erg = OK;
	c = s_o_s(a);

	erg += freeall(S_SPA_G(a)); 
	erg += freeall(s_spa_k(a));
	SYM_free(c.ob_skewpartition); 
	return erg;
	}

INT copy_skewpartition(a,b) OP a,b;
/* AK 280789 V1.1 */ /* AK 140891 V1.3 */
	{
	INT erg = OK;
	erg += b_gk_spa(callocobject(),callocobject(),b);
	erg += copy(S_SPA_G(a),S_SPA_G(b)); 
	erg += copy(s_spa_k(a),s_spa_k(b)); 
	ENDR("copy_skewpartition");
	}

INT weight_skewpartition(a,b) OP a,b;
/* AK 020488 */ /* AK 060390 V1.1 */ /* AK 020591 V1.2 */
/* AK 210891 V1.3 */
	{
	OP c=callocobject(), d=callocobject(); 
	weight(S_SPA_G(a),c); weight(s_spa_k(a),d); sub(c,d,b);
	freeall(c);freeall(d); 
return(OK);
	}

INT objectread_skewpartition(f,a) FILE *f; OP a;
/* AK 210690 V1.1 */ /* AK 020591 V1.2 */
/* AK 210891 V1.3 */
	{
	b_gk_spa(callocobject(),callocobject(),a);
	objectread(f,S_SPA_G(a));
	objectread(f,s_spa_k(a));
	return OK;
	}

INT objectwrite_skewpartition(f,a) FILE *f; OP a;
/* AK 210690 V1.1 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	fprintf(f, "%ld ", (INT)SKEWPARTITION);
	erg += objectwrite(f,S_SPA_G(a));
	erg += objectwrite(f,s_spa_k(a));
	ENDR("objectwrite_skewpartition");
	}

INT dimension_skewpartition(a,b) OP a,b;
/* dimension der dartsellung */
/* AK 020890 V1.1 */ /* AK 210891 V1.3 */
{
	OP c = callocobject();
	part_part_skewschur(S_SPA_G(a),S_SPA_K(a),c);
	dimension(c,b);
	freeall(c);
	return OK;
}


INT starpart(a,b,c) OP a,b,c;
/* 020488 AK implementiert staroperation aus REWH */
/* bsp 123 * 222 -> 222345/222 */
/* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT i,letztes;
	OP glength = callocobject(); 
	OP klength = callocobject(); 

	b_gk_spa(callocobject(),callocobject(),c);
	add(S_PA_L(a),S_PA_L(b),glength);
	length(a,klength);
	b_kl_pa(VECTOR,glength,S_SPA_G(c));
	b_kl_pa(VECTOR,klength,S_SPA_K(c));
	
	letztes = S_PA_II(b,S_PA_LI(b)-1);
	for (i=0L;i<S_PA_LI(a);i++) M_I_I(letztes,s_spa_ki(c,i));
	for (i=0L;i<S_PA_LI(b);i++)
		M_I_I(S_PA_II(b,i),s_spa_gi(c,i));
	for (i=0L;i<S_PA_LI(a);i++)
		M_I_I(S_PA_II(a,i)+letztes,s_spa_gi(c,i+S_PA_LI(b)));
	return OK;
	}


INT ferrers_skewpartition(a) OP a; 
{
	return error("ferrers_skewpartition: not yet implemented");
}
#endif /* SKEWPARTTRUE */

#ifdef SKEWPARTTRUE
INT fprint_skewpartition(f,a) OP a; FILE *f;
/* AK 280789 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT erg = OK; /* AK 150192 */
	erg += fprint(f,S_SPA_G(a));
	fprintf(f," / ");
	erg += fprint(f,s_spa_k(a));
	return erg; /* AK 150192 */
	}



INT scan_skewpartition(a) OP a;
/* 020488 AK */ /* AK 010889 V1.1 */ /* AK 210891 V1.3 */
	{
	b_gk_spa(callocobject(),callocobject(),a);
	scan_printeingabe("input of a skewpartiton, the big partition");
	scan(PARTITION,S_SPA_G(a));
	scan_printeingabe("input of a skewpartiton, the small partition");
	scan(PARTITION,s_spa_k(a));
	return(OK);
	}


static struct skewpartition * callocskewpartition()
/* 020488 AK erste prozedur beim einfuehren eines neuen datentyps */
/* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	struct  skewpartition *erg
	= (struct skewpartition *) SYM_calloc(1,sizeof(struct skewpartition));
	if (erg == NULL) error("erg == NULL in callocskewpartition()");
	return(erg);
	}

INT skewpartitionp(a) OP a;
/* AK V2.0 040398 */
/* TRUE if a skewpartition */
{
	if (S_O_K(a) != SKEWPARTITION)
		return FALSE;
	if (not partitionp(S_SPA_G(a)))
		return FALSE;
	if (not partitionp(S_SPA_K(a)))
		return FALSE;
	return TRUE;
}

INT m_gk_spa(gross,klein,res)  OP gross,klein,res;
/* AK 110790 V1.1 */ /* AK 140891 V1.3 */
/* AK V2.0 090298 */
/* input:	two PARTITION objects gross, klein
   output:	SKEWPARTITION res = gross/klein
*/
	{
	INT erg = OK;
	CTO(PARTITION,"m_gk_spa",gross);
	CTO(PARTITION,"m_gk_spa",klein);
	CE3(gross,klein,res,m_gk_spa);
	erg +=  b_gk_spa(callocobject(),callocobject(),res);
	erg += copy_partition(gross,S_SPA_G(res));
	erg += copy_partition(klein,S_SPA_K(res));
	ENDR("m_gk_spa");
	}

INT b_gk_spa(gross,klein,ergebnis)  OP gross,klein,ergebnis;
/* AK 020488 */
/* AK 181289 V1.1 */ /* AK 140891 V1.3 */
/* AK 040398 V2.0 */
	{
	OBJECTSELF d;

	if (ergebnis==NULL)
		return ERROR;

	d.ob_skewpartition = callocskewpartition();
	b_ks_o(SKEWPARTITION, d, ergebnis);

	c_spa_g(ergebnis,gross); /*change_skewpartition_gross*/
	c_spa_k(ergebnis,klein); /*change_skewpartition_klein*/
	return(OK);
	}
#endif  /* SKEWPARTTRUE */

#ifdef WORDTRUE
INT test_word()
/* AK 030892 */
{
	OP c = callocobject();
	OP b = callocobject();
	OP a = callocobject();
	printf("random_word(30,b):");
	m_i_i(30L,a); random_word(a,b); println(b);
	printf("content(b,c):");
	content(b,c); println(c);
	freeall(a);
	freeall(b);
	freeall(c);
	return OK;
}
#endif /* WORDTRUE */

#ifdef WORDTRUE
INT charge_word(a,b) OP a,b;
/* AK 151196 */
{
	OP c,d,e,f;
	INT erg = OK,i,r=0,j,oj;
	c = callocobject();
	erg += content_word(a,c);
	if (einsp(c)) goto aaa;
	if (not decreasingp_vector(c))
		{
		erg += fprint(stderr,a);
		erg += fprint(stderr,c);
		erg += error("charge_word:not decreasing content of the word");
		goto endr_ende;
		}
	/* decompose into standard words */
	d = callocobject();
	e = callocobject();
	f = callocobject();
	erg += m_v_pa(c,d);
	erg += conjugate(d,d); println(d);
	erg += copy(a,c);
	erg += m_i_i(0,b);
	for (i=S_PA_LI(d)-1;i>=0;i--) /* number of subwords */
		{
		r = 1;
		m_il_w(S_PA_II(d,i),e); /* the subword */
ccc:
		j=S_W_LI(c)-1;
ddd:
		if (S_W_II(c,j) == r) { r++; M_I_I(-S_W_II(c,j),S_W_I(c,j)); }
		j--;
		if (r == S_W_LI(e) +1) goto bbb; /* one word finished */
		if (j == -1) goto ccc; else goto ddd;
bbb:
		for (j=0,r=0;j<S_W_LI(c);j++)
			if (S_W_II(c,j) < 0) 
				{
				M_I_I(-S_W_II(c,j),S_W_I(e,r));
				r++;
				M_I_I(0,S_W_I(c,j));
				}
		erg += charge_word(e,f);
		erg += add_apply(f,b);
		}
	erg += freeall(d);
	erg += freeall(e);
	erg += freeall(f);
	goto eee;
aaa:
	oj = S_V_LI(c);
	for (i=1;i<= S_V_LI(c);i++)
		{
		for (j=0;j<S_W_LI(a);j++)
			if (S_W_II(a,j) == i) 
				{
				if (j > oj) r++;
				M_I_I(r,S_V_I(c,j));
				oj = j;
				}
		}
	erg += sum(c,b);
eee:
	erg += freeall(c);
	ENDR("charge_word");
}

INT random_word(a,b) OP a,b;
/* AK 030892 */
/* a random word of length a and entries between 1 and 2 * length */
{
	OP c;
	INT erg = OK, i;
	CTO(INTEGER,"random_word",a);
	c = callocobject();
	erg += m_i_i(S_I_I(a)+S_I_I(a),c);
	erg += m_l_w(a,b);
	for (i=0L;i<S_W_LI(b);i++)
		erg += random_integer(S_W_I(b,i),cons_eins,c);
	erg += freeall(c);
	ENDR("random_word");
}
#endif /* WORDTRUE */

#ifdef WORDTRUE
INT S_a_rofword(w,a,r) OP w,a,r;
/* 220488 */ /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	OP i=callocobject(); 
	if (ge(a,r)) { fprintln(stderr,a); fprintln(stderr,r);
		error("a >= r in S_a_rofword"); }

	copy(r,i);
	do {	dec(i); S_rofword(w,i); } while( ge(i,a) );
	freeall(i);
	return(OK);
	}



INT S_rofword(w,r) OP w,r;
/* 210488 */ /* AK 160890 V1.1 */
/* liefert TRUE solange ein r-index > 0 */
/* AK 210891 V1.3 */
	{
	INT erg = OK;
	OP max=callocobject(); 
	OP index=callocobject(); 

	erg += maxrindexword(w,r,index,max);
	if (S_I_I(max) <= 0L) return(FALSE);
	M_I_I(S_I_I(r)-1L,S_W_I(w,S_I_I(index)));
	erg += freeall(max); 
	erg += freeall(index); 
	return(TRUE);
	}



INT content_word(a,b) OP a,b;
/* AK 300792 */
	{
	INT erg=OK,m,i;
	if (a==b) 
		return ERROR;
	m=0L;
	for (i=0L;i<S_W_LI(a);i++)
		if (S_W_II(a,i)>m)
			m=S_W_II(a,i);
	/* m is max */
	erg += m_il_nv(m,b);
	for (i=0L;i<S_W_LI(a);i++)
		{
		if (S_W_II(a,i) < 1L) 
			{
			erg += freeself(b);
			return error("content_word: wrong word content");
			}
		erg += INC_INTEGER(S_V_I(b,S_W_II(a,i)-1L));
		}
	ENDR("content_word");
	}
#endif /* WORDTRUE */

#ifdef WORDTRUE
INT R_roftableaux(w,r) OP w,r;
/* 250488 */ /* AK 160890 V1.1 */
/* AK 210891 V1.3 */
/* der umriss wird nicht gebraucht */
	{
	INT j,i,k;

	i=s_t_hi(w)-S_I_I(r)+1L; /* die zeilenummer in die gewechselt wird */
	for (j=0L;j<s_t_li(w);j++)
		if (EMPTYP(s_t_ij(w,i,j))) break;
	if (j==s_t_li(w)) 	{ inc(w); i=i+1L; };
	/* j ist die spaltennummer in die gewechselt wird */
	
	for (k=0L;k<s_t_li(w);k++) if (EMPTYP(s_t_ij(w,i-1L,k))) break;
	k = k-1L;
	/* k ist die spaltennummer aus der gewechselt wird */

	M_I_I(s_t_iji(w,i-1L,k),s_t_ij(w,i,j));
	freeself(s_t_ij(w,i-1L,k));return(OK);
	}



INT starttableaux(t,s) OP t,s;
/* berechnet das Tableaux T_0 aus MD */
/* 250488 */ /* AK 160890 V1.1 */
/* AK 210891 V1.3 */
	{
	OP in = callocobject();
	OP m = callocobject();
	OP l = callocobject();
	OP h = callocobject();
	
	INT i,j,k;

	m_us_t(callocobject(),callocobject(),s);
	content(t,in); max(in,m);

	/* ist der maximale eintrag in  content */
	copy(s_v_l(in),h); copy(m,l);
	m_lh_m(l,h,S_T_S(s));
	for (i=S_I_I(h)-1L,k=0L;i>=0L;i--,k++)
		for (j=s_v_ii(in,k)-1L;j>=0L;j--)
			M_I_I(k+1L,s_t_ij(s,i,j));

	freeall(in);
	SYM_free(m);
	return OK;
	}

INT rm_rindex(word,r) OP word,r;
/* 250488 */ /* AK 160890 V1.1 */
/* AK 210891 V1.3 */
	{
	while(S_rofword(word,r))
		{
		};
	return(OK);
}

	


static INT coroutine250488(i,word,tableaux) INT i; OP word,tableaux;
/* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	OP rindex=callocobject(); 
	OP umriss;
	INT erg=OK;
	M_I_I(i,rindex);
	while(S_rofword(word,rindex))
		erg += R_roftableaux(tableaux,rindex);
		/* simultane operation auf tableaux */


	if (i>2) 
		erg += coroutine250488(i-1L,word,tableaux);

	umriss = callocobject();  /* AK 100688 den umriss ausrechnen */
	erg+= m_matrix_umriss(S_T_S(tableaux), S_T_U(tableaux));

	erg += freeall(rindex);
	return erg;
	}



INT m_tableaux_tableauxpair(tab,ergtab_eins,s) OP tab,ergtab_eins,s; 
/* AK 160890 V1.1 */ /* AK 210891 V1.3 */
	{
	OP w = callocobject(); 

	INT i,j,l;
	INT index;

	wordoftableaux(tab,w);
	starttableaux(tab,s);
	l = s_t_hi(s);
	for(i=2L;i<=l;i++)
		coroutine250488(i,w,s);
	copy(tab,ergtab_eins);
	index=0L;
	for (i=s_t_hi(ergtab_eins)-1L;i>=0L;i--)
		for (j=s_t_li(ergtab_eins)-1L;j>=0L;j--)
			if (not EMPTYP(s_t_ij(ergtab_eins,i,j)))
				{
				M_I_I(S_W_II(w,index),s_t_ij(ergtab_eins,i,j));
				index++;
				};
	freeall(w);
	return OK;
	}



INT maxrindexword(w,r,index,erg) OP w,r,erg,index;
	/*210488*/ /* AK 160890 V1.1 */
	/* berechnet den maximalen wert der r-indices */
	/* er wird an der stelle index erreicht */
/* AK 210891 V1.3 */
	{
	INT i;
	OP zw_eins=callocobject(); 
	OP stelle=callocobject(); 

	M_I_I(-1000000L,erg);
	M_I_I(0L,index);
	for(i=0L;i<s_w_li(w);i++)
		{
		M_I_I(i,stelle);
		rindexword(w,r,stelle,zw_eins);
		if (gr(zw_eins,erg)) {copy(zw_eins,erg);M_I_I(i,index);};
		};
	freeall(zw_eins); freeall(stelle);return(OK);
	}



INT latticepword(w) OP w;
/* 210488 */ /* AK 160890 V1.1 */
/* AK 210891 V1.3 */
	{
	OP m = callocobject(); 
	OP null = callocobject(); 
	OP stelle = callocobject(); 
	OP r = callocobject(); 
	OP erg = callocobject(); 
	INT i,j,a=FALSE;

	max(w,m);
	M_I_I(0L,null);
	for (i=2L;i<=S_I_I(m);i++)
		for(j=0L;j<s_w_li(w);j++)
			{
			M_I_I(i,r); M_I_I(j,stelle); rindexword(w,r,stelle,erg);
			if (gr(erg,null)) goto lwende;
			};
	a = TRUE;
	lwende:
	freeall(null); freeall(r); freeall(erg); freeall(stelle);
	return(a);
	}



INT rindexword(w,r,stelle,erg) OP w,r,stelle,erg;
/* 210488 */ /* AK 020290 V1.1 */
/* AK 210891 V1.3 */
	{
	OP zw_eins= callocobject(); 
	OP zw_zwei= callocobject(); 
	if (S_I_I(r) <= 1) error("zu diesem r ist r-index nicht definiert");
	dec(r);
	rindexword_sub(w,r,stelle,zw_eins);
	inc(r);
	rindexword_sub(w,r,stelle,zw_zwei);
	sub(zw_zwei,zw_eins,erg);
	freeall(zw_eins);
	freeall(zw_zwei);
	return OK;
	}



INT rindexword_sub(w,r,stelle,erg) OP w,r,stelle,erg;
/* 210488 */ /* AK 020290 V1.1 */
/* AK 210891 V1.3 */
	{
	INT i,z=0L;
	if (ge(stelle,s_w_l(w))) { error("so lang ist das wort nicht"); };
	for(i=0L;i<=S_I_I(stelle);i++)
		if (S_W_II(w,i) == S_I_I(r)) z++;
	M_I_I(z,erg);
	return(OK);
	}



INT sscan_word(t,a) char *t; OP a;
{
	INT erg = OK;
	erg += sscan_integervector(t,a);
	C_O_K(a,WORD);
	ENDR("sscan_word");
}

INT scan_word(ergebnis) OP ergebnis;
/* AK 020290 V1.1 */ /* AK 210891 V1.3 */
	{
	OP length = callocobject();
	INT i,erg=OK;
	
	erg += scan_printeingabe("length of the word ");
	erg += scan(INTEGER,length);

	erg += b_l_w(length,ergebnis);
	for (i=0L;i < S_I_I(length); erg += scan(INTEGER,S_W_I(ergebnis,i++)));
	ENDR("scan_word");
	}

	

OP s_w_s(a) OP a;
/* AK 260789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	return(s_v_s(a));
	}

OP s_w_l(a) OP a;
/* AK 260789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	return(s_v_l(a));
	}

INT s_w_li(a) OP a;
/* AK 260789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	return(s_v_li(a));
	}

OP s_w_i(a,i) OP a;INT i;
/* AK 260789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	return(s_v_i(a,i));
	}

INT s_w_ii(a,i) OP a;INT i;
/* AK 260789 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	return(s_v_ii(a,i));
	}
#endif /* WORDTRUE */

INT cast_apply_integer(a) OP a;
/* AK a is a object which should become a INTEGER */
{
	INT erg = OK,err;
	switch(S_O_K(a)) {
		case INTEGER: break;
#ifdef LONGINTTRUE
		case LONGINT: erg += t_longint_int(a,a);
			if (S_O_K(a) != INTEGER)
				erg+= error("cast_apply_integer: LONGINT too big");
			break;
#endif
#ifdef BRUCHTRUE
		case BRUCH: 
			erg += kuerzen(a); 
			if (S_O_K(a) == BRUCH)
				{
				erg+= 
			error("cast_apply_integer: BRUCH with nenner != 1");
				break; 
				}
			erg += cast_apply_integer(a);
			break;
#endif
		default:
			err = error("cast_apply_integer: cannot cast to INTEGER");
			if (err==ERROR_EXPLAIN)
				{
				fprintf(stderr,"I tried to convert:");
				fprintln(stderr,a);
				}
			erg += ERROR;
		}
	ENDR("cast_apply_integer");
}



INT cast_apply(k,a) OBJECTKIND k; OP a;
/* AK 140293 */
/* to cast into correct datatype */
{
	INT erg = OK;
	if (k == S_O_K(a))
		goto cae;
	switch (k) {
#ifdef FFTRUE
		case FF:
			erg += cast_apply_ff(a); break;
#endif /* FFTRUE */
#ifdef BRUCHTRUE
		case BRUCH:
			erg += cast_apply_bruch(a) ; break;
#endif /* BRUCHTRUE */
		case INTEGER:
			erg += cast_apply_integer(a); break;
#ifdef MATRIXTRUE
		case MATRIX:
			erg += cast_apply_matrix(a); break;
#endif
		case MONOM:
			erg += cast_apply_monom(a); break;
#ifdef PARTTRUE
		case PARTITION:
			erg += cast_apply_part(a); break;
#endif
#ifdef PERMTRUE
		case PERMUTATION:
			erg += cast_apply_perm(a); break;
		case BARPERM:
			erg += cast_apply_barperm(a); break;
#endif
#ifdef SCHURTRUE
		case ELMSYM:
			erg += cast_apply_elmsym(a); break;
		case SCHUR:
			erg += cast_apply_schur(a); break;
#endif
#ifdef MONOPOLYTRUE
		case MONOPOLY:
			erg += cast_apply_monopoly(a);
			break;
#endif
#ifdef POLYTRUE
		case POLYNOM:
			erg += cast_apply_polynom(a); break;
#endif
#ifdef TABLEAUXTRUE
		case TABLEAUX:
			erg += cast_apply_tableaux(a); break;
#endif
		default:
			erg += printobjectkind(a);
			erg += print_type(k);
			erg += error("cast_apply:can not cast from first kind into second kind");
	}
cae:
	ENDR("cast_apply");
}

OP select_i(a,b) OP a,b;
/* AK 180294 */
{
	INT erg = OK;
	CTO(INTEGER,"select_i",b);
	switch(S_O_K(a)) {
		case INTEGERVECTOR:
		case VECTOR: return s_v_i(a,S_I_I(b));
		case PERMUTATION: return s_p_i(a,S_I_I(b));
		case PARTITION: return s_pa_i(a,S_I_I(b));
		}
	WTO("select_i",a);
	ENDO("select_i");
}



/*
Additionne 2 polynomes de Laurent.
La composante 0 de vc1 est plus grande que la composante 0 de vc2 
*/

static INT q_add_ord(vc1,vc2,res) OP vc1,vc2,res;
{
  INT delta,lg_vc1,lg_vc2,i,dg_vc2;

  lg_vc1=S_LA_LI(vc1);
  lg_vc2=S_LA_LI(vc2);
  delta=S_LA_II(vc1,0L)-S_LA_II(vc2,0L);
  if(lg_vc2>=lg_vc1+delta)
    m_il_nla(lg_vc2,res);
  else
    m_il_nla(lg_vc1+delta,res);
  M_I_I(S_LA_II(vc2,0L),S_LA_I(res,0L));

  for(i=1L;i<lg_vc2;i++)
    M_I_I(S_LA_II(vc2,i),S_LA_I(res,i));
  for(i=1L;i<lg_vc1;i++)
    M_I_I(S_LA_II(res,i+delta)+S_LA_II(vc1,i),S_LA_I(res,i+delta));
  return OK;
}

/*
Additionne 2 polynomes de Laurent
*/

INT add_laurent(vc1,vc2,res) OP vc1,vc2,res;
{
	INT erg = OK;
  if (S_O_K(vc2) == INTEGER)
	{
	OP c = callocobject();
	t_INTEGER_LAURENT(vc2,c);
	add_laurent(vc1,c,res);
	freeall(c);
	return OK;
	}
  else if (S_O_K(vc2) != LAURENT)
	{
	WTO("add_laurent",vc2);
	goto endr_ende;
	}
  if(S_LA_II(vc1,0L)<S_LA_II(vc2,0L))
    q_add_ord(vc2,vc1,res);
  else
    q_add_ord(vc1,vc2,res);
  return OK;
	ENDR("add_laurent");
}

/*
*/

INT add_apply_laurent(a,b) OP a,b;
{
  OP c;
	INT erg = OK;
  c=callocobject();
  erg += add_laurent(a,b,c);
  erg += freeself(b);
  c_o_s(b,S_O_S(c));
	C_O_K(c,EMPTY);
	erg += freeall(c);
/*
  if(speicherposition+1L < SPEICHERSIZE)
    speicher[++speicherposition]=c;
  else
    free(c);
*/
	ENDR("add_apply_laurent");
}

/*
Produit de 2 polynomes de Laurent
*/

INT mult_laurent(vc1,vc2,res) OP vc1,vc2,res;
{
  INT lg_vc1,lg_vc2,i,j;
	INT erg = OK;

  if (S_O_K(vc2) == INTEGER)
	{
	OP c = callocobject();
	t_INTEGER_LAURENT(vc2,c);
	 mult_laurent(vc1,c,res);
	freeall(c);
	return OK;
	}
  else if (S_O_K(vc2) == BRUCH)
	{
	copy(vc2,res);
	mult(vc1,S_B_O(vc2),S_B_O(res));
	kuerzen(res);
	return OK;
	}
  else if (S_O_K(vc2) != LAURENT)
	{
	WTO("mult_laurent",vc2);
	goto endr_ende;
	}
  lg_vc1=S_LA_LI(vc1);
  lg_vc2=S_LA_LI(vc2);
  m_il_nla(lg_vc1+lg_vc2-2L,res);
  M_I_I(S_LA_II(vc1,0L)+S_LA_II(vc2,0L),S_LA_I(res,0L));
  for(i=1L;i<lg_vc1;i++)
    if(S_LA_II(vc1,i)!=0L)
      for(j=i;j<i+lg_vc2-1L;j++)
        M_I_I(S_LA_II(res,j)+(S_LA_II(vc1,i)*S_LA_II(vc2,j-i+1L)),S_LA_I(res,j));
  return(OK);
	ENDR("mult_laurent");
}

/*
Normalise the Laurent's polynom:
For example [2, 0, 0, 3, 4, 0, 7] becomes [4, 3, 4]
returns 0 if the polynom is null, 1 if not
*/
INT normal_laurent(vc) OP vc;
{
	/* CC 290396 */
	/*Normalise Laurent polynom. For example, [2,0,0,3,5] becomes [4,3,5]*/

	INT tp,tmp,lg_vc,i,lg_w;
	OP w;
	OBJECTSELF ob;
	INT erg = OK;

	tp=0L;
	lg_vc= S_LA_LI(vc);
	for(i=1L;i<lg_vc;i++)
		{
		if(S_LA_II(vc,i)!=0L) break;
		else tp++;
		}
	if(i>=lg_vc)
		{
		erg += m_il_nla(2L,vc);
		goto endr_ende;
		}
	tmp=0L;
	for(i=lg_vc-1L;i>0L;i--)
	{
		if(S_LA_II(vc,i)!=0L) break;
		else tmp++;
	}
	w=callocobject();
	lg_w=lg_vc-tmp-tp;
	erg += m_il_la(lg_w,w);
		M_I_I(S_LA_II(vc,0L)+tp,S_LA_I(w,0L));
	for(i=1L;i<lg_w;i++)
		M_I_I(S_LA_II(vc,i+tp),S_LA_I(w,i));
	erg += freeself(vc);
	*vc = *w;
	C_O_K(w,EMPTY); /* AK 300197 */
	freeall(w);
	/*
	if(speicherposition+1L < SPEICHERSIZE)
	speicher[++speicherposition]=w;
	else
	free(w);
	*/
	ENDR("normal_laurent");
}


INT scan_laurent(ergebnis) OP ergebnis;
{
/* CC 010496 */
  INT length,erg=OK;
  INT i;
  erg += printeingabe("length of vector ");
  scanf("%ld",&length);
  if(length<2L)
  {
    erg+= m_il_nla(2L,ergebnis);
    return OK;
  }
  erg+=m_il_la(length,ergebnis);
  for(i=0L;i<length;erg += scan(INTEGER,S_V_I(ergebnis,i++)));
  return OK;
}


INT t_LAURENT_OBJ(vc,mp) OP vc,mp;
{
/*CC 290496*/
/*
transforms an object vc of type LAURENT into an object mp of type MONOPOLY
or into a BRUCH or into an INTEGER 
*/
	OP oben,unten,mn,sf,ob;
	INT erg = OK;
	INT i;

	CTO(LAURENT,"t_LAURENT_OBJ",vc);

        erg += normal_laurent(vc);
        if(S_LA_LI(vc)==2L&&S_LA_II(vc,0L)==0L)
	{
		erg += m_i_i(S_LA_II(vc,1L),mp);
		goto endr_ende;
	}
	sf=callocobject();
	if(S_LA_II(vc,0L)>=0L)
	{
		erg += init(MONOPOLY,mp);
		for(i=1L;i<S_LA_LI(vc);i++)
		{
			if(S_LA_II(vc,i)!=0L)
			{
				mn=callocobject();
				M_I_I(S_LA_II(vc,0L)+i-1L,sf);
				erg += m_sk_mo(sf,S_LA_I(vc,i),mn);
				insert(mn,mp,add_koeff,NULL);
			}
		}
	}
	else
	{
		unten=callocobject();
		init(MONOPOLY,unten);
		M_I_I(-S_LA_II(vc,0L),sf);
		mn=callocobject();
		erg += m_sk_mo(sf,cons_eins,mn);
		insert(mn,unten,add_koeff,NULL);
		oben=callocobject();
		if(S_LA_LI(vc)==2L)
			M_I_I(S_LA_II(vc,1L),oben);
		else
		{
			erg += init(MONOPOLY,oben);
			M_I_I(0L,sf);
			for(i=1L;i<S_LA_LI(vc);i++)
			{
				if(S_LA_II(vc,i)!=0L)
				{
					mn=callocobject();
					erg += m_sk_mo(sf,S_LA_I(vc,i),mn);
					insert(mn,oben,add_koeff,NULL);
				}
				erg += inc(sf);
			}
		}
		erg += b_ou_b(oben,unten,mp);
	}
	erg += freeall(sf);
	ENDR("t_LAURENT_OBJ");
}



INT t_MONOPOLY_LAURENT(mp,vc) OP mp,vc;
{
/* CC 010496 */
	OP dg,z;
	INT dgi,deb,lg_vc,tmp;

	if(S_O_K(mp)!=MONOPOLY)
		return error("t_MONOPOLY_LAURENT: wrong first type");
	if(nullp_monopoly(mp))
	{
		m_il_nla(2L,vc);
		return OK;
	}
	dg=callocobject();
	degree_monopoly(mp,dg);
	dgi=S_I_I(dg);
	deb=S_I_I(S_PO_S(mp));
	lg_vc=dgi-deb+2L;
	m_il_nla(lg_vc,vc);
	M_I_I(deb,S_LA_I(vc,0L));
	z=mp;
	while(z!=NULL)
	{
		tmp=S_I_I(S_PO_S(z));
		copy(S_PO_K(z),S_LA_I(vc,tmp-deb+1L));
		z=S_L_N(z);
	}
	freeall(dg);return OK;
}


INT t_POLYNOM_LAURENT(po,vc) OP po,vc;
{
	/*CC 010496*/
	OP dg,z;
	INT dgi,deb,lg_vc,tmp;
	INT erg = OK;

	CTO(POLYNOM,"t_POLYNOM_LAURENT",po);


	/*CC 30/07/96*/
	if(has_one_variable(po)==FALSE) 
		{
		erg += error("t_POLYNOM_LAURENT: the first polynomial has more than pne variable");
		goto endr_ende;
		}

	if(nullp_polynom(po))
		{
		erg += m_il_nla(2L,vc);
		goto endr_ende;
		}
	dg=callocobject();
	erg += degree_polynom(po,dg);
	dgi=S_I_I(dg);
	deb=S_PO_SII(po,0L);
	lg_vc=dgi-deb+2L;
	erg += m_il_nla(lg_vc,vc);
	M_I_I(deb,S_LA_I(vc,0L));
	z=po;
	while(z!=NULL)
		{
		tmp=S_PO_SII(z,0L);
		copy(S_PO_K(z),S_LA_I(vc,tmp-deb+1L));
		z=S_L_N(z);
		}
	erg += freeall(dg);
	ENDR("t_POLYNOM_LAURENT");
}

INT t_INTEGER_LAURENT(n,vc) OP n,vc;
{
	if((S_O_K(n)!=INTEGER)&&(S_O_K(n)!=LONGINT))
		return error("t_INTEGER_LAURENT: first argument not an integer");
	m_il_nla(2L,vc);
	copy(n,S_LA_I(vc,1L));
	return(OK);
}


/*
transforms an object of type MONOPOLY or POLYNOM or INTEGER or
BRUCH into an object of type LAURENT
*/

INT t_OBJ_LAURENT(obj,vc) OP obj,vc;
{
	switch(S_O_K(obj))
	{
		case MONOPOLY:
			return t_MONOPOLY_LAURENT(obj,vc);
		case POLYNOM:
			return t_POLYNOM_LAURENT(obj,vc);
		case INTEGER:
			return t_INTEGER_LAURENT(obj,vc);
		case BRUCH:
			return t_BRUCH_LAURENT(obj,vc);
		default:
			return error("t_OBJ_LAURENT: wrong first type");		}
}

INT invers_laurent(lau, res) OP lau,res;
{
	INT erg = OK;
	erg += t_LAURENT_OBJ(lau,res);
	erg += invers(res,res);
/*
	erg += b_ou_b(callocobject(),callocobject(),res);
	M_I_I((INT)1,S_B_O(res));
	erg += copy(lau,S_B_U(res));
	C_B_I(res,GEKUERZT);
*/
	ENDR("invers_laurent");
}

INT addinvers_apply_laurent(lau) OP lau;
{
	INT i;
	INT erg  = OK;
	for (i=1;i<S_LA_LI(lau);i++)
		erg += addinvers_apply(S_LA_I(lau,i));
	ENDR("addinvers_apply_laurent");
}

INT t_BRUCH_LAURENT(br,vc) OP br,vc;
/*CC 030196*/
{
	OP oo,uu,vc1,v,z,hh,u;
	INT i;

	krz(br);
	if(S_O_K(br) != BRUCH)
		return t_OBJ_LAURENT(br,vc);
	oo=S_B_O(br); uu=S_B_U(br);
	if(S_O_K(uu)==INTEGER || S_O_K(uu)==LONGINT)
	{
		vc1=callocobject();
		t_OBJ_LAURENT(oo,vc);
		copy(vc,vc1);
		for(i=1L;i<S_LA_LI(vc);i++)
			div(S_LA_I(vc1,i),uu,S_LA_I(vc,i));
		freeall(vc1); return OK;
	}
	if(S_O_K(uu)==POLYNOM)
	{
        	if(has_one_variable(uu)==FALSE) return FALSE;
		u=callocobject(); init(MONOPOLY,u);
		z=uu;
		while(z!=NULL)
        	{
               	 	hh=callocobject();
               	 	m_sk_mo(S_V_I(S_PO_S(z),0L),S_PO_K(z),hh);
               	 	insert(hh,u,add_koeff,NULL);
                	z=S_PO_N(z);
        	}
		copy(u,uu); freeall(u);
	}
	if(S_O_K(uu)== MONOPOLY)
	{
		v=callocobject();
		t_MONOPOLY_LAURENT(uu,v);
		if(S_LA_LI(v) >2L)
		{
			freeall(v);
			return error("t_BRUCH_LAURENT: don't succeed in converting into Laurent polynomial");
		}
		t_OBJ_LAURENT(oo,vc); 
		vc1=callocobject();
		copy(vc,vc1);
		sub(S_LA_I(vc1,0L),S_LA_I(v,0L),S_LA_I(vc,0L));
		for(i=1L;i<S_LA_LI(vc);i++)
                        div(S_LA_I(vc1,i),S_LA_I(v,1L),S_LA_I(vc,i));
                freeall(vc1); 
		freeall(v); 
		return OK;
	}
}




INT unrank_subset(b,c,d) OP b,c,d;
{
	INT k = S_I_I(b);
	INT i; 
	INT erg = OK;
	OP p ,oi,h,r;

	CE3(b,c,d,unrank_subset);

	p = callocobject();
	oi = callocobject();
	h = callocobject();
	r = callocobject();
	erg += copy(c,r);
	erg += m_l_v(b,d);
	for (i=k;i>=1;i--)
		{
		erg += m_i_i(i-1,p);
		erg += m_i_i(i,oi);
		do {
		erg += inc(p);
		erg += binom(p,oi,h);
		} while (ge(r,h));
		erg += dec(p);
		erg += binom(p,oi,h);
		erg += sub(r,h,r);
		erg += m_i_i(S_I_I(p)+1,S_V_I(d,i-1));
		}
	erg += freeall(p);
	erg += freeall(r);
	erg += freeall(h);
	erg += freeall(oi);
	ENDR("unrank_subset");
}




OP find_hashtable(a,b,cf,hf) OP a,b; INT (*cf)();INT (*hf)();
/* AK 281097 */
/* find a object in hashtable b */
{
	OP z;
	INT i;
	if (hf == NULL) hf = hash;
	z = S_V_I(b,(*hf)(a) % S_V_LI(b) );
	if (EMPTYP(z))
		return NULL;
	if (cf == NULL) 
		cf = comp;

	for (i=0;i<S_V_LI(z);i++)
		{
		if ((*cf)(a,S_V_I(z,i)) == (INT)0)
			{
			return S_V_I(z,i);
			}
		}
	return NULL;
	
}

INT init_hashtable(a) OP a;
/* AK 281097 */
/* initialize a hashtable */
	{
	INT erg = OK;
	erg += m_il_v(1010,a);
	M_I_I(1009,S_V_L(a));
	C_O_K(a,HASHTABLE);
	M_I_I(0,S_V_I(a,1009));
	ENDR("init_hashtable");
	}

INT init_size_hashtable(a,b) OP a; INT b;
	{
	OP c = callocobject();
	M_I_I(b,c);
	while (not primep(c)) INC_INTEGER(c);
	INC_INTEGER(c);
	b_l_v(c,a);
	DEC_INTEGER(c);
	C_O_K(a,HASHTABLE);
	M_I_I(0,S_V_I(a,S_V_LI(a)));
	return OK;
	}

INT clone_size_hashtable(a,b) OP a; INT b;
        {
        OP c = callocobject();
        M_I_I(b,c);
        INC_INTEGER(c);
        b_l_v(c,a);
        DEC_INTEGER(c);
        C_O_K(a,HASHTABLE);
        M_I_I(0,S_V_I(a,S_V_LI(a)));
        return OK;
        }



INT insert_hashtable_hashtable(a,b,eh , cf,hf) OP a,b; INT (*eh)(), (*cf)(), (*hf)();
{
	INT erg = OK;
	OP z;
	if (S_V_LI(a) != S_V_LI(b))
		{
		erg += error("hash tables of different sizes ");
		goto endr_ende;
		}
	FORALL(z,a, {
		OP f = callocobject();
		swap(z,f);
		insert_hashtable(f,b,eh , cf,hf);
		} );
	freeall(a);
	ENDR("insert_hashtable_hashtable");
		
}

INT insert_hashtable(a,b,eh , cf,hf) OP a,b; INT (*eh)(), (*cf)(), (*hf)();
/* AK 281097 */
/* insert into a hashtable */
	{
	INT i,index,freeindex=-1;
	INT erg = OK;
	OP z;

	CTO(HASHTABLE,"insert_hashtable",b);
	if (S_O_K(a) == HASHTABLE)
		{
			erg += insert_hashtable_hashtable(a,b,eh,cf,hf);
			goto endr_ende;
		}
	
	if (hf == NULL) hf = hash;
	index = (*hf)(a) % S_V_LI(b);

	if (index < 0) index += S_V_LI(b);
	z = S_V_I(b,index);

	if (EMPTYP(z))
		{
		b_o_v(a,z);
		INC_INTEGER(S_V_I(b,S_V_LI(b))); /* counter++ */
		}
	else	{
		/* collision */
		if (cf == NULL) cf = comp;
		for (i=0;i<S_V_LI(z);i++)
			{
			if (EMPTYP(S_V_I(z,i))) 
				freeindex = i;
			else if ((*cf)(a,S_V_I(z,i)) == 0)
				{
				if (eh == NULL) return OK;
				else {
					(*eh)(a,S_V_I(z,i));
					erg += freeall(a);   
					if (EMPTYP(S_V_I(z,i)))
					    DEC_INTEGER(S_V_I(b,S_V_LI(b))); /* counter++ */
					goto endr_ende;
					}
				}
			}
		/* nicht da */
		if (freeindex < 0) { freeindex = S_V_LI(z); inc(z); }
			
		INC_INTEGER(S_V_I(b,S_V_LI(b))); /* counter++ */
		erg += swap(a,S_V_I(z,freeindex));
		erg += freeall(a);
		}
	ENDR("insert_hashtable");
	}

INT hash(a) OP a;
/* returns hash-number unsigned 32 bit */
/* AK 281097 */
{
	INT i,erg;
	switch(S_O_K(a))
		{
		case EMPTY: return 0;
		case INTEGER: return S_I_I(a);
		case PARTITION: return hash(S_PA_S(a));
		case PERMUTATION: return hash(S_P_S(a));
		case INTEGERVECTOR:
		case VECTOR: {
			INT erg = hash(S_V_I(a,0));
			for (i=1;i<S_V_LI(a);i++)
				{
				erg *= 11;
				erg += hash(S_V_I(a,i));
				}
			return erg;
			}
		}
	
}

#define callocobject callocobject_trace
#undef callocobject