1 /* file: list.c */
2 #include "def.h"
3 #include "macro.h"
4 
5 static struct list * calloc_list();
6 static INT free_list();
7 
8 static INT mem_counter_list;
9 static int list_speicherindex=-1; /* AK 290102 */
10 static int list_speichersize=0; /* AK 290102 */
11 static struct list **list_speicher=NULL; /* AK 290102 */
12 
13 
14 #ifdef LISTTRUE
list_anfang()15 INT list_anfang()
16 /* AK 100893 */
17     {
18     mem_counter_list=0L;
19     return OK;
20     }
21 
22 
23 
24 
25 
list_ende()26 INT list_ende()
27 /* AK 100893 */
28     {
29     INT erg = OK;
30 
31     if (no_banner != TRUE)
32     if (mem_counter_list != 0L)
33         {
34         fprintf(stderr, "mem_counter_list = %" PRIINT "\n" ,mem_counter_list);
35         erg += error("list memory not freed");
36         goto endr_ende;
37         }
38 
39     if (list_speicher!=NULL)
40         {
41         INT i;
42         for (i=0;i<=list_speicherindex;i++)
43             SYM_free(list_speicher[i]);
44         SYM_free(list_speicher);
45         }
46 
47     list_speicher=NULL;
48     list_speicherindex=-1;
49     list_speichersize=0;
50 
51     ENDR("list_ende");
52     }
53 
54 
empty_listp(a)55 INT empty_listp(a) OP a;
56 /* true falls es sich um eine leere liste handelt
57 d.h. self == NULL */
58 /* AK 130690 V1.1 */ /* AK 060891 V1.3 */
59 {
60     if (not listp(a))
61         return FALSE;
62     if (S_L_S(a) != NULL)
63         return FALSE;
64     return TRUE;
65 }
66 
67 
68 
fprint_list(f,list)69 INT fprint_list(f,list) FILE *f; OP list;
70 /* ausgabe eines list-objects
71 ausgabe bis einschliesslich next == NULL */
72 /* AK 210688 */ /* AK 030789 V1.0 */ /* AK 281289 V1.1 */
73 /* AK 060891 V1.3 */
74 {
75     INT erg = OK;
76     OP zeiger = list;
77     OBJECTSELF d; /* AK 141091 */
78 
79     COP("fprint_list(1)",f);
80 
81     if (list == NULL) /* AK 141091 */
82         {
83         erg +=  NOP("fprint_list");
84         goto fple;
85         }
86     d = S_O_S(list); /* AK 141091 */
87     if (d.ob_list == NULL) /* AK 141091 */
88         return error("fprint_list:s_o_s == NULL");
89 
90     if     ((S_L_S(list) == NULL)&&(S_L_N(list)==NULL))
91     /* AK 030389 */
92     /* so wird ein list object initialisiert mit b_sn_l(NULL,NULL,obj) */
93         {
94         fprintf(f,"empty list");
95         if (f == stdout)
96             {
97             zeilenposition += 10L;
98             if (zeilenposition >row_length)
99                 {
100                 fprintf(stdout,"\n");
101                 zeilenposition = 0L;
102                 }
103             }
104         }
105     else
106         while (zeiger != NULL)
107         {
108             if (not LISTP(zeiger))
109                 {
110                 erg += WTO("fprint_list:internal",zeiger);
111                 goto fple;
112                 }
113             erg += fprint(f,S_L_S(zeiger));
114             fprintf(f,"  ");
115             if (f == stdout)
116             {
117                 zeilenposition += 2L;
118                 if (zeilenposition >row_length)
119                 {
120                 fprintf(stdout,"\n");
121                 zeilenposition = 0L;
122                 }
123             }
124             zeiger=S_L_N(zeiger);
125         }
126 fple:
127     ENDR("fprint_list");
128 }
129 #endif /* LISTTRUE */
130 
131 
132 
insert_list(von,nach,eh,cf)133 INT insert_list(von,nach,eh,cf) OP von,nach; INT (*eh)(), (*cf)();
134 /* fuegt das object von in die liste nach ein AK 220688 */
135 /* AK 030789 V1.0 */ /* AK 201289 V1.1 */
136 /* AK 060891 V1.3 */
137 /* moegliche faelle:
138     a)zwei listen
139     b)von ist ein scalar und kann in das entsprechende list object umgewandelt werden
140     c)a ist hashtable und die objecte werden eingefuegt
141     d)a ist monom und wird in das entsprechende LIST object umgewandelt
142 */
143 
144 {
145     OP c;
146     INT erg = OK;
147     if (LISTP(von))  /* fall a */
148         {
149         erg += insert_list_list(von,nach,eh,cf);
150         goto endr_ende;
151         }
152 
153     if (S_O_K(von) == HASHTABLE) { /* fall c */
154         if (S_O_K(nach) == MONOMIAL) {
155             erg += t_HASHTABLE_MONOMIAL(von,von);
156             insert_list_list(von,nach,eh,cf);
157             goto endr_ende;
158             }
159         if (S_O_K(nach) == SCHUR) {
160             erg += t_HASHTABLE_SCHUR(von,von);
161             insert_list_list(von,nach,eh,cf);
162             goto endr_ende;
163             }
164         if (S_O_K(nach) == HOMSYM) {
165             erg += t_HASHTABLE_HOMSYM(von,von);
166             insert_list_list(von,nach,eh,cf);
167             goto endr_ende;
168             }
169         if (S_O_K(nach) == POWSYM) {
170             erg += t_HASHTABLE_POWSYM(von,von);
171             insert_list_list(von,nach,eh,cf);
172             goto endr_ende;
173             }
174         if (S_O_K(nach) == ELMSYM) {
175             erg += t_HASHTABLE_ELMSYM(von,von);
176             insert_list_list(von,nach,eh,cf);
177             goto endr_ende;
178             }
179         FORALL(c,von, {
180             OP f;
181             f = CALLOCOBJECT();
182             erg += swap(c,f);
183             insert_list(f,nach,eh , cf);
184             });
185         erg += freeall(von);
186         goto endr_ende;
187         }
188 
189 
190 
191 
192 
193     if (S_O_K(nach) == POLYNOM)
194         {
195         if (scalarp(von))
196             {
197             c = CALLOCOBJECT();
198             erg += b_skn_po(CALLOCOBJECT(),von,NULL,c);
199             erg += m_il_v(1L,S_PO_S(c));
200             erg += m_i_i(0L,S_PO_SI(c,0L));
201             }
202         else if (S_O_K(von) == MONOM)
203             {
204             CTTTTO(INTEGERMATRIX,MATRIX,
205                    INTEGERVECTOR,VECTOR,"insert_list(1-monom-self)",S_MO_S(von));
206             c = CALLOCOBJECT();
207             erg += b_sn_l(von,NULL,c);
208             C_O_K(c,POLYNOM);
209             }
210         else
211             {
212             erg += WTT("insert_list(1,2)",von,nach);
213             goto endr_ende;
214             }
215         }
216 
217 #ifdef SCHURTRUE
218     else if (S_O_K(nach) == SCHUR)
219         {
220         if (scalarp(von))
221             {
222             c = CALLOCOBJECT();
223             erg += b_scalar_schur(von,c);
224             }
225         else if (S_O_K(von) == MONOM)
226             {
227             CTO(PARTITION,"insert_list",S_MO_S(von));
228             c = CALLOCOBJECT();
229             erg += b_sn_s(von,NULL,c);
230             }
231         else
232             {
233             erg += WTT("insert_list(1,2)",von,nach);
234             goto endr_ende;
235             }
236         }
237     else if (S_O_K(nach) == HOMSYM)
238         {
239         if (S_O_K(von) == MONOM)
240             {
241             CTO(PARTITION,"insert_list",S_MO_S(von));
242             c = CALLOCOBJECT();
243             erg += b_sn_h(von,NULL,c);
244             }
245         else if (scalarp(von))
246             {
247             c = CALLOCOBJECT();
248             erg += b_scalar_homsym(von,c);
249             }
250         else
251             {
252             erg += WTT("insert_list(1,2)",von,nach);
253             goto endr_ende;
254             }
255         }
256     else if (S_O_K(nach) == MONOMIAL)
257         {
258         if (S_O_K(von) == MONOM)
259             {
260             CTO(PARTITION,"insert_list",S_MO_S(von));
261             c = CALLOCOBJECT();
262             erg += b_sn_mon(von,NULL,c);
263             }
264         else if (scalarp(von))
265             {
266             c = CALLOCOBJECT();
267             erg += b_scalar_monomial(von,c);
268             }
269         else
270             {
271             erg += WTT("insert_list(1,2)",von,nach);
272             goto endr_ende;
273             }
274         }
275 
276     else if (S_O_K(nach) == ELMSYM)
277         {
278         if (S_O_K(von) == MONOM)
279             {
280             CTO(PARTITION,"insert_list",S_MO_S(von));
281             c = CALLOCOBJECT();
282             erg += b_sn_e(von,NULL,c);
283             }
284         else if (scalarp(von))
285             {
286             c = CALLOCOBJECT();
287             erg += b_scalar_elmsym(von,c);
288             }
289         else
290             {
291             erg += WTT("insert_list(1,2)",von,nach);
292             goto endr_ende;
293             }
294         }
295 
296 
297     else if (S_O_K(nach) == POWSYM)
298         {
299         if (scalarp(von))
300             {
301             c = CALLOCOBJECT();
302             erg += b_scalar_powsym(von,c);
303             }
304         else if (S_O_K(von) == MONOM)
305             {
306             CTO(PARTITION,"insert_list",S_MO_S(von));
307             c = CALLOCOBJECT();
308             erg += b_sn_ps(von,NULL,c);
309             }
310         else
311             {
312             erg += WTT("insert_list(1,2)",von,nach);
313             goto endr_ende;
314             }
315         }
316 
317 #endif /* SCHURTRUE */
318 
319 #ifdef SCHUBERTTRUE
320     else if (S_O_K(nach) == SCHUBERT)
321         {
322         if (scalarp(von))
323             {
324             c = CALLOCOBJECT();
325             erg += b_skn_sch(CALLOCOBJECT(),von,NULL,c);
326             erg += m_ks_p(VECTOR,CALLOCOBJECT(),S_SCH_S(c));
327             erg += m_il_v(1L,S_SCH_S(c));
328             erg += m_i_i(1L,S_SCH_SI(c,0L));
329             }
330         else if (S_O_K(von) == MONOM)
331             {
332             CTO(PERMUTATION,"insert_list",S_MO_S(von));
333             c = CALLOCOBJECT();
334             erg += b_sn_l(von,NULL,c);
335             C_O_K(c,SCHUBERT);
336             }
337         else
338             {
339             erg += WTT("insert_list(1,2)",von,nach);
340             goto endr_ende;
341             }
342         }
343 #endif /* SCHUBERTTRUE */
344     else if (S_O_K(nach) == MONOPOLY)
345         {
346         if (S_O_K(von) == MONOM)
347             {
348             c = CALLOCOBJECT();
349             erg += b_sn_l(von,NULL,c);
350             C_O_K(c,MONOPOLY);
351             }
352         else {
353             erg += WTT("insert_list(1,2)",von,nach);
354             goto endr_ende;
355             }
356         }
357     else   {
358         c = CALLOCOBJECT();
359         erg += b_sn_l(von,NULL,c);
360         }
361     erg +=  insert_list_list(c,nach,eh,cf);
362 
363     ENDR("insert_list");
364 }
365 
366 
367 #ifdef LISTTRUE
copy_list(von,nach)368 INT copy_list(von,nach) OP von, nach;
369 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */ /* AK 060891 V1.3 */
370 {
371     OBJECTSELF d; /* AK 141091 */
372     d= S_O_S(von);
373     if (d.ob_list == NULL)
374         return error("copy_list:sos = NULL");
375     return transformlist(von,nach,copy);
376 }
377 
378 
379 
lastp_list(list)380 INT lastp_list(list) OP list;
381 /* AK 210688 */ /* AK 290689 V1.0 */ /* AK 281289 V1.1 */
382 /* AK 060891 V1.3 */
383 {
384     return(S_L_N(list) == NULL);
385     /* das letzte element falls das naechste==NULL */
386 }
387 
388 
389 
calloc_list()390 static struct list * calloc_list()
391 /* AK 210688 */ /* AK 290689 V1.0 */ /* AK 281289 V1.1 */
392 /* AK 060891 V1.3 */
393 {
394 /*
395     struct list *a =
396         (struct list *) SYM_MALLOC(sizeof(struct list));
397 
398     mem_counter_list++;
399     return a;
400 */
401     struct list *ergebnis;
402 
403     mem_counter_list++;
404 
405 
406     if (list_speicherindex >= 0) /* AK 301001 */
407         return list_speicher[list_speicherindex--];
408 
409 
410 
411     ergebnis = (struct list *)
412         SYM_malloc( sizeof(struct list));
413 
414     if (ergebnis == NULL) no_memory();
415 
416     return ergebnis;
417 
418 }
419 
free_list(a)420 static INT free_list(a) struct list *a;
421 /* AK 300197 */
422 {
423     INT erg = OK;
424     COP("free_list(1)",a);
425 /*
426     mem_counter_list--;
427     erg += SYM_free(a);
428 */
429     if (list_speicherindex+1 == list_speichersize) {
430        if (list_speichersize == 0) {
431            list_speicher = (struct list **) SYM_malloc(100 * sizeof(struct list *));
432            if (list_speicher == NULL) {
433                erg += error("no memory");
434                goto endr_ende;
435                }
436            list_speichersize = 100;
437            }
438        else {
439            list_speicher = (struct list **) SYM_realloc (list_speicher,
440                2 * list_speichersize * sizeof(struct list *));
441            if (list_speicher == NULL) {
442                erg += error("no memory");
443                goto endr_ende;
444                }
445            list_speichersize = 2 * list_speichersize;
446            }
447        }
448 
449     mem_counter_list--;
450 
451     list_speicher[++list_speicherindex] = a;
452 
453     ENDR("free_list");
454 }
455 
456 
457 
458 
m_sn_l(self,nx,a)459 INT m_sn_l(self,nx,a) OP self,nx,a;
460 /* AK 290590 V1.1 */ /* AK 050891 V1.3 */
461 {
462     OP s = NULL,n = NULL;
463     INT erg = OK;
464     COP("m_sn_l(3)",a);
465     if (self != NULL)
466         {
467         s = CALLOCOBJECT();
468         erg += copy(self,s);
469         }
470     if (nx != NULL)
471         {
472         n = CALLOCOBJECT();
473         erg += copy(nx,n);
474         }
475     erg += b_sn_l(s,n,a);
476     ENDR("m_sn_l");
477 }
478 
479 
b_sn_l(self,nx,a)480 INT b_sn_l(self,nx,a) OP self,nx,a;
481 /* build_self next_list AK 210688 */
482 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */  /* AK 050891 V1.3 */
483 {
484     INT erg =OK;
485     OBJECTSELF d;
486 
487     COP("b_sn_l",a);
488     d.ob_list = calloc_list();
489     erg += b_ks_o(LIST,d,a);
490     C_L_S(a,self);
491     C_L_N(a,nx);
492     ENDR("b_sn_l");
493 }
494 
b_sn_e(self,nx,a)495 INT b_sn_e(self,nx,a) OP self,nx,a;
496 /* build_self next_elmsym AK 210688 */
497 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */  /* AK 050891 V1.3 */
498 {
499     INT erg =OK;
500     OBJECTSELF d;
501 
502     COP("b_sn_e",a);
503     d.ob_list = calloc_list();
504     erg += b_ks_o(ELMSYM,d,a);
505     C_L_S(a,self);
506     C_L_N(a,nx);
507     ENDR("b_sn_e");
508 }
509 
b_sn_s(self,nx,a)510 INT b_sn_s(self,nx,a) OP self,nx,a;
511 /* build_self next_schur AK 210688 */
512 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */  /* AK 050891 V1.3 */
513 {
514     INT erg =OK;
515     OBJECTSELF d;
516 
517     COP("b_sn_s",a);
518     d.ob_list = calloc_list();
519     erg += b_ks_o(SCHUR,d,a);
520     C_L_S(a,self);
521     C_L_N(a,nx);
522     ENDR("b_sn_s");
523 }
524 
b_sn_ps(self,nx,a)525 INT b_sn_ps(self,nx,a) OP self,nx,a;
526 /* build_self next_powsym AK 210688 */
527 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */  /* AK 050891 V1.3 */
528 {
529     INT erg =OK;
530     OBJECTSELF d;
531 
532     COP("b_sn_ps",a);
533     d.ob_list = calloc_list();
534     erg += b_ks_o(POWSYM,d,a);
535     C_L_S(a,self);
536     C_L_N(a,nx);
537     ENDR("b_sn_ps");
538 }
539 
b_sn_h(self,nx,a)540 INT b_sn_h(self,nx,a) OP self,nx,a;
541 /* build_self next_homsym AK 210688 */
542 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */  /* AK 050891 V1.3 */
543 {
544     INT erg =OK;
545     OBJECTSELF d;
546 
547     COP("b_sn_h",a);
548     d.ob_list = calloc_list();
549     erg += b_ks_o(HOMSYM,d,a);
550     C_L_S(a,self);
551     C_L_N(a,nx);
552     ENDR("b_sn_h");
553 }
554 
b_sn_mon(self,nx,a)555 INT b_sn_mon(self,nx,a) OP self,nx,a;
556 /* build_self next_monomial AK 210688 */
557 /* AK 290689 V1.0 */ /* AK 281289 V1.1 */  /* AK 050891 V1.3 */
558 {
559     INT erg =OK;
560     OBJECTSELF d;
561 
562     COP("b_sn_mon",a);
563     d.ob_list = calloc_list();
564     erg += b_ks_o(MONOMIAL,d,a);
565     C_L_S(a,self);
566     C_L_N(a,nx);
567     ENDR("b_sn_mon");
568 }
569 
570 
b_sn_po(self,nx,a)571 INT b_sn_po(self,nx,a) OP self,nx,a;
572 /* build_self next_polynom AK 230703 */
573 {
574     INT erg =OK;
575     OBJECTSELF d;
576 
577     COP("b_sn_po",a);
578     d.ob_list = calloc_list();
579     erg += b_ks_o(POLYNOM,d,a);
580     C_L_S(a,self);
581     C_L_N(a,nx);
582     ENDR("b_sn_po");
583 }
584 
585 
586 
hash_list(list)587 INT hash_list(list) OP list;
588 /* AK 170304 */
589 {
590     INT erg = 1257;
591     OP z;
592     FORALL(z,list, { erg = erg * 1257 + hash(S_MO_S(z))*hash(S_MO_K(z)); } );
593     return erg;
594 }
595 
length_list(list,res)596 INT length_list(list,res) OP list,res;
597 /* AK 220688 */ /* AK 290689 V1.0 */ /* AK 281289 V1.1 */
598 /* AK 060891 V1.3 */
599 {
600     OP zeiger = list;
601     INT erg = OK;
602         CTO(EMPTY,"length_list",res);
603     M_I_I(0L,res);
604 
605     if (empty_listp(list))
606         goto endr_ende;
607 
608     while (zeiger != NULL) /* abbruch bedingung */
609     {
610         INC_INTEGER(res);
611         zeiger = S_L_N(zeiger);
612     }
613 
614     ENDR("length_list");
615 }
616 
617 
filter_list(a,b,tf)618 INT filter_list(a,b,tf) OP a,b; INT (*tf)();
619 /* AK 020394 */
620 {
621     OP z,zb=b;
622     INT erg = OK, f = 0;
623     COP("filter_list(3)",tf);
624     z = a;
625     while (z != NULL)
626         {
627         if ((*tf)(S_L_S(z)) == TRUE)
628             {
629             if (f == 0)
630                 {
631                 erg += b_sn_l(CALLOCOBJECT(),NULL,b);
632                 C_O_K(b,S_O_K(a));
633                 erg += copy(S_L_S(z),S_L_S(b));
634                 f = 1;
635                 }
636             else {
637                 C_L_N(zb,CALLOCOBJECT());
638                 erg += b_sn_l(CALLOCOBJECT(),NULL,S_L_N(zb));
639                 erg += copy(S_L_S(z),S_L_S(S_L_N(zb)));
640                 zb = S_L_N(zb);
641                 C_O_K(zb,S_O_K(a));
642                 }
643 
644             }
645         z = S_L_N(z);
646         }
647     ENDR("filter_list");
648 
649 }
650 
transform_apply_list(von,tf)651 INT transform_apply_list(von,tf) OP von; INT (*tf)();
652 /* AK 201289 V1.1 */
653 /* AK 060891 V1.3 */
654 /* AK 210498 V2.0 */
655 {
656     OP zeiger = von;
657     INT erg = OK;
658     COP("transform_apply_list(2)",tf);
659 
660     while (zeiger != NULL)
661         { erg += (*tf)(S_L_S(zeiger)); zeiger = S_L_N(zeiger); }
662     ENDR("transform_apply_list");
663 }
664 
transformlist(von,nach,tf)665 INT transformlist(von,nach,tf) OP von, nach;INT (*tf)();
666 /* AK 270688 */ /* AK 030789 V1.0 */ /* AK 010890 V1.1 */ /* AK 060891 V1.3 */
667 /* AK 210498 V2.0 */
668 {
669     OP zeiger = von;
670     OP nachzeiger = nach;
671     OBJECTSELF d;
672     INT erg = OK; /* AK 100893 */
673     COP("transformlist(3)",tf);
674 
675     if (not EMPTYP(nach))
676         erg += freeself(nach);
677     while (zeiger != NULL)
678     {
679         d= S_O_S(zeiger);
680         if (d.ob_list == NULL)
681             return error("transformlist:sos = NULL");
682         if (S_L_S(zeiger) != NULL)
683             {
684             erg += b_sn_l(CALLOCOBJECT(),NULL,nachzeiger);
685             /* AK 100789 b_sn_l() statt init() */
686             C_O_K(nachzeiger,S_O_K(zeiger));
687             /* AK 107089 fuer faelle wie polynom etc */
688             erg += (*tf)(S_L_S(zeiger),S_L_S(nachzeiger));
689             }
690         else
691             {
692             erg += b_sn_l(NULL,NULL,nachzeiger);
693             C_O_K(nachzeiger,S_O_K(zeiger));
694             }
695         if (not lastp(zeiger))
696             C_L_N(nachzeiger,CALLOCOBJECT());
697 
698         zeiger = S_L_N(zeiger);
699         nachzeiger = S_L_N(nachzeiger);
700     }
701     ENDR("transformlist");
702 }
703 
trans2formlist(ve,vz,nach,tf)704 INT trans2formlist(ve,vz,nach,tf) OP ve,vz,nach; INT (*tf)();
705 /* AK 270688 *//* ve ist konstante , vz ist liste */
706 /* AK 030789 V1.0 */ /* AK 211289 V1.1 */ /* AK 060891 V1.3 */
707 {
708     OP zeiger = vz;
709     OP nachzeiger = nach;
710     INT erg = OK;
711     COP("trans2formlist(4)",tf);
712 
713 
714     while (zeiger != NULL)
715     {
716         erg += b_sn_l(CALLOCOBJECT(),NULL,nachzeiger);
717         C_O_K(nachzeiger,S_O_K(vz));
718         erg += (*tf)(ve,S_L_S(zeiger),S_L_S(nachzeiger));
719         if (not lastp(zeiger))
720         {
721             C_L_N(nachzeiger,CALLOCOBJECT());
722             nachzeiger = S_L_N(nachzeiger);
723         }
724         zeiger = S_L_N(zeiger);
725     }
726     ENDR("transformlist");
727 }
728 #endif /* LISTTRUE */
729 
comp_list(a,b)730 INT comp_list(a,b) OP a,b;
731 {
732     if ((S_L_S(b) == NULL) && (S_L_S(a) == NULL))
733         return 0;
734     else if (S_L_S(a) == NULL)
735         return -1;
736     else if (S_L_S(b) == NULL)
737         return 1;
738     else
739         return comp_list_co(a,b,comp);
740 }
741 
comp_list_co(a,b,cf)742 INT comp_list_co(a,b,cf) OP a,b; INT (*cf)();
743 /* vergleich zweier listen, z.b. 1,1,3  < 1,2,2 z.b. 2,2,3  > 2/3   AK 140788 */
744 /* AK 030789 V1.0 */ /* AK 010890 V1.1 */
745 /* AK 060891 V1.3 */
746 /* self parts are non null */
747 
748 {
749     INT erg;
750     SYMCHECK(S_L_S(a) == NULL,"comp_list_co:self(1) == NULL");
751     SYMCHECK(S_L_S(b) == NULL,"comp_list_co:self(2) == NULL");
752 cla:
753     erg=(*cf)(S_L_S(a),S_L_S(b));
754     if (erg == 0L) /* gleicher listenanfang */
755     {
756         if ((S_L_N(a) == NULL)&&(S_L_N(b) == NULL)) return(0L);
757         /* gleich */
758         else if (S_L_N(a) == NULL) return(-1L);
759         /* a < b */
760         else if (S_L_N(b) == NULL) return(1L);
761         /* a > b */
762         else {
763             a = S_L_N(a);
764             b = S_L_N(b);
765             goto cla;
766             }
767         /* rest ist wieder liste */
768     }
769     else return(erg);
770     ENDR("comp_list_co");
771 }
772 
773 #ifdef LISTTRUE
s_l_s(a)774 OP s_l_s(a) OP a;
775 /* AK 010890 V1.1 */ /* AK 060891 V1.3 */
776 {
777     OBJECTSELF c;
778     if (a == NULL)
779         return error("s_l_s: a == NULL"),(OP)NULL;
780     if (not listp(a))
781         return error("s_l_s: a not list"),(OP)NULL;
782     c = s_o_s(a);
783     return(c.ob_list->l_self);
784 }
785 
s_l_n(a)786 OP s_l_n(a) OP a;
787 /* AK 010890 V1.1 */ /* AK 060891 V1.3 */
788 {
789     OBJECTSELF c;
790     if (a == NULL)
791         return error("s_l_n: a == NULL"),(OP)NULL;
792     if (not listp(a))
793         return error("s_l_n: a not list"),(OP)NULL;
794     c = s_o_s(a);
795     return(c.ob_list->l_next);
796 }
797 
c_l_n(a,b)798 INT c_l_n(a,b) OP a,b;
799 /* AK 010890 V1.1 */ /* AK 060891 V1.3 */
800 
801 {
802     OBJECTSELF c;
803     c = s_o_s(a);
804     c.ob_list->l_next = b;
805     return(OK); }
806 
c_l_s(a,b)807 INT c_l_s(a,b) OP a,b;
808 /* AK 010890 V1.1 */ /* AK 060891 V1.3 */
809 {
810     OBJECTSELF c;
811     c = s_o_s(a);
812     c.ob_list->l_self = b;
813     return(OK);
814 }
815 
816 
817 
freeself_list(obj)818 INT freeself_list(obj) OP obj;
819 /* AK 290689 V1.0 */ /* AK 211189 V1.1 */ /* AK 170591 V1.2 */
820 /* AK 060891 V1.3 */
821 {
822     INT erg = OK;
823     OP z = obj,za=NULL;
824 
825 
826     z = S_L_N(obj);
827     while (z != NULL)
828         {
829         za = z;
830         z = S_L_N(z);
831         C_L_N(za,NULL);
832         if (S_L_S(za) != NULL) FREEALL(S_L_S(za));
833         erg += free_list(S_O_S(za).ob_list);
834         C_O_K(za,EMPTY);
835         FREEALL(za);
836         }
837 
838     if (S_L_S(obj) != NULL)
839         FREEALL(S_L_S(obj));
840 
841     erg += free_list(S_O_S(obj).ob_list);
842     C_O_K(obj,EMPTY);
843     ENDR("freeself_list");
844 }
845 
846 
847 
848 
scan_list(a,givenkind)849 INT scan_list(a,givenkind) OP a; OBJECTKIND givenkind;
850 /* genaue art der liste */
851 /* AK 210688 */ /* AK 030789 V1.0 */ /* AK 010890 V1.1 */
852 /* AK 060891 V1.3 */
853 {
854     char antwort[2];
855     INT erg;
856 
857 
858     /* a ist ein leeres object */
859     b_sn_l(callocobject(),NULL,a);
860     /* self ist nun initialisiert */
861     if (givenkind == (OBJECTKIND)0) {
862         /*
863             a ----> kind: LIST
864                        self: --|
865                            |
866                            V
867                        |-------------|
868                        | self : OP   |
869                        | next : NULL |
870                        |-------------|
871             */
872         printeingabe("please enter kind of list element");
873         givenkind = scanobjectkind(); /* nun weiss man das */
874     }
875 
876 
877     erg=scan(givenkind,S_L_S(a));
878     if (erg == ERROR) {
879         error("scan_list:error in scanning listelement");
880         goto endr_ende;
881     }
882 
883     printeingabe("one more listelement y/n");
884     skip_comment(); /* AK 210395 */
885     scanf("%s",antwort);
886     if (antwort[0]  == 'y')
887     {
888         C_L_N(a,callocobject());
889         erg += scan_list(S_L_N(a),givenkind);
890     };
891     ENDR("scan_list");
892 }
893 #endif /* LISTTRUE */
894 
895 
896 #ifdef VECTORTRUE
897 #ifdef LISTTRUE
t_LIST_VECTOR(a,b)898 INT t_LIST_VECTOR(a,b) OP a,b;
899 /* AK 090889 wandelt eine Liste in einen Vektor um */
900 /* die daten werden dabei kopiert */
901 /* AK 090889 V1.1 */ /* AK 060891 V1.3 */
902 {
903     INT i;
904     INT erg = OK;
905     OP l;
906 
907     if (not LISTP(a))
908         WTO("t_LIST_VECTOR",a);
909     CE2(a,b,t_LIST_VECTOR);
910     l = callocobject();
911     erg += length(a,l);
912     erg += b_l_v(l,b);
913     for(i=0L;i<S_I_I(l);i++,a=S_L_N(a))
914         erg += copy(S_L_S(a),S_V_I(b,i));
915     ENDR("t_LIST_VECTOR");
916 }
917 
918 #define T_VECTOR_LIST_CO(a,b,t)\
919 /* AK 140802 */\
920     {\
921     INT i;\
922     for(i=0L;b != NULL;)\
923     {\
924         erg += b_sn_l(CALLOCOBJECT(),NULL,b);\
925         C_O_K(b,t);\
926         COPY(S_V_I(a,i),S_L_S(b));\
927         if (++i < S_V_LI(a)) C_L_N(b,CALLOCOBJECT());\
928         b = S_L_N(b);\
929     }  \
930     }
931 
t_VECTOR_LIST(a,b)932 INT t_VECTOR_LIST(a,b) OP a,b;
933 /* AK 090889 change from vector to list */
934 /* the order will be the same, data will be copied */
935 /* AK 090889 V1.1 */ /* AK 130591 V1.2 */ /* AK 060891 V1.3 */
936 {
937     INT i,erg=OK;
938 
939     if (not VECTORP(a))
940         WTO("t_VECTOR_LIST",a);
941     CE2(a,b,t_VECTOR_LIST);
942     T_VECTOR_LIST_CO(a,b,LIST);
943     ENDR("t_VECTOR_LIST");
944 }
945 
t_VECTOR_POLYNOM(a,b)946 INT t_VECTOR_POLYNOM(a,b) OP a,b;
947 /* AK 140802 */
948 {
949     INT erg = OK;
950     CTO(VECTOR,"t_VECTOR_POLYNOM(1)",a);
951     CE2(a,b,t_VECTOR_POLYNOM);
952     T_VECTOR_LIST_CO(a,b,POLYNOM);
953     ENDR("t_VECTOR_POLYNOM");
954 }
955 #endif /* LISTTRUE */
956 #endif /* VECTORTRUE */
957 
958 
test_list()959 INT test_list()
960 /* AK 010890 V1.1 */ /* AK 060891 V1.3 */
961 {
962     OP a= callocobject();
963     OP b= callocobject();
964     b_sn_l(NULL,NULL,a);
965     println(a);
966     freeself(a);
967     scan(LIST,a);
968     println(a);
969     scan(LIST,b);
970     println(b);
971     insert(a,b,NULL,NULL);
972     println(b);
973     freeself(b);
974     return(OK);
975 }
976 
977 
978 #ifdef LISTTRUE
tex_list(list)979 INT tex_list(list) OP list;
980 /* zur ausgabe einer liste */
981 /* AK 210688 */ /* AK 290689 V1.0 */ /* AK 191289 V1.1 */
982 /* AK 070291 V1.2 texout instead of stdout for output */
983 /* AK 060891 V1.3 */
984 {
985     OP zeiger = list;
986     while (zeiger != NULL) /* abbruch bedingung */
987     {
988         tex(S_L_S(zeiger));
989         fprintf(texout,"\\ ");
990         texposition += 3L;
991         zeiger = S_L_N(zeiger);
992     }
993     return(OK);
994 }
995 #endif /* LISTTRUE */
996 
997 
insert_list_list_2(von,nach,eh,cf)998 INT insert_list_list_2(von,nach,eh,cf) OP von,nach; INT (*eh)(), (*cf)();
999 /* for compability */
1000 {
1001     return insert_list_list(von,nach,eh,cf);
1002 }
1003 
insert_list_list(von,nach,eh,cf)1004 INT insert_list_list(von,nach,eh,cf) OP von,nach; INT (*eh)(), (*cf)();
1005 /* programmiert nach
1006 christopher J. van Wyk : Data  structures and c programs */
1007 /* AK 201289 V1.1 */ /* AK 130591 V1.2 */
1008 /* AK 060891 V1.3 */
1009 {
1010     struct object dummy;
1011     struct list dummy_list;
1012     OP p;
1013     INT res,erg=OK;
1014     OBJECTSELF d;
1015     OBJECTKIND kind=S_O_K(von);
1016     OP nn,altnext;
1017 
1018 
1019 
1020     if (nach == NULL) {
1021         error("insert_list_list:nach == NULL");
1022         /* darf nicht vorkommen, nach muss initialisiert sein */
1023         goto ende;
1024     }
1025 
1026     if (EMPTYP(nach))
1027         init(kind,nach);
1028 
1029 
1030     if (S_L_S(nach) == NULL)
1031     {
1032         C_L_S(nach,S_L_S(von));
1033         C_L_N(nach,S_L_N(von));
1034         C_L_S(von,NULL); /* AK 300197 */
1035         C_L_N(von,NULL); /* AK 300197 */
1036         FREEALL(von); /* AK 300197 */
1037         goto ende;
1038     }
1039 
1040     if (S_L_S(von) == NULL)
1041         {
1042         FREEALL(von);
1043         goto ende;
1044         }
1045 
1046 
1047     if (EMPTYP(S_L_S(nach)))    /* nach ist leer */
1048         {
1049         erg +=  error("insert_list_list: result is a LIST with empty self");
1050         goto ende;
1051         }
1052 
1053     nn = CALLOCOBJECT();
1054     *nn = *nach;
1055     p = &dummy;
1056 
1057     d.ob_list = &dummy_list;
1058     C_O_S(p,d);
1059     C_O_K(p,LIST);
1060 
1061     if (cf == NULL) cf = comp;
1062     while((von != NULL) && (nn != NULL))
1063     {
1064         res = (* cf)(S_L_S(von),S_L_S(nn));
1065         if (res < 0L) {
1066             C_L_N(p,von);
1067             von = S_L_N(von);
1068             p = S_L_N(p);
1069         }
1070         else if (res >0L){
1071             C_L_N(p,nn);
1072             nn = S_L_N(nn);
1073             p = S_L_N(p);
1074         }
1075         else {
1076             if (eh == NULL);
1077             else if (eh == add_koeff) /* AK 011101 */
1078                 {
1079                 ADD_KOEFF(S_L_S(von),S_L_S(nn));
1080                 }
1081             else (*eh)(S_L_S(von),S_L_S(nn));
1082             if (not EMPTYP(S_L_S(nn))) {
1083                 /* eh hat nicht geloescht */
1084                 C_L_N(p,nn);
1085                 p = S_L_N(p);
1086                 nn = S_L_N(nn);
1087             }
1088             else {
1089                 FREEALL(S_L_S(nn));
1090                 altnext=S_L_N(nn);
1091                 C_L_N(nn,NULL); /* AK 300197 */
1092                 C_L_S(nn,NULL); /* AK 300197 */
1093                 FREEALL(nn); /* AK 300197 */
1094                 nn = altnext;
1095             }
1096 
1097             FREEALL(S_L_S(von));
1098             altnext=S_L_N(von);
1099             C_L_N(von,NULL); /* AK 300197 */
1100             C_L_S(von,NULL); /* AK 300197 */
1101             FREEALL(von); /* AK 300197 */
1102             von = altnext;
1103         }
1104     }
1105 
1106     C_L_N(p,NULL);
1107     if (von == NULL)
1108         von = nn;
1109     if (von != NULL)
1110         C_L_N(p,von);
1111     if (S_L_N(&dummy) == NULL)
1112         {
1113         C_O_K(nach,EMPTY);
1114         init (kind,nach);
1115         }
1116     else     {
1117         *nach = *(S_L_N(&dummy));
1118         C_O_K(S_L_N(&dummy),EMPTY);
1119         FREEALL(S_L_N(&dummy));
1120         }
1121 ende:
1122     ENDR("insert_list_list");
1123 }
1124 
1125 #ifdef LISTTRUE
objectwrite_list(f,a)1126 INT objectwrite_list(f,a) FILE *f; OP a;
1127 /* AK 210690 V1.1 */ /* AK 100591 V1.2 */
1128 /* AK 060891 V1.3 */
1129 {
1130     fprintf(f, "%" PRIINT " " , (INT)S_O_K(a));
1131     if (S_L_S(a) == NULL) /* 100591 */
1132         fprintf(f,"%ld\n",0L);
1133     else    {
1134         fprintf(f,"%ld\n",1L);
1135         objectwrite(f,S_L_S(a));
1136         }
1137     if (S_L_N(a) == NULL)
1138         {
1139         fprintf(f,"%ld\n",0L);
1140         return OK;
1141         }
1142     else    {
1143         fprintf(f,"%ld\n",1L);
1144         return objectwrite(f,S_L_N(a));
1145         }
1146 }
1147 
1148 
objectread_list(f,a)1149 INT objectread_list(f,a) FILE *f; OP a;
1150 /* AK 210690 V1.1 */ /* AK 100591 V1.2 */
1151 /* AK 060891 V1.3 */
1152 {
1153     INT i;
1154     fscanf(f, "%" SCNINT ,&i);
1155     if (i == 0)
1156         b_sn_l(NULL,NULL,a);
1157     else if (i == 1)
1158         {
1159         b_sn_l(callocobject(),NULL,a);
1160         objectread(f,S_L_S(a));
1161         }
1162     else
1163         return error("objectread_list: wrong format (1) ");
1164     fscanf(f, "%" SCNINT ,&i);
1165     if (i == 0L)
1166         return OK;
1167     else if (i == 1L)
1168         {
1169         C_L_N(a,callocobject());
1170         return objectread(f,S_L_N(a));
1171         }
1172     else
1173         return error("objectread_list: wrong format (2) ");
1174 }
1175 
1176 
filter_apply_list(a,tf)1177 INT filter_apply_list(a,tf) OP a; INT (*tf)();
1178 /* AK 020394 */
1179 /* if tf return true the elements stays in the list */
1180 /* error beseitigt am 110397 */
1181 /* tf takes a list element as input */
1182 {
1183     OP z,zb,vorg=NULL;
1184     INT erg = OK;
1185     OBJECTKIND typ = S_O_K(a);
1186     z = a;
1187     if (S_L_S(a) == NULL)
1188         goto endr_ende;
1189     while (z != NULL)
1190         {
1191         if ((*tf)(S_L_S(z)) == TRUE)
1192             /* stays inside the list */
1193             {
1194             if (vorg != NULL)  C_L_N(vorg,z);
1195             zb = z;
1196             z = S_L_N(z);
1197             C_L_N(zb,NULL);
1198             if (vorg == NULL)
1199                 {
1200                 if (a != zb)
1201                     {
1202                     *a = *zb;
1203                     C_O_K(zb,EMPTY);
1204                     FREEALL(zb);
1205                     }
1206                 vorg = a;
1207                 }
1208             else
1209                 vorg = zb;
1210             }
1211         else
1212             /* remove from the list */
1213             {
1214             zb = z;
1215             z = S_L_N(z);
1216             C_L_N(zb,NULL);
1217             if (zb != a) FREEALL(zb);
1218             else FREESELF(zb);
1219             }
1220         } /* end while z!=NULL */
1221     if (vorg == NULL)
1222         erg += init(typ,a);
1223 
1224     ENDR("filter_apply_list");
1225 }
1226 #endif /* LISTTRUE */
1227 
1228