1 /* de.c SYMMETRICA */
2 #include "def.h"
3 #include "macro.h"
4
5
6 #include <sys/types.h>
7
8
9 #ifdef unix
10 #undef MSDOS
11 #include <sys/times.h>
12 #endif /* unix */
13
14 #include <time.h> /* for the routine clock,time */
15
16
17 #ifdef unix
18 #include <sys/param.h>
19 #endif /* unix */
20
21 OP cons_drei; /* global INTEGER variable 3 */
22 OP cons_zwei; /* global INTEGER variable 2 */
23 OP cons_eins; /* global INTEGER variable 1 */
24 OP cons_negeins;/* global INTEGER variable -1 */
25 OP cons_null; /* global INTEGER variable 0 */
26 FILE *texout; /* global variable for texoutput */
27 INT no_banner = TRUE;
28 INT no_mem_check=TRUE; /* AK 100893 */
29 INT english_tableau=FALSE; /* AK 290995 */
30
31 INT doffset=0L; /* global for debugprint AK 160393 */
32
33 INT freeall_speichersize_max = (INT) 1000000;
SYM_free(a)34 int SYM_free(a) char *a;
35 {
36 if (sym_timelimit > 0L) check_time();
37 free(a);
38 return 0;
39 }
40
SYM_malloc(a)41 char * SYM_malloc(a) int a;
42 {
43 INT erg = OK;
44 char *res;
45 INT err;
46 if (sym_timelimit > 0L) check_time();
47 SYMCHECK( (a < 0) , "SYM_malloc: size < 0");
48 sca:
49 res = (char*)malloc(a);
50 if (res == NULL)
51 {
52 err=error("SYM_malloc: no memory");
53 if (err==ERROR_RETRY) goto sca;
54 if (err==ERROR_EXPLAIN) {
55 fprintf(stderr,"I wanted %d Byte of Memory", a); }
56 }
57 return res;
58 ENDTYP("SYM_malloc",char *);
59 }
60
SYM_calloc(a,b)61 char * SYM_calloc(a,b) int a,b;
62 {
63 char *erg;
64 INT err;
65 if (sym_timelimit > 0L) check_time();
66
67 if ( a < 0 )
68 {
69 err = error("SYM_calloc: negative number of entries");
70 if (err==ERROR_EXPLAIN) {
71 fprintf(stderr,"I wanted %d pieces of size %d", a,b); }
72 return NULL;
73 }
74 else if ( b < 0 )
75 {
76 err = error("SYM_calloc: negative size");
77 if (err==ERROR_EXPLAIN) {
78 fprintf(stderr,"I wanted %d pieces of size %d", a,b); }
79 return NULL;
80 }
81 sca:
82 erg=(char*) calloc(a,b);
83 if (erg == NULL)
84 {
85 err=error("SYM_calloc: no memory");
86 if (err==ERROR_RETRY)
87 {
88 goto sca;
89 }
90 if (err==ERROR_EXPLAIN) {
91 fprintf(stderr,"I wanted %d pieces of size %d", a,b);
92 goto sca;
93 }
94 }
95 return erg;
96 }
97
SYM_realloc(a,b)98 char * SYM_realloc(a,b) char *a; int b;
99 {
100 char *erg;
101 INT err= -1;
102 if (sym_timelimit > 0L) check_time();
103 sca:
104 erg = (char *)realloc(a,b);
105
106 if (erg == NULL)
107 {
108 err=error("SYM_realloc: no memory");
109 if (err == ERROR_RETRY)
110 {
111 goto sca;
112 }
113 if (err==ERROR_EXPLAIN)
114 {
115 fprintf(stderr,"I wanted %d Byte of Memory", b);
116 goto sca;
117 }
118 }
119 return erg;
120 }
121
122
123
anfang()124 INT anfang()
125 /* AK 070890 V1.1 */ /* AK 210891 V1.3 */
126 /* AK 260298 V2.0 */
127 /* AK 280705 V3.0 */
128 {
129 time_t l;
130 INT erg = OK;
131 void srand();
132 if (not no_banner)
133 {
134 printeingabe("SYMMETRICA VERSION 3.0 - STARTING");
135 printeingabe(TITELTEXT);
136 }
137
138 time(&l);
139 l = l * l * clock();
140 srand((unsigned long)l);
141 memcheck("anfang");
142 fflush(stdout); fflush(stderr);
143
144 erg += speicher_anfang();
145 NEW_INTEGER(cons_drei,3);
146 NEW_INTEGER(cons_zwei,2);
147 NEW_INTEGER(cons_eins,1);
148 NEW_INTEGER(cons_negeins,-1);
149 NEW_INTEGER(cons_null,0); /* needed in start_longint */
150
151 texmath_yn=0L; /* not in math mode */
152
153 #ifdef LONGINTTRUE
154 start_longint();
155 #endif /* LONGINTTRUE */
156
157 check_time_co = NULL; /* co routine called in check time,
158 may be set by other programms */
159 texout = stdout;
160
161 #ifdef NUMBERTRUE /* 291091: TPMcD */
162 /* The third parameter is NULL or the name of a file with cyclotomic data */
163 setup_numbers(STD_BASIS,TRUE, NULL);
164
165 #endif /* NUMBERTRUE */
166
167 #ifdef BRUCHTRUE
168 bruch_anfang(); /* AK 100893 */
169 #endif /* BRUCHTRUE */
170
171 #ifdef VECTORTRUE
172 vec_anfang(); /* AK 100893 */
173 #endif /* VECTORTRUE */
174 #ifdef PARTTRUE
175 part_anfang(); /* AK 040903 */
176 #endif /* PARTTRUE */
177
178 #ifdef TABLEAUXTRUE
179 tab_anfang(); /* AK 100893 */
180 #endif /* TABLEAUXTRUE */
181
182 #ifdef PERMTRUE
183 perm_anfang(); /* AK 100893 */
184 #endif /* PERMTRUE */
185
186 #ifdef LISTTRUE
187 list_anfang(); /* AK 100893 */
188 #endif /* LISTTRUE */
189
190 #ifdef POLYTRUE
191 monom_anfang(); /* AK 100893 */
192 #endif /* POLYTRUE */
193 #ifdef FFTRUE
194 ff_anfang(); /* AK 011204 */
195 #endif /* FFTRUE */
196 #ifdef GRTRUE
197 galois_anfang(); /* AK 271106 */
198 #endif /* GRTRUE */
199 #ifdef LOCALTRUE
200 local_anfang(); /* AK 280705 */
201 #endif
202
203 /* checks on type of constants */
204 CTO(INTEGER,"anfang(e1)",cons_zwei);
205 CTO(INTEGER,"anfang(e2)",cons_eins);
206 CTO(INTEGER,"anfang(e3)",cons_negeins);
207 CTO(INTEGER,"anfang(e4)",cons_null);
208 CTO(INTEGER,"anfang(e5)",cons_drei);
209 ENDR("anfang");
210 }
211
212
ende()213 INT ende()
214 /* AK 070890 V1.1 */ /* AK 210891 V1.3 */
215 {
216 INT erg = OK;
217 char t[100];
218
219
220 #ifdef SCHURTRUE
221 schur_ende();
222 #endif /* SCHURTRUE */
223
224 #ifdef NUMBERTRUE /* 29.10.91: TPMcD */
225 release_numbers();
226 #endif /* NUMBERTRUE */
227
228 #ifdef POLYTRUE
229 monom_release();
230 #endif /* POLYTRUE */
231
232
233 #ifdef TABLEAUXTRUE
234 tab_ende(); /* AK 100893 */
235 #endif /* TABLEAUXTRUE */
236
237 hash_ende();
238
239 #ifdef POLYTRUE
240 monom_ende(); /* AK 100893 */ /* nach schur ende */
241 #endif /* POLYTRUE */
242
243 #ifdef BRUCHTRUE
244 bruch_ende(); /* AK 100893 */
245 #endif /* BRUCHTRUE */
246
247 #ifdef PARTTRUE
248 part_ende();
249 #endif /* PARTTRUE */
250
251 #ifdef LISTTRUE
252 list_ende(); /* AK 100893 */
253 #endif /* LISTTRUE */
254
255 #ifdef PERMTRUE
256 perm_ende(); /* AK 100893 */
257 #endif /* PERMTRUE */
258
259 #ifdef FFTRUE
260 ff_ende();
261 #endif /* FFTRUE */
262 #ifdef GRTRUE
263 galois_ende(); /* AK 271106 */
264 #endif /* GRTRUE */
265
266 #ifdef LOCALTRUE
267 local_ende(); /* AK 280705 */
268 #endif
269 #ifdef NUMBERTRUE /* AK 310893 */
270 nb_ende();
271 #endif /* NUMBERTRUE */
272
273 #ifdef LONGINTTRUE
274 longint_ende();
275 #endif /* LONGINTTRUE */
276
277 #ifdef VECTORTRUE
278 vec_ende(); /* AK 100893 */
279 #endif /* VECTORTRUE */
280
281
282 if ( /* AK 190194 */
283 (S_O_K(cons_drei) != INTEGER) ||
284 (S_O_K(cons_null) != INTEGER) ||
285 (S_O_K(cons_zwei) != INTEGER) ||
286 (S_O_K(cons_eins) != INTEGER) ||
287 (S_O_K(cons_negeins) != INTEGER) ||
288 (S_I_I(cons_null) != (INT) 0) ||
289 (S_I_I(cons_zwei) != (INT) 2) ||
290 (S_I_I(cons_eins) != (INT) 1) ||
291 (S_I_I(cons_negeins) != (INT) -1)
292 )
293 erg += error("ende: wrong constant values e.g. cons_null");
294 erg += freeall(cons_null);
295 erg += freeall(cons_zwei);
296 erg += freeall(cons_drei);
297 erg += freeall(cons_eins);
298 erg += freeall(cons_negeins);
299
300 erg += speicher_ende();
301
302
303 memcheck("ende");
304
305 if (not no_banner)
306 {
307 printeingabe("\nSYMMETRICA VERSION 3.0 - ENDING");
308 sprintf(t,"last changed: %s",TITELTEXT); /* AK 181194 */
309 printeingabe(t);
310 }
311
312 fflush(stdout);
313 fflush(stderr);
314 return erg;
315 }
runtime(l)316 INT runtime(l) long *l;
317 /* AK 270689 V1.0 */ /* AK 070890 V1.1 */ /* AK 210891 V1.3 */
318 {
319 #ifdef UNDEF
320 #ifdef unix
321 struct tms buffer;
322 times(&buffer);
323 *l = (long) buffer.tms_utime;
324 #else /* clock ist POSIX */
325 *l = (long) clock()/60;
326 #endif /* unix */
327 #endif
328 *l = (long) clock()/CLOCKS_PER_SEC;
329 return OK;
330 }
331
get_time(a)332 INT get_time(a) OP a;
333 /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
334 /* AK 300998 V2.0 */
335 {
336 long l;
337 runtime(&l);
338 return m_i_i((INT)l,a);
339 }
340
341
print_time()342 INT print_time()
343 /* AK 160890 V1.1 */ /* AK 210891 V1.3 */
344 {
345 long l;
346 runtime(&l);
347 printf("zeit:%ld\n",l);return OK;
348 }
349
350
fusedmemory(fn,stelle)351 INT fusedmemory(fn,stelle) FILE *fn; char *stelle;
352 /* AK 270689 V1.0 */ /* AK 010290 V1.1 */ /* AK 130691 V1.2 */
353 /* AK 210891 V1.3 */
354 {
355 #ifdef unix
356 #ifndef linux
357 /*
358 struct mallinfo mallinfo();
359 struct mallinfo ergebnis;
360 free(calloc(1,1));
361 ergebnis = mallinfo();
362 fprintf(fn,"%s: ",stelle);
363 fprintf(fn,"%d ",ergebnis.uordblks);
364 fprintf(fn,"%d\n",ergebnis.usmblks);
365 return(OK);
366 */
367 #endif /* linux */
368 #endif /* unix */
369 #ifdef TURBOC
370 /*
371 fprintf(fn,"%s: ",stelle);
372 fprintf(fn,"%ul\n",coreleft());
373 return(OK);
374 */
375 #endif /* TURBOC */
376 return(OK);
377 }
378
mem_small()379 INT mem_small()
380 /* anzahl small memory zurueck */
381 /* AK 270689 V1.0 */ /* AK 070890 V1.1 */ /* AK 210891 V1.3 */
382 {
383 #ifdef unix
384 #ifndef linux
385 /*
386 struct mallinfo mallinfo();
387 struct mallinfo ergebnis;
388 ergebnis = mallinfo();
389 return(ergebnis.usmblks);
390 */
391 #endif /*linux */
392 #endif /* unix */
393 return(0);
394 }
395
396
memcheck(stelle)397 INT memcheck(stelle) char *stelle;
398 /* informationen ueber memory 31/10/86 */
399 /* AK 270689 V1.0 */ /* AK 010290 V1.1 */ /* AK 210891 V1.3 */
400 {
401 #ifdef unix
402 #ifndef linux
403 /*
404 struct mallinfo mallinfo();
405 struct mallinfo ergebnis;
406
407 if (no_mem_check == TRUE) return OK;
408 SYM_free(SYM_calloc(1,1));
409 ergebnis = mallinfo();
410 printf("memory information %s\n",stelle);
411 printf("total space %d\n",ergebnis.arena);
412 printf("block number %d\n",ergebnis.ordblks);
413 printf("small blocks %d\n",ergebnis.smblks);
414 printf("used blocks %d\n",ergebnis.uordblks);
415 printf("free blocks %d\n",ergebnis.fordblks);
416 printf("used sm. blocks %d\n",ergebnis.usmblks);
417 printf("free sm. blocks %d\n",ergebnis.fsmblks);
418 return(OK);
419 */
420 #endif /*linux */
421 #endif /* unix */
422 return(OK);
423 }
424
425 INT sym_background = 0L;
426 INT sym_www = 0L;
427 INT sym_timelimit = 0L;
fatal_error(fehlertext)428 INT fatal_error(fehlertext) char *fehlertext;
429 /* AK 270295 */
430 {
431 fprintf(stderr,"fatal error in function %s\n",fehlertext);
432 exit(11);
433 return OK;
434 }
error(fehlertext)435 INT error(fehlertext) char *fehlertext;
436 /* if answer == a ==> abort
437 if answer == e ==> explain
438 if answer == g ==> go on
439 if answer == r ==> retry
440 if answer == s ==> go on suppress error texts
441 if answer == f ==> go on forever
442 else exit */
443 /* AK 270689 V1.0 */ /* AK 070890 V1.1 */
444 /* AK 070291 V1.2 explanation of possible input */
445 /* AK 210891 V1.3 */
446 {
447 char antwort[2];
448 static int forever=0;
449 if (forever==2) return ERROR;
450 if (sym_www) {
451 printf("ERROR: %s?: ",fehlertext);
452 exit(ERROR_BACKGROUND);
453 }
454 fflush(stdout);
455 fflush(stderr);
456 fprintf(stderr,
457 "\nenter a to abort with core dump, g to go, f to suppress\n");
458 fprintf(stderr,
459 "s to suppress further error text, r to retry, e to explain, else stop\n");
460 fprintf(stderr,"ERROR: %s?: ",fehlertext);
461
462
463 fflush(stderr);
464
465 if (sym_background) {
466 fprintf(stderr,"\nerror occurred in background mode finishing SYMMETRICA\n");
467 exit(ERROR_BACKGROUND);
468 }
469
470 if (forever==1) return ERROR;
471
472 antwort[0]='X';
473 scanf("%s",antwort);
474 if (antwort[0] == 'a') abort();
475 if (antwort[0] == 'f') {forever = 1; return ERROR;}
476 if (antwort[0] == 's') {forever = 2; return ERROR;}
477 if (antwort[0] == 'g') return ERROR;
478 if (antwort[0] == 'r') return ERROR_RETRY;
479 if (antwort[0] == 'e') return ERROR_EXPLAIN;
480 exit(1); /* AK 121192 */
481 }
482
483
no_memory()484 INT no_memory()
485 /* AK 090792 */
486 {
487 return error("no memory left");
488 }
489
debugprint(a)490 INT debugprint(a) OP a;
491 /* AK 260788 */ /* AK 030789 V1.0 */ /* AK 130690 V1.1 */ /* AK 210891 V1.3 */
492 {
493 OBJECTKIND kind;
494 INT i,j,k;
495 char *text=NULL;
496 for (i=0L;i<doffset;i++) fprintf(stderr," ");
497 if (a==NULL) {
498 fprintf(stderr,"NULL\n");
499 return(OK);
500 }
501 kind = s_o_k(a);
502 switch ((int)kind)
503 /* abschluss immer mit newline */
504 {
505 case 0:
506 fprintf(stderr,"kind:0=empty self=%ld\n",s_o_s(a).ob_INT);
507 break;
508 case 1:
509 fprintf(stderr,"kind:1=integer value:");
510 fprintf(stderr, "%" PRIINT "\n" ,s_i_i(a));
511 return(OK);
512 #ifdef VECTORTRUE
513 case 120199: case 31:
514 case 26: case 19: case 15:
515 case 2:
516 case 211106:
517 if (kind == 2) text="vector";
518 if (kind == 15) text="integervector";
519 if (kind == 19) text="word";
520 if (kind == 26) text="comp";
521 if (kind == 31) text="kranz";
522 if (kind == 47) text="subset";
523 if (kind == 120199) text="hashtable";
524 if (kind == 211106) text="galois ring";
525 fprintf(stderr,"kind:%d=%s length:\n",(int)kind, text);
526 doffset += 2L;
527 debugprint(s_v_l(a));
528 doffset -= 2L;
529 for (i=0L;i<s_v_li(a);i++)
530 {
531 for (k=0L;k<doffset;k++) fprintf(stderr," ");
532 fprintf(stderr, "%s %" PRIINT "-komponente:\n" ,text,i);
533 doffset += 2L;
534 debugprint(s_v_i(a,i));
535 doffset -= 2L;
536 }
537 return(OK);
538 #endif /* VECTORTRUE */
539 #ifdef PARTTRUE
540 case 3:
541 case 12:
542 {
543 if (kind == 12) text="augpartition";
544 if (kind == 3) text="partition";
545 fprintf(stderr,"kind:%d=%s kind:%d hash:%d\n",(int)kind,text,
546 (int)s_pa_k(a),
547 (int)s_pa_hash(a));
548 for (k=0L;k<doffset;k++) fprintf(stderr," ");
549 fprintf(stderr,"%s self:\n",text);
550 doffset += 2L;
551 debugprint(s_pa_s(a));
552 doffset -= 2L;
553 return(OK);
554 }
555 #endif /* PARTTRUE */
556 #ifdef BRUCHTRUE
557 case 4:
558 {
559 fprintf(stderr, "kind:4=bruch gekuerzt=%" PRIINT " oben:\n" , s_b_i(a));
560 doffset += 2L;
561 debugprint(s_b_o(a));
562 doffset -= 2L;
563 for (k=0L;k<doffset;k++) fprintf(stderr," ");
564 fprintf(stderr,"bruch unten:\n");
565 doffset += 2L;
566 debugprint(s_b_u(a));
567 doffset -= 2L;
568 return(OK);
569 }
570 #endif /* BRUCHTRUE */
571 #ifdef PERMTRUE
572 case 6:
573 {
574 fprintf(stderr,"kind:6=permutation kind:%d\n",(int)s_p_k(a));
575 for (k=0L;k<doffset;k++) fprintf(stderr," ");
576 fprintf(stderr,"permutation self:\n");
577 doffset += 2L;
578 debugprint(s_p_s(a));
579 doffset -= 2L;
580 return(OK);
581 }
582 #endif /* PERMTRUE */
583 #ifdef SKEWPARTTRUE
584 case 7:
585 {
586 fprintf(stderr,"kind:7=skewpartition gross:\n");
587 doffset += 2L;
588 debugprint(s_spa_g(a));
589 doffset -= 2L;
590 for (k=0L;k<doffset;k++) fprintf(stderr," ");
591 fprintf(stderr,"skewpartition klein:\n");
592 doffset += 2L;
593 debugprint(s_spa_k(a));
594 doffset -= 2L;
595 return(OK);
596 }
597 #endif /* SKEWPARTTRUE */
598 #ifdef TABLEAUXTRUE
599 case 8:
600 {
601 fprintf(stderr,"kind:8=tableaux self:\n");
602 doffset += 2L;
603 debugprint(s_t_s(a));
604 doffset -= 2L;
605 for (k=0L;k<doffset;k++) fprintf(stderr," ");
606 fprintf(stderr,"tableaux umriss:\n");
607 doffset += 2L;
608 debugprint(s_t_u(a));
609 doffset -= 2L;
610 return(OK);
611 }
612 #endif /* TABLEAUXTRUE */
613 #ifdef LISTTRUE
614 case 13: case 10: case 29: case 28: case 33: case 32:case 14:
615 case 20: case 9: case 42:
616 {
617 if (kind == 9) text="polynom";
618 if (kind == 20) text="list";
619 if (kind == 14) text="schubert";
620 if (kind == 10) text="schur";
621 if (kind == 13) text="homsym";
622 if (kind == 28) text="powsym";
623 if (kind == 29) text="monomial";
624 if (kind == 32) text="groupalgebra";
625 if (kind == 33) text="elmsym";
626 if (kind == 42) text="monopoly";
627 fprintf(stderr,"kind:%d=%s self:\n",(int)kind,text);
628 doffset += 2L;
629 debugprint(s_l_s(a));
630 doffset -= 2L;
631 for (k=0L;k<doffset;k++) fprintf(stderr," ");
632 fprintf(stderr,"%s next:\n",text);
633 doffset += 2L;
634 debugprint(s_l_n(a));
635 doffset -= 2L;
636 return(OK);
637 }
638 #endif /* LISTTRUE */
639 #ifdef MATRIXTRUE
640 case 27: case 11: case 40:
641 {
642 if (kind==11) text = "matrix";
643 if (kind==27) text = "kranztypus";
644 if (kind==40) text = "integermatrix";
645
646 fprintf(stderr,"kind:%d=%s height:\n",(int)kind,text);
647 doffset += 2L;
648 debugprint(s_m_h(a));
649 doffset -= 2L;
650 for (k=0L;k<doffset;k++) fprintf(stderr," ");
651 fprintf(stderr,"%s length:\n",text);
652 doffset += 2L;
653 debugprint(s_m_l(a));
654 doffset -= 2L;
655 fprintf(stderr,"%s hash:%d\n",text,s_m_hash(a));
656 for (k=0L;k<doffset;k++) fprintf(stderr," ");
657 for (i=0L;i<s_m_hi(a);i++)
658 for (j=0L;j<s_m_li(a);j++)
659 {
660 for (k=0L;k<doffset;k++) fprintf(stderr," ");
661 fprintf(stderr, "%s %" PRIINT " %" PRIINT "-komponente:\n" ,text,i,j);
662 doffset += 2L;
663 debugprint(s_m_ij(a,i,j));
664 doffset -= 2L;
665 }
666 return(OK);
667 }
668 #endif /* MATRIXTRUE */
669 #ifdef MONOMTRUE
670 case 21:
671 {
672 fprintf(stderr,"kind:21=monom koeff:\n");
673 doffset += 2L;
674 debugprint(s_mo_k(a));
675 doffset -= 2L;
676 for (k=0L;k<doffset;k++) fprintf(stderr," ");
677 fprintf(stderr,"monom self:\n");
678 doffset += 2L;
679 debugprint(s_mo_s(a));
680 doffset -= 2L;
681 return(OK);
682 }
683 #endif /* MONOMTRUE */
684 #ifdef CHARTRUE
685 case 18:
686 {
687 fprintf(stderr,"kind:18=symchar dim:\n");
688 doffset += 2L;
689 debugprint(s_sc_d(a));
690 doffset -= 2L;
691 fprintf(stderr,"symchar partitionen:\n");
692 doffset += 2L;
693 debugprint(s_sc_p(a));
694 doffset -= 2L;
695 fprintf(stderr,"symchar werte:\n");
696 doffset += 2L;
697 debugprint(s_sc_w(a));
698 doffset -= 2L;
699 return OK;
700 }
701 #endif /* CHARTRUE */
702 #ifdef LONGINTTRUE
703 case 22: return(debugprint_longint(a));
704 #endif /* LONGINTTRUE */
705 #ifdef NUMBERTRUE
706 case 41: case 43:
707 {
708 if (kind == 41) text = "cyclotomic";
709 if (kind == 43) text = "squareradical";
710
711 fprintf(stderr,"kind:%d=%s self:\n",(int)kind,text);
712 doffset += 2L;
713 debugprint(s_n_s(a));
714 doffset -= 2L;
715 return(OK);
716 }
717 #endif /*NUMBERTRUE*/
718 #ifdef VECTORTRUE
719 case 44:
720 {
721 if (kind == 44) text = "bitvector";
722 fprintf(stderr,"kind:%d=%s self:\n",(int)kind,text);
723 doffset += 2L;
724 C_O_K(a,VECTOR);
725 for (k=0L;k<doffset;k++) fprintf(stderr," ");
726 fprintf(stderr, "length = number of bits = %" PRIINT "\n" ,s_v_li(a));
727 C_O_K(a,BITVECTOR);
728 doffset -= 2L;
729 return(OK);
730 }
731 #endif /*VECTORTRUE */
732 #ifdef FFTRUE
733 case 35: return debugprint_ff(a);
734 #endif /* FFTRUE */
735 #ifdef REIHETRUE
736 case 36: return debugprint_reihe(a);
737 #endif /* REIHETRUE */
738 default:
739 fprintf(stderr,"kind:%ld unknown\n",s_o_k(a));
740 break;
741 }
742 return OK;
743 }
744
SYM_isdigit(a)745 int SYM_isdigit(a) char a; /* AK 040194 */
746 { return ((a >= '0') && (a <= '9')); }
747
SYM_strlen(a)748 int SYM_strlen(a) char *a; /* AK 030294 */
749 { int i=0; while (*a++) i++; return i; }
750
SYM_memcmp(a,b,c)751 int SYM_memcmp(a,b,c) char *a,*b; size_t c; /* AK 210294 */
752 { return memcmp(a,b,c); }
753
SYM_abs(a)754 int SYM_abs(a) INT a; /* AK 230695 */
755 { return (a>0 ) ? a : -a; }
756
757
mem_size(a)758 INT mem_size(a) OP a;
759 /* AK 150295 */
760 {
761 INT erg = OK;
762 if (a == NULL)
763 return 0;
764 switch(S_O_K(a))
765 {
766 case EMPTY:
767 case INTEGER: return sizeof(struct object);
768 case MATRIX:
769 case INTEGERMATRIX:
770 case KOSTKA: return mem_size_matrix(a);
771 case LONGINT: return mem_size_longint(a); /* AK 080903 */
772 case COMPOSITION:
773 case WORD:
774 case SUBSET:
775 case INTEGERVECTOR:
776 case VECTOR: return mem_size_vector(a);
777 case HASHTABLE: return mem_size_hashtable(a);
778 default:
779 erg += WTO("mem_size",a);goto endr_ende;
780 }
781 ENDR("mem_size");
782 }
783