/[ascend]/trunk/base/generic/compiler/instantiate.c
ViewVC logotype

Diff of /trunk/base/generic/compiler/instantiate.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 183 by johnpye, Fri Jan 13 02:35:00 2006 UTC revision 530 by johnpye, Sat Apr 22 07:52:30 2006 UTC
# Line 29  Line 29 
29   *   *
30   */   */
31  #include <stdarg.h>  #include <stdarg.h>
32  #include "utilities/ascConfig.h"  #include <utilities/ascConfig.h>
33  #include "utilities/ascMalloc.h"  #include <utilities/ascMalloc.h>
34  #include "utilities/ascPanic.h"  #include <utilities/ascPanic.h>
35  #include "general/pool.h"  #include <general/pool.h>
36  #include "general/list.h"  #include <general/list.h>
37  #include "general/dstring.h"  #include <general/dstring.h>
38  #include "compiler/compiler.h"  #include "compiler.h"
39  #if TIMECOMPILER  #if TIMECOMPILER
40  #include <time.h>  #include <time.h>
41  #include "general/tm_time.h"  #include <general/tm_time.h>
42  #endif  #endif
43  #include "compiler/bit.h"  #include "bit.h"
44  #include "compiler/symtab.h"  #include "symtab.h"
45  #include "compiler/fractions.h"  #include "fractions.h"
46  #include "compiler/dimen.h"  #include "dimen.h"
47  #include "compiler/functype.h"  #include "functype.h"
48  #include "compiler/types.h"  #include "types.h"
49  #include "compiler/instance_enum.h"  #include "instance_enum.h"
50  #include "compiler/stattypes.h"  #include "stattypes.h"
51  #include "compiler/statement.h"  #include "statement.h"
52  #include "compiler/child.h"  #include "child.h"
53  #include "compiler/type_desc.h"  #include "type_desc.h"
54  #include "compiler/type_descio.h"  #include "type_descio.h"
55  #include "compiler/module.h"  #include "module.h"
56  #include "compiler/library.h"  #include "library.h"
57  #include "compiler/sets.h"  #include "sets.h"
58  #include "compiler/setio.h"  #include "setio.h"
59  #include "compiler/extfunc.h"  #include "extfunc.h"
60  #include "compiler/extcall.h"  #include "extcall.h"
61  #include "compiler/dimen.h"  #include "dimen.h"
62  #include "compiler/forvars.h"  #include "forvars.h"
63  #include "compiler/exprs.h"  #include "exprs.h"
64  #include "compiler/name.h"  #include "name.h"
65  #include "compiler/nameio.h"  #include "nameio.h"
66  #include "compiler/vlist.h"  #include "vlist.h"
67  #include "compiler/slist.h"  #include "slist.h"
68  #include "compiler/evaluate.h"  #include "evaluate.h"
69  #include "compiler/value_type.h"  #include "value_type.h"
70  #include "compiler/statio.h"  #include "statio.h"
71  #include "compiler/pending.h"  #include "pending.h"
72  #include "compiler/find.h"  #include "find.h"
73  #include "compiler/relation_type.h"  #include "relation_type.h"
74  #include "compiler/relation.h"  #include "relation.h"
75  #include "compiler/logical_relation.h"  #include "logical_relation.h"
76  #include "compiler/logrelation.h"  #include "logrelation.h"
77  #include "compiler/relation_util.h"  #include "relation_util.h"
78  #include "compiler/logrel_util.h"  #include "logrel_util.h"
79  #include "compiler/instance_types.h"  #include "instance_types.h"
80  #include "compiler/cmpfunc.h"  #include "cmpfunc.h"
81  #include "compiler/instance_io.h"  #include "instance_io.h"
82  #include "compiler/when.h"  #include "when.h"
83  #include "compiler/case.h"  #include "case.h"
84  #include "compiler/when_util.h"  #include "when_util.h"
85  #include "compiler/select.h"  #include "select.h"
86  /* new headers */  /* new headers */
87  #include "compiler/atomvalue.h"  #include "atomvalue.h"
88  #include "compiler/arrayinst.h"  #include "arrayinst.h"
89  #include "compiler/copyinst.h"  #include "copyinst.h"
90  #include "compiler/createinst.h"  #include "createinst.h"
91  #include "compiler/destroyinst.h"  #include "destroyinst.h"
92  #include "compiler/extinst.h"  #include "extinst.h"
93  #include "compiler/visitinst.h"  #include "visitinst.h"
94  #include "compiler/instquery.h"  #include "instquery.h"
95  #include "compiler/mathinst.h"  #include "mathinst.h"
96  #include "compiler/mergeinst.h"  #include "mergeinst.h"
97  #include "compiler/parentchild.h"  #include "parentchild.h"
98  #include "compiler/refineinst.h"  #include "refineinst.h"
99  #include "compiler/check.h"  #include "check.h"
100  #include "compiler/instance_name.h"  #include "instance_name.h"
101  #include "compiler/setinstval.h"  #include "setinstval.h"
102  #include "compiler/anontype.h"  #include "anontype.h"
103  #include "compiler/anoncopy.h"  #include "anoncopy.h"
104  #include "compiler/parpend.h"  #include "parpend.h"
105  #include "compiler/parpend.h"  #include "parpend.h"
106  #include "compiler/bintoken.h"  #include "bintoken.h"
107  #include "compiler/watchpt.h"  #include "watchpt.h"
108  #include "compiler/initialize.h"  #include "initialize.h"
109  #include "compiler/instantiate.h"  #include "instantiate.h"
110  /* don't even THINK ABOUT adding instmacro.h to this list */  /* don't even THINK ABOUT adding instmacro.h to this list */
111    
112  #define MAXNUMBER 4     /* maximum number of iterations allowed  #define MAXNUMBER 4     /* maximum number of iterations allowed
# Line 136  static int g_iteration = 0;    /* the curre Line 136  static int g_iteration = 0;    /* the curre
136  /* moved from tcltk98/generic/interface/SimsProc.c */  /* moved from tcltk98/generic/interface/SimsProc.c */
137  struct Instance *g_cursim;  struct Instance *g_cursim;
138    
139    #define NEW_ext 1
140    #define OLD_ext 0
141  /*************************************************************************\  /*************************************************************************\
142  variable to check agreement in the number of boolean, integer or symbol  variable to check agreement in the number of boolean, integer or symbol
143  variables in the WHEN/SELECT statement with the number of boolean, integer  variables in the WHEN/SELECT statement with the number of boolean, integer
# Line 147  or symbol values in each of the CASEs Line 149  or symbol values in each of the CASEs
149  /*  /*
150   * Variables to switch old and new pass 2 instantiation.   * Variables to switch old and new pass 2 instantiation.
151   * The condition for using new pass 2 (anonymous type-based   * The condition for using new pass 2 (anonymous type-based
152   * relation copying) is g_use_copyanon != 0   * relation copying) is g_use_copyanon != 0
153   * || FORCE applied.   * || FORCE applied.
154   */   */
155    
156  int g_use_copyanon = 1;  int g_use_copyanon = 1;
157  /* g_use_copyanon is the user switch for anonymous type based relation  /* g_use_copyanon is the user switch for anonymous type based relation
158   * copying. if 0, no copying by that method is done.   * copying. if 0, no copying by that method is done.
159   */   */
160    
161  #if TIMECOMPILER  #if TIMECOMPILER
# Line 177  long int g_compiler_counter = 1; Line 179  long int g_compiler_counter = 1;
179   * which changes the instance tree is called.   * which changes the instance tree is called.
180   */   */
181    
182  /* #define DEBUG_RELS */  #define DEBUG_RELS
183  /* undef DEBUG_RELS if you want less spew in pass 2 */  /* undef DEBUG_RELS if you want less spew in pass 2 */
184    
185  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
# Line 324  void WriteStatementLocation(FILE *f, str Line 326  void WriteStatementLocation(FILE *f, str
326  static  static
327  void WriteSetError(struct Statement *statement, struct TypeDescription *def)  void WriteSetError(struct Statement *statement, struct TypeDescription *def)
328  {  {
329    WSEM(ASCERR,statement, (GetBaseType(def) == set_type) ?    STATEMENT_ERROR(statement, (GetBaseType(def) == set_type) ?
330                               "No set type specified in IS_A statement"                               "No set type specified in IS_A statement"
331                               : "Set type specified for a non-set type");                               : "Set type specified for a non-set type");
332  }  }
# Line 381  int CalcSetType(symchar *c, struct State Line 383  int CalcSetType(symchar *c, struct State
383      case integer_constant_type: return 1;      case integer_constant_type: return 1;
384      case symbol_constant_type: return 0;      case symbol_constant_type: return 0;
385      default:      default:
386        WSEM(ASCERR,statement, "Incorrect set type in IS_A");        STATEMENT_ERROR(statement, "Incorrect set type in IS_A");
387        /* lint should keep us from ever getting here */        /* lint should keep us from ever getting here */
388        return -2;        return -2;
389      }      }
390    } else{    } else{
391      WSEM(ASCERR,statement, "Unable to determine type of set.");      STATEMENT_ERROR(statement, "Unable to determine type of set.");
392      return -2;      return -2;
393    }    }
394  }  }
# Line 395  int CalcSetType(symchar *c, struct State Line 397  int CalcSetType(symchar *c, struct State
397   * probably should check constantness too but does not.   * probably should check constantness too but does not.
398   * return 0 if ok, 1 if not.   * return 0 if ok, 1 if not.
399   */   */
400  static  static
401  int CheckSetVal(struct value_t setval)  int CheckSetVal(struct value_t setval)
402  {  {
403    if (ValueKind(setval) != set_value) {    if (ValueKind(setval) != set_value) {
# Line 519  void SignalChildExpansionFailure(struct Line 521  void SignalChildExpansionFailure(struct
521    }    }
522    if (StatInFOR(statement)) {    if (StatInFOR(statement)) {
523      MarkStatContext(statement,context_WRONG);      MarkStatContext(statement,context_WRONG);
524      WSEM(ASCERR,statement, "Add another FOR index. In FOR loops,"      STATEMENT_ERROR(statement, "Add another FOR index. In FOR loops,"
525           " all array subscripts must be scalar values, not sets.");           " all array subscripts must be scalar values, not sets.");
526      WSS(ASCERR,statement);      WSS(ASCERR,statement);
527    } else {    } else {
528      MarkStatContext(statement,context_WRONG);      MarkStatContext(statement,context_WRONG);
529      WSEM(ASCERR,statement, "Subscripts of conflicting or incorrect types"      STATEMENT_ERROR(statement, "Subscripts of conflicting or incorrect types"
530           " in rectangular array.");           " in rectangular array.");
531      WSS(ASCERR,statement);      WSS(ASCERR,statement);
532    }    }
# Line 805  struct IndexType *MakeIndex(struct Insta Line 807  struct IndexType *MakeIndex(struct Insta
807      case set_value:      case set_value:
808      case list_value:      case list_value:
809        if (last==0) {        if (last==0) {
810          WSEM(ASCERR,stat, "Index to sparse array is of an incorrect type");          STATEMENT_ERROR(stat, "Index to sparse array is of an incorrect type");
811          DestroyValue(&value);          DestroyValue(&value);
812          return NULL;          return NULL;
813        } else {        } else {
# Line 839  struct IndexType *MakeIndex(struct Insta Line 841  struct IndexType *MakeIndex(struct Insta
841        DestroyValue(&value);        DestroyValue(&value);
842        return NULL;        return NULL;
843      default:      default:
844        WSEM(ASCERR,stat, "Unknown result value type in MakeIndex.\n");        STATEMENT_ERROR(stat, "Unknown result value type in MakeIndex.\n");
845        Asc_Panic(2, NULL, "Unknown result value type in MakeIndex.\n");        Asc_Panic(2, NULL, "Unknown result value type in MakeIndex.\n");
846        exit(2);/* Needed to keep gcc from whining */        exit(2);/* Needed to keep gcc from whining */
847      }      }
# Line 867  struct IndexType *MakeIndex(struct Insta Line 869  struct IndexType *MakeIndex(struct Insta
869        }        }
870      default:      default:
871        DestroyValue(&value);        DestroyValue(&value);
872        WSEM(ASCERR,stat, "Bad index to dense alias array");        STATEMENT_ERROR(stat, "Bad index to dense alias array");
873        Asc_Panic(2, NULL, "Bad index to dense alias array");        Asc_Panic(2, NULL, "Bad index to dense alias array");
874        exit(2);/* Needed to keep gcc from whining */        exit(2);/* Needed to keep gcc from whining */
875      }      }
# Line 1003  struct Instance *DoNextArray(struct Inst Line 1005  struct Instance *DoNextArray(struct Inst
1005    case boolean_value:    case boolean_value:
1006    case list_value:    case list_value:
1007      if (last==0) {      if (last==0) {
1008        WSEM(ASCERR,stat, "Index to array is of an incorrect type");        STATEMENT_ERROR(stat, "Index to array is of an incorrect type");
1009        DestroyValue(&value);        DestroyValue(&value);
1010        return NULL;        return NULL;
1011      } else {      } else {
# Line 1033  struct Instance *DoNextArray(struct Inst Line 1035  struct Instance *DoNextArray(struct Inst
1035      case name_unfound:      case name_unfound:
1036        break;        break;
1037      default:      default:
1038        WSEM(ASCERR,stat, "Error in array indices");        STATEMENT_ERROR(stat, "Error in array indices");
1039        break;        break;
1040      }      }
1041      DestroyValue(&value);      DestroyValue(&value);
# Line 1134  struct Instance *MakeSparseArray(struct Line 1136  struct Instance *MakeSparseArray(struct
1136                                   intset,0,0,0,indices);                                   intset,0,0,0,indices);
1137        break;        break;
1138      default:      default:
1139        WSEM(ASCERR,stat, "Utter screw-up in MakeSparseArray");        STATEMENT_ERROR(stat, "Utter screw-up in MakeSparseArray");
1140        Asc_Panic(2, NULL, "Utter screw-up in MakeSparseArray");        Asc_Panic(2, NULL, "Utter screw-up in MakeSparseArray");
1141      }      }
1142      aryinst = CreateArrayInstance(desc,1);      aryinst = CreateArrayInstance(desc,1);
# Line 1175  void MakeAliasInstance(CONST struct Name Line 1177  void MakeAliasInstance(CONST struct Name
1177      /* case of simple part name */      /* case of simple part name */
1178      if (StatInFOR(statement) && StatWrong(statement)==0) {      if (StatInFOR(statement) && StatWrong(statement)==0) {
1179        MarkStatContext(statement,context_WRONG);        MarkStatContext(statement,context_WRONG);
1180        WSEM(ASCERR,statement,"Unindexed statement in FOR loop not allowed.");        STATEMENT_ERROR(statement,"Unindexed statement in FOR loop not allowed.");
1181        WSS(ASCERR,statement);        WSS(ASCERR,statement);
1182        return;        return;
1183      }      }
# Line 1198  void MakeAliasInstance(CONST struct Name Line 1200  void MakeAliasInstance(CONST struct Name
1200                                strlen(REDEFINE_CHILD_MESG2)+1);                                strlen(REDEFINE_CHILD_MESG2)+1);
1201          strcpy(msg,REDEFINE_CHILD_MESG2);          strcpy(msg,REDEFINE_CHILD_MESG2);
1202          strcat(msg,SCP(childname));          strcat(msg,SCP(childname));
1203          WSEM(ASCERR,statement,msg);          STATEMENT_ERROR(statement,msg);
1204          ascfree(msg);          ascfree(msg);
1205        }        }
1206      } else{         /* unknown child name */      } else{         /* unknown child name */
1207        /* case of part not expected */        /* case of part not expected */
1208        WSEM(ASCERR,statement, "Unknown child name.  Never should happen");        STATEMENT_ERROR(statement, "Unknown child name.  Never should happen");
1209        Asc_Panic(2, NULL, "Unknown child name.  Never should happen");        Asc_Panic(2, NULL, "Unknown child name.  Never should happen");
1210      }      }
1211    } else{    } else{
# Line 1235  void MakeAliasInstance(CONST struct Name Line 1237  void MakeAliasInstance(CONST struct Name
1237                SignalChildExpansionFailure(parent,pos);                SignalChildExpansionFailure(parent,pos);
1238              }              }
1239            } else {            } else {
1240              WSEM(ASCERR,statement, "Unable to create alias array instance");              STATEMENT_ERROR(statement, "Unable to create alias array instance");
1241              Asc_Panic(2, NULL, "Unable to create alias array instance");              Asc_Panic(2, NULL, "Unable to create alias array instance");
1242            }            }
1243          } else {          } else {
1244            DeleteTypeDesc(arydef);            DeleteTypeDesc(arydef);
1245            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
1246                 "Unknown array child name. Never should happen");                 "Unknown array child name. Never should happen");
1247            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");
1248          }          }
# Line 1261  void MakeAliasInstance(CONST struct Name Line 1263  void MakeAliasInstance(CONST struct Name
1263                                   rhsinst,NULL,rhslist);                                   rhsinst,NULL,rhslist);
1264            }            }
1265          } else {          } else {
1266            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
1267              "Unknown array child name. Never should happen");              "Unknown array child name. Never should happen");
1268            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");
1269          }          }
# Line 1270  void MakeAliasInstance(CONST struct Name Line 1272  void MakeAliasInstance(CONST struct Name
1272        /* bad child name. cannot create parts of parts. should never        /* bad child name. cannot create parts of parts. should never
1273         * happen, being trapped out in typelint.         * happen, being trapped out in typelint.
1274         */         */
1275        WSEM(ASCERR,statement,"Bad ALIASES child name.");        STATEMENT_ERROR(statement,"Bad ALIASES child name.");
1276      }      }
1277    }    }
1278  }  }
# Line 1307  int ExecuteALIASES(struct Instance *inst Line 1309  int ExecuteALIASES(struct Instance *inst
1309      return 0; /* rhs not compiled yet */      return 0; /* rhs not compiled yet */
1310    }    }
1311    if (gl_length(rhslist)>1) {    if (gl_length(rhslist)>1) {
1312      WSEM(ASCERR,statement,"ALIASES needs exactly 1 RHS");      STATEMENT_ERROR(statement,"ALIASES needs exactly 1 RHS");
1313      gl_destroy(rhslist);      gl_destroy(rhslist);
1314      return 1; /* rhs not unique for current values of sets */      return 1; /* rhs not unique for current values of sets */
1315    }    }
1316    rhsinst = (struct Instance *)gl_fetch(rhslist,1);    rhsinst = (struct Instance *)gl_fetch(rhslist,1);
1317    gl_destroy(rhslist);    gl_destroy(rhslist);
1318    if (InstanceKind(rhsinst)==REL_INST || LREL_INST ==InstanceKind(rhsinst)) {    if (InstanceKind(rhsinst)==REL_INST || LREL_INST ==InstanceKind(rhsinst)) {
1319      WSEM(ASCERR,statement,"Direct ALIASES of relations are not permitted");      STATEMENT_ERROR(statement,"Direct ALIASES of relations are not permitted");
1320      MarkStatContext(statement,context_WRONG);      MarkStatContext(statement,context_WRONG);
1321      WSS(ASCERR,statement);      WSS(ASCERR,statement);
1322      return 1; /* relations only aliased through models */      return 1; /* relations only aliased through models */
# Line 1512  struct value_t ComputeArrayElements(stru Line 1514  struct value_t ComputeArrayElements(stru
1514            "Undefined values in WITH_VALUE () list");            "Undefined values in WITH_VALUE () list");
1515          return CreateErrorValue(undefined_value);          return CreateErrorValue(undefined_value);
1516        default:        default:
1517          WSEM(ASCERR,statement,"Bad result in evaluating WITH_VALUE list\n");          STATEMENT_ERROR(statement,"Bad result in evaluating WITH_VALUE list\n");
1518          MarkStatContext(statement,context_WRONG);          MarkStatContext(statement,context_WRONG);
1519          WSS(ASCERR,statement);          WSS(ASCERR,statement);
1520          DestroyValue(&subslist);          DestroyValue(&subslist);
# Line 1530  struct value_t ComputeArrayElements(stru Line 1532  struct value_t ComputeArrayElements(stru
1532         ) {         ) {
1533        DestroyValue(&result);        DestroyValue(&result);
1534        DestroyValue(&subscripts);        DestroyValue(&subscripts);
1535        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
1536          "WITH_VALUE list does not form a proper subscript set.\n");          "WITH_VALUE list does not form a proper subscript set.\n");
1537        MarkStatContext(statement,context_WRONG);        MarkStatContext(statement,context_WRONG);
1538        WSS(ASCERR,statement);        WSS(ASCERR,statement);
# Line 1538  struct value_t ComputeArrayElements(stru Line 1540  struct value_t ComputeArrayElements(stru
1540      }      }
1541      /* check sanity of values. may need fixing around empty set. */      /* check sanity of values. may need fixing around empty set. */
1542      if ( (SetKind(SetValue(subscripts))==integer_set) != (intset!=0)) {      if ( (SetKind(SetValue(subscripts))==integer_set) != (intset!=0)) {
1543        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
1544          "Unable to construct set. Values and set type mismatched\n");          "Unable to construct set. Values and set type mismatched\n");
1545        DestroyValue(&result);        DestroyValue(&result);
1546        DestroyValue(&subscripts);        DestroyValue(&subscripts);
# Line 1548  struct value_t ComputeArrayElements(stru Line 1550  struct value_t ComputeArrayElements(stru
1550      }      }
1551      /* check set size == instances to alias */      /* check set size == instances to alias */
1552      if (Cardinality(SetValue(subscripts)) != len) {      if (Cardinality(SetValue(subscripts)) != len) {
1553        WSEM(ASCERR,statement,"In: ");        STATEMENT_ERROR(statement,"In: ");
1554        FPRINTF(ASCERR,        FPRINTF(ASCERR,
1555          "WITH_VALUE list length (%lu) != number of instances given (%lu)\n",          "WITH_VALUE list length (%lu) != number of instances given (%lu)\n",
1556          Cardinality(SetValue(subscripts)),len);          Cardinality(SetValue(subscripts)),len);
# Line 1624  int ExecuteARR(struct Instance *inst, st Line 1626  int ExecuteARR(struct Instance *inst, st
1626    if (gl_length(rhsinstlist) >0) {    if (gl_length(rhsinstlist) >0) {
1627      rhsinst = (struct Instance *)gl_fetch(rhsinstlist,1);      rhsinst = (struct Instance *)gl_fetch(rhsinstlist,1);
1628      if (BaseTypeIsEquation(InstanceTypeDesc(rhsinst))) {      if (BaseTypeIsEquation(InstanceTypeDesc(rhsinst))) {
1629        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
1630          "Direct ALIASES of rels/lrels/whens are not permitted");          "Direct ALIASES of rels/lrels/whens are not permitted");
1631        MarkStatContext(statement,context_WRONG);        MarkStatContext(statement,context_WRONG);
1632        WSS(ASCERR,statement);        WSS(ASCERR,statement);
# Line 1757  struct Instance *MakeSimpleInstance(stru Line 1759  struct Instance *MakeSimpleInstance(stru
1759        break;        break;
1760      case relation_type:      case relation_type:
1761        inst = NULL;        inst = NULL;
1762        FPRINTF(ASCERR,"Type '%s' is not allowed in IS_A.\n",        FPRINTF(ASCERR,"Type '%s' is not allowed in IS_A.\n",
1763                SCP(GetBaseTypeName(relation_type)));                SCP(GetBaseTypeName(relation_type)));
1764      case logrel_type:      case logrel_type:
1765        inst = NULL;        inst = NULL;
# Line 1771  struct Instance *MakeSimpleInstance(stru Line 1773  struct Instance *MakeSimpleInstance(stru
1773        break;        break;
1774      case array_type:      case array_type:
1775      default: /* picks up patch_type */      default: /* picks up patch_type */
1776        WSEM(ASCERR,statement, "MakeSimpleInstance error. PATCH/ARRAY found.\n");        STATEMENT_ERROR(statement, "MakeSimpleInstance error. PATCH/ARRAY found.\n");
1777        Asc_Panic(2, NULL,  "MakeSimpleInstance error. PATCH/ARRAY found.\n");        Asc_Panic(2, NULL,  "MakeSimpleInstance error. PATCH/ARRAY found.\n");
1778      }      }
1779    }    }
# Line 1907  int ArrayElementsTypeCompatible(CONST st Line 1909  int ArrayElementsTypeCompatible(CONST st
1909      if (InstanceKind(i) == SET_ATOM_INST) {      if (InstanceKind(i) == SET_ATOM_INST) {
1910        /* both should be of same type "set" */        /* both should be of same type "set" */
1911        if (atype!=ptype ||        if (atype!=ptype ||
1912            (IntegerSetInstance(i)==0 &&            (IntegerSetInstance(i)==0 &&
1913             stype == GetBaseTypeName(integer_constant_type))             stype == GetBaseTypeName(integer_constant_type))
1914            || (IntegerSetInstance(i)==1 &&            || (IntegerSetInstance(i)==1 &&
1915                stype == GetBaseTypeName(symbol_constant_type))                stype == GetBaseTypeName(symbol_constant_type))
1916           ) {           ) {
1917          /* set type mismatch */          /* set type mismatch */
# Line 2220  int MPICheckConstraint(struct Instance * Line 2222  int MPICheckConstraint(struct Instance *
2222      default:      default:
2223        /* it questionable whether this is a correct action in all cases*/        /* it questionable whether this is a correct action in all cases*/
2224        /* we could probably turn out more useful error messages here */        /* we could probably turn out more useful error messages here */
2225        WSEM(ASCERR,statement, "Condition doesn't make sense.");        STATEMENT_ERROR(statement, "Condition doesn't make sense.");
2226        DestroyValue(&value);        DestroyValue(&value);
2227        return MPIBADREL;        return MPIBADREL;
2228      }      }
# Line 2231  int MPICheckConstraint(struct Instance * Line 2233  int MPICheckConstraint(struct Instance *
2233          return MPIOK;          return MPIOK;
2234        } else {        } else {
2235          DestroyValue(&value);          DestroyValue(&value);
2236          WSEM(ASCERR,statement, "Arguments do not conform to requirements");          STATEMENT_ERROR(statement, "Arguments do not conform to requirements");
2237          return MPIBADREL;          return MPIBADREL;
2238        }        }
2239      } else {      } else {
2240        DestroyValue(&value);        DestroyValue(&value);
2241        WSEM(ASCERR,statement, "Requirements cannot be satisfied by variables");        STATEMENT_ERROR(statement, "Requirements cannot be satisfied by variables");
2242        return MPIVARREL;        return MPIVARREL;
2243      }      }
2244    default:    default:
2245      DestroyValue(&value);      DestroyValue(&value);
2246      WSEM(ASCERR,statement, "Constraint does not evaluate to boolean result.");      STATEMENT_ERROR(statement, "Constraint does not evaluate to boolean result.");
2247      return MPINOTBOOL;      return MPINOTBOOL;
2248    }    }
2249  }  }
# Line 2308  int InsertParameterInst(struct Instance Line 2310  int InsertParameterInst(struct Instance
2310                strlen(REDEFINE_CHILD_MESG)+1);                strlen(REDEFINE_CHILD_MESG)+1);
2311        strcpy(msg,REDEFINE_CHILD_MESG);        strcpy(msg,REDEFINE_CHILD_MESG);
2312        strcat(msg,SCP(childname));        strcat(msg,SCP(childname));
2313        WSEM(ASCERR,statement,msg);        STATEMENT_ERROR(statement,msg);
2314        ascfree(msg);        ascfree(msg);
2315        return 0;        return 0;
2316      }      }
2317    } else {          /* unknown name */    } else {          /* unknown name */
2318      WSEM(ASCERR,statement, "Unknown parameter name.  Never should happen");      STATEMENT_ERROR(statement, "Unknown parameter name.  Never should happen");
2319      Asc_Panic(2, NULL, "Unknown parameter name.  Never should happen");      Asc_Panic(2, NULL, "Unknown parameter name.  Never should happen");
2320      exit(2);/* Needed to keep gcc from whining */      exit(2);/* Needed to keep gcc from whining */
2321    }    }
# Line 2380  void mpierror(struct Set *argset, Line 2382  void mpierror(struct Set *argset,
2382      WriteSet(ASCERR,argset);      WriteSet(ASCERR,argset);
2383      FPRINTF(ASCERR,"\n");      FPRINTF(ASCERR,"\n");
2384    }    }
2385    WSEM(ASCERR,statement,"Error in executing statement:");    STATEMENT_ERROR(statement,"Error in executing statement:");
2386    MarkStatContext(statement,context_WRONG);    MarkStatContext(statement,context_WRONG);
2387    WSS(ASCERR,statement);    WSS(ASCERR,statement);
2388  }  }
# Line 2917  int MPICheckWBTS(struct Instance *tmpins Line 2919  int MPICheckWBTS(struct Instance *tmpins
2919      switch(err){      switch(err){
2920      case impossible_instance:      case impossible_instance:
2921        MissingInsts(tmpinst,GetStatVarList(statement),1);        MissingInsts(tmpinst,GetStatVarList(statement),1);
2922        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
2923          "WILL_BE_THE_SAME statement contains an impossible instance name");          "WILL_BE_THE_SAME statement contains an impossible instance name");
2924        return MPIBADWBTS;        return MPIBADWBTS;
2925      default:      default:
# Line 2937  int MPICheckWBTS(struct Instance *tmpins Line 2939  int MPICheckWBTS(struct Instance *tmpins
2939            MoreRefined(InstanceTypeDesc(gl_fetch(instances,c)),            MoreRefined(InstanceTypeDesc(gl_fetch(instances,c)),
2940                        InstanceTypeDesc(head))==NULL) {                        InstanceTypeDesc(head))==NULL) {
2941          /* can't be merged later */          /* can't be merged later */
2942          WSEM(ASCERR,statement,          STATEMENT_ERROR(statement,
2943            "WILL_BE_THE_SAME statement contains incompatible instances");            "WILL_BE_THE_SAME statement contains incompatible instances");
2944          gl_destroy(instances);          gl_destroy(instances);
2945          return MPIBADWBTS;          return MPIBADWBTS;
# Line 2975  int MPICheckWNBTS(struct Instance *tmpin Line 2977  int MPICheckWNBTS(struct Instance *tmpin
2977      switch(err){      switch(err){
2978      case impossible_instance:      case impossible_instance:
2979        MissingInsts(tmpinst,GetStatVarList(statement),1);        MissingInsts(tmpinst,GetStatVarList(statement),1);
2980        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
2981          "WILL_NOT_BE_THE_SAME statement contains an impossible instance name");          "WILL_NOT_BE_THE_SAME statement contains an impossible instance name");
2982        return MPIBADWNBTS;        return MPIBADWNBTS;
2983      default:      default:
# Line 2986  int MPICheckWNBTS(struct Instance *tmpin Line 2988  int MPICheckWNBTS(struct Instance *tmpin
2988      }      }
2989    }    }
2990    if (gl_unique_list(instances)==0) {    if (gl_unique_list(instances)==0) {
2991      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
2992            "WILL_NOT_BE_THE_SAME statement contains"            "WILL_NOT_BE_THE_SAME statement contains"
2993           " identical/merged instances");           " identical/merged instances");
2994      gl_destroy(instances);      gl_destroy(instances);
# Line 3015  int CheckWhereFOR(struct Instance *inst, Line 3017  int CheckWhereFOR(struct Instance *inst,
3017    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
3018    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
3019    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
3020      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
3021      return MPIFOR;      return MPIFOR;
3022    }    }
3023    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 3028  int CheckWhereFOR(struct Instance *inst, Line 3030  int CheckWhereFOR(struct Instance *inst,
3030      case name_unfound:      case name_unfound:
3031      case undefined_value:      case undefined_value:
3032        DestroyValue(&value);        DestroyValue(&value);
3033        WSEM(ASCERR,statement, "FOR has undefined values");        STATEMENT_ERROR(statement, "FOR has undefined values");
3034        return MPIFOR; /* this maybe should be mpiwait? */        return MPIFOR; /* this maybe should be mpiwait? */
3035      default:      default:
3036        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 3866  void MakeInstance(CONST struct Name *nam Line 3868  void MakeInstance(CONST struct Name *nam
3868    struct TypeDescription *arydef;    struct TypeDescription *arydef;
3869    struct gl_list_t *indices;    struct gl_list_t *indices;
3870    int tce;    int tce;
3871      /*char *nstr;
3872      nstr = WriteNameString(name);
3873      CONSOLE_DEBUG(nstr);
3874      ascfree(nstr); */
3875    if ((childname = SimpleNameIdPtr(name))!=NULL){ /* simple 1 element name */    if ((childname = SimpleNameIdPtr(name))!=NULL){ /* simple 1 element name */
3876      if (StatInFOR(statement) && StatWrong(statement)==0) {      if (StatInFOR(statement) && StatWrong(statement)==0) {
3877        MarkStatContext(statement,context_WRONG);        MarkStatContext(statement,context_WRONG);
3878        WSEM(ASCERR,statement,"Unindexed statement in FOR loop not allowed.");        STATEMENT_ERROR(statement,"Unindexed statement in FOR loop not allowed.");
3879        WSS(ASCERR,statement);        WSS(ASCERR,statement);
3880        return;        return;
3881      }      }
# Line 3885  void MakeInstance(CONST struct Name *nam Line 3891  void MakeInstance(CONST struct Name *nam
3891                                strlen(REDEFINE_CHILD_MESG)+1);                                strlen(REDEFINE_CHILD_MESG)+1);
3892          strcpy(msg,REDEFINE_CHILD_MESG);          strcpy(msg,REDEFINE_CHILD_MESG);
3893          strcat(msg,SCP(childname));          strcat(msg,SCP(childname));
3894          WSEM(ASCERR,statement,msg);          STATEMENT_ERROR(statement,msg);
3895          ascfree(msg);          ascfree(msg);
3896        }        }
3897      } else {            /* unknown child name */      } else {            /* unknown child name */
3898        WSEM(ASCERR,statement, "Unknown child name.  Never should happen");        STATEMENT_ERROR(statement, "Unknown child name.  Never should happen");
3899        Asc_Panic(2, NULL, "Unknown child name.  Never should happen");        Asc_Panic(2, NULL, "Unknown child name.  Never should happen");
3900      }      }
3901    } else {    } else {
# Line 3915  void MakeInstance(CONST struct Name *nam Line 3921  void MakeInstance(CONST struct Name *nam
3921                SignalChildExpansionFailure(parent,pos);                SignalChildExpansionFailure(parent,pos);
3922              }              }
3923            } else {            } else {
3924              WSEM(ASCERR,statement, "Unable to create array instance");              STATEMENT_ERROR(statement, "Unable to create array instance");
3925              Asc_Panic(2, NULL, "Unable to create array instance");              Asc_Panic(2, NULL, "Unable to create array instance");
3926            }            }
3927          } else {          } else {
3928            DeleteTypeDesc(arydef);            DeleteTypeDesc(arydef);
3929            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
3930                 "Unknown array child name. Never should happen");                 "Unknown array child name. Never should happen");
3931            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");
3932          }          }
# Line 3937  void MakeInstance(CONST struct Name *nam Line 3943  void MakeInstance(CONST struct Name *nam
3943              (void)AddArrayChild(parent,name,statement,NULL,arginst,NULL);              (void)AddArrayChild(parent,name,statement,NULL,arginst,NULL);
3944            }            }
3945          } else {          } else {
3946            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
3947              "Unknown array child name. Never should happen");              "Unknown array child name. Never should happen");
3948            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");            Asc_Panic(2, NULL, "Unknown array child name. Never should happen");
3949          }          }
# Line 3946  void MakeInstance(CONST struct Name *nam Line 3952  void MakeInstance(CONST struct Name *nam
3952        /* bad child name. cannot create parts of parts.  should never        /* bad child name. cannot create parts of parts.  should never
3953         * happen, being trapped out in typelint.         * happen, being trapped out in typelint.
3954         */         */
3955        WSEM(ASCERR,statement,"Bad IS_A child name.");        STATEMENT_ERROR(statement,"Bad IS_A child name.");
3956      }      }
3957    }    }
3958  }  }
# Line 3993  int ExecuteISA(struct Instance *inst, st Line 3999  int ExecuteISA(struct Instance *inst, st
3999      }      }
4000      intset = CalcSetType(GetStatSetType(statement),statement);      intset = CalcSetType(GetStatSetType(statement),statement);
4001      if (intset < 0) { /* incorrect set type */      if (intset < 0) { /* incorrect set type */
4002        WSEM(ASCERR,statement,"Illegal set type encountered.");        STATEMENT_ERROR(statement,"Illegal set type encountered.");
4003        /* should never happen due to lint */        /* should never happen due to lint */
4004        return 0;        return 0;
4005      }      }
# Line 4014  int ExecuteISA(struct Instance *inst, st Line 4020  int ExecuteISA(struct Instance *inst, st
4020                            SCLEN(GetStatType(statement))+1);                            SCLEN(GetStatType(statement))+1);
4021      strcpy(msg,UNDEFINED_TYPE_MESG);      strcpy(msg,UNDEFINED_TYPE_MESG);
4022      strcat(msg,SCP(GetStatType(statement)));      strcat(msg,SCP(GetStatType(statement)));
4023      WSEM(ASCERR,statement,msg); /* added print. baa. string was here already*/      STATEMENT_ERROR(statement,msg); /* added print. baa. string was here already*/
4024      ascfree(msg);      ascfree(msg);
4025      return 1;      return 1;
4026    }    }
# Line 4053  void MakeDummyInstance(CONST struct Name Line 4059  void MakeDummyInstance(CONST struct Name
4059             strlen(REDEFINE_CHILD_MESG)+1);             strlen(REDEFINE_CHILD_MESG)+1);
4060        strcpy(msg,REDEFINE_CHILD_MESG);        strcpy(msg,REDEFINE_CHILD_MESG);
4061        strcat(msg,SCP(childname));        strcat(msg,SCP(childname));
4062        WSEM(ASCERR,statement,msg);        STATEMENT_ERROR(statement,msg);
4063        ascfree(msg);        ascfree(msg);
4064      }      }
4065    } else {          /* unknown child name */    } else {          /* unknown child name */
4066        WSEM(ASCERR,statement, "Unknown child name.  Never should happen");        STATEMENT_ERROR(statement, "Unknown child name.  Never should happen");
4067        Asc_Panic(2, NULL, "Unknown child name.  Never should happen");        Asc_Panic(2, NULL, "Unknown child name.  Never should happen");
4068    }    }
4069  }  }
# Line 4089  int ExecuteUnSelectedISA( struct Instanc Line 4095  int ExecuteUnSelectedISA( struct Instanc
4095      char *msg = ascmalloc(strlen(UNDEFINED_TYPE_MESG)+11);      char *msg = ascmalloc(strlen(UNDEFINED_TYPE_MESG)+11);
4096      strcpy(msg,UNDEFINED_TYPE_MESG);      strcpy(msg,UNDEFINED_TYPE_MESG);
4097      strcat(msg,"dummy_type");      strcat(msg,"dummy_type");
4098      WSEM(ASCERR,statement,msg);      STATEMENT_ERROR(statement,msg);
4099      ascfree(msg);      ascfree(msg);
4100      return 1;      return 1;
4101    }    }
# Line 4230  void MissingInsts(struct Instance *inst, Line 4236  void MissingInsts(struct Instance *inst,
4236      while(list!=NULL){      while(list!=NULL){
4237        temp = FindInstances(inst,NamePointer(list),&err);        temp = FindInstances(inst,NamePointer(list),&err);
4238        if (temp==NULL){        if (temp==NULL){
4239          error_reporter_start(ASC_USER_ERROR,NULL,0);          ERROR_REPORTER_START_NOLINE(ASC_USER_ERROR);
4240          FPRINTF(ASCERR,"Problem finding instance(s): \n");          FPRINTF(ASCERR,"Problem finding instance(s): \n");
4241          WriteName(ASCERR,NamePointer(list));          WriteName(ASCERR,NamePointer(list));
4242          FPRINTF(ASCERR,"\n");          FPRINTF(ASCERR,"\n");
# Line 4366  int ExecuteIRT(struct Instance *work, st Line 4372  int ExecuteIRT(struct Instance *work, st
4372      instances = FindInsts(work,GetStatVarList(statement),&err);      instances = FindInsts(work,GetStatVarList(statement),&err);
4373      if (instances != NULL){      if (instances != NULL){
4374        if (ListContainsFundamental(instances)){        if (ListContainsFundamental(instances)){
4375          WSEM(ASCERR,statement,          STATEMENT_ERROR(statement,
4376                "IS_REFINED_TO statement affects a part of an atom");                "IS_REFINED_TO statement affects a part of an atom");
4377          gl_destroy(instances);          gl_destroy(instances);
4378          MarkStatContext(statement,context_WRONG);          MarkStatContext(statement,context_WRONG);
# Line 4400  int ExecuteIRT(struct Instance *work, st Line 4406  int ExecuteIRT(struct Instance *work, st
4406            FPRINTF(ASCERR,"Incompatible instance: ");            FPRINTF(ASCERR,"Incompatible instance: ");
4407            WriteInstanceName(ASCERR,inst,work);            WriteInstanceName(ASCERR,inst,work);
4408            FPRINTF(ASCERR,"\n");            FPRINTF(ASCERR,"\n");
4409            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
4410                 "Unconformable refinement in IS_REFINED_TO statement");                 "Unconformable refinement in IS_REFINED_TO statement");
4411            gl_destroy(instances);            gl_destroy(instances);
4412            MarkStatContext(statement,context_WRONG);            MarkStatContext(statement,context_WRONG);
# Line 4415  int ExecuteIRT(struct Instance *work, st Line 4421  int ExecuteIRT(struct Instance *work, st
4421              FPRINTF(ASCERR,"ARE_ALIKE'd instance: ");              FPRINTF(ASCERR,"ARE_ALIKE'd instance: ");
4422              WriteInstanceName(ASCERR,inst,work);              WriteInstanceName(ASCERR,inst,work);
4423              FPRINTF(ASCERR,"\n");              FPRINTF(ASCERR,"\n");
4424              WSEM(ASCERR,statement,              STATEMENT_ERROR(statement,
4425                "Refinement of clique to parameterized type family disallowed");                "Refinement of clique to parameterized type family disallowed");
4426              gl_destroy(instances);              gl_destroy(instances);
4427              MarkStatContext(statement,context_WRONG);              MarkStatContext(statement,context_WRONG);
# Line 4455  int ExecuteIRT(struct Instance *work, st Line 4461  int ExecuteIRT(struct Instance *work, st
4461      } else {      } else {
4462        switch(err){        switch(err){
4463        case impossible_instance:        case impossible_instance:
4464          WSEM(ASCERR,statement,          STATEMENT_ERROR(statement,
4465            "IS_REFINED_TO statement contains an impossible instance name");            "IS_REFINED_TO statement contains an impossible instance name");
4466          MissingInsts(work,GetStatVarList(statement),1);          MissingInsts(work,GetStatVarList(statement),1);
4467          return 1;          return 1;
# Line 4471  int ExecuteIRT(struct Instance *work, st Line 4477  int ExecuteIRT(struct Instance *work, st
4477                            SCLEN(GetStatType(statement))+1);                            SCLEN(GetStatType(statement))+1);
4478      strcpy(msg,IRT_UNDEFINED_TYPE);      strcpy(msg,IRT_UNDEFINED_TYPE);
4479      strcat(msg,SCP(GetStatType(statement)));      strcat(msg,SCP(GetStatType(statement)));
4480      WSEM(ASCERR,statement,msg);      STATEMENT_ERROR(statement,msg);
4481      ascfree(msg);      ascfree(msg);
4482      return 1;      return 1;
4483    }    }
# Line 4530  int ExecuteATS(struct Instance *inst, st Line 4536  int ExecuteATS(struct Instance *inst, st
4536    instances = FindInsts(inst,GetStatVarList(statement),&err);    instances = FindInsts(inst,GetStatVarList(statement),&err);
4537    if (instances != NULL){    if (instances != NULL){
4538      if (ListContainsFundamental(instances)){      if (ListContainsFundamental(instances)){
4539        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
4540          "ARE_THE_SAME statement affects a part of an atom");          "ARE_THE_SAME statement affects a part of an atom");
4541        gl_destroy(instances);        gl_destroy(instances);
4542        return 1;        return 1;
# Line 4545  int ExecuteATS(struct Instance *inst, st Line 4551  int ExecuteATS(struct Instance *inst, st
4551            inst2 = (struct Instance *)gl_fetch(instances,c);            inst2 = (struct Instance *)gl_fetch(instances,c);
4552            inst1 = MergeInstances(inst1,inst2);            inst1 = MergeInstances(inst1,inst2);
4553            if (inst1==NULL){            if (inst1==NULL){
4554              WSEM(ASCERR,statement, "Fatal ARE_THE_SAME error");              STATEMENT_ERROR(statement, "Fatal ARE_THE_SAME error");
4555              Asc_Panic(2, NULL, "Fatal ARE_THE_SAME error");              Asc_Panic(2, NULL, "Fatal ARE_THE_SAME error");
4556              /*NOTREACHED Wanna bet? ! */              /*NOTREACHED Wanna bet? ! */
4557            }            }
# Line 4553  int ExecuteATS(struct Instance *inst, st Line 4559  int ExecuteATS(struct Instance *inst, st
4559          PostMergeCheck(inst1);          PostMergeCheck(inst1);
4560        }        }
4561      } else {      } else {
4562        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
4563             "ARE_THE_SAME statement contains unconformable instances");             "ARE_THE_SAME statement contains unconformable instances");
4564      }      }
4565      gl_destroy(instances);      gl_destroy(instances);
# Line 4562  int ExecuteATS(struct Instance *inst, st Line 4568  int ExecuteATS(struct Instance *inst, st
4568      switch(err){      switch(err){
4569      case impossible_instance:      case impossible_instance:
4570        MissingInsts(inst,GetStatVarList(statement),1);        MissingInsts(inst,GetStatVarList(statement),1);
4571        WSEM(ASCERR,statement, "ARE_THE_SAME contains impossible instance");        STATEMENT_ERROR(statement, "ARE_THE_SAME contains impossible instance");
4572        return 1;        return 1;
4573      default:      default:
4574        MissingInsts(inst,GetStatVarList(statement),0);        MissingInsts(inst,GetStatVarList(statement),0);
# Line 4586  int ExecuteAA(struct Instance *inst, str Line 4592  int ExecuteAA(struct Instance *inst, str
4592    instances = FindInsts(inst,GetStatVarList(statement),&err);    instances = FindInsts(inst,GetStatVarList(statement),&err);
4593    if (instances != NULL){    if (instances != NULL){
4594      if (ListContainsFundamental(instances)){      if (ListContainsFundamental(instances)){
4595        WSEM(ASCERR,statement, "ARE_ALIKE statement affects a part of an atom");        STATEMENT_ERROR(statement, "ARE_ALIKE statement affects a part of an atom");
4596        gl_destroy(instances);        gl_destroy(instances);
4597        return 1;        return 1;
4598      }      }
4599      if (ListContainsParameterized(instances)){      if (ListContainsParameterized(instances)){
4600        WSEM(ASCERR,statement, "ARE_ALIKE statement affects parameterized type");        STATEMENT_ERROR(statement, "ARE_ALIKE statement affects parameterized type");
4601        gl_destroy(instances);        gl_destroy(instances);
4602        return 1;        return 1;
4603      }      }
# Line 4617  int ExecuteAA(struct Instance *inst, str Line 4623  int ExecuteAA(struct Instance *inst, str
4623          }          }
4624        }        }
4625      } else {      } else {
4626        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
4627                      "ARE_ALIKE statement contains unconformable instances");                      "ARE_ALIKE statement contains unconformable instances");
4628      }      }
4629      gl_destroy(instances);      gl_destroy(instances);
# Line 4626  int ExecuteAA(struct Instance *inst, str Line 4632  int ExecuteAA(struct Instance *inst, str
4632      switch(err){      switch(err){
4633      case impossible_instance:      case impossible_instance:
4634        MissingInsts(inst,GetStatVarList(statement),1);        MissingInsts(inst,GetStatVarList(statement),1);
4635        WSEM(ASCERR,statement, "ARE_ALIKE contains impossible instance");        STATEMENT_ERROR(statement, "ARE_ALIKE contains impossible instance");
4636        return 1;        return 1;
4637      default:      default:
4638        MissingInsts(inst,GetStatVarList(statement),0);        MissingInsts(inst,GetStatVarList(statement),0);
# Line 4648  struct Instance *MakeRelationInstance(st Line 4654  struct Instance *MakeRelationInstance(st
4654                                        struct Statement *stat,                                        struct Statement *stat,
4655                                        enum Expr_enum type)                                        enum Expr_enum type)
4656  {  {
4657      /* CONSOLE_DEBUG("..."); */
4658    symchar *childname;    symchar *childname;
4659    struct Instance *child;    struct Instance *child;
4660    struct InstanceName rec;    struct InstanceName rec;
# Line 4675  struct Instance *MakeRelationInstance(st Line 4682  struct Instance *MakeRelationInstance(st
4682        if (InstanceChild(parent,pos)==NULL){        if (InstanceChild(parent,pos)==NULL){
4683          /* must make array */          /* must make array */
4684          child = MakeSparseArray(parent,name,stat,NULL,0,NULL,NULL,NULL);          child = MakeSparseArray(parent,name,stat,NULL,0,NULL,NULL,NULL);
4685        } else {          } else {
4686          /* must add array element */          /* must add array element */
4687          child = AddArrayChild(parent,name,stat,NULL,NULL,NULL);          child = AddArrayChild(parent,name,stat,NULL,NULL,NULL);
4688        }        }
# Line 4711  int ExecuteREL(struct Instance *inst, st Line 4718  int ExecuteREL(struct Instance *inst, st
4718        child = MakeRelationInstance(name,FindRelationType(),        child = MakeRelationInstance(name,FindRelationType(),
4719                                     inst,statement,e_token);                                     inst,statement,e_token);
4720        if (child==NULL){        if (child==NULL){
4721          WSEM(ASCERR,statement, "Unable to create expression structure");          STATEMENT_ERROR(statement, "Unable to create expression structure");
4722         /* print a better message here if needed. maybe an if!makeindices moan*/         /* print a better message here if needed. maybe an if!makeindices moan*/
4723          return 1;          return 1;
4724        }        }
# Line 4728  int ExecuteREL(struct Instance *inst, st Line 4735  int ExecuteREL(struct Instance *inst, st
4735        gl_destroy(instances);        gl_destroy(instances);
4736        if (InstanceKind(child)==DUMMY_INST) {        if (InstanceKind(child)==DUMMY_INST) {
4737  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4738          WSEM(ASCERR,statement, "DUMMY_INST foundin compiling relation.");          STATEMENT_ERROR(statement, "DUMMY_INST foundin compiling relation.");
4739  #endif  #endif
4740          return 1;          return 1;
4741        }        }
4742  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4743        WSEM(ASCERR,statement, "REL_INST found in compiling relation.");        STATEMENT_ERROR(statement, "REL_INST found in compiling relation.");
4744  #endif  #endif
4745      } else {      } else {
4746        WSEM(ASCERR,statement, "Expression name refers to more than one object");        STATEMENT_ERROR(statement, "Expression name refers to more than one object");
4747        gl_destroy(instances);    /* bizarre! */        gl_destroy(instances);    /* bizarre! */
4748        return 1;        return 1;
4749      }      }
# Line 4750  int ExecuteREL(struct Instance *inst, st Line 4757  int ExecuteREL(struct Instance *inst, st
4757    if (GetInstanceRelation(child,&reltype)==NULL) {    if (GetInstanceRelation(child,&reltype)==NULL) {
4758      if ( (g_instantiate_relns & TOKRELS) ==0) {      if ( (g_instantiate_relns & TOKRELS) ==0) {
4759  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4760          WSNM(ASCERR,statement, "TOKRELS 0 found in compiling relation.");        STATEMENT_NOTE(statement, "TOKRELS 0 found in compiling relation.");
4761  #endif  #endif
4762        return 1;        return 1;
4763      }      }
# Line 4762  int ExecuteREL(struct Instance *inst, st Line 4769  int ExecuteREL(struct Instance *inst, st
4769      if (reln != NULL){      if (reln != NULL){
4770        SetInstanceRelation(child,reln,e_token);        SetInstanceRelation(child,reln,e_token);
4771  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4772        WSNM(ASCERR,statement, "Created relation.");        STATEMENT_NOTE(statement, "Created relation.");
4773  #endif  #endif
4774        return 1;        return 1;
4775      } else {      } else {
# Line 4795  int ExecuteREL(struct Instance *inst, st Line 4802  int ExecuteREL(struct Instance *inst, st
4802                       "Unmade or Undefined instances in relation",3);                       "Unmade or Undefined instances in relation",3);
4803            return 1;            return 1;
4804          case impossible_instance:          case impossible_instance:
4805            WSSM(ASCERR,statement,            WSSM(ASCERR,statement,
4806                       "Relation contains an impossible instance",3);                       "Relation contains an impossible instance",3);
4807            return 1;            return 1;
4808          case correct_instance:          case correct_instance:
# Line 4817  int ExecuteREL(struct Instance *inst, st Line 4824  int ExecuteREL(struct Instance *inst, st
4824        }        }
4825      }      }
4826  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4827      WSNM(ASCERR,statement, "   Failed relation -- unexpected scenario.");      STATEMENT_NOTE(statement, "   Failed relation -- unexpected scenario.");
4828  #endif  #endif
4829    } else{    } else{
4830      /*  Do nothing, somebody already completed the relation.  */      /*  Do nothing, somebody already completed the relation.  */
4831  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4832          WSNM(ASCERR,statement, "Already compiled in compiling relation?!.");          STATEMENT_NOTE(statement, "Already compiled in compiling relation?!.");
4833  #endif  #endif
4834      return 1;      return 1;
4835    }    }
4836  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
4837    WSNM(ASCERR,statement, "End of ExecuteREL. huh?");    STATEMENT_NOTE(statement, "End of ExecuteREL. huh?");
4838  #endif  #endif
4839  }  }
4840    
# Line 4945  int ExecuteUnSelectedEQN(struct Instance Line 4952  int ExecuteUnSelectedEQN(struct Instance
4952        assert(InstanceKind(child)==DUMMY_INST);        assert(InstanceKind(child)==DUMMY_INST);
4953        gl_destroy(instances);        gl_destroy(instances);
4954      } else{      } else{
4955        WSEM(ASCERR,statement, "Expression name refers to more than one object");        STATEMENT_ERROR(statement, "Expression name refers to more than one object");
4956        gl_destroy(instances);        gl_destroy(instances);
4957        Asc_Panic(2, NULL, "Expression name refers to more than one object");        Asc_Panic(2, NULL, "Expression name refers to more than one object");
4958      }      }
# Line 5290  struct gl_list_t *ProcessArgs(struct Ins Line 5297  struct gl_list_t *ProcessArgs(struct Ins
5297    return arglist;    return arglist;
5298  }  }
5299    
5300  static  static /* blackbox only */
5301  struct gl_list_t *CheckExtCallArgs(struct Instance *inst,  struct gl_list_t *CheckExtCallArgs(struct Instance *inst,
5302                                     struct Statement *stat,                                     struct Statement *stat,
5303                                     enum find_errors *ferr)                                     enum find_errors *ferr)
# Line 5298  struct gl_list_t *CheckExtCallArgs(struc Line 5305  struct gl_list_t *CheckExtCallArgs(struc
5305    struct VariableList *vl;    struct VariableList *vl;
5306    struct gl_list_t *result;    struct gl_list_t *result;
5307    
5308    vl = ExternalStatVlist(stat);    vl = ExternalStatVlistBlackBox(stat);
5309    result = ProcessArgs(inst,vl,ferr);    result = ProcessArgs(inst,vl,ferr);
5310    if (result==NULL){    if (result==NULL){
5311      return NULL;      return NULL;
# Line 5306  struct gl_list_t *CheckExtCallArgs(struc Line 5313  struct gl_list_t *CheckExtCallArgs(struc
5313    return result;    return result;
5314  }  }
5315    
5316  static  static /* blackbox only */
5317  struct Instance *CheckExtCallData(struct Instance *inst,  struct Instance *CheckExtCallData(struct Instance *inst,
5318                                    struct Statement *stat,                                    struct Statement *stat,
5319                                    enum find_errors *ferr)                                    enum find_errors *ferr)
# Line 5315  struct Instance *CheckExtCallData(struct Line 5322  struct Instance *CheckExtCallData(struct
5322    struct Instance *result;    struct Instance *result;
5323    struct gl_list_t *instances;    struct gl_list_t *instances;
5324    
5325    n = ExternalStatData(stat);    n = ExternalStatDataBlackBox(stat);
5326    if (n) {    if (n) {
5327      instances = FindInstances(inst,n,ferr);      instances = FindInstances(inst,n,ferr);
5328      if (instances){ /* only 1 data instance is allowed */      if (instances){ /* only 1 data instance is allowed */
# Line 5361  int ExecuteBlackBoxEXT(struct Instance * Line 5368  int ExecuteBlackBoxEXT(struct Instance *
5368    CONSOLE_DEBUG("ENTERED ExecuteBlackBoxExt\n");    CONSOLE_DEBUG("ENTERED ExecuteBlackBoxExt\n");
5369    
5370    /* make or find the array head */    /* make or find the array head */
5371    name = ExternalStatName(statement);    name = ExternalStatNameBlackBox(statement);
5372    aryinst = MakeExtRelationArray(inst,name,statement);    aryinst = MakeExtRelationArray(inst,name,statement);
5373    if (aryinst==NULL) {    if (aryinst==NULL) {
5374      WriteStatementLocation(ASCERR,statement);      WriteStatementLocation(ASCERR,statement);
# Line 5370  int ExecuteBlackBoxEXT(struct Instance * Line 5377  int ExecuteBlackBoxEXT(struct Instance *
5377    }    }
5378    /* we now have an array head */    /* we now have an array head */
5379    if (!RectangleArrayExpanded(aryinst)){        /* need to make children */    if (!RectangleArrayExpanded(aryinst)){        /* need to make children */
5380      if (ExternalStatData(statement)){      if (ExternalStatDataBlackBox(statement)){
5381        data = CheckExtCallData(inst,statement,&ferr); /* check data */        data = CheckExtCallData(inst,statement,&ferr); /* check data bbox*/
5382        switch(ferr){        switch(ferr){
5383        case correct_instance:        case correct_instance:
5384          break;          break;
# Line 5389  int ExecuteBlackBoxEXT(struct Instance * Line 5396  int ExecuteBlackBoxEXT(struct Instance *
5396          return 1;          return 1;
5397        }        }
5398      }      }
5399      arglist = CheckExtCallArgs(inst,statement,&ferr); /* check main args */      arglist = CheckExtCallArgs(inst,statement,&ferr); /* check main args bbox*/
5400      if (arglist==NULL){      if (arglist==NULL){
5401        switch(ferr){        switch(ferr){
5402        case unmade_instance:        case unmade_instance:
# Line 5470  struct gl_list_t *CheckGlassBoxArgs(stru Line 5477  struct gl_list_t *CheckGlassBoxArgs(stru
5477    unsigned long len,c;    unsigned long len,c;
5478    int error = 0;    int error = 0;
5479    
5480    vl = ExternalStatVlist(stat);    vl = ExternalStatVlistGlassBox(stat);
5481    if (!vl) {    if (!vl) {
5482      *ferr = impossible_instance; /* a relation with no incidence ! */      *ferr = impossible_instance; /* a relation with no incidence ! */
5483      return NULL;      return NULL;
# Line 5522  int CheckGlassBoxIndex(struct Instance * Line 5529  int CheckGlassBoxIndex(struct Instance *
5529    
5530    (void)inst;  /*  stop gcc whine about unused parameter  */    (void)inst;  /*  stop gcc whine about unused parameter  */
5531    
5532    n = ExternalStatData(stat);    n = ExternalStatDataGlassBox(stat);
5533    if (!n) {    if (!n) {
5534      *err = incorrect_num_args;      /* we must have an index */      *err = incorrect_num_args;      /* we must have an index */
5535      return -1;      return -1;
# Line 5530  int CheckGlassBoxIndex(struct Instance * Line 5537  int CheckGlassBoxIndex(struct Instance *
5537    
5538    str = SimpleNameIdPtr(n);    str = SimpleNameIdPtr(n);
5539    if (str) {    if (str) {
5540      result = atoi(SCP(str));    /* convert to integer. fixme strtod */      result = atoi(SCP(str));    /* convert to integer. FIXME strtod */
5541      *err = okay;      *err = okay;
5542      return result;      return result;
5543    }    }
# Line 5567  int ExecuteGlassBoxEXT(struct Instance * Line 5574  int ExecuteGlassBoxEXT(struct Instance *
5574      return 1;      return 1;
5575    }    }
5576    
5577    name = ExternalStatName(statement);    name = ExternalStatNameGlassBox(statement);
5578    instances = FindInstances(inst,name,&ferr);    instances = FindInstances(inst,name,&ferr);
5579    if (instances==NULL){    if (instances==NULL){
5580      if (ferr == unmade_instance){           /* glassbox reln */      if (ferr == unmade_instance){           /* glassbox reln */
5581        child = MakeRelationInstance(name,FindRelationType(),        child = MakeRelationInstance(name,FindRelationType(),
5582                                     inst,statement,e_glassbox);                                     inst,statement,e_glassbox);
5583        if (child==NULL){        if (child==NULL){
5584          WSEM(ASCERR,statement, "Unable to create expression structure");          STATEMENT_ERROR(statement, "Unable to create expression structure");
5585          return 1;          return 1;
5586        }        }
5587      }      }
5588      else {      else {
5589        WSEM(ASCERR,statement, "Unable to execute expression");        STATEMENT_ERROR(statement, "Unable to execute expression");
5590        return 1;        return 1;
5591      }      }
5592    }    }
# Line 5590  int ExecuteGlassBoxEXT(struct Instance * Line 5597  int ExecuteGlassBoxEXT(struct Instance *
5597        gl_destroy(instances);        gl_destroy(instances);
5598      }      }
5599      else{      else{
5600        WSEM(ASCERR,statement, "Expression name refers to more than one object");        STATEMENT_ERROR(statement, "Expression name refers to more than one object");
5601        gl_destroy(instances);        gl_destroy(instances);
5602        return 1;        return 1;
5603      }      }
# Line 5657  int ExecuteEXT(struct Instance *inst, st Line 5664  int ExecuteEXT(struct Instance *inst, st
5664  {  {
5665    int mode;    int mode;
5666    
5667      CONSOLE_DEBUG("...");
5668    
5669    mode = ExternalStatMode(statement);    mode = ExternalStatMode(statement);
5670    switch(mode) {    switch(mode) {
5671    default:    case ek_method:
   case 0:  
5672      WriteStatementLocation(ASCERR,statement);      WriteStatementLocation(ASCERR,statement);
5673      FPRINTF(ASCERR,"Invalid external statement in declarative section. \n");      FPRINTF(ASCERR,"Invalid external statement in declarative section. \n");
5674      return 1;      return 1;
5675    case 1:    case ek_glass:
5676      return ExecuteGlassBoxEXT(inst,statement);      return ExecuteGlassBoxEXT(inst,statement);
5677    case 2:    case ek_black:
5678      return ExecuteBlackBoxEXT(inst,statement);      return ExecuteBlackBoxEXT(inst,statement);
5679      default:
5680        WriteStatementLocation(ASCERR,statement);
5681        FPRINTF(ASCERR,"Invalid external statement in declarative section. \n");
5682        return 1;
5683    }    }
5684  }  }
5685    
# Line 5678  static Line 5690  static
5690  void StructuralAsgnErrorReport(struct Statement *statement,  void StructuralAsgnErrorReport(struct Statement *statement,
5691                                 struct value_t *value)                                 struct value_t *value)
5692  {  {
5693    WSEM(ASCERR,statement,    STATEMENT_ERROR(statement,
5694      "Structural assignment right hand side is not constant");      "Structural assignment right hand side is not constant");
5695    DestroyValue(value);    DestroyValue(value);
5696  }  }
# Line 5695  int AsgnErrorReport(struct Statement *st Line 5707  int AsgnErrorReport(struct Statement *st
5707    case undefined_value:    case undefined_value:
5708    case name_unfound: DestroyValue(value); return 0;    case name_unfound: DestroyValue(value); return 0;
5709    case incorrect_name:    case incorrect_name:
5710      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
5711           "Assignment right hand side contains non-existent instance");           "Assignment right hand side contains non-existent instance");
5712      DestroyValue(value);      DestroyValue(value);
5713      return 1;      return 1;
5714    case temporary_variable_reused:    case temporary_variable_reused:
5715      WSEM(ASCERR,statement, "Assignment re-used temporary variable");      STATEMENT_ERROR(statement, "Assignment re-used temporary variable");
5716      DestroyValue(value);      DestroyValue(value);
5717      return 1;      return 1;
5718    case dimension_conflict:    case dimension_conflict:
5719      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
5720            "Assignment right hand side is dimensionally inconsistent");            "Assignment right hand side is dimensionally inconsistent");
5721      DestroyValue(value);      DestroyValue(value);
5722      return 1;      return 1;
5723    case incorrect_such_that:    case incorrect_such_that:
5724      WSEM(ASCERR,statement, "Assignment uses incorrect such that expression");      STATEMENT_ERROR(statement, "Assignment uses incorrect such that expression");
5725      DestroyValue(value);      DestroyValue(value);
5726      return 1;      return 1;
5727    case empty_choice:    case empty_choice:
5728      WSEM(ASCERR,statement, "Assignment has CHOICE of an empty set");      STATEMENT_ERROR(statement, "Assignment has CHOICE of an empty set");
5729      DestroyValue(value);      DestroyValue(value);
5730      return 1;      return 1;
5731    case empty_intersection:    case empty_intersection:
5732      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
5733        "Assignment has an empty INTERSECTION() construct which is undefined");        "Assignment has an empty INTERSECTION() construct which is undefined");
5734      DestroyValue(value);      DestroyValue(value);
5735      return 1;      return 1;
5736    case type_conflict:    case type_conflict:
5737      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
5738           "Assignment right hand side contains a type conflict");           "Assignment right hand side contains a type conflict");
5739      DestroyValue(value);      DestroyValue(value);
5740      return 1;      return 1;
5741    default:    default:
5742      WSEM(ASCERR,statement, "Assignment contains strange error");      STATEMENT_ERROR(statement, "Assignment contains strange error");
5743      DestroyValue(value);      DestroyValue(value);
5744      return 1;      return 1;
5745    }    }
# Line 5741  void ReAssignmentError(CONST char *str, Line 5753  void ReAssignmentError(CONST char *str,
5753    strcpy(msg,REASSIGN_MESG1);    strcpy(msg,REASSIGN_MESG1);
5754    strcat(msg,str);    strcat(msg,str);
5755    strcat(msg,REASSIGN_MESG2);    strcat(msg,REASSIGN_MESG2);
5756    WSEM(ASCERR,statement,msg);    STATEMENT_ERROR(statement,msg);
5757    ascfree(msg);    ascfree(msg);
5758  }  }
5759    
# Line 5760  int AssignStructuralValue(struct Instanc Line 5772  int AssignStructuralValue(struct Instanc
5772    case ARRAY_ENUM_INST:    case ARRAY_ENUM_INST:
5773    case REL_INST:    case REL_INST:
5774    case LREL_INST:    case LREL_INST:
5775      WSEM(ASCERR,statement, "Arg!  Attempt to assign to a non-scalar");      STATEMENT_ERROR(statement, "Arg!  Attempt to assign to a non-scalar");
5776      return 0;      return 0;
5777    case REAL_ATOM_INST:    case REAL_ATOM_INST:
5778    case REAL_INST:    case REAL_INST:
# Line 5770  int AssignStructuralValue(struct Instanc Line 5782  int AssignStructuralValue(struct Instanc
5782    case INTEGER_INST:    case INTEGER_INST:
5783    case SYMBOL_ATOM_INST:    case SYMBOL_ATOM_INST:
5784    case SYMBOL_INST:    case SYMBOL_INST:
5785      WSEM(ASCERR,statement, "Assignment to non-constant LHS ignored");      STATEMENT_ERROR(statement, "Assignment to non-constant LHS ignored");
5786      return 0;      return 0;
5787    case REAL_CONSTANT_INST:    case REAL_CONSTANT_INST:
5788      switch(ValueKind(value)){      switch(ValueKind(value)){
# Line 5785  int AssignStructuralValue(struct Instanc Line 5797  int AssignStructuralValue(struct Instanc
5797          if (!AtomAssigned(inst)) {          if (!AtomAssigned(inst)) {
5798            if ( !IsWild(RealAtomDims(inst)) &&            if ( !IsWild(RealAtomDims(inst)) &&
5799                 !SameDimen(RealValueDimensions(value),RealAtomDims(inst)) ) {                 !SameDimen(RealValueDimensions(value),RealAtomDims(inst)) ) {
5800              WSEM(ASCERR,statement, "Dimensionally inconsistent assignment");              STATEMENT_ERROR(statement, "Dimensionally inconsistent assignment");
5801              return 0;              return 0;
5802            } else {            } else {
5803              if (IsWild(RealAtomDims(inst))) {              if (IsWild(RealAtomDims(inst))) {
# Line 5809  int AssignStructuralValue(struct Instanc Line 5821  int AssignStructuralValue(struct Instanc
5821          if (!AtomAssigned(inst)) {          if (!AtomAssigned(inst)) {
5822            if ( !IsWild(RealAtomDims(inst)) &&            if ( !IsWild(RealAtomDims(inst)) &&
5823                 !SameDimen(Dimensionless(),RealAtomDims(inst)) ) {                 !SameDimen(Dimensionless(),RealAtomDims(inst)) ) {
5824              WSEM(ASCERR,statement, "Dimensionally inconsistent assignment");              STATEMENT_ERROR(statement, "Dimensionally inconsistent assignment");
5825              return 0;              return 0;
5826            } else {            } else {
5827              if (IsWild(RealAtomDims(inst))) {              if (IsWild(RealAtomDims(inst))) {
# Line 5822  int AssignStructuralValue(struct Instanc Line 5834  int AssignStructuralValue(struct Instanc
5834        /* case of same value,dimen reassigned is silently ignored */        /* case of same value,dimen reassigned is silently ignored */
5835        return 1;        return 1;
5836      default:      default:
5837        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
5838             "Attempt to assign non-real value to a real instance");             "Attempt to assign non-real value to a real instance");
5839      }      }
5840      return 0;      return 0;
5841    case BOOLEAN_CONSTANT_INST:    case BOOLEAN_CONSTANT_INST:
5842      if (ValueKind(value)!=boolean_value){      if (ValueKind(value)!=boolean_value){
5843        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
5844        "Attempt to assign a non-boolean value to a boolean instance");        "Attempt to assign a non-boolean value to a boolean instance");
5845        return 0;        return 0;
5846      } else {      } else {
# Line 5873  int AssignStructuralValue(struct Instanc Line 5885  int AssignStructuralValue(struct Instanc
5885        }        }
5886        /* intended to fall through to default if not wild real or not 0 */        /* intended to fall through to default if not wild real or not 0 */
5887      default:      default:
5888        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
5889             "Attempt to assign a non-integer value to an integer instance");             "Attempt to assign a non-integer value to an integer instance");
5890      }      }
5891      return 0;      return 0;
# Line 5898  int AssignStructuralValue(struct Instanc Line 5910  int AssignStructuralValue(struct Instanc
5910        }        }
5911        return 1;        return 1;
5912      } else {      } else {
5913        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
5914             "Attempt to assign a non-set value to a set instance");             "Attempt to assign a non-set value to a set instance");
5915        return 0;        return 0;
5916      }      }
# Line 5917  int AssignStructuralValue(struct Instanc Line 5929  int AssignStructuralValue(struct Instanc
5929        }        }
5930        return 1;        return 1;
5931      } else {      } else {
5932        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
5933                "Attempt to assign a non-symbol value to a symbol instance");                "Attempt to assign a non-symbol value to a symbol instance");
5934      }      }
5935      return 0;      return 0;
5936    default:    default:
5937      WSEM(ASCERR,statement, "Error: Unknown value type");      STATEMENT_ERROR(statement, "Error: Unknown value type");
5938      return 0;      return 0;
5939    }    }
5940  }  }
# Line 5971  int ExecuteCASGN(struct Instance *work, Line 5983  int ExecuteCASGN(struct Instance *work,
5983          gl_destroy(instances);          gl_destroy(instances);
5984          SetDeclarativeContext(previous_context);          SetDeclarativeContext(previous_context);
5985          StructuralAsgnErrorReport(statement,&value);          StructuralAsgnErrorReport(statement,&value);
5986          WSEM(ASCERR,statement, "Assignment is impossible");          STATEMENT_ERROR(statement, "Assignment is impossible");
5987          MarkStatContext(statement,context_WRONG);          MarkStatContext(statement,context_WRONG);
5988          WSS(ASCERR,statement);          WSS(ASCERR,statement);
5989          return 1;          return 1;
# Line 5983  int ExecuteCASGN(struct Instance *work, Line 5995  int ExecuteCASGN(struct Instance *work,
5995          inst = (struct Instance *)gl_fetch(instances,c);          inst = (struct Instance *)gl_fetch(instances,c);
5996          if (!AssignStructuralValue(inst,value,statement)) {          if (!AssignStructuralValue(inst,value,statement)) {
5997            MarkStatContext(statement,context_WRONG);            MarkStatContext(statement,context_WRONG);
5998            WSEM(ASCERR,statement, "Assignment is impossible (wrong set type)");            STATEMENT_ERROR(statement, "Assignment is impossible (wrong set type)");
5999            WSS(ASCERR,statement);            WSS(ASCERR,statement);
6000          }          }
6001        }        }
# Line 5995  int ExecuteCASGN(struct Instance *work, Line 6007  int ExecuteCASGN(struct Instance *work,
6007    } else {    } else {
6008      switch(err){      switch(err){
6009      case impossible_instance:      case impossible_instance:
6010        WSEM(ASCERR,statement, "Left hand side of assignment statement"        STATEMENT_ERROR(statement, "Left hand side of assignment statement"
6011              " contains an impossible instance");              " contains an impossible instance");
6012        SetDeclarativeContext(previous_context);        SetDeclarativeContext(previous_context);
6013        return 1;        return 1;
# Line 6017  static Line 6029  static
6029  int NameContainsName(CONST struct Name *n,CONST struct Name *sub)  int NameContainsName(CONST struct Name *n,CONST struct Name *sub)
6030  {  {
6031    struct gl_list_t *nl;    struct gl_list_t *nl;
6032    unsigned long c,len;                      unsigned long c,len;
6033    struct Expr *en;    struct Expr *en;
6034    
6035    assert(n!=NULL);    assert(n!=NULL);
# Line 6288  up later. Line 6300  up later.
6300      return 0; /* rhs not compiled yet */      return 0; /* rhs not compiled yet */
6301    }    }
6302    if (gl_length(rhslist)>1) {    if (gl_length(rhslist)>1) {
6303      WSEM(ASCERR,stat,"ALIASES needs exactly 1 RHS");      STATEMENT_ERROR(stat,"ALIASES needs exactly 1 RHS");
6304    }    }
6305    gl_destroy(rhslist);    gl_destroy(rhslist);
6306    
# Line 6713  int CheckRelModName(struct Instance *wor Line 6725  int CheckRelModName(struct Instance *wor
6725       }       }
6726      }      }
6727      else {      else {
6728      FPRINTF(ASCERR,"\n");            FPRINTF(ASCERR,"\n");
6729      FPRINTF(ASCERR,      FPRINTF(ASCERR,
6730      "Error in WHEN statement. Name assigned to more than one %s \n",      "Error in WHEN statement. Name assigned to more than one %s \n",
6731      "instance type:");      "instance type:");
# Line 6768  int Pass3CheckCondStatements(struct Inst Line 6780  int Pass3CheckCondStatements(struct Inst
6780      case WHEN:      case WHEN:
6781      case FNAME:      case FNAME:
6782      case SELECT:      case SELECT:
6783           WSEM(ASCERR,statement,           STATEMENT_ERROR(statement,
6784                 "Statement not allowed inside a CONDITIONAL statement\n");                 "Statement not allowed inside a CONDITIONAL statement\n");
6785           return 0;           return 0;
6786      default:      default:
# Line 6818  int Pass2CheckCondStatements(struct Inst Line 6830  int Pass2CheckCondStatements(struct Inst
6830      case ATS:      case ATS:
6831      case AA:      case AA:
6832      case CALL:      case CALL:
6833      case EXT:      case EXT: /** FIXME probably need a check and action here */
6834      case ASGN:      case ASGN:
6835      case CASGN:      case CASGN:
6836      case COND:      case COND:
6837      case WHEN:      case WHEN:
6838      case FNAME:      case FNAME:
6839      case SELECT:      case SELECT:
6840           WSEM(ASCERR,statement,           STATEMENT_ERROR(statement,
6841                 "Statement not allowed inside a CONDITIONAL statement\n");                 "Statement not allowed inside a CONDITIONAL statement\n");
6842           return 0;           return 0;
6843      default:      default:
# Line 6988  int CheckWhenSetNode(struct Instance *re Line 7000  int CheckWhenSetNode(struct Instance *re
7000      FPRINTF(ASCERR,"Innapropriate value type in the list of %s\n",      FPRINTF(ASCERR,"Innapropriate value type in the list of %s\n",
7001          "values of a CASE of a WHEN statement");          "values of a CASE of a WHEN statement");
7002      FPRINTF(ASCERR,"Only symbols or integers and booleans are allowed\n");      FPRINTF(ASCERR,"Only symbols or integers and booleans are allowed\n");
7003      FPRINTF(ASCERR,"\n");          FPRINTF(ASCERR,"\n");
7004      return 0;      return 0;
7005    }    }
7006  }  }
# Line 7029  int CheckWhenVariableNode(struct Instanc Line 7041  int CheckWhenVariableNode(struct Instanc
7041        FPRINTF(ASCERR,"\n");        FPRINTF(ASCERR,"\n");
7042        FPRINTF(ASCERR,"Innapropriate index in the list of %s\n",        FPRINTF(ASCERR,"Innapropriate index in the list of %s\n",
7043            "variables of a WHEN statement");            "variables of a WHEN statement");
7044        FPRINTF(ASCERR,"only symbol or integer allowed\n");              FPRINTF(ASCERR,"only symbol or integer allowed\n");
7045        FPRINTF(ASCERR,"\n");        FPRINTF(ASCERR,"\n");
7046        return 0;        return 0;
7047      }      }
# Line 7108  int CheckWhenVariableNode(struct Instanc Line 7120  int CheckWhenVariableNode(struct Instanc
7120          FPRINTF(ASCERR,"\n");          FPRINTF(ASCERR,"\n");
7121          FPRINTF(ASCERR,"Inappropriate instance in the list of %s\n",          FPRINTF(ASCERR,"Inappropriate instance in the list of %s\n",
7122          "variables of a WHEN statement");          "variables of a WHEN statement");
7123          FPRINTF(ASCERR,"Only boolean, integer and symbols are allowed\n");          FPRINTF(ASCERR,"Only boolean, integer and symbols are allowed\n");
7124          WriteName(ASCERR,name);          WriteName(ASCERR,name);
7125          FPRINTF(ASCERR,"\n");            FPRINTF(ASCERR,"\n");
7126      return 0;      return 0;
7127        }        }
7128      } else {      } else {
# Line 7118  int CheckWhenVariableNode(struct Instanc Line 7130  int CheckWhenVariableNode(struct Instanc
7130        FPRINTF(ASCERR,"\n");        FPRINTF(ASCERR,"\n");
7131        FPRINTF(ASCERR,"Inappropriate instance in the list of %s\n",        FPRINTF(ASCERR,"Inappropriate instance in the list of %s\n",
7132            "variables of a WHEN statement");            "variables of a WHEN statement");
7133        FPRINTF(ASCERR,"Multiple instances of\n");        FPRINTF(ASCERR,"Multiple instances of\n");
7134        WriteName(ASCERR,name);        WriteName(ASCERR,name);
7135        FPRINTF(ASCERR,"\n");        FPRINTF(ASCERR,"\n");
7136        return 0;        return 0;
7137      }      }
7138    }    }
# Line 7156  int CheckWhenStatements(struct Instance Line 7168  int CheckWhenStatements(struct Instance
7168      case CALL:      case CALL:
7169      case ASGN:      case ASGN:
7170      case SELECT:      case SELECT:
7171           WSEM(ASCERR,statement,           STATEMENT_ERROR(statement,
7172                "Statement not allowed inside a WHEN statement\n");                "Statement not allowed inside a WHEN statement\n");
7173           return 0;           return 0;
7174      default:      default:
# Line 7259  int CheckWHEN(struct Instance *inst, str Line 7271  int CheckWHEN(struct Instance *inst, str
7271      FPRINTF(ASCERR,"Name of a WHEN already exits in ");      FPRINTF(ASCERR,"Name of a WHEN already exits in ");
7272      WriteInstanceName(ASCERR,inst,NULL);      WriteInstanceName(ASCERR,inst,NULL);
7273      FPRINTF(ASCERR,"\n");      FPRINTF(ASCERR,"\n");
7274      WSEM(ASCERR,statement,"The following statement will not be executed: \n");      STATEMENT_ERROR(statement,"The following statement will not be executed: \n");
7275      FPRINTF(ASCERR,"\n");        FPRINTF(ASCERR,"\n");
7276        return 0;        return 0;
7277      }      }
7278      if ( CheckWhenName(inst,wname) == -1) return 1;      if ( CheckWhenName(inst,wname) == -1) return 1;
# Line 7274  int CheckWHEN(struct Instance *inst, str Line 7286  int CheckWHEN(struct Instance *inst, str
7286    if (!CheckWhenVariableList(inst,vlist,p1)) {    if (!CheckWhenVariableList(inst,vlist,p1)) {
7287      FPRINTF(ASCERR,"In ");      FPRINTF(ASCERR,"In ");
7288      WriteInstanceName(ASCERR,inst,NULL);      WriteInstanceName(ASCERR,inst,NULL);
7289      WSEM(ASCERR,statement," the following statement will not be executed:\n");      STATEMENT_ERROR(statement," the following statement will not be executed:\n");
7290      FPRINTF(ASCERR,"\n");          FPRINTF(ASCERR,"\n");
7291      return 0;      return 0;
7292    }    }
7293    w1 = WhenStatCases(statement);    w1 = WhenStatCases(statement);
# Line 7289  int CheckWHEN(struct Instance *inst, str Line 7301  int CheckWHEN(struct Instance *inst, str
7301              "number of values in a CASE");              "number of values in a CASE");
7302              FPRINTF(ASCERR,"In ");              FPRINTF(ASCERR,"In ");
7303              WriteInstanceName(ASCERR,inst,NULL);              WriteInstanceName(ASCERR,inst,NULL);
7304              WSEM(ASCERR,statement,              STATEMENT_ERROR(statement,
7305           " the following statement will not be executed: \n");           " the following statement will not be executed: \n");
7306              FPRINTF(ASCERR,"\n");                  FPRINTF(ASCERR,"\n");
7307          return 0;          return 0;
7308        }        }
7309            if (!CheckWhenSetList(inst,s,p2)) {            if (!CheckWhenSetList(inst,s,p2)) {
7310              FPRINTF(ASCERR,"\n");              FPRINTF(ASCERR,"\n");
7311              FPRINTF(ASCERR,"In ");              FPRINTF(ASCERR,"In ");
7312              WriteInstanceName(ASCERR,inst,NULL);              WriteInstanceName(ASCERR,inst,NULL);
7313              WSEM(ASCERR,statement,              STATEMENT_ERROR(statement,
7314           " the following statement will not be executed: \n");           " the following statement will not be executed: \n");
7315              FPRINTF(ASCERR,"\n");                  FPRINTF(ASCERR,"\n");
7316          return 0;          return 0;
7317        }        }
7318            p1 = &vl[0];            p1 = &vl[0];
# Line 7311  int CheckWHEN(struct Instance *inst, str Line 7323  int CheckWHEN(struct Instance *inst, str
7323              "of values in a CASE");              "of values in a CASE");
7324              FPRINTF(ASCERR,"In ");              FPRINTF(ASCERR,"In ");
7325              WriteInstanceName(ASCERR,inst,NULL);              WriteInstanceName(ASCERR,inst,NULL);
7326              WSEM(ASCERR,statement,              STATEMENT_ERROR(statement,
7327           " the following statement will not be executed: \n");           " the following statement will not be executed: \n");
7328              FPRINTF(ASCERR,"\n");                  FPRINTF(ASCERR,"\n");
7329          return 0;          return 0;
7330        }        }
7331        }        }
# Line 7324  int CheckWHEN(struct Instance *inst, str Line 7336  int CheckWHEN(struct Instance *inst, str
7336              FPRINTF(ASCERR,"More than one default case in a WHEN\n");              FPRINTF(ASCERR,"More than one default case in a WHEN\n");
7337              FPRINTF(ASCERR,"In ");              FPRINTF(ASCERR,"In ");
7338              WriteInstanceName(ASCERR,inst,NULL);              WriteInstanceName(ASCERR,inst,NULL);
7339              WSEM(ASCERR,statement,              STATEMENT_ERROR(statement,
7340           " the following statement will not be executed: \n");           " the following statement will not be executed: \n");
7341              FPRINTF(ASCERR,"\n");                    FPRINTF(ASCERR,"\n");
7342          return 0;          return 0;
7343        }        }
7344        }        }
# Line 7335  int CheckWHEN(struct Instance *inst, str Line 7347  int CheckWHEN(struct Instance *inst, str
7347          FPRINTF(ASCERR,"\n");          FPRINTF(ASCERR,"\n");
7348          FPRINTF(ASCERR,"In ");          FPRINTF(ASCERR,"In ");
7349          WriteInstanceName(ASCERR,inst,NULL);          WriteInstanceName(ASCERR,inst,NULL);
7350          WSEM(ASCERR,statement,          STATEMENT_ERROR(statement,
7351           " the following statement will not be executed: \n");           " the following statement will not be executed: \n");
7352          FPRINTF(ASCERR,"\n");            FPRINTF(ASCERR,"\n");
7353      return 0;      return 0;
7354        }        }
7355        w1 = NextWhenCase(w1); }        w1 = NextWhenCase(w1); }
# Line 7377  int CheckSelectStatements(struct Instanc Line 7389  int CheckSelectStatements(struct Instanc
7389      return CheckCASGN(inst,statement);      return CheckCASGN(inst,statement);
7390    case SELECT:    case SELECT:
7391      return CheckSELECT(inst,statement);      return CheckSELECT(inst,statement);
7392    case REL: /* broken */    case REL: /* not broken. equations disallowed. */
7393    case LOGREL: /* broken */    case LOGREL:
7394    case EXT: /* broken */    case EXT:
7395    case CALL: /* broken */    case CALL:
7396    case WHEN:  /* broken */    case WHEN:
7397    case FNAME:    case FNAME:
7398      if (g_iteration>=MAXNUMBER) { /* see WriteUnexecutedMessage */      if (g_iteration>=MAXNUMBER) { /* see WriteUnexecutedMessage */
7399         WSEM(ASCERR,statement,         STATEMENT_ERROR(statement,
7400                "Statement not allowed inside a SELECT statement\n"); }                "Statement not allowed inside a SELECT statement\n"); }
7401      /** AND WHY NOT? fix me. **/      /** AND WHY NOT? fix me. **/
7402      return 0;      return 0;
# Line 7747  int Pass2CheckStatement(struct Instance Line 7759  int Pass2CheckStatement(struct Instance
7759    }    }
7760  }  }
7761    
7762  /*  /**
7763   * checking statementlist, as in a FOR loop check.   * checking statementlist, as in a FOR loop check.
7764   * BUG!: CheckStatement and New flavors of same ignore the   * relations are not handled in pass 1
  * type EXT. We never use external relations inside a loop?!  
7765   */   */
7766  static  static
7767  int Pass1CheckStatement(struct Instance *inst, struct Statement *stat)  int Pass1CheckStatement(struct Instance *inst, struct Statement *stat)
# Line 7916  void Pass3MarkCondLogRels(struct Instanc Line 7927  void Pass3MarkCondLogRels(struct Instanc
7927      case REL:      case REL:
7928        break;        break;
7929      default:      default:
7930        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
7931                       "Inappropriate statement type in CONDITIONAL Statement");                       "Inappropriate statement type in CONDITIONAL Statement");
7932    }    }
7933  }  }
# Line 7944  void Pass3MarkCondLogRelStatList(struct Line 7955  void Pass3MarkCondLogRelStatList(struct
7955        case REL:        case REL:
7956          break;          break;
7957        default:        default:
7958          WSEM(ASCERR,stat,          STATEMENT_ERROR(stat,
7959                       "Inappropriate statement type in CONDITIONAL Statement");                       "Inappropriate statement type in CONDITIONAL Statement");
7960      }      }
7961    }    }
# Line 7990  int Pass3ExecuteCondStatements(struct In Line 8001  int Pass3ExecuteCondStatements(struct In
8001      case REL:      case REL:
8002        return 1; /* assume done */        return 1; /* assume done */
8003      default:      default:
8004        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
8005                       "Inappropriate statement type in CONDITIONAL Statement");                       "Inappropriate statement type in CONDITIONAL Statement");
8006        return 0;        return 0;
8007    }    }
# Line 8060  void Pass2MarkCondRelations(struct Insta Line 8071  void Pass2MarkCondRelations(struct Insta
8071      case LOGREL:      case LOGREL:
8072        break;        break;
8073      default:      default:
8074        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
8075                       "Inappropriate statement type in CONDITIONAL Statement");                       "Inappropriate statement type in CONDITIONAL Statement");
8076    }    }
8077  }  }
# Line 8087  void Pass2MarkCondRelStatList(struct Ins Line 8098  void Pass2MarkCondRelStatList(struct Ins
8098        case LOGREL:        case LOGREL:
8099          break;          break;
8100        default:        default:
8101          WSEM(ASCERR,stat,          STATEMENT_ERROR(stat,
8102                       "Inappropriate statement type in CONDITIONAL Statement");                       "Inappropriate statement type in CONDITIONAL Statement");
8103      }      }
8104    }    }
# Line 8121  int Pass2ExecuteCondStatements(struct In Line 8132  int Pass2ExecuteCondStatements(struct In
8132    switch(StatementType(statement)){    switch(StatementType(statement)){
8133      case REL:      case REL:
8134  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
8135      error_reporter_start(ASC_PROG_NOTE,NULL,0);      ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
8136      FPRINTF(stderr,"Pass2ExecuteCondStatements: case REL");      FPRINTF(stderr,"Pass2ExecuteCondStatements: case REL");
8137      WriteStatement(stderr, statement, 3);      WriteStatement(stderr, statement, 3);
8138      error_reporter_end_flush();      error_reporter_end_flush();
8139  #endif  #endif
8140        return ExecuteREL(inst,statement);        return ExecuteREL(inst,statement);
8141      case FOR:      case FOR:
8142        if ( ForContainsRelations(statement) ) {        if ( ForContainsRelations(statement) ) {
8143  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
8144      error_reporter_start(ASC_PROG_NOTE,NULL,0);          ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
8145      FPRINTF(stderr,"Pass2ExecuteCondStatements: case FOR");          FPRINTF(stderr,"Pass2ExecuteCondStatements: case FOR");
8146      WriteStatement(stderr, statement, 3);          WriteStatement(stderr, statement, 3);
8147      error_reporter_end_flush();          error_reporter_end_flush();
8148  #endif  #endif
8149          return Pass2ExecuteFOR(inst,statement);          return Pass2ExecuteFOR(inst,statement);
8150        }        }
# Line 8141  int Pass2ExecuteCondStatements(struct In Line 8152  int Pass2ExecuteCondStatements(struct In
8152      case LOGREL:      case LOGREL:
8153        return 1; /* Ignore */        return 1; /* Ignore */
8154      default:      default:
8155        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
8156                       "Inappropriate statement type in CONDITIONAL Statement");                       "Inappropriate statement type in CONDITIONAL Statement");
8157        return 0;        return 0;
8158    }    }
# Line 8400  void MakeWhenReference(struct Instance * Line 8411  void MakeWhenReference(struct Instance *
8411      } else {      } else {
8412        gl_destroy(instances);        gl_destroy(instances);
8413        FPRINTF(ASCERR,"\n");        FPRINTF(ASCERR,"\n");
8414        WriteName(ASCERR,name);        WriteName(ASCERR,name);
8415        Asc_Panic(2, NULL,        Asc_Panic(2, NULL,
8416                  "Error in WHEN statement. Name assigned"                  "Error in WHEN statement. Name assigned"
8417                  " to more than one instance type\n");                  " to more than one instance type\n");
# Line 8475  void MakeRealWhenCaseReferencesList(stru Line 8486  void MakeRealWhenCaseReferencesList(stru
8486        MakeRealWhenCaseReferencesFOR(inst,child,statement,listref);        MakeRealWhenCaseReferencesFOR(inst,child,statement,listref);
8487        break;        break;
8488      default:      default:
8489        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
8490                        "Inappropriate statement type in declarative section");                        "Inappropriate statement type in declarative section");
8491        Asc_Panic(2, NULL,"Inappropriate statement type in declarative section");        Asc_Panic(2, NULL,"Inappropriate statement type in declarative section");
8492        break;        break;
# Line 8617  void RealExecuteWHEN(struct Instance *in Line 8628  void RealExecuteWHEN(struct Instance *in
8628      /*    if (ferr == unmade_instance) { */      /*    if (ferr == unmade_instance) { */
8629        child = MakeWhenInstance(inst,wname,statement);        child = MakeWhenInstance(inst,wname,statement);
8630        if (child == NULL) {        if (child == NULL) {
8631          WSEM(ASCERR,statement,"Unable to create when instance");          STATEMENT_ERROR(statement,"Unable to create when instance");
8632          Asc_Panic(2, NULL, "Unable to create when instance");          Asc_Panic(2, NULL, "Unable to create when instance");
8633        }        }
8634        /*    }        /*    }
8635      else {      else {
8636        WSEM(ASCERR,statement,"Unable to execute statement");        STATEMENT_ERROR(statement,"Unable to execute statement");
8637        Asc_Panic(2, NULL, "Unable to execute statement");        Asc_Panic(2, NULL, "Unable to execute statement");
8638      }  */      }  */
8639    } else {    } else {
# Line 8635  void RealExecuteWHEN(struct Instance *in Line 8646  void RealExecuteWHEN(struct Instance *in
8646          return;          return;
8647        }        }
8648      } else{      } else{
8649        WSEM(ASCERR,statement, "Expression name refers to more than one object");        STATEMENT_ERROR(statement, "Expression name refers to more than one object");
8650        gl_destroy(instances);        gl_destroy(instances);
8651        Asc_Panic(2, NULL, "Expression name refers to more than one object");        Asc_Panic(2, NULL, "Expression name refers to more than one object");
8652        child = NULL;        child = NULL;
# Line 8734  int ExecuteUnSelectedWHEN(struct Instanc Line 8745  int ExecuteUnSelectedWHEN(struct Instanc
8745        assert(InstanceKind(child)==DUMMY_INST);        assert(InstanceKind(child)==DUMMY_INST);
8746        gl_destroy(instances);        gl_destroy(instances);
8747      } else{      } else{
8748        WSEM(ASCERR,statement, "Expression name refers to more than one object");        STATEMENT_ERROR(statement, "Expression name refers to more than one object");
8749        gl_destroy(instances);        gl_destroy(instances);
8750        Asc_Panic(2, NULL, "Expression name refers to more than one object");        Asc_Panic(2, NULL, "Expression name refers to more than one object");
8751      }      }
# Line 8810  void ExecuteSelectStatements(struct Inst Line 8821  void ExecuteSelectStatements(struct Inst
8821          if (return_value) ClearBit(blist,*count);          if (return_value) ClearBit(blist,*count);
8822          break;          break;
8823        case EXT:        case EXT:
8824    #if OLD_ext
8825          return_value = ExecuteEXT(inst,statement);          return_value = ExecuteEXT(inst,statement);
8826          if (return_value) ClearBit(blist,*count);          if (return_value) ClearBit(blist,*count);
8827          break;          break;
8828    #endif
8829        case ASGN:        case ASGN:
8830        case REL:        case REL:
8831        case LOGREL:        case LOGREL:
# Line 8824  void ExecuteSelectStatements(struct Inst Line 8837  void ExecuteSelectStatements(struct Inst
8837          break;          break;
8838        case FNAME:        case FNAME:
8839          if (g_iteration>=MAXNUMBER) {          if (g_iteration>=MAXNUMBER) {
8840            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
8841                "FNAME not allowed inside a SELECT Statement");                "FNAME not allowed inside a SELECT Statement");
8842          }          }
8843          return_value = 1; /* Ignore it */          return_value = 1; /* Ignore it */
# Line 8878  void ExecuteUnSelectedStatements(struct Line 8891  void ExecuteUnSelectedStatements(struct
8891          break;          break;
8892        case FNAME:        case FNAME:
8893          if (g_iteration>=MAXNUMBER) {          if (g_iteration>=MAXNUMBER) {
8894            WSEM(ASCERR,statement,"FNAME not allowed inside a SELECT Statement");            STATEMENT_ERROR(statement,"FNAME not allowed inside a SELECT Statement");
8895          }          }
8896          return_value = 1; /*ignore it */          return_value = 1; /*ignore it */
8897          ClearBit(blist,*count);          ClearBit(blist,*count);
# Line 9453  void WriteForValueError(struct Statement Line 9466  void WriteForValueError(struct Statement
9466  {  {
9467    switch(ErrorValue(value)){    switch(ErrorValue(value)){
9468    case type_conflict:    case type_conflict:
9469      WSEM(ASCERR,statement, "Type conflict in FOR expression");      STATEMENT_ERROR(statement, "Type conflict in FOR expression");
9470      break;      break;
9471    case incorrect_name:    case incorrect_name:
9472      WSEM(ASCERR,statement, "Impossible instance in FOR expression");      STATEMENT_ERROR(statement, "Impossible instance in FOR expression");
9473      break;      break;
9474    case temporary_variable_reused:    case temporary_variable_reused:
9475      WSEM(ASCERR,statement, "Temporary variable reused in FOR expression");      STATEMENT_ERROR(statement, "Temporary variable reused in FOR expression");
9476      break;      break;
9477    case dimension_conflict:    case dimension_conflict:
9478      WSEM(ASCERR,statement, "Dimension conflict in FOR expression");      STATEMENT_ERROR(statement, "Dimension conflict in FOR expression");
9479      break;      break;
9480    case incorrect_such_that:    case incorrect_such_that:
9481      WSEM(ASCERR,statement, "Incorrect such that expression in FOR expression");      STATEMENT_ERROR(statement, "Incorrect such that expression in FOR expression");
9482      break;      break;
9483    case empty_choice:    case empty_choice:
9484      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
9485                           "CHOICE is called on an empty set in FOR expression");                           "CHOICE is called on an empty set in FOR expression");
9486      break;      break;
9487    case empty_intersection:    case empty_intersection:
9488      WSEM(ASCERR,statement, "Empty INTERSECTION() in FOR expression");      STATEMENT_ERROR(statement, "Empty INTERSECTION() in FOR expression");
9489      break;      break;
9490    default:    default:
9491      WSEM(ASCERR,statement, "Unexpected error in FOR expression");      STATEMENT_ERROR(statement, "Unexpected error in FOR expression");
9492      break;      break;
9493    }    }
9494  }  }
# Line 9502  int Pass4ExecuteForStatements(struct Ins Line 9515  int Pass4ExecuteForStatements(struct Ins
9515        if (!Pass4ExecuteFOR(inst,statement)) return 0;        if (!Pass4ExecuteFOR(inst,statement)) return 0;
9516        break;        break;
9517      case SELECT:      case SELECT:
9518        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9519             "SELECT statements are not allowed inside a FOR Statement");             "SELECT statements are not allowed inside a FOR Statement");
9520        return 0;        return 0;
9521        /* I probably need to change NP4REF to integer */        /* I probably need to change NP4REF to integer */
# Line 9522  int Pass4ExecuteForStatements(struct Ins Line 9535  int Pass4ExecuteForStatements(struct Ins
9535      case EXT:  /* ignore'm */      case EXT:  /* ignore'm */
9536      break;      break;
9537      default:      default:
9538        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9539             "Inappropriate statement type in declarative section WHEN");             "Inappropriate statement type in declarative section WHEN");
9540        Asc_Panic(2, NULL,        Asc_Panic(2, NULL,
9541                  "Inappropriate statement type in declarative section WHEN");                  "Inappropriate statement type in declarative section WHEN");
# Line 9566  int Pass3ExecuteForStatements(struct Ins Line 9579  int Pass3ExecuteForStatements(struct Ins
9579        return_value = 1; /* ignore'm until pass 4 */        return_value = 1; /* ignore'm until pass 4 */
9580        break;        break;
9581      case FNAME:      case FNAME:
9582        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9583                   "FNAME statements are only allowed inside a WHEN Statement");                   "FNAME statements are only allowed inside a WHEN Statement");
9584        return_value = 0;        return_value = 0;
9585        break;        break;
9586      case SELECT:      case SELECT:
9587        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9588             "SELECT statements are not allowed inside a FOR Statement");             "SELECT statements are not allowed inside a FOR Statement");
9589        return_value = 0;        return_value = 0;
9590        break;        break;
# Line 9581  int Pass3ExecuteForStatements(struct Ins Line 9594  int Pass3ExecuteForStatements(struct Ins
9594        }        }
9595        break;        break;
9596      case COND:      case COND:
9597        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9598                   "COND not allowed inside a FOR. Try FOR inside COND");                   "COND not allowed inside a FOR. Try FOR inside COND");
9599        return_value = 0;        return_value = 0;
9600        break;        break;
# Line 9594  int Pass3ExecuteForStatements(struct Ins Line 9607  int Pass3ExecuteForStatements(struct Ins
9607        }        }
9608        break;        break;
9609      default:      default:
9610        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9611             "Inappropriate statement type in declarative section log rel\n");             "Inappropriate statement type in declarative section log rel\n");
9612        Asc_Panic(2, NULL, "Inappropriate statement type"        Asc_Panic(2, NULL, "Inappropriate statement type"
9613                  " in declarative section log rel\n");                  " in declarative section log rel\n");
# Line 9643  void Pass2ExecuteForStatements(struct In Line 9656  void Pass2ExecuteForStatements(struct In
9656        return_value = 1; /* ignore'm until pass 4 */        return_value = 1; /* ignore'm until pass 4 */
9657        break;        break;
9658      case SELECT:      case SELECT:
9659        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9660             "SELECT statements are not allowed inside a FOR Statement");             "SELECT statements are not allowed inside a FOR Statement");
9661        return_value = 0;        return_value = 0;
9662        break;        break;
9663      case FNAME:      case FNAME:
9664        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9665                   "FNAME statements are only allowed inside a WHEN Statement");                   "FNAME statements are only allowed inside a WHEN Statement");
9666        return_value = 0;        return_value = 0;
9667        break;        break;
# Line 9656  void Pass2ExecuteForStatements(struct In Line 9669  void Pass2ExecuteForStatements(struct In
9669        return_value = 1;        return_value = 1;
9670        if ( ForContainsRelations(statement) ) {        if ( ForContainsRelations(statement) ) {
9671  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
9672        error_reporter_start(ASC_PROG_NOTE,NULL,0);          ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
9673        WriteStatement(stderr, statement, 6);          WriteStatement(stderr, statement, 6);
9674        error_reporter_end_flush();          error_reporter_end_flush();
9675  #endif  #endif
9676          Pass2RealExecuteFOR(inst,statement);          Pass2RealExecuteFOR(inst,statement);
9677          /* p2ref expected to succeed or fail permanently.          /* p2ref expected to succeed or fail permanently.
9678           * if it doesn't, this needs fixing.           * if it doesn't, this needs fixing.
9679           */           */
9680        }        }
9681        break;        break;
9682      case COND:      case COND:
9683        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9684                   "COND not allowed inside a FOR. Try FOR inside COND");                   "COND not allowed inside a FOR. Try FOR inside COND");
9685        return_value = 0;        return_value = 0;
9686        break;        break;
9687      case REL:      case REL:
9688  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
9689        error_reporter_start(ASC_PROG_NOTE,NULL,0);             ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
9690        WriteStatement(stderr, statement, 6);         WriteStatement(stderr, statement, 6);
9691        error_reporter_end_flush();         error_reporter_end_flush();
9692  #endif  #endif
9693        return_value = ExecuteREL(inst,statement);        return_value = ExecuteREL(inst,statement);
9694        /* ER expected to succeed or fail permanently,returning 1.        /* ER expected to succeed or fail permanently,returning 1.
# Line 9685  void Pass2ExecuteForStatements(struct In Line 9698  void Pass2ExecuteForStatements(struct In
9698      case EXT:      case EXT:
9699        return_value = 1;        return_value = 1;
9700        if (!ExecuteEXT(inst,statement)) {        if (!ExecuteEXT(inst,statement)) {
9701          WSEM(ASCERR,statement,"Impossible external relation encountered");          STATEMENT_ERROR(statement,"Impossible external relation encountered");
9702        }        }
9703        break;        break;
9704      default:      default:
9705        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9706        "Inappropriate statement type in declarative section relations");        "Inappropriate statement type in declarative section relations");
9707        Asc_Panic(2, NULL, "Inappropriate statement type"        Asc_Panic(2, NULL, "Inappropriate statement type"
9708                  " in declarative section relations");                  " in declarative section relations");
# Line 9754  void Pass1ExecuteForStatements(struct In Line 9767  void Pass1ExecuteForStatements(struct In
9767        return_value = ExecuteCASGN(inst,statement);        return_value = ExecuteCASGN(inst,statement);
9768        break;        break;
9769      case FNAME:      case FNAME:
9770        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9771                  "FNAME statements are only allowed inside a WHEN Statement");                  "FNAME statements are only allowed inside a WHEN Statement");
9772        return_value = 0;        return_value = 0;
9773        break;        break;
9774      case SELECT:      case SELECT:
9775        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9776                  "SELECT statements are not allowed inside a FOR Statement");                  "SELECT statements are not allowed inside a FOR Statement");
9777        return_value = 0;        return_value = 0;
9778        break;        break;
9779      default:      default:
9780        WSEM(ASCERR,statement,        STATEMENT_ERROR(statement,
9781             "Inappropriate statement type in declarative section");             "Inappropriate statement type in declarative section");
9782        Asc_Panic(2, NULL,        Asc_Panic(2, NULL,
9783                  "Inappropriate statement type in declarative section");                  "Inappropriate statement type in declarative section");
# Line 9805  int ExecuteUnSelectedForStatements(struc Line 9818  int ExecuteUnSelectedForStatements(struc
9818          break;          break;
9819        case FNAME:        case FNAME:
9820          if (g_iteration>=MAXNUMBER) {          if (g_iteration>=MAXNUMBER) {
9821            WSEM(ASCERR,statement,            STATEMENT_ERROR(statement,
9822                "FNAME not allowed inside a SELECT Statement");                "FNAME not allowed inside a SELECT Statement");
9823          }          }
9824          return_value = 1; /*ignore it */          return_value = 1; /*ignore it */
# Line 9828  int ExecuteUnSelectedForStatements(struc Line 9841  int ExecuteUnSelectedForStatements(struc
9841          return_value = ExecuteUnSelectedWHEN(inst,statement);          return_value = ExecuteUnSelectedWHEN(inst,statement);
9842          break;          break;
9843        case COND:        case COND:
9844          WSEM(ASCERR,statement,          STATEMENT_ERROR(statement,
9845          "CONDITIONAL not allowed inside a FOR loop. Try FOR inside COND");          "CONDITIONAL not allowed inside a FOR loop. Try FOR inside COND");
9846          Asc_Panic(2, NULL, "CONDITIONAL not allowed inside a FOR loop."          Asc_Panic(2, NULL, "CONDITIONAL not allowed inside a FOR loop."
9847                    " Try FOR inside COND");                    " Try FOR inside COND");
9848        case SELECT:        case SELECT:
9849          WSEM(ASCERR,statement, "SELECT not allowed inside a FOR Statement");          STATEMENT_ERROR(statement, "SELECT not allowed inside a FOR Statement");
9850          Asc_Panic(2, NULL, "SELECT not allowed inside a FOR Statement");          Asc_Panic(2, NULL, "SELECT not allowed inside a FOR Statement");
9851          break;          break;
9852        default:        default:
# Line 9862  int Pass4RealExecuteFOR(struct Instance Line 9875  int Pass4RealExecuteFOR(struct Instance
9875    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
9876    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
9877    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
9878      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
9879      return 0;      return 0;
9880    }    }
9881    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 9875  int Pass4RealExecuteFOR(struct Instance Line 9888  int Pass4RealExecuteFOR(struct Instance
9888      case name_unfound:      case name_unfound:
9889      case undefined_value:      case undefined_value:
9890        DestroyValue(&value);        DestroyValue(&value);
9891        WSEM(ASCERR,statement, "Phase 4 FOR has undefined values");        STATEMENT_ERROR(statement, "Phase 4 FOR has undefined values");
9892        return 0;        return 0;
9893      default:      default:
9894        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 9954  void MakeRealWhenCaseReferencesFOR(struc Line 9967  void MakeRealWhenCaseReferencesFOR(struc
9967    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
9968    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
9969    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
9970      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
9971      return ;      return ;
9972    }    }
9973    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 9967  void MakeRealWhenCaseReferencesFOR(struc Line 9980  void MakeRealWhenCaseReferencesFOR(struc
9980      case name_unfound:      case name_unfound:
9981      case undefined_value:      case undefined_value:
9982        DestroyValue(&value);        DestroyValue(&value);
9983        WSEM(ASCERR,statement, "Phase 2 FOR has undefined values");        STATEMENT_ERROR(statement, "Phase 2 FOR has undefined values");
9984        break;        break;
9985      default:      default:
9986        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 10032  int Pass3RealExecuteFOR(struct Instance Line 10045  int Pass3RealExecuteFOR(struct Instance
10045    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
10046    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
10047    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
10048      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
10049      return 0;      return 0;
10050    }    }
10051    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 10045  int Pass3RealExecuteFOR(struct Instance Line 10058  int Pass3RealExecuteFOR(struct Instance
10058      case name_unfound:      case name_unfound:
10059      case undefined_value:      case undefined_value:
10060        DestroyValue(&value);        DestroyValue(&value);
10061        WSEM(ASCERR,statement, "Phase 3 FOR has undefined values");        STATEMENT_ERROR(statement, "Phase 3 FOR has undefined values");
10062        return 0;        return 0;
10063      default:      default:
10064        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 10109  void Pass3FORMarkCondLogRels(struct Inst Line 10122  void Pass3FORMarkCondLogRels(struct Inst
10122    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
10123    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
10124    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
10125      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
10126      return ;      return ;
10127    }    }
10128    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 10122  void Pass3FORMarkCondLogRels(struct Inst Line 10135  void Pass3FORMarkCondLogRels(struct Inst
10135      case name_unfound:      case name_unfound:
10136      case undefined_value:      case undefined_value:
10137        DestroyValue(&value);        DestroyValue(&value);
10138        WSEM(ASCERR,statement, "Phase 3 FOR has undefined values");        STATEMENT_ERROR(statement, "Phase 3 FOR has undefined values");
10139        break;        break;
10140      default:      default:
10141        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 10200  int Pass2RealExecuteFOR(struct Instance Line 10213  int Pass2RealExecuteFOR(struct Instance
10213    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
10214    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
10215    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
10216      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
10217      return 0;      return 0;
10218    }    }
10219    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 10213  int Pass2RealExecuteFOR(struct Instance Line 10226  int Pass2RealExecuteFOR(struct Instance
10226      case name_unfound:      case name_unfound:
10227      case undefined_value:      case undefined_value:
10228        DestroyValue(&value);        DestroyValue(&value);
10229        WSEM(ASCERR,statement, "Phase 2 FOR has undefined values");        STATEMENT_ERROR(statement, "Phase 2 FOR has undefined values");
10230        return 0;        return 0;
10231      default:      default:
10232        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 10225  int Pass2RealExecuteFOR(struct Instance Line 10238  int Pass2RealExecuteFOR(struct Instance
10238    case symbol_value:    case symbol_value:
10239    case boolean_value:    case boolean_value:
10240    case list_value:    case list_value:
10241        ERROR_REPORTER_START_NOLINE(ASC_USER_ERROR);
10242      WriteStatement(ASCERR,statement,0);      WriteStatement(ASCERR,statement,0);
10243      FPRINTF(ASCERR,"FOR expression returns the wrong type.\n");      FPRINTF(ASCERR,"FOR expression returns the wrong type.\n");
10244        error_reporter_end_flush();
10245      DestroyValue(&value);      DestroyValue(&value);
10246      return 0;      return 0;
10247    case set_value:    case set_value:
10248      sptr = SetValue(value);      sptr = SetValue(value);
10249      switch(SetKind(sptr)){      switch(SetKind(sptr)){
10250      case empty_set:      case empty_set:
10251  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
10252        FPRINTF(stderr,"Pass2RealExecuteFOR empty_set.\n");        ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"Pass2RealExecuteFOR empty_set.\n");
10253  #endif  #endif
10254        break;        break;
10255      case integer_set:      case integer_set:
# Line 10243  int Pass2RealExecuteFOR(struct Instance Line 10258  int Pass2RealExecuteFOR(struct Instance
10258        AddLoopVariable(GetEvaluationForTable(),fv);        AddLoopVariable(GetEvaluationForTable(),fv);
10259        len = Cardinality(sptr);        len = Cardinality(sptr);
10260  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
10261        FPRINTF(stderr,"Pass2RealExecuteFOR integer_set %lu.\n",len);        ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"Pass2RealExecuteFOR integer_set %lu.\n",len);
10262  #endif  #endif
10263        for(c=1;c<=len;c++){        for(c=1;c<=len;c++){
10264          SetForInteger(fv,FetchIntMember(sptr,c));          SetForInteger(fv,FetchIntMember(sptr,c));
# Line 10258  int Pass2RealExecuteFOR(struct Instance Line 10273  int Pass2RealExecuteFOR(struct Instance
10273        AddLoopVariable(GetEvaluationForTable(),fv);        AddLoopVariable(GetEvaluationForTable(),fv);
10274        len = Cardinality(sptr);        len = Cardinality(sptr);
10275  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
10276        FPRINTF(stderr,"Pass2RealExecuteFOR string_set %lu.\n",len);        ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,"Pass2RealExecuteFOR string_set %lu.\n",len);
10277  #endif  #endif
10278        for(c=1;c<=len;c++){        for(c=1;c<=len;c++){
10279          SetForSymbol(fv,FetchStrMember(sptr,c));          SetForSymbol(fv,FetchStrMember(sptr,c));
# Line 10292  void Pass2FORMarkCondRelations(struct In Line 10307  void Pass2FORMarkCondRelations(struct In
10307    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
10308    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
10309    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
10310      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
10311      return ;      return ;
10312    }    }
10313    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 10305  void Pass2FORMarkCondRelations(struct In Line 10320  void Pass2FORMarkCondRelations(struct In
10320      case name_unfound:      case name_unfound:
10321      case undefined_value:      case undefined_value:
10322        DestroyValue(&value);        DestroyValue(&value);
10323        WSEM(ASCERR,statement, "Phase 2 FOR has undefined values");        STATEMENT_ERROR(statement, "Phase 2 FOR has undefined values");
10324        break;        break;
10325      default:      default:
10326        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 10378  void Pass1RealExecuteFOR(struct Instance Line 10393  void Pass1RealExecuteFOR(struct Instance
10393    ex = ForStatExpr(statement);    ex = ForStatExpr(statement);
10394    sl = ForStatStmts(statement);    sl = ForStatStmts(statement);
10395    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable */
10396      WSEM(ASCERR,statement, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(statement, "FOR construct uses duplicate index variable");
10397      return;      return;
10398    }    }
10399    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 10391  void Pass1RealExecuteFOR(struct Instance Line 10406  void Pass1RealExecuteFOR(struct Instance
10406      case name_unfound:      case name_unfound:
10407      case undefined_value:      case undefined_value:
10408        DestroyValue(&value);        DestroyValue(&value);
10409        WSEM(ASCERR,statement, "FOR has undefined values");        STATEMENT_ERROR(statement, "FOR has undefined values");
10410        Asc_Panic(2, NULL, "FOR has undefined values");        Asc_Panic(2, NULL, "FOR has undefined values");
10411      default:      default:
10412        WriteForValueError(statement,value);        WriteForValueError(statement,value);
# Line 10948  int Pass3ExecuteStatement(struct Instanc Line 10963  int Pass3ExecuteStatement(struct Instanc
10963    case WHEN:    case WHEN:
10964      return 1; /* assumed done  */      return 1; /* assumed done  */
10965    case FNAME:    case FNAME:
10966      WSEM(ASCERR,statement,"FNAME are allowed only inside a WHEN statement");      STATEMENT_ERROR(statement,"FNAME are allowed only inside a WHEN statement");
10967      return 0;      return 0;
10968    default:    default:
10969      return 0;      return 0;
# Line 10962  int Pass2ExecuteStatement(struct Instanc Line 10977  int Pass2ExecuteStatement(struct Instanc
10977    switch(StatementType(statement)){ /* should be an if relinstance */    switch(StatementType(statement)){ /* should be an if relinstance */
10978    case FOR:    case FOR:
10979  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
10980      error_reporter_start(ASC_PROG_NOTE,NULL,0);      ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
10981      WriteStatement(stderr, statement, 3);      WriteStatement(stderr, statement, 3);
10982      error_reporter_end_flush();      error_reporter_end_flush();
10983  #endif  #endif
10984      return Pass2ExecuteFOR(inst,statement);      return Pass2ExecuteFOR(inst,statement);
10985    case REL:    case REL:
10986  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
10987      error_reporter_start(ASC_PROG_NOTE,NULL,0);      ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
10988      WriteStatement(stderr, statement, 3);      WriteStatement(stderr, statement, 3);
10989      error_reporter_end_flush();      error_reporter_end_flush();
10990  #endif  #endif
10991      /* ER expected to succeed or fail permanently. this may change. */      /* ER expected to succeed or fail permanently. this may change. */
10992      return ExecuteREL(inst,statement);      return ExecuteREL(inst,statement);
10993    case EXT:    case EXT:
10994        CONSOLE_DEBUG("ABOUT TO EXECUTEEXT");
10995      return ExecuteEXT(inst,statement);      return ExecuteEXT(inst,statement);
10996    case COND:    case COND:
10997      return Pass2ExecuteCOND(inst,statement);      return Pass2ExecuteCOND(inst,statement);
10998    case LOGREL:    case LOGREL:
10999    case WHEN:    case WHEN:
11000  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
11001      error_reporter_start(ASC_PROG_NOTE,NULL,0);      ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
11002      FPRINTF(stderr,"-- IGNORING WHEN STAT\n");      FPRINTF(stderr,"-- IGNORING WHEN STAT\n");
11003      /* write statement */      /* write statement */
11004      WriteStatement(stderr, statement, 3);      WriteStatement(stderr, statement, 3);
11005      error_reporter_end_flush();      error_reporter_end_flush();
11006  #endif  #endif
11007      return 1; /* assumed done  */      return 1; /* assumed done  */
11008    case FNAME:    case FNAME:
11009      WSEM(ASCERR,statement,"FNAME are allowed only inside a WHEN statement");      STATEMENT_ERROR(statement,"FNAME are allowed only inside a WHEN statement");
11010      return 0;      return 0;
11011    default:    default:
11012      return 0;      return 0;
# Line 11035  int Pass1ExecuteStatement(struct Instanc Line 11051  int Pass1ExecuteStatement(struct Instanc
11051    case WHEN:    case WHEN:
11052      return 1; /* automatically assume done */      return 1; /* automatically assume done */
11053    case FNAME:    case FNAME:
11054      WSEM(ASCERR,statement,"FNAME are allowed only inside a WHEN statement");      STATEMENT_ERROR(statement,"FNAME are allowed only inside a WHEN statement");
11055      return 0;      return 0;
11056    case SELECT:    case SELECT:
11057      return ExecuteSELECT(inst,c,statement);      return ExecuteSELECT(inst,c,statement);
11058    default:    default:
11059      WSEM(ASCERR,statement,      STATEMENT_ERROR(statement,
11060                         "Inappropriate statement type in declarative section");                         "Inappropriate statement type in declarative section");
11061      Asc_Panic(2, NULL, "Inappropriate statement type in declarative section");      Asc_Panic(2, NULL, "Inappropriate statement type in declarative section");
11062    }    }
# Line 11212  void Pass4ProcessPendingInstances(void) Line 11228  void Pass4ProcessPendingInstances(void)
11228          /* we do away with TryArrayExpansion because it doesn't do whens */          /* we do away with TryArrayExpansion because it doesn't do whens */
11229          if (BitListEmpty(blist)) {          if (BitListEmpty(blist)) {
11230            /*            /*
11231         * delete PENDING model.         * delete PENDING model.
11232         */         */
11233        RemoveInstance(PendingInstance(work));        RemoveInstance(PendingInstance(work));
11234          } else {          } else {
11235        /*        /*
11236         * bitlist is still unhappy, but there's nothing to do about it.         * bitlist is still unhappy, but there's nothing to do about it.
11237             * Move the instance to the bottom and increase the counter             * Move the instance to the bottom and increase the counter
11238         * so that we do not visit it again.         * so that we do not visit it again.
# Line 11314  void Pass3ProcessPendingInstances(void) Line 11330  void Pass3ProcessPendingInstances(void)
11330   * This is the singlepass phase2 with anontype sharing of   * This is the singlepass phase2 with anontype sharing of
11331   * relations implemented. If relations can depend on other   * relations implemented. If relations can depend on other
11332   * relations (as in future differential work) then this function   * relations (as in future differential work) then this function
11333   * Needs to be slightly more sophisticated.   * needs to be slightly more sophisticated.
11334   */   */
11335  static  static
11336  void Pass2ProcessPendingInstancesAnon(struct Instance *result)  void Pass2ProcessPendingInstancesAnon(struct Instance *result)
# Line 11330  void Pass2ProcessPendingInstancesAnon(st Line 11346  void Pass2ProcessPendingInstancesAnon(st
11346  #if TIMECOMPILER  #if TIMECOMPILER
11347    clock_t start,classt;    clock_t start,classt;
11348  #endif  #endif
11349      CONSOLE_DEBUG("...");
11350    
11351    /* pending will have at least one instance, or quick return. */    /* pending will have at least one instance, or quick return. */
11352    assert(PASS2MAXNUMBER==1);    assert(PASS2MAXNUMBER==1);
# Line 11354  void Pass2ProcessPendingInstancesAnon(st Line 11371  void Pass2ProcessPendingInstancesAnon(st
11371        proto = Asc_GetAnonPrototype(at);        proto = Asc_GetAnonPrototype(at);
11372        if (InstanceKind(proto) == MODEL_INST && InstanceInList(proto)) {        if (InstanceKind(proto) == MODEL_INST && InstanceInList(proto)) {
11373  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
11374          error_reporter_start(ASC_PROG_NOTE,NULL,0);          ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
11375          FPRINTF(stderr,"Rels in model: ");          FPRINTF(stderr,"Rels in model: ");
11376          WriteInstanceName(stderr,proto,NULL); FPRINTF(stderr,"\n");          WriteInstanceName(stderr,proto,NULL); FPRINTF(stderr,"\n");
11377          error_reporter_end_flush();          error_reporter_end_flush();
11378  #endif  #endif
11379          blist = InstanceBitList(proto);          blist = InstanceBitList(proto);
11380          if ((blist!=NULL) && !BitListEmpty(blist)) {          if ((blist!=NULL) && !BitListEmpty(blist)) {
# Line 11578  static void ExecuteDefault(struct Instan Line 11595  static void ExecuteDefault(struct Instan
11595                SetRealAtomDims(ptr,Dimensionless());                SetRealAtomDims(ptr,Dimensionless());
11596                break;                break;
11597              default:              default:
11598                WSEM(ASCERR,stat,"Bad real default value");                STATEMENT_ERROR(stat,"Bad real default value");
11599                break;                break;
11600              }              }
11601            } else {            } else {
11602              switch(ValueKind(value)) {              switch(ValueKind(value)) {
11603              case real_value:              case real_value:
11604                if ( !SameDimen(RealValueDimensions(value),RealAtomDims(ptr)) ){                if ( !SameDimen(RealValueDimensions(value),RealAtomDims(ptr)) ){
11605                  WSEM(ASCERR,stat,                  STATEMENT_ERROR(stat,
11606                  "Default right hand side is dimensionally inconsistent");                  "Default right hand side is dimensionally inconsistent");
11607                } else {                } else {
11608                  SetRealAtomValue(ptr,RealValue(value),*depth);                  SetRealAtomValue(ptr,RealValue(value),*depth);
# Line 11593  static void ExecuteDefault(struct Instan Line 11610  static void ExecuteDefault(struct Instan
11610                break;                break;
11611              case integer_value:              case integer_value:
11612                if ( !SameDimen(Dimensionless(),RealAtomDims(ptr)) ){                if ( !SameDimen(Dimensionless(),RealAtomDims(ptr)) ){
11613                  WSEM(ASCERR,stat,                  STATEMENT_ERROR(stat,
11614                  "Default right hand side is dimensionally inconsistent");                  "Default right hand side is dimensionally inconsistent");
11615                } else {                } else {
11616                  SetRealAtomValue(ptr,(double)IntegerValue(value),*depth);                  SetRealAtomValue(ptr,(double)IntegerValue(value),*depth);
11617                }                }
11618                break;                break;
11619              default:              default:
11620                WSEM(ASCERR,stat,"Bad real default value");                STATEMENT_ERROR(stat,"Bad real default value");
11621                break;                break;
11622              }              }
11623            }            }
# Line 11620  static void ExecuteDefault(struct Instan Line 11637  static void ExecuteDefault(struct Instan
11637              SetBooleanAtomValue(ptr,BooleanValue(value),*depth);              SetBooleanAtomValue(ptr,BooleanValue(value),*depth);
11638            }            }
11639            else{            else{
11640              WSEM(ASCERR,stat, "Bad boolean default value");              STATEMENT_ERROR(stat, "Bad boolean default value");
11641            }            }
11642            DestroyValue(&value);            DestroyValue(&value);
11643          }          }
# Line 11637  static void ExecuteDefault(struct Instan Line 11654  static void ExecuteDefault(struct Instan
11654            SetIntegerAtomValue(ptr,IntegerValue(value),0);            SetIntegerAtomValue(ptr,IntegerValue(value),0);
11655          }          }
11656          else{          else{
11657            WSEM(ASCERR,stat, "Bad integer default value");            STATEMENT_ERROR(stat, "Bad integer default value");
11658          }          }
11659          DestroyValue(&value);          DestroyValue(&value);
11660          break;          break;
# Line 11652  static void ExecuteDefault(struct Instan Line 11669  static void ExecuteDefault(struct Instan
11669            SetSymbolAtomValue(ptr,SymbolValue(value));            SetSymbolAtomValue(ptr,SymbolValue(value));
11670          }          }
11671          else{          else{
11672            WSEM(ASCERR,stat, "Bad symbol default value");            STATEMENT_ERROR(stat, "Bad symbol default value");
11673          }          }
11674          DestroyValue(&value);          DestroyValue(&value);
11675          break;          break;
# Line 11663  static void ExecuteDefault(struct Instan Line 11680  static void ExecuteDefault(struct Instan
11680      gl_destroy(lvals);      gl_destroy(lvals);
11681    }    }
11682    else{    else{
11683      WSEM(ASCERR,stat, "Nonexistent LHS variable in default statement.");      STATEMENT_ERROR(stat, "Nonexistent LHS variable in default statement.");
11684    }    }
11685  }  }
11686    
# Line 11715  void RealDefaultFor(struct Instance *i, Line 11732  void RealDefaultFor(struct Instance *i,
11732    ex = ForStatExpr(stat);    ex = ForStatExpr(stat);
11733    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable*/    if (FindForVar(GetEvaluationForTable(),name)){ /* duplicated for variable*/
11734      FPRINTF(ASCERR,"Error during default stage.\n");      FPRINTF(ASCERR,"Error during default stage.\n");
11735      WSEM(ASCERR,stat, "FOR construct uses duplicate index variable");      STATEMENT_ERROR(stat, "FOR construct uses duplicate index variable");
11736      return;      return;
11737    }    }
11738    assert(GetEvaluationContext()==NULL);    assert(GetEvaluationContext()==NULL);
# Line 11729  void RealDefaultFor(struct Instance *i, Line 11746  void RealDefaultFor(struct Instance *i,
11746      case undefined_value:      case undefined_value:
11747        DestroyValue(&value);        DestroyValue(&value);
11748        FPRINTF(ASCERR,"Error in default stage.\n");        FPRINTF(ASCERR,"Error in default stage.\n");
11749        WSEM(ASCERR,stat, "FOR has undefined values");        STATEMENT_ERROR(stat, "FOR has undefined values");
11750        return;        return;
11751      default:      default:
11752        WriteForValueError(stat,value);        WriteForValueError(stat,value);
# Line 11742  void RealDefaultFor(struct Instance *i, Line 11759  void RealDefaultFor(struct Instance *i,
11759    case boolean_value:    case boolean_value:
11760    case list_value:    case list_value:
11761      FPRINTF(ASCERR,"Error during default stage.\n");      FPRINTF(ASCERR,"Error during default stage.\n");
11762      WSEM(ASCERR,stat, "FOR expression returns the wrong type");      STATEMENT_ERROR(stat, "FOR expression returns the wrong type");
11763      DestroyValue(&value);      DestroyValue(&value);
11764      return;      return;
11765    case set_value:    case set_value:
# Line 11986  static Line 12003  static
12003  struct Instance *Pass2InstantiateModel(struct Instance *result,  struct Instance *Pass2InstantiateModel(struct Instance *result,
12004                                         unsigned long *pcount)                                         unsigned long *pcount)
12005  {  {
12006      CONSOLE_DEBUG("starting...");
12007    /* do we need a ForTable on the stack here? don't think so. np2ppi does it */    /* do we need a ForTable on the stack here? don't think so. np2ppi does it */
12008    if (result!=NULL) {    if (result!=NULL) {
12009        CONSOLE_DEBUG("result!=NULL...");
12010      /* pass2 pendings already set by visit */      /* pass2 pendings already set by visit */
12011      if (ANONFORCE || g_use_copyanon != 0) {      if (ANONFORCE || g_use_copyanon != 0) {
12012  #if TIMECOMPILER  #if TIMECOMPILER
# Line 12011  struct Instance *Pass2InstantiateModel(s Line 12030  struct Instance *Pass2InstantiateModel(s
12030      }      }
12031      ClearList();      ClearList();
12032    }    }
12033      CONSOLE_DEBUG("...done");
12034    return result;    return result;
12035  }  }
12036    
# Line 12021  void Pass2SetRelationBits(struct Instanc Line 12041  void Pass2SetRelationBits(struct Instanc
12041    if (inst != NULL && InstanceKind(inst)==MODEL_INST) {    if (inst != NULL && InstanceKind(inst)==MODEL_INST) {
12042      struct BitList *blist;      struct BitList *blist;
12043  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
12044      error_reporter_start(ASC_PROG_NOTE,NULL,0);      ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
12045      FPRINTF(stderr,"P2SRB: ");      FPRINTF(ASCERR,"P2SRB: ");
12046      WriteInstanceName(ASCERR,inst,debug_rels_work);      WriteInstanceName(ASCERR,inst,debug_rels_work);
12047      error_reporter_end_flush();      FPRINTF(ASCERR,"\n");
12048        error_reporter_end_flush();
12049  #endif  #endif
12050    
12051      blist = InstanceBitList(inst);      blist = InstanceBitList(inst);
# Line 12050  void Pass2SetRelationBits(struct Instanc Line 12071  void Pass2SetRelationBits(struct Instanc
12071            }            }
12072          }          }
12073          else {          else {
12074            if ( st == REL || (st == COND && CondContainsRelations(stat)) ||            if ( st == REL ||
12075    #if NEW_ext
12076            st == EXT ||
12077    #endif
12078             (st == COND && CondContainsRelations(stat)) ||
12079               (st == FOR && ForContainsRelations(stat)) ){               (st == FOR && ForContainsRelations(stat)) ){
12080              SetBit(blist,c);              SetBit(blist,c);
12081              changed++;              changed++;
# Line 12064  void Pass2SetRelationBits(struct Instanc Line 12089  void Pass2SetRelationBits(struct Instanc
12089          AddBelow(NULL,inst);          AddBelow(NULL,inst);
12090          /* add PENDING model */          /* add PENDING model */
12091  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
12092          error_reporter_start(ASC_PROG_NOTE,NULL,0);          ERROR_REPORTER_START_NOLINE(ASC_PROG_NOTE);
12093          FPRINTF(stderr,"Changed: ");          FPRINTF(stderr,"Changed: ");
12094          WriteInstanceName(ASCERR,inst,debug_rels_work);          WriteInstanceName(ASCERR,inst,debug_rels_work);
12095          error_reporter_end_flush();          error_reporter_end_flush();
# Line 12175  struct Instance *NewInstantiateModel(str Line 12200  struct Instance *NewInstantiateModel(str
12200    /* At this point, there may be unexecuted non-relation    /* At this point, there may be unexecuted non-relation
12201     * statements, but they can never be executed. The     * statements, but they can never be executed. The
12202     * pending list is therefore empty. We know how many.     * pending list is therefore empty. We know how many.
12203     * The bitlists know which ones.     * The bitlists know which ones.
12204     */     */
12205    if (result!=NULL) {    if (result!=NULL) {
12206  #ifdef DEBUG_RELS  #ifdef DEBUG_RELS
# Line 12201  struct Instance *NewInstantiateModel(str Line 12226  struct Instance *NewInstantiateModel(str
12226    FPRINTF(ASCERR,"Phase 2 relations \t\t%lu\n",    FPRINTF(ASCERR,"Phase 2 relations \t\t%lu\n",
12227      (unsigned long)(phase2t-phase1t));      (unsigned long)(phase2t-phase1t));
12228  #endif  #endif
12229      CONSOLE_DEBUG("Starting phase 3...");
12230    /* at this point, there may be unexecuted non-logical relation    /* at this point, there may be unexecuted non-logical relation
12231     * statements, but they can never be executed. The     * statements, but they can never be executed. The
12232     * pending list is therefore empty. We know how many.     * pending list is therefore empty. We know how many.
# Line 12209  struct Instance *NewInstantiateModel(str Line 12235  struct Instance *NewInstantiateModel(str
12235    if (result!=NULL) {    if (result!=NULL) {
12236      /* now set the bits for relation statements and add pending models */      /* now set the bits for relation statements and add pending models */
12237      SilentVisitInstanceTree(result,Pass3SetLogRelBits,0,0);      SilentVisitInstanceTree(result,Pass3SetLogRelBits,0,0);
12238      /* note, the order of the visit might be better 1 than 0. don't know      /* note, the order of the visit might be better 1 than 0. don't know
12239       * at present order 0, so we do lower models before those near root       * at present order 0, so we do lower models before those near root
12240       */       */
12241      result = Pass3InstantiateModel(result,&pass3pendings);      result = Pass3InstantiateModel(result,&pass3pendings);
12242     /* result will not move as currently implemented */     /* result will not move as currently implemented */
# Line 12242  struct Instance *NewInstantiateModel(str Line 12268  struct Instance *NewInstantiateModel(str
12268        DefaultInstanceTree(result);        DefaultInstanceTree(result);
12269      }      }
12270      else{      else{
12271        error_reporter(ASC_USER_WARNING,NULL,0,"There are unexecuted statements "        ERROR_REPORTER_NOLINE(ASC_USER_WARNING,"There are unexecuted statements "
12272          "in the instance.\nDefault assignments not executed.");          "in the instance.\nDefault assignments not executed.");
12273      }      }
12274    }    }
# Line 12323  struct Instance *NewRealInstantiate(stru Line 12349  struct Instance *NewRealInstantiate(stru
12349                                   int intset)                                   int intset)
12350  {  {
12351    struct Instance *result;    struct Instance *result;
12352      CONSOLE_DEBUG("...");
12353    
12354    result = ShortCutMakeUniversalInstance(def); /*does quick Universal check */    result = ShortCutMakeUniversalInstance(def); /*does quick Universal check */
12355    if (result) return result;    if (result) return result;

Legend:
Removed from v.183  
changed lines
  Added in v.530

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22