generic/solver/var.c

/*
 *  SLV: Ascend Numeric Solver
 *  by Karl Michael Westerberg
 *  Created: 2/6/90
 *  Version: $Revision: 1.31 $
 *  Version control file: $RCSfile: var.c,v $
 *  Date last modified: $Date: 1998/02/19 13:31:36 $
 *  Last modified by: $Author: mthomas $
 *
 *  This file is part of the SLV solver.
 *
 *  Copyright (C) 1990 Karl Michael Westerberg
 *  Copyright (C) 1993 Joseph Zaher
 *  Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
 *
 *  The SLV solver is free software; you can redistribute
 *  it and/or modify it under the terms of the GNU General Public License as
 *  published by the Free Software Foundation; either version 2 of the
 *  License, or (at your option) any later version.
 *
 *  The SLV solver is distributed in hope that it will be
 *  useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with the program; if not, write to the Free Software Foundation,
 *  Inc., 675 Mass Ave, Cambridge, MA 02139 USA.  Check the file named
 *  COPYING.  COPYING is found in ../compiler.
 *
 */

#include <utilities/ascConfig.h>
#include <utilities/ascMalloc.h>
#include <general/dstring.h>
#include <general/list.h>
#include <compiler/compiler.h>
#include <compiler/symtab.h>
#include <compiler/instance_enum.h>
#include <compiler/fractions.h>
#include <compiler/module.h>
#include <compiler/library.h>
#include <compiler/dimen.h>
#include <compiler/child.h>
#include <compiler/type_desc.h>
#include <compiler/atomvalue.h>
#include <compiler/parentchild.h>
#include <compiler/instquery.h>
#include <compiler/instance_io.h>
#include "mtx.h"
#include "slv_types.h"
#include "rel.h"
#include "var.h"
#include "discrete.h"
#include "conditional.h"
#include "logrel.h"
#include "bnd.h"
#include "slv_server.h"
#include "slv_common.h"
#include "linsol.h"
#include "linsolqr.h"
#include "slv_client.h"

/* useful cast */
#define IPTR(i) ((struct Instance *)(i))

/* useful symbol table things to know */
#define FIXED_V g_strings[0]
#define LOWER_V g_strings[1]
#define UPPER_V g_strings[2]
#define RELAXED_V g_strings[3]
#define NOMINAL_V g_strings[4]
#define INTERFACE_V g_strings[5]
#define ODEATOL_V g_strings[6]

/*
 * array of those symbol table entries we need.
 */
static symchar * g_strings[7];

SlvBackendToken var_instanceF(const struct var_variable *var)
{ if (var==NULL || var->ratom==NULL) {
    FPRINTF(stderr,"var_instance called on bad var\n");
    return NULL;
  }
  return var->ratom;
}

void var_set_instanceF(struct var_variable *var, SlvBackendToken i)
{
  if (var==NULL)  {
    FPRINTF(stderr,"var_set_instance called on NULL var\n");
    return;
  }
  var->ratom = i;
}


char *var_make_name(const slv_system_t sys,const  struct var_variable *var)
{
  return WriteInstanceNameString(IPTR(var->ratom),IPTR(slv_instance(sys)));
}

char *var_make_xname(const struct var_variable *var)
{
   static char name[81];
   char *res;
   sprintf(name,"x%d",var_sindex(var));
   res=ASC_NEW_ARRAY(char,strlen(name)+1);
   sprintf(res,"%s",name);
   return res;
}

void var_write_name(const slv_system_t sys,
  const struct var_variable *var,FILE *fp)
{
  if (var == NULL || fp==NULL) return;
  if (sys!=NULL) {
    WriteInstanceName(fp,var_instance(var),slv_instance(sys));
  } else {
    WriteInstanceName(fp,var_instance(var),NULL);
  }
}

void var_destroy(struct var_variable *var)
{
  if (var==NULL) return;
  var->ratom = NULL;
  ascfree((POINTER)var->incidence);
}


int32 var_mindexF(const struct var_variable *var)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return -1;
  }
  return var->mindex;
}

void var_set_mindexF(struct var_variable *var, int32 mindex)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  var->mindex = mindex;
}

int32 var_sindexF(const struct var_variable *var)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return -1;
  }
  return var->sindex;
}

void var_set_sindexF(struct var_variable *var, int32 sindex)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  var->sindex = sindex;
}

real64 var_value(const struct var_variable *var)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0.0;
  }
  return( RealAtomValue(var->ratom) );
}

void var_set_value(struct var_variable *var, real64 value)
{
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  SetRealAtomValue(var->ratom,value,(unsigned)0);
}

real64 var_nominal(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 1.0;
  }
  c = ChildByChar(var->ratom,NOMINAL_V);
  if( c == NULL ) {
    FPRINTF(ASCERR,"no 'nominal' field in variable");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return 1.0;
  }
  return( RealAtomValue(c) );
}

void var_set_nominal(struct var_variable *var, real64 nominal)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),NOMINAL_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'nominal' field in var");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetRealAtomValue(c,nominal,(unsigned)0);
}


real64 var_lower_bound(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0.0;
  }
  c = ChildByChar(IPTR(var->ratom),LOWER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
    WriteInstance(stderr,IPTR(var->ratom));
    return 0.0;
  }
  return( RealAtomValue(c) );
}

void var_set_lower_bound(struct var_variable *var, real64 lower_bound)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),LOWER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetRealAtomValue(c,lower_bound,(unsigned)0);
}


real64 var_upper_bound(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0.0;
  }
  c = ChildByChar(IPTR(var->ratom),UPPER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return 0.0;
  }
  return( RealAtomValue(c) );
}

void var_set_upper_bound(struct var_variable *var, real64 upper_bound)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),UPPER_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetRealAtomValue(c,upper_bound,(unsigned)0);
}

double var_odeatol(struct var_variable *var){
    struct Instance *c;
    if(var==NULL||var->ratom==NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
        return -1;
    }
    c = ChildByChar(IPTR(var->ratom),ODEATOL_V);
    if(c==NULL){
        ERROR_REPORTER_HERE(ASC_PROG_ERR,"no '%s' field",SCP(ODEATOL_V));
        return -1;
    }
    return RealAtomValue(c);
}
    

uint32 var_flagsF(const struct var_variable *var)
{
  return var->flags;
}

void var_set_flagsF(struct var_variable *var, uint32 flags)
{
  var->flags = flags;
}

uint32 var_fixed(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return FALSE;
  }
  c = ChildByChar(IPTR(var->ratom),FIXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return FALSE;
  }
  var_set_flagbit(var,VAR_FIXED,GetBooleanAtomValue(c));
  return( GetBooleanAtomValue(c) );
}

void var_set_fixed(struct var_variable *var, uint32 fixed)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),FIXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetBooleanAtomValue(c,fixed,(unsigned)0);
  var_set_flagbit(var,VAR_FIXED,fixed);
}

uint32 var_relaxed(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return FALSE;
  }
  c = ChildByChar((var->ratom),RELAXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
    /* WriteInstance(stderr,(var->ratom)); */
    return FALSE;
  }
  var_set_flagbit(var,VAR_RELAXED,GetBooleanAtomValue(c));
  return( GetBooleanAtomValue(c) );
}

void var_set_relaxed(struct var_variable *var, uint32 fixed)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  c = ChildByChar(IPTR(var->ratom),RELAXED_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return;
  }
  SetBooleanAtomValue(c,fixed,(unsigned)0);
  var_set_flagbit(var,VAR_RELAXED,fixed);
}

uint32 var_interface(struct var_variable *var)
{
  struct Instance *c;
  if (var==NULL || var->ratom==NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return FALSE;
  }
  c = ChildByChar(IPTR(var->ratom),INTERFACE_V);
  if( c == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'interface' field");
    /* WriteInstance(stderr,IPTR(var->ratom)); */
    return 0;
  }
  var_set_flagbit(var,VAR_INTERFACE,GetBooleanAtomValue(c));
  return( GetIntegerAtomValue(c) );
}

extern uint32 var_flagbit(const struct var_variable *var,const uint32 one)
{
  if (var==NULL || var->ratom == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return 0;
  }
  return (var->flags & one);
}

void var_set_flagbit(struct var_variable *var, uint32 field,uint32 one)
{
  if (var==NULL || var->ratom == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
    return;
  }
  if (one) {
    var->flags |= field;
  } else {
    var->flags &= ~field;
  }
}

int32 var_apply_filter(const struct var_variable *var, 
    const var_filter_t *filter
){
  if (var==NULL || filter==NULL || var->ratom == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"miscalled with NULL");
    return FALSE;
  }
  /* AND to mask off irrelevant bits in flags and match value, then compare */
  return (filter->matchbits & var->flags) == (filter->matchbits & filter->matchvalue);
}

/**
    Implementation function for var_n_incidences().  Do not call this
    function directly - use var_n_incidences() instead.
*/
int32 var_n_incidencesF(struct var_variable *var)
{
  if (var!=NULL) return var->n_incidences;
  ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var");
  return 0;
}

void var_set_incidencesF(struct var_variable *var,int32 n,
                         struct rel_relation **i)
{
  if(var!=NULL && n >=0) {
    if (n && i==NULL) {
      ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL i");
    }
    var->n_incidences = n;
    var->incidence = i;
    return;
  }
  ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var, or n < 0");
}
const struct rel_relation **var_incidence_list( struct var_variable *var)
{
  if (var==NULL) return NULL;
  return( (const struct rel_relation **)var->incidence );
}

struct rel_relation **var_incidence_list_to_modify( struct var_variable *var)
{
  if (var==NULL) return NULL;
  return( (struct rel_relation **)var->incidence );
}


/* 
 * global for use with the push function. Sets the ip to the
 * value in g_var_tag;
 * should be using vp instead of a global counter.
 */
static void *g_var_tag = NULL;
static void * SetVarTags(struct Instance *i,VOIDPTR vp)
{
  (void)vp;
  if (i!=NULL && InstanceKind(i)==REAL_ATOM_INST) {
    return g_var_tag;
  } else {
    return NULL;
  }
}

struct var_variable **var_BackendTokens_to_vars(slv_system_t sys,
  SlvBackendToken *atoms, int32 len)
{
  int32 i,vartot,vlen,count=0;
  uint32 apos,ulen;
  struct var_variable **result;
  struct var_variable **vlist;
  struct gl_list_t *oldips;
  if (sys==NULL || atoms == NULL || len < 1) {
    return NULL;
  }
  ulen = (uint32)len;
  result = (struct var_variable **)malloc(len*sizeof(struct var_variable *));
  if (result == NULL) return result;
  /* init results to null */
  for (i=0; i<len; i++) result[i] = NULL;
  /* fill ips w/len in all the vars in tree. */
  g_var_tag = (void *)len;
  vartot = slv_get_num_master_vars(sys) +
           slv_get_num_master_pars(sys) +
           slv_get_num_master_unattached(sys);
  oldips = PushInterfacePtrs(slv_instance(sys),SetVarTags,vartot,0,NULL);
  /* fill ips of wanted atoms with i */
  for (i=0; i<len; i++) {
    if (GetInterfacePtr(atoms[i])==g_var_tag &&
    InstanceKind(atoms[i]) == REAL_ATOM_INST) {
    /* guard a little */
      SetInterfacePtr((struct Instance *)atoms[i],(void *)i);
    } else {
      /* the odds of g_var_tag being a legal pointer are vanishingly
    small, so if we find an ATOM without g_var_tag we assume it
    is outside the tree and shouldn't have been in the list. */
      ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad token");
    }
  }
  /* run through the master lists and put the vars with their atoms */
  vlist = slv_get_master_var_list(sys);
  vlen = slv_get_num_master_vars(sys);
  for (i = 0; i <vlen; i++) {
    apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
    if ( apos < ulen ) {
      result[apos] = vlist[i];
      count++;
    }
  }
  vlist = slv_get_master_par_list(sys);
  vlen = slv_get_num_master_pars(sys);
  for (i = 0; i <vlen; i++) {
    apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
    if ( apos < ulen ) {
      result[apos] = vlist[i];
      count++;
    }
  }
  vlist = slv_get_master_unattached_list(sys);
  vlen = slv_get_num_master_unattached(sys);
  for (i = 0; i <vlen; i++) {
    apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
    if ( apos < ulen ) {
      result[apos] = vlist[i];
      count++;
    }
  }
  if (count < len) {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"found less than expected vars (len = %d, found = %d)",len,count);
  } else {
    ERROR_REPORTER_HERE(ASC_PROG_ERR,"found more than expected vars (len = %d, found = %d)",len,count);
  }
  PopInterfacePtrs(oldips,NULL,NULL);
  return result;
}

static struct TypeDescription *g_solver_var_type;
static struct TypeDescription *g_solver_int_type;
static struct TypeDescription *g_solver_binary_type;
static struct TypeDescription *g_solver_semi_type;

boolean set_solver_types(void) {
  boolean nerr = 0;
  if( (g_solver_var_type = FindType(AddSymbol(SOLVER_VAR_STR))) == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_var' not defined");
    nerr++;
  }
  if( (g_solver_int_type = FindType(AddSymbol(SOLVER_INT_STR))) == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_ERROR,"'solver_int' not defined: MPS will not work");
    nerr++;
  }
  g_solver_binary_type = FindType(AddSymbol(SOLVER_BINARY_STR));
  if( g_solver_binary_type == NULL) {
    ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_binary' not defined: MPS will not work");
    nerr++;
  }
  if( (g_solver_semi_type = FindType(AddSymbol(SOLVER_SEMI_STR))) == NULL ) {
    ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_semi' not defined: MPS will not work");
    nerr++;
  }

  LOWER_V = AddSymbolL("lower_bound",11);
  UPPER_V = AddSymbolL("upper_bound",11);
  RELAXED_V = AddSymbolL("relaxed",7);
  NOMINAL_V = AddSymbolL("nominal",7);
  FIXED_V = AddSymbolL("fixed",5);
  INTERFACE_V = AddSymbolL("interface",9);
  ODEATOL_V = AddSymbol("ode_atol"); 
  return nerr;
}

boolean solver_var( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_var_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_var_type) );
}

boolean solver_int( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_int_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_int_type) );
}

boolean solver_binary( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_binary_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_binary_type) );
}

boolean solver_semi( SlvBackendToken inst)
{
  struct TypeDescription *type;

  if (!g_solver_semi_type) return FALSE;
  type = InstanceTypeDesc(IPTR(inst));
  return( type == MoreRefined(type,g_solver_semi_type) );
}

1	aw0a	1	/*
2			* SLV: Ascend Numeric Solver
3			* by Karl Michael Westerberg
4			* Created: 2/6/90
5			* Version: $Revision: 1.31 $
6			* Version control file: $RCSfile: var.c,v $
7			* Date last modified: $Date: 1998/02/19 13:31:36 $
8			* Last modified by: $Author: mthomas $
9			*
10			* This file is part of the SLV solver.
11			*
12			* Copyright (C) 1990 Karl Michael Westerberg
13			* Copyright (C) 1993 Joseph Zaher
14			* Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
15			*
16			* The SLV solver is free software; you can redistribute
17			* it and/or modify it under the terms of the GNU General Public License as
18			* published by the Free Software Foundation; either version 2 of the
19			* License, or (at your option) any later version.
20			*
21			* The SLV solver is distributed in hope that it will be
22			* useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
23			* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
24			* General Public License for more details.
25			*
26			* You should have received a copy of the GNU General Public License
27			* along with the program; if not, write to the Free Software Foundation,
28			* Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
29			* COPYING. COPYING is found in ../compiler.
30			*
31			*/
32
33	johnpye	399	#include <utilities/ascConfig.h>
34			#include <utilities/ascMalloc.h>
35			#include <general/dstring.h>
36			#include <general/list.h>
37			#include <compiler/compiler.h>
38			#include <compiler/symtab.h>
39			#include <compiler/instance_enum.h>
40			#include <compiler/fractions.h>
41			#include <compiler/module.h>
42			#include <compiler/library.h>
43			#include <compiler/dimen.h>
44			#include <compiler/child.h>
45			#include <compiler/type_desc.h>
46			#include <compiler/atomvalue.h>
47			#include <compiler/parentchild.h>
48			#include <compiler/instquery.h>
49			#include <compiler/instance_io.h>
50			#include "mtx.h"
51			#include "slv_types.h"
52			#include "rel.h"
53			#include "var.h"
54			#include "discrete.h"
55			#include "conditional.h"
56			#include "logrel.h"
57			#include "bnd.h"
58			#include "slv_server.h"
59			#include "slv_common.h"
60			#include "linsol.h"
61			#include "linsolqr.h"
62			#include "slv_client.h"
63	aw0a	1
64			/* useful cast */
65			#define IPTR(i) ((struct Instance *)(i))
66
67			/* useful symbol table things to know */
68			#define FIXED_V g_strings[0]
69			#define LOWER_V g_strings[1]
70			#define UPPER_V g_strings[2]
71			#define RELAXED_V g_strings[3]
72			#define NOMINAL_V g_strings[4]
73			#define INTERFACE_V g_strings[5]
74	johnpye	944	#define ODEATOL_V g_strings[6]
75	aw0a	1
76			/*
77			* array of those symbol table entries we need.
78			*/
79	johnpye	944	static symchar * g_strings[7];
80	aw0a	1
81			SlvBackendToken var_instanceF(const struct var_variable *var)
82			{ if (var==NULL \|\| var->ratom==NULL) {
83			FPRINTF(stderr,"var_instance called on bad var\n");
84			return NULL;
85			}
86			return var->ratom;
87			}
88
89			void var_set_instanceF(struct var_variable *var, SlvBackendToken i)
90			{
91			if (var==NULL) {
92			FPRINTF(stderr,"var_set_instance called on NULL var\n");
93			return;
94			}
95			var->ratom = i;
96			}
97
98
99			char var_make_name(const slv_system_t sys,const struct var_variable var)
100			{
101			return WriteInstanceNameString(IPTR(var->ratom),IPTR(slv_instance(sys)));
102			}
103
104			char var_make_xname(const struct var_variable var)
105			{
106			static char name[81];
107			char *res;
108			sprintf(name,"x%d",var_sindex(var));
109	johnpye	709	res=ASC_NEW_ARRAY(char,strlen(name)+1);
110	aw0a	1	sprintf(res,"%s",name);
111			return res;
112			}
113
114			void var_write_name(const slv_system_t sys,
115			const struct var_variable var,FILE fp)
116			{
117			if (var == NULL \|\| fp==NULL) return;
118			if (sys!=NULL) {
119			WriteInstanceName(fp,var_instance(var),slv_instance(sys));
120			} else {
121			WriteInstanceName(fp,var_instance(var),NULL);
122			}
123			}
124
125			void var_destroy(struct var_variable *var)
126			{
127			if (var==NULL) return;
128			var->ratom = NULL;
129			ascfree((POINTER)var->incidence);
130			}
131
132
133			int32 var_mindexF(const struct var_variable *var)
134			{
135			if (var==NULL \|\| var->ratom==NULL) {
136	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
137	aw0a	1	return -1;
138			}
139			return var->mindex;
140			}
141
142	johnpye	908	void var_set_mindexF(struct var_variable *var, int32 mindex)
143	aw0a	1	{
144			if (var==NULL \|\| var->ratom==NULL) {
145	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
146	aw0a	1	return;
147			}
148	johnpye	908	var->mindex = mindex;
149	aw0a	1	}
150
151			int32 var_sindexF(const struct var_variable *var)
152			{
153			if (var==NULL \|\| var->ratom==NULL) {
154	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
155	aw0a	1	return -1;
156			}
157			return var->sindex;
158			}
159
160	johnpye	908	void var_set_sindexF(struct var_variable *var, int32 sindex)
161	aw0a	1	{
162			if (var==NULL \|\| var->ratom==NULL) {
163	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
164	aw0a	1	return;
165			}
166	johnpye	908	var->sindex = sindex;
167	aw0a	1	}
168
169			real64 var_value(const struct var_variable *var)
170			{
171			if (var==NULL \|\| var->ratom==NULL) {
172	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
173	aw0a	1	return 0.0;
174			}
175			return( RealAtomValue(var->ratom) );
176			}
177
178			void var_set_value(struct var_variable *var, real64 value)
179			{
180			if (var==NULL \|\| var->ratom==NULL) {
181	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
182	aw0a	1	return;
183			}
184			SetRealAtomValue(var->ratom,value,(unsigned)0);
185			}
186
187			real64 var_nominal(struct var_variable *var)
188			{
189			struct Instance *c;
190			if (var==NULL \|\| var->ratom==NULL) {
191	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
192	aw0a	1	return 1.0;
193			}
194			c = ChildByChar(var->ratom,NOMINAL_V);
195			if( c == NULL ) {
196	johnpye	944	FPRINTF(ASCERR,"no 'nominal' field in variable");
197			/* WriteInstance(stderr,IPTR(var->ratom)); */
198	aw0a	1	return 1.0;
199			}
200			return( RealAtomValue(c) );
201			}
202
203			void var_set_nominal(struct var_variable *var, real64 nominal)
204			{
205			struct Instance *c;
206			if (var==NULL \|\| var->ratom==NULL) {
207	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
208	aw0a	1	return;
209			}
210			c = ChildByChar(IPTR(var->ratom),NOMINAL_V);
211			if( c == NULL ) {
212	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'nominal' field in var");
213			/* WriteInstance(stderr,IPTR(var->ratom)); */
214	aw0a	1	return;
215			}
216			SetRealAtomValue(c,nominal,(unsigned)0);
217			}
218
219
220			real64 var_lower_bound(struct var_variable *var)
221			{
222			struct Instance *c;
223			if (var==NULL \|\| var->ratom==NULL) {
224	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
225	aw0a	1	return 0.0;
226			}
227			c = ChildByChar(IPTR(var->ratom),LOWER_V);
228			if( c == NULL ) {
229	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
230	aw0a	1	WriteInstance(stderr,IPTR(var->ratom));
231			return 0.0;
232			}
233			return( RealAtomValue(c) );
234			}
235
236			void var_set_lower_bound(struct var_variable *var, real64 lower_bound)
237			{
238			struct Instance *c;
239			if (var==NULL \|\| var->ratom==NULL) {
240	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
241	aw0a	1	return;
242			}
243			c = ChildByChar(IPTR(var->ratom),LOWER_V);
244			if( c == NULL ) {
245	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
246			/* WriteInstance(stderr,IPTR(var->ratom)); */
247	aw0a	1	return;
248			}
249			SetRealAtomValue(c,lower_bound,(unsigned)0);
250			}
251
252
253			real64 var_upper_bound(struct var_variable *var)
254			{
255			struct Instance *c;
256			if (var==NULL \|\| var->ratom==NULL) {
257	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
258	aw0a	1	return 0.0;
259			}
260			c = ChildByChar(IPTR(var->ratom),UPPER_V);
261			if( c == NULL ) {
262	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
263			/* WriteInstance(stderr,IPTR(var->ratom)); */
264	aw0a	1	return 0.0;
265			}
266			return( RealAtomValue(c) );
267			}
268
269	jds	114	void var_set_upper_bound(struct var_variable *var, real64 upper_bound)
270	aw0a	1	{
271			struct Instance *c;
272			if (var==NULL \|\| var->ratom==NULL) {
273	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
274	aw0a	1	return;
275			}
276			c = ChildByChar(IPTR(var->ratom),UPPER_V);
277			if( c == NULL ) {
278	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
279			/* WriteInstance(stderr,IPTR(var->ratom)); */
280	aw0a	1	return;
281			}
282			SetRealAtomValue(c,upper_bound,(unsigned)0);
283			}
284
285	johnpye	944	double var_odeatol(struct var_variable *var){
286			struct Instance *c;
287			if(var==NULL\|\|var->ratom==NULL){
288			ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
289			return -1;
290			}
291			c = ChildByChar(IPTR(var->ratom),ODEATOL_V);
292			if(c==NULL){
293			ERROR_REPORTER_HERE(ASC_PROG_ERR,"no '%s' field",SCP(ODEATOL_V));
294			return -1;
295			}
296			return RealAtomValue(c);
297			}
298
299
300	aw0a	1	uint32 var_flagsF(const struct var_variable *var)
301			{
302			return var->flags;
303			}
304
305			void var_set_flagsF(struct var_variable *var, uint32 flags)
306			{
307			var->flags = flags;
308			}
309
310			uint32 var_fixed(struct var_variable *var)
311			{
312			struct Instance *c;
313			if (var==NULL \|\| var->ratom==NULL) {
314	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
315	aw0a	1	return FALSE;
316			}
317			c = ChildByChar(IPTR(var->ratom),FIXED_V);
318			if( c == NULL ) {
319	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
320			/* WriteInstance(stderr,IPTR(var->ratom)); */
321	aw0a	1	return FALSE;
322			}
323			var_set_flagbit(var,VAR_FIXED,GetBooleanAtomValue(c));
324			return( GetBooleanAtomValue(c) );
325			}
326
327			void var_set_fixed(struct var_variable *var, uint32 fixed)
328			{
329			struct Instance *c;
330			if (var==NULL \|\| var->ratom==NULL) {
331	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
332	aw0a	1	return;
333			}
334			c = ChildByChar(IPTR(var->ratom),FIXED_V);
335			if( c == NULL ) {
336	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
337			/* WriteInstance(stderr,IPTR(var->ratom)); */
338	aw0a	1	return;
339			}
340			SetBooleanAtomValue(c,fixed,(unsigned)0);
341			var_set_flagbit(var,VAR_FIXED,fixed);
342			}
343
344			uint32 var_relaxed(struct var_variable *var)
345			{
346			struct Instance *c;
347			if (var==NULL \|\| var->ratom==NULL) {
348	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
349			return FALSE;
350	aw0a	1	}
351			c = ChildByChar((var->ratom),RELAXED_V);
352			if( c == NULL ) {
353	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
354			/* WriteInstance(stderr,(var->ratom)); */
355	aw0a	1	return FALSE;
356			}
357			var_set_flagbit(var,VAR_RELAXED,GetBooleanAtomValue(c));
358			return( GetBooleanAtomValue(c) );
359			}
360
361			void var_set_relaxed(struct var_variable *var, uint32 fixed)
362			{
363			struct Instance *c;
364			if (var==NULL \|\| var->ratom==NULL) {
365	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
366	aw0a	1	return;
367			}
368			c = ChildByChar(IPTR(var->ratom),RELAXED_V);
369			if( c == NULL ) {
370	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
371			/* WriteInstance(stderr,IPTR(var->ratom)); */
372	aw0a	1	return;
373			}
374			SetBooleanAtomValue(c,fixed,(unsigned)0);
375			var_set_flagbit(var,VAR_RELAXED,fixed);
376			}
377
378			uint32 var_interface(struct var_variable *var)
379			{
380			struct Instance *c;
381			if (var==NULL \|\| var->ratom==NULL) {
382	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
383	aw0a	1	return FALSE;
384			}
385			c = ChildByChar(IPTR(var->ratom),INTERFACE_V);
386			if( c == NULL ) {
387	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'interface' field");
388			/* WriteInstance(stderr,IPTR(var->ratom)); */
389	aw0a	1	return 0;
390			}
391			var_set_flagbit(var,VAR_INTERFACE,GetBooleanAtomValue(c));
392			return( GetIntegerAtomValue(c) );
393			}
394
395			extern uint32 var_flagbit(const struct var_variable *var,const uint32 one)
396			{
397			if (var==NULL \|\| var->ratom == NULL) {
398	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
399	aw0a	1	return 0;
400			}
401			return (var->flags & one);
402			}
403
404			void var_set_flagbit(struct var_variable *var, uint32 field,uint32 one)
405			{
406			if (var==NULL \|\| var->ratom == NULL) {
407	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
408	aw0a	1	return;
409			}
410			if (one) {
411			var->flags \|= field;
412			} else {
413			var->flags &= ~field;
414			}
415			}
416
417	johnpye	719	int32 var_apply_filter(const struct var_variable *var,
418			const var_filter_t *filter
419			){
420	aw0a	1	if (var==NULL \|\| filter==NULL \|\| var->ratom == NULL) {
421	johnpye	954	ERROR_REPORTER_HERE(ASC_PROG_ERR,"miscalled with NULL");
422	aw0a	1	return FALSE;
423			}
424			/* AND to mask off irrelevant bits in flags and match value, then compare */
425	johnpye	719	return (filter->matchbits & var->flags) == (filter->matchbits & filter->matchvalue);
426	aw0a	1	}
427
428	johnpye	732	/**
429			Implementation function for var_n_incidences(). Do not call this
430			function directly - use var_n_incidences() instead.
431			*/
432	aw0a	1	int32 var_n_incidencesF(struct var_variable *var)
433			{
434			if (var!=NULL) return var->n_incidences;
435	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var");
436	aw0a	1	return 0;
437			}
438	johnpye	732
439	aw0a	1	void var_set_incidencesF(struct var_variable *var,int32 n,
440			struct rel_relation **i)
441			{
442			if(var!=NULL && n >=0) {
443			if (n && i==NULL) {
444	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL i");
445	aw0a	1	}
446			var->n_incidences = n;
447			var->incidence = i;
448			return;
449			}
450	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var, or n < 0");
451	aw0a	1	}
452			const struct rel_relation *var_incidence_list( struct var_variable var)
453			{
454			if (var==NULL) return NULL;
455			return( (const struct rel_relation **)var->incidence );
456			}
457
458			struct rel_relation *var_incidence_list_to_modify( struct var_variable var)
459			{
460			if (var==NULL) return NULL;
461			return( (struct rel_relation **)var->incidence );
462			}
463
464
465
466			/*
467			* global for use with the push function. Sets the ip to the
468			* value in g_var_tag;
469			* should be using vp instead of a global counter.
470			*/
471			static void *g_var_tag = NULL;
472			static void * SetVarTags(struct Instance *i,VOIDPTR vp)
473			{
474			(void)vp;
475			if (i!=NULL && InstanceKind(i)==REAL_ATOM_INST) {
476			return g_var_tag;
477			} else {
478			return NULL;
479			}
480			}
481
482			struct var_variable **var_BackendTokens_to_vars(slv_system_t sys,
483			SlvBackendToken *atoms, int32 len)
484			{
485			int32 i,vartot,vlen,count=0;
486			uint32 apos,ulen;
487			struct var_variable **result;
488			struct var_variable **vlist;
489			struct gl_list_t *oldips;
490			if (sys==NULL \|\| atoms == NULL \|\| len < 1) {
491			return NULL;
492			}
493			ulen = (uint32)len;
494			result = (struct var_variable *)malloc(lensizeof(struct var_variable *));
495			if (result == NULL) return result;
496			/* init results to null */
497			for (i=0; i<len; i++) result[i] = NULL;
498			/* fill ips w/len in all the vars in tree. */
499			g_var_tag = (void *)len;
500			vartot = slv_get_num_master_vars(sys) +
501			slv_get_num_master_pars(sys) +
502			slv_get_num_master_unattached(sys);
503			oldips = PushInterfacePtrs(slv_instance(sys),SetVarTags,vartot,0,NULL);
504			/* fill ips of wanted atoms with i */
505			for (i=0; i<len; i++) {
506			if (GetInterfacePtr(atoms[i])==g_var_tag &&
507			InstanceKind(atoms[i]) == REAL_ATOM_INST) {
508			/* guard a little */
509			SetInterfacePtr((struct Instance )atoms[i],(void )i);
510			} else {
511			/* the odds of g_var_tag being a legal pointer are vanishingly
512			small, so if we find an ATOM without g_var_tag we assume it
513			is outside the tree and shouldn't have been in the list. */
514	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad token");
515	aw0a	1	}
516			}
517			/* run through the master lists and put the vars with their atoms */
518			vlist = slv_get_master_var_list(sys);
519			vlen = slv_get_num_master_vars(sys);
520			for (i = 0; i <vlen; i++) {
521			apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
522			if ( apos < ulen ) {
523			result[apos] = vlist[i];
524			count++;
525			}
526			}
527			vlist = slv_get_master_par_list(sys);
528			vlen = slv_get_num_master_pars(sys);
529			for (i = 0; i <vlen; i++) {
530			apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
531			if ( apos < ulen ) {
532			result[apos] = vlist[i];
533			count++;
534			}
535			}
536			vlist = slv_get_master_unattached_list(sys);
537			vlen = slv_get_num_master_unattached(sys);
538			for (i = 0; i <vlen; i++) {
539			apos = (uint32)GetInterfacePtr(var_instance(vlist[i]));
540			if ( apos < ulen ) {
541			result[apos] = vlist[i];
542			count++;
543			}
544			}
545			if (count < len) {
546	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"found less than expected vars (len = %d, found = %d)",len,count);
547	aw0a	1	} else {
548	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERR,"found more than expected vars (len = %d, found = %d)",len,count);
549	aw0a	1	}
550			PopInterfacePtrs(oldips,NULL,NULL);
551			return result;
552			}
553
554			static struct TypeDescription *g_solver_var_type;
555			static struct TypeDescription *g_solver_int_type;
556			static struct TypeDescription *g_solver_binary_type;
557			static struct TypeDescription *g_solver_semi_type;
558
559			boolean set_solver_types(void) {
560			boolean nerr = 0;
561			if( (g_solver_var_type = FindType(AddSymbol(SOLVER_VAR_STR))) == NULL ) {
562	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_var' not defined");
563	aw0a	1	nerr++;
564			}
565			if( (g_solver_int_type = FindType(AddSymbol(SOLVER_INT_STR))) == NULL ) {
566	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_ERROR,"'solver_int' not defined: MPS will not work");
567	aw0a	1	nerr++;
568			}
569			g_solver_binary_type = FindType(AddSymbol(SOLVER_BINARY_STR));
570			if( g_solver_binary_type == NULL) {
571	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_binary' not defined: MPS will not work");
572	aw0a	1	nerr++;
573			}
574			if( (g_solver_semi_type = FindType(AddSymbol(SOLVER_SEMI_STR))) == NULL ) {
575	johnpye	944	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_semi' not defined: MPS will not work");
576	aw0a	1	nerr++;
577			}
578
579			LOWER_V = AddSymbolL("lower_bound",11);
580			UPPER_V = AddSymbolL("upper_bound",11);
581			RELAXED_V = AddSymbolL("relaxed",7);
582			NOMINAL_V = AddSymbolL("nominal",7);
583			FIXED_V = AddSymbolL("fixed",5);
584			INTERFACE_V = AddSymbolL("interface",9);
585	johnpye	944	ODEATOL_V = AddSymbol("ode_atol");
586	aw0a	1	return nerr;
587			}
588
589			boolean solver_var( SlvBackendToken inst)
590			{
591			struct TypeDescription *type;
592
593			if (!g_solver_var_type) return FALSE;
594			type = InstanceTypeDesc(IPTR(inst));
595			return( type == MoreRefined(type,g_solver_var_type) );
596			}
597
598			boolean solver_int( SlvBackendToken inst)
599			{
600			struct TypeDescription *type;
601
602			if (!g_solver_int_type) return FALSE;
603			type = InstanceTypeDesc(IPTR(inst));
604			return( type == MoreRefined(type,g_solver_int_type) );
605			}
606
607			boolean solver_binary( SlvBackendToken inst)
608			{
609			struct TypeDescription *type;
610
611			if (!g_solver_binary_type) return FALSE;
612			type = InstanceTypeDesc(IPTR(inst));
613			return( type == MoreRefined(type,g_solver_binary_type) );
614			}
615
616			boolean solver_semi( SlvBackendToken inst)
617			{
618			struct TypeDescription *type;
619
620			if (!g_solver_semi_type) return FALSE;
621			type = InstanceTypeDesc(IPTR(inst));
622			return( type == MoreRefined(type,g_solver_semi_type) );
623			}
624