/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclmain.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclmain.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclmain.c revision 44 by dashley, Fri Oct 14 02:09:58 2016 UTC projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclmain.c revision 98 by dashley, Sun Dec 18 00:57:31 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclmain.c,v 1.2 2001/10/07 01:32:29 dtashley Exp $ */  
   
 /* IJS_SM_FILE_PUBLIC */  
   
 /*  
  * tclMain.c --  
  *  
  *      Main program for Tcl shells and other Tcl-based applications.  
  *  
  * Copyright (c) 1988-1994 The Regents of the University of California.  
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclmain.c,v 1.2 2001/10/07 01:32:29 dtashley Exp $  
  */  
   
 #define MODULE_TCLMAIN  
   
 #include "tclmain.h"  
   
 #include "tcl.h"  
 #include "tclInt.h"  
   
 #include "build_config.h"  
 #include "extninit.h"  
 #include "msgstrs.h"  
   
   
 # undef TCL_STORAGE_CLASS  
 # define TCL_STORAGE_CLASS DLLEXPORT  
   
 /*  
  * The following code ensures that tclLink.c is linked whenever  
  * Tcl is linked.  Without this code there's no reference to the  
  * code in that file from anywhere in Tcl, so it may not be  
  * linked into the application.  
  */  
   
 EXTERN int Tcl_LinkVar();  
 int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;  
   
 /*  
  * Declarations for various library procedures and variables (don't want  
  * to include tclPort.h here, because people might copy this file out of  
  * the Tcl source directory to make their own modified versions).  
  * Note:  "exit" should really be declared here, but there's no way to  
  * declare it without causing conflicts with other definitions elsewher  
  * on some systems, so it's better just to leave it out.  
  */  
   
 extern int              isatty _ANSI_ARGS_((int fd));  
 extern char *           strcpy _ANSI_ARGS_((char *dst, CONST char *src));  
   
 static char *tclStartupScriptFileName = NULL;  
   
   
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclSetStartupScriptFileName --  
  *  
  *      Primes the startup script file name, used to override the  
  *      command line processing.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      This procedure initializes the file name of the Tcl script to  
  *      run at startup.  
  *  
  *----------------------------------------------------------------------  
  */  
 void TclSetStartupScriptFileName(fileName)  
     char *fileName;  
 {  
     tclStartupScriptFileName = fileName;  
 }  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclGetStartupScriptFileName --  
  *  
  *      Gets the startup script file name, used to override the  
  *      command line processing.  
  *  
  * Results:  
  *      The startup script file name, NULL if none has been set.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
 char *TclGetStartupScriptFileName()  
 {  
     return tclStartupScriptFileName;  
 }  
   
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_Main --  
  *  
  *      Main program for tclsh and most other Tcl-based applications.  
  *  
  * Results:  
  *      None. This procedure never returns (it exits the process when  
  *      it's done.  
  *  
  * Side effects:  
  *      This procedure initializes the Tcl world and then starts  
  *      interpreting commands;  almost anything could happen, depending  
  *      on the script being interpreted.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_Main(argc, argv, appInitProc)  
     int argc;                   /* Number of arguments. */  
     char **argv;                /* Array of argument strings. */  
     Tcl_AppInitProc *appInitProc;  
                                 /* Application-specific initialization  
                                  * procedure to call after most  
                                  * initialization but before starting to  
                                  * execute commands. */  
 {  
     Tcl_Obj *resultPtr;  
     Tcl_Obj *commandPtr = NULL;  
     char buffer[1000], *args;  
     int code, gotPartial, tty, length;  
     int exitCode = 0;  
     Tcl_Channel inChannel, outChannel, errChannel;  
     Tcl_Interp *interp;  
     Tcl_DString argString;  
   
     Tcl_FindExecutable(argv[0]);  
     interp = Tcl_CreateInterp();  
 #ifdef TCL_MEM_DEBUG  
     Tcl_InitMemory(interp);  
 #endif  
   
     /*  
      * Make command-line arguments available in the Tcl variables "argc"  
      * and "argv".  If the first argument doesn't start with a "-" then  
      * strip it off and use it as the name of a script file to process.  
      */  
   
     if (tclStartupScriptFileName == NULL) {  
         if ((argc > 1) && (argv[1][0] != '-')) {  
             tclStartupScriptFileName = argv[1];  
             argc--;  
             argv++;  
         }  
     }  
     args = Tcl_Merge(argc-1, argv+1);  
     Tcl_ExternalToUtfDString(NULL, args, -1, &argString);  
     Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);  
     Tcl_DStringFree(&argString);  
     ckfree(args);  
   
     if (tclStartupScriptFileName == NULL) {  
         Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);  
     } else {  
         tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,  
                 tclStartupScriptFileName, -1, &argString);  
     }  
   
     TclFormatInt(buffer, argc-1);  
     Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);  
     Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);  
   
     /*  
      * Set the "tcl_interactive" variable.  
      */  
   
     tty = isatty(0);  
     Tcl_SetVar(interp, "tcl_interactive",  
             ((tclStartupScriptFileName == NULL) && tty) ? "1" : "0",  
             TCL_GLOBAL_ONLY);  
       
     /*  
      * Invoke application-specific initialization.  
      */  
   
      /* Register any extensions that should be registered for the  
      ** executable currently being built.  
      */  
    ExtninitInit(interp);  
   
    /* Set a Tcl variable to indicate the particular product  
    ** we are building.  This is used in the startup message script  
    ** to announce product version, and may be used other  
    ** places, as well.  
    */  
    Tcl_SetVar(interp,  
               BUILD_CONFIG_PRODUCT_NAME_VARIABLE,  
               BUILD_CONFIG_STATIC_TCLSH_ALIAS,  
               TCL_GLOBAL_ONLY);  
   
    /* Set  Tcl variable to indicate the relese version of the  
    ** product we are building.  This is used in the startup message script  
    ** to announce product version, and may be used other  
    ** places, as well.  
    */  
    Tcl_SetVar(interp,  
               BUILD_CONFIG_PRODUCT_VERSION_VARIABLE,  
               BUILD_CONFIG_RELEASE_VERSION,  
               TCL_GLOBAL_ONLY);  
   
    /* Output the introductory message to the console.  
    ** The script called is generic and applies to both  
    ** IjuScripter and IjuConsole.  
    */  
    Tcl_GlobalEval(interp, BUILD_CONFIG_StartupMessageScript);  
   
     /*  
      * If a script file was specified then just source that file  
      * and quit.  
      */  
   
     if (tclStartupScriptFileName != NULL) {  
         code = Tcl_EvalFile(interp, tclStartupScriptFileName);  
         if (code != TCL_OK) {  
             errChannel = Tcl_GetStdChannel(TCL_STDERR);  
             if (errChannel) {  
                 /*  
                  * The following statement guarantees that the errorInfo  
                  * variable is set properly.  
                  */  
   
                 Tcl_AddErrorInfo(interp, "");  
                 Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",  
                         NULL, TCL_GLOBAL_ONLY));  
                 Tcl_WriteChars(errChannel, "\n", 1);  
             }  
             exitCode = 1;  
         }  
         goto done;  
     }  
     Tcl_DStringFree(&argString);  
   
     /*  
      * We're running interactively.  Source a user-specific startup  
      * file if the application specified one and if the file exists.  
      */  
   
     Tcl_SourceRCFile(interp);  
   
     /*  
      * Process commands from stdin until there's an end-of-file.  Note  
      * that we need to fetch the standard channels again after every  
      * eval, since they may have been changed.  
      */  
   
     commandPtr = Tcl_NewObj();  
     Tcl_IncrRefCount(commandPtr);  
   
     inChannel = Tcl_GetStdChannel(TCL_STDIN);  
     outChannel = Tcl_GetStdChannel(TCL_STDOUT);  
     gotPartial = 0;  
     while (1) {  
         if (tty) {  
             Tcl_Obj *promptCmdPtr;  
   
             promptCmdPtr = Tcl_GetVar2Ex(interp,  
                     (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),  
                     NULL, TCL_GLOBAL_ONLY);  
             if (promptCmdPtr == NULL) {  
                 defaultPrompt:  
                 if (!gotPartial && outChannel) {  
                     Tcl_WriteChars(outChannel, "% ", 2);  
                 }  
             } else {  
                 code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);  
                 inChannel = Tcl_GetStdChannel(TCL_STDIN);  
                 outChannel = Tcl_GetStdChannel(TCL_STDOUT);  
                 errChannel = Tcl_GetStdChannel(TCL_STDERR);  
                 if (code != TCL_OK) {  
                     if (errChannel) {  
                         Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));  
                         Tcl_WriteChars(errChannel, "\n", 1);  
                     }  
                     Tcl_AddErrorInfo(interp,  
                             "\n    (script that generates prompt)");  
                     goto defaultPrompt;  
                 }  
             }  
             if (outChannel) {  
                 Tcl_Flush(outChannel);  
             }  
         }  
         if (!inChannel) {  
             goto done;  
         }  
         length = Tcl_GetsObj(inChannel, commandPtr);  
         if (length < 0) {  
             goto done;  
         }  
         if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {  
             goto done;  
         }  
   
         /*  
          * Add the newline removed by Tcl_GetsObj back to the string.  
          */  
   
         Tcl_AppendToObj(commandPtr, "\n", 1);  
         if (!TclObjCommandComplete(commandPtr)) {  
             gotPartial = 1;  
             continue;  
         }  
   
         gotPartial = 0;  
         code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);  
         inChannel = Tcl_GetStdChannel(TCL_STDIN);  
         outChannel = Tcl_GetStdChannel(TCL_STDOUT);  
         errChannel = Tcl_GetStdChannel(TCL_STDERR);  
         Tcl_DecrRefCount(commandPtr);  
         commandPtr = Tcl_NewObj();  
         Tcl_IncrRefCount(commandPtr);  
         if (code != TCL_OK) {  
             if (errChannel) {  
                 Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));  
                 Tcl_WriteChars(errChannel, "\n", 1);  
             }  
         } else if (tty) {  
             resultPtr = Tcl_GetObjResult(interp);  
             Tcl_GetStringFromObj(resultPtr, &length);  
             if ((length > 0) && outChannel) {  
                 Tcl_WriteObj(outChannel, resultPtr);  
                 Tcl_WriteChars(outChannel, "\n", 1);  
             }  
         }  
 #ifdef TCL_MEM_DEBUG  
         if (tclMemDumpFileName != NULL) {  
             Tcl_DecrRefCount(commandPtr);  
             Tcl_DeleteInterp(interp);  
             Tcl_Exit(0);  
         }  
 #endif  
     }  
   
     /*  
      * Rather than calling exit, invoke the "exit" command so that  
      * users can replace "exit" with some other command to do additional  
      * cleanup on exit.  The Tcl_Eval call should never return.  
      */  
   
     done:  
     if (commandPtr != NULL) {  
         Tcl_DecrRefCount(commandPtr);  
     }  
     sprintf(buffer, "exit %d", exitCode);  
     Tcl_Eval(interp, buffer);  
 }  
   
   
 const char *TclMainCversion(void)  
 {    
     return ("$Revision: 1.2 $ $Modtime: 1/02/01 1:25a $ $Author: dtashley $");  
 }  
   
   
 const char *TclMainHversion(void)  
 {    
     return (TCLMAIN_H_VERSION);  
 }  
   
   
 /******************************************************************************  
 ** $Log: tclmain.c,v $  
 ** Revision 1.2  2001/10/07 01:32:29  dtashley  
 ** Log information refined.  
 **  
 ******************************************************************************/  
   
 /* End of TCLMAIN.C */  
1    /* $Header$ */
2    /*
3     * tclMain.c --
4     *
5     *      Main program for Tcl shells and other Tcl-based applications.
6     *
7     * Copyright (c) 1988-1994 The Regents of the University of California.
8     * Copyright (c) 1994-1997 Sun Microsystems, Inc.
9     *
10     * See the file "license.terms" for information on usage and redistribution
11     * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12     *
13     * RCS: @(#) $Id: tclmain.c,v 1.2 2001/10/07 01:32:29 dtashley Exp $
14     */
15    
16    #define MODULE_TCLMAIN
17    
18    #include "tclmain.h"
19    
20    #include "tcl.h"
21    #include "tclInt.h"
22    
23    #include "build_config.h"
24    #include "extninit.h"
25    #include "msgstrs.h"
26    
27    
28    # undef TCL_STORAGE_CLASS
29    # define TCL_STORAGE_CLASS DLLEXPORT
30    
31    /*
32     * The following code ensures that tclLink.c is linked whenever
33     * Tcl is linked.  Without this code there's no reference to the
34     * code in that file from anywhere in Tcl, so it may not be
35     * linked into the application.
36     */
37    
38    EXTERN int Tcl_LinkVar();
39    int (*tclDummyLinkVarPtr)() = Tcl_LinkVar;
40    
41    /*
42     * Declarations for various library procedures and variables (don't want
43     * to include tclPort.h here, because people might copy this file out of
44     * the Tcl source directory to make their own modified versions).
45     * Note:  "exit" should really be declared here, but there's no way to
46     * declare it without causing conflicts with other definitions elsewher
47     * on some systems, so it's better just to leave it out.
48     */
49    
50    extern int              isatty _ANSI_ARGS_((int fd));
51    extern char *           strcpy _ANSI_ARGS_((char *dst, CONST char *src));
52    
53    static char *tclStartupScriptFileName = NULL;
54    
55    
56    
57    
58    /*
59     *----------------------------------------------------------------------
60     *
61     * TclSetStartupScriptFileName --
62     *
63     *      Primes the startup script file name, used to override the
64     *      command line processing.
65     *
66     * Results:
67     *      None.
68     *
69     * Side effects:
70     *      This procedure initializes the file name of the Tcl script to
71     *      run at startup.
72     *
73     *----------------------------------------------------------------------
74     */
75    void TclSetStartupScriptFileName(fileName)
76        char *fileName;
77    {
78        tclStartupScriptFileName = fileName;
79    }
80    
81    
82    /*
83     *----------------------------------------------------------------------
84     *
85     * TclGetStartupScriptFileName --
86     *
87     *      Gets the startup script file name, used to override the
88     *      command line processing.
89     *
90     * Results:
91     *      The startup script file name, NULL if none has been set.
92     *
93     * Side effects:
94     *      None.
95     *
96     *----------------------------------------------------------------------
97     */
98    char *TclGetStartupScriptFileName()
99    {
100        return tclStartupScriptFileName;
101    }
102    
103    
104    
105    /*
106     *----------------------------------------------------------------------
107     *
108     * Tcl_Main --
109     *
110     *      Main program for tclsh and most other Tcl-based applications.
111     *
112     * Results:
113     *      None. This procedure never returns (it exits the process when
114     *      it's done.
115     *
116     * Side effects:
117     *      This procedure initializes the Tcl world and then starts
118     *      interpreting commands;  almost anything could happen, depending
119     *      on the script being interpreted.
120     *
121     *----------------------------------------------------------------------
122     */
123    
124    void
125    Tcl_Main(argc, argv, appInitProc)
126        int argc;                   /* Number of arguments. */
127        char **argv;                /* Array of argument strings. */
128        Tcl_AppInitProc *appInitProc;
129                                    /* Application-specific initialization
130                                     * procedure to call after most
131                                     * initialization but before starting to
132                                     * execute commands. */
133    {
134        Tcl_Obj *resultPtr;
135        Tcl_Obj *commandPtr = NULL;
136        char buffer[1000], *args;
137        int code, gotPartial, tty, length;
138        int exitCode = 0;
139        Tcl_Channel inChannel, outChannel, errChannel;
140        Tcl_Interp *interp;
141        Tcl_DString argString;
142    
143        Tcl_FindExecutable(argv[0]);
144        interp = Tcl_CreateInterp();
145    #ifdef TCL_MEM_DEBUG
146        Tcl_InitMemory(interp);
147    #endif
148    
149        /*
150         * Make command-line arguments available in the Tcl variables "argc"
151         * and "argv".  If the first argument doesn't start with a "-" then
152         * strip it off and use it as the name of a script file to process.
153         */
154    
155        if (tclStartupScriptFileName == NULL) {
156            if ((argc > 1) && (argv[1][0] != '-')) {
157                tclStartupScriptFileName = argv[1];
158                argc--;
159                argv++;
160            }
161        }
162        args = Tcl_Merge(argc-1, argv+1);
163        Tcl_ExternalToUtfDString(NULL, args, -1, &argString);
164        Tcl_SetVar(interp, "argv", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
165        Tcl_DStringFree(&argString);
166        ckfree(args);
167    
168        if (tclStartupScriptFileName == NULL) {
169            Tcl_ExternalToUtfDString(NULL, argv[0], -1, &argString);
170        } else {
171            tclStartupScriptFileName = Tcl_ExternalToUtfDString(NULL,
172                    tclStartupScriptFileName, -1, &argString);
173        }
174    
175        TclFormatInt(buffer, argc-1);
176        Tcl_SetVar(interp, "argc", buffer, TCL_GLOBAL_ONLY);
177        Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&argString), TCL_GLOBAL_ONLY);
178    
179        /*
180         * Set the "tcl_interactive" variable.
181         */
182    
183        tty = isatty(0);
184        Tcl_SetVar(interp, "tcl_interactive",
185                ((tclStartupScriptFileName == NULL) && tty) ? "1" : "0",
186                TCL_GLOBAL_ONLY);
187        
188        /*
189         * Invoke application-specific initialization.
190         */
191    
192         /* Register any extensions that should be registered for the
193         ** executable currently being built.
194         */
195       ExtninitInit(interp);
196    
197       /* Set a Tcl variable to indicate the particular product
198       ** we are building.  This is used in the startup message script
199       ** to announce product version, and may be used other
200       ** places, as well.
201       */
202       Tcl_SetVar(interp,
203                  BUILD_CONFIG_PRODUCT_NAME_VARIABLE,
204                  BUILD_CONFIG_STATIC_TCLSH_ALIAS,
205                  TCL_GLOBAL_ONLY);
206    
207       /* Set  Tcl variable to indicate the relese version of the
208       ** product we are building.  This is used in the startup message script
209       ** to announce product version, and may be used other
210       ** places, as well.
211       */
212       Tcl_SetVar(interp,
213                  BUILD_CONFIG_PRODUCT_VERSION_VARIABLE,
214                  BUILD_CONFIG_RELEASE_VERSION,
215                  TCL_GLOBAL_ONLY);
216    
217       /* Output the introductory message to the console.
218       ** The script called is generic and applies to both
219       ** IjuScripter and IjuConsole.
220       */
221       Tcl_GlobalEval(interp, BUILD_CONFIG_StartupMessageScript);
222    
223        /*
224         * If a script file was specified then just source that file
225         * and quit.
226         */
227    
228        if (tclStartupScriptFileName != NULL) {
229            code = Tcl_EvalFile(interp, tclStartupScriptFileName);
230            if (code != TCL_OK) {
231                errChannel = Tcl_GetStdChannel(TCL_STDERR);
232                if (errChannel) {
233                    /*
234                     * The following statement guarantees that the errorInfo
235                     * variable is set properly.
236                     */
237    
238                    Tcl_AddErrorInfo(interp, "");
239                    Tcl_WriteObj(errChannel, Tcl_GetVar2Ex(interp, "errorInfo",
240                            NULL, TCL_GLOBAL_ONLY));
241                    Tcl_WriteChars(errChannel, "\n", 1);
242                }
243                exitCode = 1;
244            }
245            goto done;
246        }
247        Tcl_DStringFree(&argString);
248    
249        /*
250         * We're running interactively.  Source a user-specific startup
251         * file if the application specified one and if the file exists.
252         */
253    
254        Tcl_SourceRCFile(interp);
255    
256        /*
257         * Process commands from stdin until there's an end-of-file.  Note
258         * that we need to fetch the standard channels again after every
259         * eval, since they may have been changed.
260         */
261    
262        commandPtr = Tcl_NewObj();
263        Tcl_IncrRefCount(commandPtr);
264    
265        inChannel = Tcl_GetStdChannel(TCL_STDIN);
266        outChannel = Tcl_GetStdChannel(TCL_STDOUT);
267        gotPartial = 0;
268        while (1) {
269            if (tty) {
270                Tcl_Obj *promptCmdPtr;
271    
272                promptCmdPtr = Tcl_GetVar2Ex(interp,
273                        (gotPartial ? "tcl_prompt2" : "tcl_prompt1"),
274                        NULL, TCL_GLOBAL_ONLY);
275                if (promptCmdPtr == NULL) {
276                    defaultPrompt:
277                    if (!gotPartial && outChannel) {
278                        Tcl_WriteChars(outChannel, "% ", 2);
279                    }
280                } else {
281                    code = Tcl_EvalObjEx(interp, promptCmdPtr, 0);
282                    inChannel = Tcl_GetStdChannel(TCL_STDIN);
283                    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
284                    errChannel = Tcl_GetStdChannel(TCL_STDERR);
285                    if (code != TCL_OK) {
286                        if (errChannel) {
287                            Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
288                            Tcl_WriteChars(errChannel, "\n", 1);
289                        }
290                        Tcl_AddErrorInfo(interp,
291                                "\n    (script that generates prompt)");
292                        goto defaultPrompt;
293                    }
294                }
295                if (outChannel) {
296                    Tcl_Flush(outChannel);
297                }
298            }
299            if (!inChannel) {
300                goto done;
301            }
302            length = Tcl_GetsObj(inChannel, commandPtr);
303            if (length < 0) {
304                goto done;
305            }
306            if ((length == 0) && Tcl_Eof(inChannel) && (!gotPartial)) {
307                goto done;
308            }
309    
310            /*
311             * Add the newline removed by Tcl_GetsObj back to the string.
312             */
313    
314            Tcl_AppendToObj(commandPtr, "\n", 1);
315            if (!TclObjCommandComplete(commandPtr)) {
316                gotPartial = 1;
317                continue;
318            }
319    
320            gotPartial = 0;
321            code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
322            inChannel = Tcl_GetStdChannel(TCL_STDIN);
323            outChannel = Tcl_GetStdChannel(TCL_STDOUT);
324            errChannel = Tcl_GetStdChannel(TCL_STDERR);
325            Tcl_DecrRefCount(commandPtr);
326            commandPtr = Tcl_NewObj();
327            Tcl_IncrRefCount(commandPtr);
328            if (code != TCL_OK) {
329                if (errChannel) {
330                    Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
331                    Tcl_WriteChars(errChannel, "\n", 1);
332                }
333            } else if (tty) {
334                resultPtr = Tcl_GetObjResult(interp);
335                Tcl_GetStringFromObj(resultPtr, &length);
336                if ((length > 0) && outChannel) {
337                    Tcl_WriteObj(outChannel, resultPtr);
338                    Tcl_WriteChars(outChannel, "\n", 1);
339                }
340            }
341    #ifdef TCL_MEM_DEBUG
342            if (tclMemDumpFileName != NULL) {
343                Tcl_DecrRefCount(commandPtr);
344                Tcl_DeleteInterp(interp);
345                Tcl_Exit(0);
346            }
347    #endif
348        }
349    
350        /*
351         * Rather than calling exit, invoke the "exit" command so that
352         * users can replace "exit" with some other command to do additional
353         * cleanup on exit.  The Tcl_Eval call should never return.
354         */
355    
356        done:
357        if (commandPtr != NULL) {
358            Tcl_DecrRefCount(commandPtr);
359        }
360        sprintf(buffer, "exit %d", exitCode);
361        Tcl_Eval(interp, buffer);
362    }
363    
364    
365    const char *TclMainCversion(void)
366    {  
367        return ("$Header$");
368    }
369    
370    
371    const char *TclMainHversion(void)
372    {  
373        return (TCLMAIN_H_VERSION);
374    }
375    
376    /* End of tclmain.c */
Legend:
Removed from v.44  
changed lines
  Added in v.98
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25