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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 58 - (show annotations) (download) (as text)
Sat Oct 1 18:10:03 2005 UTC (18 years, 9 months ago) by jds
File MIME type: text/x-csrc
File size: 41268 byte(s)
- Minor changes to AscPrintTcl.c and Driver.c to compile on Linux
- Add Watcom support to jam/Jambase
- Add release_notes subdirectory to tcltk98 for notes, licenses, etc.
1 /*
2 * Driver.c
3 * by Kirk Abbott and Ben Allan
4 * Created: 1/94
5 * Version: $Revision: 1.48 $
6 * Version control file: $RCSfile: Driver.c,v $
7 * Date last modified: $Date: 2003/08/23 18:43:06 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the ASCEND Tcl/Tk interface
11 *
12 * Copyright 1997, Carnegie Mellon University
13 *
14 * The ASCEND Tcl/Tk interface is free software; you can redistribute
15 * it and/or modify it under the terms of the GNU General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
18 *
19 * The ASCEND Tcl/Tk interface is distributed in hope that it will be
20 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 * General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License
25 * along with the program; if not, write to the Free Software Foundation,
26 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27 * COPYING. COPYING is found in ../compiler.
28 */
29
30 #include <stdarg.h>
31 #include <ctype.h>
32 #include <signal.h>
33 #include <time.h>
34 #include "tcl.h"
35 #include "tk.h"
36 #include "utilities/ascConfig.h"
37 #ifndef __WIN32__
38 #include <unistd.h>
39 #else
40 #define WIN32_LEAN_AND_MEAN
41 /* jds20041229 - windows.h now included in ascConfig.h.
42 #include <windows.h>
43 */
44 #include <locale.h>
45 #include "interface/tkConsole.h"
46 #undef WIN32_LEAN_AND_MEAN
47 #endif /* __WIN32__ */
48 #include "utilities/ascMalloc.h" /* for ascshutdown */
49 #include "utilities/ascPanic.h" /* for Asc_Panic */
50 #include "utilities/ascEnvVar.h"
51 #include "compiler/compiler.h"
52 #include "compiler/ascCompiler.h"
53 #include "compiler/instance_enum.h"
54 #include "compiler/fractions.h"
55 #include "compiler/dimen.h"
56 #include "compiler/compiler.h" /* for symchar for units.h */
57 #include "compiler/units.h"
58 #include "compiler/redirectFile.h" /* for Asc_RedirectCompilerDefault() */
59 #include "solver/slv_types.h"
60 #include "solver/var.h"
61 #include "solver/rel.h"
62 #include "solver/logrel.h"
63 #include "solver/discrete.h"
64 #include "solver/mtx.h"
65 #include "solver/slv_stdcalls.h"
66 #include "interface/AscBitmaps.h"
67 #include "utilities/ascPrint.h"
68 #include "interface/AscPrintTcl.h"
69 #include "interface/HelpProc.h"
70 #include "interface/Commands.h"
71 #include "interface/Driver.h"
72 #include "interface/ScriptProc.h"
73 #include "interface/SolverProc.h"
74 #include "interface/UnitsProc.h"
75
76 #ifndef lint
77 static CONST char DriverID[] = "$Id: Driver.c,v 1.48 2003/08/23 18:43:06 ballan Exp $";
78 #endif
79
80
81 /*
82 * The following are the environment variables ASCEND requires.
83 * If the user does not have the DIST_ENVIRONVAR set in his or her
84 * environment, a default value is set based on the directory where the
85 * ascend binary lives. The other environment variables will be set
86 * to default values keyed off of DIST_ENVIRONVAR. See the function
87 * CheckEnvironmentVars later in this file for the details.
88 */
89 #define DIST_ENVIRONVAR "ASCENDDIST"
90 #define ASCTK_ENVIRONVAR "ASCENDTK"
91 #define BITMAP_ENVIRONVAR "ASCENDBITMAPS"
92 #define LIBR_ENVIRONVAR "ASCENDLIBRARY"
93
94 /*
95 * EXPORTED VARIABLES
96 */
97
98 /**
99 * g_compiler_timing
100 *
101 * TRUE if compiler timing is to be printed.
102 * default is false, set to TRUE by passing -t on the command line
103 */
104 int g_compiler_timing = 0;
105
106 /**
107 * g_interp
108 *
109 * Interpreter for this application. We need to make it global
110 * so that our signal/floating-porint traps can access it.
111 */
112 Tcl_Interp *g_interp;
113
114 /*
115 * zz_debug
116 *
117 * Comes from the yacc file if yacc was built with debugging information
118 */
119 #ifdef ZZ_DEBUG
120 extern int zz_debug;
121 #endif
122
123
124 /*
125 * Declarations for procedures defined outside of this file.
126 */
127 extern int Tktable_Init(Tcl_Interp*);
128
129 /*
130 * Forward declarations for procedures defined later in this file.
131 */
132 static int AscDriver(int, CONST84 char * argv[]);
133 static void AscTrap(int);
134 static int AscCheckEnvironVars(Tcl_Interp*);
135 static void AscPrintHelpExit(CONST char *);
136 static int AscProcessCommandLine(Tcl_Interp*, int, CONST84 char **);
137 static void Prompt(Tcl_Interp*, int);
138 static int AscSetStartupFile(Tcl_Interp*);
139 static void StdinProc(ClientData, int);
140 #ifdef DEBUG_MALLOC
141 static void InitDebugMalloc(void);
142 #endif /* DEBUG_MALLOC */
143 #ifdef __WIN32__
144 static void setargv(int*, char ***);
145 #endif /* __WIN32__ */
146
147
148 /*
149 * LOCALLY GLOBAL VARIABLES
150 */
151
152 /*
153 * g_interface_simplify_relations
154 *
155 * TRUE for compiler optimizations
156 * default is TRUE, set to FALSE by passing +s on the command line
157 */
158 static int g_interface_simplify_relations = TRUE;
159
160 /*
161 * g_interfacever
162 *
163 * TRUE if windows to be built; default is TRUE, false is not supported
164 */
165 static int g_interfacever = 1;
166
167 /*
168 * g_command
169 *
170 * Used to assemble lines of terminal input into Tcl commands.
171 */
172 static Tcl_DString g_command;
173
174 /*
175 * g_line
176 *
177 * Used to read the next line from the terminal input.
178 */
179 static Tcl_DString g_line;
180
181 /*
182 * tty
183 *
184 * Non-zero means standard input is a terminal-like device.
185 * Zero means it's a file.
186 */
187 static int tty;
188
189 /*
190 * initScriptTclAdjust
191 * initScriptTkAdjust
192 *
193 * These two variables hold Tcl scripts that will set the TCL_LIBRARY
194 * and TK_LIBRARY environment variables if they are not already
195 * set in the user's environment.
196 * TCL_LIBRARY is set to: dirnameofexecutable/../../Tcl/lib/tcl8.0
197 * TK_LIBRARY is set to $tcl_library/../tk8.0
198 */
199 static char initScriptTclAdjust[] =
200 "proc asc_tclInit {} {\n\
201 global env\n\
202 rename asc_tclInit {}\n\
203 set errors {}\n\
204 set dirs {}\n\
205 if [info exists env(TCL_LIBRARY)] {\n\
206 return\n\
207 } else {\n\
208 set parentDir [file dirname [info nameofexecutable]]\n\
209 set env(TCL_LIBRARY) $parentDir/../../Tcl/lib/tcl8.0\n\
210 }\n\
211 }\n\
212 asc_tclInit";
213 /* for tcl, FOO/ascend4/bin/ascend4.exe is the executable, then
214 * /-- up to FOO/ascend4/bin
215 * set parentDir [file dirname [info nameofexecutable]]\n\
216 * Then if Tcl is next to ascend4, ../../Tcl/lib/tcl8.0 should work.
217 */
218
219 static char initScriptTkAdjust[] =
220 "proc asc_tkInit {} {\n\
221 global env\n\
222 rename asc_tkInit {}\n\
223 set errors {}\n\
224 set dirs {}\n\
225 if [info exists env(TK_LIBRARY)] {\n\
226 return\n\
227 } else {\n\
228 set parentDir [file dirname [info library]]\n\
229 set env(TK_LIBRARY) $parentDir/tk8.0\n\
230 }\n\
231 }\n\
232 asc_tkInit";
233 /*
234 * This assumes tcl_library has been found and that tcl8.0 and tk8.0
235 * are installed in the same lib directory -- the default tcl/tk install.
236 */
237
238 /*
239 * build_name
240 *
241 * who built this binary and when
242 */
243 #ifndef TIMESTAMP
244 static char build_name[]="by anonymous";
245 #else
246 static char build_name[]=TIMESTAMP;
247 #endif /* TIMESTAMP */
248
249
250
251 /*
252 * main or WinMain
253 *
254 * The main entry point for a Unix or Windows application.
255 *
256 * Each just calls AscDriver().
257 * These are based on functions from the Tk 8.0 distribution.
258 * See unix/tkAppInit.c and win/winMain.c in their sources.
259 */
260 #ifndef __WIN32__
261
262 int main(int argc, CONST84 char *argv[])
263 {
264 AscDriver(argc, argv);
265 return 0;
266 }
267
268 #else /* __WIN32__ */
269
270 int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance,
271 LPSTR lpszCmdLine, int nCmdShow)
272 {
273 int argc;
274 char **argv;
275 char *p;
276 char buffer[MAX_PATH];
277
278 UNUSED_PARAMETER(hInstance);
279 UNUSED_PARAMETER(hPrevInstance);
280 UNUSED_PARAMETER(lpszCmdLine);
281 UNUSED_PARAMETER(nCmdShow);
282
283 /*
284 * Set up the default locale to be standard "C" locale so parsing
285 * is performed correctly.
286 */
287 setlocale(LC_ALL, "C");
288
289 /*
290 * Increase the application queue size from default value of 8.
291 * At the default value, cross application SendMessage of WM_KILLFOCUS
292 * will fail because the handler will not be able to do a PostMessage!
293 * This is only needed for Windows 3.x, since NT dynamically expands
294 * the queue.
295 */
296 SetMessageQueue(64);
297
298 /*
299 * Create the console channels and install them as the standard
300 * channels. All I/O will be discarded until TkConsoleInit is
301 * called to attach the console to a text widget.
302 */
303
304 /*
305 * Windows expects us to parse our arguments ourselves.
306 */
307 setargv(&argc, &argv);
308
309 /*
310 * Replace argv[0] with full pathname of executable, and forward
311 * slashes substituted for backslashes.
312 */
313 GetModuleFileName(NULL, buffer, sizeof(buffer));
314 argv[0] = buffer;
315 for (p = buffer; *p != '\0'; p++) {
316 if (*p == '\\') {
317 *p = '/';
318 }
319 }
320
321 AscDriver(argc, argv);
322 return 1;
323 }
324 #endif /* __WIN32__ */
325
326
327 /*
328 * int AscDriver( argc, argv )
329 * int argc;
330 * char *argv;
331 *
332 * A common entry point for Windows and Unix. The corresponding
333 * WinMain() and main() functions just call this function.
334 *
335 * This function creates a Tcl interpreter, initializes Tcl and Tk,
336 * initializes the Ascend data structures, sets up the user's
337 * environment, sources ASCEND's startup script, and calls Tk_MainLoop
338 * so the user can interact with ASCEND. Cleans up and exits the
339 * program when Tk_MainLoop returns.
340 *
341 * This function is based on the functions Tk_Main and Tcl_AppInit
342 * from the Tk8.0 distribution. See the files tkMain.c and tkAppInit.c
343 * in the Tk sources.
344 *
345 */
346 static int AscDriver(int argc, CONST84 char *argv[])
347 {
348 Tcl_Interp *interp; /* local version of global g_interp */
349 Tcl_Channel inChannel;
350 Tcl_Channel outChannel;
351
352 /* jds20050119: Initialize ASCERR before any calls to ascPanic(). */
353 /* TODO: revisit when interface is decoupled from base - this may change. */
354 Asc_RedirectCompilerDefault();
355 #ifdef USE_ASC_PRINTF
356 Asc_PrintInit_TclVtable();
357 #endif /* USE_ASC_PRINTF */
358 /*
359 * Create the Tk Console
360 *
361 * Create the console channels and install them as the standard
362 * channels. All I/O will be discarded until TkConsoleInit() is
363 * called to attach the console to a text widget.
364 */
365 #ifdef ASC_USE_TK_CONSOLE
366 TkConsoleCreate();
367 #endif /* ASC_USE_TK_CONSOLE */
368
369 /*
370 * Find the name of the current executable---available in the
371 * Tcl command `info nameofexecutable'
372 */
373 Tcl_FindExecutable(argv[0]);
374
375 /*
376 * Create the interpreter
377 */
378 g_interp = Tcl_CreateInterp();
379 interp = g_interp;
380 if( interp == NULL ) {
381 Asc_Panic(2, "Asc_Driver",
382 "Call to Tcl_CreateInterp returned NULL interpreter");
383 }
384
385 /*
386 * Check the arguments on the command line
387 */
388 AscProcessCommandLine(interp, argc, argv);
389
390 /*
391 * Set the "tcl_interactive" variable.
392 *
393 * ASCEND sets tty to `1', since we assume ASCEND is always interactive.
394 */
395 tty = 1;
396 Tcl_SetVar(interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
397
398 /*
399 * Initialize Tcl and Tk
400 */
401 (void)Tcl_Eval(interp,initScriptTclAdjust);
402 if (Tcl_Init(interp) == TCL_ERROR) {
403 Asc_Panic(2, "Asc_Driver", "Tcl initialization failed:\n%s",
404 Tcl_GetStringResult(interp));
405 }
406 (void)Tcl_Eval(interp,initScriptTkAdjust);
407 if (Tk_Init(interp) == TCL_ERROR) {
408 Asc_Panic(2, "Asc_Driver", "Tk initialization failed:\n%s",
409 Tcl_GetStringResult(interp));
410 }
411 Tcl_StaticPackage( interp, "Tk", Tk_Init, Tk_SafeInit );
412
413 /*
414 * Initialize the console and the ASCEND printf() substitutes.
415 * All output before this point is lost.
416 */
417 #ifdef ASC_USE_TK_CONSOLE
418 if (TkConsoleInit(interp) == TCL_ERROR) {
419 Asc_Panic(2, "Asc_Driver",
420 "Call to TkConsoleInit failed:\n%s",
421 Tcl_GetStringResult(interp));
422 }
423 #endif /* ASC_USE_TK_CONSOLE */
424 #ifdef USE_ASC_PRINTF
425 Asc_PrintInit_Tcl();
426 #endif /* USE_ASC_PRINTF */
427
428 /*
429 * Now that our console and printing functions are properly
430 * initialized, print our startup banner.
431 */
432 PRINTF("ASCEND VERSION IV\n");
433 PRINTF("Compiler Implemention Version: 2.0\n");
434 PRINTF("Written by Tom Epperly, Kirk Abbott, and Ben Allan\n");
435 PRINTF(" Built: %s %s %s\n",__DATE__,__TIME__,build_name);
436 PRINTF("Copyright(C) 1990, 1993, 1994 Thomas Guthrie Epperly\n");
437 PRINTF("Copyright(C) 1993-1996 Kirk Andre Abbott, Ben Allan\n");
438 PRINTF("Copyright(C) 1997 Carnegie Mellon University\n");
439
440 /*
441 * Call the init procedures for included packages.
442 */
443 #ifdef STATIC_TKTABLE
444 if( Tktable_Init(interp) == TCL_ERROR ) {
445 Asc_Panic(2, "Asc_Driver",
446 "Call to Tktable_Init failed:\n%s",
447 Tcl_GetStringResult(interp));
448 }
449 #endif /* STATIC_TKTABLE */
450
451 /*
452 * Initialize ASCEND C Structures
453 * Create ASCEND Tcl Commands
454 */
455 clock();
456 /* the next line should NOT be Asc_SignalHandlerPush */
457 (void)signal(SIGINT, AscTrap);
458 #ifdef DEBUG_MALLOC
459 InitDebugMalloc();
460 ascstatus("Memory status after calling InitDebugMalloc()");
461 #endif /* DEBUG_MALLOC */
462 if ( Asc_CompilerInit(g_interface_simplify_relations) != 0 ) {
463 Asc_Panic(2, "Asc_CompilerInit",
464 "Insufficient memory to initialize compiler.");
465 }
466 SlvRegisterStandardClients();
467 if( Asc_HelpInit() == TCL_ERROR ) {
468 Asc_Panic(2, "Asc_HelpInit",
469 "Insufficient memory to initialize help system.");
470 }
471 Asc_CreateCommands(interp);
472 Asc_RegisterBitmaps(interp);
473
474 /*
475 * Set the environment, and set find the
476 * location of ASCEND's startup file.
477 */
478 AscCheckEnvironVars(interp);
479 if( AscSetStartupFile(interp) != TCL_OK ) {
480 Asc_Panic(2, "Asc_Driver",
481 "Cannot find ~/.ascendrc nor the default AscendRC\n%s",
482 Tcl_GetStringResult(interp));
483 }
484
485 /*
486 * Evaluate the ~/.ascendrc or $ASCENDTK/AscendRC file
487 */
488 Tcl_SourceRCFile(interp);
489
490 /*
491 * Establish a channel handlers for stdin and stdout
492 */
493 inChannel = Tcl_GetStdChannel(TCL_STDIN);
494 if (inChannel) {
495 Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
496 (ClientData) inChannel);
497 }
498 if (tty) {
499 Prompt(interp, 0);
500 }
501 outChannel = Tcl_GetStdChannel(TCL_STDOUT);
502 if (outChannel) {
503 Tcl_Flush(outChannel);
504 }
505
506 /*
507 * Initialize the Dynamic Strings used in StdinProc()
508 */
509 Tcl_DStringInit(&g_command);
510 Tcl_DStringInit(&g_line);
511 Tcl_ResetResult(interp);
512
513 /*
514 * Loop infinitely, waiting for commands to execute. When there
515 * are no windows left, Tk_MainLoop returns and we exit.
516 */
517 #ifdef DEBUG_MALLOC
518 ascstatus("Memory status before calling Tk_MainLoop()");
519 #endif /* DEBUG_MALLOC */
520 if (Asc_ScriptConfigureInterrupt(1,interp)!=0) {
521 Asc_Panic(2, "Asc_ScriptConfigureInterrupt",
522 "Unable to configure script interrupt.");
523 }
524 Tk_MainLoop();
525 Asc_ScriptConfigureInterrupt(0,interp);
526 #ifdef USE_ASC_PRINTF
527 Asc_PrintFinalize_Tcl();
528 #endif /* USE_ASC_PRINTF */
529 #ifdef DEBUG_MALLOC
530 ascstatus("Memory status after Tk_MainLoop() exits");
531 #endif /* DEBUG_MALLOC */
532
533 /*
534 * Do ASCEND Cleanup
535 */
536 Asc_HelpDestroy();
537 Asc_UnitValue(NULL);
538 Asc_SolvMemoryCleanup();
539 Asc_CompilerDestroy();
540 Asc_DestroyEnvironment();
541 #ifdef DEBUG_MALLOC
542 ascshutdown("Memory status just before exiting");
543 #endif /* DEBUG_MALLOC */
544
545 /*
546 * Destroy the interpreter and exit
547 */
548 Tcl_DeleteInterp(interp);
549 Tcl_Exit(0);
550 return 0;
551 }
552
553
554 /*
555 *-----------------------------------------------------------------
556 * int AscCheckEnvironVars(interp)
557 * Tcl_Interp *interp;
558 *
559 * This function checks the following environment variables and sets them
560 * to the default value if they are not set. This function will set
561 * DIST_ENVIRONVAR to the parent of the directory where the ASCEND binary
562 * lives if it is not set, e.g., if the ascend binary is
563 * /foo/bar/ascend4
564 * DIST_ENVIRONVAR is set to "/foo".
565 *
566 * We check to see if ASCTK_ENVIRONVAR points to the proper place by
567 * looking for the ASCEND startup script "AscendRC". If we find it, set
568 * the Tcl variable tcl_rcFileName to its location, otherwise, call
569 * Asc_Panic() to exit.
570 *
571 * Returns a standard Tcl return code.
572 *
573 * CPP_MACRO ENVIRONMENT VAR DEFAULT VALUE
574 * ================= =============== =============
575 * DIST_ENVIRONVAR ASCENDDIST parent of binary's directory
576 * AWW20041208: ASCTK_ENVIRONVAR ASCENDTK ASCENDDIST/TK
577 * ASCTK_ENVIRONVAR ASCENDTK ASCENDDIST/TK
578 * BITMAP_ENVIRONVAR ASCENDBITMAPS ASCENDTK/bitmaps
579 * LIBR_ENVIRONVAR ASCENDLIBRARY
580 * AWW20041209: .:ASCENDDIST/models/libraries:ASCENDDIST/models/examples
581 * .:ASCENDDIST/../../models
582 *
583 */
584 static int AscCheckEnvironVars(Tcl_Interp *interp)
585 {
586 char *tmpenv; /* holds values returned by Asc_GetEnv() */
587 Tcl_DString ascenddist; /* holds the value of DIST_ENVIRONVAR */
588 Tcl_DString buffer2; /* used to incrementally build environment
589 * variable values
590 */
591 Tcl_DString buffer1; /* holds the environment variable value in the
592 * native format: result of passing buffer2
593 * into Tcl_TranslateFileName()
594 */
595 Tcl_Channel c; /* used to test if file exists */
596
597 /* initialize */
598 Tcl_DStringInit(&ascenddist);
599 Tcl_DStringInit(&buffer1);
600 Tcl_DStringInit(&buffer2);
601
602 /*
603 * Get the value of the ASCENDDIST environment variable;
604 * if not set, set it to the parent of the directory containing
605 * the ascend binary. For example, if the ascend binary is
606 * /foo/bar/bin/ascend4, set ASCENDDIST to /foo/bar
607 * If Tcl doesn't know where we are---the Tcl command
608 * `info nameofexecutable' returns ""---then ASCENDDIST is set
609 * to "."
610 */
611 if( Asc_ImportPathList(DIST_ENVIRONVAR) == 0 ) {
612 if( (tmpenv = Asc_GetEnv(DIST_ENVIRONVAR)) == NULL ) {
613 /* shouldn't be NULL since we just imported it successfully */
614 Asc_Panic(2, "CheckEnvironmentVars",
615 "Asc_GetEnv(%s) returned NULL value.", DIST_ENVIRONVAR);
616 }
617 Tcl_DStringAppend(&ascenddist, tmpenv, -1);
618 ascfree(tmpenv);
619 } else {
620 char cmd[] =
621 "file nativename [file dirname [file dirname [info nameofexecutable]]]";
622 if( Tcl_Eval(interp, cmd) == TCL_OK ) {
623 Tcl_DStringGetResult(interp, &ascenddist);
624 if(Asc_SetPathList(DIST_ENVIRONVAR,Tcl_DStringValue(&ascenddist)) != 0) {
625 Asc_Panic(2, "AscCheckEnvironVars",
626 "Asc_SetPathList() returned Nonzero: "
627 "Not enough memory to extend the environment");
628 }
629 }
630 }
631 /* Make sure the Tcl side can also see this variable */
632 Tcl_SetVar2(interp, "env", DIST_ENVIRONVAR,
633 Tcl_DStringValue(&ascenddist), TCL_GLOBAL_ONLY);
634
635 /*
636 * If the user's environment does not have ASCENDLIBRARY set, then set
637 * it to a reasonable default.
638 */
639 if( Asc_ImportPathList(LIBR_ENVIRONVAR) == 0 ) {
640 if( (tmpenv = Asc_GetEnv(LIBR_ENVIRONVAR)) == NULL ) {
641 /* shouldn't be NULL since we just imported it successfully */
642 Asc_Panic(2, "CheckEnvironmentVars",
643 "Asc_GetEnv(%s) returned NULL value.", LIBR_ENVIRONVAR);
644 }
645 /* Make sure the Tcl side can also see this variable */
646 Tcl_SetVar2(interp, "env", LIBR_ENVIRONVAR, tmpenv, TCL_GLOBAL_ONLY);
647 ascfree(tmpenv);
648 } else {
649 /* Add ``.'' to the ASCENDLIBRARY envar */
650 if( Asc_SetPathList(LIBR_ENVIRONVAR, ".") != 0 ) {
651 Asc_Panic(2, "AscCheckEnvironVars",
652 "Asc_SetPathList() returned Nonzero: "
653 "Not enough memory to extend the environment");
654 }
655
656 /*AWW20041209: Add ``$ASCENDDIST/models'' to the ASCENDLIBRARY envar */
657 /* Add ``$ASCENDDIST/../../models'' to the ASCENDLIBRARY envar */
658 Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&ascenddist), -1);
659 Tcl_DStringAppend(&buffer2, "/models", -1);
660 /* Tcl_DStringAppend(&buffer2, "/../../models", -1); AWW */
661 if( NULL != (Tcl_TranslateFileName(interp, Tcl_DStringValue(&buffer2),
662 &buffer1))) {
663 if(Asc_AppendPath(LIBR_ENVIRONVAR, Tcl_DStringValue(&buffer1)) != 0) {
664 Asc_Panic(2, "AscCheckEnvironVars",
665 "Asc_AppendPath() returned Nonzero: "
666 "Not enough memory to extend the environment");
667 }
668 Tcl_DStringFree(&buffer1);
669 }
670 Tcl_DStringFree(&buffer2);
671
672 /* Add ``$ASCENDDIST/models/examples'' to the ASCENDLIBRARY envar */
673 /*AWW20041209 - remove all this:
674 Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&ascenddist), -1);
675 Tcl_DStringAppend(&buffer2, "/models/examples", -1);
676 if( NULL != (Tcl_TranslateFileName(interp, Tcl_DStringValue(&buffer2),
677 &buffer1))) {
678 if(Asc_AppendPath(LIBR_ENVIRONVAR, Tcl_DStringValue(&buffer1)) != 0) {
679 Asc_Panic(2, "AscCheckEnvironVars",
680 "Asc_AppendPath() returned Nonzero: "
681 "Not enough memory to extend the environment");
682 }
683 Tcl_DStringFree(&buffer1);
684 }
685 Tcl_DStringFree(&buffer2);
686 */
687 /* Add ``$ASCENDDIST/models/libraries'' to the ASCENDLIBRARY envar */
688 /* Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&ascenddist), -1);
689 Tcl_DStringAppend(&buffer2, "/models/libraries", -1);
690 if( NULL != (Tcl_TranslateFileName(interp, Tcl_DStringValue(&buffer2),
691 &buffer1))) {
692 if(Asc_AppendPath(LIBR_ENVIRONVAR, Tcl_DStringValue(&buffer1)) != 0) {
693 Asc_Panic(2, "AscCheckEnvironVars",
694 "Asc_AppendPath() returned Nonzero: "
695 "Not enough memory to extend the environment");
696 }
697 Tcl_DStringFree(&buffer1);
698 }
699 Tcl_DStringFree(&buffer2);
700
701 up to here */
702
703 /* Get the full value of the environment variable and set
704 * $env(ASCENDLIBRARY) in the Tcl code
705 */
706 if( (tmpenv = Asc_GetEnv(LIBR_ENVIRONVAR)) == NULL ) {
707 /* shouldn't be NULL since we just set it. memory error! */
708 Asc_Panic(2, "CheckEnvironmentVars",
709 "Asc_GetEnv(%s) returned NULL value.", LIBR_ENVIRONVAR);
710 }
711 /* Make sure the Tcl side can also see this variable */
712 Tcl_SetVar2(interp, "env", LIBR_ENVIRONVAR, tmpenv, TCL_GLOBAL_ONLY);
713 ascfree(tmpenv);
714 }
715
716 /*
717 * If the user's environment does not have ASCENDTK set, then set it
718 * by appending `TK' to ASCENDDIST. Later in this function, we check
719 * to make sure it is a valid directory by checking for the existence
720 * of `AscendRC' in that directory.
721 */
722 if( Asc_ImportPathList(ASCTK_ENVIRONVAR) == 0 ) {
723 if( (tmpenv = Asc_GetEnv(ASCTK_ENVIRONVAR)) == NULL ) {
724 /* shouldn't be NULL since we just imported it successfully */
725 Asc_Panic(2, "CheckEnvironmentVars",
726 "Asc_GetEnv(%s) returned NULL value.", ASCTK_ENVIRONVAR);
727 }
728 /* store ASCENDTK in ``buffer1'' so we can check for ASCENDTK/AscendRC
729 * below
730 */
731 Tcl_DStringAppend(&buffer1, tmpenv, -1);
732 ascfree(tmpenv);
733 } else {
734 Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&ascenddist), -1);
735 /* AWW20041208: Tcl_DStringAppend(&buffer2, "/TK", -1);
736 */
737 Tcl_DStringAppend(&buffer2, "/TK", -1);
738 if(NULL != (Tcl_TranslateFileName(interp, Tcl_DStringValue(&buffer2),
739 &buffer1))) {
740 if( Asc_SetPathList(ASCTK_ENVIRONVAR, Tcl_DStringValue(&buffer1)) != 0) {
741 Asc_Panic(2, "Asc_EnvironmentInit",
742 "Not enough memory to initialize the environment");
743 }
744 }
745 Tcl_DStringFree(&buffer2);
746 }
747 /* Make sure the Tcl side can also see this variable */
748 Tcl_SetVar2(interp, "env", ASCTK_ENVIRONVAR,
749 Tcl_DStringValue(&buffer1), TCL_GLOBAL_ONLY);
750
751 /*
752 * Check to see if ASCENDTK looks reasonable by checking
753 * for ASCENDTK/AscendRC We use the Tcl channel
754 * mechanism to see if file exists.
755 */
756 Tcl_DStringAppend(&buffer1, "/AscendRC", -1 );
757 c = Tcl_OpenFileChannel( NULL, Tcl_DStringValue(&buffer1), "r", 0 );
758 if( c != (Tcl_Channel)NULL ) {
759 /*
760 * file exists. close the channel and set tcl_rcfilename to
761 * this location
762 */
763 Tcl_Close( NULL, c );
764 Tcl_SetVar(interp, "tcl_rcFileName", Tcl_DStringValue(&buffer1),
765 TCL_GLOBAL_ONLY);
766 } else {
767 Asc_Panic(2, "AscCheckEnvironVars",
768 "ERROR: Cannot find the file \"%s\" in the subdirectory \"TK\"\n"
769 "under the directory \"%s\"\n"
770 "Please check the value of the environment variables %s and\n"
771 "and %s and start ASCEND again.\n",
772 "AscendRC", Tcl_DStringValue(&ascenddist), DIST_ENVIRONVAR,
773 ASCTK_ENVIRONVAR);
774 }
775 Tcl_DStringFree(&buffer1);
776
777 /*
778 * If the user's environment does not have ASCENDBITMAPS set, then set
779 * it by appending `bitmaps' to ASCENDTK.
780 */
781 if( Asc_ImportPathList(BITMAP_ENVIRONVAR) == 0 ) {
782 if( (tmpenv = Asc_GetEnv(BITMAP_ENVIRONVAR)) == NULL ) {
783 /* shouldn't be NULL since we just imported it successfully */
784 Asc_Panic(2, "CheckEnvironmentVars",
785 "Asc_GetEnv(%s) returned NULL value.", BITMAP_ENVIRONVAR);
786 }
787 /* Make sure the Tcl side can also see this variable */
788 Tcl_SetVar2(interp, "env", BITMAP_ENVIRONVAR, tmpenv, TCL_GLOBAL_ONLY);
789 ascfree(tmpenv);
790 } else {
791 Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&ascenddist), -1);
792 Tcl_DStringAppend(&buffer2, "/TK/bitmaps", -1);
793 if(NULL != (Tcl_TranslateFileName(interp, Tcl_DStringValue(&buffer2),
794 &buffer1))) {
795 if(Asc_SetPathList(BITMAP_ENVIRONVAR, Tcl_DStringValue(&buffer1)) != 0) {
796 Asc_Panic(2, "Asc_EnvironmentInit",
797 "Not enough memory to initialize the environment");
798 }
799 }
800 Tcl_DStringFree(&buffer2);
801 /* Make sure the Tcl side can also see this variable */
802 Tcl_SetVar2(interp, "env", BITMAP_ENVIRONVAR,
803 Tcl_DStringValue(&buffer1), TCL_GLOBAL_ONLY);
804 Tcl_DStringFree(&buffer1);
805 }
806
807 /* Cleanup */
808 Tcl_DStringFree(&ascenddist);
809
810 return TCL_OK;
811 }
812
813
814 /*
815 * int AscSetStartupFile(interp)
816 * Tcl_Interp *interp;
817 *
818 * Look for ~/.ascendrc; if found, set the Tcl variable tcl_rcFileName
819 * to this file's location. This overrides the value set in
820 * AscCheckEnvironVars().
821 * If ~/_ascendrc is available it only gets used if ~/.ascendrc is not.
822 * Returns a standard Tcl return code.
823 */
824 static int AscSetStartupFile(Tcl_Interp *interp)
825 {
826 char *fullname; /* try to find this if first fails */
827 Tcl_DString buffer;
828 Tcl_Channel c; /* used to check for file existance */
829
830 Tcl_ResetResult(interp);
831
832 fullname = Tcl_TranslateFileName( interp, "~/.ascendrc", &buffer );
833 if( fullname != NULL ) {
834 /*
835 * Use the Tcl file channel routines to determine if ~/.ascendrc
836 * exists. We cannot use access() since Windows doesn't use it.
837 */
838 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
839 if( c != (Tcl_Channel)NULL ) {
840 /* file exists. close the channel and set tcl_rcFileName. */
841 Tcl_Close( NULL, c );
842 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
843 Tcl_DStringFree(&buffer);
844 return TCL_OK;
845 }
846 Tcl_DStringFree(&buffer);
847 }
848 fullname = Tcl_TranslateFileName( interp, "~/_ascendrc", &buffer );
849 if( fullname != NULL ) {
850 /*
851 * Use the Tcl file channel routines to determine if ~/_ascendrc
852 * exists. We cannot use access() since Windows doesn't use it.
853 */
854 c = Tcl_OpenFileChannel( NULL, fullname, "r", 0 );
855 if( c != (Tcl_Channel)NULL ) {
856 /* file exists. close the channel and set tcl_rcFileName */
857 Tcl_Close( NULL, c );
858 Tcl_SetVar(interp, "tcl_rcFileName", fullname, TCL_GLOBAL_ONLY);
859 Tcl_DStringFree(&buffer);
860 return TCL_OK;
861 }
862 Tcl_DStringFree(&buffer);
863 }
864 return TCL_OK; /* probably should be TCL_ERROR */
865 }
866
867
868
869 /*
870 * file = AscProcessCommandLine(argc, argv)
871 * char *file;
872 * int argc;
873 * char *argv[];
874 *
875 * Process the options given on the command line `argv' where `argc' is
876 * the length of argv.
877 *
878 * Strip out ASCEND specific flags and then pass the rest to Tcl so it
879 * can set what it needs.
880 *
881 * This function may call exit() if the user requests help.
882 */
883 static int AscProcessCommandLine(Tcl_Interp *interp, int argc, CONST84 char **argv)
884 {
885 int i;
886 int flag; /* set to 1 for `+arg', -1 for `-arg' */
887 size_t length; /* length of an argv */
888 char *args;
889 char buf[MAXIMUM_NUMERIC_LENGTH]; /* space for integer->string conversion */
890 int new_argc = 0; /* the argc we will pass to Tcl */
891 #ifdef ZZ_DEBUG
892 zz_debug = 0; /* nonzero to print parser debugging info*/
893 #endif
894
895 for( i = 1; i < argc; i++ ) {
896 if( (length = strlen(argv[i])) == 0 ) {
897 /* ignore 0-length arguments */
898 continue;
899 }
900
901 if(( length >= 2 ) && ( strncmp(argv[i],"-h",2) == 0 )) {
902 AscPrintHelpExit(argv[0]);
903 }
904 if(( length >= 2 ) && ( strncmp(argv[i],"-H",2) == 0 )) {
905 AscPrintHelpExit(argv[0]);
906 }
907 if(( length >= 4 ) && ( strncmp(argv[i],"help",4) == 0 )) {
908 AscPrintHelpExit(argv[0]);
909 }
910
911 if( argv[i][0] == '-' ) {
912 flag = -1;
913 } else if( argv[i][0] == '+' ) {
914 flag = 1;
915 } else {
916 flag = 0;
917 }
918
919 if(( length == 2 ) && ( flag != 0 )) {
920 switch( argv[i][1] ) {
921 case 'd':
922 /* '-d' turns on scanner debugging (if ascend was built with it)
923 * '+d' turns off scanner debugging [default]
924 */
925 if( flag == -1 ) {
926 #ifdef ZZ_DEBUG
927 zz_debug = 1;
928 } else {
929 zz_debug = 0;
930 #else
931 FPRINTF(ASCERR, "Sorry, %s wasn't compiled with %s defined.\n",
932 argv[0], "ZZ_DEBUG");
933 #endif /* ZZ_DEBUG */
934 }
935 break;
936 case 's':
937 /* '-s' turns on compiler optimizations [default]
938 * '+s' turns off compiler optimizations
939 */
940 if( flag == -1 ) {
941 g_interface_simplify_relations = 1;
942 } else {
943 g_interface_simplify_relations = 0;
944 }
945 break;
946 case 't':
947 /* '-t' turns on timing of compiler optimizations
948 * '+t' turns off timing of compiler optimizations [default]
949 */
950 if( flag == 0 ) {
951 g_compiler_timing = 1;
952 } else {
953 g_compiler_timing = 0;
954 }
955 break;
956 case 'c':
957 case 'g':
958 fprintf(ASCERR, "WARNING! Obsolete ASCEND option \"%s\"\n", argv[i]);
959 break;
960 default:
961 /* unknown ASCEND option, pass it on to Tcl
962 */
963 argv[++new_argc] = argv[i];
964 break;
965 }
966 } else {
967 /* unknown ASCEND option, pass it on to Tcl
968 */
969 argv[++new_argc] = argv[i];
970 }
971 }
972
973 /*
974 * Make command-line arguments available in the Tcl variables "argc"
975 * and "argv".
976 */
977 args = Tcl_Merge(new_argc, (argv+1));
978 Tcl_SetVar(interp, "argv", args, TCL_GLOBAL_ONLY);
979 ckfree(args);
980 sprintf(buf, "%d", new_argc);
981 Tcl_SetVar(interp, "argc", buf, TCL_GLOBAL_ONLY);
982 Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
983
984 return TCL_OK;
985 }
986
987
988 /*
989 * AscPrintHelpExit(invoke_name)
990 * CONST char *invoke_name;
991 *
992 * Print a help message and exit. Use invoke_name as the name of
993 * the binary
994 */
995 static
996 void AscPrintHelpExit(CONST char *invoke_name)
997 {
998 PRINTF("usage: %s [options]\n"
999 "\n"
1000 "where options include [default value]:\n"
1001 " -h print this message\n"
1002 " -/+d turn on/off yacc debugging [off]\n"
1003 " -/+s turn on/off compiler optimizations [on]\n"
1004 " -/+t turn on/off timing of compiler operations [off]\n",
1005 invoke_name);
1006 Tcl_Exit(0); /* Show this help message and leave */
1007 }
1008
1009
1010 /*
1011 * AscTrap(sig)
1012 * int sig;
1013 *
1014 * Function to call when we receive an interrupt.
1015 */
1016 static
1017 void AscTrap(int sig)
1018 {
1019 putchar('\n');
1020 Asc_Panic(sig, "AscTrap", "Caught Signal: %d", sig);
1021 }
1022
1023
1024 /*
1025 * See this file's header for documentation.
1026 */
1027 int Asc_LoadWin(ClientData cdata, Tcl_Interp *interp,
1028 int argc, CONST84 char *argv[])
1029 {
1030 (void)cdata; /* stop gcc whine about unused parameter */
1031 (void)argv; /* stop gcc whine about unused parameter */
1032
1033 if ( argc != 1 ) {
1034 FPRINTF(stderr,"call is: ascloadwin <no args> \n");
1035 return TCL_ERROR;
1036 }
1037 if (g_interfacever) {
1038 Tcl_SetResult(interp, "1", TCL_STATIC);
1039 } else {
1040 Tcl_SetResult(interp, "0", TCL_STATIC);
1041 }
1042 return TCL_OK;
1043 }
1044
1045
1046 /*
1047 *----------------------------------------------------------------------
1048 *----------------------------------------------------------------------
1049 * The following StdinProc() and Prompt() are from tkMain.c in
1050 * the Tk4.1 distribution (and did not change in Tk8.0).
1051 *----------------------------------------------------------------------
1052 *----------------------------------------------------------------------
1053 */
1054 /*
1055 *----------------------------------------------------------------------
1056 *
1057 * StdinProc --
1058 *
1059 * This procedure is invoked by the event dispatcher whenever
1060 * standard input becomes readable. It grabs the next line of
1061 * input characters, adds them to a command being assembled, and
1062 * executes the command if it's complete.
1063 *
1064 * Results:
1065 * None.
1066 *
1067 * Side effects:
1068 * Could be almost arbitrary, depending on the command that's
1069 * typed.
1070 *
1071 *----------------------------------------------------------------------
1072 */
1073
1074 /* ARGSUSED */
1075 static void
1076 StdinProc(clientData, mask)
1077 ClientData clientData; /* Not used. */
1078 int mask; /* Not used. */
1079 {
1080 static int gotPartial = 0;
1081 char *cmd;
1082 int code, count;
1083 Tcl_Channel chan = (Tcl_Channel) clientData;
1084
1085 Tcl_Interp *interp = g_interp; /* use a local copy of the
1086 * global tcl interpreter
1087 */
1088
1089 (void)clientData; /* stop gcc whine about unused parameter */
1090 (void)mask; /* stop gcc whine about unused parameter */
1091
1092 count = Tcl_Gets(chan, &g_line);
1093
1094 if (count < 0) {
1095 if (!gotPartial) {
1096 if (tty) {
1097 return;
1098 } else {
1099 Tcl_DeleteChannelHandler(chan, StdinProc, (ClientData) chan);
1100 }
1101 return;
1102 } else {
1103 count = 0;
1104 }
1105 }
1106
1107 (void) Tcl_DStringAppend(&g_command, Tcl_DStringValue(&g_line), -1);
1108 cmd = Tcl_DStringAppend(&g_command, "\n", -1);
1109 Tcl_DStringFree(&g_line);
1110
1111 if (!Tcl_CommandComplete(cmd)) {
1112 gotPartial = 1;
1113 goto prompt;
1114 }
1115 gotPartial = 0;
1116
1117 /*
1118 * Disable the stdin channel handler while evaluating the command;
1119 * otherwise if the command re-enters the event loop we might
1120 * process commands from stdin before the current command is
1121 * finished. Among other things, this will trash the text of the
1122 * command being evaluated.
1123 */
1124
1125 Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
1126 code = Tcl_RecordAndEval(interp, cmd, TCL_EVAL_GLOBAL);
1127 Tcl_CreateChannelHandler(chan, TCL_READABLE, StdinProc,
1128 (ClientData) chan);
1129 Tcl_DStringFree(&g_command);
1130 if (*interp->result != 0) {
1131 if ((code != TCL_OK) || (tty)) {
1132 /*
1133 * The statement below used to call "printf", but that resulted
1134 * in core dumps under Solaris 2.3 if the result was very long.
1135 *
1136 * NOTE: This probably will not work under Windows either.
1137 */
1138
1139 puts(interp->result);
1140 }
1141 }
1142
1143 /*
1144 * Output a prompt.
1145 */
1146
1147 prompt:
1148 if (tty) {
1149 Prompt(interp, gotPartial);
1150 }
1151 Tcl_ResetResult(interp);
1152 }
1153
1154 /*
1155 *----------------------------------------------------------------------
1156 *
1157 * Prompt --
1158 *
1159 * Issue a prompt on standard output, or invoke a script
1160 * to issue the prompt.
1161 *
1162 * Results:
1163 * None.
1164 *
1165 * Side effects:
1166 * A prompt gets output, and a Tcl script may be evaluated
1167 * in interp.
1168 *
1169 *----------------------------------------------------------------------
1170 */
1171
1172 static void
1173 Prompt(interp, partial)
1174 Tcl_Interp *interp; /* Interpreter to use for prompting. */
1175 int partial; /* Non-zero means there already
1176 * exists a partial command, so use
1177 * the secondary prompt. */
1178 {
1179 CONST84 char *promptCmd;
1180 int code;
1181 Tcl_Channel outChannel, errChannel;
1182 CONST84 char *subPrompt;
1183
1184 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1185
1186 subPrompt = (partial ? "tcl_prompt2" : "tcl_prompt1");
1187 promptCmd = Tcl_GetVar(interp, subPrompt, TCL_GLOBAL_ONLY);
1188 if (promptCmd == NULL) {
1189 defaultPrompt:
1190
1191 /*
1192 * We must check that outChannel is a real channel - it
1193 * is possible that someone has transferred stdout out of
1194 * this interpreter with "interp transfer".
1195 */
1196
1197 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1198 if (outChannel != (Tcl_Channel) NULL) {
1199 if (!partial) {
1200 Tcl_Write(outChannel, "AscendIV% ", 10);
1201 } else {
1202 Tcl_Write(outChannel, "more? ", 6);
1203 }
1204 }
1205 } else {
1206 code = Tcl_Eval(interp, promptCmd);
1207 if (code != TCL_OK) {
1208 Tcl_AddErrorInfo(interp,
1209 "\n (script that generates prompt)");
1210 /*
1211 * We must check that errChannel is a real channel - it
1212 * is possible that someone has transferred stderr out of
1213 * this interpreter with "interp transfer".
1214 */
1215
1216 errChannel = Tcl_GetChannel(interp, "stderr", NULL);
1217 if (errChannel != (Tcl_Channel) NULL) {
1218 Tcl_Write(errChannel, interp->result, -1);
1219 Tcl_Write(errChannel, "\n", 1);
1220 }
1221 goto defaultPrompt;
1222 }
1223 }
1224 outChannel = Tcl_GetChannel(interp, "stdout", NULL);
1225 if (outChannel != (Tcl_Channel) NULL) {
1226 Tcl_Flush(outChannel);
1227 }
1228 }
1229
1230 /*
1231 *----------------------------------------------------------------------
1232 * Tom Epperly's Malloc Debugger
1233 *----------------------------------------------------------------------
1234 */
1235 #ifdef DEBUG_MALLOC
1236 static void InitDebugMalloc(void)
1237 {
1238 union dbmalloptarg m;
1239 m.str = NULL;
1240 m.i = 0;
1241 dbmallopt(MALLOC_CKDATA,&m);
1242 }
1243
1244 int Asc_DebugMallocCmd(ClientData cdata, Tcl_Interp *interp,
1245 int argc, CONST84 char *argv[])
1246 {
1247 union dbmalloptarg m;
1248
1249 if ( argc != 2 ) {
1250 Tcl_SetResult(interp, "wrong # args : Usage __dbmalloc ?on?off?",
1251 TCL_STATIC);
1252 return TCL_ERROR;
1253 }
1254 m.str = NULL;
1255 if (strcmp(argv[1],"on")==0) {
1256 m.i = 1;
1257 } else if (strcmp(argv[1],"off")==0) {
1258 m.i = 0;
1259 } else {
1260 Tcl_SetResult(interp, "incorrect args : should be \"on\" or \"off\"",
1261 TCL_STATIC);
1262 return TCL_ERROR;
1263 }
1264 dbmallopt(MALLOC_CKDATA,&m); /* turn on str* mem* and b* checking */
1265 return TCL_OK;
1266 }
1267 #endif /* DEBUG_MALLOC */
1268
1269 #ifdef __WIN32__
1270 /*
1271 *-------------------------------------------------------------------------
1272 *
1273 * setargv --
1274 *
1275 * Parse the Windows command line string into argc/argv. Done here
1276 * because we don't trust the builtin argument parser in crt0.
1277 * Windows applications are responsible for breaking their command
1278 * line into arguments.
1279 *
1280 * 2N backslashes + quote -> N backslashes + begin quoted string
1281 * 2N + 1 backslashes + quote -> literal
1282 * N backslashes + non-quote -> literal
1283 * quote + quote in a quoted string -> single quote
1284 * quote + quote not in quoted string -> empty string
1285 * quote -> begin quoted string
1286 *
1287 * Results:
1288 * Fills argcPtr with the number of arguments and argvPtr with the
1289 * array of arguments.
1290 *
1291 * Side effects:
1292 * Memory allocated.
1293 *
1294 * This function is from the Tk 8.0 distribution. See win/winMain.c in
1295 * their sources.
1296 *
1297 *--------------------------------------------------------------------------
1298 */
1299 static void
1300 setargv(argcPtr, argvPtr)
1301 int *argcPtr; /* Filled with number of argument strings. */
1302 char ***argvPtr; /* Filled with argument strings (malloc'd). */
1303 {
1304 char *cmdLine, *p, *arg, *argSpace;
1305 char **argv;
1306 int argc, size, inquote, copy, slashes;
1307
1308 cmdLine = GetCommandLine();
1309
1310 /*
1311 * Precompute an overly pessimistic guess at the number of arguments
1312 * in the command line by counting non-space spans.
1313 */
1314
1315 size = 2;
1316 for (p = cmdLine; *p != '\0'; p++) {
1317 if (isspace(*p)) {
1318 size++;
1319 while (isspace(*p)) {
1320 p++;
1321 }
1322 if (*p == '\0') {
1323 break;
1324 }
1325 }
1326 }
1327 argSpace = (char *) ckalloc((unsigned) (size * sizeof(char *)
1328 + strlen(cmdLine) + 1));
1329 argv = (char **) argSpace;
1330 argSpace += size * sizeof(char *);
1331 size--;
1332
1333 p = cmdLine;
1334 for (argc = 0; argc < size; argc++) {
1335 argv[argc] = arg = argSpace;
1336 while (isspace(*p)) {
1337 p++;
1338 }
1339 if (*p == '\0') {
1340 break;
1341 }
1342
1343 inquote = 0;
1344 slashes = 0;
1345 while (1) {
1346 copy = 1;
1347 while (*p == '\\') {
1348 slashes++;
1349 p++;
1350 }
1351 if (*p == '"') {
1352 if ((slashes & 1) == 0) {
1353 copy = 0;
1354 if ((inquote) && (p[1] == '"')) {
1355 p++;
1356 copy = 1;
1357 } else {
1358 inquote = !inquote;
1359 }
1360 }
1361 slashes >>= 1;
1362 }
1363
1364 while (slashes) {
1365 *arg = '\\';
1366 arg++;
1367 slashes--;
1368 }
1369
1370 if ((*p == '\0') || (!inquote && isspace(*p))) {
1371 break;
1372 }
1373 if (copy != 0) {
1374 *arg = *p;
1375 arg++;
1376 }
1377 p++;
1378 }
1379 *arg = '\0';
1380 argSpace = arg + 1;
1381 }
1382 argv[argc] = NULL;
1383
1384 *argcPtr = argc;
1385 *argvPtr = argv;
1386 }
1387
1388 #endif /* __WIN32__ */

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