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	/*
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	#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
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	#define ODEATOL_V g_strings[6]
75
76	/*
77	* array of those symbol table entries we need.
78	*/
79	static symchar * g_strings[7];
80
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	res=ASC_NEW_ARRAY(char,strlen(name)+1);
110	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
137	return -1;
138	}
139	return var->mindex;
140	}
141
142	void var_set_mindexF(struct var_variable *var, int32 mindex)
143	{
144	if (var==NULL \|\| var->ratom==NULL) {
145	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
146	return;
147	}
148	var->mindex = mindex;
149	}
150
151	int32 var_sindexF(const struct var_variable *var)
152	{
153	if (var==NULL \|\| var->ratom==NULL) {
154	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
155	return -1;
156	}
157	return var->sindex;
158	}
159
160	void var_set_sindexF(struct var_variable *var, int32 sindex)
161	{
162	if (var==NULL \|\| var->ratom==NULL) {
163	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
164	return;
165	}
166	var->sindex = sindex;
167	}
168
169	real64 var_value(const struct var_variable *var)
170	{
171	if (var==NULL \|\| var->ratom==NULL) {
172	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
173	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
182	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
192	return 1.0;
193	}
194	c = ChildByChar(var->ratom,NOMINAL_V);
195	if( c == NULL ) {
196	FPRINTF(ASCERR,"no 'nominal' field in variable");
197	/* WriteInstance(stderr,IPTR(var->ratom)); */
198	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
208	return;
209	}
210	c = ChildByChar(IPTR(var->ratom),NOMINAL_V);
211	if( c == NULL ) {
212	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'nominal' field in var");
213	/* WriteInstance(stderr,IPTR(var->ratom)); */
214	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
225	return 0.0;
226	}
227	c = ChildByChar(IPTR(var->ratom),LOWER_V);
228	if( c == NULL ) {
229	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
230	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
241	return;
242	}
243	c = ChildByChar(IPTR(var->ratom),LOWER_V);
244	if( c == NULL ) {
245	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'lower_bound' field");
246	/* WriteInstance(stderr,IPTR(var->ratom)); */
247	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
258	return 0.0;
259	}
260	c = ChildByChar(IPTR(var->ratom),UPPER_V);
261	if( c == NULL ) {
262	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
263	/* WriteInstance(stderr,IPTR(var->ratom)); */
264	return 0.0;
265	}
266	return( RealAtomValue(c) );
267	}
268
269	void var_set_upper_bound(struct var_variable *var, real64 upper_bound)
270	{
271	struct Instance *c;
272	if (var==NULL \|\| var->ratom==NULL) {
273	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
274	return;
275	}
276	c = ChildByChar(IPTR(var->ratom),UPPER_V);
277	if( c == NULL ) {
278	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'upper_bound' field");
279	/* WriteInstance(stderr,IPTR(var->ratom)); */
280	return;
281	}
282	SetRealAtomValue(c,upper_bound,(unsigned)0);
283	}
284
285	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	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
315	return FALSE;
316	}
317	c = ChildByChar(IPTR(var->ratom),FIXED_V);
318	if( c == NULL ) {
319	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
320	/* WriteInstance(stderr,IPTR(var->ratom)); */
321	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
332	return;
333	}
334	c = ChildByChar(IPTR(var->ratom),FIXED_V);
335	if( c == NULL ) {
336	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'fixed' field");
337	/* WriteInstance(stderr,IPTR(var->ratom)); */
338	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
349	return FALSE;
350	}
351	c = ChildByChar((var->ratom),RELAXED_V);
352	if( c == NULL ) {
353	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
354	/* WriteInstance(stderr,(var->ratom)); */
355	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
366	return;
367	}
368	c = ChildByChar(IPTR(var->ratom),RELAXED_V);
369	if( c == NULL ) {
370	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'relaxed' field");
371	/* WriteInstance(stderr,IPTR(var->ratom)); */
372	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
383	return FALSE;
384	}
385	c = ChildByChar(IPTR(var->ratom),INTERFACE_V);
386	if( c == NULL ) {
387	ERROR_REPORTER_HERE(ASC_PROG_ERR,"no 'interface' field");
388	/* WriteInstance(stderr,IPTR(var->ratom)); */
389	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
399	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad var");
408	return;
409	}
410	if (one) {
411	var->flags \|= field;
412	} else {
413	var->flags &= ~field;
414	}
415	}
416
417	int32 var_apply_filter(const struct var_variable *var,
418	const var_filter_t *filter
419	){
420	if (var==NULL \|\| filter==NULL \|\| var->ratom == NULL) {
421	ERROR_REPORTER_HERE(ASC_PROG_ERR,"miscalled with NULL");
422	return FALSE;
423	}
424	/* AND to mask off irrelevant bits in flags and match value, then compare */
425	return (filter->matchbits & var->flags) == (filter->matchbits & filter->matchvalue);
426	}
427
428	/**
429	Implementation function for var_n_incidences(). Do not call this
430	function directly - use var_n_incidences() instead.
431	*/
432	int32 var_n_incidencesF(struct var_variable *var)
433	{
434	if (var!=NULL) return var->n_incidences;
435	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var");
436	return 0;
437	}
438
439	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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL i");
445	}
446	var->n_incidences = n;
447	var->incidence = i;
448	return;
449	}
450	ERROR_REPORTER_HERE(ASC_PROG_ERR,"NULL var, or n < 0");
451	}
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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"bad token");
515	}
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	ERROR_REPORTER_HERE(ASC_PROG_ERR,"found less than expected vars (len = %d, found = %d)",len,count);
547	} else {
548	ERROR_REPORTER_HERE(ASC_PROG_ERR,"found more than expected vars (len = %d, found = %d)",len,count);
549	}
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	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_var' not defined");
563	nerr++;
564	}
565	if( (g_solver_int_type = FindType(AddSymbol(SOLVER_INT_STR))) == NULL ) {
566	ERROR_REPORTER_HERE(ASC_PROG_ERROR,"'solver_int' not defined: MPS will not work");
567	nerr++;
568	}
569	g_solver_binary_type = FindType(AddSymbol(SOLVER_BINARY_STR));
570	if( g_solver_binary_type == NULL) {
571	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_binary' not defined: MPS will not work");
572	nerr++;
573	}
574	if( (g_solver_semi_type = FindType(AddSymbol(SOLVER_SEMI_STR))) == NULL ) {
575	ERROR_REPORTER_HERE(ASC_PROG_FATAL,"'solver_semi' not defined: MPS will not work");
576	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	ODEATOL_V = AddSymbol("ode_atol");
586	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