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

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