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