#include "def.h" 
#include "macro.h"

/* SYMMETRICA vector.c */
/* AK 160986 */

#define callocobject callocobject_trace
#undef callocobject

static struct vector * callocvectorstruct();

#ifdef MEMCHECK
static INT mem_counter_vec;
#endif /* MEMCHECK */

#ifdef VECTORTRUE
INT vec_anfang()
/* AK 100893 */
	{
#ifdef MEMCHECK
	mem_counter_vec=(INT)0;
#endif /* MEMCHECK */
	return OK;
	}

INT vec_ende()
/* AK 100893 */
	{
	INT erg = OK;
#ifdef MEMCHECK
	if (mem_counter_vec != (INT)0)
		{
		fprintf(stderr,"mem_counter_vec = %ld\n",mem_counter_vec);
		erg += error("vec memory not freed");
		}
#endif /* MEMCHECK */
	return erg;
	}


INT einsp_vector(a) OP a;
/* AK 010692 */
{
	INT i;
	for (i=(INT)0;i<S_V_LI(a);i++)
		if (not einsp(S_V_I(a,i))) return FALSE;
	return TRUE;
}

INT decreasingp_vector(a) OP a;
/* AK 151196 */
{
	INT i;
	if (S_V_LI(a) <= 1) return TRUE;

        for (i=S_V_LI(a)-2;i>=0;i--)
		if (LT(S_V_I(a,i),S_V_I(a,i+1)))  return FALSE;
	return TRUE;
}

#endif /* VECTORTRUE */
INT vectorp(a) OP a;
/* AK 210192 */
{
#ifdef VECTORTRUE
	if (
		(s_o_k(a) == VECTOR)
		||
		(s_o_k(a) == WORD)
		||
		(s_o_k(a) == KRANZ)
		||
		(s_o_k(a) == LAURENT)
		||
		(s_o_k(a) == COMP)
		||
		(s_o_k(a) == INTEGERVECTOR)
		||
		(s_o_k(a) == FF)
	   ) return TRUE;
#endif /* VECTORTRUE */
	return FALSE;
}

#ifdef VECTORTRUE
INT m_o_v(ob,vec) OP ob,vec;
/* make_object_vector */
/* AK 260488 erzeugt aus einen object einen vector */
/* AK 270689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{ 
	INT erg = OK;
	if (check_equal_2(ob,vec,m_o_v,&erg) == EQUAL)
                goto endr_ende;
	erg += m_il_v((INT)1,vec); 
	erg += copy(ob,S_V_I(vec,(INT)0));
	ENDR("m_o_v");
}

INT b_o_v(ob,vec) OP ob,vec;
/* build_object_vector */ 
/* AK 170590 V1.1 */ /* AK 200891 V1.3 */
{ 
	INT erg = OK;
	if (ob == vec) 
		erg += error("b_o_v: the two parameters are equal");
	erg += b_ls_v(callocobject(),ob,vec); 
	M_I_I((INT)1,S_V_L(vec)); 
	ENDR("b_o_v");
}

INT m_l_nv(il,vec)  OP il,vec;
/* AK 160791 V1.3 */
{
	return m_il_nv(S_I_I(il),vec);
}

INT m_il_nv(il,vec) INT il; OP vec;
/* AK 160791 V1.3 */
{
	INT i;
	INT erg = OK;
	erg += m_il_v(il,vec);
	for (i=(INT)0;i<S_V_LI(vec);i++)
		M_I_I((INT)0,S_V_I(vec,i));
	ENDR("m_il_nv");
}

INT m_il_bv(il,bitvec) INT il; OP bitvec;
/* AK 161294 */
{
	INT erg = OK,i;
        if (il < (INT)0)
                return error("m_il_bv: negativ length");
        if (il == (INT)0)
                erg += b_ls_v(callocobject(),NULL,bitvec);
	erg += b_ls_v(callocobject(),NULL,bitvec);
	M_I_I(il,S_V_L(bitvec));
	C_V_S(bitvec,SYM_malloc(S_BV_LI(bitvec)));
	C_O_K(bitvec,BITVECTOR);
	ENDR("m_il_bv");
}

INT m_il_nbv(il,bitvec) INT il; OP bitvec;
/* AK 161294 */
{
	INT erg = OK,i;
        if (il < (INT)0)
                return error("m_il_nbv: negativ length");
	erg += b_ls_v(callocobject(),NULL,bitvec);
	M_I_I(il,S_V_L(bitvec));
	if (il > (INT)0)
		{
		C_V_S(bitvec,SYM_calloc(S_BV_LI(bitvec),
				sizeof(unsigned char)));
		}
	C_O_K(bitvec,BITVECTOR);
	ENDR("m_il_bv");
}


INT m_il_v(il,vec) INT il; OP vec;
/* make_integerlength_vector */
/* AK 250587 */ /* AK 270689 V1.0 */ /* AK 211289 V1.1 */
/* AK 080291 V1.2 test on negativ
                  test on zero length */
/* AK 200891 V1.3 */
{
	INT erg = OK,i;
	if (il < (INT)0) 
		return error("m_il_v: negativ length");
	if (il == (INT)0) 
		erg += b_ls_v(callocobject(),NULL,vec);
	else if (il == (INT)1) 
		erg += b_ls_v(callocobject(),callocobject(),vec);
	else
		erg += b_ls_v(callocobject(),
			(OP) SYM_malloc((int)il * sizeof(struct object)),vec);
	M_I_I(il,S_V_L(vec));
	for (i=(INT)0;i<il;i++) 
		C_O_K(S_V_I(vec,i),EMPTY);
	ENDR("m_il_v");
}

INT mem_size_vector(a) OP a;
/* AK 150295 */
{
	INT erg = 0;
	if (a == NULL)
		return 0;
	if (not VECTORP(a))
		WTO("mem_size_vector",a);
	erg += sizeof(struct object);
	erg += sizeof(struct vector);
	erg += mem_size(S_V_L(a));
	erg += S_V_LI(a) * sizeof(struct object);
	return erg;
}

#endif /* VECTORTRUE */

INT b_l_v(length,a) OP length, a;
/* build_length_vector
	build bedeutet length wird teil des vector objects */
/* AK 170590 V1.1 */ /* AK 200891 V1.3 */
{
#ifdef VECTORTRUE 
	INT erg = OK,i;
	OP self ; /* self komponente des vectors */

	CTO(INTEGER,"b_l_v",length);
	if (erg != OK) goto ende;
	

	if (NULLP_INTEGER(length)) 
		{
		erg += b_ls_v(length,NULL,a); /* AK 021291 */
		goto ende;
		}

	if (S_I_I(length) == (INT)1)
		self = callocobject();
	else
		self = (OP) SYM_malloc((int)S_I_I(length) * 
				sizeof(struct object));
	if (self == NULL) 
		{
		erg += error("b_l_v:no memory");
		goto ende;
		}

	erg += b_ls_v( length , self, a);

	for (i=(INT)0;i<S_V_LI(a);i++) /* AK 271191 DOS */
		C_O_K(S_V_I(a,i),EMPTY);
ende:
	ENDR("b_l_v");
#else
	return error("b_l_v: VECTOR not available");
#endif /* VECTORTRUE */
}

INT b_l_nv(a,b) OP a,b;
/* AK 170692 */
	{
#ifdef VECTORTRUE 
	INT i,erg = OK;;
	CTO(INTEGER,"b_l_nv",a);
	erg += b_l_v(a,b);
	for (i=(INT)0;i<S_V_LI(b);i++)
		M_I_I((INT)0,S_V_I(b,i));
	ENDR("b_l_nv");
#else
	return error("b_l_nv: VECTOR not available");
#endif /* VECTORTRUE */
	}

INT m_l_v(length,a) OP length,a;
/* make_length_vector
	make bedeutet length wird copiert */
/* AK 170590 V1.1 */ /* AK 200891 V1.3 */
{
#ifdef VECTORTRUE 
	OP l ;
	INT erg = OK;
	CTO(INTEGER,"m_l_v",length);
	l = callocobject();
	erg += COPY_INTEGER(length,l);
	erg += b_l_v(l,a);
	ENDR("m_l_v");
#else
	return error("m_l_v: VECTOR not available");
#endif /* VECTORTRUE */
}

#ifdef VECTORTRUE 
INT add_apply_vector(a,b) OP a, b;
/* b = b+a */
/* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT i,erg = OK;
	OP c;
	if (not VECTORP(b))
		return WTT("add_apply_vector",a,b);

	if (S_V_LI(a) > S_V_LI(b))
	{
		c = callocobject();
		erg += copy(a,c);
		for (i=(INT)0;i<S_V_LI(a);i++)
			if 	(i < S_V_LI(b))
				erg += add(S_V_I(a,i),S_V_I(b,i),S_V_I(c,i));
			else break;
		erg += freeself(b);
		*b = *c;
		C_O_K(c,EMPTY);
		erg += SYMfreeall(c);
	}
	else {
		for (i=(INT)0;i<S_V_LI(b);i++)
			if 	(i < S_V_LI(a))
				erg += add_apply(S_V_I(a,i),S_V_I(b,i));
			else break;
	};
	ENDR("add_apply_vector");
}
#endif /* VECTORTRUE */


#ifdef VECTORTRUE 
INT add_vector(a,b,c) OP a, b, c;
/* AK 221086 */
/* geaendert ohne hilfsvariable 061186 */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT i;
	INT erg = OK;
	if (S_V_LI(a) > S_V_LI(b))
	{
		erg += copy(a,c);
		for (i=(INT)0;i<S_V_LI(a);i++)
			if 	(i < S_V_LI(b))
				erg += add(S_V_I(a,i),S_V_I(b,i),S_V_I(c,i));
			else break;
	}
	else {
		erg += copy(b,c);
		for (i=(INT)0;i<S_V_LI(b);i++)
			if 	(i < S_V_LI(a))
				erg += add(S_V_I(a,i),S_V_I(b,i),S_V_I(c,i));
			else break;
	};
	ENDR("add_vector");
}
#endif /* VECTORTRUE */

#ifdef VECTORTRUE 
INT qsort_vector(vec) OP vec;
/* sortiert einen vector in aufsteigender folge mit systemroutine AK 060488 */
/* AK 280689 V1.0 */
/* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	qsort(S_V_S(vec),(int)S_V_LI(vec),sizeof(struct object),comp);
	/* (int) wegen PC-compabilitaet AK 120789 */
	return(OK);
}

INT usersort_vector(vec,f) OP vec;INT (*f)();
{
	qsort(S_V_S(vec),(int)S_V_LI(vec),sizeof(struct object),f);
	/* (int) wegen PC-compabilitaet AK 120789 */
	return(OK);
}

INT sort_vector(vec) OP vec;
/* sortiert einen vector in aufsteigender folge
nach den algorithmus insertion-sort (knuth) AK 270787 */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT i,j,k;
	OBJECTSELF zeiger;
	OBJECTKIND art;

	for (i=(INT)0;i<S_V_LI(vec);i++)
		for (j=(INT)0;j<i;j++)
			if (lt(S_V_I(vec,i),S_V_I(vec,j)))
			{
				zeiger =  S_O_S(S_V_I(vec,i));
				art =  S_O_K(S_V_I(vec,i));
				for (k=i;k>j;k--)
					*S_V_I(vec,k) = *S_V_I(vec,k-(INT)1);
				C_O_S(S_V_I(vec,j),zeiger);
				C_O_K(S_V_I(vec,j),art);
			};
	return(OK);
}
#endif /* VECTORTRUE */


#ifdef VECTORTRUE

INT random_bv(a,b) OP a,b;
/* AK 250194 */
{
	INT erg = OK,i;
	CTO(INTEGER,"random_bv",a);
	erg += m_il_bv(S_I_I(a),b);
	C_O_K(b,BITVECTOR);
	for (i=(INT)0;i<S_V_LI(b);i++)
		{
		if (rand()%2)
			SET_BV_I(b,i);
		}
	ENDR("random_bv");
}
INT sscan_integervector(t,a) OP a; char *t;
/* AK 050194 to read integervector from string
        format [1,2,3,..]
*/
{
        INT i,n,erg = OK;

        char *v,*w;
        v = t;
        while (*v == ' ') v++;
        if (*v != '[')
                {erg = ERROR; goto spe;}
        w = v; n = (INT)1;
        /* now we count the number of parts */
        w++;
        while (*w != ']')
                {
		if (*w == ' ') ; /* AK 060397 */
                else if (*w == ',') n++;
                else if (*w == '-'); /* AK 280197 */
                else if (not SYM_isdigit(*w))
                        {erg = ERROR; goto spe;}
                w++;
                }
        /* n is the number of parts */
        m_il_v(n,a);
	C_O_K(a,INTEGERVECTOR);
        w = v;
        w++;
        for (i=(INT)0; i<n; i++)
                {
                erg += sscan(w,INTEGER,S_V_I(a,i));
                if (erg != OK) goto spe;

                while (SYM_isdigit(*w)) w++;
                w++;
                }
        spe:
        ENDR("sscan_integervector");
}

INT random_integervector(a,b) OP a,b;
/* AK 250194 */
{
	INT erg = OK,i;
	CTO(INTEGER,"random_integervector",a);
	erg += m_l_v(a,b);
	C_O_K(b,INTEGERVECTOR);
	for (i=(INT)0;i<S_V_LI(b);i++)
		erg += random_integer(S_V_I(b,i),NULL,NULL);
	ENDR("random_integervector");
}

INT freeself_integervector(a) OP a;
/* AK 110394 */
{
	INT erg = OK;
	OBJECTSELF d;
	if (not VECTORP(a))
		return ERROR;
	d = S_O_S(a);
	if (S_V_LI(a) == (INT)1) 
		SYMfreeall(S_V_S(a));
	else
		SYM_free(S_V_S(a));

	erg += SYMfreeall(S_V_L(a)); 
	SYM_free(d.ob_vector);
	C_O_K(a,EMPTY);
	ENDR("freeself_integervector");
}

INT freeself_bitvector(a) OP a;
/* AK 081294 */
{
	INT erg = OK;
	OBJECTSELF d;
	if (S_O_K(a) != BITVECTOR)
		return ERROR;
	d = S_O_S(a);
	SYM_free(S_V_S(a));
	erg += SYMfreeall(S_V_L(a)); 
	SYM_free(d.ob_vector);
	C_O_K(a,EMPTY);
	ENDR("freeself_bitvector");
}

INT freeself_vector(vec) OP vec;
/* gibt den speicherplatz eines vectorobjects frei */
/* AK 280689 V1.0 */ /* AK 211189 V1.1 */ /* AK 130691 V1.2 */ 
/* AK 200891 V1.3 */
{
	OBJECTSELF d;
	INT  i,erg=OK;
	OP z;

	if (not VECTORP(vec))
		return ERROR;

	d = S_O_S(vec);
	z = S_V_S(vec);
	if (S_V_LI(vec) == (INT)1) 
		SYMfreeall(S_V_S(vec));
	else if (S_V_LI(vec) > (INT)0) 
		{
		for (i=(INT)0;i<S_V_LI(vec);i++,z++) 
			if (not EMPTYP(z))
				if (S_O_K(z) != INTEGER)
					erg += freeself(z);
		SYM_free(S_V_S(vec));
		}
	erg += SYMfreeall(S_V_L(vec)); 
	SYM_free(d.ob_vector);
	C_O_K(vec,EMPTY);
	ENDR("freeself_vector");
}
#endif /* VECTORTRUE */


INT addinvers_vector(vec,res) OP vec,res;
/* AK 270887 */ /* AK 280689 V1.0 */ /* AK 201289 V1.1 */
/* AK 200891 V1.3 */
{
	INT i,erg = OK;

	erg += copy(vec,res);
	for (i=(INT)0;i<S_V_LI(vec);i++) 
		erg += addinvers(S_V_I(vec,i),S_V_I(res,i));
	ENDR("addinvers_vector");
}


INT addinvers_apply_vector(vec) OP vec;
/* AK 201289 V1.1 */ /* AK 080591 V1.2 */ /* AK 200891 V1.3 */
{
	INT i,erg=OK;
	for (i=(INT)0;i<S_V_LI(vec);i++) 
		erg += addinvers_apply(S_V_I(vec,i));
	ENDR("addinvers_apply_vector");
}


INT addtoallvectorelements(zahl,vector,res) OP zahl,vector,res;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT		i;
	copy(vector,res);
	for(	i = (INT)0; i < S_V_LI(res);
	    add(zahl,S_V_I(res,i),S_V_I(res,i)),
	    i++);
	return OK;
}

INT absolute_vector(vec,res) OP vec, res;
/* AK 240293 */
{
	INT		i,erg=OK;

	m_il_v(	S_V_LI(vec), res);

	for(	i=(INT)0; i < S_V_LI(vec); i++)
		{
		erg += absolute(S_V_I(vec,i),S_V_I(res,i));
		}
	C_O_K(res,S_O_K(vec));
	ENDR("absolute_vector");
}


INT copy_vector(vec,res) OP vec, res;
/* AK 021286 */ /* AK 280689 V1.0 */ /* AK 081289 V1.1 */
/* AK 120391 V1.2 */ /* AK 200891 V1.3 */
{
	INT erg = OK,i;

	erg += m_il_v(	S_V_LI(vec), res);

	for(	i=(INT)0; i < S_V_LI(vec); i++)
		{
		if (S_O_K(S_V_I(vec,i)) == INTEGER) /* AK 120391 */
			* (S_V_I(res,i)) = * (S_V_I(vec,i));
		else
			erg += copy(S_V_I(vec,i),S_V_I(res,i));
		}
	C_O_K(res,S_O_K(vec));
	ENDR("copy_vector");
}

INT sub_comp_bv(a,b) OP a,b;
/* AK 180396 */
{
	INT erg=0,i,ai,bi;
	CTO(BITVECTOR,"comp_bv",a);
	CTO(BITVECTOR,"comp_bv",b);
	if (S_V_LI(a) != S_V_LI(b)) 
		return NONCOMPARABLE;
	for (i=0;i<S_V_LI(a);i++)
		{
		ai = GET_BV_I(a,i);
		bi = GET_BV_I(b,i);
		if (ai == bi) continue;
		if ((ai < bi) && (erg == 1)) return NONCOMPARABLE;
		if ((ai < bi) && (erg == 0)) { erg = -1; continue; }
		if ((ai > bi) && (erg == -1)) return NONCOMPARABLE;
		if ((ai > bi) && (erg == 0)) { erg = 1; continue; }
		}
	return erg;
	ENDR("sub_comp_bv");
}

INT comp_bv(a,b) OP a,b;
/* AK 200395 */
{
	INT i;
	INT erg = OK;
	CTO(BITVECTOR,"comp_bv",a);
	CTO(BITVECTOR,"comp_bv",b);
	if (S_V_LI(a) != S_V_LI(b)) 
		error("comp_bv:different lengths");
	for (i=0;i<S_V_LI(a);i++)
		if (GET_BV_I(a,i) < GET_BV_I(b,i)) return (INT)-1;
		else if (GET_BV_I(a,i) > GET_BV_I(b,i)) return (INT)1;
	return (INT) 0;
	ENDR("comp_bv");
}

INT comp_integervector(a,b) OP a,b;
{
	INT i;
	for (	i=(INT)0; i<S_V_LI(a); i++)
	{
		if (i >=  S_V_LI(b)) return (INT)1;
		if (S_V_II(a,i) > S_V_II(b,i)) return (INT) 1;
		if (S_V_II(a,i) == S_V_II(b,i)) continue;
		return (INT) -1;
	};
	if (i < S_V_LI(b))
		return (INT) -1;
	return((INT)0);
}

INT comp_vector(a,b) OP a,b;
/* AK 060488 */ /* AK 280689 V1.0 */ /* AK 201289 V1.1 */
/* AK 200891 V1.3 */
{
	INT i,erg;
	for (	i=(INT)0; i<S_V_LI(a); i++)
	{
		if (i >=  S_V_LI(b)) return((INT)1);
		erg = comp(S_V_I(a,i),S_V_I(b,i));
		if (erg != (INT)0) return(erg);
	};
	if (S_V_LI(a) < S_V_LI(b)) return (INT) -1; /* AL 091194 */
	return((INT)0);
}


INT scan_bitvector(res) OP res;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 080591 V1.2 */
/* AK 200891 V1.3 */
{
	INT i,erg =OK;
	OP d,e;

	d = callocobject();
	e = callocobject();
	erg += printeingabe("input of a bitvector (0-1 vector)");
	erg += printeingabe("length of bit vector ");
	erg += scan(INTEGER,d);
	erg += b_l_v(d,e);
	for (i=(INT)0;i<S_V_LI(e); erg += scan(INTEGER,S_V_I(e,i++)));
	erg += t_INTVECTOR_BITVECTOR(e,res);
	erg += SYMfreeall(e);
	ENDR("scan_bitvector");
}

INT scan_integervector(res) OP res;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 080591 V1.2 */
/* AK 200891 V1.3 */
{
	INT i,erg =OK;
	OP d;

	d = callocobject();
	erg += printeingabe("length of INTEGER vector ");
	erg += scan(INTEGER,d);
	erg += b_l_v(d,res);
	for (i=(INT)0;i<S_V_LI(res); erg += scan(INTEGER,S_V_I(res,i++)));
	ENDR("scan_integervector");
}

INT scan_vector(res) OP res;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT i,erg=OK;
	OBJECTKIND kind;
	OP d;

	d = callocobject();
	erg += printeingabe("length of vector "); 
	erg += scan(INTEGER,d);
	erg += b_l_v(d,res);
	erg += printeingabe("kind of vector elements ");
	kind = scanobjectkind();
	for (i=(INT)0;i < S_V_LI(res); erg += scan(kind,S_V_I(res,i++)));
	ENDR("scan_vector");
}

#define CALLOCVECTORSTRUCT() (struct vector *)SYM_malloc(sizeof(struct vector))
static struct vector * callocvectorstruct()
/* AK 170889 V1.1 malloc statt calloc */ /* AK 211289 V1.1 */
/* AK 200891 V1.3 */
{
	struct vector * res =
	(struct vector *) SYM_malloc(sizeof(struct vector));
	if (res == NULL) 
		no_memory();
	return res;
}

INT b_ls_v(length,self,res) OP length, self,res;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	OBJECTSELF d;
	INT erg = OK;

	d.ob_vector = CALLOCVECTORSTRUCT();
	erg += b_ks_o(VECTOR, d,res); /* res will be freed */
	C_V_S(res,self); 
	C_V_L(res,length);
	ENDR("b_ls_v");
}


OP s_v_s(a) OP a; 
/* AK 270689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{ 
	OBJECTSELF c; 
	c = s_o_s(a);
	if (a==NULL) 
		{ 
		error("s_v_s:object == NULL"); 
		return(NULL); 
		}
	if (c.ob_vector==NULL) 
		{ 
		error( "s_v_s:vector pointer == NULL");
		return(NULL); 
		}
	if (not vectorp(a)) { /* AK 210192 */
		error("s_v_s: not VECTOR");
		return NULL;
		}
	return(c.ob_vector->v_self);
}

OP s_v_l(a) OP a; 
/* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{ 
	OBJECTSELF c; 
	OP erg=NULL;
	c = s_o_s(a);
	if (a==NULL) 
		{ 
		error("s_v_l:object == NULL"); 
		return(NULL); 
		}
	if (c.ob_vector==NULL)
		{  
		error( "s_v_l:vector pointer == NULL"); 
		return(NULL); 
		}
	if (not vectorp(a)) { /* AK 210192 */
		WTO("s_v_l",a);
		return NULL;
		}
	erg = c.ob_vector->v_length;
	if (s_o_k(erg) != INTEGER) 
		{  
		printobjectkind(erg);
		error( "s_v_l:length != INTEGER");
		return(NULL); 
		}
	if (s_i_i(erg) < (INT)0) 
		{  
		error( "s_v_l:length <0");
		return(NULL); 
		}
	return erg;
}


INT s_v_li(a) OP a; 
/* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{ 
	INT erg = s_i_i(s_v_l(a)); 
	return erg;
}

OP s_v_i(a,i) OP a; INT i; 
/* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{
	INT j;
	if (i<(INT)0) 
		{ 
		fprintf(stderr,"index = %ld\n",i);
		error("s_v_i:negative index"); 
		return(NULL); 
		}
	if (i >= (j=s_v_li(a)) ) 
		{ 
		fprintf(stderr,"index = %ld dimension = %ld\n",i,j);
		error("s_v_i:index too big"); 
		return(NULL); 
		}
	return(s_v_s(a) + (i));
}

INT c_v_i(a,i,b) OP a,b; INT i;
/* AK 170889 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{ 
	c_o_k(s_v_i(a,i),s_o_k(b)); 
	c_o_s(s_v_i(a,i),s_o_s(b)); 
	return(OK); 
}

INT s_v_ii(a,i) OP a; INT i;
/* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{ return(s_i_i(s_v_i(a,i))); }

INT c_v_s(a,b) OP a,b;
/* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{ 
	OBJECTSELF c; 
	c = s_o_s(a); 
	(c.ob_vector->v_self)=b; 
	return(OK); 
}

INT c_v_l(a,b) OP a,b;
/* AK 270689 V1.0 */ /* AK 201289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{ 
	OBJECTSELF c; 
	c = s_o_s(a); 
	(c.ob_vector->v_length)=b; 
	return(OK); 
}

INT lastof_vector(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{
	return(copy(S_V_I(a,S_V_LI(a)-(INT)1),b));
}

INT length_vector(a,b) OP a,b;
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 180691 V1.2 */
/* AK 200891 V1.3 */
{
	return(copy(S_V_L(a),b));
}


INT tex_vector(vecobj) OP vecobj;
/* AK 101187 */
/* mit tex werden alle elemente ausgegeben */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */
/* AK 070291 V1.2 prints to texout */
/* AK 200891 V1.3 */
{
	INT i,ot=texmath_yn;
	
	if (texmath_yn==0)
		{
		fprintf(texout,"\\ $[");
		texmath_yn = 1;
		}
	else
		fprintf(texout,"\\ [");

	for(	i = (INT)0; i<S_V_LI(vecobj); i++)
	{
		texposition += (INT)6;
		tex(S_V_I(vecobj,i));
		if (i != S_V_LI(vecobj)-1)
			{ fprintf(texout,","); texposition ++; }
	};

	fprintf(texout,"]\\ ");
	texposition += (INT)6;
	if (ot == 0) {
		fprintf(texout,"$ ");
		texmath_yn = 0;
		}
	return(OK);
}


INT fprint_vector(f,vecobj) FILE *f; OP vecobj;
/* AK 171186 */
/* AK 211186 als fprint */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT i;
	fprintf(f,"[");
	if (f == stdout) zeilenposition++;
	for(	i = (INT)0; i<S_V_LI(vecobj); i++)
	{
		fprint(f,S_V_I(vecobj,i));
		if (i != S_V_LI(vecobj)-1)
		{
			fprintf(f,",");
			if (f == stdout) { 
				zeilenposition++;
				if (zeilenposition >(INT)70) {
					fprintf(f,"\n");
					zeilenposition = (INT)0; 
				}
			}
		};
	};

	fprintf(f,"]");
	if (f == stdout) zeilenposition++;
	return(OK);
}




#ifdef VECTORTRUE
INT objectread_bv(filename,vec) FILE *filename; OP vec;
/* AK 220395 */
{
	OP t;
	INT erg = OK;
	t = callocobject();
	erg += objectread_vector(filename,t);
	erg += t_INTVECTOR_BITVECTOR(t,vec);
	erg += SYMfreeall(t);
	ENDR("objectread_bv");
}

INT objectread_vector(filename,vec) FILE *filename; OP vec;
/* AK 131086 */ /* AK 280689 V1.0 */ /* AK 211289 V1.1 */
/* AK 200891 V1.3 */
{
	INT i,erg = OK;
	OP length;
	length = callocobject();
	erg += objectread(filename,length);
	erg += b_l_v(length,vec);
	for (i=(INT)0;i<S_I_I(length);i++) 
		erg += objectread(filename,S_V_I(vec,i));
	ENDR("objectread_vector");
}
INT objectwrite_bv(filename,vec) FILE *filename; OP vec;
/* AK 220395 */
{
	INT erg = OK,i;
	OP t;
	t = callocobject();
	fprintf(filename," %d ",S_O_K(vec));
	erg += t_BITVECTOR_INTVECTOR(vec,t);

        erg += objectwrite(filename,S_V_L(t));

        for (i=(INT)0;i<S_V_LI(t);i++)
                erg += objectwrite(filename,S_V_I(t,i));
	erg += SYMfreeall(t);
        ENDR("objectwrite_bv");
}


INT objectwrite_vector(filename,vec) FILE *filename; OP vec;
/* AK 131086 */ /* AK 280689 V1.0 */ /* AK 211289 V1.1 */
/* AK 200891 V1.3 */
{
	INT i;
	INT erg = OK;
	fprintf(filename," %d ",S_O_K(vec));

	erg += objectwrite(filename,S_V_L(vec));

	for (i=(INT)0;i<S_V_LI(vec);i++) 
		erg += objectwrite(filename,S_V_I(vec,i));
	ENDR("objectwrite_vector");
}


INT inc_vector(a) OP a;
{
	return inc_vector_co(a,(INT) 1);
}

INT inc_vector_co(a,r) OP a; INT r;
/* AK 270887 */
/* verlaengert den vector um r leere objecte, welches am Ende steht */
/* dabei werden die vector elemente kopiert */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
{
	INT i,erg=OK;
	OP z;
	if (r == (INT)0) 
		goto endr_ende;
	if (r < (INT)0) 
		{
		erg += error("inc_vector_co: neg increment");
		goto endr_ende;
		}


	if ((S_V_LI(a) == (INT)0)&&(r==1))
		{
		z = callocobject();
		}
	else if (S_V_LI(a) == (INT)0)
		{
		i = (r) * (sizeof(struct object));
		z =  (OP ) SYM_malloc((unsigned) i);
		}
	else if (S_V_LI(a) == (INT)1)  /* AK 310197 */
		{
		i = (r+1) * (sizeof(struct object));
		z =  (OP ) SYM_malloc((unsigned) i);
		*z = *S_V_S(a);
		C_O_K(S_V_S(a),EMPTY);
		erg += SYMfreeall(S_V_S(a)); /* vector of length, the self part was allocated 
						using callocobject */
		}
	else {
		i = (S_V_LI(a) + r) * (sizeof(struct object));
		z =  (OP ) SYM_realloc((char*) S_V_S(a),(unsigned) i);
		}

	if (z == NULL)
		erg += error("inc_vector_co:self == NULL");

	C_V_S(a,z);
	for (i=0;i<r;i++)
		C_O_K(S_V_I(a,S_V_LI(a)+i),EMPTY);
	erg += m_i_i(S_V_LI(a) + r, S_V_L(a));
	ENDR("inc_vector_co");
}
#endif /* VECTORTRUE */

#ifdef VECTORTRUE
INT sum_vector(vecobj,res) OP vecobj,res;
/* berechnet die summe der vectorelemente AK 270787 */
/* AK 280689 V1.0 */ /* AK 081289 V1.1 */ /* AK 070891 V1.3 */
{
	INT i;
	INT erg = OK;
	M_I_I((INT)0,res);
	for (	i=(INT)0; i < S_V_LI(vecobj);i++)
		erg += add_apply(	 S_V_I(vecobj,i), res);
	ENDR("sum_vector");
}
#endif /* VECTORTRUE */



INT max_vector(vec,m) OP vec,m;
/* kopiert maximales element */
/* AK 280689 V1.0 */ /* AK 050390 V1.1 */ /* AK 100691 V1.2 */ 
/* AK 070891 V1.3 */
{
	INT i;
	INT erg = OK;
	OP zm;
	zm = S_V_I(vec,(INT)0);
	for(i=(INT)1;i<S_V_LI(vec);i++)
		if (GR(S_V_I(vec,i),zm)) zm = S_V_I(vec,i);
	erg += copy(zm,m);
	ENDR("max_vector");
}

INT mult_scalar_vector(a,b,c) OP a,b,c;
/* AK 010888 skalarmultiplikation */
/* a ist skalar b ist vector c wird vector */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
{
	INT i = (INT)0;
	INT erg = OK;
	erg += m_il_v(S_V_LI(b),c);
	C_O_K(c,S_O_K(b));
	for (i=(INT)0; i<S_V_LI(c); i++)
		erg += mult(a, S_V_I(b,i), S_V_I(c,i));
	ENDR("mult_scalar_vector");
}

#ifdef VECTORTRUE
#ifdef MATRIXTRUE
INT mult_vector_matrix(a,b,c) OP a, b, c;
/* AK 200192 */
{
	INT i,j;
	INT erg = OK;
	OP d;
	if (S_O_K(a) != VECTOR) return ERROR;
	if (S_O_K(b) != MATRIX) return ERROR;
	if ((a == c) || (b == c)) return ERROR;
	if (S_V_LI(a) != S_M_HI(b)) return ERROR;
	erg += m_il_nv(S_M_LI(b),c);
	d = callocobject();
	for (i=(INT)0;i<S_V_LI(c);i++)
	for (j=(INT)0;j<S_V_LI(a);j++)
		{
		erg += mult(S_V_I(a,j),S_M_IJ(b,j,i),d);
		erg += add_apply(d,S_V_I(c,i));
		}
	erg += SYMfreeall(d);
	ENDR("mult_vector_matrix");
}
#endif /* MATRIXTRUE */
#endif /* VECTORTRUE */

INT mult_vector_vector(a,b,c) OP a, b, c;
/* AK 110588  componentenweise multiplication */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
{
	INT i = (INT)0;

	if (S_V_LI(a) !=  S_V_LI(b))
	{
		fprintf(stderr,"size of a: "); fprintln(stderr,S_V_L(a));
		fprintf(stderr,"size of b: "); fprintln(stderr,S_V_L(b));
		return error("mult_vector_vector:different size of vectors ");
	}
	else {
		if (not EMPTYP(c)) freeself(c);
		m_il_v(S_V_LI(a),c);
		for (i=(INT)0;i<S_V_LI(b);i++)
			mult(S_V_I(a,i),S_V_I(b,i),S_V_I(c,i));
		};
	return(OK);
}

INT scalarproduct_vector(a,b,d) OP a,b,d;
/* AK 141189 V1.1 */ /* AK 070891 V1.3 */
{
	INT i;
	INT erg = OK; /* AK 200192 */
	OP c;

	if (S_V_LI(a) != S_V_LI(b)) {
		erg += error("scalarproduct_vector:different length");
		goto ende;
	}
	c = callocobject();
	for (i=S_V_LI(a)-(INT)1;i>=(INT)0;i--)
	{
		erg += mult(S_V_I(a,i),S_V_I(b,i),c);
		erg += add_apply(c,d);
	}
	erg += SYMfreeall(c);
ende:
	ENDR("scalarproduct_vector");
}

INT dec_vector(a) OP a;
/* AK 120187  kuerzt den vector um 1 */
/* das letzte element wird gestrichen */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
{
	INT erg = OK; /* AK 100893 */
	OP zz;
	if (S_V_LI(a) == (INT)0 )
	{
		erg += error("dec_vector:initial length == 0");
		goto ende;
	}
	if (not EMPTYP(S_V_I(a,S_V_LI(a)-(INT)1)))  /* AK 260991 */
		erg += freeself(S_V_I(a,S_V_LI(a)-(INT)1));
	/* freigeben des speicherplatzes des letzten vectorelements */
	DEC_INTEGER(S_V_L(a));
	/* verkuerzen der laenge um eins */
	if (S_V_LI(a) == (INT)1) /* AK 111093 */
		{
		zz = S_V_S(a);
		C_V_S(a,callocobject());
		*(S_V_S(a)) = *zz;
		SYM_free(zz);
		}
	else if (S_V_LI(a) == (INT)0) /* AK 100893 */
		{
		erg += SYMfreeall(S_V_S(a));
		C_V_S(a,NULL);
		}
ende:
	ENDR("dec_vector");
}

#ifdef VECTORTRUE
INT append_vector(a,b,c) OP a, b, c;
/* haengt den vector b an den vector a an */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
{
	INT		i,length;
	INT erg = OK;
	if ((a == c) || (b == c))
		{
		erg += ERROR;
		goto endr_ende;
		}

	if (not VECTORP(b)) /* AK 291292 */
		{
		OP d = callocobject();
		erg += m_o_v(b,d);
		erg += append_vector(a,d,c);
		erg += SYMfreeall(d);
		goto endr_ende;
		}
	length=S_V_LI(a)+S_V_LI(b);
	erg += m_il_v(length,c);
	if (S_O_K(a) == S_O_K(b)) /* AK 030295 */
		C_O_K(c,S_O_K(a));
	else
		C_O_K(c,VECTOR);
	for(	i=(INT)0;i<length; i++)
		if (i < S_V_LI(a))
			erg += copy(S_V_I(a,i),S_V_I(c,i));
		else
			erg += copy(S_V_I(b,i-S_V_LI(a)),S_V_I(c,i));
	ENDR("append_vector");
}
#endif /* VECTORTRUE */

INT mult_apply_vector(a,b) OP a, b;
/* AK 070891 V1.3 */
{
	INT erg = OK;
	switch (S_O_K(b)) {
		case VECTOR: 
			erg += mult_apply_vector_vector(a,b); break;
		default:
			erg = error("mult_apply_vector: wrong type"); break;
		}
	return erg;
}

INT mult_apply_vector_vector(a,b) OP a, b;
/* AK 110588  componentenweise multiplication */
/* AK 280689 V1.0 */ /* AK 211289 V1.1 */ /* AK 070891 V1.3 */
{
	INT i = (INT)0;
	INT erg = OK;

	if (S_V_LI(a) !=  S_V_LI(b))
	{
		fprintf(stderr,"size of a: "); fprintln(stderr,S_V_L(a));
		fprintf(stderr,"size of b: "); fprintln(stderr,S_V_L(b));
	erg +=  error("mult_apply_vector_vector:different size of vectors ");
		goto ende;
	}
	else {
		for (i=(INT)0;i<S_V_LI(b);i++)
			erg += mult_apply(S_V_I(a,i),S_V_I(b,i));
		};
ende:
	ENDR("mult_apply_vector_vector");
}

#ifdef VECTORTRUE
INT nullp_integervector(a) OP a;
/* AK 311091 */
{
	INT i;
	for (i=(INT)0;i<S_V_LI(a); i++)
		{
		if (not INTEGERP(S_V_I(a,i)))
			C_O_K(a, VECTOR);
		if (not nullp(S_V_I(a,i)))
			return FALSE;
		}
	return TRUE;
}

INT nullp_vector(a) OP a;
/* AK 311091 */
{
	INT i;
	for (i=(INT)0;i<S_V_LI(a); i++)
		if (not nullp(S_V_I(a,i)))
			return FALSE;
	return TRUE;
}

INT index_vector(a,b) OP a,b;
/* AK 010393 */
{
	INT i;
	for (i=(INT)0;i<S_V_LI(b);i++)
		{
		if (EQ(S_V_I(b,i),a))
			return i;
		}
	return (INT)-1;
}

INT delete_entry_vector(a,index,b) OP a,b; INT index;
/* AK 220296 */
{
	INT i,j, erg = OK;
	if (a == b) 
		{
		OP c = callocobject();
                *c = *b;
                C_O_K(b,EMPTY);
                erg += delete_entry_vector(c,index,b);
                erg += SYMfreeall(c);
                goto endr_ende;
		}
	erg += m_il_v(S_V_LI(a)-1,b);
	for (i=0,j=0;i<S_V_LI(b);i++)
		{
		if (j == index) j++;
		erg += copy(S_V_I(a,j),S_V_I(b,i));
		j++;
		}
	ENDR("delete_entry_vector");
}

OP find_vector(a,b) OP a,b;
/* AK 010393 */
{
	INT i = index_vector(a,b);
	if (i == (INT)-1)
		return NULL;
	else
		return S_V_I(b,i);
}

#endif /* VECTORTRUE */

#ifdef VECTORTRUE
INT t_INTVECTOR_UCHAR(a,b) OP a; char **b;
{
	INT i;
	*b = SYM_malloc((int) S_V_LI(a)+1);
	if ((*b) == NULL)
		return ERROR;
	(*b)[0]=(unsigned char) S_V_LI(a);
	for (i=(INT)1;i<=S_V_LI(a);i++)
		(*b)[i] = (unsigned char) S_V_II(a,i-(INT)1);
	return OK;
}
INT t_UCHAR_INTVECTOR(a,b) OP b; char *a;
{
	INT erg = OK;
	INT i;
	erg += m_il_v((INT)a[0],b);
	for (i=(INT)0;i<S_V_LI(b);i++)
		M_I_I(a[i+1], S_V_I(b,i));
	ENDR("t_UCHAR_INTVECTOR");
}
#endif /* VECTORTRUE */

#ifdef VECTORTRUE
INT comp_numeric_vector(a,b) OP a,b;
/* AK 020893 */
{
	INT i,m,erg=OK;
	OP c;
	if (not VECTORP(a) || not VECTORP(b))
			{
			WTT("comp_numeric_vector",a,b);
			goto endr_ende;
			}
	if (S_V_LI(a) < S_V_LI(b)) 
		{
		c = a;
		a = b;
		b = c; m = (INT)-1;
		}
	else
		m = (INT)1;

	for (i=(INT)0;i<S_V_LI(a);i++)
		if (S_O_K(S_V_I(a,i)) != INTEGER)
			return error("comp_numeric_vector:no INTEGER entry");
		else if (S_O_K(S_V_I(b,i)) != INTEGER)
			return error("comp_numeric_vector:no INTEGER entry");
		else if (S_V_II(a,i) < S_V_II(b,i))
			return m * (INT)-1;
		else if (S_V_II(a,i) > S_V_II(b,i))
			return m ;
	for (;i<S_V_LI(b);i++)
		if (S_O_K(S_V_I(b,i)) != INTEGER)
			return error("comp_numeric_vector:no INTEGER entry");
		else if (S_V_II(b,i) < (INT)0)
			return m ;
		else if (S_V_II(b,i) > (INT)0)
			return m * (INT)-1;
	return (INT)0;
	ENDR("comp_numeric_vector");
}
#endif /* VECTORTRUE */

#ifdef VECTORTRUE
INT add_apply_integervector(a,b) OP a, b;
/* b = b+a */
/* AK 211289 V1.1 */ /* AK 200891 V1.3 */
{
	INT i,erg = OK;
	if (not VECTORP(b))
		return WTT("add_apply_integervector",a,b);

	if (S_V_LI(a) > S_V_LI(b))
	{
		i  = S_V_LI(b);
		inc_vector_co(b,S_V_LI(a) - S_V_LI(b));
		for (; i<S_V_LI(a); i++)
			M_I_I((INT)0,S_V_I(b,i));
	}
	for (i=(INT)0;i<S_V_LI(b);i++)
		if 	(i < S_V_LI(a))
			{
			if (INTEGERP(S_V_I(a,i)) && INTEGERP(S_V_I(b,i)))
			{
			erg += add_apply_integer_integer(S_V_I(a,i),S_V_I(b,i));
			if (not INTEGERP(S_V_I(b,i))) /* AK 310195 */
				C_O_K(b,VECTOR);
			}
			else if (INTEGERP(S_V_I(a,i))) {
				erg += add_apply(S_V_I(a,i),S_V_I(b,i));
                                C_O_K(b,VECTOR);
				}
			else {
			    erg += add_apply(S_V_I(a,i),S_V_I(b,i));
				C_O_K(a,VECTOR);
			if (not INTEGERP(S_V_I(b,i))) /* AK 310195 */
				C_O_K(b,VECTOR);
                   		}
			}
		else break;
	ENDR("add_apply_integervector");
}

INT copy_bitvector(vec,res) OP vec, res;
/* AK 180396 */
{
	INT erg = OK;
	erg += m_il_bv(	S_V_LI(vec), res);
	memcpy(S_V_S(res),S_V_S(vec), S_BV_LI(vec));
	C_O_K(res,S_O_K(vec));
	ENDR("copy_bitvector");
}

INT copy_integervector(vec,res) OP vec, res;
/* AK 021286 */ /* AK 280689 V1.0 */ /* AK 081289 V1.1 */
/* AK 120391 V1.2 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += m_il_v(	S_V_LI(vec), res);
	memcpy(S_V_S(res),S_V_S(vec), S_V_LI(vec) * sizeof(struct object));
	C_O_K(res,S_O_K(vec));
	ENDR("copy_integervector");
}



#endif /* VECTORTRUE */
#ifdef VECTORTRUE
INT comp_colex_vector(a,b) OP a,b;
/* a,b vectors colex order */
/* AK V1.1 151189 */ /* AK 200891 V1.3 */
{
        INT i = S_V_LI(a)-1;
        INT j = S_V_LI(b)-1;
        INT erg;

        if (not VECTORP(a))
                error("comp_colex_vector:kind != VECTOR");
        if (not VECTORP(b))
                error("comp_colex_vector:kind != VECTOR");


        for (;(i >= (INT)0) || (j>=(INT)0); i--,j--)
        {
                if (i<(INT)0) return((INT)1);
                if (j<(INT)0) return((INT)-1);
                erg = comp(S_V_I(a,i),S_V_I(b,j));
                if (erg <(INT)0) return((INT)1);
                if (erg >(INT)0) return((INT)-1);
        }
        return((INT)0);
}

#endif /* VECTORTRUE */

#ifdef VECTORTRUE

/* laenge in byte */
INT unset_bv_i(a,i) OP a; INT i;
/* ite bit auf 0 setzen */
{
	INT erg = OK;
	CTO(BITVECTOR,"unset_bv_i",a);
	if (S_V_LI(a) < i)
		return error("unset_bv_i: index to big");
	if (i< 0)
		return error("unset_bv_i: index negativ");
	*((unsigned char *)S_V_S(a)  + (i/8))  &= (~(1 << (i%8)));

	ENDR("unset_bv_i");
}
INT set_bv_i(a,i) OP a; INT i;
/* ite bit setzen */
{
	INT erg = OK;
	CTO(BITVECTOR,"set_bv_i",a);
	if (S_V_LI(a) < i)
		return error("set_bv_i: index to big");
	if (i< 0)
		return error("set_bv_i: index negativ");
	*((unsigned char *)S_V_S(a)  + (i/8))  |= (1 << (i%8));

	ENDR("set_bv_i");
}
INT get_bv_i(a,i) OP a; INT i;
{
	INT erg = OK;
	CTO(BITVECTOR,"set_bv_i",a);
	if (S_V_LI(a) < i)
		return error("set_bv_i: index to big");
	if (i< 0)
		return error("set_bv_i: index negativ");
	return (*(((unsigned char *)S_V_S(a) ) + i/8)  >> (i%8))%2;
	ENDR("get_bv_i");
	
}


INT fprint_bitvector(fp,a) OP a; FILE *fp;
{
	INT i,erg = OK;
	CTO(BITVECTOR,"fprint_bitvector",a);
	for (i=0;i<S_V_LI(a);i++)
		{
		fprintf(fp,"%d",get_bv_i(a,i));
		if (fp == stdout)
			{
			zeilenposition ++;
			if (zeilenposition > 70)
				{
				printf("\n");
				zeilenposition = 0;
				}
			}
		}
	ENDR("fprint_bitvector");
}


INT t_INTVECTOR_BITVECTOR(a,b) OP a,b;
{
	INT erg = OK;
	unsigned char  *self;
	INT i,j,k,l;
	if (not VECTORP(a))
		{
		WTO("t_INTVECTOR_BITVECTOR",a);
		goto endr_ende;
		}
	if (a == b)
		return ERROR;
	/* a is INTVECTOR object */
	l =  S_V_LI(a);
	self = (unsigned char  *)SYM_calloc(l/8+1,1);
	for (i=0,j=0,k=1;i<S_V_LI(a);i++,k*=2 )
		{
		if (k == 256) { j ++; k = 1;}
		if ((S_V_II(a,i)%2) == 0)
			self[j] = self[j] & (0177 ^ k);
		else
			self[j] = self[j] | k;

		}
	erg += b_ls_v(callocobject(),self,b);
	M_I_I(S_V_LI(a),S_V_L(b));
	C_O_K(b,BITVECTOR);
	ENDR("t_INTVECTOR_BITVECTOR");
}

INT nullp_bitvector(bit) OP bit;
{
	unsigned char *self;
	INT l,i;
	self = (unsigned char *) S_V_S(bit);
	l =  S_V_LI(bit);
	for (i=0;i<= (l/8);i++)
		if (self[i] != 0) return FALSE;
	return TRUE;
}

INT sup_bitvector(bit1, bit2, res) OP bit1,bit2,res;
{
	unsigned char  *self, *bs1, *bs2;
	INT erg = OK;
	INT i,l;
	if (S_V_LI(bit1) != S_V_LI(bit2))
		error("sup_bitvector:diff lengths");
	l =  S_V_LI(bit1);
	bs1 = (unsigned char *) S_V_S(bit1);
	bs2 = (unsigned char *) S_V_S(bit2);
	self = (unsigned char  *)SYM_calloc(l,1);
	for (i=0;i<= (l/8);i++)
		self[i] = bs1[i] | bs2[i];
	erg += b_ls_v(callocobject(),self,res);
        M_I_I(l,S_V_L(res));
        C_O_K(res,BITVECTOR);
        ENDR("sup_bitvector");
}

INT inf_bitvector(bit1, bit2, res) OP bit1,bit2,res;
{
	unsigned char  *self, *bs1, *bs2;
	INT erg = OK;
	INT i,l;
	if (S_V_LI(bit1) != S_V_LI(bit2))
		error("inf_bitvector:diff lengths");
	l =  S_V_LI(bit1);
	bs1 = (unsigned char *) S_V_S(bit1);
	bs2 = (unsigned char *) S_V_S(bit2);
	self = (unsigned char  *)SYM_calloc(l,1);
	for (i=0;i<= (l/8);i++)
		self[i] = bs1[i] & bs2[i];
	erg += b_ls_v(callocobject(),self,res);
        M_I_I(l,S_V_L(res));
        C_O_K(res,BITVECTOR);
        ENDR("inf_bitvector");
}

INT exor_bitvector_apply(bit1,  res) OP bit1,res;
{
	unsigned char  *self, *bs1, *bs2;
	INT erg = OK;
	INT i,l;
	if (S_V_LI(bit1) != S_V_LI(res))
		error("exor_bitvector_apply:diff lengths");
	l =  S_V_LI(bit1);
	bs1 = (unsigned char *) S_V_S(bit1);
	bs2 = (unsigned char *) S_V_S(res);
	for (i=0;i<= (l/8);i++)
		bs2[i] ^= bs1[i] ;
        ENDR("exor_bitvector_apply");
}



INT inf_bitvector_apply(bit1,  res) OP bit1,res;
{
	unsigned char  *self, *bs1, *bs2;
	INT erg = OK;
	INT i,l;
	if (S_V_LI(bit1) != S_V_LI(res))
		error("inf_bitvector_apply:diff lengths");
	l =  S_V_LI(bit1);
	bs1 = (unsigned char *) S_V_S(bit1);
	bs2 = (unsigned char *) S_V_S(res);
	for (i=0;i<= (l/8);i++)
		bs2[i] &= bs1[i] ;
        ENDR("inf_bitvector_apply");
}



INT t_BITVECTOR_INTVECTOR(a,b) OP a,b;
{
	unsigned char  *self;
	INT i,j,k;
	if (a == b)
		return ERROR;
	/* a is INTVECTOR object */
	self = (unsigned char  *) S_V_S(a);
	m_il_v(S_V_LI(a),b);
	for (i=0,j=0,k=1;i<S_V_LI(b);i++,k*=2 )
		{
		if (k==256) { j ++; k = 1;}
		if (self[j] & k) 
			M_I_I((INT)1,S_V_I(b,i));
		else 
			M_I_I((INT)0,S_V_I(b,i));
		}
	C_O_K(b,INTEGERVECTOR);
	return OK;
}

INT t_VECTOR_BIT(a,b) OP a,b;
/* AK 091294 */
{
	INT erg = OK;
	INT il,i,j,k;
	unsigned char *self;
	CTO(PARTITION,"t_VECTOR_BIT",a);
	if (S_PA_K(a) != VECTOR)
		return error("t_VECTOR_BIT input no VECTOR kind PARTITION object");
	if (check_equal_2(a,b,t_VECTOR_BIT,&erg) == EQUAL)
                return erg;
	
	il = S_PA_LI(a) + S_PA_II(a,S_PA_LI(a)-(INT)1); 
		/* laenge des bit vectors i n bit */
	erg += b_ks_pa(BITVECTOR,callocobject(),b);
	erg += b_ls_v(callocobject(),NULL,S_PA_S(b));
	M_I_I(il,S_PA_L(b));
	C_O_K(S_PA_S(b),BITVECTOR);
	self = (unsigned char *) SYM_calloc(S_BV_LI(S_PA_S(b)),1);
	C_V_S(S_PA_S(b),self);
	for  (i=(INT)0,j=S_PA_LI(a)-1,k=S_PA_II(a,S_PA_LI(a)-1);i<il;i++)
		{
		if (j== -1) /* nur noch einsen */
			{
			set_bv_i(S_PA_S(b),i);
			k--;
			}
		else if (k > S_PA_II(a,j))
			{
                        set_bv_i(S_PA_S(b),i);
                        k--;
			}
		else 	{
			j--;
			}
		}
	if (k != 0)
		return error("t_VECTOR_BIT: internal error tVB-0");
	if (j != -1)
		return error("t_VECTOR_BIT: internal error tVB-1");
	ENDR("t_VECTOR_BIT");
}

static INT maxpart_bitvector_part_i(a) OP a;
{
	INT i,j=0;
	for (i=0;i<=S_V_LI(a);i++)
		{
		if (GET_BV_I(a,i) != (INT)1) break;
		}
	/* d.h. i ist die 0 */
	for (;i<=S_V_LI(a);i++)
		if (GET_BV_I(a,i) == (INT)1) j++;
	return j;
	/* maximaler teil */
}

static INT length_bitvector_part_i(a) OP a;
{
	INT i,j=0,k;
	for (i=S_V_LI(a)-1;i>=0;i--)
		{
		if ((k=GET_BV_I(a,i)) != (INT)0) break;
		}
	/* d.h. i ist die letzte 1 */
	for (k=(INT)0;k<i;k++)
		if (GET_BV_I(a,k) == (INT)0) j++;
	return j;
}

INT t_BIT_VECTOR(a,b) OP a,b;
/* AK 121294 */
{
	unsigned char *self;
	INT erg = OK;
	INT il, i,j,k;
	if (S_O_K(a) != PARTITION)
		return WTO("t_BIT_VECTOR",a);
	if (S_PA_K(a) != BITVECTOR)
		return error("t_BIT_VECTOR input no BITVECTOR kind PARTITION object");
	if (check_equal_2(a,b,t_BIT_VECTOR,&erg) == EQUAL)
                return erg;

	il = length_bitvector_part_i(S_PA_S(a)); /* Anzahl teile */

	b_ks_pa(VECTOR,callocobject(),b);
	m_il_v(il,S_PA_S(b));
	j=0;k=0;
	for (i=S_PA_LI(a)-1;i>=0;i--)
		{
		if(GET_BV_I(S_PA_S(a),i) == 1) break;
		}
	for (;k<il;i--)
		if (GET_BV_I(S_PA_S(a),i) == 1) 
			j++;
		else
			{
			M_I_I(j,S_PA_I(b,k));
			k++;
			}
	ENDR("t_BIT_VECTOR");
}

static INT dimension_bit_co();
INT dimension_bit(a,b) OP a,b;
{
	INT erg = OK;
	if (S_O_K(a) != PARTITION)
                return WTO("dimension_bit",a);
        if (S_PA_K(a) != BITVECTOR)
	return error("dimension_bit input no BITVECTOR kind PARTITION object");
        if (check_equal_2(a,b,dimension_bit,&erg) == EQUAL)
                return erg;
	m_i_i((INT)0,b);
	erg += dimension_bit_co(S_PA_S(a),b,(INT)1);
	ENDR("dimension_bit");
}

static INT dimension_bit_co(a,b,sig) OP a,b; INT sig;
/* AK 141294 */
{
	INT nu,is,i,il,j,jo,k,l,erg=OK;
	OP c,d;
                
	il = length_bitvector_part_i(a);
	is = maxpart_bitvector_part_i(a);
	c = callocobject();
	d = callocobject();
	erg += m_il_v(is,c);
	C_O_K(c,INTEGERVECTOR);
	M_I_I((INT)1,d);
	j=0;k=0;
        for (i=S_V_LI(a)-1;i>=0;i--)
                {
                if(GET_BV_I(a,i) == 1) break;
                }
	/* hier geht die partition los */
	nu = 0;
        for (;k<il;i--)
                if (GET_BV_I(a,i) == 1)
                        j++;
                else
                        {
			if (k==0)
				{
				for (l=0;l<j;l++)
					M_I_I(j-l,S_V_I(c,l));
				nu += j;
				jo = j;
				}
			else {
				for (l=0;l<jo;l++)
					{
					erg += mult_apply_integer(S_V_I(c,l),d);
					M_I_I(S_V_II(c,l)+1+j-jo, S_V_I(c,l));
					}
				for (;l<j;l++)
					M_I_I(j-l,S_V_I(c,l));
				nu += j;
				jo = j;
			     }
                        k++;
                        }

	k=0;
	for (i=(INT)0;i<jo;i++)
		erg += mult_apply_integer(S_V_I(c,i),d);	
	erg += freeself(c);
	erg += M_I_I(nu,c);
	erg += fakul(c,c);
	erg += ganzdiv_apply(d,c);
	if (sig == (INT)1)
		add_apply(c,b);
	else
		sub(b,c,b);
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	ENDR("internal routine:dimension_bit_co");
}

static charvalue_bit_co();
INT charvalue_bit (a,b,scv) OP a,b,scv;
{
	INT erg = OK;
	if (S_O_K(a) != PARTITION)
		if (S_PA_K(a) != BITVECTOR)
			return ERROR;
	if (S_O_K(b) != PARTITION)
		if (S_PA_K(b) != VECTOR)
			return ERROR;
	if (EMPTYP(scv))
		M_I_I((INT)0,scv);
	else if (S_O_K(scv) == INTEGER)
		M_I_I((INT)0,scv);
	else
		m_i_i((INT)0,scv);
	charvalue_bit_co(S_PA_S(a),S_PA_S(b),scv,S_PA_LI(b)-(INT)1,(INT)1);
	return erg;
}

static charvalue_bit_co(a,b,c,index,sig) OP a,b,c;register INT index,sig;
{
	INT i,j,k,l,lh,hakenlaenge, ol;
	unsigned char *uc,*uch;

	if ((S_V_II(b,index) == (INT)1) 
		&&
		(index >= 6) 
	)		
			{
			dimension_bit_co(a,c,sig);
			return OK;
			}

	i=S_V_LI(a)-1;
	uc = ((unsigned char *) S_V_S(a)) + (i/8); 
	l = i%8;
	for (;i>=0;i--,l--)
		{
		if (l < 0) {l+=8;uc--;}
		/* if (GET_BV_I(a,i) != 0) break; */
		if (GET_BIT_I(uc,l) != 0) break;
		}
	ol = S_V_LI(a);
	M_I_I(i+1,S_V_L(a));
	/* i index erster wagrechter eintrag */
	hakenlaenge = S_V_II(b,index); 
	uch = ((unsigned char *) S_V_S(a)) + ((i-hakenlaenge)/8); 
	lh = (i-hakenlaenge)%8;
	for (;i>=hakenlaenge;i--,l--,lh--)
		{
		if (l < 0) {l+=8;uc--;} 
		if (lh < 0) {lh+=8;uch--;} 
		/* if (GET_BV_I(a,i) != 1) continue; */
		if (GET_BIT_I(uc,l) != 1) continue;
		/*if (GET_BV_I(a,i-hakenlaenge) != 0) continue; */
		if (GET_BIT_I(uch,lh) != 0) continue;
		k = 0;
		for (j=i-1;j>i-hakenlaenge;j--)
			if (GET_BV_I(a,j) == 0) k++;

		/* k is leglength */
		if (index == (INT)0)
			{
			if (k%2 == 1) sig *= -1;
			if (sig==1) inc(c); else dec(c);
			goto ende;
			}

		/* UNSET_BV_I(a,i); */
		UNSET_BIT_I(uc,l);
		/* SET_BV_I(a,i-hakenlaenge); */
		SET_BIT_I(uch,lh);
		if (k%2 == 0)
			charvalue_bit_co(a,b,c,index-1,sig);
		else 
			charvalue_bit_co(a,b,c,index-1,sig* ((INT)-1));
		/* SET_BV_I(a,i); */
		SET_BIT_I(uc,l);
		/* UNSET_BV_I(a,i-hakenlaenge); */
		UNSET_BIT_I(uch,lh);
		}
ende:
	M_I_I(ol,S_V_L(a));
	return OK;
/* #undef hakenlaenge */
}

	
#endif /* VECTORTRUE */
	
