From 125245d11c0ac7e6a04f15193d6b6227a615756d Mon Sep 17 00:00:00 2001 From: David Declerck Date: Mon, 16 Sep 2024 11:31:41 +0200 Subject: [PATCH] FIX WIP --- cobc/cobc.c | 7 +- print.h | 437 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 441 insertions(+), 3 deletions(-) create mode 100644 print.h diff --git a/cobc/cobc.c b/cobc/cobc.c index 98ec55391..73e2539df 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -1145,7 +1145,7 @@ cobc_parse_realloc (void *prevptr, const size_t size) return m->memptr; } - +#include "../print.h" void cobc_parse_free (void *prevptr) { @@ -1162,8 +1162,9 @@ cobc_parse_free (void *prevptr) /* LCOV_EXCL_START */ if (!curr) { #ifdef COB_TREE_DEBUG - cobc_err_msg (_("call to %s with invalid pointer, as it is missing in list"), - "cobc_parse_free"); + cobc_err_msg (_("call to %s with invalid pointer %p, as it is missing in list"), + "cobc_parse_free", prevptr); +print_trace(); cobc_abort_terminate (1); #else return; diff --git a/print.h b/print.h new file mode 100644 index 000000000..ae506b3ea --- /dev/null +++ b/print.h @@ -0,0 +1,437 @@ + +#include +#include +#include +#include + +#include "cobc.h" +#include "tree.h" + +#define MAX_CALL_DEPTH 10 + +static const char * node_tag(const cb_tree x) +{ + switch (CB_TREE_TAG (x)) { + case CB_TAG_CONST: return "CONST"; + case CB_TAG_INTEGER: return "INTEGER"; + case CB_TAG_STRING: return "SPRING"; + case CB_TAG_ALPHABET_NAME: return "ALPHABET-NAME"; + case CB_TAG_CLASS_NAME: return "CLASS-NAME"; + case CB_TAG_LOCALE_NAME: return "LOCALE-NAME"; + case CB_TAG_SYSTEM_NAME: return "SYSTEM-NAME"; + case CB_TAG_LITERAL: return "LITERAL"; + case CB_TAG_DECIMAL: return "DECIMAL"; + case CB_TAG_FIELD: return "FIELD"; + case CB_TAG_FILE: return "FILE"; + case CB_TAG_REPORT: return "REPORT"; + case CB_TAG_CD: return "CD"; + case CB_TAG_REFERENCE: return "REFERENCE"; + case CB_TAG_BINARY_OP: return "BINARY-OP"; + case CB_TAG_FUNCALL: return "FUNCALL"; + case CB_TAG_CAST: return "CAST"; + case CB_TAG_INTRINSIC: return "INTRINSIC"; + case CB_TAG_LABEL: return "LABEL"; + case CB_TAG_ASSIGN: return "ASSIGN"; + case CB_TAG_INITIALIZE: return "INITIALIZE"; + case CB_TAG_SEARCH: return "SEARCH"; + case CB_TAG_CALL: return "CALL"; + case CB_TAG_GOTO: return "GOTO"; + case CB_TAG_IF: return "IF"; + case CB_TAG_PERFORM: return "PERFORM"; + case CB_TAG_STATEMENT: return "STATEMENT"; + case CB_TAG_CONTINUE: return "CONTINUE"; + case CB_TAG_CANCEL: return "CANCEL"; + case CB_TAG_ALTER: return "ALTER"; + case CB_TAG_SET_ATTR: return "SET-ATTR"; + case CB_TAG_PERFORM_VARYING: return "PERFORM-VARYING"; + case CB_TAG_PICTURE: return "PICTURE"; + case CB_TAG_LIST: return "LIST"; + case CB_TAG_DIRECT: return "DIRECT"; + case CB_TAG_DEBUG: return "DEBUG"; + case CB_TAG_DEBUG_CALL: return "DEBUG-CALL"; + case CB_TAG_PROGRAM: return "PROGRAM"; + case CB_TAG_PROTOTYPE: return "PROTOTYPE"; + case CB_TAG_DECIMAL_LITERAL: return "DECIMAL-LITERAL"; + case CB_TAG_REPORT_LINE: return "REPORT-LINE"; + case CB_TAG_ML_SUPPRESS: return "ML-SUPPRESS"; + case CB_TAG_ML_TREE: return "ML-TREE"; + case CB_TAG_ML_SUPPRESS_CHECKS: return "ML-SUPPRESS-CHECKS"; + case CB_TAG_VARY: return "VARY"; + default: return "(unknown tag)"; + } +} + +static const char * node_category(const cb_tree x) +{ + switch (CB_TREE_CATEGORY (x)) { + case CB_CATEGORY_UNKNOWN: return "UNKNOWN"; + case CB_CATEGORY_ALPHABETIC: return "ALPHABETIC"; + case CB_CATEGORY_ALPHANUMERIC: return "ALPHANUMERIC"; + case CB_CATEGORY_ALPHANUMERIC_EDITED: return "ALPHANUMERIC-EDITED"; + case CB_CATEGORY_BOOLEAN: return "BOOLEAN"; + case CB_CATEGORY_INDEX: return "INDEX"; + case CB_CATEGORY_NATIONAL: return "NATIONAL"; + case CB_CATEGORY_NATIONAL_EDITED: return "NATIONAL-EDITED"; + case CB_CATEGORY_NUMERIC: return "NUMERIC"; + case CB_CATEGORY_NUMERIC_EDITED: return "NUMERIC-EDITED"; + case CB_CATEGORY_OBJECT_REFERENCE: return "OBJECT-REFERENCE"; + case CB_CATEGORY_DATA_POINTER: return "DATA-POINTER"; + case CB_CATEGORY_PROGRAM_POINTER: return "PROGRAM-POINTER"; + case CB_CATEGORY_FLOATING_EDITED: return "FLOATING-EDITED"; + case CB_CATEGORY_ERROR: return "ERROR"; + default: return "(unknown category)"; + } +} + +static void print_ident(int level) +{ + printf("%*s", level * 2, ""); +} + +static void print(int level, const char *fmt, ...) { + va_list args; + va_start(args, fmt); + print_ident(level); + vprintf(fmt, args); + va_end(args); +} + +static void print_node_internal(int level, cb_tree x) +{ + static int nested_calls = 0; + + ++nested_calls; + + if (nested_calls > MAX_CALL_DEPTH) { + print(level, "(...)\n"); + goto end; + } + + if (x == NULL) { + print(level, "(null)\n"); + goto end; + } + + print(level, "%s {%s} ", node_tag(x), node_category(x)); + + ++level; + + switch (CB_TREE_TAG (x)) { + + /* Primitives */ + + case CB_TAG_CONST: { /* 0 Constant value */ + struct cb_const *c = CB_CONST(x); + printf("VAL: '%s'\n", c->val); + break; + } + + case CB_TAG_INTEGER: { /* 1 Integer constant */ + struct cb_integer *i = CB_INTEGER(x); + printf("VAL: %d\n", i->val); + break; + } + + case CB_TAG_STRING: { /* 2 String constant */ + struct cb_string *s = CB_STRING(x); + printf("SIZE: %ld DATA: \"%s\"\n", s->size, s->data); + break; + } + + case CB_TAG_ALPHABET_NAME: { /* 3 Alphabet-name */ + struct cb_alphabet_name *an = CB_ALPHABET_NAME(x); + printf("NAME: '%s'\n", an->name); + break; + } + + case CB_TAG_CLASS_NAME: { /* 4 Class-name */ + struct cb_class_name *cn = CB_CLASS_NAME(x); + printf("NAME: '%s'\n", cn->name); + break; + } + + case CB_TAG_LOCALE_NAME: { /* 5 Locale-name */ + struct cb_locale_name *ln = CB_LOCALE_NAME(x); + printf("NAME: '%s'\n", ln->name); + break; + } + + case CB_TAG_SYSTEM_NAME: /* 6 System-name */ + printf("X\n"); + break; + + case CB_TAG_LITERAL: { /* 7 Numeric/alphanumeric literal */ + struct cb_literal *l = CB_LITERAL(x); + printf("SIZE: %d SCALE: %d LLIT: %d SIGN: %d ALL: %d DATA:\"%s\"\n", l->size, l->scale, l->llit, l->sign, l->all, l->data); + break; + } + + case CB_TAG_DECIMAL: { /* 8 Decimal number */ + struct cb_decimal *d = CB_DECIMAL(x); + printf("ID: %d\n", d->id); + break; + } + + case CB_TAG_FIELD: /* 9 User-defined variable */ + CB_TREE_TAG(x) = 255; /* Temporary change to avoid cycles */ + struct cb_field *f = CB_FIELD(x); + printf("NAME: '%s' ID: %d SIZE: %d LVL: %d\n", + f->name, f->id, f->size, f->level); + print(level, "MSIZE: %d CXSIZE: %d OFF: %d OMIN: %d OMAX: %d IDX: %d\n", + f->memory_size, /*f->compx_size*/-1, f->offset, + f->occurs_min, f->occurs_max, f->indexes); + print(level, "CNT: %d MOFF: %d NKEY: %d PNUM: %d VADDR: %d ODOLVL: %d\n", + f->count, f->mem_offset, f->nkeys, + f->param_num, f->vaddr, f->odo_level); + if (f->children) { + print(level, "CHILDREN:\n"); + print_node_internal(level + 1, CB_TREE(f->children)); + } + if (f->sister) { + print(level, "SISTER:\n"); + print_node_internal(level + 1, CB_TREE(f->sister)); + } + if (f->redefines) { + print(level, "REDEFINES:\n"); + if (CB_TREE_TAG(f->redefines) == 255) { + print(level + 1, "FIELD {%s} NAME: '%s' (cyclic)\n", + node_category(CB_TREE(f->redefines)), + f->redefines->name); + } else { + print_node_internal(level + 1, + CB_TREE(f->redefines)); + } + } + if (f->rename_thru) { + print(level, "RENAMES THRU:\n"); + print_node_internal(level + 1, CB_TREE(f->rename_thru)); + } + CB_TREE_TAG(x) = CB_TAG_FIELD; + break; + + case CB_TAG_FILE: /* 10 File description */ + printf("X\n"); + break; + + case CB_TAG_REPORT: /* 11 Report description */ + printf("X\n"); + break; + + case CB_TAG_CD: /* 12 Communication description */ + printf("X\n"); + break; + + /* Expressions */ + case CB_TAG_REFERENCE: { /* 13 Reference to a field, file, or label */ + struct cb_reference *r = CB_REFERENCE(x); + printf("REC: %d ALL: %d DECL: %d ALT: %d DBG: %d\n", + r->flag_receiving, r->flag_all, r->flag_in_decl, + r->flag_alter_code, r->flag_debug_code); + print(level, "ALLDBG: %d TARG: %d OPT: %d IGN: %d FILREF: %d DUP: %d\n", + r->flag_all_debug, r->flag_all_debug, r->flag_target, + r->flag_optional, r->flag_ignored, r->flag_filler_ref, + r->flag_duped); + if (r->offset) { + print(level, "OFFSET:\n"); + print_node_internal(level + 1, r->offset); + } + if (r->length) { + print(level, "LENGTH:\n"); + print_node_internal(level + 1, r->length); + } + if (r->check) { + print(level, "CHECK:\n"); + print_node_internal(level + 1, r->check); + } + if (r->chain) { + print(level, "CHAIN:\n"); + print_node_internal(level + 1, r->chain); + } + if (r->subs) { + print(level, "SUBS:\n"); + print_node_internal(level + 1, r->subs); + } + if (r->value) { + print(level, "VALUE:\n"); + print_node_internal(level + 1, r->value); + } + break; + } + + case CB_TAG_BINARY_OP: /* 14 Binary operation */ + printf("BINOP\n"); + break; + + case CB_TAG_FUNCALL: /* 15 Run-time function call */ + printf("FUNCALL\n"); + break; + + case CB_TAG_CAST: /* 16 Type cast */ + printf("CAST\n"); + break; + + case CB_TAG_INTRINSIC: /* 17 Intrinsic function */ + printf("INTR\n"); + break; + + /* Statements */ + case CB_TAG_LABEL: /* 18 Label statement */ + printf("LABEL\n"); + break; + + case CB_TAG_ASSIGN: /* 19 Assignment statement */ + printf("ASSIGN\n"); + break; + + case CB_TAG_INITIALIZE: /* 20 INITIALIZE statement */ + printf("INIT\n"); + break; + + case CB_TAG_SEARCH: /* 21 SEARCH statement */ + printf("X\n"); + break; + + case CB_TAG_CALL: /* 22 CALL statement */ + printf("CALL\n"); + break; + + case CB_TAG_GOTO: /* 23 GO TO statement */ + printf("GOTO\n"); + break; + + case CB_TAG_IF: /* 24 IF statement / WHEN clause / PRESENT WHEN clause */ + printf("X\n"); + break; + + case CB_TAG_PERFORM: /* 25 PERFORM statement */ + printf("X\n"); + break; + + case CB_TAG_STATEMENT: /* 26 General statement */ + printf("STMT\n"); + break; + + case CB_TAG_CONTINUE: /* 27 CONTINUE statement */ + printf("CONT\n"); + break; + + case CB_TAG_CANCEL: /* 28 CANCEL statement */ + printf("CANCEL\n"); + break; + + case CB_TAG_ALTER: /* 29 ALTER statement */ + printf("X\n"); + break; + + case CB_TAG_SET_ATTR: /* 30 SET ATTRIBUTE statement */ + printf("X\n"); + break; + + /* Miscellaneous */ + case CB_TAG_PERFORM_VARYING: /* 31 PERFORM VARYING parameter */ + printf("X\n"); + break; + + case CB_TAG_PICTURE: /* 32 PICTURE clause */ + printf("PIC\n"); + break; + + case CB_TAG_LIST: /* 33 List */ + printf("SIZE: %d\n", CB_SIZES(x)); + if (CB_VALUE(x)) { + print(level, "VALUE:\n"); + print_node_internal(level + 1, CB_VALUE(x)); + } + if (CB_CHAIN(x)) { + print(level, "NEXT:\n"); + print_node_internal(level + 1, CB_CHAIN(x)); + } + + break; + + case CB_TAG_DIRECT: /* 34 Code output or comment */ + printf("DIRECT\n"); + break; + + case CB_TAG_DEBUG: /* 35 Debug item set */ + printf("DEBUG\n"); + break; + + case CB_TAG_DEBUG_CALL: /* 36 Debug callback */ + printf("DEBUG_CALL\n"); + break; + + case CB_TAG_PROGRAM: /* 37 Program */ + printf("PROG\n"); + break; + + case CB_TAG_PROTOTYPE: /* 38 Prototype */ + printf("X\n"); + break; + + case CB_TAG_DECIMAL_LITERAL: /* 39 Decimal Literal */ + printf("DEC LIT\n"); + break; + + case CB_TAG_REPORT_LINE: /* 40 Report line description */ + printf("X\n"); + break; + + case CB_TAG_ML_SUPPRESS: /* 41 JSON/XML GENERATE SUPPRESS clause */ + printf("X\n"); + break; + + case CB_TAG_ML_TREE: /* 42 JSON/XML GENERATE output tree */ + printf("X\n"); + break; + + case CB_TAG_ML_SUPPRESS_CHECKS: /* 43 JSON/XML GENERATE SUPPRESS checks */ + printf("X\n"); + break; + + case CB_TAG_VARY: /* 44 Report line description */ + printf("VARY\n"); + break; + + /* case CB_TAG_TAB_VALS: /\* 45 VALUE entries in table-format *\/ */ + /* printf("TAB_VALS\n"); */ + /* break; */ + + default: + printf("UNKNOWN %d\n", CB_TREE_TAG (x)); + break; + } + + --level; + +end: + --nested_calls; +} + +void print_node(cb_tree x); + +void print_node(cb_tree x) +{ + print_node_internal(0, x); +} + +void print_trace(void); + +void print_trace(void) +{ + void *array[10]; + size_t size; + char **strings; + size_t i; + + size = backtrace (array, 10); + strings = backtrace_symbols (array, size); + + printf ("Obtained %zd stack frames.\n", size); + + for (i = 0; i < size; i++) { + printf ("%s\n", strings[i]); + } + + free (strings); +}