Tcl Source Code

    /*
     * Walk through the assembly script using the Tcl parser.  Each 'command'
     * will be an instruction or assembly directive.
     */

    const char* instPtr = codePtr;
				/* Where to start looking for a line of code */
    int instLen;		/* Length in bytes of the current line of
				 * code */
    const char* nextPtr;	/* Pointer to the end of the line of code */
    int bytesLeft = codeLen;	/* Number of bytes of source code remaining to
				 * be parsed */
    int status;			/* Tcl status return */
    AssemblyEnv* assemEnvPtr = NewAssemblyEnv(envPtr, flags);
    Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;

    do {
	/*
	 * Parse out one command line from the assembly script.
	 */

	status = Tcl_ParseCommand(interp, instPtr, bytesLeft, 0, parsePtr);
	instLen = parsePtr->commandSize;
	if (parsePtr->term == parsePtr->commandStart + instLen - 1) {
	    --instLen;
	}

	/*
	 * Report errors in the parse.
	 */

	if (status != TCL_OK) {
	    if (flags & TCL_EVAL_DIRECT) {
		Tcl_LogCommandInfo(interp, codePtr, parsePtr->commandStart,
			instLen);
	    }
	    FreeAssemblyEnv(assemEnvPtr);
	    return TCL_ERROR;
	}

	/*
	 * Advance the pointers around any leading commentary.
	 */

	TclAdvanceLines(&assemEnvPtr->cmdLine, instPtr,
		parsePtr->commandStart);
	TclAdvanceContinuations(&assemEnvPtr->cmdLine, &assemEnvPtr->clNext,
		parsePtr->commandStart - envPtr->source);

	/*
	 * Process the line of code.
	 */

	if (parsePtr->numWords > 0) {







	    /*
	     * If tracing, show each line assembled as it happens.
	     */

#ifdef TCL_COMPILE_DEBUG
	    if ((tclTraceCompile >= 2) && (envPtr->procPtr == NULL)) {
		printf("  %4ld Assembling: ",

	eeFramePtr->data.eval.path = NULL;
    }

    iPtr->evalFlags = 0;
    do {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
	    code = TCL_ERROR;


	    goto error;
	}

	/*
	 * TIP #280 Track lines. The parser may have skipped text till it
	 * found the command we are now at. We have to count the lines in this
	 * block, and do not forget invisible continuation lines.
	 */

	     */

	    commandLength -= 1;
	}
	Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		commandLength);
    }

    iPtr->flags &= ~ERR_ALREADY_LOGGED;

    /*
     * Then free resources that had been allocated to the command.
     */

    for (i = 0; i < objectsUsed; i++) {

    do {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
	    /*
	     * Compile bytecodes to report the parse error at runtime.
	     */

	    Tcl_LogCommandInfo(interp, script, parsePtr->commandStart,
		    /* Drop the command terminator (";","]") if appropriate */
		    (parsePtr->term ==
		    parsePtr->commandStart + parsePtr->commandSize - 1)?
		    parsePtr->commandSize - 1 : parsePtr->commandSize);
	    TclCompileSyntaxError(interp, envPtr);
	    break;
	}

	/*
	 * TIP #280: We have to count newlines before the command even in the
	 * degenerate case when the command has no words. (See test

    -cleanup {
	rename x {}
	unset result
    }
    -match glob
    -result {1 {extra characters after close-brace} {extra characters after close-brace
    while executing
"{}extra
	    "
    ("assemble" body, line 2)*}}
}
test assemble-4.2 {null command} {
    -body {
	proc x {} {
	    assemble {
		push hello; pop;;push goodbye

    "
    set msg {}
    join [list [catch tstProc msg] $msg $::errorInfo] \n
} [subst -novariables -nocommands {1
missing close-brace for variable name
missing close-brace for variable name
    while executing
"set tst $a([winfo name $\{zz)
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a bogus comment
	# this is a ..."
    (procedure "tstProc" line 4)
    invoked from within
"tstProc"}]

for {set i 1} {$i<300} {incr i} {
    test misc-2.$i {hash table with sys-alloc} testhashsystemhash \
	    "testhashsystemhash $i" OK