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

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