← Back to branch summary

~ubuntu-branches/ubuntu/raring/tcl8.5/raring

« back to all changes in this revision

Viewing changes to generic/tclBasic.c

  • Committer: Bazaar Package Importer
  • Author(s): Sergei Golovan
  • Date: 2011-06-26 11:47:14 UTC
  • mfrom: (11.2.2 sid)
  • Revision ID: james.westby@ubuntu.com-20110626114714-mdw95b180f00mm08
Tags: 8.5.10-1
http://bugs.debian.org/617628
* New upstream release (closes: #617628).
* Changed tclsh8.5 alternative priority to 850 to make it higher than
  tclsh8.4 one.
* Bumped standards version to 3.9.2.

Show diffs side-by-side

added added

removed removed

Lines of Context:
generic/tclBasic.c
13
13
 *
14
14
 * See the file "license.terms" for information on usage and redistribution of
15
15
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
16
 
 *
17
 
 * RCS: @(#) $Id: tclBasic.c,v 1.295.2.18 2010/07/25 10:13:49 nijtmans Exp $
18
16
 */
19
17
 
20
18
#include "tclInt.h"
501
499
    iPtr->resultSpace[0] = 0;
502
500
    iPtr->threadId = Tcl_GetCurrentThread();
503
501
 
 
502
    /* TIP #378 */
 
503
#ifdef TCL_INTERP_DEBUG_FRAME
 
504
    iPtr->flags |= INTERP_DEBUG_FRAME;
 
505
#else
 
506
    if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) {
 
507
        iPtr->flags |= INTERP_DEBUG_FRAME;
 
508
    }
 
509
#endif
 
510
 
504
511
    /*
505
512
     * Initialise the tables for variable traces and searches *before*
506
513
     * creating the global ns - so that the trace on errorInfo can be
821
828
    Tcl_InitStubs(interp, TCL_VERSION, 1);
822
829
 
823
830
    if (TclTommath_Init(interp) != TCL_OK) {
824
 
        Tcl_Panic(Tcl_GetString(Tcl_GetObjResult(interp)));
 
831
        Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
825
832
    }
826
833
 
827
834
    return interp;
1250
1257
     * table, as it will be freed later in this function without further use.
1251
1258
     */
1252
1259
 
1253
 
    TclCleanupLiteralTable(interp, &(iPtr->literalTable));
1254
1260
    TclHandleFree(iPtr->handle);
1255
1261
    TclTeardownNamespace(iPtr->globalNsPtr);
1256
1262
 
3442
3448
TclInterpReady(
3443
3449
    Tcl_Interp *interp)
3444
3450
{
 
3451
#if !defined(TCL_NO_STACK_CHECK)
3445
3452
    int localInt; /* used for checking the stack */
 
3453
#endif
3446
3454
    register Interp *iPtr = (Interp *) interp;
3447
3455
 
3448
3456
    /*
3655
3663
        }
3656
3664
    }
3657
3665
 
 
3666
#ifdef USE_DTRACE
3658
3667
    if (TCL_DTRACE_CMD_ARGS_ENABLED()) {
3659
3668
        char *a[10];
3660
3669
        int i = 0;
3673
3682
        TCL_DTRACE_CMD_INFO(a[0], a[1], a[2], a[3], i[0], i[1]);
3674
3683
        TclDecrRefCount(info);
3675
3684
    }
 
3685
#endif /* USE_DTRACE */
3676
3686
 
3677
3687
    /*
3678
3688
     * Finally, invoke the command's Tcl_ObjCmdProc.
3747
3757
        (void) Tcl_GetObjResult(interp);
3748
3758
    }
3749
3759
 
 
3760
#ifdef USE_DTRACE
3750
3761
    if (TCL_DTRACE_CMD_RESULT_ENABLED()) {
3751
3762
        Tcl_Obj *r;
3752
3763
 
3753
3764
        r = Tcl_GetObjResult(interp);
3754
3765
        TCL_DTRACE_CMD_RESULT(TclGetString(objv[0]), code, TclGetString(r),r);
3755
3766
    }
 
3767
#endif /* USE_DTRACE */
3756
3768
 
3757
3769
  done:
3758
3770
    if (savedVarFramePtr) {
4057
4069
    int line,                   /* The line the script starts on. */
4058
4070
    int*  clNextOuter,       /* Information about an outer context for */
4059
4071
    CONST char* outerScript) /* continuation line data. This is set only in
4060
 
                              * EvalTokensStandard(), to properly handle
 
4072
                              * TclSubstTokens(), to properly handle
4061
4073
                              * [...]-nested commands. The 'outerScript'
4062
4074
                              * refers to the most-outer script containing the
4063
4075
                              * embedded command, which is refered to by
4564
4576
    /*
4565
4577
     * Track the invisible continuation lines embedded in a script, if
4566
4578
     * any. Here they are just spaces (already). They were removed by
4567
 
     * EvalTokensStandard() via Tcl_UtfBackslash().
 
4579
     * TclSubstTokens() via TclParseBackslash().
4568
4580
     *
4569
4581
     * *clNextPtrPtr         <=> We have continuation lines to track.
4570
4582
     * **clNextPtrPtr >= 0   <=> We are not beyond the last possible location.
4751
4763
             * have to save them at compile time.
4752
4764
             */
4753
4765
 
 
4766
            if (ePtr->nline != objc) {
 
4767
                Tcl_Panic ("TIP 280 data structure inconsistency");
 
4768
            }
 
4769
 
4754
4770
            for (word = 1; word < objc; word++) {
4755
4771
                if (ePtr->line[word] >= 0) {
4756
4772
                    int isnew;
4836
4852
                                                    (char *) objv[word]);
4837
4853
                    if (hPtr) {
4838
4854
                        CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr);
4839
 
 
 
4855
 
4840
4856
                        if (cfwPtr->prevPtr) {
4841
4857
                            Tcl_SetHashValue(hPtr, cfwPtr->prevPtr);
4842
4858
                        } else {
4887
4903
     * up by the caller. It knows better than us.
4888
4904
     */
4889
4905
 
4890
 
    if ((!obj->bytes) || ((obj->typePtr == &tclListType) &&
4891
 
            ((List *)obj->internalRep.twoPtrValue.ptr1)->canonicalFlag)) {
 
4906
    if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
4892
4907
        return;
4893
4908
    }
4894
4909
 
5070
5085
     * internal rep).
5071
5086
     */
5072
5087
 
5073
 
    if (objPtr->typePtr == &tclListType) {      /* is a list... */
5074
 
        List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
5075
 
 
5076
 
        if (objPtr->bytes == NULL ||    /* ...without a string rep */
5077
 
            listRepPtr->canonicalFlag) {/* ...or that is canonical */
5078
 
            /*
5079
 
             * TIP #280 Structures for tracking lines. As we know that this is
5080
 
             * dynamic execution we ignore the invoker, even if known.
5081
 
             */
5082
 
 
5083
 
            int nelements;
5084
 
            Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
5085
 
            CmdFrame *eoFramePtr = (CmdFrame *)
 
5088
    if (TclListObjIsCanonical(objPtr)) {
 
5089
        /*
 
5090
         * TIP #280 Structures for tracking lines. As we know that this is
 
5091
         * dynamic execution we ignore the invoker, even if known.
 
5092
         */
 
5093
 
 
5094
        int nelements;
 
5095
        Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
 
5096
        CmdFrame *eoFramePtr = (CmdFrame *)
5086
5097
                TclStackAlloc(interp, sizeof(CmdFrame));
5087
5098
 
5088
 
            eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
5089
 
            eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
5090
 
                                 1 : iPtr->cmdFramePtr->level + 1);
5091
 
            eoFramePtr->framePtr = iPtr->framePtr;
5092
 
            eoFramePtr->nextPtr = iPtr->cmdFramePtr;
5093
 
 
5094
 
            eoFramePtr->nline = 0;
5095
 
            eoFramePtr->line = NULL;
5096
 
 
5097
 
            eoFramePtr->cmd.listPtr  = objPtr;
5098
 
            Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
5099
 
            eoFramePtr->data.eval.path = NULL;
5100
 
 
5101
 
            /*
5102
 
             * TIP #280 We do _not_ compute all the line numbers for the words
5103
 
             * in the command. For the eval of a pure list the most sensible
5104
 
             * choice is to put all words on line 1. Given that we neither
5105
 
             * need memory for them nor compute anything.  'line' is left
5106
 
             * NULL. The two places using this information (TclInfoFrame, and
5107
 
             * TclInitCompileEnv), are special-cased to use the proper line
5108
 
             * number directly instead of accessing the 'line' array.
5109
 
             */
5110
 
 
5111
 
            Tcl_ListObjGetElements(NULL, copyPtr,
5112
 
                                   &nelements, &elements);
5113
 
 
5114
 
            iPtr->cmdFramePtr = eoFramePtr;
5115
 
            result = Tcl_EvalObjv(interp, nelements, elements,
5116
 
                                  flags);
5117
 
 
5118
 
            Tcl_DecrRefCount(copyPtr);
5119
 
            iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
5120
 
            Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
5121
 
            TclStackFree(interp, eoFramePtr);
5122
 
 
5123
 
            goto done;
5124
 
        }
5125
 
    }
5126
 
 
5127
 
    if (flags & TCL_EVAL_DIRECT) {
 
5099
        eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
 
5100
        eoFramePtr->level = (iPtr->cmdFramePtr == NULL?  1 
 
5101
                : iPtr->cmdFramePtr->level + 1);
 
5102
        eoFramePtr->framePtr = iPtr->framePtr;
 
5103
        eoFramePtr->nextPtr = iPtr->cmdFramePtr;
 
5104
 
 
5105
        eoFramePtr->nline = 0;
 
5106
        eoFramePtr->line = NULL;
 
5107
 
 
5108
        eoFramePtr->cmd.listPtr  = objPtr;
 
5109
        Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
 
5110
        eoFramePtr->data.eval.path = NULL;
 
5111
 
 
5112
        /*
 
5113
         * TIP #280 We do _not_ compute all the line numbers for the words
 
5114
         * in the command. For the eval of a pure list the most sensible
 
5115
         * choice is to put all words on line 1. Given that we neither
 
5116
         * need memory for them nor compute anything.  'line' is left
 
5117
         * NULL. The two places using this information (TclInfoFrame, and
 
5118
         * TclInitCompileEnv), are special-cased to use the proper line
 
5119
         * number directly instead of accessing the 'line' array.
 
5120
         */
 
5121
 
 
5122
        Tcl_ListObjGetElements(NULL, copyPtr, &nelements, &elements);
 
5123
 
 
5124
        iPtr->cmdFramePtr = eoFramePtr;
 
5125
        result = Tcl_EvalObjv(interp, nelements, elements, flags);
 
5126
 
 
5127
        Tcl_DecrRefCount(copyPtr);
 
5128
        iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
 
5129
        Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
 
5130
        TclStackFree(interp, eoFramePtr);
 
5131
    } else if (flags & TCL_EVAL_DIRECT) {
5128
5132
        /*
5129
5133
         * We're not supposed to use the compiler or byte-code interpreter.
5130
5134
         * Let Tcl_EvalEx evaluate the command directly (and probably more
5284
5288
        iPtr->varFramePtr = savedVarFramePtr;
5285
5289
    }
5286
5290
 
5287
 
  done:
5288
5291
    TclDecrRefCount(objPtr);
5289
5292
    return result;
5290
5293
}
6468
6471
            goto unChanged;
6469
6472
        } else if (l == (long)0) {
6470
6473
            const char *string = objv[1]->bytes;
6471
 
            if (!string) {
6472
 
            /* There is no string representation, so internal one is correct */
6473
 
                goto unChanged;
6474
 
            }
6475
 
            while (isspace(UCHAR(*string))) {
6476
 
                ++string;
6477
 
            }
6478
 
            if (*string != '-') {
6479
 
                goto unChanged;
6480
 
            }
 
6474
            if (string) {
 
6475
                while (*string != '0') {
 
6476
                    if (*string == '-') {
 
6477
                        Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
 
6478
                        return TCL_OK;
 
6479
                    }
 
6480
                    string++;
 
6481
                }
 
6482
            }
 
6483
            goto unChanged;
6481
6484
        } else if (l == LONG_MIN) {
6482
6485
            TclBNInitBignumFromLong(&big, l);
6483
6486
            goto tooLarge;