/[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 1002 - (show annotations) (download) (as text)
Sat Dec 30 14:27:47 2006 UTC (13 years, 11 months ago) by johnpye
File MIME type: text/x-csrc
File size: 30529 byte(s)
Some work on fixing error with test_ascSignal.
Breaking down into smaller test cases.
Removed some debug output from detection of ASC_RESETNEEDED.
Changed all calls 'signal' to 'SIGNAL' macro that includes optional debug output.
Removed 'libasctest.so' (made part of libasctestsuite.so FWIW)
Fixed big in test.c wrt CUEA_ABORT.
Added 'print_stack' and 'Asc_SignalPrintStack' and 'Asc_SignalStackLength'.

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

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