#ifndef __GENIMP_C__ #define __GENIMP_C__ 1 // Walk ICode AST and output reconstituted Imp77 source. // There is a design flaw in pass1 of the original Imp77 parser, which is that // a %recordformatspec in an imp program is not propogated to the ICode file... // This worked for a pure code generator because it was only relevant when // outputting code for a %recordname, which did not need to know anything other // than that the object was a pointer. However when translating to C, (or // regenerating Imp from the ICode) the C compiler also needs to see the equivalent // of that %recordformatspec, so we have to infer when one is needed and output it, // though preferably only once. This makes for a very ugly workaround :-( // Currently, that workaround is being done here, but maybe a better solution would // be to handle it in a filter.c pass and insert the recordformatspec as new ICode // tuples at the head of the block that the recordformat itself was declared in. // (being careful that the recordformat may be being used in a sub-block rather // than the one it was declared in. We have no way of knowing the location of // the original recordformatspec that was removed which is very problematic if // it shadowed an earlier spec of the same name but wasn't declared until after // some use of that earlier spec at the same level!) // Future stuff: // look for externals followed by %begin %end %endoffile and translate the // latter as %begin %endofprogram #include #include "icode2ast.h" #include "icode2ast_data.h" #include "showicode.h" #include "stack.h" #include "genimp.h" #include "errorf.h" #define IS_BINOP(icode) ( (icode) != NULL && ( \ (icode)->generic.opcode == OP_OR \ || (icode)->generic.opcode == OP_XOR \ || (icode)->generic.opcode == OP_AND \ || (icode)->generic.opcode == OP_MUL \ || (icode)->generic.opcode == OP_ADD \ || (icode)->generic.opcode == OP_SUB \ || (icode)->generic.opcode == OP_CONCAT \ || (icode)->generic.opcode == OP_QUOT \ || (icode)->generic.opcode == OP_DIVIDE \ || (icode)->generic.opcode == OP_LSH \ || (icode)->generic.opcode == OP_RSH \ || (icode)->generic.opcode == OP_ADDA \ || (icode)->generic.opcode == OP_SUBA)) int IMP_PRECEDENCE(IMPAST *icode) { /* ! Highest: 1. \ (complement, unary not) ! 2. \, \\, <<, >> ! 3. *, /, //, & ! Lowest: 4. +, - (unary and binary), !, !! */ if (icode == NULL) return 0xDEADBEEF; switch(icode->generic.opcode) { // monops: case OP_NEGATE: return 11; // *POSSIBLY WRONG* case OP_NOT: return 14; // Due to the inanity of -1 >> 1 in Imp... // binops: case OP_OR: return 1; case OP_XOR: return 1; case OP_AND: return 2; case OP_MUL: return 2; case OP_ADD: return 1; case OP_SUB: return 1; case OP_CONCAT: return 5; // probably irrelevant case OP_QUOT: return 2; case OP_DIVIDE: return 2; case OP_LSH: return 3; case OP_RSH: return 3; case OP_ADDA: return 5; // probably irrelevant case OP_SUBA: return 5; // probably irrelevant case OP_REXP: return 3; case OP_IEXP: return 3; default: return 20; // not a binop } } /* in a = b + c + d - e a = (b + c) + d - e a = b + (c + d) - e a = b + c + (d - e) a = (b + c + d) - e a = b + (c + d - e) a = (b + c) + (d - e) out A = ((B + C) + D) - E A = ((B + C) + D) - E A = (B + (C + D)) - E A = (B + C) + (D - E) A = ((B + C) + D) - E A = B + ((C + D) - E) A = (B + C) + (D - E) */ // ***NOTE*** Imp77 pass1 bug: ^ and ^^ (\ and \\) should be right-associative // according to the language definition (and the Imp80 implementation) but they // are not, in practice! So the IEXP and REXP hacks below which would be needed // if there actually was a right-associative binary operator are in fact not // needed if we intend to reproduce Imp77 behaviour as implemented rather than // as specified. int LEFT_NEEDS_BRACKETS(IMPAST *left, IMPAST *op) { if (OP(left) == OP(op) && (OP(left) == OP_ADD || OP(left) == OP_MUL)) return 0; // A + B + C or A * B * C //if (OP(left) == OP(op) && (OP(left) == OP_IEXP || OP(left) == OP_REXP)) return 1; return IMP_PRECEDENCE(left) <= IMP_PRECEDENCE(op); } int RIGHT_NEEDS_BRACKETS(IMPAST *op, IMPAST *right) { if (OP(op) == OP(right) && (OP(right) == OP_ADD || OP(right) == OP_MUL)) return 0; //if (OP(op) == OP(right) && (OP(right) == OP_IEXP || OP(right) == OP_REXP)) return 1; return IMP_PRECEDENCE(op) >= IMP_PRECEDENCE(right); // if equal, left to right order handles it. } extern int IN_START_FINISH_BLOCK; int debug_genimp = 0; int debugcodetype = 0; static char *indent(int suppress, int lev) { static char s[256]; char *sp = s; if (!suppress) { *sp = '\0'; lev += 1; if (lev > 64) lev = 64; while (lev --> 0) { *sp++ = ' '; *sp++ = ' '; } } *sp = '\0'; return s; } static int blocklevel = 0; // local copy derived from values stored in AST void codegen(IMPAST *icode) { gen_imp(stdout, icode, 1); } void dump_code(char *format, ...) { va_list ap; char *s = format; char item_format[1024]; va_start(ap, format); for (;;) { int c = *s++; if (c == 0) break; if (c == '%') { int f = *s++; if (f == 0) break; if (f == '%') { fprintf(stdout, "%%"); } else { void *arg = va_arg(ap, void *); // Beware: some of these clash with little-used format codes from C library (eg %A) if (f == 'N') { // Node codegen(arg); #ifdef NEVER } else if (f == 'V') { // Variable // TO DO: if (REQUIRES_AUTO_DEREF((arg))) { // TO DO: arg = (void *)mktuple(AST_INDIRECT_THROUGH, (arg)); // TO DO: } codegen((arg)); } else if (f == 'L') { // L-value codegen((arg)); } else if (f == 'R') { // R-value codegen((arg)); } else if (f == 'A') { // Address-of codegen(mktuple(AST_ADDRESS_OF, (arg)) /*, WANT_ADDRESS_OF */); } else if (f == 'P') { // Pointer-fetch codegen(mktuple(AST_INDIRECT_THROUGH, (arg)) /*, WANT_INDIRECT_THROUGH */); #endif } else { char *p = item_format; *p++ = '%'; for (;;) { *p++ = f; if (isalpha(f)) break; f = *s++; } *p = '\0'; fprintf(stdout, item_format, arg); } } } else fprintf(stdout, "%c", c); } va_end(ap); } void generate_imp_source(IMPAST *Program) { IMPAST *this = Program; blocklevel = 0; while (this != NULL) { gen_imp(stdout, this, 0); this = this->generic.next_icode; } //fprintf(stdout, "\n"); //fprintf(stdout, "%%end %%of %%file {generate_imp_source}\n"); } void gen_label(FILE *out, int labtag) { if (labtag < 0 || labtag >= 0x100000) { fprintf(out, "", labtag); } else if (DEFTAG[labtag] == NULL) { fprintf(out, "", labtag); } else { fprintf(out, "%s", DEFTAG[labtag]->def.imp_id); } } void gen_init(FILE *out, char *equals, IMPAST *init) { if (init->generic.opcode == OP_INIT) { IMPAST *data = init->init.data; if (data == NULL) { // fprintf(out, "[]"); } else { if (data->generic.opcode == OP_PUSHI || data->generic.opcode == OP_PUSHS || data->generic.opcode == OP_PUSHR) { fprintf(out, "%s", equals); gen_imp(out, data, 1); if (init->init.repeats > 1) fprintf(out, "(%d)", init->init.repeats); } else { fprintf(out, "%s[init.data: %s]", equals, icode_name[data->generic.opcode]); } } } else { fprintf(out, "%s[init: %s]", equals, icode_name[init->generic.opcode]); } } void gen_init_reverse_array(FILE *out, char *equals, IMPAST *init) { gen_init(out, equals, init); init = init->init.next_init; while (init != NULL) { gen_init(out, ", ", init); init = init->init.next_init; } } void gen_init_recurse(FILE *out, IMPAST *init) { // somewhat stack-heavy I'll admit but on a modern machine, not an issue. if (init->init.next_init != NULL) { gen_init_recurse(out, init->init.next_init); fprintf(out, ", "); } gen_imp(out, init->init.data, 1); if (init->init.repeats > 1) fprintf(out, "(%d)", init->init.repeats); } void gen_init_array(FILE *out, char *equals, IMPAST *init) { fprintf(out, "%s", equals); gen_init_recurse(out, init); } void gen_formal_parameter_list(FILE *out, IMPAST *def) { if (OP(def) != OP_DEF) { fatalf("Asked to list formal parameters for a %s\n", icode_name[OP(def)]); } IMPAST *param = def->def.formal_params; fprintf(out, "("); for (;;) { if (param == NULL) break; if (param->generic.opcode == OP_START) { fprintf(stderr, "? OP_START found in a parameter list\n"); param = param->generic.next_icode; // Shouldn't happen now START/FINISH have been removed. if (param == NULL) break; } if (param->generic.opcode == OP_FINISH) { fatalf("OP_FINISH found in a parameter list"); } if (param->generic.opcode == OP_ALTALT) { if (param->altalt.alttype == '(') { fprintf(out, "( { SHOULD THIS EVEN BE IN A PARAM LIST? }"); } else if (param->altalt.alttype == '|') { fprintf(out, "%%or "); } else if (param->altalt.alttype == ')') { fprintf(out, ")"); } else { // error } } else { //int saveblocklevel = blocklevel; blocklevel = 0; gen_imp(out, param, 1); //blocklevel = saveblocklevel; } param = param->generic.next_icode; if (param == NULL) break; if ( param->generic.opcode != OP_FINISH) fprintf(out, ", "); } fprintf(out, ")"); } void gen_recordformat(FILE *out, IMPAST *recordformatdef) { // This is ugly but apparently works. I'd rather build this up into a proper AST structure, but // for now it doesn't appear to be needed. We only need the overlay info for the declaration - // when we use the fields, they might as well all have been flat and linear, as the overlay info // is no longer needed, and the fields are numbered sequentially from 1. if (OP(recordformatdef) != OP_DEF) fatalf("Not a DEF at genimp.c:%d\n", __LINE__); int field_idx = 0; IMPAST *param = recordformatdef->def.recordformat_field_list; //fprintf(out, "({tag=0x%04x} %%c\n ", recordformatdef->def.format); fprintf(out, "("); if (debug_genimp) fprintf(out, "{tag=0x%04x utag=0x%04x}", recordformatdef->def.tag, recordformatdef->def.unique_tag); fprintf(out, " %%c\n "); for (;;) { IMPAST *next; int suppress_comma = 0; if (param == NULL) break; if (param->generic.opcode == OP_START) param = param->generic.next_icode; if (param == NULL || param->generic.opcode == OP_FINISH) break; if (param->generic.opcode == OP_ALTALT) { if (param->altalt.alttype == '(') { fprintf(out, "( %%c\n"); } else if (param->altalt.alttype == '|') { fprintf(out, "%%or %%c\n"); } else if (param->altalt.alttype == ')') { fprintf(out, ")"); next = param->altalt.next_icode; if ( next != NULL && ((next->generic.opcode == OP_ALTALT && next->altalt.alttype == '(') || next->generic.opcode == OP_DEF)) { fprintf(out, ",\n"); } else { fprintf(out, " %%c\n"); } } else { // error } suppress_comma = 1; } else { gen_imp(out, param, 1); field_idx += 1; if (debug_genimp) fprintf(out, " {idx=%d}", field_idx); next = param->generic.next_icode; if ( next == NULL || (next->generic.opcode == OP_ALTALT && next->altalt.alttype != '(')) { fprintf(out, " %%c"); } } param = param->generic.next_icode; if (param == NULL) break; if ((param->generic.opcode == OP_DEF) || (param->generic.opcode == OP_ALTALT && param->altalt.alttype == '(')) { if (!suppress_comma) fprintf(out, ","); } if ( next == NULL || next->generic.opcode == OP_FINISH) { fprintf(out, " %%c"); } fprintf(out, "\n "); } fprintf(out, ")\n"); } void gen_imp(FILE *out, IMPAST *this, int suppress_newline) { IMPAST *opd1, *opd2; // The primary reason for structuring this as lots of calls on gen_imp to output a single opcode at a time // with the caller appending the "\n" was that we wanted to handle // %integer i // %string(255) s // differently from when they appear as formal parameters, as in // %routine fred(%integer i, %string(255)s) if (this == NULL) { return; } int opcode = this->generic.opcode; if (opcode < 0 || opcode >= LAST_OP) { fprintf(stderr, "* showicode.c: %05d Bad opcode: %x(0x%08x)\n", this->generic.seqno, opcode, opcode); exit(EXIT_FAILURE); } switch(opcode) { case ASTOP_PERMS: if (debug_genimp) fprintf(out, "^^// %s %05d ! %s \n", indent(suppress_newline, blocklevel), this->perms.seqno, icode_name[opcode]); if (opt_perms) { fprintf(out, "%%endoflist\n"); gen_imp(out, this->perms.perms, 0); fprintf(out, "%%list\n"); fprintf(out, "%%endofperm\n"); // maybe a real command, or may %endofperm (singular) is? Or neither. } break; case ASTOP_RECFMSPEC: fprintf(out, "%s%%recordformatspec %s\n", indent(suppress_newline, blocklevel), this->recfmspec.imp_id); DEFTAG[this->recfmspec.tag] = this->recfmspec.def; /* <-- if recfmspec is inserted here, the DEFTAG[] entry will still be overwritten by something in a following block... %begin %recordformat WRONG(%real R) %end */ //debugf("Setting DEFTAG[0x%04x] = DEF %05d\n", this->recfmspec.tag, this->recfmspec.def->def.seqno); break; case '\n': break; // end of file case OP_ALTALT: // '~': { int pending = this->altalt.alttype; if ((' ' + 1 <= pending) && (pending <= '~')) { if (pending == 'A' || pending == '(') { fprintf(out, "( "); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s ~A %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], "ALTBEG"); } else if (pending == 'B' || pending == ')') { fprintf(out, " )"); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s ~B %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], "ALTEND"); } else if (pending == 'C' || pending == '|') { fprintf(out, " %%OR "); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s ~C %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], "ALT"); } else { if (debug_genimp) fprintf(out, "^^// %s %05d %c %s ??? %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], "ALTALT1"); } } else { if (debug_genimp) fprintf(out, "^^// %s %05d %c %s pending=%d %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], pending, "ALTALT2"); } } break; case OP_BEGIN: // 'H': /* BEGIN */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s %s {lev=%d --> %d}\n", indent(suppress_newline, blocklevel-1), this->generic.seqno, opcode, icode_name[opcode], this->begin.imp_id, blocklevel-1, blocklevel); fprintf(out, "%s%%begin\n", indent(suppress_newline, blocklevel)); blocklevel += 1; IMPAST *begin = this->begin.body; //debugf("***************** BEGIN BODY ******************\n"); while (begin != NULL) { gen_imp(out, begin, 0); begin = begin->generic.next_icode; } //debugf("***************** END OF BEGIN BODY ******************\n"); blocklevel -= 1; break; case OP_END: // ';': /* END */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s %s {lev=%d --> %d}\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->end.imp_id, blocklevel+1, blocklevel); fprintf(out, "%s%%end", indent(suppress_newline, blocklevel)); if (blocklevel == 0) fprintf(out, " %%of %%file"); if (!suppress_newline) fprintf(out, "\n"); break; case OP_START: // '{': /* START */ { //fprintf(out, "( {start paramlist or recordformat}\n"); blocklevel += 1; } break; case OP_ALT: // '|': /* ALT */ // Only relevant to record definitions, not parameter lists. fprintf(out, " %%OR {<%s>}", icode_name[this->generic.opcode]); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s\n", indent(suppress_newline, blocklevel-1), this->generic.seqno, opcode, icode_name[opcode]); break; case OP_FINISH: // '}': /* FINISH */ { blocklevel -= 1; //fprintf(out, " {finish paramlist or recordformat}\n%s)", indent(suppress_newline, blocklevel)); } break; case OP_DEF: // '$': /*case 'g':*/ /* {RE}DEF TAG TEXT TYPE FORM SIZE SPEC PREFIX */ { int linkage, type, form; int special; if (this->def.suppress) break; // this line can probably be removed (after confirming it is redundant): DEFTAG[this->def.tag] = this; linkage = this->def.linkage; type = this->def.type; form = this->def.form; special = this->def.special; fprintf(out, "%s", indent(suppress_newline, blocklevel)); switch (form) { case F_VOID: // I'm not sure if the VOID case is ever used, I'm just including it to be safe... //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); } fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); if (this->def.init != NULL) { gen_init(out, " = ", this->def.init); } break; case F_SIMPLE: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.init != NULL) { gen_init(out, " = ", this->def.init); } break; case F_NAME: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); } fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.init != NULL) { gen_init(out, " == ", this->def.init); } break; case F_LABEL: if (debugcodetype) fprintf(out, "{CFG}"); fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); fprintf(out, "%s", impformdesc[form]); //fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); break; case F_RECORDFORMAT: // *** TO DO ***: If any of the fields in this recordformat require reinstatement of a missing %recordformatspec, it should be done here! fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); //fprintf(out, "%s", imptypedesc[type]); fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); // Although I don't think Imp77 is passing through the %recordformatspec, and if I do add that fprintf(out, "%s", this->def.imp_id); // myself, remember to *not* output the body: if (this->def.recordformat_field_list != NULL /* && !IS_SPEC(this) */) { // The current 'missing spec' code causes the %recordformatspec to be output in this call, which is wrong! gen_recordformat(out, this); } break; case F_SWITCH: if (debugcodetype) fprintf(out, "{CFG}"); fprintf(out, "%%switch %s ", this->def.imp_id); gen_imp(out, this->def.bounds_list, 1); break; case F_ROUTINE: if (debugcodetype) fprintf(out, "{CFG}"); fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.formal_params != NULL) { gen_formal_parameter_list(out, this); if (!suppress_newline) fprintf(out, "\n"); } break; case F_FN: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table if (debugcodetype) fprintf(out, "{CFG}"); fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.formal_params != NULL) { gen_formal_parameter_list(out, this); if (!suppress_newline) fprintf(out, "\n"); } break; case F_MAP: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table if (debugcodetype) fprintf(out, "{CFG}"); fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.formal_params != NULL) { gen_formal_parameter_list(out, this); if (!suppress_newline) fprintf(out, "\n"); } break; case F_PREDICATE: if (debugcodetype) fprintf(out, "{CFG}"); fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.formal_params != NULL) { gen_formal_parameter_list(out, this); if (!suppress_newline) fprintf(out, "\n"); } break; case F_ARRAY: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } fprintf(out, "%s", impformdesc[form]); fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); { IMPAST *bounds_list = this->def.bounds_list; fprintf(out, " ("); while (bounds_list != NULL) { gen_imp(out, bounds_list->boundspair.lb, 1); fprintf(out, ":"); gen_imp(out, bounds_list->boundspair.ub, 1); bounds_list = bounds_list->boundspair.next_bound; if (bounds_list != NULL) fprintf(out, ", "); } fprintf(out, ")"); } if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.init != NULL) { gen_init_array(out, " = ", this->def.init); } break; case F_ARRAY_NAME: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format&255; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } if (this->def.dims > 1) { fprintf(out, "%%array (%d) %%name ", this->def.dims); } else { //fprintf(out, "%s", impformdesc[form]); fprintf(out, "%%array %%name "); } fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } break; case F_NAME_ARRAY: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } #ifdef NEVER if (this->def.dims > 1) { fprintf(out, "%%name %%array (%d) %%name ", this->def.dims); } else { //fprintf(out, "%s", impformdesc[form]); fprintf(out, "%%name %%array %%name "); } #else fprintf(out, "%s", impformdesc[form]); #endif fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } { IMPAST *bounds_list = this->def.bounds_list; if (bounds_list != NULL) { // worry about N-d %name arrays later... fprintf(out, " ("); gen_imp(out, bounds_list->boundspair.lb, 1); fprintf(out, ":"); gen_imp(out, bounds_list->boundspair.ub, 1); // multi-D array indices would go here... fprintf(out, ")"); } else { fprintf(out, " [?:?]"); } } if (this->def.init != NULL) { gen_init_array(out, " == ", this->def.init); } break; case F_NAME_ARRAY_NAME: //if (type == T_RECORD && this->def.format != 0) fprintf(out, "{{%%recordformatspec %s}}\n%s", DEFTAG[this->def.format]->def.imp_id, indent(suppress_newline, blocklevel)); // and put in table fprintf(out, "%s", implinkagedesc[linkage]); fprintf(out, "%s", impspecialdesc[special]); fprintf(out, "%s", imptypedesc[type]); if (type == T_RECORD) { int tagidx = this->def.format; IMPAST *tag = DEFTAG[tagidx]; fprintf(out, "(%s", tag != NULL ? tag->def.imp_id : "?"); if (debug_genimp) fprintf(out, " {tag=0x%04x}", this->def.format); fprintf(out, ") "); } else if (type == T_STRING) { int strlen = this->def.format; if (strlen == 0) fprintf(out, "(*) "); else fprintf(out, "(%d) ", strlen); //fprintf(out, "(%d) ", strlen); } if (this->def.dims > 1) { fprintf(out, "%%name %%array (%d) %%name ", this->def.dims); } else { //fprintf(out, "%s", impformdesc[form]); fprintf(out, "%%name %%array %%name "); } fprintf(out, "%s", IS_SPEC(this) ? "%spec " : ""); fprintf(out, "%s", this->def.imp_id); if (this->def.alias != NULL) { fprintf(out, " %%alias \"%s\" ", this->def.alias->alias.alias); } if (this->def.init != NULL) { gen_init(out, " = ", this->def.init); } break; case F_EXPR: // not yet used, might never be? break; } if (debug_genimp) fprintf(out, "^^ ;!// %s %05d %c ", indent(suppress_newline, blocklevel), this->def.seqno, opcode); char extra[1024]; extra[0] = '\0'; if (this->def.alias != NULL) sprintf(extra+strlen(extra), "(LINKAGE: \"%s\") ", this->def.alias->alias.alias); if (this->def.formal_params != NULL) sprintf(extra+strlen(extra), "Params=%05d ", this->def.formal_params->generic.seqno); if (debug_genimp) fprintf(out, "\n%s! %s %s %stag=0x%04x (unique_tag=0x%04x) a/tf=0x%04x b/format=0x%04x c/ostate=0x%04x" " type=%d (%s) form=%d (%s) special=%d (%s)" " linkage=%d (%s) spec=%d indirect=%d no_unass_check=%d", indent(suppress_newline, blocklevel), icode_name[opcode], this->def.imp_id, extra, this->def.tag, this->def.unique_tag, this->def.tf, this->def.format, this->def.ostate, type, typedesc[type], form, formdesc[form], special, specialdesc[special], linkage, linkagedesc[linkage], IS_SPEC(this), IS_INDIRECT(this), NO_UNASS_CHECK(this)); extra[0] = '\0'; //if (IS_PROCEDURE(this) && !IS_SPEC(this)) fprintf(out, " {lev=%d --> %d}", blocklevel-1, blocklevel); // surely should be blocklevel-1, blocklevel but this seems to match whats expected??? if (debug_genimp) { if (this->def.init != NULL) fprintf(out, " (INIT=%05d)", this->def.init->generic.seqno ); if (this->def.formal_params != NULL) fprintf(out, " (PARAMS=%05d)", this->def.formal_params->generic.seqno ); if (this->def.body != NULL) fprintf(out, " (BODY=%05d)", this->def.body->generic.seqno ); if (this->def.recordformatdef != NULL) fprintf(out, " (RECORDFORMATDEF=%05d)", this->def.recordformatdef->generic.seqno); if (this->def.recordformat_field_list != NULL) fprintf(out, " (RECORDFORMATFIELDS=%05d)", this->def.recordformat_field_list->generic.seqno); } if (debug_genimp) fprintf(out, "^^\n"); if (!suppress_newline) fprintf(out, "\n"); if (IS_PROCEDURE(this) && !IS_SPEC(this)) { // perhaps also !IS_INDIRECT because of procedure parameters? blocklevel += 1; //debugf("***************** DEF BODY ******************\n"); IMPAST *body = this->def.body; while (body != NULL) { gen_imp(stdout, body, 0); body = body->generic.next_icode; } //debugf("***************** END OF DEF BODY ******************\n"); blocklevel -= 1; //fprintf(out, "%s%%end\n", indent(suppress_newline, blocklevel)); } } break; case OP_JUMPIFD: // '"': /* JUMPIFD cond label */ /* -> L_0001 %if A # B -> L_0001 %if B # C should be -> L_0001 %if A # (tmp=B) -> L_0001 %if tmp # C - to avoid ambiguity, best place to handle this would be at the AST level where a JUMPIFD followed by a JUMPIF could be conflated into a new 3-parameter jump code. (because A = B = C is not the same as A = B %and B = C when B has side-effects!) */ fprintf(out, "%s%s-> %s", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", this->jumpifd.printable_label); //gen_label(out, this->jumpifd.label); fprintf(out, " %%if "); gen_imp(out, this->jumpifd.opd1, 1); fprintf(out, " %s ", imp_value_comparision[this->jumpifd.cond]); gen_imp(out, this->jumpifd.opd2, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_JUMPIFA: // 'C': /* JUMPIFA cond label */ fprintf(out, "%s%s-> %s", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", this->jumpifa.printable_label); //gen_label(out, this->jumpifa.label); fprintf(out, " %%if "); gen_imp(out, this->jumpifa.opd1, 1); fprintf(out, " %s ", imp_name_comparision[this->jumpifa.cond]); gen_imp(out, this->jumpifa.opd2, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_JUMPIF: // '?': /* JUMPIF cond label */ fprintf(out, "%s%s-> %s", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", this->jumpif.printable_label); //gen_label(out, this->jumpif.label); fprintf(out, " %%if "); gen_imp(out, this->jumpif.opd1, 1); fprintf(out, " %s ", imp_value_comparision[this->jumpif.cond]); gen_imp(out, this->jumpif.opd2, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_BF: // 'k': /* BF label */ fprintf(out, "%s%s-> %s", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", this->bf.printable_label); //gen_label(out, this->bf.label); fprintf(out, " %%unless "); gen_imp(out, this->bf.opd, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_BT: // 't': /* BT label */ fprintf(out, "%s%s-> %s", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", this->bt.printable_label); //gen_label(out, this->bt.label); fprintf(out, " %%if "); gen_imp(out, this->bt.opd, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_PUSHS: // '\'': /* PUSHS sconst */ { char *s = this->pushs.string_value; fprintf(out, "\""); for (;;) { int c = *s++; if (c == '\0') break; if (c == '"') { fprintf(out, "\"\""); } else { fprintf(out, "%c", c); } } fprintf(out, "\""); } break; case OP_ALIAS: // 'G': /* ALIAS */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->alias.alias); break; case OP_PUSHR: // 'D': /* PUSHR rconst */ fprintf(out, "%s", this->pushr.str); if (this->pushr.exponent != 0) { fprintf(out, "@%0d", this->pushr.exponent); } break; case OP_PUSHI: // 'N': /* PUSHI iconst */ fprintf(out, "%0d", (int)this->pushi.value); break; case OP_LOCATE: // ':': /* LOCATE label */ fprintf(out, "%s" /*"{lab=0x%04x} "*/ "%s:", debugcodetype?"{CFG:}":"", /*this->locate.label,*/ this->locate.printable_label); if (!suppress_newline) fprintf(out, "\n"); break; case OP_GOTO: // 'F': /* GOTO label */ fprintf(out, "%s%s-> " /*"{lab=0x%04x} "*/ "%s", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", /*this->igoto.label,*/ this->igoto.printable_label); if (!suppress_newline) fprintf(out, "\n"); break; case OP_JUMP: // 'J': /* JUMP label */ fprintf(out, "%s%s-> " /*"{lab=0x%04x} "*/ "%s", debugcodetype?"{CFG}":"", indent(suppress_newline, blocklevel), /*this->jump.label,*/ this->jump.printable_label); if (!suppress_newline) fprintf(out, "\n"); break; case OP_LABEL: // 'L': /* LABEL label */ fprintf(out, "%s" /*"{lab=0x%04x} "*/ "%s:", debugcodetype?"{CFG:}":"", /*this->label.label,*/ this->label.printable_label); if (!suppress_newline) fprintf(out, "\n"); break; case OP_FOR: // 'f': /* FOR label (label was missing from thesis description) */ // This would be better handled by modifying the AST rather than doing it on output. // top-level statement fprintf(out, "%s", indent(suppress_newline, blocklevel)); if (this->ifor.control) gen_imp(out, this->ifor.control, 0); fprintf(out, " = ("); if (this->ifor.initial) gen_imp(out, this->ifor.initial, 0); fprintf(out, ") - ("); if (this->ifor.increment) gen_imp(out, this->ifor.increment, 0); fprintf(out, "); {%%for "); if (this->ifor.control) gen_imp(out, this->ifor.control, 0); fprintf(out, " = "); if (this->ifor.initial) gen_imp(out, this->ifor.initial, 0); fprintf(out, ", "); if (this->ifor.increment) gen_imp(out, this->ifor.increment, 0); fprintf(out, ", "); if (this->ifor.final) gen_imp(out, this->ifor.final, 0); fprintf(out, " %%cycle}\n"); fprintf(out, "%s:\n", this->ifor.printable_forlab); fprintf(out, "%s->%s %%if ", indent(suppress_newline, blocklevel), this->ifor.printable_exitlab); if (this->ifor.control) gen_imp(out, this->ifor.control, 0); fprintf(out, " = "); if (this->ifor.final) gen_imp(out, this->ifor.final, 0); fprintf(out, "\n%s", indent(suppress_newline, blocklevel)); if (this->ifor.control) gen_imp(out, this->ifor.control, 0); fprintf(out, " = ("); if (this->ifor.control) gen_imp(out, this->ifor.control, 0); fprintf(out, ") + ("); if (this->ifor.increment) gen_imp(out, this->ifor.increment, 0); fprintf(out, ")\n"); break; case OP_REPEAT: // 'B': /* REPEAT label */ fprintf(out, "%s-> %s", indent(suppress_newline, blocklevel), this->repeat.printable_forlab); if (!suppress_newline) fprintf(out, "\n"); break; case OP_LINE: // 'O': /* LINE decimal */ // line info has been moved into fixed fields of all opcodes //suppress_perms = FALSE; // EXTENSION FOR C-PASS1: /*if (opt_extended_line) fname = this->line.filename; */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s %d %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->line.lineno, this->line.filename); break; case OP_PUSH: // '@': /* PUSH tag */ if (this->push.tag < 0 || this->push.tag >= MAX_AST_ENTRIES) { errorf("PUSH: this->push.tag = %d\n", this->push.tag); } else if (DEFTAG[this->push.tag] == NULL) { fprintf(out, "", this->push.tag); } else { fprintf(out, "%s", DEFTAG[this->push.tag]->def.imp_id); } break; #ifdef NEVER case OP_PROC: // '^': /* PROC tag */ // THIS MAY NOT EVER BE CALLED WITH THE CURRENT PASS1 // PROC This is the same as PUSH except that the // descriptor being stacked represents a // procedure which is about to be called // (using ENTER). // (ENTER may be the same as CALL? We have no ENTER in this ICode defn.) if (this->proc.tag < 0 || this->pproc.tag >= MAX_AST_ENTRIES) { errorf"PROC: this->proc.tag = %d\n", this->proc.tag); } else if (DEFTAG[this->proc.tag] == NULL) { fprintf(out, "", this->proc.tag); } else { fprintf(out, "%s", DEFTAG[this->proc.tag]->def.imp_id); } if (debug_genimp) fprintf(out, "^^// %s %05d %c %s tag=0x%04x\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->proc.tag); break; #endif case OP_SELECT: // 'n': /* SELECT tag */ { IMPAST *fielddef; //fprintf(out, "<%s>", icode_name[this->generic.opcode]); // When a recordformat is DEFined, the tag values for all the fields in the // record are given as 0. When SELECT is invoked, you have to find that // corresponding recordformat, and then count through the fields sequentially // starting at 1 to find the name and type of the field. // somehow we have to locate that information from this->select.parent_record ... // opd may be a tree of records, fields, array accesses, fn or map results etc // terminating in an object of %record type. So having its type available // depends on every item in that tree being correctly typed from the leaves // back. (or from the roots up depending on how you draw your trees ;-) ) gen_imp(out, this->select.parent_record, 1); fielddef = this->select.fielddef; if (fielddef != NULL) { fprintf(out, "_%s", fielddef->def.imp_id); } else { fprintf(out, "_", this->select.fieldtag); } } break; case OP_DEFSW: // '`': /* defsw */ // EXTENSION FOR C-PASS1: default switch label fprintf(out, "%s%s%s(*):", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", DEFTAG[this->defsw.label]->def.imp_id); // parameter could have been better to have been an IMPAST label rather than a tag? if (!suppress_newline) fprintf(out, "\n"); break; case OP_SJUMP: // 'W': /* SJUMP sd */ fprintf(out, "%s%s->%s(", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", DEFTAG[this->sjump.label]->def.imp_id); gen_imp(out, this->sjump.index, 1); fprintf(out, ")"); if (!suppress_newline) fprintf(out, "\n"); break; case OP_SLABEL: // '_': /* SLABEL sd */ fprintf(out, "%s%s%s(", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":"", DEFTAG[this->slabel.label]->def.imp_id); gen_imp(out, this->slabel.index, 1); fprintf(out, "):"); if (!suppress_newline) fprintf(out, "\n"); break; case OP_DIM: // 'd': /* DIM short,short */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s dims %d #arrays %d\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->dim.dimens, this->dim.arrays); break; case OP_DEFAULT: // 'Y': /* DEFAULT short */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s %d\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->idefault.data); fprintf(out, "%sdefault: {*** BUG ***}", debugcodetype?"{CFG:}":""); if (!suppress_newline) fprintf(out, "\n"); break; case OP_INIT: // 'A': /* INIT short */ if (debug_genimp) fprintf(out, "^^// %s %05d %c %s %d\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->init.repeats); break; case OP_DIAG: // 'y': /* DIAG short */ // top-level statement fprintf(out, "%s%s%%diagnose ...", indent(suppress_newline, blocklevel), debugcodetype?"{BB}":""); if (!suppress_newline) fprintf(out, "\n"); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s 0x%04X\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->diag.data); DIAGNOSE = this->diag.data; break; case OP_CONTROL: // 'z': /* CONTROL short */ /* (lsb) Bit 0 :: Unassigned variable (%CONTROL X'00000001') 1 :: String capacity (%CONTROL X'00000002') 2 :: %for loop (%CONTROL X'00000004') 3 :: Array bound (%CONTROL X'00000008') 4 :: Integer overflow (%CONTROL X'00000010') 28 :: Decode wanted in listing file (%CONTROL X'10000000') */ // top-level statement fprintf(out, "%s%s%%control %d", indent(suppress_newline, blocklevel), debugcodetype?"{BB}":"", this->control.data); if (!suppress_newline) fprintf(out, "\n"); CONTROL = this->control.data; break; case OP_EVENT: // 'e': /* EVENT short */ fprintf(out, "%s%%signal %d,", indent(suppress_newline, blocklevel), this->event.event); if (this->event.subevent == NULL) fprintf(out, "0"); else gen_imp(out, this->event.subevent, 1); fprintf(out, ","); if (this->event.extra == NULL) fprintf(out, "0"); else gen_imp(out, this->event.extra, 1); if (!suppress_newline) fprintf(out, "\n"); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s 0x%04X\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->event.event); break; case OP_LANG: // 'l': /* LANG short */ fprintf(out, "{<%s>}", icode_name[this->generic.opcode]); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s 0x%04X\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->lang.language); break; case OP_ON: // 'o': /* ON byte short label */ fprintf(out, "%s%%on %%event ", indent(suppress_newline, blocklevel)); static char events[256]; *events = '\0'; for (int shift = 0; shift < 32; shift++) { if ((this->on.mask & (1< %s", events, this->on.printable_label); if (!suppress_newline) fprintf(out, "\n"); if (debug_genimp) fprintf(out, "^^// %s %05d %c %s MASK=0x%04X lab=0x%04x %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->on.mask, this->on.label, this->on.printable_label); break; case OP_RESOLVE: // 'r': /* RESOLVE m */ // *** TO DO *** Does this->resolve.conditional need to be used? gen_imp(out, this->resolve.string, 0); fprintf(out, " -> "); if (this->resolve.opd2 != NULL) { gen_imp(out, this->resolve.opd1, 0); fprintf(out, "."); } gen_imp(out, this->resolve.match, 0); if (this->resolve.opd1 != NULL) { fprintf(out, "."); gen_imp(out, this->resolve.opd2, 0); } // result is tested by BF or BT! if (debug_genimp) fprintf(out, "^^// %s %05d %c %s flags=%04x\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode], this->resolve.flags); break; case OP_MCODE1: // 'c': /* MCODE */ #ifdef NEVER { int i1; short int h1; if (debug_genimp) fprintf(out, "^^// %s %05d %c %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode]); for (;;) { p1 = getmcstring(&i1); fprintf(out, " %s", p1); if (i1 == ';') break; p2 = getshort(); fprintf(out, " tag_%s", p2); } } #endif break; case OP_ASSPAR: // 'p': /* ASSPAR */ gen_imp(out, this->asspar.param, 1); if (this->asspar.next_param != NULL) { fprintf(out, ", "); gen_imp(out, this->asspar.next_param, 1); } break; case OP_CALL: // 'E': /* CALL rt/fn/map/pred */ { IMPAST *def = this->call.def; // If a %routine, output as a statement, otherwise, part of an expression. if (FORM(def) == F_ROUTINE) fprintf(out, "%s", indent(suppress_newline, blocklevel)); fprintf(out, "%s", debugcodetype?"{CFG}":""); if (def) { // protection for development if proc/block handling not being invoked during development fprintf(out, "%s", def->def.imp_id); if (this->call.actual_params == NULL) { // This should have been done by now! Just checking in case it hasn't... if (def->def.actual_params != NULL) { fprintf(stderr, "? Warning: forgot to copy def->def.actual_params to this->call.actual_params\n"); this->call.actual_params = def->def.actual_params; } } else { fprintf(out, "("); //fprintf(stderr, "Actual params: "); show_icode(this->call.actual_params, stdout); fprintf(stderr, "\n"); gen_imp(out, this->call.actual_params, 1); fprintf(out, ")"); } if (FORM(def) == F_ROUTINE) if (!suppress_newline) fprintf(out, "\n"); } } break; case OP_ASSVAL: // 'S': /* ASSVAL */ // top-level statement fprintf(out, "%s%s", indent(suppress_newline, blocklevel), debugcodetype?"{BB}":""); gen_imp(out, this->assval.dest, 1); fprintf(out, " = "); gen_imp(out, this->assval.source, 1); if (!suppress_newline) fprintf(out, "\n"); if (debug_genimp) fprintf(out, "^^ ;! %05d %c %s\n", this->generic.seqno, opcode, icode_name[opcode]); break; case OP_ASSREF: // 'Z': /* ASSREF */ // top-level statement fprintf(out, "%s%s", indent(suppress_newline, blocklevel), debugcodetype?"{BB}":""); gen_imp(out, this->assref.dest, 1); fprintf(out, " == "); gen_imp(out, this->assref.source, 1); if (!suppress_newline) fprintf(out, "\n"); if (debug_genimp) fprintf(out, "^^ ;! %05d %c %s\n", this->generic.seqno, opcode, icode_name[opcode]); break; case OP_JAM: // 'j': /* JAM */ // top-level statement fprintf(out, "%s%s", indent(suppress_newline, blocklevel), debugcodetype?"{BB}":""); gen_imp(out, this->jam.dest, 1); fprintf(out, " <- "); gen_imp(out, this->jam.source, 1); if (!suppress_newline) fprintf(out, "\n"); if (debug_genimp) fprintf(out, "^^ ;! %05d %c %s\n", this->generic.seqno, opcode, icode_name[opcode]); break; case OP_TRUE: // 'T': /* TRUE */ // top-level statement fprintf(out, "%s%s%%TRUE", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); if (!suppress_newline) fprintf(out, "\n"); break; case OP_FALSE: // 'K': /* FALSE */ // top-level statement fprintf(out, "%s%s%%FALSE", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); if (!suppress_newline) fprintf(out, "\n"); break; case OP_RESULT: // 'V': /* RESULT */ // top-level statement fprintf(out, "%s%s%%RESULT = ", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); gen_imp(out, this->result.opd, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_MAP: // 'M': /* MAP */ // top-level statement fprintf(out, "%s%s%%RESULT == ", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); gen_imp(out, this->map.opd, 1); if (!suppress_newline) fprintf(out, "\n"); break; case OP_RETURN: // 'R': /* RETURN */ // top-level statement fprintf(out, "%s%s%%RETURN", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); if (!suppress_newline) fprintf(out, "\n"); break; case OP_NEGATE: // 'U': /* NEGATE */ opd1 = this->negate.opd; if (IS_BINOP(opd1)) { fprintf(out, "-("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { fprintf(out, "-"); gen_imp(out, opd1, 1); } break; case OP_NOT: // '\\': /* NOT */ opd1 = this->not.opd; if (IS_BINOP(opd1)) { fprintf(out, "\\("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { fprintf(out, "\\"); gen_imp(out, opd1, 1); } break; case OP_MOD: // 'v': /* MOD */ #ifdef CSTYLE fprintf(out, "MOD("); gen_imp(out, this->mod.opd, 1); fprintf(out, ")"); #endif fprintf(out, "|"); // Old style was !expr! but that was ambiguous. |expr| fixed the ambiguity gen_imp(out, this->mod.opd, 1); fprintf(out, "|"); break; case OP_OR: // '!': /* OR */ opd1 = this->or.opd1; opd2 = this->or.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " ! "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_XOR: // '%': /* XOR */ opd1 = this->xor.opd1; opd2 = this->xor.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " !! "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_AND: // '&': /* AND */ opd1 = this->and.opd1; opd2 = this->and.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " & "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_MUL: // '*': /* MUL */ opd1 = this->mul.opd1; opd2 = this->mul.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " * "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_ADD: // '+': /* ADD */ opd1 = this->add.opd1; opd2 = this->add.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " + "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_SUB: // '-': /* SUB */ opd1 = this->sub.opd1; opd2 = this->sub.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " - "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_CONCAT: // '.': /* CONCAT */ gen_imp(out, this->concat.opd1, 1); fprintf(out, " . "); gen_imp(out, this->concat.opd2, 1); break; case OP_QUOT: // '/': /* QUOT */ opd1 = this->quot.opd1; opd2 = this->quot.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " // "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_DIVIDE: // 'Q': /* DIVIDE */ opd1 = this->divide.opd1; opd2 = this->divide.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " / "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_REXP: // 'x': /* REXP */ #ifdef CSTYLE fprintf(out, "REXP("); gen_imp(out, this->rexp.opd1, 1); fprintf(out, ", "); gen_imp(out, this->rexp.opd2, 1); fprintf(out, ")"); #endif opd1 = this->rexp.opd1; opd2 = this->rexp.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " \\ "); // or fprintf(out, " ^ "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_IEXP: // 'X': /* IEXP */ #ifdef CSTYLE fprintf(out, "IEXP("); gen_imp(out, this->iexp.opd1, 1); fprintf(out, ", "); gen_imp(out, this->iexp.opd2, 1); fprintf(out, ")"); #endif opd1 = this->iexp.opd1; opd2 = this->iexp.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " \\\\ "); // or fprintf(out, " ^^ "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_LSH: // '[': /* LSH */ opd1 = this->lsh.opd1; opd2 = this->lsh.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " << "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_RSH: // ']': /* RSH */ opd1 = this->rsh.opd1; opd2 = this->rsh.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, " >> "); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_ADDA: // 'u': /* ADDA */ opd1 = this->adda.opd1; opd2 = this->adda.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, "++"); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_SUBA: // 'q': /* SUBA */ opd1 = this->suba.opd1; opd2 = this->suba.opd2; if (LEFT_NEEDS_BRACKETS(opd1, this)) { fprintf(out, "("); gen_imp(out, opd1, 1); fprintf(out, ")"); } else { gen_imp(out, opd1, 1); } fprintf(out, "--"); if (RIGHT_NEEDS_BRACKETS(this, opd2)) { fprintf(out, "("); gen_imp(out, opd2, 1); fprintf(out, ")"); } else { gen_imp(out, opd2, 1); } break; case OP_INDEX: // 'i': /* INDEX */ /* Array Index; */ case OP_ACCESS: // 'a': /* ACCESS */ break; case OP_BOUNDSPAIR: // 'b': /* BOUNDS */ { IMPAST *bounds_list = this; fprintf(out, "("); gen_imp(out, bounds_list->boundspair.lb, 1); fprintf(out, ":"); gen_imp(out, bounds_list->boundspair.ub, 1); bounds_list = bounds_list->boundspair.next_bound; while (bounds_list != NULL && OP(bounds_list) == OP_BOUNDSPAIR) { fprintf(out, ", "); gen_imp(out, bounds_list->boundspair.lb, 1); fprintf(out, ":"); gen_imp(out, bounds_list->boundspair.ub, 1); bounds_list = bounds_list->boundspair.next_bound; } fprintf(out, ")"); } break; case OP_MONITOR: // 'm': /* MONITOR */ fprintf(out, "%s%s%%MONITOR", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); if (!suppress_newline) fprintf(out, "\n"); break; case OP_STOP: // 's': /* STOP */ fprintf(out, "%s%s%%STOP", indent(suppress_newline, blocklevel), debugcodetype?"{CFG}":""); if (!suppress_newline) fprintf(out, "\n"); break; case ASTOP_ARRAYINDEX: gen_imp(out, this->array_index.array_base, 1); fprintf(out, "("); for (;;) { IMPAST *index = this->array_index.index; gen_imp(out, index, 1); this = this->array_index.next_index; if (this == NULL) break; fprintf(out, ", "); } fprintf(out, ")"); break; default: if (opcode < 0 || opcode > 255 || icode_name[opcode] == NULL) { if (debug_genimp) fprintf(out, "^^// ? showicode.c: %s %05d OPCODE %d (0x%08x)\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, opcode); } else { if (debug_genimp) fprintf(out, "^^// ? showicode.c: %s %05d %c %s\n", indent(suppress_newline, blocklevel), this->generic.seqno, opcode, icode_name[opcode]); } break; } } #endif // !__GENIMP_C__