/[ascend]/trunk/tcltk/generic/interface/Driver.c
ViewVC logotype

Contents of /trunk/tcltk/generic/interface/Driver.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2016 - (show annotations) (download) (as text)
Tue Apr 28 09:30:57 2009 UTC (10 years, 11 months ago) by jpye
File MIME type: text/x-csrc
File size: 30942 byte(s)
Trying to fix up ASCEND for change of model library location to /usr/lib/ascend/models.
1 /* ASCEND modelling environment
2 Copyright 1997, Carnegie Mellon University
3 Copyright (C) 2006 Carnegie Mellon University
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2, or (at your option)
8 any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place - Suite 330,
18 Boston, MA 02111-1307, USA.
19 *//*
20 by Kirk Abbott and Ben Allan
21 Created: 1/94
22 Last in CVS: $Revision: 1.48 $ $Date: 2003/08/23 18:43:06 $ $Author: ballan $
23 */
24
25 #define ASC_BUILDING_INTERFACE
26
27 #include <stdarg.h>
28 #include <ctype.h>
29 #include <time.h>
30 #include <tcl.h>
31 #include <tk.h>
32 #include <utilities/config.h>
33 #include "config.h"
34 #include <general/ospath.h>
35 #include <utilities/ascPrint.h>
36 #include <utilities/error.h>
37 #include <solver/solver.h>
38 #ifdef ASC_SIGNAL_TRAPS
39 # include <utilities/ascSignal.h>
40 #endif
41
42 #ifndef __WIN32__
43 # include <unistd.h>
44 #else
45
46 /* jds20041229 - windows.h now included in ascConfig.h. */
47 /* jp - i took it back out of ascConfig.h - Apr 2005 */
48 # define WIN32_LEAN_AND_MEAN
49 # include <windows.h>
50
51 # include <locale.h>
52 # include "tkConsole.h"
53 # undef WIN32_LEAN_AND_MEAN
54 #endif /* __WIN32__ */
55
56 #include <utilities/config.h>
57 #include <utilities/ascMalloc.h> /* for ascshutdown */
58 #include <utilities/ascPanic.h> /* for Asc_Panic */
59 #include <utilities/ascEnvVar.h>
60 #include <utilities/ascPrint.h>
61
62 #include <compiler/ascCompiler.h>
63 #include <compiler/instance_enum.h>
64 #include <compiler/units.h>
65 /* #include <compiler/redirectFile.h> */ /* for Asc_RedirectCompilerDefault() */
66 #include <compiler/simlist.h>
67
68 #include <linear/mtx.h>
69
70 #include <system/slv_client.h>
71 #include <system/slv_stdcalls.h>
72
73 #include "AscBitmaps.h"
74 #include "AscPrintTcl.h"
75 #include "HelpProc.h"
76 #include "Commands.h"
77 #include "Driver.h"
78 #include "ScriptProc.h"
79 #include "SolverProc.h"
80 #include "UnitsProc.h"
81
82 /*
83 * EXPORTED VARIABLES
84 */
85
86 /**
87 Interpreter for this application. We need to make it global
88 so that our signal/floating-porint traps can access it.
89 */
90 Tcl_Interp *g_interp;
91
92 /*
93 Comes from the yacc file if yacc was built with debugging information
94 */
95 #ifdef ZZ_DEBUG
96 extern int zz_debug;
97 #endif
98
99
100 /*
101 Declarations for procedures defined outside of this file.
102 */
103 extern int Tktable_Init(Tcl_Interp*);
104
105 #ifdef ASC_SIGNAL_TRAPS
106 static void AscTrap(int);
107 #endif
108
109 static void AscCheckEnvironVars(Tcl_Interp*,const char *progname);
110 static void AscPrintHelpExit(CONST char *);
111 static int AscProcessCommandLine(Tcl_Interp*, int, CONST char **);
112 static int AscSetStartupFile(Tcl_Interp*);
113 static void StdinProc(ClientData, int);
114 #ifdef DEBUG_MALLOC
115 static void InitDebugMalloc(void);
116 #endif /* DEBUG_MALLOC */
117
118
119 /*
120 LOCALLY GLOBAL VARIABLES
121 think global, act local :-)
122 */
123
124 /**
125 TRUE for compiler optimizations default is TRUE, set to FALSE by passing
126 +s on the command line
127 */
128 static int g_interface_simplify_relations = TRUE;
129
130 /** TRUE if windows to be built; default is TRUE, false is not supported */
131 static int g_interfacever = 1;
132
133 /** Used to assemble lines of terminal input into Tcl commands. */
134 static Tcl_DString g_command;
135
136 /** Used to read the next line from the terminal input. */
137 static Tcl_DString g_line;
138
139 /**
140 Non-zero means standard input is a terminal-like device.
141 Zero means it's a file.
142 */
143 static int tty;
144
145 /*
146 initScriptTclAdjust
147 initScriptTkAdjust
148
149 These two variables hold Tcl scripts that will set the TCL_LIBRARY
150 and TK_LIBRARY environment variables if they are not already
151 set in the user's environment.
152 TCL_LIBRARY is set to: dirnameofexecutable/../../Tcl/lib/tcl8.0
153 TK_LIBRARY is set to $tcl_library/../tk8.0
154 */
155 static char initScriptTclAdjust[] =
156 "proc asc_tclInit {} {\n\
157 global env\n\
158 rename asc_tclInit {}\n\
159 set errors {}\n\
160 set dirs {}\n\
161 if [info exists env(TCL_LIBRARY)] {\n\
162 return\n\
163 } else {\n\
164 set parentDir [file dirname [info nameofexecutable]]\n\
165 set env(TCL_LIBRARY) $parentDir/../../Tcl/lib/tcl8.0\n\
166 }\n\
167 }\n\
168 asc_tclInit";
169 /* for tcl, FOO/ascend4/bin/ascend4.exe is the executable, then
170 * /-- up to FOO/ascend4/bin
171 * set parentDir [file dirname [info nameofexecutable]]\n\
172 * Then if Tcl is next to ascend4, ../../Tcl/lib/tcl8.0 should work.
173 */
174
175 static char initScriptTkAdjust[] =
176 "proc asc_tkInit {} {\n\
177 global env\n\
178 rename asc_tkInit {}\n\
179 set errors {}\n\
180 set dirs {}\n\
181 if [info exists env(TK_LIBRARY)] {\n\
182 return\n\
183 } else {\n\
184 set parentDir [file dirname [info library]]\n\
185 set env(TK_LIBRARY) $parentDir/tk8.0\n\
186 }\n\
187 }\n\
188 asc_tkInit";
189 /**<
190 This assumes tcl_library has been found and that tcl8.0 and tk8.0
191 are installed in the same lib directory -- the default tcl/tk install.
192 */
193
194 /**
195 who built this binary and when
196 */
197 #ifndef TIMESTAMP
198 static char build_name[]="by anonymous";
199 #else
200 static char build_name[]=TIMESTAMP;
201 #endif /* TIMESTAMP */
202
203 /*
204 jp: Moved 'main' and 'WinMain' to separate 'main.c'
205 so that ascend4.exe can be built without linkage to Tcl/Tk
206 */
207
208
209 /**
210 A common entry point for Windows and Unix. The corresponding
211 WinMain() and main() functions just call this function.
212
213 This function creates a Tcl interpreter, initializes Tcl and Tk,
214 initializes the Ascend data structures, sets up the user's
215 environment, sources ASCEND's startup script, and calls Tk_MainLoop
216 so the user can interact with ASCEND. Cleans up and exits the
217 program when Tk_MainLoop returns.
218
219 This function is based on the functions Tk_Main and Tcl_AppInit
220 from the Tk8.0 distribution. See the files tkMain.c and tkAppInit.c
221 in the Tk sources.
222 */
223 int AscDriver(int argc, CONST char **argv)
224 {
225 Tcl_Interp *interp; /* local version of global g_interp */
226 Tcl_Channel inChannel;
227 Tcl_Channel outChannel;
228
229 /* Remove the stream redirection stuff for the moment -- JP Nov 2006 */
230 /* jds20050119: Initialize ASCERR before any calls to ascPanic(). */
231 /* TODO: revisit when interface is decoupled from base - this may change. */
232 #ifdef REIMPLEMENT_STREAMS
233 Asc_RedirectCompilerDefault();
234 #endif
235
236 #ifdef USE_ASC_PRINTF
237 Asc_PrintInit_TclVtable();
238 #endif /* USE_ASC_PRINTF */
239 /*
240 * Create the Tk Console
241 *
242 * Create the console channels and install them as the standard
243 * channels. All I/O will be discarded until TkConsoleInit() is
244 * called to attach the console to a text widget.
245 */
246 #ifdef ASC_USE_TK_CONSOLE
247 TkConsoleCreate();
248 #endif /* ASC_USE_TK_CONSOLE */
249
250 /*
251 * Find the name of the current executable---available in the
252 * Tcl command `info nameofexecutable'
253 */
254 Tcl_FindExecutable(argv[0]);
255
256 /*
257 * Create the interpreter
258 */
259 g_interp = Tcl_CreateInterp();
260 interp = g_interp;
261 if( interp == NULL ) {
262 Asc_Panic(2, "Asc_Driver",
263 "Call to Tcl_CreateInterp returned NULL interpreter");
264 }
265
266 /*
267 * Check the arguments on the command line
268 */
269 AscProcessCommandLine(interp, argc, argv);
270
271 /*
272 * Set the "tcl_interactive" variable.
273 *
274 * ASCEND sets tty to `1', since we assume ASCEND is always interactive.
275 */
276 tty = 1;
277 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
278
279 /*
280 * Initialize Tcl and Tk
281 */
282 (void)Tcl_Eval(interp,initScriptTclAdjust);
283 if (Tcl_Init(interp) == TCL_ERROR) {
284 ASC_PANIC("Tcl initialization failed:\n%s",
285 Tcl_GetStringResult(interp));
286 }
287 (void)Tcl_Eval(interp,initScriptTkAdjust);
288 if (Tk_Init(interp) == TCL_ERROR) {
289 ASC_PANIC("Tk initialization failed:\n%s",
290 Tcl_GetStringResult(interp));
291 }
292 Tcl_StaticPackage( interp, "Tk", Tk_Init, Tk_SafeInit );
293
294 /*
295 * Initialize the console and the ASCEND printf() substitutes.
296 * All output before this point is lost.
297 */
298 #ifdef ASC_USE_TK_CONSOLE
299 if (TkConsoleInit(interp) == TCL_ERROR) {
300 Asc_Panic(2, "Asc_Driver",
301 "Call to TkConsoleInit failed:\n%s",
302 Tcl_GetStringResult(interp));
303 }
304 #endif /* ASC_USE_TK_CONSOLE */
305 #ifdef USE_ASC_PRINTF
306 Asc_PrintInit_Tcl();
307 #endif /* USE_ASC_PRINTF */
308
309 /*
310 * Now that our console and printing functions are properly
311 * initialized, print our startup banner.
312 */
313
314 color_on(stderr,"34;1");
315 ASC_FPRINTF(stderr,"\nASCEND modelling environment\n");
316 ASC_FPRINTF(stderr,"Copyright(C) 1997, 2006-2007 Carnegie Mellon University\n");
317 ASC_FPRINTF(stderr,"Copyright(C) 1993-1996 Kirk Andre Abbott, Ben Allan\n");
318 ASC_FPRINTF(stderr,"Copyright(C) 1990, 1993, 1994 Thomas Guthrie Epperly\n");
319 ASC_FPRINTF(stderr,"Built %s %s %s\n\n",__DATE__,__TIME__,build_name);
320 ASC_FPRINTF(stderr,"ASCEND comes with ABSOLUTELY NO WARRANTY, and is free software that you may\n");
321 ASC_FPRINTF(stderr,"redistribute within the conditions of the GNU General Public License. See the\n");
322 ASC_FPRINTF(stderr,"included file 'LICENSE.txt' for full details.\n\n");
323 color_off(stderr);
324
325 /*
326 * Call the init procedures for included packages.
327 */
328 #ifdef STATIC_TKTABLE
329 if( Tktable_Init(interp) == TCL_ERROR ) {
330 Asc_Panic(2, "Asc_Driver",
331 "Call to Tktable_Init failed:\n%s",
332 Tcl_GetStringResult(interp));
333 }
334 #endif /* STATIC_TKTABLE */
335
336 /*
337 * Initialize ASCEND C Structures
338 * Create ASCEND Tcl Commands
339 */
340 clock();
341 /* the next line should NOT be Asc_SignalHandlerPush */
342 #ifdef ASC_SIGNAL_TRAPS
343 (void)SIGNAL(SIGINT, AscTrap);
344 #endif
345
346 #ifdef DEBUG_MALLOC
347 InitDebugMalloc();
348 ascstatus("Memory status after calling InitDebugMalloc()");
349 #endif /* DEBUG_MALLOC */
350 if ( Asc_CompilerInit(g_interface_simplify_relations) != 0 ) {
351 Asc_Panic(2, "Asc_CompilerInit",
352 "Insufficient memory to initialize compiler.");
353 }
354
355 /*
356 * Set the environment, and set find the
357 * location of ASCEND's startup file.
358 */
359 AscCheckEnvironVars(interp,argv[0]);
360 if( AscSetStartupFile(interp) != TCL_OK ) {
361 Asc_Panic(2, "Asc_Driver",
362 "Cannot find ~/.ascendrc nor the default AscendRC\n%s",
363 Tcl_GetStringResult(interp));
364 }
365
366 SlvRegisterStandardClients();
367 if( Asc_HelpInit() == TCL_ERROR ) {
368 Asc_Panic(2, "Asc_HelpInit",
369 "Insufficient memory to initialize help system.");
370 }
371 Asc_CreateCommands(interp);
372 Asc_RegisterBitmaps(interp);
373
374
375
376 /*
377 * Evaluate the ~/.ascendrc or $ASCENDTK/AscendRC file
378 */
379 Tcl_SourceRCFile(interp);
380
381 /*
382 * Establish a channel handlers for stdin and stdout
383 */
384 inChannel = Tcl_GetStdChannel(TCL_STDIN);
385 if (inChannel) {
386 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
387 (ClientData) inChannel);
388 }
389 if (tty) {
390 Asc_Prompt(interp, 0);
391 }
392 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
393 if (outChannel) {
394 Tcl_Flush(outChannel);
395 }
396
397 /*
398 * Initialize the Dynamic Strings used in StdinProc()
399 */
400 Tcl_DStringInit(&g_command);
401 Tcl_DStringInit(&g_line);
402 Tcl_ResetResult(interp);
403
404 /*
405 * Loop infinitely, waiting for commands to execute. When there
406 * are no windows left, Tk_MainLoop returns and we exit.
407 */
408 #ifdef DEBUG_MALLOC
409 ascstatus("Memory status before calling Tk_MainLoop()");
410 #endif /* DEBUG_MALLOC */
411 if (Asc_ScriptConfigureInterrupt(1,interp)!=0) {
412 Asc_Panic(2, "Asc_ScriptConfigureInterrupt",
413 "Unable to configure script interrupt.");
414 }
415 Tk_MainLoop();
416 Asc_ScriptConfigureInterrupt(0,interp);
417 #ifdef USE_ASC_PRINTF
418 Asc_PrintFinalize_Tcl();
419 #endif /* USE_ASC_PRINTF */
420 #ifdef DEBUG_MALLOC
421 ascstatus("Memory status after Tk_MainLoop() exits");
422 #endif /* DEBUG_MALLOC */
423
424 /*
425 * Do ASCEND Cleanup
426 */
427 Asc_HelpDestroy();
428 Asc_UnitValue(NULL);
429 Asc_SolvMemoryCleanup();
430 Asc_CompilerDestroy();
431 Asc_DestroyEnvironment();
432 #ifdef DEBUG_MALLOC
433 ascshutdown("Memory status just before exiting");
434 #endif /* DEBUG_MALLOC */
435
436 /*
437 * Destroy the interpreter and exit
438 */
439 Tcl_DeleteInterp(interp);
440 Tcl_Exit(0);
441 return 0;
442 }
443
444 /*-------------------------------------------------------
445 SETTING UP ENVIRONMENT...
446 */
447
448 #define GETENV Asc_GetEnv
449 #define PUTENV Asc_PutEnv
450
451 /**
452 This is a quick macro to output a FilePath to an environment
453 variable.
454 */
455 #define OSPATH_PUTENV(VAR,FP) \
456 /*CONSOLE_DEBUG("VAR: %s",VAR);*/ \
457 sprintf(envcmd,"%s=",VAR); \
458 ospath_strcat(FP,envcmd,MAX_ENV_VAR_LENGTH); \
459 /*CONSOLE_DEBUG("ENVCMD: %s",envcmd);*/ \
460 PUTENV(envcmd)
461
462 /**
463 This is a quick macro to send data to Tcl using Tcl_SetVar.
464 It uses an intermediate buffer which is assumed to be
465 empty already.
466
467 usage: ASC_SEND_TO_TCL(tclvarname,"some string value");
468 */
469 #define ASC_SEND_TO_TCL(VAR,VAL) \
470 Tcl_DStringAppend(&buffer,VAL,-1); \
471 Tcl_SetVar(interp,#VAR,Tcl_DStringValue(&buffer),TCL_GLOBAL_ONLY); \
472 Tcl_DStringFree(&buffer);
473
474 /**
475 This is a quick macro to send data to Tcl using Tcl_SetVar2.
476 It uses an intermediate buffer which is assumed to be
477 empty already.
478
479 usage: ASC_SEND_TO_TCL2(arrayname,"keyname","some string value");
480 */
481 #define ASC_SEND_TO_TCL2(ARR,KEY,VAL) \
482 Tcl_DStringAppend(&buffer,VAL,-1); \
483 Tcl_SetVar2(interp,#ARR,KEY,Tcl_DStringValue(&buffer),TCL_GLOBAL_ONLY); \
484 Tcl_DStringFree(&buffer);
485
486 static void printenv(){
487 int n;
488 const char **l;
489 l = Asc_EnvNames(&n);
490 CONSOLE_DEBUG("VARS = %d",n);
491 ascfree(l);
492 }
493
494 /**
495 Ensure that all required environment variables are present
496 and set values for them if they are not present. The names
497 for the environment variables are specified in
498 <utilities/config.h>. The following comments assume that you
499 use the usual names for each of these:
500
501 ASCENDDIST defaults to $PROGDIR/@ASC_DATADIR_REL_BIN@ (also in config.h)
502 ASCENDTK defaults to $ASCENDDIST/TK (latter is from config.h)
503 ASCENDBITMAPS defaults $ASCENDTK/bitmaps
504 ASCENDLIBRARY defaults to $ASCENDDIST/models
505
506 Also check for the existence of the file AscendRC in $ASCENDTK
507 and if found, export the location of that file to the Tcl
508 variable tcl_rcFileName.
509
510 If you set ASC_ABSOLUTE_PATHS then ASCENDDIST defaults to @ASC_DATADIR@ and
511 the rest follows through as above.
512 */
513 static void AscCheckEnvironVars(Tcl_Interp *interp,const char *progname){
514 char *distdir, *tkdir, *bitmapsdir, *librarydir, *solversdir;
515 struct FilePath *fp, *fp1, *distfp, *tkfp, *bitmapsfp, *libraryfp, *solversfp;
516 char envcmd[MAX_ENV_VAR_LENGTH];
517 # ifndef ASC_ABSOLUTE_PATHS
518 char s1[PATH_MAX];
519 #endif
520 int err;
521 int guessedtk=0;
522 FILE *f;
523
524 Tcl_DString buffer;
525
526 Tcl_DStringInit(&buffer);
527
528 /* import these into the environment */
529 err = env_import(ASC_ENV_DIST,getenv,PUTENV);
530 if(err)CONSOLE_DEBUG("No %s var imported (error %d)",ASC_ENV_DIST,err);
531 env_import(ASC_ENV_TK,getenv,PUTENV);
532 env_import(ASC_ENV_BITMAPS,getenv,PUTENV);
533 env_import(ASC_ENV_LIBRARY,getenv,PUTENV);
534 env_import(ASC_ENV_SOLVERS,getenv,PUTENV);
535
536 /* used for colour console output */
537 env_import("TERM",getenv,PUTENV);
538
539 /* CONSOLE_DEBUG("IMPORTING VARS"); */
540
541 distdir = GETENV(ASC_ENV_DIST);
542 tkdir = GETENV(ASC_ENV_TK);
543 bitmapsdir = GETENV(ASC_ENV_BITMAPS);
544 librarydir = GETENV(ASC_ENV_LIBRARY);
545 solversdir = GETENV(ASC_ENV_SOLVERS);
546
547 /* Create an ASCENDDIST value if it's missing */
548
549 if(distdir == NULL){
550 CONSOLE_DEBUG("Note: No '" ASC_ENV_DIST "' var defined");
551
552 # ifndef ASC_ABSOLUTE_PATHS
553
554 /* read the executable's name/relative path.*/
555 fp = ospath_new(progname);
556
557 ospath_strncpy(fp,s1,PATH_MAX);
558 /* CONSOLE_DEBUG("PROGNAME = %s",s1); */
559
560 /* get the directory name from the exe path*/
561 fp1 = ospath_getdir(fp);
562 ospath_free(fp);
563
564 ospath_strncpy(fp1,s1,PATH_MAX);
565 /* CONSOLE_DEBUG("DIR = %s",s1); */
566
567 /* append the contents of ASC_DISTDIR_REL_BIN to this path*/
568 fp = ospath_new_noclean(ASC_DISTDIR_REL_BIN);
569 distfp = ospath_concat(fp1,fp);
570 ospath_cleanup(distfp);
571
572 ospath_strncpy(fp1,s1,PATH_MAX);
573 /* CONSOLE_DEBUG("DIST = %s",s1); */
574
575 # else
576 CONSOLE_DEBUG("ASC_ABSOLUTE_PATHS=%d",ASC_ABSOLUTE_PATHS);
577 distfp = ospath_new(ASC_DATADIR);
578 (void)progname;
579 # endif
580 distdir = ospath_str(distfp);
581 /* CONSOLE_DEBUG("GUESSING %s = %s",ASC_ENV_DIST,distdir); */
582 OSPATH_PUTENV(ASC_ENV_DIST,distfp);
583 distdir = GETENV(ASC_ENV_DIST);
584 /* CONSOLE_DEBUG("RETRIEVED %s = %s",ASC_ENV_DIST,distdir); */
585 printenv();
586 }
587
588 if(tkdir == NULL){
589 /* CONSOLE_DEBUG("USING DEFAULT %s = %s",ASC_ENV_TK,ASC_ENV_TK_DEFAULT); */
590 guessedtk=1;
591 tkfp = ospath_new_expand_env(ASC_ENV_TK_DEFAULT, &GETENV);
592 tkdir = ospath_str(tkfp);
593
594 ospath_strncpy(tkfp,envcmd,MAX_ENV_VAR_LENGTH);
595 /* CONSOLE_DEBUG("TK = %s",envcmd); */
596
597 OSPATH_PUTENV(ASC_ENV_TK,tkfp);
598 }else{
599 tkfp = ospath_new_expand_env(tkdir, &GETENV);
600 tkdir = ospath_str(tkfp);
601 OSPATH_PUTENV(ASC_ENV_TK,tkfp);
602 }
603
604 if(bitmapsdir == NULL){
605 /* CONSOLE_DEBUG("NO " ASC_ENV_BITMAPS " VAR DEFINED"); */
606 /* Create a path $ASCENDTK/bitmaps */
607 bitmapsfp = ospath_new_expand_env("$ASCENDTK/bitmaps", &GETENV);
608 OSPATH_PUTENV(ASC_ENV_BITMAPS,bitmapsfp);
609 bitmapsdir = ospath_str(bitmapsfp);
610 }
611
612 /**
613 @TODO FIXME Note, at present this default library path only caters for a
614 ** SINGLE PATH COMPONENT **
615
616 @TODO Also, what about ASCEND_DEFAULTLIBRARY ?
617 */
618 if(librarydir == NULL){
619 /* CONSOLE_DEBUG("NO " ASC_ENV_LIBRARY " VAR DEFINED"); */
620 libraryfp = ospath_new_expand_env("$ASCENDDIST/lib/models", &GETENV);
621 /* CONSOLE_DEBUG("CREATED LIBRARY VAL"); */
622 OSPATH_PUTENV(ASC_ENV_LIBRARY,libraryfp);
623 librarydir = ospath_str(libraryfp);
624 ospath_free(libraryfp);
625 }
626
627 if(solversdir == NULL){
628 /* CONSOLE_DEBUG("NO " ASC_ENV_LIBRARY " VAR DEFINED"); */
629 solversfp = ospath_new_expand_env("$ASCENDDIST/lib/solvers", &GETENV);
630 /* CONSOLE_DEBUG("CREATED SOLVERS VAL"); */
631 OSPATH_PUTENV(ASC_ENV_SOLVERS,solversfp);
632 solversdir = ospath_str(solversfp);
633 ospath_free(solversfp);
634 }
635
636 CONSOLE_DEBUG("CHECKING FOR AscendRC FILE");
637
638 fp1 = ospath_new("AscendRC");
639 fp = ospath_concat(tkfp,fp1);
640 ospath_free(fp1);
641 f = ospath_fopen(fp,"r");
642 if(f==NULL){
643 if(guessedtk){
644 Asc_Panic(2, "AscCheckEnvironVars",
645 "Cannot located AscendRC file in expected (guessed) location:\n%s\n"
646 "Please set the %s environment variable to the correct location (typically\n"
647 "it would be c:\\Program Files\\ASCEND\\TK or /usr/share/ascend/tcltk/TK. You\n"
648 "should do this, then start ASCEND again."
649 ,tkdir,ASC_ENV_TK
650 );
651 }else{
652 Asc_Panic(2, "AscCheckEnvironVars",
653 "Cannot located AscendRC file in the specified location:\n%s\n"
654 "Please check your value for the %s environment variable.\n"
655 ,tkdir,ASC_ENV_TK
656 );
657 }
658 /* can't get here, hopefully */
659 }
660 fclose(f);
661 /* reuse 'envcmd' to get the string file location for AscendRC */
662 ospath_strncpy(fp,envcmd,MAX_ENV_VAR_LENGTH);
663 ospath_free(fp);
664
665 /* export the value to Tcl/Tk */
666 ASC_SEND_TO_TCL(tcl_rcFileName, envcmd);
667
668 /* send all the environment variables to Tcl/Tk as well */
669 ASC_SEND_TO_TCL2(env,ASC_ENV_DIST,distdir);
670 ASC_SEND_TO_TCL2(env,ASC_ENV_LIBRARY,librarydir);
671 ASC_SEND_TO_TCL2(env,ASC_ENV_BITMAPS,bitmapsdir);
672 ASC_SEND_TO_TCL2(env,ASC_ENV_TK,tkdir);
673 }
674
675
676
677 /**
678 Look for ~/.ascendrc; if found, set the Tcl variable tcl_rcFileName
679 to this file's location. This overrides the value set in
680 AscCheckEnvironVars().
681 If ~/_ascendrc is available it only gets used if ~/.ascendrc is not.
682 Returns a standard Tcl return code.
683 */
684 static int AscSetStartupFile(Tcl_Interp *interp)
685 {
686 char *fullname; /* try to find this if first fails */
687 Tcl_DString buffer;
688 Tcl_Channel c; /* used to check for file existance */
689
690 Tcl_ResetResult(interp);
691
692 fullname = Tcl_TranslateFileName( interp, "~/.ascendrc", &buffer );
693 if( fullname != NULL ) {
694 /*
695 * Use the Tcl file channel routines to determine if ~/.ascendrc
696 * exists. We cannot use access() since Windows doesn't use it.
697 */
698 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
699 if( c != (Tcl_Channel)NULL ) {
700 /* file exists. close the channel and set tcl_rcFileName. */
701 Tcl_Close( NULL, c );
702 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
703 Tcl_DStringFree(&buffer);
704 return TCL_OK;
705 }
706 Tcl_DStringFree(&buffer);
707 }
708 fullname = Tcl_TranslateFileName( interp, "~/_ascendrc", &buffer );
709 if( fullname != NULL ) {
710 /*
711 * Use the Tcl file channel routines to determine if ~/_ascendrc
712 * exists. We cannot use access() since Windows doesn't use it.
713 */
714 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
715 if( c != (Tcl_Channel)NULL ) {
716 /* file exists. close the channel and set tcl_rcFileName */
717 Tcl_Close( NULL, c );
718 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
719 Tcl_DStringFree(&buffer);
720 return TCL_OK;
721 }
722 Tcl_DStringFree(&buffer);
723 }
724 return TCL_OK; /* probably should be TCL_ERROR */
725 }
726
727
728 /**
729 Process the options given on the command line `argv' where `argc' is
730 the length of argv.
731
732 Strip out ASCEND specific flags and then pass the rest to Tcl so it
733 can set what it needs.
734
735 This function may call exit() if the user requests help.
736 */
737 static int AscProcessCommandLine(Tcl_Interp *interp, int argc, CONST char **argv)
738 {
739 int i;
740 int flag; /* set to 1 for `+arg', -1 for `-arg' */
741 size_t length; /* length of an argv */
742 char *args;
743 char buf[MAXIMUM_NUMERIC_LENGTH]; /* space for integer->string conversion */
744 int new_argc = 0; /* the argc we will pass to Tcl */
745 #ifdef ZZ_DEBUG
746 zz_debug = 0; /* nonzero to print parser debugging info*/
747 #endif
748
749 for( i = 1; i < argc; i++ ) {
750 if( (length = strlen(argv[i])) == 0 ) {
751 /* ignore 0-length arguments */
752 continue;
753 }
754
755 if(( length >= 2 ) && ( strncmp(argv[i],"-h",2) == 0 )) {
756 AscPrintHelpExit(argv[0]);
757 }
758 if(( length >= 2 ) && ( strncmp(argv[i],"-H",2) == 0 )) {
759 AscPrintHelpExit(argv[0]);
760 }
761 if(( length >= 4 ) && ( strncmp(argv[i],"help",4) == 0 )) {
762 AscPrintHelpExit(argv[0]);
763 }
764
765 if( argv[i][0] == '-' ) {
766 flag = -1;
767 } else if( argv[i][0] == '+' ) {
768 flag = 1;
769 } else {
770 flag = 0;
771 }
772
773 if(( length == 2 ) && ( flag != 0 )) {
774 switch( argv[i][1] ) {
775 case 'd':
776 /* '-d' turns on scanner debugging (if ascend was built with it)
777 * '+d' turns off scanner debugging [default]
778 */
779 if( flag == -1 ) {
780 #ifdef ZZ_DEBUG
781 zz_debug = 1;
782 } else {
783 zz_debug = 0;
784 #else
785 FPRINTF(ASCERR, "Sorry, %s wasn't compiled with %s defined.\n",
786 argv[0], "ZZ_DEBUG");
787 #endif /* ZZ_DEBUG */
788 }
789 break;
790 case 's':
791 /* '-s' turns on compiler optimizations [default]
792 * '+s' turns off compiler optimizations
793 */
794 if( flag == -1 ) {
795 g_interface_simplify_relations = 1;
796 } else {
797 g_interface_simplify_relations = 0;
798 }
799 break;
800 case 't':
801 /* '-t' turns on timing of compiler optimizations
802 * '+t' turns off timing of compiler optimizations [default]
803 */
804 if( flag == 0 ) {
805 g_compiler_timing = 1;
806 } else {
807 g_compiler_timing = 0;
808 }
809 break;
810 case 'c':
811 case 'g':
812 fprintf(ASCERR, "WARNING! Obsolete ASCEND option \"%s\"\n", argv[i]);
813 break;
814 default:
815 /* unknown ASCEND option, pass it on to Tcl
816 */
817 argv[++new_argc] = argv[i];
818 break;
819 }
820 } else {
821 /* unknown ASCEND option, pass it on to Tcl
822 */
823 argv[++new_argc] = argv[i];
824 }
825 }
826
827 /*
828 * Make command-line arguments available in the Tcl variables "argc"
829 * and "argv".
830 */
831 args = Tcl_Merge(new_argc, (argv+1));
832 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
833 ckfree(args);
834 sprintf(buf, "%d", new_argc);
835 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
836 Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
837
838 return TCL_OK;
839 }
840
841
842 /**
843 Print a help message and exit. Use invoke_name as the name of the binary
844 */
845 static
846 void AscPrintHelpExit(CONST char *invoke_name)
847 {
848 PRINTF("usage: %s [options]\n"
849 "\n"
850 "where options include [default value]:\n"
851 " -h print this message\n"
852 " -/+d turn on/off yacc debugging [off]\n"
853 " -/+s turn on/off compiler optimizations [on]\n"
854 " -/+t turn on/off timing of compiler operations [off]\n",
855 invoke_name);
856 Tcl_Exit(0); /* Show this help message and leave */
857 }
858
859
860 #ifdef ASC_SIGNAL_TRAPS
861 /**
862 Function to call when we receive an interrupt.
863 */
864 static
865 void AscTrap(int sig)
866 {
867 putchar('\n');
868 Asc_Panic(sig, "AscTrap", "Caught Signal: %d", sig);
869 }
870 #endif
871
872 int Asc_LoadWin(ClientData cdata, Tcl_Interp *interp,
873 int argc, CONST84 char *argv[])
874 {
875 UNUSED_PARAMETER(cdata);
876 (void)argv; /* stop gcc whine about unused parameter */
877
878 if ( argc != 1 ) {
879 FPRINTF(stderr,"call is: ascloadwin <no args> \n");
880 return TCL_ERROR;
881 }
882 if (g_interfacever) {
883 Tcl_SetResult(interp, "1", TCL_STATIC);
884 } else {
885 Tcl_SetResult(interp, "0", TCL_STATIC);
886 }
887 return TCL_OK;
888 }
889
890 /*---------------------------------------------------------------------
891 The following StdinProc() and Asc_Prompt() are from tkMain.c in
892 the Tk4.1 distribution (and did not change in Tk8.0).
893 ----------------------------------------------------------------------*/
894
895 /**
896 This procedure is invoked by the event dispatcher whenever
897 standard input becomes readable. It grabs the next line of
898 input characters, adds them to a command being assembled, and
899 executes the command if it's complete.
900
901 Results:
902 None.
903
904 Side effects:
905 Could be almost arbitrary, depending on the command that's
906 typed.
907 */
908 static void
909 StdinProc(ClientData clientData, int mask)
910 {
911 static int gotPartial = 0;
912 char *cmd;
913 int code, count;
914 Tcl_Channel chan = (Tcl_Channel) clientData;
915
916 Tcl_Interp *interp = g_interp; /* use a local copy of the
917 * global tcl interpreter
918 */
919
920 (void)clientData; /* stop gcc whine about unused parameter */
921 (void)mask; /* stop gcc whine about unused parameter */
922
923 count = Tcl_Gets(chan, &g_line);
924
925 if (count < 0) {
926 if (!gotPartial) {
927 if (tty) {
928 return;
929 } else {
930 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
931 }
932 return;
933 } else {
934 count = 0;
935 }
936 }
937
938 (void) Tcl_DStringAppend(&g_command, Tcl_DStringValue(&g_line), -1);
939 cmd = Tcl_DStringAppend(&g_command, "\n", -1);
940 Tcl_DStringFree(&g_line);
941
942 if (!Tcl_CommandComplete(cmd)) {
943 gotPartial = 1;
944 goto prompt;
945 }
946 gotPartial = 0;
947
948 /*
949 * Disable the stdin channel handler while evaluating the command;
950 * otherwise if the command re-enters the event loop we might
951 * process commands from stdin before the current command is
952 * finished. Among other things, this will trash the text of the
953 * command being evaluated.
954 */
955
956 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
957 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
958 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
959 (ClientData) chan);
960 Tcl_DStringFree(&g_command);
961 if (*interp->result != 0) {
962 if ((code != TCL_OK) || (tty)) {
963 /*
964 * The statement below used to call "printf", but that resulted
965 * in core dumps under Solaris 2.3 if the result was very long.
966 *
967 * NOTE: This probably will not work under Windows either.
968 */
969
970 puts(interp->result);
971 }
972 }
973
974 /*
975 * Output a prompt.
976 */
977
978 prompt:
979 if (tty) {
980 Asc_Prompt(interp, gotPartial);
981 }
982 Tcl_ResetResult(interp);
983 }
984
985 /**
986 Issue a prompt on standard output, or invoke a script
987 to issue the prompt.
988
989 Results:
990 None.
991
992 Side effects:
993 A prompt gets output, and a Tcl script may be evaluated
994 in interp.
995
996 Parameters:
997 interp Interpreter to use for prompting.
998 partial Non-zero means there already exists a partial
999 command, so use the secondary prompt.
1000 */
1001 void
1002 Asc_Prompt(Tcl_Interp *interp, int partial)
1003 {
1004 CONST84 char *promptCmd;
1005 int code;
1006 Tcl_Channel outChannel, errChannel;
1007 CONST84 char *subPrompt;
1008
1009 color_on(stdout,"0;32");
1010
1011 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1012
1013 subPrompt = (partial ? "tcl_prompt2" : "tcl_prompt1");
1014 promptCmd = Tcl_GetVar(interp, subPrompt, TCL_GLOBAL_ONLY);
1015 if (promptCmd == NULL) {
1016 defaultPrompt:
1017
1018 /*
1019 * We must check that outChannel is a real channel - it
1020 * is possible that someone has transferred stdout out of
1021 * this interpreter with "interp transfer".
1022 */
1023
1024
1025 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1026 if (outChannel != (Tcl_Channel) NULL) {
1027 if (!partial) {
1028 Tcl_Write(outChannel, "AscendIV% ", 10);
1029 } else {
1030 Tcl_Write(outChannel, "more? ", 6);
1031 }
1032 }
1033 } else {
1034 code = Tcl_Eval(interp, promptCmd);
1035 if (code != TCL_OK) {
1036 Tcl_AddErrorInfo(interp,
1037 "\n (script that generates prompt)");
1038 /*
1039 * We must check that errChannel is a real channel - it
1040 * is possible that someone has transferred stderr out of
1041 * this interpreter with "interp transfer".
1042 */
1043
1044 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1045 if (errChannel != (Tcl_Channel) NULL) {
1046 Tcl_Write(errChannel, interp->result, -1);
1047 Tcl_Write(errChannel, "\n", 1);
1048 }
1049 goto defaultPrompt;
1050 }
1051 }
1052 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1053 if (outChannel != (Tcl_Channel) NULL) {
1054 Tcl_Flush(outChannel);
1055 }
1056 color_off(stdout);
1057 }
1058
1059 #ifdef DEBUG_MALLOC
1060 /**
1061 Tom Epperly's Malloc Debugger
1062 */
1063 static void InitDebugMalloc(void)
1064 {
1065 union dbmalloptarg m;
1066 m.str = NULL;
1067 m.i = 0;
1068 dbmallopt(MALLOC_CKDATA,&m);
1069 }
1070
1071 int Asc_DebugMallocCmd(ClientData cdata, Tcl_Interp *interp,
1072 int argc, CONST84 char *argv[])
1073 {
1074 union dbmalloptarg m;
1075
1076 if ( argc != 2 ) {
1077 Tcl_SetResult(interp, "wrong # args : Usage __dbmalloc ?on?off?",
1078 TCL_STATIC);
1079 return TCL_ERROR;
1080 }
1081 m.str = NULL;
1082 if (strcmp(argv[1],"on")==0) {
1083 m.i = 1;
1084 } else if (strcmp(argv[1],"off")==0) {
1085 m.i = 0;
1086 } else {
1087 Tcl_SetResult(interp, "incorrect args : should be \"on\" or \"off\"",
1088 TCL_STATIC);
1089 return TCL_ERROR;
1090 }
1091 dbmallopt(MALLOC_CKDATA,&m); /* turn on str* mem* and b* checking */
1092 return TCL_OK;
1093 }
1094 #endif /* DEBUG_MALLOC */

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