static char *rcs_version = "ast.c V$Revision: 1.80 $"; // This module is called from i2c to perform actions based on each ICODE. #define _POSIX_C_SOURCE 200809L #define _XOPEN_SOURCE 500 #include // TO DO: // * in cdecl, a const array should be declared as static. // * for variables that are not explicitly initialised, we could assign the unassigned pattern to them // ourselves, since the gcc mechanism for doing that isn't always available if the user has an older // version of gcc that doesn't support -ftrivial-auto-var-init=pattern which fills unassigned // variables with 0xFEFEFEFE and tests for that pattern at runtime. (unfortunately that value // is hard wired, and not guaranteed.) Imp used 0x80808080 and some older code *might* rely on // that (though I haven't found any yet that does) // * If BITS is already declared as unsigned char, no need to cast: // MASK = (unsigned char)((((unsigned char)BITS[V->TYPE]) >> (((V->DISP) & (3))))); // * // 3388 BLOCK WORD = 'B'-32+('L'-32)<<6+('O'-32)<<12+('C'-32)<<18+('K'-32)<<24 // BLOCKWORD = (((((((((((34) + ((unsigned char)(((44) << (6))))))) + (((47) << (12)))))) + (((35) << (18)))))) + (((43) << (24)))); // the unsigned char cast here is wrong: ((unsigned char)(((44) << (6)))) // my guess - inference of smallest type given the constants was not valid as a larger type was appropriate, so that // the left-shifted value wasn't detected as an overlow by valgrind. (Imp never errors a shift left past the capacity!) // * (int *) cast where (int) wanted in some expressions. Types not propogating I suspect. // - see: sed -i 's/_U((int \*)/_U((int)/' dhrystone/dhry_2.c // < /*Warning: potential loss of precision converting from integer AST_VAR (RADIX - 4 bytes) to real AST_VAR (RVAL - 4 bytes) detected at ast.c line 845 */ #include #include #include #include #include "i2c.h" #include "flex.h" #include "stringpool.h" extern FILE *output_file; char hashline[1024] = {'\0'}; ASTIDX Descriptor[MAX_DESCRIPTORS]; int next_free_private_tag = MAX_DESCRIPTORS; int NEW_INTERNAL_TAG(void) { return --next_free_private_tag; } int _imp_diagnose = 0; int _imp_control = 0; static int accessible = 1; // duplicates a variable in pass1 for convenience // We *only* use this to suppress the extra code // that is planted to detect a missing %result //----------------------------------------------------------------------- // remember to update typedef enum { ... } ASTCODE in ast.h // (you can't include arrays in header files that might be included // in multiple source files and you will then get multiple copies // of the array data which will fail at link time.) #define A(NAME) [AST_##NAME] = "AST_" #NAME const char *astname[ASTCODES] = { A(ASTCODE_WAS_ZERO), A(ICONST), A(RCONST), A(ISTRINGCONST), A(MONOP), A(BINOP), A(VAR), A(RESULT), A(CALL), A(RETURN), A(DECLARE_FP), A(DECLARE), A(START_PARAMLIST), A(CONDITIONAL_RESOLVE), A(UNCONDITIONAL_RESOLVE), A(COMPARE), A(COMPARE2), A(GOTO), A(IFGOTO), A(ONGOTO), A(DEFLAB), A(ASSIGN), A(LABEL), A(RESOLVE), A(DEF_SWLAB), A(DEF_DEFAULTSWLAB), A(GOTO_SWLAB), A(BOUNDSPAIR), A(SEQ), A(BLOCKSTART), A(BLOCKEND), A(COMMENT), // Experimental A(STOP), A(ADDRESS_OF), A(INDIRECT_THROUGH), A(FIELDSELECT), A(ARRAYACCESS), A(DYNAMICARRAYACCESS), A(FORMAL_PARAMETER_LIST), A(ACTUAL_PARAMETER), A(ACTUAL_PARAMETER_LIST), A(INDEX_LIST), A(PASS_PARAMETER), A(IMP_LINE), A(DOPEVECTOR), A(DIAGNOSE), A(CONTROL), A(MONITOR), A(SIGNAL), A(CAST), A(BRACKET), A(UNASS_CHECK), A(DIVZERO_CHECK), A(FOR), }; #undef A //----------------------------------------------------------------------- // temporary for debugging... const char *tag_fields[] = { "tag", "BASE_TYPE", // T_* eg T_INTEGER, T_REAL "FORM", // F_* eg F_FN "BASE_SIZE_CODE", // BASE_SIZE_CODE can almost certainly be eliminated as it is redundant with BASE_SIZE_BYTES. "BASE_SIZE_BYTES", "LINKAGE", // X_* eg X_OWN, X_CONST etc "SPECIAL", // SPECIAL_* "IMP_NAME_IDX", "C_NAME_IDX", "EXTERNAL_NAME_IDX", "IS_BASE_NAME", "IS_ARRAY", "IS_ARRAY_NAME", "IS_PROC_PARAM", // this proc/fn/map/pred is in the FP list of another procedure "IS_SPEC_ONLY", // { 8, " spec" }, // S=1 "NO_AUTO_DEREF", // { 16, " {indirect-no-auto-deref, I=1}" } "NO_UNASS", // { 32, " {NO UNASSIGNED CHECKS, U=1}" } "STRING_CAPACITY", "RECORD_FORMAT", }; //----------------------------------------------------------------------- const char *operator[128] = { ['<'] = "<", ['>'] = ">", ['('] = "<=", [')'] = ">=", ['='] = "==", ['#'] = "!=", ['!'] = "|", ['%'] = "^", ['&'] = "&", ['.'] = "ERROR-.", ['*'] = "*", ['/'] = "/", // QUOT: integer divide ['+'] = "+", ['-'] = "-", ['Q'] = "/", // DIVIDE: real divide ['['] = "<<", [']'] = ">>", ['X'] = "ERROR-X", // IEXP ['x'] = "ERROR-x", // REXP ['S'] = "=", // but be careful re ASSVAL ASSREF ['u'] = "+", // ADDA ['q'] = "-", // SUBA }; const char *translate_imp[4] = { /* translate 'special' codes below. Really not sure what these are used for yet. */ /* 0: */ "", #define SPECIAL_DEFAULT 0 /* 1: */ "%byte %integer ", #define SPECIAL_BYTE_INT 1 /* 2: */ "%short %integer ", #define SPECIAL_SHORT_INT 2 /* 3: */ "%long %real ", #define SPECIAL_LONG_REAL 3 }; const char *types_imp[16] = { /* 0: */ "TYPE=0 ", /* 1: */ "%integer ", #define T_INTEGER 1 /* If T is INTEGER takes the following meanings: = 1, full range 2, range 0..255 3, range -32768..32767 */ /* 2: */ "%real ", #define T_REAL 2 /* If T is REAL takes the following meanings: = 1, normal precision 4, double precision */ /* 3: */ "%string ", #define T_STRING 3 /* If T is STRING gives the maximum length of the string. */ /* 4: */ "%record ", #define T_RECORD 4 /* If T is RECORD gives the tag of the corresponding recordformat. */ /* 5: */ "Boolean ", #define T_BOOLEAN 5 // Pascal /* 6: */ "set ", #define T_SET 6 // Pascal /* 7: */ "byte-enumerated {format } ", #define T_BYTE_ENUMERATED 7 /* 8: */ "short-enumerated {format } ", #define T_SHORT_ENUMERATED 8 /* If T is enumerated gives the tag of the dummy format used to identify the enumerated value identifiers. */ /* 9: */ "%name ", // "pointer" #define T_POINTER 9 // for C? /* 10: */ "%byte ", #define T_CHAR 10 // for C? /* 11: */ "ERROR(T=11)", /* 12: */ "ERROR(T=12)", /* 13: */ "ERROR(T=13)", /* 14: */ "ERROR(T=14)", /* 15: */ "general-area" #define T_GENERAL 15 // ??? Maybe imp's generic %name parameter perhaps? }; const char *types_c[16] = { /* 0: */ "TYPE=0 ", /* 1: */ "int ", #define T_INTEGER 1 /* If T is INTEGER takes the following meanings: = 1, full range 2, range 0..255 3, range -32768..32767 */ /* 2: */ "float ", #define T_REAL 2 /* If T is REAL takes the following meanings: = 1, normal precision 4, double precision */ /* 3: */ "String ", // ONLY WITH ARRAYS for %string #define T_STRING 3 /* If T is STRING gives the maximum length of the string. */ /* 4: */ "struct ", #define T_RECORD 4 /* If T is RECORD gives the tag of the corresponding recordformat. */ /* 5: */ "Boolean ", #define T_BOOLEAN 5 // Pascal /* 6: */ "set ", #define T_SET 6 // Pascal /* 7: */ "byte-enumerated {format } ", #define T_BYTE_ENUMERATED 7 /* 8: */ "short-enumerated {format } ", #define T_SHORT_ENUMERATED 8 /* If T is enumerated gives the tag of the dummy format used to identify the enumerated value identifiers. */ /* 9: */ " * /*pointer*/", // "pointer" #define T_POINTER 9 // for C? /* 10: */ " char ", #define T_CHAR 10 // for C? /* 11: */ "ERROR(T=11)", /* 12: */ "ERROR(T=12)", /* 13: */ "ERROR(T=13)", /* 14: */ "ERROR(T=14)", /* 15: */ "general-area" #define T_GENERAL 15 // ??? Maybe imp's generic %name parameter perhaps? }; /*const*/ char *forms_imp[16] = { /* 0: */ "(void F=0) ", // "void" #define F_VOID 0 /* 1: */ "(scalar F=1) ", // "simple" #define F_SIMPLE 1 /* 2: */ "%name ", #define F_NAME 2 /* 3: */ "%label ", #define F_LABEL 3 /* 4: */ "%record %format ", #define F_RECORDFORMAT 4 /* 5: */ "ERROR(F=5)", /* 6: */ "%switch ", #define F_SWITCH 6 /* 7: */ "%routine ", #define F_ROUTINE 7 /* 8: */ "%function ", #define F_FN 8 /* 9: */ "%map ", #define F_MAP 9 /* 10: */ "%predicate ", #define F_PREDICATE 10 /* 11: */ "%array ", #define F_ARRAY 11 /* 12: */ "%array %name ", #define F_ARRAY_NAME 12 /* 13: */ "%name %array ", #define F_NAME_ARRAY 13 /* 14: */ "%name %array %name ", #define F_NAME_ARRAY_NAME 14 /* 15: */ "", #define F_EXPR 15 // Invented code to use for composite nodes... }; const char *forms_c[16] = { /* 0: */ "void ", #define F_VOID 0 /* 1: */ "", // "simple" #define F_SIMPLE 1 /* 2: */ "", #define F_NAME 2 /* 3: */ "label ", #define F_LABEL 3 /* 4: */ "typedef struct ", #define F_RECORDFORMAT 4 /* 5: */ "ERROR(F=5)", /* 6: */ "switch ", #define F_SWITCH 6 /* 7: */ "void ", #define F_ROUTINE 7 /* 8: */ "", #define F_FN 8 /* 9: */ "", #define F_MAP 9 /* 10: */ "int ", #define F_PREDICATE 10 /* 11: */ "", #define F_ARRAY 11 /* 12: */ "", #define F_ARRAY_NAME 12 /* 13: */ "", #define F_NAME_ARRAY 13 /* 14: */ "", #define F_NAME_ARRAY_NAME 14 /* 15: */ "", #define F_EXPR 15 // Invented code to use for composite nodes... }; /* is a two-byte value: U<<5+I<<4+S<<3+X where: U is 1 check the object for unassigned 0 otherwise I is 1 if the object is an indirect object, 0 otherwise S is 1 if this is a spec, 0 otherwise X = 0 :: automatic (stack) allocation 1 :: own 2 :: constant 3 :: external 4 :: system 5 :: dynamic 6 :: primitive 7 :: permanent An indirect object (I=1) differs from F=2 in that F=2 implies that the actual object created will be a pointer and will be dereferenced whenever used unless explicit action is taken (e.g. use of Assign-Reference). If I=1 a pointer will be created (usually as an integer) and will be treated as an integer (or address) with no automatic dereferencing taking place. */ const char *ostates_imp[8] = { /* 0: */ "", #define X_AUTO 0 /* 1: */ "%own ", #define X_OWN 1 /* 2: */ "%constant ", #define X_CONST 2 /* 3: */ "%external ", #define X_EXTERNAL 3 /* 4: */ "%system ", #define X_SYSTEM 4 /* 5: */ "%dynamic ", #define X_DYNAMIC 5 /* 6: */ "%prim ", #define X_PRIM 6 /* 7: */ "%perm " #define X_PERM 7 }; const char *ostates_c[8] = { /* 0: */ "", #define X_AUTO 0 /* 1: */ "static ", #define X_OWN 1 /* 2: */ "const ", #define X_CONST 2 /* 3: */ "extern ", #define X_EXTERNAL 3 /* 4: */ "extern ", #define X_SYSTEM 4 /* 5: */ "extern ", #define X_DYNAMIC 5 /* 6: */ "static inline ", #define X_PRIM 6 /* 7: */ "extern " #define X_PERM 7 }; /* An indirect object (I=1) differs from F=2 in that F=2 implies that the actual object created will be a pointer and will be dereferenced whenever used unless explicit action is taken (e.g. use of Assign-Reference). If I=1 a pointer will be created (usually as an integer) and will be treated as an integer (or address) with no automatic dereferencing taking place. */ const OSPECIAL oflags[3] = { {8, "%spec "}, // S=1 {16, ""}, //" /*indirect-no-auto-deref, I=1*/"}, // <--- I=1 Object is indirect but should not be automatically indirected through like a %NAME variable. {32, ""}, //" /*NO UNASSIGNED CHECKS, U=1*/"}, }; int debug_ast = FALSE; // TRUE; const char *safe_astname(int idx) { if (idx >= 0 && idx < ASTCODES) return astname[idx]; return "INVALID"; } void debug_types_inner(char *name, int ast, char *file, int line) { if (!opt_verbose) return; // recfm 13161: AST_DECLARE 'SIMPLE' -> BASE_TYPE: %record (4) dump_code("/* %s %d: %s", name, ast, safe_astname(OP(ast))); /*if (OP(ast) == AST_DECLARE || OP(ast) == AST_VAR)*/ dump_code(" C_NAME: '%s'", C_NAME_IDX(ast) == 0 ? "" : pooltostr(C_NAME_IDX(ast))); dump_code( " -> BASE_TYPE: %s (%d)\n" " FORM: %s (%d)\n" " BASE_SIZE_CODE: %d BASE_SIZE_BYTES: %d\n" " LINKAGE: %s (%d)\n" " SPECIAL: %d\n" " BASE_%%NAME? %c ARRAY? %c ARRAY_NAME? %c\n" " PROC_PARAM? %c SPEC? %c\n" " NO_AUTO_DEREF: %d STRLEN: %d RECFM: %d\n" " FORMAL_PARAMS: %d ACTUAL_PARAMS: %d\n" " BOUNDS: %d DOPEVECTOR: %d\n" " INDEX_LIST: %d\n", types_imp[BASE_TYPE(ast) & 15], BASE_TYPE(ast), forms_imp[FORM(ast) & 15], FORM(ast), BASE_SIZE_CODE(ast), BASE_SIZE_BYTES(ast), ostates_imp[LINKAGE(ast)], LINKAGE(ast), SPECIAL(ast), IS_BASE_NAME(ast) ? 'Y' : 'N', IS_ARRAY(ast) ? 'Y' : 'N', IS_ARRAY_NAME(ast) ? 'Y' : 'N', IS_PROC_PARAM(ast) ? 'Y' : 'N', IS_SPEC_ONLY(ast) ? 'Y' : 'N', NO_AUTO_DEREF(ast), STRING_CAPACITY(ast), RECORD_FORMAT(ast), FORMAL_PARAM_LIST(ast), ACTUAL_PARAM_LIST(ast), BOUNDS1D(ast), DOPEVECTOR(ast), INDEX_LIST(ast) ); // we need both a holder for the record format *and* the formal param list in case there is a record function with params... dump_code(" UFC=%d [", USER_FIELD_COUNT(ast)); for (int i = 0; i < USER_FIELD_COUNT(ast); i++) { dump_code(" %d ", USERFIELD(ast, i)); } dump_code("] XFC=%d [", EXTENDED_FIELD_COUNT(ast)); for (int i = 0; i < EXTENDED_FIELD_COUNT(ast); i++) { dump_code(" %d", EXTRAFIELD(ast, i)); } dump_code("] in \"%s\":%d\n */\n", file, line); } int END_MARKER = UNASSIGNED; // Do not use. It's magic. int NEXT_AST = 0; // hackily shared with i2c.c int AST[MAX_AST]; // Ast entries are stored in here. // Ast entries must never include pointers to memory, // only integer data or indexes into arrays. // (Among other reasons, this allows us to relocate // the AST data which will be stored as a flex array) // Application-specific data int next_opd = 0; ASTIDX opdstack[MAX_ICODE_INSTRS]; // An AST entry is: (lower bounds inclusive, upper bounds exclusive) // 0..F: fixed fields (#F) common to all AST types, plus user fields (#U) which are // fixed for any specific AST type, which includes info such as the number of // fields in a specific ast type, plus the number of entries (#V) for variable- // length fields, which must follow the user fields and be located by the // contents of a user field. // F+1..U: user fields specific to each ast type // F+U+1..F+U+V: variable fields for this ast type (may be none) // // As the design (for want of a better word) of this code has iterated, more fields have // been thrown in to the 'fixed' area even though they're not used by all tuple types, // but there are still some variable fields left for things such as initial values of // array elements. void debug_tuple(ASTIDX tuple, char *mess) { fprintf(stderr, "%s AST TUPLE %d: OP=%d user fields: %d extended fields: %d\n", mess, tuple, OP(tuple), USER_FIELD_COUNT(tuple), EXTENDED_FIELD_COUNT(tuple)); fprintf(output_file, "%s AST TUPLE %d: OP=%d user fields: %d extended fields: %d\n", mess, tuple, OP(tuple), USER_FIELD_COUNT(tuple), EXTENDED_FIELD_COUNT(tuple)); if (OP(tuple) > ASTCODES) { fprintf(output_file, "* BAD tuple!\n"); fprintf(stderr, "* BAD tuple!\n"); exit(1); } } // unfortunately we have to mirror some info that actually is available in pass1: int switch_tag[MAX_SWITCHES]; int switch_low[MAX_SWITCHES]; int switch_high[MAX_SWITCHES]; //ASTIDX switch_decl[MAX_SWITCHES]; char *switches_set[MAX_SWITCHES]; // points to dynamic array of flags per switch index // This would have been better to have been stored in INDEX_LIST(ast) for the switch // declaration but I don't feel like going back to reimplement it since the current // hack actually works. 20:20 hindsight :-( int swstack_nextfree; int swbase[MAX_NESTED_BLOCKS]; // false bottom on stack of switches indexed by blocklevel // set by swbase[blocklevel] = swstack_nextfree just before // incrementing blocklevel, and swstack_nextfree = swbase[blocklevel] // whenever blocklevel is decremented int block_type[MAX_NESTED_BLOCKS]; // codegen by default evaluates the values of the objects it is given, so if a map call appears // withing a BINOP tuple for example, it is the value of the mapped object that is evaluated. // When we need the address of the object, e.g. for the ASSREF opcode ('==' assignment) that // will be pulled out as a special case. Same will apply for name parameters and the built-in // ADDR() function. // // ##### // # # ##### ###### #### # // # # # # # # # // # # # ##### # # // # # # # # # // # # # # # # # # // ##### ##### ###### #### ###### // void cdecl(ASTCODE AST_op, ASTIDX decltag) { // FINAL BIG 'TO DO'... make sure procedure parameters are fully output now that the icode // files can be modified to insert the parameters to the procedure parameters at the right // place. This may require a recursive call to cdecl! // And remember to suppress the 'REDEF' version which follows the formal parameter list. // Both of the above may require support from i2c.c ASTCODE AST_check_op; int tag, icode_op; detuple(decltag, &AST_check_op, &tag, &icode_op); assert(AST_op == AST_check_op); accessible = TRUE; // icode_op is either '$' or 'g' - the 'g' code is REDEF which should be handled exactly as DEF // except that no C code should be output. // external spec with a %alias can be done with an inline procedure wrapper as long as the alias // text is something that is valid C (mainly A-Za-z_ and possibly '$' if enabled. // An exported external routine with an alias can probably be done the same way. C does have // a mechanism a little similar to %alias but not identical and there are a lot of restrictions // in how it's used. There's also editing of object files but both of these options are not // ideal and I'ld like to avoid them. // Possibly asm("aliasname") may be a better solution for aliased external specs?: // extern double DSIN(double angle) asm("sin"); // %systemroutines should be in lower case to allow calling C library code. Whether we should // also have Imp reverse the order of evaluation of parameters for a C call is a separate issue. // (I'm specifcally referring to side-effects. Not the order in which the parameters are // typed in a source line which should always be left to right to match C, but they could if // we wanted be *evaluated* right to left by using temporaries. But there's no good reason // to apply C semantics to imp source code. /* Let's take an example: int connect(int sockfd, const struct sockaddr *addr, socklen_t addrlen); %recordformat sockaddr(%integer whatever) %externalroutine connect(%integer sockfd, %record (sockaddr) %name addr, %integer addlen) %systemroutinespec connect(sockfd, %record (sockaddr) %name addr, %integer addlen) connect(%integer sockfd, addr, addlen) %end */ // ------------------------------------------------------------------------------------------------ // external etc: if ((LINKAGE(decltag) /*& 7*/) == X_AUTO) { if ((blocklevel > 0) && (IS_PROCEDURE(decltag)) && IS_SPEC_ONLY(decltag)) { if (icode_op != 'g') dump_code("auto "); } // nested forward references using GCC must be declared 'auto'. The actual procedure doesn't have to be. } else if ((LINKAGE(decltag) /*& 7*/) == X_EXTERNAL) { // %external %integer fred -> int FRED; // %external %integer %spec fred -> extern int FRED; if (IS_SPEC_ONLY(decltag)) { dump_code("extern "); } } else { // Assuming for now that a %begin/%endofprogram is not going to skip the enclosing _imp_main // procedure, and make all procedures at that level global statics... // Note: const arrays probably should be static const arrays and handled here? dump_code("%s", ostates_c[LINKAGE(decltag) & 7]); } // ------------------------------------------------------------------------------------------------ // record format definitions are a special case. They can't be assigned or passed as // parameters. So relatively simple... if (FORM(decltag) == F_RECORDFORMAT) { // TO DO: alternative record fields (%or) dump_code( "typedef struct %s %s;\n", // // "forward declaration to allow a 'next' pointer to a struct within that struct...\n", pooltostr(C_NAME_IDX(decltag)), pooltostr(C_NAME_IDX(decltag))); dump_code("struct %s {\n", pooltostr(C_NAME_IDX(decltag))); ASTIDX parameterlist = FORMAL_PARAM_LIST(decltag); ASTIDX field_op; int num_fields; //debug_types(parameterlist); detuple(parameterlist, &field_op, &num_fields); //dump_code(" tuple: %d;\n", num_fields); for (int field = 0; field < num_fields; field++) { dump_code(" %N;\n", EXTRAFIELD(parameterlist, field)); } dump_code("};\n"); return; } // ------------------------------------------------------------------------------------------------ // Regular cases follow... switch (BASE_TYPE(decltag)) { case T_INTEGER: { const char *datasize_name[4] = {"long long int " /*64 bits*/, "int " /*32 bits*/, "unsigned char " /*8 bits*/, "short " /*16 bits*/}; if (SPECIAL(decltag)) { // Should this only be done in T_INTEGER or should it be moved above, outside this switch? const char *translate_c[4] = { /* translate 'special' codes below. */ /* 0: */ "", #define SPECIAL_DEFAULT 0 /* 1: */ "unsigned char ", // %byteinteger #define SPECIAL_BYTE_INT 1 /* 2: */ "short ", // %shortinteger #define SPECIAL_SHORT_INT 2 /* 3: */ "double ", // %longreal #define SPECIAL_LONG_REAL 3 }; // These override the BASE_TYPE!: if ((SPECIAL(decltag) & 3) == SPECIAL_BYTE_INT) { BASE_TYPE(decltag) = T_INTEGER; BASE_SIZE_BYTES(decltag) = 1; } else if ((SPECIAL(decltag) & 3) == SPECIAL_SHORT_INT) { BASE_TYPE(decltag) = T_INTEGER; BASE_SIZE_BYTES(decltag) = 2; } else if ((SPECIAL(decltag) & 3) == SPECIAL_LONG_REAL) { BASE_TYPE(decltag) = T_REAL; BASE_SIZE_BYTES(decltag) = 8; } if (icode_op != 'g') dump_code("%s", translate_c[SPECIAL(decltag) & 3]); } else { if ((BASE_SIZE_CODE(decltag) & 3) == 0) { BASE_TYPE(decltag) = T_INTEGER; BASE_SIZE_BYTES(decltag) = 8; } else if ((BASE_SIZE_CODE(decltag) & 3) == 1) { BASE_TYPE(decltag) = T_INTEGER; BASE_SIZE_BYTES(decltag) = 4; } else if ((BASE_SIZE_CODE(decltag) & 3) == 2) { BASE_TYPE(decltag) = T_INTEGER; BASE_SIZE_BYTES(decltag) = 1; } else if ((BASE_SIZE_CODE(decltag) & 3) == 3) { BASE_TYPE(decltag) = T_INTEGER; BASE_SIZE_BYTES(decltag) = 2; } if (icode_op != 'g') dump_code("%s", datasize_name[BASE_SIZE_CODE(decltag) & 3]); } } break; case T_REAL: if (BASE_SIZE_BYTES(decltag) == 4) { BASE_TYPE(decltag) = T_REAL; BASE_SIZE_BYTES(decltag) = 4; if (icode_op != 'g') dump_code("float "); } else { BASE_TYPE(decltag) = T_REAL; BASE_SIZE_BYTES(decltag) = 8; if (icode_op != 'g') dump_code("double "); } break; case T_RECORD: { // Let's handle record stuff separately too, it's not as awkward but still not completely regular... ASTIDX format_idx = RECORD_FORMAT(decltag); if (format_idx == 0) { if (icode_op != 'g') dump_code(" void "); // %const %record (*) %name NIL == 0 / const void * NIL = 0; } else { StrpoolIDX formatstr = C_NAME_IDX(format_idx); if (icode_op != 'g') dump_code(" %s ", pooltostr(formatstr)); } } break; default: if (FORM(decltag) == F_ROUTINE) { if (icode_op != 'g') dump_code("void "); } else if (FORM(decltag) == F_PREDICATE) { if (icode_op != 'g') dump_code("int /*Boolean*/ "); } else if (FORM(decltag) == F_SWITCH) { // Somewhere there is a scoping error with switch labels, so as a quick hack to see if the problem is where I think it might be, // I'm going to give every switch a unique name... char renamed_switch[512]; static int unique_number = 1; char unique_prefix[16]; sprintf(unique_prefix, "sw%0d", unique_number); unique_number += 1; sprintf(renamed_switch, "%s_%s", unique_prefix, pooltostr(C_NAME_IDX(decltag))); C_NAME_IDX(decltag) = strtopool(renamed_switch); dump_code("static int %s_idx;\n", pooltostr(C_NAME_IDX(decltag))); dump_code( "static const void * /*SWITCH*/ "); // static const void *reason[10] = { &&reason_0, &&reason_1, ... &&reason_9 }; } else if (BASE_TYPE(decltag) == T_STRING) { // (move these two BASE_TYPE tests up into the switch statement above?) if (icode_op != 'g') dump_code("_imp_string /*%%string(%d)*/ ", STRING_CAPACITY(decltag) & 255); } else if (BASE_TYPE(decltag) == 0 || FORM(decltag) == F_VOID) { if (!IS_A_POINTER(decltag)) { // Fortunate we can distinguish between the two rather hackily // TO DO: // an explicit %label declaration will unfortunately be preceded by "_imp_current_line = ...;" // unless --noline is active, but C does not allow imperative code before a label declaration, // which causes a compile-time error. Although this can be worked around by using --noline, // it is still a translator bug and has to be worked around, though I cannot see a solution // that does not involve an extra pass or some hack with shuffling the ICODE using idec.c if (blocklevel > 1) dump_code("__label__ U_%04X;\n", user_label_id[tag]); // %label ? return; // break; } else { if (icode_op != 'g') dump_code("void "); // generic %name variable! %real fred; %name jim; jim == fred } } else { // Everything else (the default case) dump_code("/*TO DO: DEFAULT TYPE*/ %s ", types_c[BASE_TYPE(decltag)]); // placeholder } break; } // ------------------------------------------------------------------------------------------------ if (IS_BASE_NAME(decltag)) { if (icode_op != 'g') dump_code("/*name*/*"); // %name } else if (FORM(decltag) == F_MAP) { if (icode_op != 'g') dump_code("/*map*/*"); // %map } if (IS_ARRAY_NAME(decltag)) { if (icode_op != 'g') dump_code("/*arrayname*/*"); // %arrayname // either int *fred[] or int **fred ? NO! (was "**", now "*") See AST_PASS_PARAMETER: when param is an arrayname... } // ------------------------------------------------------------------------------------------------ char *pname; pname = pooltostr(C_NAME_IDX(decltag)); if (icode_op != 'g') dump_code("%s", pname); if (IS_ARRAY(decltag) || (FORM(decltag) == F_SWITCH)) { if (LINKAGE(decltag) == X_AUTO) { // TO DO: check that DOPEVECTOR() is not 0 and BOUNDS1D() is 0 if (DOPEVECTOR(decltag) != 0) { if (icode_op != 'g') dump_code("%N", DOPEVECTOR(decltag)); } else if (BOUNDS1D(decltag) != 0) { if (icode_op != 'g') dump_code("%N", BOUNDS1D(decltag)); } else { dump_code("[/*missing array bounds*/]"); } if (FORM(decltag) == F_SWITCH) { // We don't need to wait until the switch labels are set (unlike in imptoc) as they are predictable! ASTIDX Lower, Upper; ASTCODE tag_check_op; ASTIDX bounds = BOUNDS1D(decltag); detuple(bounds, &tag_check_op, &Lower, &Upper); int LB, UB; LB = USERFIELD(Lower, 0); UB = USERFIELD(Upper, 0); dump_code(" = { "); for (int idx = LB; idx <= UB; idx++) { if (idx < 0) { dump_code("&&%s_M_%d, ", pname, -idx); } else { dump_code("&&%s_%d, ", pname, idx); } } dump_code(" }"); } } else { ASTIDX bounds = BOUNDS1D(decltag); // TO DO: check that BOUNDS1D() is not 0 and DOPEVECTOR() is 0 if (bounds != 0) { if (icode_op != 'g') dump_code("%N", bounds); } else { dump_code("[/*missing N-D array bounds*/]"); } } } // ------------------------------------------------------------------------------------------------ // Note: %switch is effectively a const %label array with non-standard initialisation // and remember the C syntax is a bit weird if using the gcc extension, i.e. // the array elements need "&&". Probably simpler just to add some dispatch code // at the foot of the procedure, and jump to that whenever there's a '->sw(n)'... /* Also remember trick for negative labels. And default. if ((n < 0) || (n > 9)) BADSWITCH(n, __LINE__, __FILE__); #ifdef USE_GCC_EXTENSIONS goto *reason[n]; #else switch (n) { case 0: goto reason_0; case 1: goto reason_1; case 2: goto reason_2; case 3: goto reason_3; case 4: goto reason_4; case 5: goto reason_5; case 6: goto reason_6; case 7: goto reason_7; case 8: goto reason_8; case 9: goto reason_9; } #endif reason_0: // 0 printstring("compiler error!"); goto more; reason_1: // 1 printstring("switch vector too large"); goto more; */ // ------------------------------------------------------------------------------------------------ if (IS_PROCEDURE(decltag)) { if (icode_op != 'g') dump_code("( %N )", FORMAL_PARAM_LIST(decltag)); if (IS_SPEC_ONLY(decltag)) { if ((LINKAGE(decltag) == X_EXTERNAL) && (EXTERNAL_NAME_IDX(decltag) != C_NAME_IDX(decltag))) { // strpool indexes for the same string created at different times are not guaranteed to be equal, // however the *_NAME_IDX entries for a given procedure are filled in with the same value when // the tuple is created, so if they differ it is because a different name was given later for // the same procedure. So the test above is safe. However if this breaks for any reason later, // we can use the much safer (but more expensive) test below: // (strcmp(pooltostr(EXTERNAL_NAME_IDX(decltag)), pooltostr(EXTERNAL_NAME_IDX(decltag))) != 0) /* The __attribute__(alias) mechanism which I initially considered for Imp's %alias doesn't work in many contexts, whether using "alias" or "weak" or any other option. One possible alternative that's mostly portable, *but* only works with names that are C compatible, is to use an inline procedure as a shim, e.g: static inline float FLOATYSQRT(float N) { extern float sqrtf(float); // Hide from rest of Imp program return sqrt(N); } but that only works for external references, not for the bodies. Another option for references (which should allow calls to procs whose names are not C-compatible) - but not bodies - is to use dlopen, but that's way overkill for regular external procedure calls. However the best solution I've found and the one I plan to use is: For an external reference: extern void MYPROC( int RC ) __asm__("S_XXX"); For an external body: void MYPROC( int RC ) __asm__("S_XXX"); void MYPROC( int RC ) { ... } - note that it must be given as a spec first followed by the body, and the __asm__("...") must be given on the spec even though it renames the body. this solution allows both spec and body to be renamed, and partially allows non-C-compatible names as long as they are compatible with gcc's assembler. */ dump_code(" __asm__(\"%s\")", pooltostr(EXTERNAL_NAME_IDX(decltag))); // I haven't yet implemented the equivalent for procedure bodies. } if (AST_op == AST_DECLARE) { if (icode_op != 'g') dump_code(";\n"); } } else { if (icode_op != 'g') dump_code("\n"); // '}' now being added by AST_BLOCKSTART node. } } else { if (AST_op == AST_DECLARE) { ASTIDX init_var = INITVALUES(decltag); // (fixed a bug by changing init_var default to 0 and ensuring INITVALUES() was initialised.) if (init_var != 0 && (OP(init_var) == AST_ICONST || (OP(init_var) == AST_RCONST || (OP(init_var) == AST_ISTRINGCONST)))) { ASTIDX bounds = BOUNDS1D(decltag); if (bounds != 0) { // ARRAY INIT // yes, putting an entire array on one line *is* messy, // but it does preserve the #line numbering slightly better. ASTIDX Lower, Upper; ASTCODE tag_check_op; detuple(bounds, &tag_check_op, &Lower, &Upper); int LB, UB; LB = USERFIELD(Lower, 0); UB = USERFIELD(Upper, 0); // this is rather hacky and depends on all const // tuple types having exactly 1 user field. // Not necessary but just to make the C output more readable, I use C's version of 0(*) // at the end of an array to remove possibly thousands of repeated entries. This isn't // done elsewhere in an array, just at the end. int stride = FIXED_FIELDS + 1; int num_vals = UB - LB + 1; dump_code(" = { "); int idx = 0; ASTIDX last_value_idx = INITVALUES(decltag) - idx * stride; ASTIDX this_value_idx; for (;;) { idx += 1; this_value_idx = INITVALUES(decltag) - idx * stride; if (USERFIELD(this_value_idx,0) != USERFIELD(last_value_idx,0)) { break; } } // num_vals-1:idx inclusive are assorted values, // idx-1:0 inclusive are all the same. ASTIDX last_unique_idx = idx; if (IS_ICONST(last_value_idx) && (idx > 16)) { for (int idx = num_vals - 1; idx >= last_unique_idx; idx--) { dump_code("%N, ", INITVALUES(decltag) - idx * stride); } dump_code("[%d ... %d] = %N", num_vals - last_unique_idx, num_vals - 1, last_value_idx); } else { for (int idx = num_vals - 1; idx >= 0; idx--) { dump_code("%N, ", INITVALUES(decltag) - idx * stride); /*GASTRICREFLUX*/ // (see elsewhere) } } dump_code(" }"); } else if (BASE_TYPE(decltag) == T_RECORD && IS_ZERO(INITVALUES(decltag))) { // RECORD INIT dump_code(" = { %N } /* Initialise all fields of a record to 0. */", INITVALUES(decltag)); } else { // SCALAR INIT dump_code(" = %N", INITVALUES(decltag)); } } if (icode_op != 'g') dump_code(";\n"); } } } // // ##### // # # #### ##### ###### #### ###### # # // # # # # # # # # # ## # // # # # # # ##### # ##### # # # // # # # # # # # ### # # # # // # # # # # # # # # # # ## // ##### #### ##### ###### #### ###### # # // void codegen_inner(char *file, int line, int tuple) { ASTCODE AST_op, AST_check_op; if (tuple / 100000 == 100) { fprintf(stderr, "i2c: codegen was called in %s (line %d) with a tuple which was created as a placeholder at line %d\n", file, line, tuple % 100000); exit(EXIT_FAILURE); } AST_op = OP(tuple); switch (AST_op) { #ifdef NOT_YET case AST_RECORD_FORMAT: { // Just output the name of the record format... } break; #endif case AST_DECLARE_FP: // Identical to AST_DECLARE except we don't want the ";\n" after everything! // (the commas between parameters will be inserted by AST_FORMAL_PARAMETER_LIST) case AST_DECLARE: { cdecl(AST_op, tuple); debug_types(tuple); } break; // The start of a procedure body increases the level same as a BLOCKSTART (%begin). // Both are terminated by a BLOCKEND (%end). There are some housekeeping actions // that will need to be performed on a BLOCKEND: // 1) Place any missing switch labels, and have them output a 'missing switch label' // error message. This code will also be branched to by the range test to be // added to the ->sw(n) jumps when n is outside the range of the switch labels. // Note that the 'blocklevel' variable that tracks the current scope level is // currently being handled by i2c.c but probably should be moved to this unit instead. // (See the code for Define Var ('$'), Begin ('H') and End (';') in i2c.c) case AST_BLOCKSTART: { swbase[blocklevel] = swstack_nextfree; blocklevel += 1; int BLOCKTYPE, name, level = 0; // level of the block we are about to go into. detuple(tuple, &AST_check_op, &level, &BLOCKTYPE, &name); if (level != blocklevel) { dump_code("/*BUG:blocklevel=%d level=%d*/", blocklevel, level); blocklevel = level; } blockname[blocklevel] = name; block_type[blocklevel] = BLOCKTYPE; if (BLOCKTYPE == BLOCKTYPE_BEGIN_ENDOFPROGRAM) { dump_code("int main(int argc, char **argv) {\n", level); #ifdef END_OF_BLOCK_HACK dump_code(" __label__ _imp_endofblock;\n"); #endif dump_code(" _imp_initialise(argc, argv);\n", level); /* NOTE: I did toy at one point with using the gcc constructor to do the imp run-time initialisation on the fly as main() was entered; however this does not allow us to pick up argv and argc to use in Imp's "cliparam" etc. There might be an argument for separating argc & argv (and maybe stream initialisation) from any other imp initialisation, and using the constructor for the non-main related initialisation, which is that a C main program might want to call some library routines written in Imp. But for now that's an unlikely scenario, and offhand I can't think of anything other than streams and arguments that has to be initialised anyway. __attribute__((constructor)) void init_function() { printf("This runs before main().\n"); } */ } else { // dump_code("{ // Start of block %s at level %d\n", pooltostr(blockname[level]), level); // Although in Imp77, a %begin/%end block is notionally described as an anonymous procedure, // here it has to be an actual procedure (which is called immediately after the %end), and // this is for the most stupid of reasons: PSR's clever but obscure method of reusing label // IDs fails totally when translated to C, because label scope in IMP stays within a %begin/%end // block, but C's "{ ... }" block does not restrict the label scope, so we get a clash. // By making that block into a procedure rather than the C equivalent of a start/finish, // we reinstate the ability to provide scope and suddenly this duplicated label error goes away! if (BLOCKTYPE == BLOCKTYPE_BEGIN_END) dump_code("void %s(void) ", pooltostr(blockname[level])); dump_code("{\n"); #ifdef END_OF_BLOCK_HACK dump_code(" __label__ _imp_endofblock;\n"); #endif } } break; case AST_BLOCKEND: { int level = 0; // level of the block being ended detuple(tuple, &AST_check_op, &level); int BLOCKTYPE = block_type[level]; //dump_code("\n/*AST_BLOCKEND: level=%d BLOCKTYPE=%d blockname=%s */\n", level, BLOCKTYPE, pooltostr(blockname[level])); if (blocklevel == 0) { dump_code("// End of file\n"); } else { if (BLOCKTYPE == BLOCKTYPE_BEGIN_ENDOFPROGRAM) { // %endofprogram // TO DO: This is a good place to remove any %onevent block from the chain if (accessible) dump_code("/* Remove %%on %%event handler here if present for this block */\n"); dump_code("return 0;\n"); // or exit(EXIT_SUCCESS) or %signal 0,0,0,"normal exit" ??? accessible = FALSE; } else { // TO DO: possibly handle missing %result etc for fn/map/pred, plus a "return;" for %routines switch (BLOCKTYPE) { case BLOCKTYPE_BEGIN_END: #ifdef END_OF_BLOCK_HACK dump_code("goto _imp_endofblock;\n");/* break;*/ // btw Imp77 allows %return but C does not. #else dump_code("return;\n"); #endif accessible = FALSE; break; case BLOCKTYPE_ROUTINE: // TO DO: This is a good place to remove any %onevent block from the chain if (accessible) dump_code("/* Remove %%on %%event handler here if present for this block */\n"); dump_code("return;\n"); accessible = FALSE; break; // not an error case BLOCKTYPE_FN: case BLOCKTYPE_MAP: case BLOCKTYPE_PREDICATE: if (accessible) { // If at some point I change this from doing an immediate exit() to raising a signal, // I will need to add the signal chain cleanup code here as well: // TO DO: This is a good place to remove any %onevent block from the chain //dump_code("/* Remove %%on %%event handler here if present for this block */\n"); dump_code("/*_imp_signal(8, 4, 0, \"\");*/\n"); dump_code("fprintf(stderr, \"%%%%RESULT missing in %%s in file %%s:%%d\\n\", __PRETTY_FUNCTION__, (_imp_current_file != 0 ? _imp_current_file : __FILE__), (_imp_current_line != 0 ? _imp_current_line : __LINE__));\n"); dump_code("exit(1);\n"); accessible = FALSE; } break; } } int sw_at_this_level = swstack_nextfree; // locate the switch definition in the stack... (we keep a redundant copy of data that could probably be got from pass1, for convenience) for (;;) { if (sw_at_this_level == swbase[blocklevel-1]) break; // or should that be if (sw_at_this_level == swbase[blocklevel]) break; ?/? if (sw_at_this_level == 0) break; sw_at_this_level -= 1; int missing=0; int switchtag = switch_tag[sw_at_this_level]; int swstack_idx = sw_at_this_level; for (;;) { if (swstack_idx < 0) break; if (switch_tag[swstack_idx] == switchtag) { int low = switch_low[swstack_idx]; int high = switch_high[swstack_idx]; char *switch_flag = switches_set[swstack_idx]; for (int idx = low; idx <= high; idx++) { if (switch_flag[idx-low] == 0) { // MARK AS USED! int index_ast = mktuple(AST_ICONST, idx); missing += 1; codegen(mktuple(AST_DEF_SWLAB, mktuple(AST_VAR, switchtag), index_ast)); // use 'codegen()', not 'dump_code()', otherwise it comes out after the '}' is printed! } } break; } swstack_idx -= 1; } if (missing) { // TO DO! We need to a) have a location associated with this switch's declaration which is // initialised to 'a default has not yet been supplied' // and B) set that to 'a default *has* been supplied' on this icode. // It will be tested on the end of the block, where we have 3 options: // 1) there are unset labels in the switch's range and no default - output an error message // 2) there are unset labels in the switch's range and there is a default - so jump to it // 3) there are no unset labels, the range was already fully used: don't generate any epilog code // (note we have a new opcode, '`', to define the default switch label) int default_supplied = STRING_CAPACITY(Descriptor[switchtag]); // TO DO. StrpoolIDX switchname = C_NAME_IDX(Descriptor[switchtag]); if (default_supplied) { dump_code("goto %s_default;\n", pooltostr(switchname)); } else { dump_code("/*_imp_signal(6,3,%s_idx,\"SWITCH LABEL NOT SET - %s\");*/\n", pooltostr(switchname), pooltostr(switchname)); dump_code("fprintf(stderr, \"%%%%SWITCH LABEL NOT SET - %s(%%d): at line %%s:%%d\", %s_idx, (_imp_current_file != 0 ? _imp_current_file : __FILE__), (_imp_current_line != 0 ? _imp_current_line : __LINE__));\n", pooltostr(switchname), pooltostr(switchname)); dump_code("exit(1);\n"); } accessible = FALSE; } } swstack_nextfree = swbase[blocklevel-1]; // this might fix the bug mentioned above..? // The ';' before the '}' is to keep C happy re no labels before '}' // - a problem which goes away when an appropriate return is added... #ifdef END_OF_BLOCK_HACK dump_code("_imp_endofblock: ;\n"); #endif // TO DO: This is a good place to remove any %onevent block from the chain if (accessible) dump_code("/* Remove %%on %%event handler here if present for this block */\n"); dump_code("} // End of block %s at level %d\n", pooltostr(blockname[level]), level); // Inline %begin/%end blocks are implemented as actual procedures, so we have to call those procedures! // (Note that %begin/%end/%endoffile is the same as %begin/%endofprogram, hence the level test below)) if ((BLOCKTYPE == BLOCKTYPE_BEGIN_END) && (level > 1)) dump_code("%s();\n", pooltostr(blockname[level])); } //dump_code("\n/* Blocklevel was %d */\n", blocklevel); if (blocklevel > 0) { // blocklevel is the global describing the current block level blocklevel -= 1; } //dump_code("\n/* Blocklevel is now %d */\n", blocklevel); accessible = TRUE; } break; case AST_RESULT: { int rslt; detuple(tuple, &AST_check_op, &rslt); assert(AST_op == AST_check_op); // TO DO: This is a good place to remove any %onevent block from the chain dump_code("/* Remove %%on %%event handler here if present for this block */\n"); dump_code("return %V;\n", rslt); accessible = FALSE; } break; case AST_RETURN: { detuple(tuple, &AST_check_op); assert(AST_op == AST_check_op); // *** Note *** in a %begin/%end block, which Imp77 treats as an anonymous %routine, issuing // a %return causes a jump to the end of the block, so I have changed the implementation of blocks // into actual inline procedures, to more closely match Imp77's concept of begin/end blocks. // TO DO: This is a good place to remove any %onevent block from the chain dump_code("/* Remove %%on %%event handler here if present for this block */\n"); dump_code("return;\n"); // so for the moment, this obscure case is broken :-( accessible = FALSE; } break; case AST_CONDITIONAL_RESOLVE: { ASTIDX resolve; detuple(tuple, &AST_check_op, &resolve); dump_code("%N", resolve); } break; case AST_UNCONDITIONAL_RESOLVE: { ASTIDX resolve; detuple(tuple, &AST_check_op, &resolve); // https://gtoal.com/history.dcs.ed.ac.uk/archive/docs/EMAS_Manuals/IMP/Edinburgh_IMP_Language_Manual.pdf P144 dump_code("if (!%N) _imp_signal(7,1,0, \"string resolution fails\");\n", resolve); } break; case AST_ONGOTO: { ASTIDX eventlist; int lab; int count = 0; // TO DO: on event blocks must be removed from the chain when the enclosing level exits, whether at the // %end of the block or via a %result or %return. The presence of this "ONGOTO' node can be used to set // a flag for this block level which we can test when generating code for %result=, %return, or %end. // NOTE: %signal handling may now require us to insert some code immediately // before the %finish" of the %on %event %start ... %finish block. // That position will be immediately before the below is output. detuple(tuple, &AST_check_op, &eventlist, &lab); // note eventlist is a 16 bit bitmask value, not an ICONST dump_code("if (!_imp_on_event("); for (int evno = 0; evno < 16; evno++) { if ((eventlist & (1< = + } else { dump_code("{static int _initial, _increment, _final, _control;\n"); // dump_code("_initial = %N; _increment = %N; _final = %N; %N = _control = _initial;\n", initial, increment, final, control); dump_code("_initial = %V; _increment = %V; _final = %V; %V = _control = _initial;\n", initial, increment, final, control); // If values are constants can warn about this at compile time. pass1 should have done so however! // but... if we do do it here, output a "#warn" directive into the C source rather than printing it directly to stderr. // dump_code("if (((_final-_initial) %% _increment) != 0) _imp_signal(5,1,0,\"Illegal cycle %N = %N, %N, %N\");\n", control, initial, increment, final); dump_code("if (((_final-_initial) %% _increment) != 0) _imp_signal(5,1,0,\"Illegal cycle %V = %V, %V, %V\");\n", control, initial, increment, final); // dump_code("%N -= _increment; _control -= _increment;\n", control); dump_code("%V -= _increment; _control -= _increment;\n", control); codegen(mktuple(AST_DEFLAB, mktuple(AST_LABEL, forlab, 'L', fortag))); // LABEL // dump_code("if (%N == _final) goto %N;\n", control, mktuple(AST_LABEL, exitlab, 'L', fortag + 1)); dump_code("if (%V == _final) goto %N;\n", control, mktuple(AST_LABEL, exitlab, 'L', fortag + 1)); // dump_code("%N += _increment; _control += _increment;\n", control); // = + dump_code("%V += _increment; _control += _increment;\n", control); // = + // dump_code("if (%N != _control) _imp_signal(4,2,0,\"Corrupt control variable %N\"); /* FOR loop control variable corrupted */\n", control, control); dump_code("if (%V != _control) _imp_signal(4,2,0,\"Corrupt control variable %V\"); /* FOR loop control variable corrupted */\n", control, control); dump_code("}\n"); } } break; case AST_COMPARE2: { // First iteration at handing double-sided conditions better: just do what we did before... ASTIDX param1, param2, param3; int opsym1, opsym2; detuple(tuple, &AST_check_op, ¶m1, &opsym1, ¶m2, &opsym2, ¶m3); int needs_cache = (IS_PROCEDURE(param1) || IS_PROCEDURE(param2) || IS_PROCEDURE(param3)); if (needs_cache) { // potential side-effects, so ensure the functions are called in left-to-right order and not called twice for the middle value // Unfortunately we need to get the type info from Imp rather than using C's typeof() hack, because // the C mechanism does not work with literals, only variables, so either we don't cache variables // (which is doable but awkward) or we look at the type information of the params and use that // explicitly in the declarations. (which is doable but awkward). // For now I'll just make an approximate solution using integer, real and string... int basetype = BASE_TYPE(param2); // for now ignore precision... /* TO DO */ char *usetype; if (basetype == T_INTEGER || basetype == T_REAL) { if (basetype == T_INTEGER) usetype = "int"; else usetype = "double"; /* test/soap80-a.c: In function 'STOI': test/soap80-a.c:4488:29: warning: initialization of 'int' from 'unsigned char *' makes integer from pointer without a cast [-Wint-conversion] 4488 | if (({int tmp1 = 48, tmp2 = _imp_CHARNO(&SNUM, 1), tmp3 = 57; (tmp1 > tmp2) || (tmp2 <= tmp3);})) goto L_025d; | ^~~~~~~~~~~ Why didn't the call to the CHARNO map get automatically dereferenced? If I add dereferencing here do I need to check all 3 operands? */ dump_code("({%s tmp1 = %V, tmp2 = %V, tmp3 = %V; (tmp1 %s tmp2) || (tmp2 %s tmp3);})", usetype, param1, param2, param3, operator[opsym1], operator[opsym2]); } else if (basetype == T_STRING) { dump_code("({_imp_string tmp1, tmp2, tmp3; _imp_strcpy(tmp1, %V); _imp_strcpy(tmp2, %V); _imp_strcpy(tmp3, %V); _imp_strcmp(tmp1, tmp2) %s 0) || _imp_strcmp(tmp2, tmp3) %s 0;})", param1, param2, param3, operator[opsym1], operator[opsym2]); } else { // fallback code. Hope this doesn't happen, but at least I've marked to in case it does... // TO DO: I think this one was caused by param2 having auto deref applied, and the resulting tuple must not have had its BASETYPE copied over correctly? dump_code("/*BUG@%d? basetype=%d*/ (%N) || (%N)", __LINE__, basetype, mktuple(AST_COMPARE, param1, opsym1, param2), mktuple(AST_COMPARE, param2, opsym2, param3)); } } else { // No need - no side-effects... let GCC optimise the 2 accesses to param2... dump_code("(%N) || (%N)", mktuple(AST_COMPARE, param1, opsym1, param2), mktuple(AST_COMPARE, param2, opsym2, param3)); } } break; // Although I should really merge COMPARE with BINOP, there's no need to, // since it is not possible in imp to mix arithmetic operations with // comparisons, other than the single comparison in the simplified 'if' // statement as output by pass1 to icode. // NOTE that AST_COMPARE is (currently) OPD opsym OPD // but AST_BINOP is opsym OPD OPD. This caused problems // in an earlier revision of this code... case AST_COMPARE: { ASTIDX param1, param2; int comparison_opsym; detuple(tuple, &AST_check_op, ¶m1, &comparison_opsym, ¶m2); if (IS_STRING(param1) || IS_STRING(param2)) { // should be both! :) dump_code("(_imp_strcmp(%V, %V) %s 0)", param1, param2, operator[comparison_opsym]); } else { dump_code("((%V) %s (%V))", param1, operator[comparison_opsym], param2); } } break; case AST_ASSIGN: // TO DO: strings, records, type conversions int to real, etc { // rather than have separate AST types for ASSREF/JAM/ASSVAL, all assignments // come through AST_ASSIGN, and the special cases are handled by looking at the // 'opsym' field which is the original ICODE operation symbol: ASSVAL='S', // ASSREF='Z', JAM='j'. ASTIDX assop; int opsym; ASTIDX dest, source; detuple(tuple, &assop, &opsym, &dest, &source); if (OP(source) == AST_BRACKET) source = USERFIELD(source, 0); // remove redundant brackets on RHS of assignment. if ((opsym == 'S') || (opsym == 'j')) { // ASSVAL, JAM: /* DEST is mapcall, SOURCE is %name: *dest() = *source DEST is mapcall, SOURCE is scalar: *dest = source DEST is %name, SOURCE is %name: *dest = *source DEST is %name, SOURCE is scalar: *dest = source DEST is scalar, SOURCE is %name: dest = *source DEST is scalar, SOURCE is scalar: dest = source */ //if (IS_NAME(source)) { // fixed: was IS_A_POINTER. Should this just apply to F_NAME not F_ARRAYNAME which might need to be handled elsewhere as in (*NAME)[INDEX] ? if (REQUIRES_AUTO_DEREF(source)) { // fixed: was IS_A_POINTER. Should this just apply to F_NAME not F_ARRAYNAME which might need to be handled elsewhere as in (*NAME)[INDEX] ? source = mktuple(AST_INDIRECT_THROUGH, source); // TO DO: check that a %map is handled correctly. } //dump_code("/*CHECKING LHS (%s) IS %%name or %%map?", astname[OP(dest)]); //if (IS_NAME(dest)) { // TO DO: check that a %map is handled correctly. I suspect it is *NOT* ... so, changed... if (REQUIRES_AUTO_DEREF(dest)) { // TO DO: check that a %map is handled correctly. I suspect it is *NOT* ... so, changed... //dump_code(" - yes*/"); dest = mktuple(AST_INDIRECT_THROUGH, dest); // TO DO: check that a %map is handled correctly. } else { //dump_code(" - no*/"); } // It appears not to be for a %staring(255)%name S; S = S . '?' - the LHS is not indirected. Don't yet know why. if (BASE_TYPE(dest) == T_RECORD && (LINKAGE(dest) == X_PERM || LINKAGE(dest) == X_PRIM) && (strcmp(pooltostr(IMP_NAME_IDX(dest)), "RECORD")==0)) { char *dest_struct_name; ASTIDX recfm = RECORD_FORMAT(source); StrpoolIDX formatstr = C_NAME_IDX(recfm); dest_struct_name = pooltostr(formatstr); dump_code(" *(%s *) %N = ", dest_struct_name, mktuple(AST_ADDRESS_OF, dest)); } else { dump_code("%N = ", dest); } if ((opsym == 'j') && (BASE_TYPE(dest) == T_INTEGER || BASE_TYPE(dest) == T_REAL)) { // jam transfer must cast the RHS to the type of the LHS which will cause truncation without an error message. // TO DO: remove all instances of promote_cast (which has now been deleted), and replace them with AST_CAST tuples. // dump_code("/*jam transfer*/%s", promote_cast(dest, dest, 0)); } if (BASE_TYPE(dest) == T_RECORD && OP(source) == AST_ICONST) { char *dest_struct_name; ASTIDX recfm = RECORD_FORMAT(dest); StrpoolIDX formatstr = C_NAME_IDX(recfm); dest_struct_name = pooltostr(formatstr); dump_code("(%s){ %N } /* Assign 0's to all fields of record */;\n", dest_struct_name, source); } else if (BASE_TYPE(dest) == T_RECORD && (LINKAGE(source) == X_PERM || LINKAGE(source) == X_PRIM) && (strcmp(pooltostr(IMP_NAME_IDX(source)), "RECORD")==0)) { char *dest_struct_name; ASTIDX recfm = RECORD_FORMAT(dest); StrpoolIDX formatstr = C_NAME_IDX(recfm); dest_struct_name = pooltostr(formatstr); dump_code(" *(%s *) ", dest_struct_name); /*if (FORM(source) == F_SIMPLE) ... */ dump_code("%N;\n", mktuple(AST_ADDRESS_OF, source)); break; } else { // TO DO: the right hand side of an AST_ASSIGN should be checked for unassigned if it is a simple scalar dump_code("%N;\n", source); } } else if (opsym == 'Z') { // ASSREF // TO DO! AST_FIELDSELECT may be broken but the fault is more likely here: //%BEGIN // %RECORDFORMAT F(%INTEGER I,J,K,%INTEGERARRAY A(1:5)) // %RECORD(F) R // %INTEGERARRAYNAME B // ! Bug in AST_FIELDSELECT: // B==R_A //%ENDOFPROGRAM // 23 | B = &A[-1]; // 9 // | ^ // test/missingrecord.c:23:6: note: each undeclared identifier is reported only once for each function it appears in // TO DO: Once the above is fixed, next big RECORD-related issue is to handle the RECORD() map. As far as I can see // it is only ever used when assigning to a real record or recordname, i.e. in this AST_ASSIGN code. // I haven't decided yet if using a cast to the record type of the LHS is the way to go, or if // using memmove would be better... I need to check to see if a jam transfer from a larger record // to a smaller one is allowed in Imp77. /* ASSREF: DEST is mapcall, SOURCE is %name: ILLEGAL COMBINATION DEST is mapcall, SOURCE is scalar: ILLEGAL COMBINATION DEST is %name, SOURCE is %name: dest = source DEST is %name, SOURCE is scalar: dest = &source DEST is scalar, SOURCE is %name: ILLEGAL COMBINATION DEST is scalar, SOURCE is scalar: ILLEGAL COMBINATION */ // Don't automatically deference LHS of == address assignment. Imp77 pass1 would // not have come via this path with a LHS that is not an assignable pointer. dump_code("%N = ", dest); /* TO DO: Assigning an array to an arrayname *should* (but currently doesn't) adjust the base so that the address of element 0 is assigned. There are several places now where the offset into an array is calculated, they really need to be made into common code. As well as accessing array elements, we need to handle passing arrays and array names as parameters (this AST_ASSIGN, and also AST_ACCESS, AST_INDEX, and AST_PASS_PARAMETER) // 30 %ownintegerarrayname pointer static int / *arrayname* / *POINTER; // 31 // 32 pointer == bert POINTER = BERT; */ if ((LINKAGE(source) == X_PERM || LINKAGE(source) == X_PRIM) && (strcmp(pooltostr(IMP_NAME_IDX(source)), "RECORD")==0)) { // ^^^^^^^^^^ should this be IMP_NAME_IDX(source)? or "_imp_RECORD"? // How do we handle %record (recfm) %name rp == RECORD(address)? Can RECORD() ever be used in any other context than in a '==' assignment? // (or as a parameter to a procedure, which is amost the same thing) // In an assignment to a record pointer: // R==RECORD(ADDR(A(0))) // When used as NIL (NULL) by giving a 0 parameter: // fredp == RECORD(0) // Note that when used in an assignment, the location it is being assigned to can be complex: // A(x'ff')_LINK==RECORD(0) // In an "==" (or "\==") comparison: // %WHILE RN_LINK\==RECORD(0) %CYCLE // As a parameter: // WRITE DA (PAGING FILE,J,RECORD(BUFFER)) // My suspicion is that it cannot be used arbitrarily in expressions, so catching uses of RECORD() // at the top level of AST_ASSIGN or AST_CALL where the type of the target is known will get us // through all cases that will come up in practice. char *dest_struct_name; ASTIDX recfm = RECORD_FORMAT(dest); StrpoolIDX formatstr = C_NAME_IDX(recfm); dest_struct_name = pooltostr(formatstr); //dump_code(" /*(recfm=%s) See %s:%d */ ", dest_struct_name, __FILE__, __LINE__); dump_code(" (%s *) ", dest_struct_name); } // This is basically the opposite of REQUIRES_AUTO_DEREF... switch (FORM(source)) { case F_VOID: dump_code("/*F_VOID*/%N;\n", source); break; case F_SIMPLE: dump_code(/*F_SIMPLE*/"%N;\n", mktuple(AST_ADDRESS_OF, source)); break; case F_NAME: dump_code(/*F_NAME*/"%N;\n", source); break; case F_MAP: dump_code(/*F_MAP*/"%N;\n", source); break; case F_ARRAY: { // This is effectively the same code as passing an array as a parameter to a procedure. (some code-sharing required) //dump_code("/*F_ARRAY*/ &%N[0/*ADJUST BASE*/];\n", source); ASTIDX boundspair = BOUNDS1D(source); ASTIDX dopevector = DOPEVECTOR(source); ASTIDX LB, UB; int /*check_dv_op,*/ check_bounds_op; if (boundspair != 0) { // pass 1-D array with static bounds as a parameter detuple(boundspair, &check_bounds_op, &LB, &UB); // TO DO! Add something like this when passing an arrayname: if (REQUIRES_AUTO_DEREF(source)) source = mktuple(AST_INDIRECT_THROUGH, source); if (IS_ZERO(LB)) { dump_code("&%N[0]", source); } else if (IS_ICONST(LB)) { if (USERFIELD(LB, 0) < 0) { dump_code("/*is_array_name6*/ &((%N+%d)[0])", source, -USERFIELD(LB, 0)); } else { dump_code("/*is_array_name5*/ &((%N-%d)[0])", source, USERFIELD(LB, 0)); } } else { // shouldn't happen with 1D arrays and constant bounds dump_code("/*is_array_name3 BUG UNHANDLED EDGE CASE? */ &(%N[0])", mktuple(AST_BINOP, '-', source, LB)); } } else if (dopevector != 0) { // NEW CODE UNDER TEST TO PASS DYNAMIC ARRAYS AS A PARAMETER: debug_types(source); int dims = USERFIELD(dopevector, 0); if (dims != 1) { fprintf(stderr, "* IMPLEMENTATION RESTRICTION: cannot assign arrays of %d dimensions to an arrayname variable.\n", dims); } if (IS_ARRAY_NAME(source)) { dump_code("%s", pooltostr(C_NAME_IDX(source))); } else { dump_code("&%s", pooltostr(C_NAME_IDX(source))); } for (int dim = 1; dim <= dims; dim++) { ASTIDX boundspair = EXTRAFIELD(dopevector, dim-1); // '-1' to be tidied up ASTIDX LB, UB; int check_op; detuple(boundspair, &check_op, &LB, &UB); dump_code("[-(%N)]", LB); } } else { // Might be an arrayname parameter so based at 0 but still requires proper checking if (REQUIRES_AUTO_DEREF(source)) { dump_code("/*is_array_name_param4 BUG? */ &%N[0]", source); } else { dump_code("/*is_array_name_param3 BUG? */ &%N[0]", source); } } dump_code(";"); } break; case F_ARRAY_NAME: dump_code("/*F_ARRAY_NAME*/%N;\n", source); break; case F_NAME_ARRAY: dump_code(/*F_NAME_ARRAY*/"%N;\n", source); break; case F_NAME_ARRAY_NAME: dump_code("/*F_NAME_ARRAY_NAME*/%N;\n", source); break; default: break; } } } break; case AST_LABEL: { int labtag; int imp_labno, labtype; detuple(tuple, &AST_check_op, &imp_labno, &labtype, &labtag); dump_code(/*labtag: %d*/ "%c_%04x", /*labtag,*/ labtype, imp_labno); } break; case AST_GOTO: { int lab; detuple(tuple, &AST_check_op, &lab); dump_code("goto %N;\n", lab); accessible = FALSE; } break; case AST_DEFLAB: { int lab; // TO DO! Labels declarations in C cannot come after code. Unfortunately even when the Imp sources // happens to follow this restriction, if run-time line numbers are being output, those assignments // cause the label declaration to fail. detuple(tuple, &AST_check_op, &lab); dump_code("%N:;\n", lab); accessible = TRUE; } break; case AST_DEF_DEFAULTSWLAB: { // new icode added by GT ASTIDX sw; detuple(tuple, &AST_check_op, &sw); int tag = USERFIELD(sw, 0); STRING_CAPACITY(Descriptor[tag]) = 1; // Make a note that this switch // has had it's default set. dump_code("%N_default:;\n", sw); accessible = TRUE; } break; case AST_DEF_SWLAB: { ASTIDX tag, const_switch_index_ast; detuple(tuple, &AST_check_op, &tag, &const_switch_index_ast); // Note: no special handling needed at this level for SW(*): - handled in i2c.c (eventually) if (OP(const_switch_index_ast) == AST_ICONST) { ASTIDX checkop; int iconst; detuple(const_switch_index_ast, &checkop, &iconst); if (iconst < 0) { dump_code("%N_M_%d:;\n", tag, -iconst); } else { dump_code("%N_%d:;\n", tag, iconst); } } else { dump_code("%N_%N:; /*SHOULD NOT HAPPEN*/\n", tag, const_switch_index_ast); } accessible = TRUE; } break; case AST_GOTO_SWLAB: { ASTIDX tag_check_op; ASTIDX tag, switch_index_ast, bounds; ASTIDX Lower, Upper; detuple(tuple, &AST_check_op, &tag, &switch_index_ast); //if (REQUIRES_AUTO_DEREF(switch_index_ast)) switch_index_ast = mktuple(AST_INDIRECT_THROUGH, switch_index_ast); bounds = BOUNDS1D(tag); detuple(bounds, &tag_check_op, &Lower, &Upper); int LB, UB; LB = USERFIELD(Lower, 0); UB = USERFIELD(Upper, 0); char *swname_c = pooltostr(C_NAME_IDX(tag)); char *swname_imp = pooltostr(IMP_NAME_IDX(tag)); dump_code("%s_idx = %V; ", swname_c, switch_index_ast); // At this point we could output "%s_dispatch:" and on subsequent ->sw() calls, jump here instead. // However this does require keeping an extra flag associated with the switch to record whether // the displatch jump has already been generated or not. But def. would be neater of there are // multiple jumps to the same switch. As long as the jump comes after assigning to the index, // and _imp_current_{line,file} are assigned so that a missing label failure is properly reported... int need_range_test = 1; if (IS_ICONST(switch_index_ast)) { int actual_index = USERFIELD(switch_index_ast, 0); if ((LB <= actual_index) && (actual_index <= UB)) need_range_test = 0; } if (need_range_test && PARM_CHECK) { // We can skip the range check for an in-range constant. The missing switch label check will still happen at the destination. dump_code("if ((%d <= %s_idx) && (%s_idx <= %d)) ", LB, swname_c, swname_c, UB); } if (LB == 0) { dump_code("goto *%s[%s_idx]; ", swname_c, swname_c); } else if (LB > 0) { dump_code("goto *(%s-%d)[%s_idx]; /* Bounds=%d:%d */ ", swname_c, LB, swname_c, LB, UB); } else { dump_code("goto *(%s+%d)[%s_idx]; /* Bounds=%d:%d */ ", swname_c, -LB, swname_c, LB, UB); } if (need_range_test && PARM_CHECK) { dump_code("else {\n" " /*_imp_signal(8, 2, %s_idx);*/\n" /* 6 -> RANGE ERROR */ " fprintf(stderr, \"%%%%SWITCH index %s(%%d) " "not in range %d:%d " "at %%s:%%d\\n\",\n %s_idx, " "(_imp_current_file != 0 ? _imp_current_file : __FILE__),\n " "(_imp_current_line != 0 ? _imp_current_line : __LINE__));\n " "exit(1);\n" "}\n", swname_c, swname_imp, LB, UB, swname_c); } else { dump_code("\n"); } accessible = FALSE; } break; case AST_SEQ: { // Execute two statements sequentially. ASTIDX stmnt1, stmnt2; detuple(tuple, &AST_check_op, &stmnt1, &stmnt2); dump_code("%N%N", stmnt1, stmnt2); } break; case AST_COMMENT: { StrpoolIDX comment; detuple(tuple, &AST_check_op, &comment); dump_code("%s%s", comment_indent, pooltostr(comment)); } break; case AST_STOP: { dump_code("exit(0);\n"); // or _exit(0) or _imp_signal(0,0,0,"%stop")? accessible = FALSE; } break; case AST_FORMAL_PARAMETER_LIST: { int count; detuple(tuple, &AST_check_op, &count); if (count == 0) { dump_code("void"); } else { for (int i = 0; i < count; i++) { ASTIDX param = EXTRAFIELD(tuple, i); dump_code("%N", param); if (i < count - 1) dump_code(", "); } } } break; case AST_ACTUAL_PARAMETER: { // These are a temporary item that is pushed on the compiler stack every time // 'p' (ASSPAR) is passed. By the time we get to CALL we are instead looking // at an AST_ACTUAL_PARAMETER_LIST containing an array of these. ASTIDX param; detuple(tuple, &AST_check_op, ¶m); // TO DO: each parameter should be checked for unassigned if it is a simple scalar dump_code("%N", param); } break; case AST_IMP_LINE: { int line; StrpoolIDX file; detuple(tuple, &AST_check_op, &line, &file); show_source_code(line, pooltostr(file)); if (PARM_IMP_SOURCE_LINENOS) { // This may not be the best place to insert these because some of the statements // take more than one line, causing gcc to assign the line number+N as the line // in any error messages. sprintf(hashline, "#line %d \"%s\"\n", line, pooltostr(file)); if (blocklevel > 0) { // (can't output imperative statements at the external level) // this could be made optional but the runtime overhead isn't particularly // high, and it's useful for minimal imp-style runtime diagnostics when // not running under valgrind or gdb: // The gcc option to merge constants means all these current_file strings // don't take up lots of space. We *could* just output a file name when // the file changes (i.e. at the start and end of an include file) // Currently there's only one cirumstance where we don't want to output // these, which is when the next line contains a %label declaration. //if (!PARM_OPT) { // CURRENTLY REMOVING THIS SO THAT I CAN LOOK AT ARM DECODE WITHOUT SO MUCH CLUTTER. // THIS NEEDS TO BE PUT BACK UNDER A COMPILE-TIME FLAG PROPERLY. //dump_code("_imp_current_line = %d; ", line); // just 2 loads & stores. No string copying happening. So verbose but relatively efficient. //dump_code("_imp_current_file = \"%s\";\n", pooltostr(file)); //} } } } break; case AST_BOUNDSPAIR: { ASTIDX low, high; detuple(tuple, &AST_check_op, &low, &high); ASTIDX left = mktuple(AST_BINOP, '-', high, low); ASTIDX index = mktuple(AST_BINOP, '+', left, mktuple(AST_ICONST, 1)); dump_code("[%N]", index); } break; case AST_DOPEVECTOR: { int dims; detuple(tuple, &AST_check_op, &dims); //dump_code("/*DV:%d*/", dims); //for (int dim = 0; dim < dims; dim++) { // right to left order -- see comments at AST_DYNAMICARRAY: for (int dim = dims-1; dim >= 0; dim--) { // left to right order dump_code("%N", EXTRAFIELD(tuple, dim)); } } break; case AST_CONTROL: { int ctrl; /* %CONTROL: Bit significance of the fields in the %control word are given below. Bit set turns checking on. Bit clear disables the check. (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') */ detuple(tuple, &AST_check_op, &ctrl); dump_code("#ifdef _IMP_CONTROL\n"); dump_code("#undef _IMP_CONTROL\n"); dump_code("#endif // _IMP_CONTROL\n"); dump_code("#define _IMP_CONTROL %d\n", ctrl); _imp_control = ctrl; } break; case AST_DIAGNOSE: { int diag; detuple(tuple, &AST_check_op, &diag); dump_code("#ifdef _IMP_DIAGNOSE\n"); dump_code("#undef _IMP_DIAGNOSE %d\n", diag); dump_code("#endif // _IMP_DIAGNOSE\n"); dump_code("#define _IMP_DIAGNOSE %d\n", diag); _imp_diagnose = diag; } break; case AST_MONITOR: { int mon = 0; // NOTE: imp77 does not support "%monitor n" or "%monitorstop". // It just accepts "%monitor" or "%monitor %and %stop"... // (or %and %monitor) detuple(tuple, &AST_check_op, &mon); dump_code("_imp_monitor(%d, (_imp_current_line != 0 ? _imp_current_line : __LINE__), (_imp_current_file != 0 ? _imp_current_file : __FILE__), __PRETTY_FUNCTION__);\n", mon); } break; case AST_SIGNAL: { ASTIDX event, subevent, extra; detuple(tuple, &AST_check_op, &event, &subevent, &extra); // subevent and extra may be expressions, event must be a literal. dump_code("_imp_signal(%N, %N, %N, \"\");\n", event, subevent, extra); } break; case AST_DIVZERO_CHECK: { ASTIDX var; detuple(tuple, &AST_check_op, &var); // for now integer only. But we ought to be able to add reals easily. /* TO DO: insert checks if "-g" or "--checks" given, but not if "--opt" or "--no-checks" */ if (PARM_UNASS == FALSE) { dump_code("%N", var); } else if (BASE_TYPE(var) == T_REAL) { dump_code("_ZR(%N)", var); } else { dump_code("_Z(%N)", var); } } break; default: codegen_data(tuple); } // end of switch }