generic/interface/SimsProc.c

/*
 *  SimsProc.c
 *  by Kirk Abbott and Ben Allan
 *  Created: 1/94
 *  Version: $Revision: 1.31 $
 *  Version control file: $RCSfile: SimsProc.c,v $
 *  Date last modified: $Date: 2003/08/23 18:43:08 $
 *  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.
 */


#include <ctype.h>
#include <tcl.h>
#include <utilities/ascConfig.h>
#include <utilities/ascMalloc.h>
#include <general/tm_time.h>
#include <general/list.h>
#include <general/dstring.h>
#include <compiler/compiler.h>
#include <compiler/instance_enum.h>
#include <compiler/cmpfunc.h>
#include <compiler/fractions.h>
#include <compiler/dimen.h>
#include <compiler/types.h>
#include <compiler/stattypes.h>
#include <compiler/statement.h>
#include <compiler/slist.h>
#include <compiler/syntax.h>
#include <compiler/prototype.h>
#include <compiler/symtab.h>
#include <compiler/instance_io.h>
#include <compiler/instance_name.h>
#include <compiler/parentchild.h>
#include <compiler/instquery.h>
#include <compiler/extinst.h>
#include <compiler/child.h>
#include <compiler/type_desc.h>
#include <compiler/copyinst.h>
#include <compiler/destroyinst.h>
#include <compiler/module.h>
#include <compiler/library.h>
#include <compiler/name.h>
#include <compiler/pending.h>
#include <compiler/check.h>
#include <compiler/stattypes.h>
#include <compiler/relation_type.h>
#include <compiler/bintoken.h>
#include <compiler/instantiate.h>
#include <compiler/value_type.h>
#include <compiler/statio.h>
#include <compiler/bit.h>
#include <compiler/simlist.h>
#include <compiler/qlfdid.h>
#include <solver/slv_types.h>
#include "HelpProc.h"
#include "Qlfdid.h"
#include "Driver.h"
#include "BrowserProc.h"
#include "HelpProc.h"
#include "SimsProc.h"

#ifndef lint
static CONST char SimsProcID[] = "$Id: SimsProc.c,v 1.31 2003/08/23 18:43:08 ballan Exp $";
#endif

int Asc_SimsQueryCmd(ClientData cdata, Tcl_Interp *interp,
                 int argc, CONST84 char *argv[])
{
  struct Instance *sim;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if (( argc == 2 ) && ( (strncmp(argv[1],"getcurrent",4)) == 0 )) {
    sim = Asc_GetCurrentSim();
    if (sim) {
      Tcl_AppendResult(interp,(char *)SCP(GetSimulationName(sim)),
                       (char *)NULL);
      return TCL_OK;
    } else {
      Tcl_SetResult(interp, "1", TCL_STATIC);
      return TCL_OK;
    }
  }

  if (( argc == 3 ) && ( (strncmp(argv[1],"setcurrent",4)) == 0 )) {
    sim = Asc_FindSimulationTop(AddSymbol(argv[2]));
    if (sim) {
      Asc_SetCurrentSim(sim);
      Tcl_SetResult(interp, "0", TCL_STATIC);
      return TCL_OK;
    } else {
      Tcl_SetResult(interp, "1", TCL_STATIC);
      return TCL_OK;
    }
  }

  Tcl_AppendResult(interp,"Invalid args: Usage ", argv[0],
                   " <setcurrent,getcurrent>", (char *)NULL);
  return TCL_ERROR;
}

int Asc_SimsUniqueNameCmd(ClientData cdata, Tcl_Interp *interp,
                      int argc, CONST84 char *argv[])
{
  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 2 ) {
     Tcl_SetResult(interp, "call is: unique \"name\"", TCL_STATIC);
     return TCL_ERROR;
  }
  if (Asc_SimsUniqueName(AddSymbol(argv[1]))) {
     Tcl_SetResult(interp, "1", TCL_STATIC);
  } else {
     Tcl_SetResult(interp, "0", TCL_STATIC);
  }
  return TCL_OK;
}

int Asc_SimsCreateInstanceCmd(ClientData cdata, Tcl_Interp *interp,
                              int argc, CONST84 char *argv[])
{
  struct TypeDescription *type;
  struct Instance *new;
  symchar *name, *defmethod;
  int len, format, k;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if (( argc < 3 ) || ( argc > 6 )) {
    Tcl_AppendResult(interp,"wrong # args:",
                     "Usage sim_create <instance_name> <instance_type>",
                     "[-m defaultMethod] [-p,-r]",(char *)NULL);
    return TCL_ERROR;
  }

  name = AddSymbol(argv[1]);
  len = SCLEN(name);
  if ((len<1) || (len > 70)) {
    Tcl_SetResult(interp, "Simulation name too long (> 70)", TCL_STATIC);
    return TCL_ERROR;
  }
  if (isdigit(SCP(name)[0])) {
    Tcl_SetResult(interp, "Instance names cannot begin with a digit",
                  TCL_STATIC);
    return TCL_ERROR;
  }

  type = FindType(AddSymbol(argv[2]));
  if (type==NULL) {
    Tcl_AppendResult(interp,"CreateInstance called with unknown type",
                     (char *)NULL);
    return TCL_ERROR;
  }

  /*
   * Check for additional compilation flags.
   */
  format = 0;           /* do standard compilation */
  k = 3;
  defmethod = AddSymbol("default_self"); /* when no input with -m */
  while (k < argc) {
    if (strcmp(argv[k],"-r")==0) {
      format = 1;           /* do no relations */
      k++;
      continue;
    }
    if (strcmp(argv[k],"-p")==0) {
      format = 2;           /* do patch compilation */
      k++;
      continue;
    }
    if (strcmp(argv[k],"-m")==0) {
      if ( (k+1)== argc) {
        k++;
        defmethod = NULL; /* -m <noargs> --> no defaults */
      } else {
        defmethod = AddSymbol(argv[k+1]);
        k += 2;
      }
      continue;
    }
    Tcl_AppendResult(interp,"Unknown compilation flag",(char *)NULL);
    return TCL_ERROR;
  }

  if (Asc_SimsUniqueName(name)) {
    Tcl_GlobalEval(interp,"Sims_SetupBinTokenCC");
    new = SimsCreateInstance(GetName(type),name,format,defmethod);
    if (new != NULL) {
      gl_insert_sorted(g_simulation_list,new,(CmpFunc)Asc_SimsCmpSim);
      Tcl_SetResult(interp, "0", TCL_STATIC);
      return TCL_OK;
    } else { /* Instantiate returned null */
      Tcl_AppendResult(interp,"Simulation of type ",argv[2]," with name ",
                       (char *)SCP(name),
                       " cannot be instantiated.", (char *)NULL);
      return TCL_ERROR;
    }
  } else {              /* sim already exists */
    Tcl_AppendResult(interp,"A simulation of the name ",(char *)SCP(name),
                     " already exists", (char *)NULL);
    return TCL_ERROR;
  }
#ifndef NDEBUG
  return TCL_OK; /* NOT reached */
#endif
}

/*
 *********************************************************************
 * Resume Instantiation functions
 *
 * An experimental UpdateInstanceCmd is included here.
 *
 * Query ? Is it possible for Reinstantiate to move the root instance ?
 * Not sure. At the moment it does not return an instance pointer.
 *********************************************************************
 */

int Asc_SimsResumeInstantiateCmd(ClientData cdata, Tcl_Interp *interp,
                             int argc, CONST84 char *argv[])
{
  double start_time =0;
  struct Instance *xisting;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 2 ) {
    Tcl_SetResult(interp, "call is: sresume <instancename> ", TCL_STATIC);
    return TCL_ERROR;
  }
  xisting = Asc_FindSimulationRoot(AddSymbol(argv[1]));
  if (xisting) {
    if (g_compiler_timing) {
      start_time = tm_cpu_time();
    }
    ReInstantiate(xisting);
    if (g_compiler_timing) {
      FPRINTF(stdout,"Reinstantiation CPU time = %g seconds\n",
              tm_cpu_time() - start_time);
    }
    Tcl_SetResult(interp, "0", TCL_STATIC);
    return TCL_OK;
  } else {
    Tcl_AppendResult(interp,"Instance ", argv[1], "not found",(char *)NULL);
    return TCL_ERROR;
  }
}

int Asc_SimsUpdateInstanceCmd(ClientData cdata, Tcl_Interp *interp,
                          int argc, CONST84 char *argv[])
{
  struct Instance *target;
  struct TypeDescription *desc, *patchdef;
  CONST struct StatementList *slist;
  double start_time;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 3 ) {
    Tcl_SetResult(interp, "call is: __sims_update qlfdid type", TCL_STATIC);
    return TCL_ERROR;
  }
  /*
   * Find the target instance, and leave g_search_inst
   * looking at it.
   */
  if (Asc_QlfdidSearch3(argv[1],0)) {
    Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
    return TCL_ERROR;
  }
  target = g_search_inst;

  patchdef = FindType(AddSymbol(argv[2]));
  if (!patchdef) {
    Tcl_SetResult(interp, "Cannot find patch type", TCL_STATIC);
    return TCL_ERROR;
  }
  desc = InstanceTypeDesc(target);
  if (GetPatchOriginal(patchdef)!=desc) {
    Tcl_SetResult(interp, "Inconsistent types in patch", TCL_STATIC);
    return TCL_ERROR;
  }

  start_time = tm_cpu_time();       /* do the update */
  slist = GetStatementList(patchdef);
  UpdateInstance(g_root,target,slist);
  if (g_compiler_timing) {
    PRINTF("Reinstantiation CPU time = %g seconds\n",
             tm_cpu_time() - start_time);
  }

  return TCL_OK;
}


int Asc_SimsCopyInstanceCmd(ClientData cdata, Tcl_Interp *interp,
                        int argc, CONST84 char *argv[])
{
  struct Instance *target;
  double start_time;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 2 ) {
    Tcl_SetResult(interp, "call is: __sims_copy qlfdid", TCL_STATIC);
    return TCL_ERROR;
  }

  /*
   * Find the target instance, and leave g_search_inst
   * looking at it.
   */
  if (Asc_QlfdidSearch3(argv[1],0)) {
    Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
    return TCL_ERROR;
  }

  start_time = tm_cpu_time();
  target = g_search_inst;
  target = CopyInstance(target);
  start_time = tm_cpu_time() - start_time;
  FPRINTF(stderr,"Time to copy instance = %g\n",start_time);
  DestroyInstance(target,NULL);

  return TCL_OK;
}


int Asc_SimsProtoTypeInstanceCmd(ClientData cdata, Tcl_Interp *interp,
                             int argc, CONST84 char *argv[])
{
  struct Instance *target, *result;
  CONST struct TypeDescription *desc;
  double start_time;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 2 ) {
    Tcl_SetResult(interp, "call is: __sims_proto qlfdid", TCL_STATIC);
    return TCL_ERROR;
  }

  if (Asc_QlfdidSearch3(argv[1],0)) {
    Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
    return TCL_ERROR;
  }

  start_time = tm_cpu_time();
  target = g_search_inst;
  switch (InstanceKind(target)) {
  case ARRAY_ENUM_INST:
  case ARRAY_INT_INST:
  case SIM_INST:
    Tcl_SetResult(interp, "Cannot prototype this type of instance",TCL_STATIC);
    return TCL_ERROR;
  default:
    break;
  }

  desc = InstanceTypeDesc(target);
  if (LookupPrototype(GetName(desc))) {
    Tcl_SetResult(interp, "a prototype already exists", TCL_STATIC);
    return TCL_OK;
  }
  result = CopyInstance(target);
  start_time = tm_cpu_time() - start_time;
  if (result) {
    AddPrototype(result);
    FPRINTF(stderr,"Time to prototype instance = %g\n",start_time);
    return TCL_OK;
  } else {
    Tcl_SetResult(interp, "Error in prototyping instance", TCL_STATIC);
    return TCL_ERROR;
  }
}


int Asc_SimsSaveInstanceCmd(ClientData cdata, Tcl_Interp *interp,
                        int argc, CONST84 char *argv[])
{
  FILE *fp = NULL;
  struct Instance *target;
  double start_time;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 3 ) {
    Tcl_SetResult(interp, "call is: __sims_saveinst qlfdid file", TCL_STATIC);
    return TCL_ERROR;
  }

  /*
   * Find the target instance, and leave g_search_inst
   * looking at it.
   */
  if (Asc_QlfdidSearch3(argv[1],0)) {
    Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
    return TCL_ERROR;
  }
  /*
   * Set up the file pointer.
   */
  fp = fopen(argv[2],"w");
  if (!fp) {
    Tcl_SetResult(interp, "error in opening file", TCL_STATIC);
    return TCL_ERROR;
  }

  start_time = tm_cpu_time();
  target = g_search_inst;
  SaveInstance(fp,target,0);
  start_time = tm_cpu_time() - start_time;
  FPRINTF(stderr,"Time to save instance = %g\n",start_time);

  if (fp) {
    fclose(fp);
  }
  return TCL_OK;
}


/*
 *********************************************************************
 * Destroy Simulation functions
 *
 * The DestroyInstance code correctly deals with *all*
 * instances. As such SIM_INST are correctly handled as well
 * DO NOT refer to it after this. Parts of the sim instance that
 * are shared by other instances, (as in the case of universals)
 * are properly handled, and will not be deallocated unless this
 * simulation is the only parent.
 *********************************************************************
 */

int Asc_SimsDestroySimulationCmd(ClientData cdata, Tcl_Interp *interp,
                               int argc, CONST84 char *argv[])
{
  struct Instance *xisting, *current;
  unsigned long ndx;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 2 ) {
    Tcl_SetResult(interp, "wrong # args: Usage: sim_destroy <simname>",
                  TCL_STATIC);
    return TCL_ERROR;
  }
  xisting = Asc_FindSimulationTop(AddSymbol(argv[1]));
  if (xisting) {
    /* the next line grabs the index in the list */
    ndx = gl_search(g_simulation_list,xisting,(CmpFunc)Asc_SimsCmpSim);
    current = Asc_GetCurrentSim();
    if (current) {
      if (Asc_SimsCmpSim(xisting,current)==0) {
        Asc_SetCurrentSim(NULL);
        Asc_DeAllocSim(xisting);
        gl_delete(g_simulation_list,ndx,0);
        Tcl_AppendResult(interp,"Simulation ",argv[1], " deleted",
                         (char *)NULL);
        return TCL_OK;
      }
    }
    Asc_DeAllocSim(xisting);        /* prepares for cleanup */
    gl_delete(g_simulation_list,ndx,0);
    Tcl_AppendResult(interp,"Simulation ",argv[1], " deleted", (char *)NULL);
    return TCL_OK;
  } else {
    Tcl_AppendResult(interp,"Simulation ",argv[1]," not found",(char *)NULL);
    return TCL_ERROR;
  }
}

int Asc_BrowShowPendings(ClientData cdata, Tcl_Interp *interp,
                    int argc, CONST84 char *argv[])
{
  struct Instance *i = NULL;
  char buf[MAXIMUM_NUMERIC_LENGTH];       /* string to hold long */
  unsigned long p=0L;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 3 ) {
    Tcl_AppendResult(interp,"wrong # args: Usage: ",
                     "\"bnumpendings\" ?sim?inst ?simname?current?search?",
                     (char *)NULL);
    return TCL_ERROR;
  }
  if ( (strncmp(argv[1],"simulation",3)) == 0 ) {
    i = Asc_FindSimulationRoot(AddSymbol(argv[2]));
  } else if ( (strncmp(argv[1],"instance",3)) == 0 ) {
    if ( (strncmp(argv[2],"current",3)) == 0 ) {
      i = g_curinst;
    } else {
      i = g_search_inst;
    }
  }
  if (!i) {
    Tcl_SetResult(interp, "10000", TCL_STATIC); /* Just some big number */
    return TCL_OK;
  }
  p = NumberPendingInstances(i);
  if (p>0L) {
    sprintf(buf,"%lu",p);
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
  }
  return TCL_OK;
}

static
void BrowWritePendingStatements(FILE *f, CONST struct Instance *i)
{
  CONST struct BitList *blist;
  CONST struct TypeDescription *desc;
  CONST struct StatementList *slist;
  CONST struct Statement *stat;
  CONST struct gl_list_t *list;
  unsigned long c,len;
  blist = InstanceBitList(i);
  if ((blist!=NULL)&&(!BitListEmpty(blist))) {
    FPRINTF(stderr,"PENDING STATEMENTS\n");
    desc = InstanceTypeDesc(i);
    slist = GetStatementList(desc);
    list = GetList(slist);
    len = gl_length(list);
    for(c=1;c<=len;c++) {
      if (ReadBit(blist,c-1)) {
        stat = (struct Statement *)gl_fetch(list,c);
        WriteStatement(f,stat,4);
        if (StatementType(stat)== SELECT) {
          c = c + SelectStatNumberStats(stat);
        }
      }
    }
  }
}

int Asc_BrowWritePendingsSTDOUT(ClientData cdata, Tcl_Interp *interp,
                            int argc, CONST84 char *argv[])
{
  struct Instance *i;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if ( argc != 2 ) {
    Tcl_SetResult(interp, "wrong # args : Usage \"bwritependings\" simname",
                  TCL_STATIC);
    return TCL_ERROR;
  }
  i = Asc_FindSimulationRoot(AddSymbol(argv[1]));
  if (!i) {
    Tcl_SetResult(interp, "given simulation nonexistent !", TCL_STATIC);
    return TCL_ERROR;
  }
  BrowWritePendingStatements(stdout,i);
  return TCL_OK;
}

int Asc_SimListPending(ClientData cdata, Tcl_Interp *interp,
                   int argc, CONST84 char *argv[])
{
  struct Instance *i;
  FILE *fp = stdout;

  (void)cdata;    /* stop gcc whine about unused parameter */

  if (( argc != 2 ) && ( argc != 3 )) {
    Tcl_SetResult(interp,
                  "simlistpending: simlistpending simname [optional filename]",
                  TCL_STATIC);
    return TCL_ERROR;
  }
  i = Asc_FindSimulationRoot(AddSymbol(argv[1]));
  if (!i) {
    Tcl_SetResult(interp, "simlistpending: given simulation not found!",
                  TCL_STATIC);
    return TCL_ERROR;
  }
  if ( argc == 3 ) {
    fp = fopen(argv[2],"w+");
    if (fp==NULL) {
      Tcl_SetResult(interp, "simlistpending: given bad filename", TCL_STATIC);
      return TCL_ERROR;
    }
  }
  FPRINTF(fp,"\n-------------------------------------\n");
  FPRINTF(fp," Pendings statements for simulation %s\n\n",argv[1]);
  CheckInstance(fp,i);
  FPRINTF(fp,"\n-------------------------------------\n");
  if ( argc == 3 ) {
    fclose(fp);
  }
  return TCL_OK;
}


STDHLF(Asc_SimBinTokenSetOptions, (Asc_SimBinTokenSetOptionsHL,Asc_SimBinTokenSetOptionsHL2,HLFSTOP));
int Asc_SimBinTokenSetOptions(ClientData cdata, Tcl_Interp *interp,
                              int argc, CONST84 char **argv)
{
  char *srcname, *objname, *libname, *buildcommand, *unlinkcommand;
  long maxrels;
  int verbose, housekeep;
  int s1,s2,s3;

  ASCUSE;  /* see if first arg is -help */
  if (argc != 9 ) {
    Asc_HelpGetUsage(interp,Asc_SimBinTokenSetOptionsHN);
    return TCL_ERROR;
  };
  srcname = ascstrdup(argv[1]);
  objname = ascstrdup(argv[2]);
  libname = ascstrdup(argv[3]);
  buildcommand = ascstrdup(argv[4]);
  unlinkcommand = ascstrdup(argv[5]);
  s1 = Tcl_ExprLong(interp,argv[6],&maxrels);
  Tcl_ResetResult(interp);
  s2 = Tcl_GetInt(interp,argv[7],&verbose);
  Tcl_ResetResult(interp);
  s3 = Tcl_GetInt(interp,argv[8],&housekeep);
  Tcl_ResetResult(interp);
  if (srcname == NULL || objname == NULL || libname == NULL ||
      buildcommand == NULL || unlinkcommand == NULL ||
      s1 != TCL_OK || s2 != TCL_OK || s3 != TCL_OK) {
    Tcl_AppendResult(interp,argv[0],": Error converting input",(char *)NULL);
    return TCL_ERROR;
  }
  BinTokenSetOptions(srcname,objname,libname,buildcommand,unlinkcommand,
                     (unsigned long)maxrels,verbose,housekeep);
  return TCL_OK;
}
1	/*
2	* SimsProc.c
3	* by Kirk Abbott and Ben Allan
4	* Created: 1/94
5	* Version: $Revision: 1.31 $
6	* Version control file: $RCSfile: SimsProc.c,v $
7	* Date last modified: $Date: 2003/08/23 18:43:08 $
8	* Last modified by: $Author: ballan $
9	*
10	* This file is part of the ASCEND Tcl/Tk interface
11	*
12	* Copyright 1997, Carnegie Mellon University
13	*
14	* The ASCEND Tcl/Tk interface is free software; you can redistribute
15	* it and/or modify it under the terms of the GNU General Public License as
16	* published by the Free Software Foundation; either version 2 of the
17	* License, or (at your option) any later version.
18	*
19	* The ASCEND Tcl/Tk interface is distributed in hope that it will be
20	* useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22	* General Public License for more details.
23	*
24	* You should have received a copy of the GNU General Public License
25	* along with the program; if not, write to the Free Software Foundation,
26	* Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27	* COPYING. COPYING is found in ../compiler.
28	*/
29
30
31	#include <ctype.h>
32	#include <tcl.h>
33	#include <utilities/ascConfig.h>
34	#include <utilities/ascMalloc.h>
35	#include <general/tm_time.h>
36	#include <general/list.h>
37	#include <general/dstring.h>
38	#include <compiler/compiler.h>
39	#include <compiler/instance_enum.h>
40	#include <compiler/cmpfunc.h>
41	#include <compiler/fractions.h>
42	#include <compiler/dimen.h>
43	#include <compiler/types.h>
44	#include <compiler/stattypes.h>
45	#include <compiler/statement.h>
46	#include <compiler/slist.h>
47	#include <compiler/syntax.h>
48	#include <compiler/prototype.h>
49	#include <compiler/symtab.h>
50	#include <compiler/instance_io.h>
51	#include <compiler/instance_name.h>
52	#include <compiler/parentchild.h>
53	#include <compiler/instquery.h>
54	#include <compiler/extinst.h>
55	#include <compiler/child.h>
56	#include <compiler/type_desc.h>
57	#include <compiler/copyinst.h>
58	#include <compiler/destroyinst.h>
59	#include <compiler/module.h>
60	#include <compiler/library.h>
61	#include <compiler/name.h>
62	#include <compiler/pending.h>
63	#include <compiler/check.h>
64	#include <compiler/stattypes.h>
65	#include <compiler/relation_type.h>
66	#include <compiler/bintoken.h>
67	#include <compiler/instantiate.h>
68	#include <compiler/value_type.h>
69	#include <compiler/statio.h>
70	#include <compiler/bit.h>
71	#include <compiler/simlist.h>
72	#include <compiler/qlfdid.h>
73	#include <solver/slv_types.h>
74	#include "HelpProc.h"
75	#include "Qlfdid.h"
76	#include "Driver.h"
77	#include "BrowserProc.h"
78	#include "HelpProc.h"
79	#include "SimsProc.h"
80
81	#ifndef lint
82	static CONST char SimsProcID[] = "$Id: SimsProc.c,v 1.31 2003/08/23 18:43:08 ballan Exp $";
83	#endif
84
85	int Asc_SimsQueryCmd(ClientData cdata, Tcl_Interp *interp,
86	int argc, CONST84 char *argv[])
87	{
88	struct Instance *sim;
89
90	(void)cdata; /* stop gcc whine about unused parameter */
91
92	if (( argc == 2 ) && ( (strncmp(argv[1],"getcurrent",4)) == 0 )) {
93	sim = Asc_GetCurrentSim();
94	if (sim) {
95	Tcl_AppendResult(interp,(char *)SCP(GetSimulationName(sim)),
96	(char *)NULL);
97	return TCL_OK;
98	} else {
99	Tcl_SetResult(interp, "1", TCL_STATIC);
100	return TCL_OK;
101	}
102	}
103
104	if (( argc == 3 ) && ( (strncmp(argv[1],"setcurrent",4)) == 0 )) {
105	sim = Asc_FindSimulationTop(AddSymbol(argv[2]));
106	if (sim) {
107	Asc_SetCurrentSim(sim);
108	Tcl_SetResult(interp, "0", TCL_STATIC);
109	return TCL_OK;
110	} else {
111	Tcl_SetResult(interp, "1", TCL_STATIC);
112	return TCL_OK;
113	}
114	}
115
116	Tcl_AppendResult(interp,"Invalid args: Usage ", argv[0],
117	" <setcurrent,getcurrent>", (char *)NULL);
118	return TCL_ERROR;
119	}
120
121	int Asc_SimsUniqueNameCmd(ClientData cdata, Tcl_Interp *interp,
122	int argc, CONST84 char *argv[])
123	{
124	(void)cdata; /* stop gcc whine about unused parameter */
125
126	if ( argc != 2 ) {
127	Tcl_SetResult(interp, "call is: unique \"name\"", TCL_STATIC);
128	return TCL_ERROR;
129	}
130	if (Asc_SimsUniqueName(AddSymbol(argv[1]))) {
131	Tcl_SetResult(interp, "1", TCL_STATIC);
132	} else {
133	Tcl_SetResult(interp, "0", TCL_STATIC);
134	}
135	return TCL_OK;
136	}
137
138	int Asc_SimsCreateInstanceCmd(ClientData cdata, Tcl_Interp *interp,
139	int argc, CONST84 char *argv[])
140	{
141	struct TypeDescription *type;
142	struct Instance *new;
143	symchar name, defmethod;
144	int len, format, k;
145
146	(void)cdata; /* stop gcc whine about unused parameter */
147
148	if (( argc < 3 ) \|\| ( argc > 6 )) {
149	Tcl_AppendResult(interp,"wrong # args:",
150	"Usage sim_create <instance_name> <instance_type>",
151	"[-m defaultMethod] [-p,-r]",(char *)NULL);
152	return TCL_ERROR;
153	}
154
155	name = AddSymbol(argv[1]);
156	len = SCLEN(name);
157	if ((len<1) \|\| (len > 70)) {
158	Tcl_SetResult(interp, "Simulation name too long (> 70)", TCL_STATIC);
159	return TCL_ERROR;
160	}
161	if (isdigit(SCP(name)[0])) {
162	Tcl_SetResult(interp, "Instance names cannot begin with a digit",
163	TCL_STATIC);
164	return TCL_ERROR;
165	}
166
167	type = FindType(AddSymbol(argv[2]));
168	if (type==NULL) {
169	Tcl_AppendResult(interp,"CreateInstance called with unknown type",
170	(char *)NULL);
171	return TCL_ERROR;
172	}
173
174	/*
175	* Check for additional compilation flags.
176	*/
177	format = 0; /* do standard compilation */
178	k = 3;
179	defmethod = AddSymbol("default_self"); /* when no input with -m */
180	while (k < argc) {
181	if (strcmp(argv[k],"-r")==0) {
182	format = 1; /* do no relations */
183	k++;
184	continue;
185	}
186	if (strcmp(argv[k],"-p")==0) {
187	format = 2; /* do patch compilation */
188	k++;
189	continue;
190	}
191	if (strcmp(argv[k],"-m")==0) {
192	if ( (k+1)== argc) {
193	k++;
194	defmethod = NULL; /* -m <noargs> --> no defaults */
195	} else {
196	defmethod = AddSymbol(argv[k+1]);
197	k += 2;
198	}
199	continue;
200	}
201	Tcl_AppendResult(interp,"Unknown compilation flag",(char *)NULL);
202	return TCL_ERROR;
203	}
204
205	if (Asc_SimsUniqueName(name)) {
206	Tcl_GlobalEval(interp,"Sims_SetupBinTokenCC");
207	new = SimsCreateInstance(GetName(type),name,format,defmethod);
208	if (new != NULL) {
209	gl_insert_sorted(g_simulation_list,new,(CmpFunc)Asc_SimsCmpSim);
210	Tcl_SetResult(interp, "0", TCL_STATIC);
211	return TCL_OK;
212	} else { /* Instantiate returned null */
213	Tcl_AppendResult(interp,"Simulation of type ",argv[2]," with name ",
214	(char *)SCP(name),
215	" cannot be instantiated.", (char *)NULL);
216	return TCL_ERROR;
217	}
218	} else { /* sim already exists */
219	Tcl_AppendResult(interp,"A simulation of the name ",(char *)SCP(name),
220	" already exists", (char *)NULL);
221	return TCL_ERROR;
222	}
223	#ifndef NDEBUG
224	return TCL_OK; /* NOT reached */
225	#endif
226	}
227
228	/*
229	*********************************************************************
230	* Resume Instantiation functions
231	*
232	* An experimental UpdateInstanceCmd is included here.
233	*
234	* Query ? Is it possible for Reinstantiate to move the root instance ?
235	* Not sure. At the moment it does not return an instance pointer.
236	*********************************************************************
237	*/
238
239	int Asc_SimsResumeInstantiateCmd(ClientData cdata, Tcl_Interp *interp,
240	int argc, CONST84 char *argv[])
241	{
242	double start_time =0;
243	struct Instance *xisting;
244
245	(void)cdata; /* stop gcc whine about unused parameter */
246
247	if ( argc != 2 ) {
248	Tcl_SetResult(interp, "call is: sresume <instancename> ", TCL_STATIC);
249	return TCL_ERROR;
250	}
251	xisting = Asc_FindSimulationRoot(AddSymbol(argv[1]));
252	if (xisting) {
253	if (g_compiler_timing) {
254	start_time = tm_cpu_time();
255	}
256	ReInstantiate(xisting);
257	if (g_compiler_timing) {
258	FPRINTF(stdout,"Reinstantiation CPU time = %g seconds\n",
259	tm_cpu_time() - start_time);
260	}
261	Tcl_SetResult(interp, "0", TCL_STATIC);
262	return TCL_OK;
263	} else {
264	Tcl_AppendResult(interp,"Instance ", argv[1], "not found",(char *)NULL);
265	return TCL_ERROR;
266	}
267	}
268
269	int Asc_SimsUpdateInstanceCmd(ClientData cdata, Tcl_Interp *interp,
270	int argc, CONST84 char *argv[])
271	{
272	struct Instance *target;
273	struct TypeDescription desc, patchdef;
274	CONST struct StatementList *slist;
275	double start_time;
276
277	(void)cdata; /* stop gcc whine about unused parameter */
278
279	if ( argc != 3 ) {
280	Tcl_SetResult(interp, "call is: __sims_update qlfdid type", TCL_STATIC);
281	return TCL_ERROR;
282	}
283	/*
284	* Find the target instance, and leave g_search_inst
285	* looking at it.
286	*/
287	if (Asc_QlfdidSearch3(argv[1],0)) {
288	Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
289	return TCL_ERROR;
290	}
291	target = g_search_inst;
292
293	patchdef = FindType(AddSymbol(argv[2]));
294	if (!patchdef) {
295	Tcl_SetResult(interp, "Cannot find patch type", TCL_STATIC);
296	return TCL_ERROR;
297	}
298	desc = InstanceTypeDesc(target);
299	if (GetPatchOriginal(patchdef)!=desc) {
300	Tcl_SetResult(interp, "Inconsistent types in patch", TCL_STATIC);
301	return TCL_ERROR;
302	}
303
304	start_time = tm_cpu_time(); /* do the update */
305	slist = GetStatementList(patchdef);
306	UpdateInstance(g_root,target,slist);
307	if (g_compiler_timing) {
308	PRINTF("Reinstantiation CPU time = %g seconds\n",
309	tm_cpu_time() - start_time);
310	}
311
312	return TCL_OK;
313	}
314
315
316	int Asc_SimsCopyInstanceCmd(ClientData cdata, Tcl_Interp *interp,
317	int argc, CONST84 char *argv[])
318	{
319	struct Instance *target;
320	double start_time;
321
322	(void)cdata; /* stop gcc whine about unused parameter */
323
324	if ( argc != 2 ) {
325	Tcl_SetResult(interp, "call is: __sims_copy qlfdid", TCL_STATIC);
326	return TCL_ERROR;
327	}
328
329	/*
330	* Find the target instance, and leave g_search_inst
331	* looking at it.
332	*/
333	if (Asc_QlfdidSearch3(argv[1],0)) {
334	Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
335	return TCL_ERROR;
336	}
337
338	start_time = tm_cpu_time();
339	target = g_search_inst;
340	target = CopyInstance(target);
341	start_time = tm_cpu_time() - start_time;
342	FPRINTF(stderr,"Time to copy instance = %g\n",start_time);
343	DestroyInstance(target,NULL);
344
345	return TCL_OK;
346	}
347
348
349	int Asc_SimsProtoTypeInstanceCmd(ClientData cdata, Tcl_Interp *interp,
350	int argc, CONST84 char *argv[])
351	{
352	struct Instance target, result;
353	CONST struct TypeDescription *desc;
354	double start_time;
355
356	(void)cdata; /* stop gcc whine about unused parameter */
357
358	if ( argc != 2 ) {
359	Tcl_SetResult(interp, "call is: __sims_proto qlfdid", TCL_STATIC);
360	return TCL_ERROR;
361	}
362
363	if (Asc_QlfdidSearch3(argv[1],0)) {
364	Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
365	return TCL_ERROR;
366	}
367
368	start_time = tm_cpu_time();
369	target = g_search_inst;
370	switch (InstanceKind(target)) {
371	case ARRAY_ENUM_INST:
372	case ARRAY_INT_INST:
373	case SIM_INST:
374	Tcl_SetResult(interp, "Cannot prototype this type of instance",TCL_STATIC);
375	return TCL_ERROR;
376	default:
377	break;
378	}
379
380	desc = InstanceTypeDesc(target);
381	if (LookupPrototype(GetName(desc))) {
382	Tcl_SetResult(interp, "a prototype already exists", TCL_STATIC);
383	return TCL_OK;
384	}
385	result = CopyInstance(target);
386	start_time = tm_cpu_time() - start_time;
387	if (result) {
388	AddPrototype(result);
389	FPRINTF(stderr,"Time to prototype instance = %g\n",start_time);
390	return TCL_OK;
391	} else {
392	Tcl_SetResult(interp, "Error in prototyping instance", TCL_STATIC);
393	return TCL_ERROR;
394	}
395	}
396
397
398	int Asc_SimsSaveInstanceCmd(ClientData cdata, Tcl_Interp *interp,
399	int argc, CONST84 char *argv[])
400	{
401	FILE *fp = NULL;
402	struct Instance *target;
403	double start_time;
404
405	(void)cdata; /* stop gcc whine about unused parameter */
406
407	if ( argc != 3 ) {
408	Tcl_SetResult(interp, "call is: __sims_saveinst qlfdid file", TCL_STATIC);
409	return TCL_ERROR;
410	}
411
412	/*
413	* Find the target instance, and leave g_search_inst
414	* looking at it.
415	*/
416	if (Asc_QlfdidSearch3(argv[1],0)) {
417	Tcl_SetResult(interp, "target instance not found", TCL_STATIC);
418	return TCL_ERROR;
419	}
420	/*
421	* Set up the file pointer.
422	*/
423	fp = fopen(argv[2],"w");
424	if (!fp) {
425	Tcl_SetResult(interp, "error in opening file", TCL_STATIC);
426	return TCL_ERROR;
427	}
428
429	start_time = tm_cpu_time();
430	target = g_search_inst;
431	SaveInstance(fp,target,0);
432	start_time = tm_cpu_time() - start_time;
433	FPRINTF(stderr,"Time to save instance = %g\n",start_time);
434
435	if (fp) {
436	fclose(fp);
437	}
438	return TCL_OK;
439	}
440
441
442
443	/*
444	*********************************************************************
445	* Destroy Simulation functions
446	*
447	* The DestroyInstance code correctly deals with all
448	* instances. As such SIM_INST are correctly handled as well
449	* DO NOT refer to it after this. Parts of the sim instance that
450	* are shared by other instances, (as in the case of universals)
451	* are properly handled, and will not be deallocated unless this
452	* simulation is the only parent.
453	*********************************************************************
454	*/
455
456	int Asc_SimsDestroySimulationCmd(ClientData cdata, Tcl_Interp *interp,
457	int argc, CONST84 char *argv[])
458	{
459	struct Instance xisting, current;
460	unsigned long ndx;
461
462	(void)cdata; /* stop gcc whine about unused parameter */
463
464	if ( argc != 2 ) {
465	Tcl_SetResult(interp, "wrong # args: Usage: sim_destroy <simname>",
466	TCL_STATIC);
467	return TCL_ERROR;
468	}
469	xisting = Asc_FindSimulationTop(AddSymbol(argv[1]));
470	if (xisting) {
471	/* the next line grabs the index in the list */
472	ndx = gl_search(g_simulation_list,xisting,(CmpFunc)Asc_SimsCmpSim);
473	current = Asc_GetCurrentSim();
474	if (current) {
475	if (Asc_SimsCmpSim(xisting,current)==0) {
476	Asc_SetCurrentSim(NULL);
477	Asc_DeAllocSim(xisting);
478	gl_delete(g_simulation_list,ndx,0);
479	Tcl_AppendResult(interp,"Simulation ",argv[1], " deleted",
480	(char *)NULL);
481	return TCL_OK;
482	}
483	}
484	Asc_DeAllocSim(xisting); /* prepares for cleanup */
485	gl_delete(g_simulation_list,ndx,0);
486	Tcl_AppendResult(interp,"Simulation ",argv[1], " deleted", (char *)NULL);
487	return TCL_OK;
488	} else {
489	Tcl_AppendResult(interp,"Simulation ",argv[1]," not found",(char *)NULL);
490	return TCL_ERROR;
491	}
492	}
493
494	int Asc_BrowShowPendings(ClientData cdata, Tcl_Interp *interp,
495	int argc, CONST84 char *argv[])
496	{
497	struct Instance *i = NULL;
498	char buf[MAXIMUM_NUMERIC_LENGTH]; /* string to hold long */
499	unsigned long p=0L;
500
501	(void)cdata; /* stop gcc whine about unused parameter */
502
503	if ( argc != 3 ) {
504	Tcl_AppendResult(interp,"wrong # args: Usage: ",
505	"\"bnumpendings\" ?sim?inst ?simname?current?search?",
506	(char *)NULL);
507	return TCL_ERROR;
508	}
509	if ( (strncmp(argv[1],"simulation",3)) == 0 ) {
510	i = Asc_FindSimulationRoot(AddSymbol(argv[2]));
511	} else if ( (strncmp(argv[1],"instance",3)) == 0 ) {
512	if ( (strncmp(argv[2],"current",3)) == 0 ) {
513	i = g_curinst;
514	} else {
515	i = g_search_inst;
516	}
517	}
518	if (!i) {
519	Tcl_SetResult(interp, "10000", TCL_STATIC); /* Just some big number */
520	return TCL_OK;
521	}
522	p = NumberPendingInstances(i);
523	if (p>0L) {
524	sprintf(buf,"%lu",p);
525	Tcl_SetResult(interp, buf, TCL_VOLATILE);
526	}
527	return TCL_OK;
528	}
529
530	static
531	void BrowWritePendingStatements(FILE f, CONST struct Instance i)
532	{
533	CONST struct BitList *blist;
534	CONST struct TypeDescription *desc;
535	CONST struct StatementList *slist;
536	CONST struct Statement *stat;
537	CONST struct gl_list_t *list;
538	unsigned long c,len;
539	blist = InstanceBitList(i);
540	if ((blist!=NULL)&&(!BitListEmpty(blist))) {
541	FPRINTF(stderr,"PENDING STATEMENTS\n");
542	desc = InstanceTypeDesc(i);
543	slist = GetStatementList(desc);
544	list = GetList(slist);
545	len = gl_length(list);
546	for(c=1;c<=len;c++) {
547	if (ReadBit(blist,c-1)) {
548	stat = (struct Statement *)gl_fetch(list,c);
549	WriteStatement(f,stat,4);
550	if (StatementType(stat)== SELECT) {
551	c = c + SelectStatNumberStats(stat);
552	}
553	}
554	}
555	}
556	}
557
558	int Asc_BrowWritePendingsSTDOUT(ClientData cdata, Tcl_Interp *interp,
559	int argc, CONST84 char *argv[])
560	{
561	struct Instance *i;
562
563	(void)cdata; /* stop gcc whine about unused parameter */
564
565	if ( argc != 2 ) {
566	Tcl_SetResult(interp, "wrong # args : Usage \"bwritependings\" simname",
567	TCL_STATIC);
568	return TCL_ERROR;
569	}
570	i = Asc_FindSimulationRoot(AddSymbol(argv[1]));
571	if (!i) {
572	Tcl_SetResult(interp, "given simulation nonexistent !", TCL_STATIC);
573	return TCL_ERROR;
574	}
575	BrowWritePendingStatements(stdout,i);
576	return TCL_OK;
577	}
578
579	int Asc_SimListPending(ClientData cdata, Tcl_Interp *interp,
580	int argc, CONST84 char *argv[])
581	{
582	struct Instance *i;
583	FILE *fp = stdout;
584
585	(void)cdata; /* stop gcc whine about unused parameter */
586
587	if (( argc != 2 ) && ( argc != 3 )) {
588	Tcl_SetResult(interp,
589	"simlistpending: simlistpending simname [optional filename]",
590	TCL_STATIC);
591	return TCL_ERROR;
592	}
593	i = Asc_FindSimulationRoot(AddSymbol(argv[1]));
594	if (!i) {
595	Tcl_SetResult(interp, "simlistpending: given simulation not found!",
596	TCL_STATIC);
597	return TCL_ERROR;
598	}
599	if ( argc == 3 ) {
600	fp = fopen(argv[2],"w+");
601	if (fp==NULL) {
602	Tcl_SetResult(interp, "simlistpending: given bad filename", TCL_STATIC);
603	return TCL_ERROR;
604	}
605	}
606	FPRINTF(fp,"\n-------------------------------------\n");
607	FPRINTF(fp," Pendings statements for simulation %s\n\n",argv[1]);
608	CheckInstance(fp,i);
609	FPRINTF(fp,"\n-------------------------------------\n");
610	if ( argc == 3 ) {
611	fclose(fp);
612	}
613	return TCL_OK;
614	}
615
616
617	STDHLF(Asc_SimBinTokenSetOptions, (Asc_SimBinTokenSetOptionsHL,Asc_SimBinTokenSetOptionsHL2,HLFSTOP));
618	int Asc_SimBinTokenSetOptions(ClientData cdata, Tcl_Interp *interp,
619	int argc, CONST84 char **argv)
620	{
621	char srcname, objname, libname, buildcommand, *unlinkcommand;
622	long maxrels;
623	int verbose, housekeep;
624	int s1,s2,s3;
625
626	ASCUSE; /* see if first arg is -help */
627	if (argc != 9 ) {
628	Asc_HelpGetUsage(interp,Asc_SimBinTokenSetOptionsHN);
629	return TCL_ERROR;
630	};
631	srcname = ascstrdup(argv[1]);
632	objname = ascstrdup(argv[2]);
633	libname = ascstrdup(argv[3]);
634	buildcommand = ascstrdup(argv[4]);
635	unlinkcommand = ascstrdup(argv[5]);
636	s1 = Tcl_ExprLong(interp,argv[6],&maxrels);
637	Tcl_ResetResult(interp);
638	s2 = Tcl_GetInt(interp,argv[7],&verbose);
639	Tcl_ResetResult(interp);
640	s3 = Tcl_GetInt(interp,argv[8],&housekeep);
641	Tcl_ResetResult(interp);
642	if (srcname == NULL \|\| objname == NULL \|\| libname == NULL \|\|
643	buildcommand == NULL \|\| unlinkcommand == NULL \|\|
644	s1 != TCL_OK \|\| s2 != TCL_OK \|\| s3 != TCL_OK) {
645	Tcl_AppendResult(interp,argv[0],": Error converting input",(char *)NULL);
646	return TCL_ERROR;
647	}
648	BinTokenSetOptions(srcname,objname,libname,buildcommand,unlinkcommand,
649	(unsigned long)maxrels,verbose,housekeep);
650	return TCL_OK;
651	}