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

static struct list * calloc_list(void);
static INT free_list(struct list *);

static INT mem_counter_list;
static int list_speicherindex=-1;
static int list_speichersize=0;
static struct list **list_speicher=NULL;


#ifdef LISTTRUE
INT list_anfang(void)
    {
    mem_counter_list=0L;
    return OK;
    }

INT list_ende(void)
    {
    INT erg = OK;

    if (list_speicher!=NULL)
        {
        INT i;
        for (i=0;i<=list_speicherindex;i++)
            SYM_free(list_speicher[i]);
        SYM_free(list_speicher);
        }

    list_speicher=NULL;
    list_speicherindex=-1;
    list_speichersize=0;

    ENDR("list_ende");
    }


/* true falls es sich um eine leere liste handelt d.h. self == NULL */
INT empty_listp(OP a)
{
    if (not listp(a))
        return FALSE;
    if (S_L_S(a) != NULL)
        return FALSE;
    return TRUE;
}


/* ausgabe eines list-objects ausgabe bis einschliesslich next == NULL */
INT fprint_list(FILE *f, OP list)
{
    INT erg = OK;
    OP zeiger = list;
    OBJECTSELF d;

    COP("fprint_list(1)",f);

    if (list == NULL)
        {
        erg +=  NOP("fprint_list");
        goto fple;
        }
    d = S_O_S(list);
    if (d.ob_list == NULL)
        return error("fprint_list:s_o_s == NULL");

    if     ((S_L_S(list) == NULL)&&(S_L_N(list)==NULL))

    /* so wird ein list object initialisiert mit b_sn_l(NULL,NULL,obj) */
        {
        fprintf(f,"empty list");
        if (f == stdout)
            {
            zeilenposition += 10L;
            if (zeilenposition >row_length)
                {
                fprintf(stdout,"\n");
                zeilenposition = 0L;
                }
            }
        }
    else
        while (zeiger != NULL)
        {
            if (not LISTP(zeiger))
                {
                WTO("fprint_list:internal",zeiger);
                goto fple;
                }
            erg += fprint(f,S_L_S(zeiger));
            fprintf(f,"  ");
            if (f == stdout)
            {
                zeilenposition += 2L;
                if (zeilenposition >row_length)
                {
                fprintf(stdout,"\n");
                zeilenposition = 0L;
                }
            }
            zeiger=S_L_N(zeiger);
        }
fple:
    ENDR("fprint_list");
}
#endif /* LISTTRUE */



/* fuegt das object von in die liste nach ein
 * moegliche faelle:
 *  a) zwei listen
 *  b) von ist ein scalar und kann in das entsprechende list object
 *     umgewandelt werden
 *  c) a ist hashtable und die objecte werden eingefuegt
 *  d) a ist monom und wird in das entsprechende LIST object umgewandelt
*/
INT insert_list(OP von, OP nach, INT (*eh)(OP,OP), INT (*cf)(OP,OP))
{
    OP c;
    INT erg = OK;
    if (LISTP(von))  /* fall a */
        {
        erg += insert_list_list(von,nach,eh,cf);
        goto endr_ende;
        }

    if (S_O_K(von) == HASHTABLE) { /* fall c */
        if (S_O_K(nach) == MONOMIAL) {
            erg += t_HASHTABLE_MONOMIAL(von,von);
            insert_list_list(von,nach,eh,cf);
            goto endr_ende;
            }
        if (S_O_K(nach) == SCHUR) {
            erg += t_HASHTABLE_SCHUR(von,von);
            insert_list_list(von,nach,eh,cf);
            goto endr_ende;
            }
        if (S_O_K(nach) == HOMSYM) {
            erg += t_HASHTABLE_HOMSYM(von,von);
            insert_list_list(von,nach,eh,cf);
            goto endr_ende;
            }
        if (S_O_K(nach) == POWSYM) {
            erg += t_HASHTABLE_POWSYM(von,von);
            insert_list_list(von,nach,eh,cf);
            goto endr_ende;
            }
        if (S_O_K(nach) == ELMSYM) {
            erg += t_HASHTABLE_ELMSYM(von,von);
            insert_list_list(von,nach,eh,cf);
            goto endr_ende;
            }
        FORALL(c,von, {
            OP f;
            f = CALLOCOBJECT();
            erg += swap(c,f);
            insert_list(f,nach,eh , cf);
            });
        erg += freeall(von);
        goto endr_ende;
        }


    if (S_O_K(nach) == POLYNOM)
        {
        if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_skn_po(CALLOCOBJECT(),von,NULL,c);
            erg += m_il_v(1L,S_PO_S(c));
            erg += m_i_i(0L,S_PO_SI(c,0L));
            }
        else if (S_O_K(von) == MONOM)
            {
            CTTTTO(INTEGERMATRIX,MATRIX,
                   INTEGERVECTOR,VECTOR,"insert_list(1-monom-self)",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_l(von,NULL,c);
            C_O_K(c,POLYNOM);
            }
        else
            {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }

#ifdef SCHURTRUE
    else if (S_O_K(nach) == SCHUR)
        {
        if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_scalar_schur(von,c);
            }
        else if (S_O_K(von) == MONOM)
            {
            CTO(PARTITION,"insert_list",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_s(von,NULL,c);
            }
        else
            {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }
    else if (S_O_K(nach) == HOMSYM)
        {
        if (S_O_K(von) == MONOM)
            {
            CTO(PARTITION,"insert_list",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_h(von,NULL,c);
            }
        else if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_scalar_homsym(von,c);
            }
        else
            { 
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }
    else if (S_O_K(nach) == MONOMIAL)
        {
        if (S_O_K(von) == MONOM)
            {
            CTO(PARTITION,"insert_list",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_mon(von,NULL,c);
            }
        else if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_scalar_monomial(von,c);
            }
        else
            {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }

    else if (S_O_K(nach) == ELMSYM)
        {
        if (S_O_K(von) == MONOM)
            {
            CTO(PARTITION,"insert_list",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_e(von,NULL,c);
            }
        else if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_scalar_elmsym(von,c);
            }
        else
            {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }
 
    else if (S_O_K(nach) == POWSYM)
        {
        if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_scalar_powsym(von,c);
            }
        else if (S_O_K(von) == MONOM)
            {
            CTO(PARTITION,"insert_list",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_ps(von,NULL,c);
            }
        else
            {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }

#endif /* SCHURTRUE */

#ifdef SCHUBERTTRUE
    else if (S_O_K(nach) == SCHUBERT)
        {
        if (scalarp(von))
            {
            c = CALLOCOBJECT();
            erg += b_skn_sch(CALLOCOBJECT(),von,NULL,c);
            erg += m_ks_p(VECTOR,CALLOCOBJECT(),S_SCH_S(c));
            erg += m_il_v(1L,S_SCH_S(c));
            erg += m_i_i(1L,S_SCH_SI(c,0L));
            }
        else if (S_O_K(von) == MONOM)
            {
            CTO(PERMUTATION,"insert_list",S_MO_S(von));
            c = CALLOCOBJECT();
            erg += b_sn_l(von,NULL,c);
            C_O_K(c,SCHUBERT);
            }
        else
            {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }
#endif /* SCHUBERTTRUE */
    else if (S_O_K(nach) == MONOPOLY)
        {
        if (S_O_K(von) == MONOM)
            {
            c = CALLOCOBJECT();
            erg += b_sn_l(von,NULL,c);
            C_O_K(c,MONOPOLY);
            }
        else {
            WTT("insert_list(1,2)",von,nach);
            goto endr_ende;
            }
        }
    else   {
        c = CALLOCOBJECT();
        erg += b_sn_l(von,NULL,c);
        }
    erg +=  insert_list_list(c,nach,eh,cf);

    ENDR("insert_list");
}


#ifdef LISTTRUE
INT copy_list(OP von, OP nach)
{
    OBJECTSELF d;
    d= S_O_S(von);
    if (d.ob_list == NULL)
        return error("copy_list:sos = NULL");
    return transformlist(von,nach,copy);
}



INT lastp_list(OP list)
{
    return(S_L_N(list) == NULL);
    /* das letzte element falls das naechste==NULL */
}



static struct list * calloc_list(void)
{
    struct list *ergebnis;
    mem_counter_list++;

    if (list_speicherindex >= 0)
        return list_speicher[list_speicherindex--];

    ergebnis = (struct list *)SYM_malloc( sizeof(struct list));

    if (ergebnis == NULL) no_memory();
    return ergebnis;

}

static INT free_list(struct list *a)
{
    INT erg = OK;
    COP("free_list(1)",a);

    if (list_speicherindex+1 == list_speichersize) {
       if (list_speichersize == 0) {
           list_speicher = (struct list **) SYM_malloc(100 * sizeof(struct list *));
           if (list_speicher == NULL) {
               erg += error("no memory");
               goto endr_ende;
               }
           list_speichersize = 100;
           }
       else {
           list_speicher = (struct list **) SYM_realloc (list_speicher,
               2 * list_speichersize * sizeof(struct list *));
           if (list_speicher == NULL) {
               erg += error("no memory");
               goto endr_ende;
               }
           list_speichersize = 2 * list_speichersize;
           }
       }

    mem_counter_list--;
    list_speicher[++list_speicherindex] = a;
    ENDR("free_list");
}


INT m_sn_l(OP self, OP nx, OP a)
{
    OP s = NULL,n = NULL;
    INT erg = OK;
    COP("m_sn_l(3)",a);
    if (self != NULL)
        {
        s = CALLOCOBJECT();
        erg += copy(self,s);
        }
    if (nx != NULL)
        {
        n = CALLOCOBJECT();
        erg += copy(nx,n);
        }
    erg += b_sn_l(s,n,a);
    ENDR("m_sn_l");
}


/* build_self next_list */
INT b_sn_l(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_l",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(LIST,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_l");
}


/* build_self next_elmsym */
INT b_sn_e(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_e",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(ELMSYM,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_e");
}


/* build_self next_schur */
INT b_sn_s(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_s",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(SCHUR,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_s");
}


/* build_self next_powsym */
INT b_sn_ps(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_ps",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(POWSYM,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_ps");
}

/* build_self next_homsym */
INT b_sn_h(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_h",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(HOMSYM,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_h");
}

/* build_self next_monomial */
INT b_sn_mon(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_mon",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(MONOMIAL,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_mon");
}


/* build_self next_polynom */
INT b_sn_po(OP self, OP nx, OP a)
{
    INT erg =OK;
    OBJECTSELF d;

    COP("b_sn_po",a);
    d.ob_list = calloc_list();
    erg += b_ks_o(POLYNOM,d,a);
    C_L_S(a,self);
    C_L_N(a,nx);
    ENDR("b_sn_po");
}


INT hash_list(OP list)
{
    INT erg = 1257;
    OP z;
    FORALL(z,list, { erg = erg * 1257 + hash(S_MO_S(z))*hash(S_MO_K(z)); } );
    return erg;
}


INT length_list(OP list, OP res)
{
    OP zeiger = list;
    INT erg = OK;
        CTO(EMPTY,"length_list",res);
    M_I_I(0L,res);

    if (empty_listp(list))
        goto endr_ende;

    while (zeiger != NULL) /* abbruch bedingung */
    {
        INC_INTEGER(res);
        zeiger = S_L_N(zeiger);
    }

    ENDR("length_list");
}


INT filter_list(OP a, OP b, INT (*tf)(OP))
{
    OP z,zb=b;
    INT erg = OK, f = 0;
    COP("filter_list(3)",tf);
    z = a;
    while (z != NULL)
        {
        if ((*tf)(S_L_S(z)) == TRUE)
            {
            if (f == 0)
                {
                erg += b_sn_l(CALLOCOBJECT(),NULL,b);
                C_O_K(b,S_O_K(a));
                erg += copy(S_L_S(z),S_L_S(b));
                f = 1;
                }
            else {
                C_L_N(zb,CALLOCOBJECT());
                erg += b_sn_l(CALLOCOBJECT(),NULL,S_L_N(zb));
                erg += copy(S_L_S(z),S_L_S(S_L_N(zb)));
                zb = S_L_N(zb);
                C_O_K(zb,S_O_K(a));
                }
            }
        z = S_L_N(z);
        }
    ENDR("filter_list");

}

INT transform_apply_list(OP von, INT (*tf)(OP))
{
    OP zeiger = von;
    INT erg = OK;
    COP("transform_apply_list(2)",tf);

    while (zeiger != NULL)
        { erg += (*tf)(S_L_S(zeiger)); zeiger = S_L_N(zeiger); }
    ENDR("transform_apply_list");
}

INT transformlist(OP von, OP nach, INT (*tf)(OP,OP))
{
    OP zeiger = von;
    OP nachzeiger = nach;
    OBJECTSELF d;
    INT erg = OK;
    COP("transformlist(3)",tf);

    if (not EMPTYP(nach))
        erg += freeself(nach);
    while (zeiger != NULL)
    {
        d= S_O_S(zeiger);
        if (d.ob_list == NULL)
            return error("transformlist:sos = NULL");
        if (S_L_S(zeiger) != NULL)
            {
            erg += b_sn_l(CALLOCOBJECT(),NULL,nachzeiger);
            /* b_sn_l() statt init() */
            C_O_K(nachzeiger,S_O_K(zeiger));
            /* fuer faelle wie polynom etc */
            erg += (*tf)(S_L_S(zeiger),S_L_S(nachzeiger));
            }
        else
            {
            erg += b_sn_l(NULL,NULL,nachzeiger);
            C_O_K(nachzeiger,S_O_K(zeiger));
            }
        if (not lastp(zeiger))
            C_L_N(nachzeiger,CALLOCOBJECT());

        zeiger = S_L_N(zeiger);
        nachzeiger = S_L_N(nachzeiger);
    }
    ENDR("transformlist");
}


/* ve ist konstante , vz ist liste */
INT trans2formlist(OP ve, OP vz, OP nach, INT (*tf)(OP,OP,OP))
{
    OP zeiger = vz;
    OP nachzeiger = nach;
    INT erg = OK;
    COP("trans2formlist(4)",tf);

    while (zeiger != NULL)
    {
        erg += b_sn_l(CALLOCOBJECT(),NULL,nachzeiger);
        C_O_K(nachzeiger,S_O_K(vz));
        erg += (*tf)(ve,S_L_S(zeiger),S_L_S(nachzeiger));
        if (not lastp(zeiger))
        {
            C_L_N(nachzeiger,CALLOCOBJECT());
            nachzeiger = S_L_N(nachzeiger);
        }
        zeiger = S_L_N(zeiger);
    }
    ENDR("trans2formlist");
}
#endif /* LISTTRUE */

INT comp_list(OP a, OP b)
{
    if ((S_L_S(b) == NULL) && (S_L_S(a) == NULL))
        return 0;
    else if (S_L_S(a) == NULL)
        return -1;
    else if (S_L_S(b) == NULL)
        return 1;
    else
        return comp_list_co(a,b,comp);
}


/* vergleich zweier listen, z.b. 1,1,3  < 1,2,2 z.b. 2,2,3  > 2/3.
 * self parts are non null */
INT comp_list_co(OP a, OP b, INT (*cf)(OP,OP))
{
    INT erg;
    SYMCHECK(S_L_S(a) == NULL,"comp_list_co:self(1) == NULL");
    SYMCHECK(S_L_S(b) == NULL,"comp_list_co:self(2) == NULL");
cla:
    erg=(*cf)(S_L_S(a),S_L_S(b));
    if (erg == 0L) /* gleicher listenanfang */
    {
        if ((S_L_N(a) == NULL)&&(S_L_N(b) == NULL)) return(0L);
        /* gleich */
        else if (S_L_N(a) == NULL) return(-1L);
        /* a < b */
        else if (S_L_N(b) == NULL) return(1L);
        /* a > b */
        else {
            a = S_L_N(a);
            b = S_L_N(b);
            goto cla;
            }
        /* rest ist wieder liste */
    }
    else return(erg);
    ENDR("comp_list_co");
}

#ifdef LISTTRUE
OP s_l_s(OP a)
{
    OBJECTSELF c;
    if (a == NULL)
        return error("s_l_s: a == NULL"),(OP)NULL;
    if (not listp(a))
        return error("s_l_s: a not list"),(OP)NULL;
    c = s_o_s(a);
    return(c.ob_list->l_self);
}

OP s_l_n(OP a)
{
    OBJECTSELF c;
    if (a == NULL)
        return error("s_l_n: a == NULL"),(OP)NULL;
    if (not listp(a))
        return error("s_l_n: a not list"),(OP)NULL;
    c = s_o_s(a);
    return(c.ob_list->l_next);
}

INT c_l_n(OP a, OP b)
{
    OBJECTSELF c;
    c = s_o_s(a);
    c.ob_list->l_next = b;
    return(OK); }

INT c_l_s(OP a, OP b)
{
    OBJECTSELF c;
    c = s_o_s(a);
    c.ob_list->l_self = b;
    return(OK); 
}


INT freeself_list(OP obj)
{
    INT erg = OK;
    OP z = obj,za=NULL;

    z = S_L_N(obj);
    while (z != NULL)
        {
        za = z;
        z = S_L_N(z);
        C_L_N(za,NULL);
        if (S_L_S(za) != NULL) FREEALL(S_L_S(za));
        erg += free_list(S_O_S(za).ob_list);
        C_O_K(za,EMPTY);
        FREEALL(za);
        }

    if (S_L_S(obj) != NULL)
        FREEALL(S_L_S(obj));

    erg += free_list(S_O_S(obj).ob_list);
    C_O_K(obj,EMPTY);
    ENDR("freeself_list");
}


/* genaue art der liste */
INT scan_list(OP a, OBJECTKIND givenkind)
{
    char antwort[2];
    INT erg;


    /* a ist ein leeres object */
    b_sn_l(callocobject(),NULL,a);
    /* self ist nun initialisiert */
    if (givenkind == (OBJECTKIND)0) {
        /*
            a ----> kind: LIST
                       self: --|
                           |
                           V
                       |-------------|
                       | self : OP   |
                       | next : NULL |
                       |-------------|
            */
        printeingabe("please enter kind of list element");
        givenkind = scanobjectkind(); /* nun weiss man das */
    }


    erg=scan(givenkind,S_L_S(a));
    if (erg == ERROR) {
        error("scan_list:error in scanning listelement");
        goto endr_ende;
    }

    printeingabe("one more listelement y/n");
    skip_comment();
    scanf("%s",antwort);
    if (antwort[0]  == 'y')
    {
        C_L_N(a,callocobject());
        erg += scan_list(S_L_N(a),givenkind);
    };
    ENDR("scan_list");
}
#endif /* LISTTRUE */


#ifdef VECTORTRUE
#ifdef LISTTRUE

/* wandelt eine Liste in einen Vektor um die daten werden dabei
 * kopiert */
INT t_LIST_VECTOR(OP a, OP b)
{
    INT i;
    INT erg = OK;
    OP l;

    if (not LISTP(a))
        WTO("t_LIST_VECTOR",a);
    CE2(a,b,t_LIST_VECTOR);
    l = callocobject();
    erg += length(a,l);
    erg += b_l_v(l,b); 
    for(i=0L;i<S_I_I(l);i++,a=S_L_N(a))
        erg += copy(S_L_S(a),S_V_I(b,i));
    ENDR("t_LIST_VECTOR");
}

#define T_VECTOR_LIST_CO(a,b,t)\
    {\
    INT i;\
    for(i=0L;b != NULL;)\
    {\
        erg += b_sn_l(CALLOCOBJECT(),NULL,b);\
        C_O_K(b,t);\
        COPY(S_V_I(a,i),S_L_S(b));\
        if (++i < S_V_LI(a)) C_L_N(b,CALLOCOBJECT());\
        b = S_L_N(b);\
    }  \
    }


/* change from vector to list the order will be the same, data will be
 * copied */
INT t_VECTOR_LIST(OP a, OP b)
{
    INT i,erg=OK;

    if (not VECTORP(a))
        WTO("t_VECTOR_LIST",a);
    CE2(a,b,t_VECTOR_LIST);
    T_VECTOR_LIST_CO(a,b,LIST);
    ENDR("t_VECTOR_LIST");
}

INT t_VECTOR_POLYNOM(OP a, OP b)
{
    INT erg = OK;
    CTO(VECTOR,"t_VECTOR_POLYNOM(1)",a);
    CE2(a,b,t_VECTOR_POLYNOM);
    T_VECTOR_LIST_CO(a,b,POLYNOM);
    ENDR("t_VECTOR_POLYNOM");
}
#endif /* LISTTRUE */
#endif /* VECTORTRUE */


INT test_list(void)
{
    OP a= callocobject();
    OP b= callocobject();
    b_sn_l(NULL,NULL,a);
    println(a);
    freeself(a);
    scan(LIST,a);
    println(a);
    scan(LIST,b);
    println(b);
    insert(a,b,NULL,NULL);
    println(b);
    freeself(b);
    return(OK);
}


#ifdef LISTTRUE

/* zur ausgabe einer liste */
INT tex_list(OP list)
{
    OP zeiger = list;
    while (zeiger != NULL) /* abbruch bedingung */
    {
        tex(S_L_S(zeiger));
        fprintf(texout,"\\ ");
        texposition += 3L;
        zeiger = S_L_N(zeiger);
    }
    return(OK);
}
#endif /* LISTTRUE */


/* for compatibility */
INT insert_list_list_2(OP von, OP nach, INT (*eh)(OP,OP), INT (*cf)(OP,OP))
{
    return insert_list_list(von,nach,eh,cf);
}

/* programmiert nach christopher J. van Wyk : Data  structures and c programs */
INT insert_list_list(OP von, OP nach, INT (*eh)(OP,OP), INT (*cf)(OP,OP))
{
    struct object dummy;
    struct list dummy_list;
    OP p;
    INT res,erg=OK;
    OBJECTSELF d;
    OBJECTKIND kind=S_O_K(von);
    OP nn,altnext;

    if (nach == NULL) {
        error("insert_list_list:nach == NULL");
        /* darf nicht vorkommen, nach muss initialisiert sein */
        goto ende;
    }

    if (EMPTYP(nach))
        init(kind,nach);

    if (S_L_S(nach) == NULL)
    {
        C_L_S(nach,S_L_S(von));
        C_L_N(nach,S_L_N(von));
        C_L_S(von,NULL);
        C_L_N(von,NULL);
        FREEALL(von);
        goto ende;
    }

    if (S_L_S(von) == NULL)
        {
        FREEALL(von);
        goto ende;
        }


    if (EMPTYP(S_L_S(nach)))    /* nach ist leer */
        {
        erg +=  error("insert_list_list: result is a LIST with empty self");
        goto ende;
        }

    nn = CALLOCOBJECT();
    *nn = *nach;
    p = &dummy;

    d.ob_list = &dummy_list;
    C_O_S(p,d);
    C_O_K(p,LIST);

    if (cf == NULL) cf = comp;
    while((von != NULL) && (nn != NULL))
    {
        res = (* cf)(S_L_S(von),S_L_S(nn));
        if (res < 0L) {
            C_L_N(p,von);
            von = S_L_N(von);
            p = S_L_N(p);
        }
        else if (res >0L){
            C_L_N(p,nn);
            nn = S_L_N(nn);
            p = S_L_N(p);
        }
        else {
            if (eh == NULL);
            else if (eh == add_koeff)
                {
                ADD_KOEFF(S_L_S(von),S_L_S(nn));
                }
            else (*eh)(S_L_S(von),S_L_S(nn));
            if (not EMPTYP(S_L_S(nn))) {
                /* eh hat nicht geloescht */
                C_L_N(p,nn);
                p = S_L_N(p);
                nn = S_L_N(nn);
            }
            else {
                FREEALL(S_L_S(nn));
                altnext=S_L_N(nn);
                C_L_N(nn,NULL);
                C_L_S(nn,NULL);
                FREEALL(nn);
                nn = altnext;
            }

            FREEALL(S_L_S(von));
            altnext=S_L_N(von);
            C_L_N(von,NULL);
            C_L_S(von,NULL);
            FREEALL(von);
            von = altnext;
        }
    }

    C_L_N(p,NULL);
    if (von == NULL)
        von = nn;
    if (von != NULL)
        C_L_N(p,von);
    if (S_L_N(&dummy) == NULL)
        {
        C_O_K(nach,EMPTY);
        init (kind,nach);
        }
    else     {
        *nach = *(S_L_N(&dummy));
        C_O_K(S_L_N(&dummy),EMPTY);
        FREEALL(S_L_N(&dummy));
        }
ende:
    ENDR("insert_list_list");
}

#ifdef LISTTRUE
INT objectwrite_list(FILE *f, OP a)

{
    fprintf(f, "%" PRIINT " " , (INT)S_O_K(a));
    if (S_L_S(a) == NULL)
        fprintf(f,"%ld\n",0L);
    else    {
        fprintf(f,"%ld\n",1L);
        objectwrite(f,S_L_S(a));
        }
    if (S_L_N(a) == NULL)
        {
        fprintf(f,"%ld\n",0L);
        return OK;
        }
    else    {
        fprintf(f,"%ld\n",1L);
        return objectwrite(f,S_L_N(a));
        }
}


INT objectread_list(FILE *f, OP a)
{
    INT i;
    fscanf(f, "%" SCNINT ,&i);
    if (i == 0)
        b_sn_l(NULL,NULL,a);
    else if (i == 1)
        {
        b_sn_l(callocobject(),NULL,a);
        objectread(f,S_L_S(a));
        }
    else
        return error("objectread_list: wrong format (1) ");
    fscanf(f, "%" SCNINT ,&i);
    if (i == 0L)
        return OK;
    else if (i == 1L)
        {
        C_L_N(a,callocobject());
        return objectread(f,S_L_N(a));
        }
    else
        return error("objectread_list: wrong format (2) ");
}


/* if tf return true the elements stays in the list error beseitigt
 * am. tf takes a list element as input
 */
INT filter_apply_list(OP a, INT (*tf)(OP))
{
    OP z,zb,vorg=NULL;
    INT erg = OK;
    OBJECTKIND typ = S_O_K(a);
    z = a;
    if (S_L_S(a) == NULL)
        goto endr_ende;
    while (z != NULL)
        {
        if ((*tf)(S_L_S(z)) == TRUE)
            /* stays inside the list */
            {
            if (vorg != NULL)  C_L_N(vorg,z);
            zb = z;
            z = S_L_N(z);
            C_L_N(zb,NULL);
            if (vorg == NULL)
                {
                if (a != zb)
                    {
                    *a = *zb;
                    C_O_K(zb,EMPTY);
                    FREEALL(zb);
                    }
                vorg = a;
                }
            else
                vorg = zb;
            }
        else
            /* remove from the list */
            {
            zb = z;
            z = S_L_N(z);
            C_L_N(zb,NULL);
            if (zb != a) FREEALL(zb);
            else FREESELF(zb);
            }
        } /* end while z!=NULL */
    if (vorg == NULL)
        erg += init(typ,a);

    ENDR("filter_apply_list");
}
#endif /* LISTTRUE */

