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

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