generic/interface/CodeGen.c

/*
 *  CodeGen.c
 *  by Kirk Abbott and Ben Allan
 *  Created: 1/94
 *  Version: $Revision: 1.24 $
 *  Version control file: $RCSfile: CodeGen.c,v $
 *  Date last modified: $Date: 2003/08/23 18:43:05 $
 *  Last modified by: $Author: ballan $
 *
 *  This file is part of the ASCEND Tcl/Tk interface
 *
 *  Copyright 1997, Carnegie Mellon University
 *
 *  The ASCEND Tcl/Tk interface 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 ASCEND Tcl/Tk interface 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.
 */

/*
 *                         CodeGeneration Routines
 *                         by Kirk Andre Abbott.
 *                         January 4, 1995.
 *                         Version: $Revision: 1.24 $
 *                         Date last modified: $Date: 2003/08/23 18:43:05 $
 *                         Copyright (C) 1995 Kirk Andre Abbott, CMU.
 */
#include <math.h>
#include <tcl.h>
#include <tk.h>
#include <utilities/ascConfig.h>
#include <utilities/ascMalloc.h>
#include <general/dstring.h>
#include <compiler/instance_io.h>
#include <compiler/instance_enum.h>
#include <compiler/module.h>
#include <compiler/library.h>
#include <compiler/exprsym.h>
#include <compiler/relation_util.h>
#include <compiler/relation_io.h>
#include <solver/system.h>
#include "Qlfdid.h"
#include "CodeGen.h"

#ifndef lint
static CONST char CodeGenID[] = "$Id: CodeGen.c,v 1.24 2003/08/23 18:43:05 ballan Exp $";
#endif

#define REIMPLEMENT 0

/* This file has to be totally rewritten  */

#if REIMPLEMENT

struct CGFormat C_Format = {
  CG_c,CG_squarebracket,CG_func_power,CG_c,CG_c
};

#define CG(str) FPRINTF(fp,str)
#define CGTAB "    "
#define CG_OFFSET 0

static char CG_CFUNCNAME[] = "slvf__";
static char CG_CGRADNAME[] = "slvg__";

/*
 * The main working structure. It is not made static
 * so that all the CodeGen* files may see it. We might
 * modify all the code here so that we pass it around a
 * pointer to it as the first parameter, to all functions
 * that require it.
 */
struct CGData g_cgdata = {
  NULL,NULL,CG_ll,{0,NULL},{0,NULL},{0,NULL},{0,NULL},{0,0,0,0,0}
};

int Asc_CGRelIncluded(struct rel_relation *rp)
{
  unsigned flags;
  flags = rel_flags(rp);
  if (flags & CG_INCLUDED) {
    return 1;
  }
  return 0;
}

int Asc_CGVarFixed(struct CGVar *cgvar)
{
  unsigned flags;
  flags = cgvar->flags;
  if (flags & CG_FIXED) {
    return 1;
  }
  return 0;
}

struct Instance *Asc_CGVarInstance(struct CGVar *cgvar)
{
  return cgvar->instance;
}

struct CGVar *Asc_CGInstanceVar(struct Instance *instance)
{
  struct CGVar *result;
  result = (struct CGVar *)GetInterfacePtr(instance);
  return result;
}

struct var_variable *Asc_CGInstancePar(struct Instance *instance)
{
  struct var_variable *result;
  result = (struct var_variable *)GetInterfacePtr(instance);
  return result;
}

/*
 * The rel_equal function in rel.[ch] is hosed. So here
 * is my version.
 */
int CG_rel_equal(struct rel_relation *rel)
{
  enum Expr_enum type;
  if (RelationRelop(GetInstanceRelation(rel->instance,&type))==e_equal) {
    return 1;
  } else {
    return 0;
  }
}


/*
 * Boiler plate routines,for code generation.
 */
void CodeGen_WriteIncludes(FILE *fp,char *file_prefix)
{
  CG("/***************** This file was generated by Ascend *************/\n");
  CG("#include <stdio.h>\n");
  CG("#include <stdlib.h>\n");
  CG("#include <math.h>\n");
  CG("#include \"codegen_support.h\"\n");
  FPRINTF(fp,"#include \"%s.h\"\n",file_prefix);
  CG("\n\n");
}

void CodeGen_WriteGlobals(FILE *fp)
{
  CG("\n");
}

void CodeGen_WriteSupportFuncs_Log(FILE *fp)
{
  CG("static double ln(double x)\n");
  CG("{\n");
  CG("  return log(x);\n");
  CG("}\n\n");
}

void CodeGen_WriteSupportFuncs_Cube(FILE *fp)
{
  CG("static double cube(double x)\n");
  CG("{\n");
  CG("  return x*x*x;\n");
  CG("}\n\n");
}

void CodeGen_WriteSupportFuncs_Sqr(FILE *fp)
{
  CG("static double sqr(double x)\n");
  CG("{\n");
  CG("  return x*x;\n");
  CG("}\n\n");
}

void CodeGen_WriteFuncHeader1(FILE *fp)
{
  CG("int slv0_funcon(mode,m,n,x,u,f,g)\n");
  CG("int *mode;\n");
  CG("int *m;\n");
  CG("int *n;\n");
  CG("double *x;\n");
  CG("double *u;\n");
  CG("double *f;\n");
  CG("double *g;\n");
  CG("{\n");
}

void CodeGen_WriteFuncHeader2(FILE *fp,int function_ndx)
{
  FPRINTF(fp,"static int %s%d(mode,m,n,x,u,f,g)\n",CG_CFUNCNAME,function_ndx);
  CG("\tint *mode; int *m; int *n;\n");
  CG("\tdouble *x; double *u; double *f; double *g;\n");
  CG("{\n");
}

void CodeGen_WriteGradHeader2(FILE *fp,int function_ndx)
{
  FPRINTF(fp,"static int %s%d(mode,m,n,x,u,f,g)\n",CG_CGRADNAME,function_ndx);
  CG("\tint *mode; int *m; int *n;\n");
  CG("\tdouble *x; double *u; double *f; double *g;\n");
  CG("{\n");
}

void CodeGen_WriteFuncDecln(FILE *fp)
{
  CG("\n");
  return;
}

void CodeGen_WriteFuncFooter(FILE *fp)
{
  CG("\treturn 0;\n");
  CG("}\n");
}


/*
 **********************************************************************
 * The below code assumes the following:
 * 1) presolve has been done and a valid slv_system_t exists.
 * 2) the relations and variables have been numbered during the
 *    presolve.
 *
 * NOTE: no special order is being enforced at the moment and objectives
 * are not being handled. THIS WILL BE FIXED.
 **********************************************************************
 */

void CodeGen_WriteInitValues(FILE *fp,char *file_prefix)
{
  struct CGVar *vp;
  struct var_variable *pp;
  /*  par_parameter_t *pp;  */
  struct Instance *instance;
  int num_vars,num_pars,i;

  int index;
  double value,lower_bound,upper_bound,nominal;

  FPRINTF(fp,"void %s__Initialize(x,u,lower,upper,nominal)\n",file_prefix);
  CG("  double *x;\n");
  CG("  double *u;\n");
  CG("  double *lower;\n");
  CG("  double *upper;\n");
  CG("  double *nominal;\n");
  CG("{\n");
  vp = g_cgdata.vars.var_list;
  num_vars = g_cgdata.vars.num_vars;
  for (i=0;i<num_vars;i++) {
    index = vp[i].index;
    instance = vp[i].instance;
    value = var_value(instance);
    lower_bound = var_lower_bound(instance);
    upper_bound = var_upper_bound(instance);
    nominal = var_nominal(instance);
    FPRINTF(fp,"x[%d] = %12.8g; nominal[%d] = %12.8g;\n",
            index,value,index,nominal);
    FPRINTF(fp,"lower[%d] = %12.8g; upper[%d] = %12.8g;\n\n",
            index,lower_bound,index,upper_bound);
  }

  /*
   * Write out the values of the parameters.
   * NOTE: No Filtering is done here. Once I figure out how
   * to cruch the arrays down with confusing myself we will.
   */
  FPRINTF(fp,"\n\n");
  pp = g_cgdata.pars.par_list;
  num_pars = g_cgdata.pars.num_pars;
  for (i=0;i<num_pars;i++) {
    index = par_index(pp[i]);
    value = par_value(pp[i]);
    FPRINTF(fp,"u[%d] = %12.8g;\n",index,value);
  }
  CG("}\n\n");
}


/*
 * Will take the *raw* list of parameters and classify
 * the list i.e., ensure that the parameters are parametric
 * and mark them as such. At the same time will index the
 * parameter list. It will return the number of parameters
 * found.
 */
struct var_variable *CodeGen_SetUpParameters(struct var_variable *pp,
                                         int num_pars)
/*par_parameter_t *CodeGen_SetUpParameters(par_parameter_t *pp,
                                         int num_pars) */
{
  /*  par_parameter_t par; */
  struct var_variable *par;
  struct Instance *inst;
  int c, num_parametric =0;

  if (num_pars==0) {
    FPRINTF(stderr,"(IndexParameters) no parameters found\n");
    return NULL;
  }
  for (c=0;c<num_pars;c++) {
    par = pp[c];
    inst = par_instance(par);
    par_set_index(par,c);
    if (is_inst_aparameter(inst)) {
      par_set_parametric(par);
      num_parametric++;
    }
  }

  FPRINTF(stderr,"(IndexParameters) %d parameters found\n",num_parametric);
  g_cgdata.filtered.num_pars = num_parametric;
  return pp;
}


/*
 **********************************************************************
 *
 * We dont want to iterate over the varlist more than we have to; So we
 * play the 'run and shoot'. First build a filter to apply to each
 * item in the raw varlist.  Based on the result set the flags on our
 * variables. We will not set the input/output/internal flag bits here,
 * as that would involve linear time search over the input and
 * output lists, for each var. We will do that later.
 * Do for all vars in the list.
 *
 * One final note. Instance interfaceptrs are a shared resource.
 * We will be polite and save the state of instance as we found it
 * and restore it when we are done. We expect that the same courtesy
 * will be extended to us.
 *
 **********************************************************************
 */

struct CGVar *Asc_CodeGenSetUpVariables(struct var_variable **vp,
                                     int num_vars)
{
  struct CGVar *cgvarlist;  /* an array of CGVar structs */
  unsigned int filter = 0x0;
  int c,num_free=0;

  if (num_vars==0) {
    FPRINTF(stderr,"(IndexVariables) no variables found\n");
    return NULL;
  }
  cgvarlist = (struct CGVar *)ascmalloc((num_vars+1)*sizeof(struct CGVar));
  if (!cgvarlist) {
    /* this is a real possibility with big problems */
    Asc_Panic(1, "CodeGen_IndexVariables",
              "Memory failure in (CodeGen_IndexVariables)\n");
  }
  for (c=0;c<num_vars;c++) {
    cgvarlist[c].instance = vp[c];
    cgvarlist[c].prev_instanceinfo = GetInterfacePtr(vp[c]); /* save data */
    SetInterfacePtr(vp[c],(VOIDPTR)&cgvarlist[c]);
    cgvarlist[c].index = c;
    cgvarlist[c].cmplr_index = -1;  /* dont set the compiler index */
    cgvarlist[c].flags = 0x0;
    if (var_fixed(vp[c])) {
      cgvarlist[c].flags |= CG_FIXED;
   }  else {
      num_free++;
   }
  }
  cgvarlist[num_vars].instance = NULL;  /* terminate with a sentinel */
  cgvarlist[num_vars].flags = 0x0;
  cgvarlist[num_vars].index = -1;
  cgvarlist[c].cmplr_index = -1;

  g_cgdata.filtered.num_vars = num_free;
  return cgvarlist;
}


unsigned int PotentialSolverVar(struct Instance *inst)
{
  struct TypeDescription *realtype,*type;
  if (solver_var(inst)) {
    return CG_SLV_REAL;
  }
  realtype = FindType("real");
  type = InstanceTypeDesc(inst);
  if (type!=realtype) {     /* already off the type hierarchy */
    return CG_SLV_CONST;
  } else {          /* is a real, so is potentially a solver_var */
    return 0x0;
  }
}

static void CollectVars(struct Instance *inst, VOIDPTR data)
{
  struct gl_list_t *list = (struct gl_list_t *)data;
  if (inst) {
    switch(InstanceKind(inst)) {
    case REAL_ATOM_INST:
      gl_append_ptr(list,(char *)inst);
      return;
    }
  }
}

struct gl_list_t *PreProcessVars(struct Instance *root)
{
  struct gl_list_t *list = gl_create(256L);
  VisitInstanceTreeTwo(root,CollectVars,1,0,(VOIDPTR)list);
  return list;
}


struct CGVar *Asc_CodeGenSetUpVariables3(struct gl_list_t *list)
{
  struct Instance *var;
  struct CGVar *cgvarlist;  /* an array of CGVar structs */
  unsigned int filter = 0x0;
  int num_vars;         /* number of compiler vars */
  int num_solver_vars = 0;  /* number of solver vars */
  int c,num_free=0;
  unsigned int status;

  num_vars = (int)gl_length(list);
  if (num_vars==0) {
    FPRINTF(stderr,"(IndexVariables) no variables found\n");
    return NULL;
  }
  cgvarlist = (struct CGVar *)ascmalloc((num_vars+1)*sizeof(struct CGVar));
  if (!cgvarlist) {
    Asc_Panic(1, "Asc_CodeGenSetUpVariables3",
              "Memory failure in (Asc_CodeGenSetUpVariables3)\n");
  }
  for (c=0;c<num_vars;c++) {
    var = (struct Instance*)gl_fetch(list,c+1);
    cgvarlist[c].instance = var;
    cgvarlist[c].prev_instanceinfo = GetInterfacePtr(var); /* save data */
    SetInterfacePtr(var,(VOIDPTR)&cgvarlist[c]);
    cgvarlist[c].flags = 0x0;
    cgvarlist[c].cmplr_index = c;

    status = PotentialSolverVar(var);
    switch (status) {
    case CG_SLV_OPEN:           /* potentially a solver_var */
      cgvarlist[c].flags |= CG_SLV_OPEN;
      cgvarlist[c].index = -1;
      break;
    case CG_SLV_CONST:          /* never will be a solver_var */
      cgvarlist[c].flags |= CG_SLV_CONST;
      cgvarlist[c].index = -1;
      break;
    case CG_SLV_REAL:           /* is already a solver_var */
      cgvarlist[c].flags |= CG_SLV_REAL;
      cgvarlist[c].index = num_solver_vars++;
      if (var_fixed(var)) {
        cgvarlist[c].flags |= CG_FIXED;
      } else {
        num_free++;
      }
      break;
    default:
      FPRINTF(stderr,
              "Unknown variable type in (Asc_CodeGenSetUpVariables3)\n");
      break;
    }
  }
  cgvarlist[num_vars].instance = NULL;  /* terminate with a sentinel */
  cgvarlist[num_vars].flags = 0x0;
  cgvarlist[num_vars].index = -1;

  g_cgdata.filtered.num_vars = num_free;
  return cgvarlist;
}


/*
 * By default anything not marked by this routine is classified
 * as being internal. It is possible for a user to have a variable
 * being both CG_INPUT and CG_OUTPUT. It is not our job only to *warn*
 * of such occurrences. The user may later decide to uninclude the
 * relevant output equation.
 */
void CodeGen_I_O_Internal(void)
{
  unsigned long len,c=0;
  int num_vars;
  struct Instance *inst;
  struct gl_list_t *list;
  struct CGVar *vlist, *self, *tmp;

  num_vars = g_cgdata.vars.num_vars;
  vlist = g_cgdata.vars.var_list;
  list = g_cgdata.input_list;   /* process the input list if given */
  if (list) {
    len = gl_length(list);
    assert((int)len <= num_vars);
    for (c=1;c<=len;c++) {
      inst = (struct Instance *)gl_fetch(list,c);
      self = (struct CGVar*)GetInterfacePtr(inst);
      tmp = &vlist[c-1];
      assert(tmp==self);    /* desperate integrity check */
      self->flags |= CG_INPUT;
    }
  }

  list = g_cgdata.output_list;  /* process the output list if given */
  if (list) {
    len = gl_length(list);

    assert(len<=num_vars);
    for (c=1;c<=len;c++) {
      inst = (struct Instance *)gl_fetch(list,c);
      self = (struct CGVar*)GetInterfacePtr(inst);
      tmp = &vlist[c-1];
      assert(tmp==self);    /* desperate integrity check */
      self->flags |= CG_OUTPUT;
    }
  }
}


/*
 **********************************************************************
 *
 * We run through the original relations list and mark everything
 * as being included, equality, lessthan, greaterthan.
 * Relationn as currently implememted already have structure, so
 * we need not create any here.
 *
 **********************************************************************
 */
struct rel_relation **Asc_CodeGenSetUpRelations(struct rel_relation * *rp,
                                       int num_rels)
{
  int i;
  int num_included = 0;
  unsigned int flags;

  for (i=0;i<num_rels;i++) {
    flags = 0x0;
    rel_set_index(rp[i],i);
    if (rel_included(rp[i]) && rel_active(rp[i]) ) {
      flags |= CG_INCLUDED;
      num_included++;
    }
    if (CG_rel_equal(rp[i])) {
      flags |= CG_EQUAL;
    } else if (rel_less(rp[i])) {
      flags |= CG_LESS;
    } else if (rel_greater(rp[i])) {
      flags |= CG_GREATER;
    }
    rel_set_flags(rp[i],flags);
  }
  g_cgdata.filtered.num_rels = num_included;
  return rp;
}

struct rel_relation **Asc_CodeGenSetUpObjectives(struct rel_relation * *op,
                                       int num_objs)
{
  int i;
  int num_included = 0;
  unsigned int flags;

  for (i=0;i<num_objs;i++) {
    flags = 0x0;
    rel_set_index(op[i],i);
    if (rel_included(op[i])) {
      flags |= CG_INCLUDED;
      num_included++;
    }
  }
  g_cgdata.filtered.num_objs = num_included;
  return op;
}


/*
 * Remember to unify the treatment of parameters.
 * i.e. treat them in the same way that we treat variables
 * and relations.       !! FIX !! kaa
 */
/*
 * remember to ditch treatment of parameters. baa */
/* codegen uses the master lists from the slv_system_t because we
   need repeatability across ascend runs */
/* int CodeGen_SetupCodeGen(slv_system_t sys,
                         struct CGVar *cgvarlist, int nvars,
                         struct rel_relation **rp, int nrels,
                         struct rel_relation **op, int nobjs,
                         par_parameter_t *pp, int npars,
                         struct gl_list_t *inputs,
                         struct gl_list_t *outputs) */
int CodeGen_SetupCodeGen(slv_system_t sys,
                         struct CGVar *cgvarlist, int nvars,
                         struct rel_relation **rp, int nrels,
                         struct rel_relation **op, int nobjs,
                         struct var_variable *pp, int npars,
                         struct gl_list_t *inputs,
                         struct gl_list_t *outputs)
{
  int num;
  struct var_variable **vp;

  if (!sys) {
    return 1;
  }
  /*
   * Variables.
   */
  if (cgvarlist) {
    g_cgdata.vars.var_list = cgvarlist;
    g_cgdata.vars.num_vars = nvars;
  } else {
    vp = slv_get_master_var_list(sys);
    num = slv_get_num_master_vars(sys);
    g_cgdata.vars.var_list =  Asc_CodeGenSetUpVariables(vp,num);
    g_cgdata.vars.num_vars = num;
  }

  /*
   * Parameters.
   */
  if (pp) {
    g_cgdata.pars.par_list = CodeGen_SetUpParameters(pp,npars);
    g_cgdata.pars.num_pars = npars;
  } else {
    num = slv_get_num_pars(sys);
    pp = slv_get_par_list(sys);
    g_cgdata.pars.par_list = CodeGen_SetUpParameters(pp,num);
    g_cgdata.pars.num_pars = num;
  }

  /*
   * Relations
   */
  if (rp) {
    g_cgdata.rels.rel_list = rp;
    g_cgdata.rels.num_rels = nrels;
  } else {
    rp = slv_get_master_rel_list(sys);
    num = slv_get_num_master_rels(sys);
    g_cgdata.rels.rel_list = Asc_CodeGenSetUpRelations(rp,num);
    g_cgdata.rels.num_rels = num;
  }

  /*
   * Objectives
   */
  if (op) {
    g_cgdata.objs.obj_list = op;
    g_cgdata.objs.num_objs = nobjs;
  } else {
    op = slv_get_objrel_list(sys);
    num = slv_get_num_objrels(sys);
    g_cgdata.objs.obj_list = Asc_CodeGenSetUpObjectives(op,num);
    g_cgdata.objs.num_objs = num;
  }

  g_cgdata.input_list = inputs;   /* process the output list if given */
  g_cgdata.output_list = outputs; /* process the output list if given */
  CodeGen_I_O_Internal();
  return 0;
}

/*
 * We need to deallocate any memory that we created; at the moment
 * this is the cgvars. First we need to reset the interfaceptrs
 * to the state that we found them in. We pulled g_cgdata of the
 * heap. All we need to do is ensure that the pointers are nulled,
 * and the counters are set to -1. NOTE: At the moment I am not sure
 * where the input list came from. For the moment let us assume that
 * we own it, so that we will deallocate it as well.
 */
void Asc_CodeGenShutDown(void)
{
  int i,num;
  struct CGVar *cgvarlist;

  if (g_cgdata.input_list!=NULL) {
    gl_destroy(g_cgdata.input_list);
  }
  if (g_cgdata.output_list!=NULL) {
    gl_destroy(g_cgdata.output_list);
  }
  if ((cgvarlist = g_cgdata.vars.var_list)!=NULL) {
    num = g_cgdata.vars.num_vars;
    for (i=0;i<num;i++) {
      SetInterfacePtr(cgvarlist[i].instance,
                      (VOIDPTR)cgvarlist[i].prev_instanceinfo);
    }
    ascfree((char *)cgvarlist);
    g_cgdata.vars.var_list = NULL;
    g_cgdata.vars.num_vars = -1;
  }
  g_cgdata.pars.par_list = NULL;
  g_cgdata.pars.num_pars = -1;
  g_cgdata.rels.rel_list = NULL;
  g_cgdata.rels.num_rels = -1;
  g_cgdata.filtered.num_vars = -1;
  g_cgdata.filtered.num_pars = -1;
  g_cgdata.filtered.num_rels = -1;
  g_cgdata.filtered.num_incidences = -1;
}


/*
 * These are support routines for writing out data.
 * Included is the capability to support different output
 * file formats. The default format will be the "C-format"
 * Other formats include an "Ascend-format", a "Gams-format"
 * a "Mathematica-format"
 */
static int printer_num_chars = 0;

static void CodeGen_PrettyPrintInteger(FILE *fp,int value)
{
  printer_num_chars += FPRINTF(fp,"%d,",value);
  if (printer_num_chars >= 74) {    /* 80 columns less 6 chars */
    FPRINTF(fp,"\n");
    printer_num_chars = 0;
  }
}

static void CodeGen_PrettyPrintReal(FILE *fp,double value)
{
  printer_num_chars += FPRINTF(fp,"%.8f,",value);
  if (printer_num_chars >= 72) {    /* 80 columns less 8 chars */
    FPRINTF(fp,"\n");
    printer_num_chars = 0;
  }
}

static void CodeGen_PrettyPrintStr(FILE *fp,char *prefix,
                                   int value)
{
  printer_num_chars += FPRINTF(fp,"%s%d,",prefix,value);
  if (printer_num_chars >= 68) {    /* 80 columns less 12 chars */
    FPRINTF(fp,"\n");
    printer_num_chars = 0;
  }
}

static void CodeGen_ResetPrettyPrinter(void)
{
  printer_num_chars = 0;
}


int CodeGen_WriteSide(FILE *,Term *,
                      RelationINF *,struct CGFormat *,int);

static void WriteOp(FILE *f, enum Expr_enum t)
{
  switch(t) {
  case e_plus: FPRINTF(f," + "); break;
  case e_uminus: PUTC('-',f); break;
  case e_minus: FPRINTF(f," - "); break;
  case e_times: PUTC('*',f); break;
  case e_divide: PUTC('/',f); break;
  case e_power: PUTC('^',f); break;
  case e_ipower: PUTC('^',f); break;
  case e_equal: PUTC('=',f); break;
  case e_notequal: FPRINTF(f,"<>"); break;
  case e_less: PUTC('<',f); break;
  case e_greater: PUTC('>',f); break;
  case e_lesseq: FPRINTF(f,"<="); break;
  case e_greatereq: FPRINTF(f,">="); break;
  case e_maximize: FPRINTF(f,"MAXIMIZE"); break;
  case e_minimize: FPRINTF(f,"MINIMIZE"); break;
  default:
    FPRINTF(stderr,"Unknown term in WriteOp.\n");
    FPRINTF(f,"***");
  }
}

static int WritePower(FILE *f, Term *term,
                      RelationINF *r,
                      struct CGFormat *format,
                      int nchars)
{
  int parens;
  int count;
  enum Expr_enum t = RelationTermType(term);
  Term *left = TermBinLeft(term);   /* we know that it is binary term */
  Term *right = TermBinRight(term);

  count = nchars;
  switch(format->main_format) {
  case CG_ascend:
  case CG_linear:
    if (parens = NeedParen(t,RelationTermType(left),0)) {
      PUTC('(',f);
    }
    count = CodeGen_WriteSide(f,left,r,format,count);
    if (parens) {
      PUTC(')',f);
    }
    WriteOp(f,t);
    if (parens = NeedParen(t,RelationTermType(right),1)) {
      PUTC('(',f);
    }
    count = CodeGen_WriteSide(f,right,r,format,count) + 2;
    if (parens) {
      PUTC(')',f);
    }
    break;
  case CG_math:
    FPRINTF(f,"Power[");
    count = CodeGen_WriteSide(f,left,r,format,count) + 5;
    PUTC(',',f);
    count = CodeGen_WriteSide(f,right,r,format,count) + 2;
    FPRINTF(f,"]");
    break;
  case CG_gams:
    FPRINTF(f,"(");
    count = CodeGen_WriteSide(f,left,r,format,count);
    FPRINTF(f,")");
    FPRINTF(f,"**(");
    count = CodeGen_WriteSide(f,right,r,format,count) + 3;
    FPRINTF(f,")");
    break;
  case CG_c:
  default:
    FPRINTF(f,"pow(");
    count = CodeGen_WriteSide(f,left,r,format,count) + 5;
    PUTC(',',f);
    count = CodeGen_WriteSide(f,right,r,format,count) + 2;
    FPRINTF(f,")");
    break;
  }
  return count;
}

/*
 * WriteName is invoked on whatever ASCEND considers a var, i.e,
 * an expression node of type e_var, which *all* REAL_ATOM_INSTances
 * have. We filter this var, to determine whether it is a
 * solver_var, solver_par, or constant. We now have to decide
 * whether a *fixed* solver_var is written as its numeric value,
 * or as symbol to be substituted. The same applies for parameters.
 * We *will* leave it as a symbolic name. We might allow a field
 * in the format parameter to tell us what to do here.
 */
static int WriteName(FILE *f, Term *term,
                     RelationINF *r,
                     struct CGFormat *format)
{
  struct Instance *cur_var;
  struct CGVar *cgvar;
  par_parameter_t par;
  int count = 0;

  switch(format->names) {
  case CG_ascend:
    cur_var = RelationVariable(r,TermVarNumber(term));
    WriteInstanceName(f,cur_var,NULL);
    return 20;      /* need to hack this to get the correct count */
  case CG_gams:
  case CG_math:
    /*
     * Mathematica needs special handling for writing out
     * floating point numbers and variable names. Because
     * we are doing this for debugging we are *not* going to do
     * constant folding, i.e., variable values will not be
     * substituted.
     */
    cur_var = RelationVariable(r,TermVarNumber(term));
    if (solver_var(cur_var)) {
      cgvar = Asc_CGInstanceVar(cur_var);
      count = FPRINTF(f,"x%d",cgvar->index);
    } else if (solver_par(cur_var)) {
      par = Asc_CGInstancePar(cur_var);
      count = FPRINTF(f,"u%d",par_index(par));
    } else {
      count = FPRINTF(f,"(%.8f)",RealAtomValue(cur_var));
    }
    return count;
  case CG_linear:
  case CG_blackbox:
  case CG_minos:
    /*
     * NOTE: This code is doing variable substitution !!!
     * For computational speed we should. We also have the notion
     * of inputs, outputs and parameters. This does not exist
     * for the glassbox format.
     */
    cur_var = RelationVariable(r,TermVarNumber(term));
    if (solver_var(cur_var)) {
      cgvar = Asc_CGInstanceVar(cur_var);
      if (Asc_CGVarFixed(cgvar)) {
        count = FPRINTF(f,"%.8g",RealAtomValue(cur_var)); /* SUBSITITUTION */
      } else {
        count = FPRINTF(f,"x[%d]",cgvar->index);
      }
    } else if (solver_par(cur_var)) {
      par = Asc_CGInstancePar(cur_var);
      if (!par_parametric(par)) {
        count = FPRINTF(f,"%.8g",RealAtomValue(cur_var));
      } else {
        count = FPRINTF(f,"u[%d]",par_index(par));
      }
    } else {
      count = FPRINTF(f,"%.8g",RealAtomValue(cur_var));
    }
    return count;
  case CG_glassbox:
    /*
     * NOTE 1: This code is *not doing any* variable substitution !!!
     * As these are glassbox relations, we write out everybody
     * that the *compiler* considers to be a variable, which at this
     * time is REAL_ATOM_INST or greater.
     * This is *very* different from the minos/blackbox case.
     * NOTE 2: This code uses a different indexing scheme than the
     * minos and blackbox formats, as each relation generated needs
     * to be standalone. In fact it uses the TermVarNumber.
     */
    count = FPRINTF(f,"x[%lu]",TermVarNumber(term)-1);
    return count;
  }
}


void CodeGen_BreakLines(FILE *f, struct CGFormat *format)
{
  switch(format->main_format) {
  case CG_c:
  case CG_math:
    FPRINTF(f," \\\n  ");
    return;
  case CG_ascend:
  case CG_linear:
  case CG_gams:
  default:
    FPRINTF(f,"\n\t");
    return;
  }
}

int CodeGen_WriteBuiltInFuncs(FILE *f, Term *term,
                              RelationINF *r,
                              struct CGFormat *format,
                              int nchars)
{
  int count = nchars;
  switch(format->main_format) {
  case CG_math:
    switch(FuncId(TermFunc(term))) {
      /*
       * All cases which do *return* rather than *break* are
       * special cases which need to be handled. Those that *break*,
       * get closing brackets written after the switch.
       */
    case F_LOG10:
      count += FPRINTF(f,"Log[");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,",10]");
      return;
    case F_LN:  count += FPRINTF(f,"Log["); break;
    case F_EXP: count += FPRINTF(f,"Exp["); break;
    case F_SIN: count += FPRINTF(f,"Sin["); break;
    case F_COS: count += FPRINTF(f,"Cos["); break;
    case F_TAN: count += FPRINTF(f,"Tan["); break;
    case F_ARCSIN: count += FPRINTF(f,"ArcSin["); break;
    case F_ARCCOS: count += FPRINTF(f,"ArcCos["); break;
    case F_ARCTAN: count += FPRINTF(f,"ArcTan["); break;
    case F_SQR:
      count += FPRINTF(f,"Power[");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,",2]");
      return;
    case F_SQRT: count += FPRINTF(f,"Sqrt["); break;
#ifdef HAVE_ERF
    case F_ERF:  count += FPRINTF(f,"Erf["); break;
#endif
    case F_LNM:  count += FPRINTF(f,"Log["); break;
    case F_SINH: count += FPRINTF(f,"Sinh["); break;
    case F_COSH: count += FPRINTF(f,"Cosh["); break;
    case F_TANH: count += FPRINTF(f,"Tanh["); break;
    case F_ARCSINH: count += FPRINTF(f,"ArcSinh["); break;
    case F_ARCCOSH: count += FPRINTF(f,"ArcCosh["); break;
    case F_ARCTANH: count += FPRINTF(f,"ArcTanh["); break;
    case F_CBRT:
      count += FPRINTF(f,"Power[");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,",1/3]");
      return;
    }
    count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
    PUTC(']',f);
    break;
  case CG_gams:
    switch(FuncId(TermFunc(term))) {
      /*
       * All cases which do *return* rather than *break* are
       * special cases which need to be handled. Those that *break*,
       * get closing brackets written after the switch.
       */
    case F_LOG10: count += FPRINTF(f,"LOG10("); break;
    case F_LN:  count += FPRINTF(f,"LOG("); break;
    case F_EXP: count += FPRINTF(f,"EXP("); break;
    case F_SIN: count += FPRINTF(f,"SIN("); break;
    case F_COS: count += FPRINTF(f,"COS("); break;
    case F_TAN: count += FPRINTF(f,"SIN(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count = FPRINTF(f,")/COS("); break;
    case F_ARCSIN: count += FPRINTF(f,"1/SIN("); break;
    case F_ARCCOS: count += FPRINTF(f,"1/COS("); break;
    case F_ARCTAN: count += FPRINTF(f,"COS(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count = FPRINTF(f,")/SIN("); break;
    case F_SQR: count += FPRINTF(f,"SQR("); break;
    case F_SQRT: count += FPRINTF(f,"SQRT("); break;
#ifdef HAVE_ERF
    case F_ERF:  count += FPRINTF(f,"ERF("); break;
#endif
    case F_LNM:  count += FPRINTF(f,"LOG"); break;
        /* WARNING: lnm not implemented here */
    case F_SINH: count += FPRINTF(f,"0.5*(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")-EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))");
      return;
    case F_COSH: count += FPRINTF(f,"0.5*(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")+EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))");
      return;
    case F_TANH: count += FPRINTF(f,"(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")-EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))/");
      count += FPRINTF(f,"(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")+EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))");
      return;
    case F_ARCSINH: count += FPRINTF(f,"2/(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")-EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))");
      return;
    case F_ARCCOSH: count += FPRINTF(f,"0.5*(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")+EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))");
      return;
    case F_ARCTANH: count += FPRINTF(f,"(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")+EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))/");
      count += FPRINTF(f,"(EXP(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")-EXP(-(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")))");
      return;
    case F_CUBE:
      count += FPRINTF(f,"(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")**(3)");
      return;
    case F_CBRT:
      count += FPRINTF(f,"(");
      count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
      count += FPRINTF(f,")**(1/3)");
      return;
    }
    count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
    PUTC(')',f);
    break;
  case CG_ascend:
  case CG_c:
  case CG_linear:
  default:
    count += FPRINTF(f,"%s(",FuncName(TermFunc(term)));
    count = CodeGen_WriteSide(f,TermFuncLeft(term),r,format,count) + 1;
    PUTC(')',f);
    break;
  }
  return count;
}

int CodeGen_WriteSide(FILE *f, Term *term,
                      RelationINF *r,
                      struct CGFormat *format,
                      int nchars)
{
  enum Expr_enum t;
  int parens;
  int count;

  count = nchars;
  if (count>=70) {      /* allow anyone to break lines */
    CodeGen_BreakLines(f,format);
    count = 0;
  }
  switch(t = RelationTermType(term)) {
  case e_var:
    count += WriteName(f,term,r,format);
    break;
  case e_int:
    (TermInteger(term) < 0) ?
      (count += FPRINTF(f,"(%ld)",TermInteger(term))) :
        (count += FPRINTF(f,"%ld",TermInteger(term)));
    break;
  case e_real:
    (TermReal(term) < 0) ?
      (count += FPRINTF(f,"(%g)",TermReal(term))) :
        (count += FPRINTF(f,"%g",TermReal(term)));
    break;
  case e_func:
    count = CodeGen_WriteBuiltInFuncs(f,term,r,format,count);
    break;
  case e_uminus:
    FPRINTF(f,"(-(");
    count = CodeGen_WriteSide(f,TermUniLeft(term),r,format,count) + 2;
    FPRINTF(f,"))");
    break;
  case e_plus:
  case e_minus:
  case e_times:
  case e_divide:
    if (parens = NeedParen(t,RelationTermType(TermBinLeft(term)),0)) {
      PUTC('(',f);
    }
    count = CodeGen_WriteSide(f,TermBinLeft(term),r,format,count) + 2;
    if (parens) {
      PUTC(')',f);
    }
    WriteOp(f,t);
    if (parens = NeedParen(t,RelationTermType(TermBinRight(term)),1)) {
      PUTC('(',f);
    }
    count = CodeGen_WriteSide(f,TermBinRight(term),r,format,count) + 2;
    if (parens) {
      PUTC(')',f);
    }
    break;
  case e_power:
  case e_ipower:
    count = WritePower(f,term,r,format,count);
    break;
  default:
    FPRINTF(f,"***");
    break;
  }
  return count;
}


/*
 **********************************************************************
 * At this point it is assumed that the parameter list,
 * the variable list, and the relations have been appropriately
 * marked. We are now going to get the incidence pattern for
 * the variables and relations that are needed to do a computation.
 *
 * This module will eventually support mulitple sparse matrix
 * formats. We are implementing the code for both the linked list
 * format, on which the Harwell format is based, as well as the CSR
 * format. Eventaully the JDS format will supported. At the moment all
 * the formatting will be written for C-style indexing. We might later
 * generate fortran style indexing.
 *
 * We write out the *entire* matrix pattern of computable variables.
 * By this we mean anything that passes the solver_var filter will be
 * written out. Relations obtained from the ASCEND compiler store
 * information what will not pass the solver var filter. We weed those
 * out here.
 *
 * The first thing to be written out is the vector "ha". Given below
 * is an orignal set of relations and the corresponding ha and ka.
 * ka is dependent upon the matrix format which is chosen; the example
 * below shows what ka looks like for two formats.
 *
 *  solver_vars x4,x3; (x2 fails solver_var filter)
 *  x4.index = 10,
 *  x3.index = 6 (x2 would not have a variable index)
 *
 *  x4 * x2 + x3 = 5;   (relation 1)
 *  x2 * x3      = 1;   (relation 2)
 *
 *  ka = [1,3]  -- CSR format.
 *  ka = [1,1,2]    -- LL format.
 *  ha = [10,6,6]
 *
 **********************************************************************
 */

/*
 * There should be a 1 to 1 mapping between the relations list
 * and the incident_var_count list. What we do for the LL matrix
 * format is to write out the relation ndx as many times as there
 * are incidences; this will give the required row, col indexing on
 * the incident variables. I know it seems a little twisted.
 */
int CodeGen_WriteKA_LL(FILE *fp, slv_system_t sys,
                       int *incident_var_count)
{
  int *ip,i,j;
  int num_rels,ndx,count=0;
  struct rel_relation **rp;

  ip = incident_var_count;
  rp = g_cgdata.rels.rel_list;
  num_rels = g_cgdata.rels.num_rels;

  CodeGen_ResetPrettyPrinter();
  CG("static int ka[] = {\n");
  for (i=0;i<num_rels;i++) {
    ndx = rel_index(rp[i]);
    count = ip[i];
    for (j=0;j<count;j++) {
      CodeGen_PrettyPrintInteger(fp,ndx);
    }
  }
  CodeGen_ResetPrettyPrinter();
  CG("-1\n};");  /* Write  a -1 as a safety check on the end of ka */
  CG("\n\n");

  FFLUSH(fp);
  return 0;
}

/*
 * This particular piece of code will need modification
 * if support a fortran style indexing. At the moment life
 * starts at 0. The incident_var_count vector should be
 * provided and deallocated by the caller, as should be
 * terminated with a -1.
 */
int CodeGen_WriteKA_CSR(FILE *fp, slv_system_t sys,
                        int *incident_var_count)
{
  int *ip;
  int count=0;
  struct rel_relation **rlist;

  rlist = g_cgdata.rels.rel_list;

  CG("static int ka[] = {\n");
  CodeGen_PrettyPrintInteger(fp,0); /* start the ball a rollin' */
  for (ip = incident_var_count; *ip != -1; ip++) {
    count += *ip;
    CodeGen_PrettyPrintInteger(fp,count);
  }
  CodeGen_ResetPrettyPrinter();
  CG("-1\n};");  /* I am writing a -1 as a safety check on the end of ka */
  CG("\n\n");

  FFLUSH(fp);
  return 0;
}

int CodeGen_WriteIncidence(FILE *fp,slv_system_t sys)
{
  int32 maxrel,maxvar;
  struct rel_relation **rp;
  enum Expr_enum type;      /* type of the relation */
  int var_count = 0;        /* var count per relation */
  int tot_var_count = 0;    /* totalized variable count */
  int *incident_var_count = NULL;

  struct CGVar *cgvar;
  struct Instance *var_inst;
  struct Instance *rel_inst;
  CONST struct relation *r;
  unsigned long n_varsinrel,i,j;
  int *ip;
  int result;

  maxrel = g_cgdata.filtered.num_rels;
  maxvar = g_cgdata.filtered.num_vars;

  /*
   * make a list of size maxrel+1 to hold the count of incident
   * variables for each relation. This list will be used by ka.
   * set the first element of this list to 1. We will be using
   * fortran style indexing. Terminate the list with a -1 so that
   * we know when we are done.
   */

  ip = incident_var_count = (int *)asccalloc((maxrel+1),sizeof(int));

  rp = g_cgdata.rels.rel_list;
  CG("static int ha[] = {\n");
  for (i=0;i<maxrel;i++) {
    rel_inst = rel_instance(rp[i]);
    r = GetInstanceRelation(rel_inst,&type);
    n_varsinrel = NumberVariables(r);
    var_count = 0;
    for (j=1;j<=n_varsinrel;j++) {
      var_inst = RelationVariable(r,j);
      if (solver_var(var_inst)) {           /* see expr.h */
        cgvar = Asc_CGInstanceVar(var_inst);
        CodeGen_PrettyPrintInteger(fp,cgvar->index);
        var_count++;    /*  update the number of incident solver_vars */
        tot_var_count++;
      }
    }
    *ip++ = var_count; /* update the incident_var_count list */
  }

  *ip = -1;                         /* terminate */
  g_cgdata.filtered.num_incidences = tot_var_count; /* cache info */
  CodeGen_ResetPrettyPrinter();
  CG("-1\n};"); /* I am writing a -1 as a safety check on the end of ha */
  CG("\n\n");

  /*
   * Let us go for ka. In processing 'ha' we have cached away the
   * count of variables so that we dont have grab the incidence list
   * for each relation again. So just process that list now.
   */

  switch(g_cgdata.matrix_type) {
  case CG_ll:
    result = CodeGen_WriteKA_LL(fp,sys,incident_var_count);
    FPRINTF(fp,"/*\n");
    result = CodeGen_WriteKA_CSR(fp,sys,incident_var_count);
    FPRINTF(fp," */\n");
    break;
  case CG_csr:
    result = CodeGen_WriteKA_CSR(fp,sys,incident_var_count);
    break;
  case CG_jds:
    FPRINTF(stderr,"JDS Format not yet supported\n");
    break;
  default:
    result = CodeGen_WriteKA_LL(fp,sys,incident_var_count);
    break;
  }

  if (incident_var_count) {
    ascfree(incident_var_count);
  }
  return result;
}

int CodeGen_WriteInputVarIndices(FILE *fp, char *file_prefix)
{
  unsigned long ninputs,c;
  int index;
  struct CGVar *cgvar;
  struct Instance *inst;

  if (g_cgdata.input_list == NULL) {
    ninputs = 0;
  } else {
    ninputs = gl_length(g_cgdata.input_list);
  }

  CodeGen_ResetPrettyPrinter();
  FPRINTF(fp,"static int inputs[] = {\n");

  for (c=1;c<=ninputs;c++) {    /* remember gl_lists number from 1 */
    inst = (struct Instance *)gl_fetch(g_cgdata.input_list,c);
    cgvar = Asc_CGInstanceVar(inst);
    CodeGen_PrettyPrintInteger(fp,cgvar->index);
  }
  FPRINTF(fp,"-1\n");
  FPRINTF(fp,"};\n");
  CodeGen_ResetPrettyPrinter();
}

int CodeGen_WriteOutputVarIndices(FILE *fp, char *file_prefix)
{
  unsigned long noutputs,c;
  int index;
  struct CGVar *cgvar;
  struct Instance *inst;

  if (g_cgdata.output_list == NULL) {
    noutputs = 0;
  } else {
    noutputs = gl_length(g_cgdata.output_list);
  }

  CodeGen_ResetPrettyPrinter();
  FPRINTF(fp,"static int outputs[] = {\n");

  for (c=1;c<=noutputs;c++) {   /* remember gl_lists number from 1 */
    inst = (struct Instance *)gl_fetch(g_cgdata.output_list,c);
    cgvar = Asc_CGInstanceVar(inst);
    CodeGen_PrettyPrintInteger(fp,cgvar->index);
  }
  FPRINTF(fp,"-1\n");
  FPRINTF(fp,"};\n");
  CodeGen_ResetPrettyPrinter();
}


/*
 * Write out the variable types array. This is an integer array
 * saying whether the variable is:
 * 0 - free,
 * 1 - fixed and internal,
 * 2 - fixed but input, (interface variable).
 * At the moment we are assuming that it is *illegal* for a variable
 * to be both CG_INPUT and CG_OUTPUT. We deal with output variables
 * elsewhere. It is the job of SetUpVariables to ensure that we
 * have good data at this point.
 */

int CodeGen_WriteVarTypes(FILE *fp, char *file_prefix)
{
  int num_vars, c;
  unsigned int filter = 0x0;
  unsigned int MASK;
  struct CGVar *cgvarlist;

  num_vars = g_cgdata.vars.num_vars;
  cgvarlist = g_cgdata.vars.var_list;

  CodeGen_ResetPrettyPrinter();
  FPRINTF(fp,"static int vartypes[] = {\n");

  for (c=0;c<num_vars;c++) {
    filter = cgvarlist[c].flags;
    if (filter & CG_FIXED) {            /* fixed variables */
      MASK = CG_INPUT | CG_OUTPUT;
      filter = filter & MASK;
      switch(filter) {
      case CG_INPUT:
        CodeGen_PrettyPrintInteger(fp,-2);  /* input fixed var */
        break;
      case CG_OUTPUT:
        FPRINTF(stderr,"Warning: fixed variable is both input and output\n");
        CodeGen_PrettyPrintInteger(fp,-2);  /* mark as input */
        break;
      default:
        CodeGen_PrettyPrintInteger(fp,1);   /* normal fixed var */
        break;
      }
    } else {                    /* free var */
      CodeGen_PrettyPrintInteger(fp,0);
    }
  }
  FPRINTF(fp,"-99\n");
  FPRINTF(fp,"};\n");
  CodeGen_ResetPrettyPrinter();
}

int CodeGen_WriteRelTypes(FILE *fp, char *file_prefix)
{
  int num_rels,c;
  unsigned int filter = 0x0;
  unsigned int MASK;
  struct rel_relation **rlist;

  num_rels = g_cgdata.rels.num_rels;
  rlist = g_cgdata.rels.rel_list;

  CodeGen_ResetPrettyPrinter();
  FPRINTF(fp,"\nstatic int reltypes[] = {\n",file_prefix);

  for (c=0;c<num_rels;c++) {
    filter = rlist[c]->flags;
    if (filter & CG_INCLUDED) {
      MASK = CG_LESS | CG_GREATER;
      filter = filter & MASK;       /* filter unwanteds so that we
                                         * can switch over the rest */
      switch(filter) {
      case CG_LESS:
        CodeGen_PrettyPrintInteger(fp,1);
        break;
      case CG_GREATER:
        CodeGen_PrettyPrintInteger(fp,-1);
        break;
      case CG_EQUAL:
      default:
        CodeGen_PrettyPrintInteger(fp,0);
        break;
      }
    } else {                /* not included */
      CodeGen_PrettyPrintInteger(fp,-2);
    }
  }
  FPRINTF(fp,"-99\n");
  FPRINTF(fp,"};\n");
  CodeGen_ResetPrettyPrinter();
}


/*
 * This function will attempt to write out as much as information
 * as a client/solver would need to be able to set up the problem.
 * Later on it will take a prefix, so as to give some name space
 * protection, or maybe use a structure. The convention is that a
 * value for any size less than 0, is garbage.
 */

int CodeGen_WriteProblemHeader(char *file_prefix)
{
  char *headerfile = NULL;
  FILE *hdr;
  headerfile = (char *)ascmalloc((strlen(file_prefix)+4)*sizeof(char));
  sprintf(headerfile,"%s.h",file_prefix);
  hdr = fopen(headerfile,"w");
  if (!hdr) {
    FPRINTF(stderr,"Error in opening file %s.h\n",file_prefix);
    if (headerfile) {
      ascfree(headerfile);
    }
    return 1;
  }

  FPRINTF(hdr,"/***************** ");
  FPRINTF(hdr,"This file was generated by Ascend *************/\n\n");
  PUTC('\n',hdr);
  FPRINTF(hdr,"#ifndef __%s_H_SEEN__\n",file_prefix);
  FPRINTF(hdr,"#define __%s_H_SEEN__\n",file_prefix);
  FPRINTF(hdr,"#include \"codegen_support.h\"\n\n");
  FPRINTF(hdr,"extern struct CG_Problem %s__problem;\n",file_prefix);
  PUTC('\n',hdr);

  FPRINTF(hdr,"extern void %s__Initialize();\n",file_prefix);
  FPRINTF(hdr,"\t/* double *x, double *u, double *lower,\n");
  FPRINTF(hdr,"\t   double *upper, double *nominal */\n");
  FPRINTF(hdr,"extern ExtEvalFunc *%s__FuncTable[];\n",file_prefix);
  FPRINTF(hdr,"extern ExtEvalFunc *%s__GradTable[];\n",file_prefix);
  PUTC('\n',hdr);
  FPRINTF(hdr,"#endif \t/*  __%s_H_SEEN__ */\n",file_prefix);
  fclose(hdr);
  if (headerfile) {
    ascfree(headerfile);
  }
  return 0;
}


void CodeGen_WriteDriver(char *file_prefix)
{
  FILE *dfile;
  char *filename=NULL;

  filename = (char *)ascmalloc((strlen(file_prefix)+32)*sizeof(char));
  sprintf(filename,"%s_driver.c",file_prefix);
  dfile = fopen(filename,"w");
  if (dfile==NULL) {
    FPRINTF(stderr,"Error in opening %s_driver.c\n",file_prefix);
    goto error;
  }

  FPRINTF(dfile,"#include <stdio.h>\n");
  FPRINTF(dfile,"#include <stdlib.h>\n");
  FPRINTF(dfile,"#include <math.h>\n");
  FPRINTF(dfile,"#include  \"codegen_support.h\"\n");
  FPRINTF(dfile,"#include \"%s.h\"\n",file_prefix);

  FPRINTF(dfile,"\n\n");
  FPRINTF(dfile,"main()\n");
  FPRINTF(dfile,"{\n");
  FPRINTF(dfile,"  int i;\n");
  FPRINTF(dfile,"  int result = 0;\n\n");
  FPRINTF(dfile,"  int mode,m,n;\n");
  FPRINTF(dfile,"  int sizeof_x_vector, sizeof_u_vector;\n");
  FPRINTF(dfile,"  int sizeof_f_vector, sizeof_g_vector;\n");
  FPRINTF(dfile,"  double *lower, *upper, *nominal;\n");
  FPRINTF(dfile,"  double *x, *u, *f, *g;\n");
  FPRINTF(dfile,"  ExtEvalFunc *func;\n\n");


  FPRINTF(dfile,"  m = %s__problem.number_variables;\n",file_prefix);
  FPRINTF(dfile,"  n = %s__problem.number_relations;\n",file_prefix);
  FPRINTF(dfile,"  sizeof_x_vector = %s__problem.sizeof_x_vector;\n",
          file_prefix);
  FPRINTF(dfile,"  sizeof_u_vector = %s__problem.sizeof_u_vector;\n",
          file_prefix);
  FPRINTF(dfile,"  sizeof_f_vector = %s__problem.sizeof_f_vector;\n",
          file_prefix);
  FPRINTF(dfile,"  sizeof_g_vector = %s__problem.sizeof_g_vector;\n",
          file_prefix);
  FPRINTF(dfile,"  mode = 2;\n\n");

  FPRINTF(dfile,
          "  x = (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
  FPRINTF(dfile,
          "  u = (double*)calloc((sizeof_u_vector+1),sizeof(double));\n");
  FPRINTF(dfile,
          "  f = (double*)calloc((sizeof_f_vector+1),sizeof(double));\n");
  FPRINTF(dfile,
          "  g = (double*)calloc((sizeof_g_vector+1),sizeof(double));\n");
  FPRINTF(dfile,
          "  lower = (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
  FPRINTF(dfile,
          "  upper= (double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
  FPRINTF(dfile,
          "  nominal = "
          "(double*)calloc((sizeof_x_vector+1),sizeof(double));\n");
  PUTC('\n',dfile);

  FPRINTF(dfile,"  %s__Initialize(x,u,lower,upper,nominal);\n",
          file_prefix);

  FPRINTF(dfile,"  for (i=0;i<m;i++) {\n");
  FPRINTF(dfile,"    func = %s__FuncTable[i];\n",file_prefix);
  FPRINTF(dfile,"    result += (*func)(&mode,&m,&n,x,u,f,g);\n");
  FPRINTF(dfile,"  }\n");
  FPRINTF(dfile,"}\n\n");

 error:
  if (dfile) {
    fclose(dfile);
  }
  if (filename) {
    ascfree(filename);
  }
}


/*
 * The initialization code here has to be updated whenever
 * the CG_problem definition changes.
 */
void CodeGen_WriteProblemStats(FILE *fp, char *file_prefix)
{
  int num_inputs, num_outputs;

  if (g_cgdata.input_list) {
    num_inputs = (int)gl_length(g_cgdata.input_list);
  } else {
    num_inputs = 0;
  }
  if (g_cgdata.output_list) {
    num_outputs = (int)gl_length(g_cgdata.output_list);
  } else {
    num_outputs = 0;
  }


  PUTC('\n',fp);
  FPRINTF(fp,"struct CG_Problem %s__problem = {\n",file_prefix);
  FPRINTF(fp,"  %d, \t/* num_rels */\n",g_cgdata.filtered.num_rels);
  FPRINTF(fp,"  %d, \t/* num_vars */\n",g_cgdata.filtered.num_vars);
  FPRINTF(fp,"  %d, \t/* num_incidences */\n",
          g_cgdata.filtered.num_incidences);
  FPRINTF(fp,"  %d, \t/* num_inputs */\n",num_inputs);
  FPRINTF(fp,"  %d, \t/* num_outputs */\n",num_outputs);

  FPRINTF(fp,"  %d, \t/* tot_num_vars */\n",g_cgdata.vars.num_vars);
  FPRINTF(fp,"  %d, \t/* tot_num_pars */\n",g_cgdata.pars.num_pars);
  FPRINTF(fp,"  %d, \t/* tot_num_rels */\n",g_cgdata.rels.num_rels);
  FPRINTF(fp,"  %d, \t/* num_incidences */\n",
          g_cgdata.filtered.num_incidences);
  FPRINTF(fp,"  \t/*\n");
  FPRINTF(fp,"  \t * Other stuff\n");
  FPRINTF(fp,"  \t */\n");
  FPRINTF(fp,"  ha, \t/* row indexes */\n");
  FPRINTF(fp,"  ka, \t/* column indexes */\n");
  FPRINTF(fp,"  vartypes,\t/* variable types */\n");
  FPRINTF(fp,"  reltypes,\t/* relation types */\n");
  FPRINTF(fp,"  inputs, \t/* input indices */\n");
  FPRINTF(fp,"  outputs, \t/* output_indices */\n");
  FPRINTF(fp,"  NULL, \t/* u_vector */\n");
  FPRINTF(fp,"  NULL \t/* wild_hook for user_data */\n");
  FPRINTF(fp,"};\n");
  PUTC('\n',fp);
}


static int CG_Classify(struct Instance *inst)
{
  return 1;
}

int CodeGen_WriteFunctions1(FILE *fp, int gradients,
                            struct CGFormat *format)
{
  struct rel_relation **rp, *rel_tmp;
  struct CGVar *var_list;
  struct Instance *rel_inst, *var_inst;
  RelationINF *r, *derivative;
  enum Expr_enum type;
  Term *lhs,*rhs;
  int nchars = 0;

  int num_rels,num_vars;
  unsigned long n_varsinrel;
  unsigned long i,j;
  int a_index=0;

  var_list = g_cgdata.vars.var_list;
  num_rels = g_cgdata.rels.num_rels;
  rel_tmp = rp = g_cgdata.rels.rel_list;

  for (i=0;i<num_rels;i++) {
    if (Asc_CGRelIncluded(rp[i])) {             /* get status */
      rel_inst = rel_instance(rp[i]);           /* get instance*/
      r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel struct */
      if (type!=e_token) {
        FPRINTF(stderr,"rel type not supported in CodeGen_WriteFunctions1\n");
        continue;
      }
      FPRINTF(fp,"\tf[%d] = ",rel_index(rp[i]));    /* write label */
      if ((lhs = RelationINF_Lhs(r))!=NULL) {       /* get lhs */
        nchars = CodeGen_WriteSide(fp,lhs,r,format,0);  /* write lhs */
      }
      if ((rhs = RelationINF_Rhs(r))!=NULL) {           /* get rhs */
        FPRINTF(fp," - (");
        nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars);/* write rhs */
        PUTC(')',fp);
      }
      FPRINTF(fp,";\n");                /* terminate func */
    }
  }

  /*
   * Now go for the gradients
   */
  FPRINTF(fp,"\tif (*mode!=2) {return 0;}\n");
  if(!gradients) {
    return 0;
  }

  PrepareDerivatives(1,1,1000); /* 1 buffer, 2000 blocks */

  a_index = 1;
  for (i=0;i<num_rels;i++) {
    if (Asc_CGRelIncluded(rp[i])) {
      rel_inst = rel_instance(rp[i]);
      r = (RelationINF *)GetInstanceRelation(rel_inst,&type);
      if (type!=e_token) {
        FPRINTF(stderr,"rel type not supported in CodeGen_WriteFunctions1\n");
        continue;
      }
      n_varsinrel = NumberVariables(r);
      for (j=1;j<=n_varsinrel;j++) {
        var_inst = RelationVariable(r,j);
        if (solver_var(var_inst)) {
          derivative = RelDeriveSloppy(r,j,CG_Classify);
          FPRINTF(fp,"\tg[%d] = ",a_index);
          if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
            nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
          }
          if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
            FPRINTF(fp," - (");
            nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
            PUTC(')',fp);
          }
          FPRINTF(fp,";\n");
          RelDestroySloppy(derivative);
          a_index++;
        }
      }
    }
  }
  ShutDownDerivatives();
}

/*
 **********************************************************************
 * CodeGen__WriteFunctions2
 *
 * This function writes a function that will compute the
 * residuals and the gradients for a given relation. It
 * returns 1 in the event of a problem, 0 otherwise.
 * NOTE, it takes as an arguement "ndx_offset", from which
 * it should start for indexing its gradients. E.g,
 * if ndx_offset = 5, and 3 gradients are written, they should
 * have indices 6,7,8 and ndx_offset should be updated to 8.
 **********************************************************************
 */
int CodeGen__WriteFunctions2(FILE *fp, struct rel_relation *rel,
                             struct CGFormat *format)
{
  struct Instance *rel_inst, *var_inst;
  RelationINF *r;
  enum Expr_enum type;
  Term *lhs,*rhs;
  int nchars;

  rel_inst = rel_instance(rel);
  r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */
  if (type!=e_token) {
    FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteFunctions2\n");
    return;
  }

  /* write label */
  FPRINTF(fp,"\tf[%d] = ",rel_index(rel));      /* FIX FIX FIX */
  if ((lhs = RelationINF_Lhs(r))!=NULL) {       /* get lhs */
    nchars = CodeGen_WriteSide(fp,lhs,r,format,0);  /* write lhs */
  }
  if ((rhs = RelationINF_Rhs(r))!=NULL) {       /* get rhs */
    FPRINTF(fp," - (");
    nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars); /* write rhs */
    PUTC(')',fp);
  }
  FPRINTF(fp,";\n\n");                  /* terminate func */
  return 0;
}

int CodeGen__WriteGradients2(FILE *fp, struct rel_relation *rel,
                             struct CGFormat *format,
                             int *ndx_offset)
{
  struct Instance *rel_inst, *var_inst;
  RelationINF *r, *derivative;
  enum Expr_enum type;
  Term *lhs,*rhs;
  int a_index;
  int nchars;
  unsigned long n_varsinrel,j;

  a_index = *ndx_offset;

  rel_inst = rel_instance(rel);
  r = (RelationINF *)GetInstanceRelation(rel_inst,&type);
  if (type!=e_token) {
    FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteGradients2\n");
    return;
  }

  n_varsinrel = NumberVariables(r);
  for (j=1;j<=n_varsinrel;j++) {
    var_inst = RelationVariable(r,j);
    if (solver_var(var_inst)) {
      derivative = RelDeriveSloppy(r,j,CG_Classify);
      FPRINTF(fp,"\tg[%d] = ",++a_index);   /* FIX FIX FIX */
      if ((lhs = RelationINF_Lhs(derivative))!=NULL) { /* write lhs */
        nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
      }
      if ((rhs = RelationINF_Rhs(derivative))!=NULL) { /* write rhs */
        FPRINTF(fp," - (");
        nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
        PUTC(')',fp);
      }
      FPRINTF(fp,";\n");
      RelDestroySloppy(derivative);
    }
  }
  *ndx_offset = a_index;    /* set up for return */
  return 0;
}


/*
 **********************************************************************
 * CodeGen__WriteFunctions3
 *
 * This code need some rationalization with CodeGen__WriteFunctions2.
 * The only difference between CodeGen__WriteFunctions2 and this code,
 * is the format of the indexing for the functions, gradients, and
 * the x vector. Also a u vector is *not* supported. This code is
 * essentially for generating glassbox relations, whereas the
 * CodeGen__WriteFunctions2, code is for blackbox relations.
 *
 **********************************************************************
 */

int CodeGen__WriteFunctions3(FILE *fp, struct rel_relation *rel,
                             struct CGFormat *format)
{
  struct Instance *rel_inst, *var_inst;
  RelationINF *r;
  enum Expr_enum type;
  Term *lhs,*rhs;
  int nchars;

  rel_inst = rel_instance(rel);
  r = (RelationINF *)GetInstanceRelation(rel_inst,&type); /* rel structure */
  if (type!=e_token) {
    FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteFunctions3\n");
    return;
  }

  FPRINTF(fp,"\tf[0] = ");              /* all index from 0 */
  if ((lhs = RelationINF_Lhs(r))!=NULL) {       /* get lhs */
    nchars = CodeGen_WriteSide(fp,lhs,r,format,0);  /* write lhs */
  }
  if ((rhs = RelationINF_Rhs(r))!=NULL) {       /* get rhs */
    FPRINTF(fp," - (");
    nchars = CodeGen_WriteSide(fp,rhs,r,format,nchars); /* write rhs */
    PUTC(')',fp);
  }
  FPRINTF(fp,";\n\n");                  /* terminate func */
  return 0;
}

int CodeGen__WriteGradients3(FILE *fp, struct rel_relation *rel,
                             struct CGFormat *format)
{
  struct Instance *relinst, *inst;
  struct CGVar *cgvar;
  RelationINF *r, *derivative;
  enum Expr_enum type;
  Term *lhs,*rhs;
  int nchars;
  int n_varsinrel,j;
  unsigned int filter;

  relinst = rel_instance(rel);
  r = (RelationINF *)GetInstanceRelation(relinst,&type);
  if (type!=e_token) {
    FPRINTF(stderr,"rel type not yet supported in CodeGen_WriteGradients3\n");
    return;
  }

  n_varsinrel = (int)NumberVariables(r);
  if (n_varsinrel) {
    for (j=0;j<n_varsinrel;j++) {
      inst = RelationVariable(r,j+1);
      cgvar = (struct CGVar *)GetInterfacePtr(inst);
      assert(cgvar);            /* desperate integrity check */
      /*
       * only do derivatives for open variables i.e. potential
       * solver_vars, and for variables that are already solver_vars.
       */
      filter = cgvar->flags;
      if (filter & CG_SLV_CONST) {
        continue;
      }
      derivative = RelDeriveSloppy(r,j+1,CG_Classify);
      FPRINTF(fp,"\tg[%d] = ",j);
      if ((lhs = RelationINF_Lhs(derivative))!=NULL) {  /* write lhs */
        nchars = CodeGen_WriteSide(fp,lhs,derivative,format,0);
      }
      if ((rhs = RelationINF_Rhs(derivative))!=NULL) {  /* write rhs */
        FPRINTF(fp," - (");
        nchars = CodeGen_WriteSide(fp,rhs,derivative,format,nchars);
        PUTC(')',fp);
      }
      FPRINTF(fp,";\n");
      RelDestroySloppy(derivative);
    }
  }
  return 0;
}


/*
 * This writes out the code for the functable,
 * which is a static array of pointers to funcs.
 */

int CodeGen_WriteFuncTable(FILE *fp,char *file_prefix)
{
  struct rel_relation **rp = g_cgdata.rels.rel_list;
  int num_rels = g_cgdata.rels.num_rels;
  int i, num_chars=0;
  char str[80];

  sprintf(str,"&%s",CG_CFUNCNAME);
  CodeGen_ResetPrettyPrinter();
  PUTC('\n',fp);
  FPRINTF(fp,"ExtEvalFunc *%s__FuncTable[] = {\n",file_prefix);
  for (i=0;i<num_rels;i++) {
    CodeGen_PrettyPrintStr(fp,str,rel_index(rp[i]));
  }
  CG("NULL\n};");
  CG("\n\n");
  CodeGen_ResetPrettyPrinter();
}

int CodeGen_WriteGradTable(FILE *fp,char *file_prefix)
{
  struct rel_relation **rp = g_cgdata.rels.rel_list;
  int num_rels = g_cgdata.rels.num_rels;
  int i, num_chars=0;
  char str[80];

  sprintf(str,"&%s",CG_CGRADNAME);
  CodeGen_ResetPrettyPrinter();
  PUTC('\n',fp);
  FPRINTF(fp,"ExtEvalFunc *%s__GradTable[] = {\n",file_prefix);
  for (i=0;i<num_rels;i++) {
    CodeGen_PrettyPrintStr(fp,str,rel_index(rp[i]));
  }
  CG("NULL\n};");
  CG("\n\n");
  CodeGen_ResetPrettyPrinter();
}

int CodeGen_WriteLoadCode(FILE *fp,char *file_prefix)
{
  FPRINTF(fp,"#ifdef ASCEND\n");
  FPRINTF(fp,"extern int CreateUserFunction();\n");

  FPRINTF(fp,"int %s_Init(void)\n",file_prefix);
  FPRINTF(fp,"{\n");
  FPRINTF(fp,"  int result;\n");
  FPRINTF(fp,"  char %s_help[] = \"%s glassbox model\";\n",
          file_prefix,file_prefix);
  FPRINTF(fp,"  result = CreateUserFunction(\"%s\", NULL,\n",file_prefix);
  FPRINTF(fp,"                              %s__FuncTable,\n",file_prefix);
  FPRINTF(fp,"                              %s__GradTable,\n",file_prefix);
  FPRINTF(fp,"                              NULL,1,1,%s_help);\n",
          file_prefix);
  FPRINTF(fp,"  return result;\n");
  FPRINTF(fp,"}\n");
  FPRINTF(fp,"#endif\n");
}


int CodeGen_WriteFunctions(FILE *fp, int gradients,
                           struct CGFormat *format)
{
  struct rel_relation **rp;
  int num_rels;
  int i,offset;
  int result;

  offset = CG_OFFSET-1;
  num_rels = g_cgdata.rels.num_rels;
  rp = g_cgdata.rels.rel_list;

  if (gradients) {
    PrepareDerivatives(1,1,1000);
  }

  switch (format->names) {
  case CG_blackbox:
   for (i=0;i<num_rels;i++) {
     CodeGen_WriteFuncHeader2(fp,i);    /* write *all* relations */
     CodeGen__WriteFunctions2(fp,rp[i],format);
     CodeGen_WriteFuncFooter(fp);
     if (gradients) {
       CodeGen_WriteGradHeader2(fp,i);  /* write *all* relations */
       CodeGen__WriteGradients2(fp,rp[i],format,&offset);
       CodeGen_WriteFuncFooter(fp);
       PUTC('\n',fp);
     }
   }
   break;
 case CG_glassbox:
   for (i=0;i<num_rels;i++) {
     CodeGen_WriteFuncHeader2(fp,i);    /* write *all* relations */
     CodeGen__WriteFunctions3(fp,rp[i],format);
     CodeGen_WriteFuncFooter(fp);
     if (gradients) {
       CodeGen_WriteGradHeader2(fp,i);  /* write *all* relations */
       CodeGen__WriteGradients3(fp,rp[i],format);
       CodeGen_WriteFuncFooter(fp);
       PUTC('\n',fp);
     }
   }
   break;
 case CG_minos:
   CodeGen_WriteFuncHeader1(fp);
   CodeGen_WriteFuncDecln(fp);
   CodeGen_WriteFunctions1(fp,gradients,format);
   CodeGen_WriteFuncFooter(fp);
   break;
 }
  if (gradients) {
    ShutDownDerivatives();
  }
  return 0;
}

int CodeGen_BlackBox(slv_system_t sys,
                     FILE *fp, char *file_prefix, struct CGFormat *format,
                     int do_gradients,
                     struct gl_list_t *inputs,
                     struct gl_list_t *outputs,
                     struct gl_list_t *parameters)
{
  int result;

  result = CodeGen_SetupCodeGen(sys, NULL,0, NULL,0, NULL,0, NULL,0,
                                inputs,outputs);
  result += CodeGen_CheckData();
  CodeGen_WriteIncidence(fp,sys);
  CodeGen_WriteInputVarIndices(fp,file_prefix);
  CodeGen_WriteOutputVarIndices(fp,file_prefix);
  CodeGen_WriteVarTypes(fp,file_prefix);
  CodeGen_WriteRelTypes(fp,file_prefix);
  if (result = CodeGen_WriteProblemHeader(file_prefix)) {
    goto error;
  }
  CodeGen_WriteDriver(file_prefix);
  CodeGen_WriteProblemStats(fp,file_prefix);
  CodeGen_WriteInitValues(fp,file_prefix);
  CodeGen_WriteFunctions(fp,do_gradients,format);
  CodeGen_WriteFuncTable(fp,file_prefix);
  CodeGen_WriteGradTable(fp,file_prefix);

 error:
  Asc_CodeGenShutDown();
  return result;

}

int CodeGen_GlassBox(slv_system_t sys,
                     FILE *fp, char *file_prefix, struct CGFormat *format,
                     int do_gradients,
                     struct gl_list_t *inputs,
                     struct gl_list_t *outputs,
                     struct gl_list_t *parameters)
{
  struct Instance *root;
  struct gl_list_t *list = NULL;
  struct CGVar *cgvarlist;
  int nvars;
  int result;

  root = g_solvinst_cur;        /* see interface1.h */
  list = PreProcessVars(root);
  cgvarlist = Asc_CodeGenSetUpVariables3(list);
  nvars = (int)gl_length(list);
  result = CodeGen_SetupCodeGen(sys, cgvarlist,nvars, NULL,0, NULL,0, NULL,0,
                                inputs,outputs);
  result += CodeGen_CheckData();
  CodeGen_WriteIncidence(fp,sys);
  CodeGen_WriteInputVarIndices(fp,file_prefix);
  CodeGen_WriteOutputVarIndices(fp,file_prefix);
  CodeGen_WriteVarTypes(fp,file_prefix);
  CodeGen_WriteRelTypes(fp,file_prefix);
  if (result = CodeGen_WriteProblemHeader(file_prefix)) {
    goto error;
  }
  CodeGen_WriteDriver(file_prefix);
  CodeGen_WriteProblemStats(fp,file_prefix);
  CodeGen_WriteFunctions(fp,do_gradients,format);
  CodeGen_WriteFuncTable(fp,file_prefix);
  CodeGen_WriteGradTable(fp,file_prefix);
  CodeGen_WriteLoadCode(fp,file_prefix);

 error:
  if (list) {
    gl_destroy(list);
  }
  Asc_CodeGenShutDown();
  return result;
}


/*
 **********************************************************************
 * CodeGen_ParseData
 *
 * This function takes a string list -- a Tcl list -- of instance
 * names, and returns a gl_list_t of the correspoding instances.
 * If there are any errors, a NULL is returned. We will also return
 * the count of elements that tcl found.
 **********************************************************************
 */
struct gl_list_t *CodeGen_ParseData(Tcl_Interp *interp, char *strlist,
                                    int *found_count)
{
  struct gl_list_t *list;
  struct Instance *i;
  char **argv=NULL;     /* the split list of strings */
  int len,c;
  int error = 0;

  if (Tcl_SplitList(interp,strlist,found_count,&argv) != TCL_OK) {
    return NULL;
  }
  if (*found_count==0) {    /* parsed ok, but was a zero length list */
    if (argv) {
      Tcl_Free((char *)argv);
    }
    return NULL;
  }
  len = *found_count;
  list = gl_create((unsigned long)len);
  /*
   * Search for each instance in turn. Qlfdid will leave
   * g_search_inst looking at the found instance.
   */
  for (c=0;c<len;c++) {
    if (Asc_QlfdidSearch3(argv[c])==0,0) {
      gl_append_ptr(list,(char *)g_search_inst);
    } else {
      FPRINTF(stderr,"Error in finding instance %s\n",argv[c]);
      error++;
      break;
    }
  }
  if (error) {
    gl_destroy(list);
    if (argv != NULL) {
      Tcl_Free((char *)argv);
    }
    return NULL;
  } else {
    if (argv !=NULL) {
      Tcl_Free((char *)argv);
    }
    return list;
  }
}


/*
 **********************************************************************
 * CodeGen_Check Routines
 *
 * This function checks the input, output and hopefully
 * the parameter list. Input and utput variables, must
 * be of type solver_var. At the moment we are only requring
 * that parameters be of type solver_par/REAL_ATOM_INST.
 **********************************************************************
 */
static struct gl_list_t *CodeGen_CheckList(struct gl_list_t *list)
{
  struct Instance *inst;
  unsigned long len,c;

  if (!list) {
    return NULL;
  }
  len = gl_length(list);
  for (c=1;c<=len;c++) {
    inst = (struct Instance *)gl_fetch(list,c);
    if (!solver_var(inst)) {
      return NULL;
    }
  }
  return list;
}

int CodeGen_CheckData(void)
{
  int bad_instances = 0;
  struct gl_list_t *result, *list;

  list = g_cgdata.input_list;
  if (list) {
    result = CodeGen_CheckList(list);
    if (result != list) {
      FPRINTF(stderr,"Input Variables must be \"solver_vars\"\n");
      gl_destroy(list);
      g_cgdata.input_list = NULL;
      bad_instances = 1;
    }
  }

  list = g_cgdata.output_list;
  if (list) {
    result = CodeGen_CheckList(list);
    if (result != list) {
      FPRINTF(stderr,"Output Variables must be \"solver_vars\"\n");
      gl_destroy(list);
      g_cgdata.output_list = NULL;
      bad_instances = 1;
    }
  }
  return bad_instances;
}


int CodeGen_CheckSystem(Tcl_Interp *interp,slv_system_t sys)
{
  struct rel_relation **rp, *rel_tmp;
  struct var_variable **vp, *var_tmp;
  if (sys==NULL) {
    Tcl_SetResult(interp, "__codegen_c called without slv_system", TCL_STATIC);
    return 1;
  }
  var_tmp = vp = slv_get_master_var_list(sys);
  if (vp==NULL) {
    Tcl_SetResult(interp, "__codegen_c called without varlist", TCL_STATIC);
    return 1;
  }
  rel_tmp = rp =slv_get_master_rel_list(sys);
  if (rp==NULL) {
    Tcl_SetResult(interp, "__codegen_c called with NULL rellist", TCL_STATIC);
  }
  if (rp==NULL) {/* THIS SHOULD BE THE OBJECTIVE !!! */
    Tcl_SetResult(interp, "__codegen_c called without constraints or obj",
                  TCL_STATIC);
    return 1;
  }
  return 0;
}


int Asc_CodeGenParseDataCmd(ClientData cdata, Tcl_Interp *interp,
                         int argc, CONST84 char *argv[])
{
  char *strlist;
  struct gl_list_t *list;
  int count = -1;
  unsigned long len;
  char buffer[256];

  if ( argc != 2 ) {
    Tcl_SetResult(interp, "wrong # args : Usage __codegen_parsedata list",
                  TCL_STATIC);
    return TCL_ERROR;
  }
  strlist = argv[1];
  list = CodeGen_ParseData(interp,strlist,&count);
  if (count>=0) {
    if (count==0) {
      /* case of an empty list: the list should be NULL -- dont free */
      Tcl_SetResult(interp, "0", TCL_STATIC);
      return TCL_OK;
    }
    if (list==NULL) {
      Tcl_SetResult(interp, "error in finding instances", TCL_STATIC);
      return TCL_ERROR;
    } else {
      sprintf(buffer,"%lu",gl_length(list));
      Tcl_SetResult(interp, buffer, TCL_VOLATILE);
      gl_destroy(list);
      return TCL_OK;
    }
  } else {
    Tcl_SetResult(interp, "error in parsing data", TCL_STATIC);
    return TCL_ERROR;
  }
}


int Asc_CodeGenCCmd(ClientData cdata, Tcl_Interp *interp,
                  int argc, CONST84 char *argv[])
{
  FILE *fp;
  char *filename = NULL;
  int do_gradients = 0;
  int result;
  int count = -1;
  slv_system_t sys = g_solvsys_cur; /* this might me made more general */
  struct CGFormat format;
  struct gl_list_t *inputs, *outputs, *parameters;

  if ( argc != 7 ) {
    Tcl_AppendResult(interp,"wrong # args : ",
                     "Usage __codegen_c filename ?grad?nograd?\n",
                     "?minos?blackbox?glassbox?, "
                     "inputlist outputlist parameterlist",
                     (char *)NULL);
    return TCL_ERROR;
  }
  result = CodeGen_CheckSystem(interp,sys);
  if (result) {
    return TCL_ERROR;
  }

  filename = (char *)ascmalloc((strlen(argv[1])+4)*sizeof(char));
  sprintf(filename,"%s.c",argv[1]);
  fp = fopen(filename,"w");
  if (!fp) {
    Tcl_SetResult(interp, "__codegen_c file open failed. system not written.",
                  TCL_STATIC);
    result = TCL_ERROR;
    goto error;
  }

  /*
   * Check gradient args.
   */
  if (strncmp(argv[2],"gradients",4)==0) {
    do_gradients = 1;
  }
  format = C_Format;

  /*
   * Check the subformat args.
   */
  if (strncmp(argv[3],"minos",4)==0) {
    format.names = CG_minos;
  } else if (strncmp(argv[3],"blackbox",4)==0) {
    format.names = CG_blackbox;
  } else {
    format.names = CG_glassbox;
  }

  /*
   * Write out necessary header information and global data,
   * which is common to all code generation formats.
   */
  CodeGen_WriteIncludes(fp,argv[1]);
  CodeGen_WriteGlobals(fp);
  CodeGen_WriteSupportFuncs_Log(fp);
  CodeGen_WriteSupportFuncs_Cube(fp);
  CodeGen_WriteSupportFuncs_Sqr(fp);

  /*
   * First parse the inputs, outputs and parameters strings
   * and set up their gl_lists. We dont need to check if
   * the lists are NULL; someone else will handle that.
   */
  inputs = CodeGen_ParseData(interp,argv[4],&count);
  outputs = CodeGen_ParseData(interp,argv[5],&count);
  parameters = CodeGen_ParseData(interp,argv[6],&count); /**** FIX ***/

  /*
   * Call the appropriate routines to generate the code.
   */
  switch (format.names) {
  case CG_blackbox: case CG_minos:
    result = CodeGen_BlackBox(sys,fp,argv[1],&format,
                              do_gradients,
                              inputs,outputs,parameters);
    break;
  case CG_glassbox:
    result = CodeGen_GlassBox(sys,fp,argv[1],&format,
                              do_gradients,
                              inputs,outputs,parameters);
    break;
  }

  /*
   * Cleanup.
   */
 error:
  if (filename) {
    ascfree(filename);
  }
  if (fp) {
    fclose(fp);
  }
  return (result!=0) ? TCL_ERROR : TCL_OK;
}

#endif

