/[ascend]/trunk/tcltk/interface/SimsProc.c
ViewVC logotype

Contents of /trunk/tcltk/interface/SimsProc.c

Parent Directory Parent Directory | Revision Log Revision Log


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

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