1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2021 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: General */
22 /* File: seed7/src/traceutl.c */
23 /* Changes: 1990 - 1994, 2008, 2010 - 2021 Thomas Mertes */
24 /* Content: Tracing and protocol procedures. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "string.h"
36 #include "limits.h"
37
38 #include "common.h"
39 #include "data.h"
40 #include "data_rtl.h"
41 #include "os_decls.h"
42 #include "heaputl.h"
43 #include "flistutl.h"
44 #include "datautl.h"
45 #include "striutl.h"
46 #include "chclsutl.h"
47 #include "entutl.h"
48 #include "identutl.h"
49 #include "syvarutl.h"
50 #include "actutl.h"
51 #include "infile.h"
52 #include "findid.h"
53 #include "doany.h"
54 #include "option.h"
55 #include "set_rtl.h"
56 #include "str_rtl.h"
57 #include "ut8_rtl.h"
58 #include "big_drv.h"
59 #include "con_rtl.h"
60 #include "con_drv.h"
61 #include "pcs_drv.h"
62
63 #undef EXTERN
64 #define EXTERN
65 #define DO_INIT
66 #include "traceutl.h"
67
68
69 static fileRecord protFileRecord = {NULL, 0};
70 static fileType protfile = &protFileRecord;
71 static boolType internal_protocol = FALSE;
72
73 /* #define prot_ptr(ptr) */
74 #define prot_ptr(ptr) prot_int((intType) (memSizeType) ptr)
75
76
77
prot_flush(void)78 void prot_flush (void)
79
80 {
81 traceRecord trace_backup;
82
83 /* prot_flush */
84 if (internal_protocol) {
85 if (SYS_PROT_OUTFILE_OBJECT != NULL) {
86 memcpy(&trace_backup, &trace, sizeof(traceRecord));
87 memset(&trace, 0, sizeof(traceRecord));
88 do_flush(SYS_PROT_OUTFILE_OBJECT);
89 memcpy(&trace, &trace_backup, sizeof(traceRecord));
90 } /* if */
91 } else {
92 if (protfile->cFile == NULL) {
93 protfile->cFile = stdout;
94 } /* if */
95 fflush(protfile->cFile);
96 } /* if */
97 } /* prot_flush */
98
99
100
prot_nl(void)101 void prot_nl (void)
102
103 {
104 traceRecord trace_backup;
105
106 /* prot_nl */
107 if (internal_protocol) {
108 if (SYS_PROT_OUTFILE_OBJECT != NULL) {
109 memcpy(&trace_backup, &trace, sizeof(traceRecord));
110 memset(&trace, 0, sizeof(traceRecord));
111 do_wrnl(SYS_PROT_OUTFILE_OBJECT);
112 memcpy(&trace, &trace_backup, sizeof(traceRecord));
113 } /* if */
114 } else {
115 if (protfile->cFile == NULL) {
116 protfile->cFile = stdout;
117 } /* if */
118 fputs("\n", protfile->cFile);
119 } /* if */
120 } /* prot_nl */
121
122
123
prot_cstri(const_cstriType cstri)124 void prot_cstri (const_cstriType cstri)
125
126 {
127 traceRecord trace_backup;
128
129 /* prot_cstri */
130 if (internal_protocol) {
131 if (SYS_PROT_OUTFILE_OBJECT != NULL) {
132 memcpy(&trace_backup, &trace, sizeof(traceRecord));
133 memset(&trace, 0, sizeof(traceRecord));
134 do_wrcstri(SYS_PROT_OUTFILE_OBJECT, cstri);
135 memcpy(&trace, &trace_backup, sizeof(traceRecord));
136 } /* if */
137 } else {
138 if (protfile->cFile == NULL) {
139 protfile->cFile = stdout;
140 } /* if */
141 if (cstri == NULL) {
142 cstri = "*NULL*";
143 } /* if */
144 #ifdef USE_CONSOLE_FOR_PROT_CSTRI
145 if (protfile->cFile == stdout) {
146 striType stri;
147
148 stri = cstri_to_stri(cstri);
149 if (stri != NULL) {
150 conWrite(stri);
151 FREE_STRI(stri, stri->size);
152 } else {
153 fputs(cstri, protfile->cFile);
154 } /* if */
155 } else {
156 fputs(cstri, protfile->cFile);
157 } /* if */
158 #else
159 fputs(cstri, protfile->cFile);
160 #endif
161 } /* if */
162 } /* prot_cstri */
163
164
165
prot_cstri8(const const_cstriType cstri8)166 void prot_cstri8 (const const_cstriType cstri8)
167
168 {
169 traceRecord trace_backup;
170 striType stri;
171 errInfoType err_info = OKAY_NO_ERROR;
172
173 /* prot_cstri8 */
174 if (internal_protocol) {
175 if (SYS_PROT_OUTFILE_OBJECT != NULL) {
176 memcpy(&trace_backup, &trace, sizeof(traceRecord));
177 memset(&trace, 0, sizeof(traceRecord));
178 stri = cstri8_to_stri(cstri8, &err_info);
179 if (stri != NULL) {
180 do_wrstri(SYS_PROT_OUTFILE_OBJECT, stri);
181 FREE_STRI(stri, stri->size);
182 } else {
183 do_wrcstri(SYS_PROT_OUTFILE_OBJECT, cstri8);
184 } /* if */
185 memcpy(&trace, &trace_backup, sizeof(traceRecord));
186 } /* if */
187 } else {
188 if (protfile->cFile == NULL) {
189 protfile->cFile = stdout;
190 } /* if */
191 if (protfile->cFile == stdout) {
192 stri = cstri8_to_stri(cstri8, &err_info);
193 if (stri != NULL) {
194 conWrite(stri);
195 FREE_STRI(stri, stri->size);
196 } else {
197 fputs(cstri8, protfile->cFile);
198 } /* if */
199 } else {
200 fputs(cstri8, protfile->cFile);
201 } /* if */
202 } /* if */
203 } /* prot_cstri8 */
204
205
206
prot_cchar(char ch)207 void prot_cchar (char ch)
208
209 {
210 char buffer[2];
211
212 /* prot_cchar */
213 buffer[0] = ch;
214 buffer[1] = '\0';
215 prot_cstri(buffer);
216 } /* prot_cchar */
217
218
219
prot_writeln(const_cstriType stri)220 void prot_writeln (const_cstriType stri)
221
222 { /* prot_writeln */
223 prot_cstri(stri);
224 prot_nl();
225 } /* prot_writeln */
226
227
228
prot_int(intType ivalue)229 void prot_int (intType ivalue)
230
231 {
232 char buffer[51];
233
234 /* prot_int */
235 sprintf(buffer, FMT_D, ivalue);
236 prot_cstri(buffer);
237 } /* prot_int */
238
239
240
prot_bigint(const const_bigIntType bigIntValue)241 void prot_bigint (const const_bigIntType bigIntValue)
242
243 {
244 striType stri;
245
246 /* prot_bigint */
247 if (bigIntValue == NULL) {
248 prot_cstri("NULL");
249 } else {
250 stri = bigStr(bigIntValue);
251 prot_cstri(striAsUnquotedCStri(stri));
252 strDestr(stri);
253 } /* if */
254 } /* prot_bigint */
255
256
257
prot_bigint_hex(const const_bigIntType bigIntValue)258 static void prot_bigint_hex (const const_bigIntType bigIntValue)
259
260 {
261 cstriType cstri;
262
263 /* prot_bigint_hex */
264 cstri = bigHexCStri(bigIntValue);
265 prot_cstri(cstri);
266 UNALLOC_CSTRI(cstri, strlen(cstri));
267 } /* prot_bigint_hex */
268
269
270
271 #if WITH_FLOAT
prot_float(floatType floatValue)272 void prot_float (floatType floatValue)
273
274 {
275 char buffer[51];
276
277 /* prot_float */
278 sprintf(buffer, FMT_E, floatValue);
279 prot_cstri(buffer);
280 } /* prot_float */
281 #endif
282
283
284
prot_char(charType cvalue)285 void prot_char (charType cvalue)
286
287 {
288 char buffer[51];
289
290 /* prot_char */
291 if (cvalue < 127) {
292 if (cvalue < ' ') {
293 sprintf(buffer, "\'%s\'", stri_escape_sequence[cvalue]);
294 } else {
295 sprintf(buffer, "\'%c\'", (int) cvalue);
296 } /* if */
297 } else {
298 sprintf(buffer, "\'\\%lu;\'", (unsigned long) cvalue);
299 } /* if */
300 prot_cstri(buffer);
301 } /* prot_char */
302
303
304
prot_string(const striType stri)305 void prot_string (const striType stri)
306
307 {
308 traceRecord trace_backup;
309
310 /* prot_string */
311 if (internal_protocol) {
312 if (SYS_PROT_OUTFILE_OBJECT != NULL) {
313 memcpy(&trace_backup, &trace, sizeof(traceRecord));
314 memset(&trace, 0, sizeof(traceRecord));
315 do_wrstri(SYS_PROT_OUTFILE_OBJECT, stri);
316 memcpy(&trace, &trace_backup, sizeof(traceRecord));
317 } /* if */
318 } else {
319 if (protfile->cFile == NULL) {
320 protfile->cFile = stdout;
321 } /* if */
322 if (protfile->cFile == stdout) {
323 conWrite(stri);
324 } else {
325 ut8Write(protfile, stri);
326 } /* if */
327 } /* if */
328 } /* prot_string */
329
330
331
prot_stri_unquoted(const const_striType stri)332 void prot_stri_unquoted (const const_striType stri)
333
334 { /* prot_stri_unquoted */
335 prot_cstri(striAsUnquotedCStri(stri));
336 } /* prot_stri_unquoted */
337
338
339
prot_stri(const const_striType stri)340 void prot_stri (const const_striType stri)
341
342 { /* prot_stri */
343 if (stri != NULL) {
344 prot_cstri("\"");
345 prot_stri_unquoted(stri);
346 prot_cstri("\"");
347 } else {
348 prot_cstri(" *NULL_STRING* ");
349 } /* if */
350 } /* prot_stri */
351
352
353
prot_bstri(bstriType bstri)354 void prot_bstri (bstriType bstri)
355
356 { /* prot_bstri */
357 if (bstri != NULL) {
358 prot_cstri("\"");
359 prot_cstri(bstriAsUnquotedCStri(bstri));
360 prot_cstri("\"");
361 } else {
362 prot_cstri(" *NULL_BYTE_STRING* ");
363 } /* if */
364 } /* prot_bstri */
365
366
367
prot_set(const_setType setValue)368 void prot_set (const_setType setValue)
369
370 {
371 intType position;
372 bitSetType bitset_elem;
373 unsigned int bit_index;
374 boolType first_elem;
375
376 /* prot_set */
377 if (setValue != NULL) {
378 prot_cstri("set[");
379 prot_int(setValue->min_position);
380 prot_cstri("/");
381 prot_int(setValue->max_position);
382 prot_cstri("]{");
383 first_elem = TRUE;
384 for (position = setValue->min_position; position <= setValue->max_position; position++) {
385 bitset_elem = setValue->bitset[position - setValue->min_position];
386 if (bitset_elem != 0) {
387 for (bit_index = 0; bit_index < CHAR_BIT * sizeof(bitSetType); bit_index++) {
388 if (bitset_elem & ((bitSetType) 1) << bit_index) {
389 if (first_elem) {
390 first_elem = FALSE;
391 } else {
392 prot_cstri(", ");
393 } /* if */
394 prot_int(position << bitset_shift | (intType) bit_index);
395 } /* if */
396 } /* for */
397 } /* if */
398 } /* for */
399 prot_cstri("}");
400 } else {
401 prot_cstri(" *NULL_SET* ");
402 } /* if */
403 } /* prot_set */
404
405
406
prot_block(const_blockType blockValue)407 void prot_block (const_blockType blockValue)
408
409 { /* prot_block */
410 if (blockValue == NULL) {
411 prot_cstri(" *NULL_BLOCK* ");
412 } else {
413 prot_cstri("func result ");
414 trace1(blockValue->result.object);
415 } /* if */
416 } /* prot_block */
417
418
419
prot_heapsize(void)420 void prot_heapsize (void)
421
422 {
423 char buffer[51];
424
425 /* prot_heapsize */
426 sprintf(buffer, "%6lu", (unsigned long) heapsize());
427 prot_cstri(buffer);
428 } /* prot_heapsize */
429
430
431
printcategory(objectCategory category)432 void printcategory (objectCategory category)
433
434 { /* printcategory */
435 logFunction(printf("printcategory\n"););
436 if (category >= SYMBOLOBJECT && category <= PROGOBJECT) {
437 prot_cstri(category_cstri(category));
438 } else {
439 prot_int((intType) category);
440 } /* if */
441 logFunction(printf("printcategory -->\n"););
442 } /* printcategory */
443
444
445
obj_ptr(objectType anyobject)446 static char *obj_ptr (objectType anyobject)
447
448 {
449 static char out_buf[50];
450
451 /* obj_ptr */
452 logFunction(printf("obj_ptr\n"););
453 sprintf(out_buf, FMT_X_MEM, (memSizeType) anyobject);
454 logFunction(printf("obj_ptr -->\n"););
455 return out_buf;
456 } /* obj_ptr */
457
458
459
printtype(const_typeType anytype)460 void printtype (const_typeType anytype)
461
462 { /* printtype */
463 logFunction(printf("printtype\n"););
464 if (anytype != NULL) {
465 if (anytype->name != NULL) {
466 prot_cstri8(id_string(anytype->name));
467 } else if (anytype->result_type != NULL) {
468 if (anytype->is_varfunc_type) {
469 prot_cstri("varfunc ");
470 } else {
471 prot_cstri("func ");
472 } /* if */
473 printtype(anytype->result_type);
474 } else {
475 prot_cstri(" *ANONYM_TYPE* ");
476 } /* if */
477 /* prot_cstri(" <");
478 prot_cstri(obj_ptr(anytype->match_obj));
479 prot_cstri(">"); */
480 } else {
481 prot_cstri(" *NULL_TYPE* ");
482 } /* if */
483 logFunction(printf("printtype -->\n"););
484 } /* printtype */
485
486
487
print_real_value(const_objectType anyobject)488 static void print_real_value (const_objectType anyobject)
489
490 {
491 structType structValue;
492 striType stri;
493
494 /* print_real_value */
495 logFunction(printf("print_real_value\n"););
496 switch (CATEGORY_OF_OBJ(anyobject)) {
497 case INTOBJECT:
498 prot_int(anyobject->value.intValue);
499 break;
500 case BIGINTOBJECT:
501 prot_bigint_hex(anyobject->value.bigIntValue);
502 break;
503 case CHAROBJECT:
504 prot_char(anyobject->value.charValue);
505 break;
506 case STRIOBJECT:
507 prot_stri(anyobject->value.striValue);
508 break;
509 case BSTRIOBJECT:
510 prot_bstri(anyobject->value.bstriValue);
511 break;
512 case FILEOBJECT:
513 if (anyobject->value.fileValue == NULL) {
514 prot_cstri(" *NULL_FILE* ");
515 } else {
516 if (anyobject->value.fileValue->cFile == NULL) {
517 prot_cstri(" *CLIB_NULL_FILE* ");
518 } else if (anyobject->value.fileValue->cFile == stdin) {
519 prot_cstri("stdin");
520 } else if (anyobject->value.fileValue->cFile == stdout) {
521 prot_cstri("stdout");
522 } else if (anyobject->value.fileValue->cFile == stderr) {
523 prot_cstri("stderr");
524 } else {
525 prot_cstri("file ");
526 prot_int((intType) fileno(anyobject->value.fileValue->cFile));
527 } /* if */
528 } /* if */
529 break;
530 case SOCKETOBJECT:
531 prot_cstri("socket ");
532 prot_int((intType) anyobject->value.socketValue);
533 break;
534 #if WITH_FLOAT
535 case FLOATOBJECT:
536 prot_float(anyobject->value.floatValue);
537 break;
538 #endif
539 case ARRAYOBJECT:
540 if (anyobject->value.arrayValue != NULL) {
541 prot_cstri("array[");
542 prot_int(anyobject->value.arrayValue->min_position);
543 prot_cstri("..");
544 prot_int(anyobject->value.arrayValue->max_position);
545 prot_cstri("]");
546 } else {
547 prot_cstri(" *NULL_ARRAY* ");
548 } /* if */
549 break;
550 case HASHOBJECT:
551 if (anyobject->value.hashValue != NULL) {
552 prot_cstri("hash[");
553 prot_int((intType) anyobject->value.hashValue->size);
554 prot_cstri("]");
555 } else {
556 prot_cstri(" *NULL_HASH* ");
557 } /* if */
558 break;
559 case STRUCTOBJECT:
560 structValue = anyobject->value.structValue;
561 if (structValue != NULL) {
562 prot_cstri("struct[");
563 prot_int((intType) structValue->size);
564 prot_cstri("]");
565 if (structValue->usage_count != 0) {
566 prot_cstri("<");
567 prot_int((intType) structValue->usage_count);
568 prot_cstri(">");
569 } /* if */
570 /* prot_cstri(" ");
571 prot_ptr(structValue); */
572 } else {
573 prot_cstri(" *NULL_STRUCT* ");
574 } /* if */
575 break;
576 case INTERFACEOBJECT:
577 if (anyobject->value.objValue != NULL) {
578 if (CATEGORY_OF_OBJ(anyobject->value.objValue) == STRUCTOBJECT) {
579 structValue = anyobject->value.objValue->value.structValue;
580 if (structValue != NULL) {
581 prot_cstri("interface[");
582 prot_int((intType) structValue->size);
583 prot_cstri("]");
584 if (structValue->usage_count != 0) {
585 prot_cstri("<");
586 prot_int((intType) structValue->usage_count);
587 prot_cstri(">");
588 } /* if */
589 prot_cstri(" ");
590 prot_ptr(structValue);
591 prot_cstri(" ");
592 prot_ptr(anyobject);
593 } else {
594 prot_cstri(" *INTERFACE_NULL_STRUCT* ");
595 } /* if */
596 } else {
597 prot_cstri(" *INTERFACE_TO_");
598 printcategory(CATEGORY_OF_OBJ(anyobject->value.objValue));
599 prot_cstri("* ");
600 prot_ptr(anyobject->value.objValue);
601 prot_cstri(" ");
602 prot_ptr(anyobject);
603 } /* if */
604 prot_nl();
605 prot_cstri(" ");
606 trace1(anyobject->value.objValue);
607 } else {
608 prot_cstri(" *NULL_INTERFACE* ");
609 } /* if */
610 break;
611 case SETOBJECT:
612 prot_set(anyobject->value.setValue);
613 break;
614 case ACTOBJECT:
615 prot_cstri("action \"");
616 prot_cstri(getActEntry(anyobject->value.actValue)->name);
617 prot_cstri("\"");
618 break;
619 case BLOCKOBJECT:
620 prot_block(anyobject->value.blockValue);
621 break;
622 case WINOBJECT:
623 if (anyobject->value.winValue == NULL) {
624 prot_cstri(" *NULL_WINDOW* ");
625 } else {
626 prot_cstri("window [");
627 prot_int((intType) anyobject->value.winValue->usage_count);
628 prot_cstri("] ");
629 prot_ptr(anyobject->value.winValue);
630 } /* if */
631 break;
632 case PROCESSOBJECT:
633 if (anyobject->value.winValue == NULL) {
634 prot_cstri(" *NULL_PROCESS* ");
635 } else {
636 prot_cstri("process [");
637 prot_int((intType) anyobject->value.processValue->usage_count);
638 prot_cstri("] ");
639 stri = pcsStr(anyobject->value.processValue);
640 prot_stri(stri);
641 strDestr(stri);
642 } /* if */
643 break;
644 case PROGOBJECT:
645 if (anyobject->value.progValue == NULL) {
646 prot_cstri(" *NULL_PROG* ");
647 } else {
648 prot_cstri("prog ");
649 prot_ptr(anyobject->value.progValue);
650 } /* if */
651 break;
652 default:
653 break;
654 } /* switch */
655 logFunction(printf("print_real_value -->\n"););
656 } /* print_real_value */
657
658
659
printvalue(const_objectType anyobject)660 void printvalue (const_objectType anyobject)
661
662 { /* printvalue */
663 logFunction(printf("printvalue\n"););
664 if (HAS_ENTITY(anyobject) &&
665 IS_NORMAL_IDENT(GET_ENTITY(anyobject)->ident)) {
666 prot_cstri8(id_string(GET_ENTITY(anyobject)->ident));
667 } else {
668 print_real_value(anyobject);
669 } /* if */
670 logFunction(printf("printvalue -->\n"););
671 } /* printvalue */
672
673
674
printobject(const_objectType anyobject)675 void printobject (const_objectType anyobject)
676
677 { /* printobject */
678 logFunction(printf("printobject\n"););
679 if (anyobject == NULL) {
680 prot_cstri("(NULL)");
681 } else {
682 if (TEMP_OBJECT(anyobject)) {
683 prot_cstri("[TEMP] ");
684 } /* if */
685 if (TEMP2_OBJECT(anyobject)) {
686 prot_cstri("[TEMP2] ");
687 } /* if */
688 switch (CATEGORY_OF_OBJ(anyobject)) {
689 case VARENUMOBJECT:
690 if (HAS_ENTITY(anyobject)) {
691 prot_cstri8(id_string(GET_ENTITY(anyobject)->ident));
692 } else {
693 prot_cstri("*NULL_ENTITY_OBJECT*");
694 } /* if */
695 break;
696 case TYPEOBJECT:
697 printtype(anyobject->value.typeValue);
698 break;
699 case FORMPARAMOBJECT:
700 prot_cstri("param ");
701 if (anyobject->value.objValue != NULL &&
702 CATEGORY_OF_OBJ(anyobject->value.objValue) == TYPEOBJECT) {
703 prot_cstri("attr ");
704 } /* if */
705 printobject(anyobject->value.objValue);
706 break;
707 case VALUEPARAMOBJECT:
708 prot_cstri("value param ");
709 printobject(anyobject->value.objValue);
710 break;
711 case REFPARAMOBJECT:
712 prot_cstri("ref param ");
713 printobject(anyobject->value.objValue);
714 break;
715 case REFOBJECT:
716 prot_cstri("refobject ");
717 printobject(anyobject->value.objValue);
718 break;
719 case RESULTOBJECT:
720 case LOCALVOBJECT:
721 printobject(anyobject->value.objValue);
722 break;
723 case INTOBJECT:
724 case BIGINTOBJECT:
725 case CHAROBJECT:
726 case STRIOBJECT:
727 case BSTRIOBJECT:
728 case FILEOBJECT:
729 case SOCKETOBJECT:
730 case FLOATOBJECT:
731 case ARRAYOBJECT:
732 case HASHOBJECT:
733 case STRUCTOBJECT:
734 case INTERFACEOBJECT:
735 case SETOBJECT:
736 case BLOCKOBJECT:
737 case WINOBJECT:
738 case PROCESSOBJECT:
739 case PROGOBJECT:
740 printvalue(anyobject);
741 break;
742 case ACTOBJECT:
743 print_real_value(anyobject);
744 break;
745 case LISTOBJECT:
746 case EXPROBJECT:
747 if (HAS_ENTITY(anyobject) &&
748 GET_ENTITY(anyobject)->ident != NULL) {
749 if (GET_ENTITY(anyobject)->ident->name != NULL) {
750 if (GET_ENTITY(anyobject)->ident->name[0] != '\0') {
751 prot_cstri8(id_string(GET_ENTITY(anyobject)->ident));
752 } else {
753 prot_cstri("(");
754 prot_list(anyobject->value.listValue);
755 prot_cstri(")");
756 } /* if */
757 } else {
758 prot_cstri("(");
759 prot_list(anyobject->value.listValue);
760 prot_cstri(")");
761 } /* if */
762 } else {
763 prot_cstri("(");
764 prot_list(anyobject->value.listValue);
765 prot_cstri(")");
766 } /* if */
767 break;
768 default:
769 if (HAS_ENTITY(anyobject)) {
770 prot_cstri8(id_string(GET_ENTITY(anyobject)->ident));
771 } else {
772 printcategory(CATEGORY_OF_OBJ(anyobject));
773 prot_cstri(" *NULL_ENTITY_OBJECT*");
774 } /* if */
775 break;
776 } /* switch */
777 /* prot_cstri(" <");
778 printcategory(CATEGORY_OF_OBJ(anyobject));
779 prot_cstri(">"); */
780 } /* if */
781 logFunction(printf("printobject -->\n"););
782 } /* printobject */
783
784
785
printformparam(const_objectType aParam)786 static void printformparam (const_objectType aParam)
787
788 { /* printformparam */
789 logFunction(printf("printformparam\n"););
790 if (aParam != NULL) {
791 switch (CATEGORY_OF_OBJ(aParam)) {
792 case VALUEPARAMOBJECT:
793 if (VAR_OBJECT(aParam)) {
794 prot_cstri("in var");
795 } else {
796 prot_cstri("val ");
797 } /* if */
798 printtype(aParam->type_of);
799 if (HAS_ENTITY(aParam)) {
800 prot_cstri(": ");
801 prot_cstri8(id_string(GET_ENTITY(aParam)->ident));
802 } else {
803 prot_cstri(" param");
804 } /* if */
805 break;
806 case REFPARAMOBJECT:
807 if (VAR_OBJECT(aParam)) {
808 prot_cstri("inout ");
809 } else {
810 prot_cstri("ref ");
811 } /* if */
812 printtype(aParam->type_of);
813 if (HAS_ENTITY(aParam)) {
814 prot_cstri(": ");
815 prot_cstri8(id_string(GET_ENTITY(aParam)->ident));
816 } else {
817 prot_cstri(" param");
818 } /* if */
819 break;
820 case TYPEOBJECT:
821 prot_cstri("attr ");
822 printtype(aParam->type_of);
823 break;
824 default:
825 prot_cstri("unknown ");
826 printobject(aParam);
827 break;
828 } /* switch */
829 } else {
830 prot_cstri(" *NULL_PARAMETER* ");
831 } /* if */
832 logFunction(printf("printformparam -->\n"););
833 } /* printformparam */
834
835
836
printparam(const_objectType aParam)837 static void printparam (const_objectType aParam)
838
839 { /* printparam */
840 logFunction(printf("printparam\n"););
841 prot_cstri("(");
842 printformparam(aParam->value.objValue);
843 prot_cstri(")");
844 logFunction(printf("printparam -->\n"););
845 } /* printparam */
846
847
848
printLocObj(const_locObjType locObj)849 void printLocObj (const_locObjType locObj)
850
851 { /* printlocobj */
852 if (locObj == NULL) {
853 prot_cstri("***NULL_LOCOBJ***");
854 } else {
855 prot_cstri("locObj:");
856 prot_nl();
857 prot_cstri("object: ");
858 printobject(locObj->object);
859 prot_nl();
860 prot_cstri("init_value: ");
861 printobject(locObj->init_value);
862 prot_nl();
863 prot_cstri("create_call_obj: ");
864 printobject(locObj->create_call_obj);
865 prot_nl();
866 prot_cstri("destroy_call_obj: ");
867 printobject(locObj->destroy_call_obj);
868 prot_nl();
869 } /* if */
870 } /* printlocobj */
871
872
873
prot_list_limited(const_listType list,int limit)874 void prot_list_limited (const_listType list, int limit)
875
876 {
877 int number;
878
879 /* prot_list_limited */
880 logFunction(printf("prot_list_limited\n"););
881 prot_cstri("{");
882 number = 0;
883 while (list != NULL && number <= 50) {
884 if (list->obj == NULL) {
885 prot_cstri("*NULL_OBJECT*");
886 } else if (!LEGAL_CATEGORY_FIELD(list->obj)) {
887 prot_cstri("*CORRUPT_CATEGORY_FIELD*");
888 } else {
889 /* printcategory(CATEGORY_OF_OBJ(list->obj)); fflush(stdout); */
890 switch (CATEGORY_OF_OBJ(list->obj)) {
891 case LISTOBJECT:
892 case EXPROBJECT:
893 if (limit != 0) {
894 prot_list_limited(list->obj->value.listValue, limit - 1);
895 } else {
896 prot_cstri(" *** Limit reached *** ");
897 } /* if */
898 break;
899 case CALLOBJECT:
900 case MATCHOBJECT:
901 if (CATEGORY_OF_OBJ(list->obj->value.listValue->obj) == ACTOBJECT) {
902 prot_cstri(getActEntry(list->obj->value.listValue->obj->value.actValue)->name);
903 } else if (HAS_ENTITY(list->obj->value.listValue->obj) &&
904 GET_ENTITY(list->obj->value.listValue->obj)->ident != NULL) {
905 prot_cstri8(id_string(GET_ENTITY(list->obj->value.listValue->obj)->ident));
906 } else {
907 printtype(list->obj->value.listValue->obj->type_of);
908 prot_cstri(": <");
909 printcategory(CATEGORY_OF_OBJ(list->obj->value.listValue->obj));
910 prot_cstri("> ");
911 } /* if */
912 prot_cstri("(");
913 if (limit != 0) {
914 prot_list_limited(list->obj->value.listValue->next, limit - 1);
915 } else {
916 prot_cstri(" *** Limit reached *** ");
917 } /* if */
918 prot_cstri(")");
919 break;
920 #ifdef OUT_OF_ORDER
921 case VALUEPARAMOBJECT:
922 case REFPARAMOBJECT:
923 case RESULTOBJECT:
924 case LOCALVOBJECT:
925 printobject(list->obj->value.objValue);
926 break;
927 #endif
928 case FORMPARAMOBJECT:
929 printparam(list->obj);
930 break;
931 case INTOBJECT:
932 case BIGINTOBJECT:
933 case CHAROBJECT:
934 case STRIOBJECT:
935 case BSTRIOBJECT:
936 case FILEOBJECT:
937 case SOCKETOBJECT:
938 case FLOATOBJECT:
939 case ARRAYOBJECT:
940 case HASHOBJECT:
941 case STRUCTOBJECT:
942 case INTERFACEOBJECT:
943 case SETOBJECT:
944 case ACTOBJECT:
945 case BLOCKOBJECT:
946 case WINOBJECT:
947 case PROCESSOBJECT:
948 printvalue(list->obj);
949 break;
950 case VARENUMOBJECT:
951 if (list->obj->value.objValue != NULL) {
952 if (HAS_ENTITY(list->obj->value.objValue) &&
953 IS_NORMAL_IDENT(GET_ENTITY(list->obj->value.objValue)->ident)) {
954 prot_cstri8(id_string(GET_ENTITY(list->obj->value.objValue)->ident));
955 } else {
956 prot_cstri("<");
957 printcategory(CATEGORY_OF_OBJ(list->obj->value.objValue));
958 prot_cstri(">");
959 } /* if */
960 } else {
961 prot_cstri(" *NULL_REF* ");
962 } /* if */
963 break;
964 case TYPEOBJECT:
965 printtype(list->obj->value.typeValue);
966 break;
967 #ifdef OUT_OF_ORDER
968 case SYMBOLOBJECT:
969 printcategory(CATEGORY_OF_OBJ(list->obj));
970 prot_cstri(" ");
971 prot_int((intType) list->obj);
972 prot_cstri(" ");
973 fflush(stdout);
974 if (HAS_ENTITY(list->obj)) {
975 prot_int((intType) GET_ENTITY(list->obj));
976 prot_cstri(" ");
977 fflush(stdout);
978 if (GET_ENTITY(list->obj)->ident != NULL) {
979 prot_cstri8(id_string(GET_ENTITY(list->obj)->ident));
980 } /* if */
981 } /* if */
982 break;
983 #endif
984 default:
985 /*
986 printf("VAR_OBJECT=%s, ", VAR_OBJECT(list->obj) ? "TRUE" : "FALSE");
987 printf("TEMP_OBJECT=%s, ", TEMP_OBJECT(list->obj) ? "TRUE" : "FALSE");
988 printf("TEMP2_OBJECT=%s, ", TEMP2_OBJECT(list->obj) ? "TRUE" : "FALSE");
989 printf("HAS_POSINFO=%s, ", HAS_POSINFO(list->obj) ? "TRUE" : "FALSE");
990 printf("HAS_MATCH_ERR=%s, ", HAS_MATCH_ERR(list->obj) ? "TRUE" : "FALSE");
991 printf("HAS_PROPERTY=%s, ", HAS_PROPERTY(list->obj) ? "TRUE" : "FALSE");
992 printf("HAS_ENTITY=%s, ", HAS_ENTITY(list->obj) ? "TRUE" : "FALSE");
993 */
994 if (HAS_ENTITY(list->obj) &&
995 GET_ENTITY(list->obj)->ident != NULL) {
996 prot_cstri8(id_string(GET_ENTITY(list->obj)->ident));
997 } else {
998 printtype(list->obj->type_of);
999 prot_cstri(": <");
1000 printcategory(CATEGORY_OF_OBJ(list->obj));
1001 prot_cstri("> ");
1002 if (HAS_POSINFO(list->obj)) {
1003 prot_string(get_file_name(GET_FILE_NUM(list->obj)));
1004 prot_cstri("(");
1005 prot_int((intType) GET_LINE_NUM(list->obj));
1006 prot_cstri(")");
1007 } else {
1008 prot_cstri("*NULL_ENTITY_OBJECT*");
1009 } /* if */
1010 } /* if */
1011 break;
1012 } /* switch */
1013 } /* if */
1014 prot_cstri(" ");
1015 list = list->next;
1016 number++;
1017 } /* while */
1018 if (list != NULL) {
1019 prot_cstri("*AND_SO_ON*");
1020 } /* if */
1021 prot_cstri("}");
1022 logFunction(printf("prot_list_limited -->\n"););
1023 } /* prot_list_limited */
1024
1025
1026
prot_list(const_listType list)1027 void prot_list (const_listType list)
1028
1029 { /* prot_list */
1030 prot_list_limited(list, -1);
1031 } /* prot_list */
1032
1033
1034
prot_params(const_listType list)1035 void prot_params (const_listType list)
1036
1037 {
1038 const_listType list_end;
1039 const_listType list_elem;
1040 boolType first_elem = TRUE;
1041 boolType previous_elem_was_symbol = FALSE;
1042
1043 /* prot_params */
1044 if (list != NULL) {
1045 list_end = list;
1046 while (list_end->next != NULL) {
1047 list_end = list_end->next;
1048 } /* while */
1049 if (CATEGORY_OF_OBJ(list->obj) != SYMBOLOBJECT &&
1050 CATEGORY_OF_OBJ(list_end->obj) == SYMBOLOBJECT &&
1051 HAS_ENTITY(list_end->obj) &&
1052 GET_ENTITY(list_end->obj)->ident != NULL &&
1053 GET_ENTITY(list_end->obj)->ident->infix_priority == 0) {
1054 prot_cstri8(id_string(GET_ENTITY(list_end->obj)->ident));
1055 first_elem = FALSE;
1056 previous_elem_was_symbol = TRUE;
1057 } else {
1058 list_end = NULL;
1059 } /* if */
1060 list_elem = list;
1061 while (list_elem != list_end) {
1062 if (list_elem->obj == NULL) {
1063 prot_cstri("*NULL_OBJECT*");
1064 } else {
1065 switch (CATEGORY_OF_OBJ(list_elem->obj)) {
1066 case VALUEPARAMOBJECT:
1067 case REFPARAMOBJECT:
1068 case TYPEOBJECT:
1069 if (first_elem) {
1070 prot_cstri("(");
1071 } else if (previous_elem_was_symbol) {
1072 prot_cstri(" (");
1073 } else {
1074 prot_cstri(", ");
1075 } /* if */
1076 printformparam(list_elem->obj);
1077 previous_elem_was_symbol = FALSE;
1078 break;
1079 default:
1080 if (previous_elem_was_symbol) {
1081 prot_cstri(" ");
1082 } else if (!first_elem) {
1083 prot_cstri(") ");
1084 } /* if */
1085 printobject(list_elem->obj);
1086 previous_elem_was_symbol = TRUE;
1087 break;
1088 } /* switch */
1089 first_elem = FALSE;
1090 } /* if */
1091 list_elem = list_elem->next;
1092 } /* while */
1093 if (!first_elem && !previous_elem_was_symbol) {
1094 prot_cstri(")");
1095 } /* if */
1096 } else {
1097 prot_cstri("{}");
1098 } /* if */
1099 } /* prot_params */
1100
1101
1102
prot_name(const_listType list)1103 void prot_name (const_listType list)
1104
1105 {
1106 const_listType list_end;
1107
1108 /* prot_name */
1109 if (list != NULL) {
1110 list_end = list;
1111 while (list_end->next != NULL) {
1112 list_end = list_end->next;
1113 } /* while */
1114 if (CATEGORY_OF_OBJ(list->obj) != SYMBOLOBJECT &&
1115 CATEGORY_OF_OBJ(list_end->obj) == SYMBOLOBJECT &&
1116 HAS_ENTITY(list_end->obj) &&
1117 GET_ENTITY(list_end->obj)->ident != NULL &&
1118 GET_ENTITY(list_end->obj)->ident->infix_priority == 0) {
1119 prot_cstri8(id_string(GET_ENTITY(list_end->obj)->ident));
1120 prot_cstri(" (");
1121 while (list->next != NULL) {
1122 if (list->obj == NULL) {
1123 prot_cstri("*NULL_OBJECT*");
1124 } else {
1125 switch (CATEGORY_OF_OBJ(list->obj)) {
1126 case FORMPARAMOBJECT:
1127 printformparam(list->obj->value.objValue);
1128 break;
1129 default:
1130 printobject(list->obj);
1131 break;
1132 } /* switch */
1133 } /* if */
1134 list = list->next;
1135 if (list->next != NULL) {
1136 prot_cstri(", ");
1137 } /* if */
1138 } /* while */
1139 prot_cstri(")");
1140 } else {
1141 prot_list(list);
1142 } /* if */
1143 } else {
1144 prot_cstri("{}");
1145 } /* if */
1146 } /* prot_name */
1147
1148
1149
prot_owner(const_ownerType owner)1150 static void prot_owner (const_ownerType owner)
1151
1152 { /* prot_owner */
1153 logFunction(printf("prot_owner\n"););
1154 while (owner != NULL) {
1155 printobject(owner->obj);
1156 owner = owner->next;
1157 if (owner != NULL) {
1158 prot_cstri(".");
1159 } /* if */
1160 } /* while */
1161 logFunction(printf("prot_owner -->\n"););
1162 } /* prot_owner */
1163
1164
1165
list_ident_names(const_identType anyident)1166 static void list_ident_names (const_identType anyident)
1167
1168 { /* list_ident_names */
1169 logFunction(printf("list_ident_names\n"););
1170 if (anyident != NULL) {
1171 list_ident_names(anyident->next1);
1172 if (anyident->entity != NULL) {
1173 if (anyident->entity->data.owner != NULL) {
1174 prot_cstri8(id_string(anyident));
1175 prot_cstri(" is ");
1176 printobject(anyident->entity->data.owner->obj);
1177 prot_nl();
1178 } /* if */
1179 } /* if */
1180 list_ident_names(anyident->next2);
1181 } /* if */
1182 logFunction(printf("list_ident_names -->\n"););
1183 } /* list_ident_names */
1184
1185
1186
trace_node(const_nodeType anynode)1187 void trace_node (const_nodeType anynode)
1188
1189 { /* trace_node */
1190 logFunction(printf("trace_node\n"););
1191 if (anynode == NULL) {
1192 prot_cstri(" *NULL_NODE* ");
1193 } else {
1194 if (anynode->match_obj != NULL) {
1195 if (HAS_ENTITY(anynode->match_obj)) {
1196 prot_cstri8(id_string(GET_ENTITY(anynode->match_obj)->ident));
1197 } else {
1198 prot_cstri(" *NULL_MATCH_OBJ_ENTITY* ");
1199 } /* if */
1200 } else {
1201 prot_cstri(" *NULL_MATCH_OBJ* ");
1202 } /* if */
1203 prot_cstri(" is ");
1204 if (anynode->entity != NULL) {
1205 if (anynode->entity->data.owner != NULL) {
1206 printobject(anynode->entity->data.owner->obj);
1207 } else {
1208 prot_cstri(" *NULL_ENTITY_OBJECTS* ");
1209 } /* if */
1210 } else {
1211 prot_cstri(" *NULL_ENTITY* ");
1212 } /* if */
1213 } /* if */
1214 logFunction(printf("trace_node -->\n"););
1215 } /* trace_node */
1216
1217
1218
list_match_object(const_objectType anyobject,char * buffer)1219 static void list_match_object (const_objectType anyobject, char *buffer)
1220
1221 { /* list_match_object */
1222 logFunction(printf("list_match_object\n"););
1223 if (anyobject != NULL) {
1224 if (HAS_ENTITY(anyobject)) {
1225 strcat(buffer, id_string(GET_ENTITY(anyobject)->ident));
1226 } else {
1227 strcat(buffer, " *NULL_MATCH_OBJ_ENTITY* ");
1228 } /* if */
1229 } else {
1230 strcat(buffer, " *NULL_MATCH_OBJ* ");
1231 } /* if */
1232 logFunction(printf("list_match_object -->\n"););
1233 } /* list_match_object */
1234
1235
1236
list_node_names(const_nodeType anynode,char * buffer)1237 static void list_node_names (const_nodeType anynode, char *buffer)
1238
1239 {
1240 size_t buf_len;
1241 size_t buf_len2;
1242
1243 /* list_node_names */
1244 logFunction(printf("list_node_names\n"););
1245 if (anynode != NULL) {
1246 if (anynode->usage_count > 0) {
1247 buf_len = strlen(buffer);
1248 if (anynode->match_obj != NULL) {
1249 if (CATEGORY_OF_OBJ(anynode->match_obj) == TYPEOBJECT) {
1250 if (anynode->match_obj->value.typeValue != NULL) {
1251 if (anynode->match_obj->value.typeValue->name != NULL) {
1252 strcat(buffer, id_string(anynode->match_obj->value.typeValue->name));
1253 } else if (anynode->match_obj->value.typeValue->result_type != NULL &&
1254 anynode->match_obj->value.typeValue->result_type->name != NULL) {
1255 if (anynode->match_obj->value.typeValue->is_varfunc_type) {
1256 strcat(buffer, "varfunc ");
1257 } else {
1258 strcat(buffer, "func ");
1259 } /* if */
1260 strcat(buffer, id_string(anynode->match_obj->value.typeValue->result_type->name));
1261 } else {
1262 strcat(buffer, " *ANONYM_TYPE* ");
1263 } /* if */
1264 } else {
1265 strcat(buffer, " *NULL_TYPE* ");
1266 } /* if */
1267 } else {
1268 list_match_object(anynode->match_obj, buffer);
1269 } /* if */
1270 } else {
1271 strcat(buffer, " *NULL_MATCH_OBJ* ");
1272 } /* if */
1273 strcat(buffer, " <");
1274 strcat(buffer, obj_ptr(anynode->match_obj));
1275 strcat(buffer, ">");
1276 if (anynode->entity != NULL) {
1277 if (anynode->entity->data.owner != NULL) {
1278 prot_cstri8(buffer);
1279 prot_cstri(" is ");
1280 printobject(anynode->entity->data.owner->obj);
1281 prot_nl();
1282 } /* if */
1283 } /* if */
1284 buf_len2 = strlen(buffer);
1285 if (anynode->symbol != NULL) {
1286 strcat(buffer, " ");
1287 list_node_names(anynode->symbol, buffer);
1288 buffer[buf_len2] = '\0';
1289 } /* if */
1290 if (anynode->inout_param != NULL) {
1291 strcat(buffer, " inout_param ");
1292 list_node_names(anynode->inout_param, buffer);
1293 buffer[buf_len2] = '\0';
1294 } /* if */
1295 if (anynode->other_param != NULL) {
1296 strcat(buffer, " other_param ");
1297 list_node_names(anynode->other_param, buffer);
1298 buffer[buf_len2] = '\0';
1299 } /* if */
1300 if (anynode->attr != NULL) {
1301 strcat(buffer, " attr ");
1302 list_node_names(anynode->attr, buffer);
1303 buffer[buf_len2] = '\0';
1304 } /* if */
1305 buffer[buf_len] = '\0';
1306 list_node_names(anynode->next1, buffer);
1307 list_node_names(anynode->next2, buffer);
1308 buffer[buf_len] = '\0';
1309 } else {
1310 list_node_names(anynode->next1, buffer);
1311 list_node_names(anynode->next2, buffer);
1312 } /* if */
1313 } /* if */
1314 logFunction(printf("list_node_names -->\n"););
1315 } /* list_node_names */
1316
1317
1318
trace_nodes(void)1319 void trace_nodes (void)
1320
1321 {
1322 int position;
1323 int character;
1324 char buffer[4096];
1325
1326 /* trace_nodes */
1327 logFunction(printf("trace_nodes\n"););
1328 prot_cstri("Names declared:");
1329 prot_nl();
1330 for (position = 0; position < ID_TABLE_SIZE; position++) {
1331 list_ident_names(prog->ident.table[position]);
1332 } /* for */
1333 for (character = (int) '!'; character <= (int) '~'; character++) {
1334 if (op_character(character) ||
1335 char_class(character) == LEFTPARENCHAR ||
1336 char_class(character) == PARENCHAR) {
1337 if (prog->ident.table1[character]->entity != NULL) {
1338 if (prog->ident.table1[character]->entity->data.owner != NULL) {
1339 prot_cstri8(id_string(prog->ident.table1[character]));
1340 prot_cstri(" is ");
1341 printobject(prog->ident.table1[character]->entity->data.owner->obj);
1342 prot_nl();
1343 } /* if */
1344 } /* if */
1345 } /* if */
1346 } /* for */
1347 if (prog->declaration_root->symbol != NULL) {
1348 buffer[0] = '\0';
1349 list_node_names(prog->declaration_root->symbol, buffer);
1350 } /* if */
1351 if (prog->declaration_root->inout_param != NULL) {
1352 strcpy(buffer, "inout_param ");
1353 list_node_names(prog->declaration_root->inout_param, buffer);
1354 } /* if */
1355 if (prog->declaration_root->other_param != NULL) {
1356 strcpy(buffer, "other_param ");
1357 list_node_names(prog->declaration_root->other_param, buffer);
1358 } /* if */
1359 if (prog->declaration_root->attr != NULL) {
1360 strcpy(buffer, "attr ");
1361 list_node_names(prog->declaration_root->attr, buffer);
1362 } /* if */
1363 prot_cstri("----------");
1364 prot_nl();
1365 logFunction(printf("trace_nodes -->\n"););
1366 } /* trace_nodes */
1367
1368
1369
printnodes(const_nodeType anynode)1370 void printnodes (const_nodeType anynode)
1371
1372 { /* printnodes */
1373 logFunction(printf("printnodes\n"););
1374 if (anynode != NULL) {
1375 printnodes(anynode->next1);
1376 if (anynode->usage_count == 0) {
1377 prot_cstri(" USAGE=0: ");
1378 } /* if */
1379 if (anynode->match_obj != NULL) {
1380 if (CATEGORY_OF_OBJ(anynode->match_obj) == TYPEOBJECT) {
1381 printtype(anynode->match_obj->value.typeValue);
1382 } else {
1383 if (HAS_ENTITY(anynode->match_obj)) {
1384 prot_cstri8(id_string(GET_ENTITY(anynode->match_obj)->ident));
1385 } else {
1386 prot_cstri(" *NULL_MATCH_OBJ_ENTITY* ");
1387 } /* if */
1388 } /* if */
1389 prot_cstri("=");
1390 prot_ptr(anynode->match_obj);
1391 } else {
1392 prot_cstri(" *NULL_MATCH_OBJ* ");
1393 } /* if */
1394 prot_cstri(" ");
1395 printnodes(anynode->next2);
1396 } /* if */
1397 logFunction(printf("printnodes -->\n"););
1398 } /* printnodes */
1399
1400
1401
trace1(const_objectType traceobject)1402 void trace1 (const_objectType traceobject)
1403
1404 { /* trace1 */
1405 logFunction(printf("trace1\n"););
1406 if (traceobject == NULL) {
1407 prot_cstri("*NULL_OBJECT*");
1408 } else if (!LEGAL_CATEGORY_FIELD(traceobject)) {
1409 prot_cstri("*CORRUPT_CATEGORY_FIELD*");
1410 } else if (CATEGORY_OF_OBJ(traceobject) > PROGOBJECT) {
1411 prot_cstri("*ILLEGAL_CATEGORY_");
1412 printcategory(CATEGORY_OF_OBJ(traceobject));
1413 prot_cstri("*");
1414 } else {
1415 if (VAR_OBJECT(traceobject)) {
1416 prot_cstri("var");
1417 } else {
1418 prot_cstri("const");
1419 } /* if */
1420 if (TEMP_OBJECT(traceobject)) {
1421 prot_cstri(" [TEMP]");
1422 } /* if */
1423 if (TEMP2_OBJECT(traceobject)) {
1424 prot_cstri(" [TEMP2]");
1425 } /* if */
1426 if (traceobject->type_of != NULL) {
1427 prot_cstri(" ");
1428 printtype(traceobject->type_of);
1429 } /* if */
1430 prot_cstri(": ");
1431 if (HAS_POSINFO(traceobject)) {
1432 prot_string(get_file_name(GET_FILE_NUM(traceobject)));
1433 prot_cstri("(");
1434 prot_int((intType) GET_LINE_NUM(traceobject));
1435 prot_cstri(")");
1436 } else {
1437 if (HAS_ENTITY(traceobject)) {
1438 if (GET_ENTITY(traceobject)->ident != NULL) {
1439 prot_cstri8(id_string(GET_ENTITY(traceobject)->ident));
1440 } else if (traceobject->descriptor.property->params != NULL) {
1441 prot_params(traceobject->descriptor.property->params);
1442 } else if (GET_ENTITY(traceobject)->fparam_list != NULL) {
1443 prot_name(GET_ENTITY(traceobject)->fparam_list);
1444 } else {
1445 prot_cstri8(id_string(NULL));
1446 } /* if */
1447 } else {
1448 prot_cstri("*NULL_ENTITY_OBJECT*");
1449 } /* if */
1450 } /* if */
1451 prot_cstri(" is <");
1452 printcategory(CATEGORY_OF_OBJ(traceobject));
1453 prot_cstri("> ");
1454 switch (CATEGORY_OF_OBJ(traceobject)) {
1455 case REFOBJECT:
1456 case ENUMLITERALOBJECT:
1457 case CONSTENUMOBJECT:
1458 case VARENUMOBJECT:
1459 case VALUEPARAMOBJECT:
1460 case REFPARAMOBJECT:
1461 case RESULTOBJECT:
1462 case LOCALVOBJECT:
1463 /* prot_ptr(traceobject);
1464 prot_cstri(" "); */
1465 prot_ptr(traceobject->value.objValue);
1466 prot_nl();
1467 prot_cstri(" ");
1468 trace1(traceobject->value.objValue);
1469 break;
1470 case FORMPARAMOBJECT:
1471 printparam(traceobject);
1472 break;
1473 case TYPEOBJECT:
1474 printobject(traceobject);
1475 prot_cstri(" ");
1476 if (traceobject->value.typeValue != NULL) {
1477 if (traceobject->value.typeValue->meta != NULL) {
1478 prot_cstri("^");
1479 printtype(traceobject->value.typeValue->meta);
1480 prot_cstri("^");
1481 } /* if */
1482 if (traceobject->value.typeValue->result_type != NULL) {
1483 prot_cstri("[");
1484 printtype(traceobject->value.typeValue->result_type);
1485 prot_cstri("]");
1486 } /* if */
1487 } else {
1488 prot_cstri(" *NULL_TYPE* ");
1489 } /* if */
1490 break;
1491 case INTOBJECT:
1492 case BIGINTOBJECT:
1493 case CHAROBJECT:
1494 case STRIOBJECT:
1495 case BSTRIOBJECT:
1496 case FILEOBJECT:
1497 case SOCKETOBJECT:
1498 case FLOATOBJECT:
1499 case ARRAYOBJECT:
1500 case HASHOBJECT:
1501 case STRUCTOBJECT:
1502 case INTERFACEOBJECT:
1503 case SETOBJECT:
1504 case ACTOBJECT:
1505 case BLOCKOBJECT:
1506 case WINOBJECT:
1507 case PROCESSOBJECT:
1508 print_real_value(traceobject);
1509 break;
1510 #ifndef OUT_OF_ORDER
1511 case LISTOBJECT:
1512 case EXPROBJECT:
1513 prot_list(traceobject->value.listValue);
1514 break;
1515 #endif
1516 case CALLOBJECT:
1517 case MATCHOBJECT:
1518 if (traceobject->value.listValue == NULL) {
1519 prot_cstri(" *EMPTY_LIST* ");
1520 } else if (traceobject->value.listValue->obj == NULL) {
1521 prot_cstri(" *NULL_CALLOBJECT* ");
1522 } else {
1523 prot_cstri("<");
1524 printcategory(CATEGORY_OF_OBJ(traceobject->value.listValue->obj));
1525 prot_cstri("> ");
1526 if (CATEGORY_OF_OBJ(traceobject->value.listValue->obj) == ACTOBJECT) {
1527 prot_cstri(getActEntry(traceobject->value.listValue->obj->value.actValue)->name);
1528 } else if (HAS_ENTITY(traceobject->value.listValue->obj) &&
1529 GET_ENTITY(traceobject->value.listValue->obj)->ident != NULL) {
1530 prot_cstri8(id_string(GET_ENTITY(traceobject->value.listValue->obj)->ident));
1531 } else {
1532 printtype(traceobject->value.listValue->obj->type_of);
1533 prot_cstri(": <");
1534 printcategory(CATEGORY_OF_OBJ(traceobject->value.listValue->obj));
1535 prot_cstri("> ");
1536 } /* if */
1537 prot_cstri("(");
1538 prot_list(traceobject->value.listValue->next);
1539 prot_cstri(")");
1540 } /* if */
1541 break;
1542 case PROGOBJECT:
1543 if (traceobject->value.progValue == NULL) {
1544 prot_cstri("NULL");
1545 } else {
1546 prot_stri(traceobject->value.progValue->program_name);
1547 } /* if */
1548 break;
1549 case SYMBOLOBJECT:
1550 prot_ptr(traceobject);
1551 break;
1552 default:
1553 break;
1554 } /* switch */
1555 } /* if */
1556 logFunction(printf("trace1 -->\n"););
1557 } /* trace1 */
1558
1559
1560
trace_entity(const_entityType anyentity)1561 void trace_entity (const_entityType anyentity)
1562
1563 { /* trace_entity */
1564 if (anyentity != NULL) {
1565 prot_cstri("anyentity->ident ");
1566 prot_cstri8(id_string(anyentity->ident));
1567 prot_cstri("\n");
1568 prot_cstri("anyentity->syobject ");
1569 trace1(anyentity->syobject);
1570 prot_cstri("\n");
1571 prot_cstri("anyentity->fparam_list ");
1572 prot_list(anyentity->fparam_list);
1573 prot_cstri("\n");
1574 prot_cstri("anyentity->data.owner ");
1575 prot_owner(anyentity->data.owner);
1576 prot_cstri("\n");
1577 } else {
1578 prot_cstri("anyentity is NULL\n");
1579 } /* if */
1580 } /* trace_entity */
1581
1582
1583
trace_list(const_listType list)1584 void trace_list (const_listType list)
1585
1586 { /* trace_list */
1587 while (list != NULL) {
1588 trace1(list->obj),
1589 prot_nl();
1590 list = list->next;
1591 } /* while */
1592 } /* trace_list */
1593
1594
1595
set_protfile_name(const const_striType protfile_name)1596 void set_protfile_name (const const_striType protfile_name)
1597
1598 {
1599 os_striType os_protfile_name;
1600 static const os_charType os_mode[] = {'w', 0};
1601 int path_info = PATH_IS_NORMAL;
1602 errInfoType err_info = OKAY_NO_ERROR;
1603
1604 /* set_protfile_name */
1605 logFunction(printf("set_protfile_name\n"););
1606 if (protfile_name != NULL && protfile_name->size != 0) {
1607 os_protfile_name = cp_to_os_path(protfile_name, &path_info, &err_info);
1608 if (unlikely(os_protfile_name != NULL)) {
1609 if (protfile->cFile != NULL && protfile->cFile != stdout) {
1610 fclose(protfile->cFile);
1611 } /* if */
1612 protfile->cFile = os_fopen(os_protfile_name, os_mode);
1613 os_stri_free(os_protfile_name);
1614 if (protfile->cFile == NULL) {
1615 protfile->cFile = stdout;
1616 } /* if */
1617 } /* if */
1618 } else if (protfile->cFile == NULL) {
1619 protfile->cFile = stdout;
1620 } /* if */
1621 logFunction(printf("set_protfile_name -->\n"););
1622 } /* set_protfile_name */
1623
1624
1625
1626 #if LOG_FUNCTIONS || LOG_FUNCTIONS_EVERYWHERE
printTraceOptions(uintType options)1627 void printTraceOptions (uintType options)
1628
1629 { /* printTraceOptions */
1630 if ((options & TRACE_ACTIONS ) != 0) { printf("ACTIONS\n"); }
1631 if ((options & TRACE_DO_ACTION_CHECK) != 0) { printf("DO_ACTION_CHECK\n"); }
1632 if ((options & TRACE_DYNAMIC_CALLS ) != 0) { printf("DYNAMIC_CALLS\n"); }
1633 if ((options & TRACE_EXCEPTIONS ) != 0) { printf("EXCEPTIONS\n"); }
1634 if ((options & TRACE_HEAP_SIZE ) != 0) { printf("HEAP_SIZE\n"); }
1635 if ((options & TRACE_MATCH ) != 0) { printf("MATCH\n"); }
1636 if ((options & TRACE_EXECUTIL ) != 0) { printf("EXECUTIL\n"); }
1637 if ((options & TRACE_SIGNALS ) != 0) { printf("SIGNALS\n"); }
1638 } /* printTraceOptions */
1639 #endif
1640
1641
1642
set_trace(uintType options)1643 void set_trace (uintType options)
1644
1645 { /* set_trace */
1646 logFunction(printf("set_trace:\n");
1647 printTraceOptions(options););
1648 trace.actions = (options & TRACE_ACTIONS ) != 0;
1649 trace.check_actions = (options & TRACE_DO_ACTION_CHECK) != 0;
1650 trace.dynamic = (options & TRACE_DYNAMIC_CALLS ) != 0;
1651 trace.exceptions = (options & TRACE_EXCEPTIONS ) != 0;
1652 trace.heapsize = (options & TRACE_HEAP_SIZE ) != 0;
1653 trace.match = (options & TRACE_MATCH ) != 0;
1654 trace.executil = (options & TRACE_EXECUTIL ) != 0;
1655 trace.signals = (options & TRACE_SIGNALS ) != 0;
1656 logFunction(printf("set_trace -->\n"););
1657 } /* set_trace */
1658
1659
1660
1661 #define DO_FLAG(bits) *options = (*options & ~(uintType) (bits)) | (flag & (bits));
1662
1663
1664
mapTraceFlags(const_striType trace_level,uintType * options)1665 void mapTraceFlags (const_striType trace_level, uintType *options)
1666
1667 {
1668 memSizeType position;
1669 uintType flag = (uintType) -1;
1670
1671 /* mapTraceFlags */
1672 logFunction(printf("mapTraceFlags\n"););
1673 if (trace_level != NULL) {
1674 for (position = 0; position < trace_level->size; position++) {
1675 /* printf("option: %c\n", trace_level->mem[position]);
1676 printf("options: %lo\n", *options);
1677 printf("flag: %lo\n", flag); */
1678 switch (trace_level->mem[position]) {
1679 case '+': flag = (uintType) -1; break;
1680 case '-': flag = 0; break;
1681 case 'a': DO_FLAG(TRACE_ACTIONS); break;
1682 case 'c': DO_FLAG(TRACE_DO_ACTION_CHECK); break;
1683 case 'd': DO_FLAG(TRACE_DYNAMIC_CALLS); break;
1684 case 'e': DO_FLAG(TRACE_EXCEPTIONS); break;
1685 case 'h': DO_FLAG(TRACE_HEAP_SIZE); break;
1686 case 'm': DO_FLAG(TRACE_MATCH); break;
1687 case 'u': DO_FLAG(TRACE_EXECUTIL); break;
1688 case 's': DO_FLAG(TRACE_SIGNALS); break;
1689 case '*': DO_FLAG(TRACE_ACTIONS | TRACE_DO_ACTION_CHECK |
1690 TRACE_DYNAMIC_CALLS | TRACE_EXCEPTIONS |
1691 TRACE_HEAP_SIZE | TRACE_MATCH |
1692 TRACE_EXECUTIL | TRACE_SIGNALS);
1693 break;
1694 } /* switch */
1695 } /* for */
1696 } /* if */
1697 logFunction(printf("mapTraceFlags --> :\n");
1698 printTraceOptions(*options););
1699 } /* mapTraceFlags */
1700
1701
1702
mapTraceFlags2(const_cstriType ctrace_level,uintType * options)1703 void mapTraceFlags2 (const_cstriType ctrace_level, uintType *options)
1704
1705 {
1706 striType trace_level;
1707
1708 /* mapTraceFlags2 */
1709 logFunction(printf("mapTraceFlags2\n"););
1710 if (ctrace_level != NULL) {
1711 trace_level = cstri8_or_cstri_to_stri(ctrace_level);
1712 if (trace_level != NULL) {
1713 mapTraceFlags(trace_level, options);
1714 FREE_STRI(trace_level, trace_level->size);
1715 } /* if */
1716 } /* if */
1717 logFunction(printf("mapTraceFlags2 -->\n"););
1718 } /* mapTraceFlags2 */
1719