/*
 *	cliptcl.c
 *
 *	Tclインタプリタ
 *
 *	CLiP - Common Library for P/ECE
 *	Copyright (C) 2001-2014 Naoyuki Sawa
 *
 *	* Sun Oct 26 19:32:00 JST 2014 Naoyuki Sawa
 *	- 1st リリース。
 *	- 「keep/Tclｲﾝﾀﾌﾟﾘﾀ対応状況.xls」に、対応状況を記録して行きます。
 */
#include "clip.h"

//┏━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓
//┃【重要】当モジュールは、ガーベージコレクターとの併用を前提としています。　　　　　　　　　　　　　　　　　　　　┃
//┃・P/ECE環境では、Tcl_CreateInterp()を呼び出す前に、「gc_init(GC_LEVEL_CONSERVATIVE);」を実行しておいてください。┃
//┃・PC環境では、ガーベージコレクターのライブラリ(「Boehm GC」等)をリンクしてください。　　　　　　　　　　　　　　┃
//┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛

/****************************************************************************
 *	
 ****************************************************************************/
/* 文字列の先頭に、Tclの言語仕様に沿った、{～},又は,"～"で囲まれた要素が有るかを判断する。
 * [in]
 *	s		調べる文字列。
 *	leftChar	囲み開始文字。'{',又は,'"'を指定してください。(他の文字も指定可能)
 *	rightChar	囲み終了文字。'}',又は,'"'を指定してください。(他の文字も指定可能)
 *	termChar	囲み終了文字の次の文字として、ヌル,空白,行継続に加えて許容する文字	たとえば「set x [expr {1+1}]」をパース可能とするための引数です。'}'の次が空白でなく']'であるが'}'が閉じる文字であると判定します。
 * [out]
 *	戻り値		囲まれた要素ならば、その終端ポインタを返す。
 *			囲まれた要素でなければ、NULLポインタを返す。
 * [note]
 *	- 当関数は、Tcl_IsBracedElement()とTcl_IsQuotedElement()の共通処理として作成しましたが、
 *	  処理は汎用的に作ってあるので、leftChar,rightCharに任意の文字を指定することもできます。
 *	- 文字列sの先頭に、囲まれた要素が有るかを判断する方法は、以下の通りです。
 *	  1. 1文字目が囲み開始文字でなければ、囲まれた要素でない。
 *	  2. 2文字目以降を、囲み開始文字,及び,囲み終了文字を終端文字として、エスケープ解除する。
 *	  3. 囲み終了文字で終端した場合は、深さを減らす。深さが0になった場合、次の文字を調べる。
 *	  3-1. 囲み終了文字の次の文字が、ヌル,空白,行継続,又は,許容する文字のいずれかならば、囲まれた要素である。
 *	  3-2. 囲み終了文字の次の文字がそれ以外の文字ならば、囲まれた要素でない。
 *	  4. 囲み開始文字で終端した場合は、深さを増やす。
 *	  5. それ以外の文字で終端した場合は、囲まれた要素でない。
 *	  囲まれた要素だった場合は、囲み終了文字の次の位置が、囲まれた要素の終端ポインタである。
 */
static char* Tcl_IsEnclosedElement(const char* s, int leftChar, int rightChar, int termChar) {
	const char delim[3] = { leftChar, rightChar, '\0' };
	int c, depth = 1;
	/* 最初の文字を取得して、次へ進める。
	 * 最初の文字が囲み開始文字でなければ、囲まれた要素ではない。 */
	if(*s++ != delim[0]) { return NULL; }
	for(;;) {
		/* エスケープされていない囲み開始文字,囲み終了文字,又は,ヌルに到達するまで、エスケープを解除する。
		 * エスケープを解除した結果の文字列は、不要なので、すぐに開放する。 */
		free(strcompress(s, (char**)&s, delim));/* "\t\n\v\f\r "は、囲まれた要素の中においては、終端文字ではない。 */
		/* エスケープを解除した終端の文字を取得して、次へ進める。 */
		c = *s++;
		/* 囲み終了文字ならば…
		 * - 囲み開始文字と囲み終了文字が同じ場合のために、囲み終了文字を先に判断する。 */
		if(c == delim[1]) {
			/* 深さを減らす。 */
			depth--;
			/* 深さが0になったら… */
			if(!depth) {
				/* 囲み終了文字の次の文字が、ヌル,空白,行継続,又は,許容する文字のいずれかならば、囲まれた要素である。
				 * 囲み終了文字の次の位置が、囲まれた要素の終端ポインタである。 */
				if(!*s || isspace(*s) || ((*s == '\\') && (*(s+1) == '\n')) || (*s == termChar)) { return (char*)s; }
				/* それ以外の文字ならば、囲まれた要素でない。 */
				break;
			}
		/* 囲み開始文字ならば… */
		} else if(c == delim[0]) {
			/* 深さを増やす。 */
			depth++;
		/* それ以外の文字ならば… */
		} else {
			/* 囲まれた要素でない。 */
			break;
		}
	}
	/* 囲まれた要素でなければ、NULLを返す。 */
	return NULL;
}
/* 文字列の先頭に、Tclの言語仕様に沿った、{～}で囲まれた要素が有るかを判断する。
 * ＜実行例＞
 * Tcl_IsBracedElement(  "{123}"  )	True
 * Tcl_IsBracedElement( "{{123}"  )	False	深さが0になる前にヌルで終端したから。
 * Tcl_IsBracedElement(  "{123}}" )	False	囲み終了文字の次の文字がヌル,又は,空白でないから。
 * Tcl_IsBracedElement( " {123}"  )	False	1文字目が囲み開始文字でないから。
 * Tcl_IsBracedElement(  "{123} " )	True
 * Tcl_IsBracedElement( "x{123}"  )	False	1文字目が囲み開始文字でないから。
 * Tcl_IsBracedElement(  "{123}x" )	False	囲み終了文字の次の文字がヌル,又は,空白でないから。
 * Tcl_IsBracedElement("x {123}"  )	False	1文字目が囲み開始文字でないから。
 * Tcl_IsBracedElement(  "{123} x")	True
 */
char* Tcl_IsBracedElement(const char* s, int termChar) {
	return Tcl_IsEnclosedElement(s, '{', '}', termChar);
}
/* 文字列の先頭に、Tclの言語仕様に沿った、"～"で囲まれた要素が有るかを判断する。
 * ＜実行例＞
 * Tcl_IsQuotedElement(  "\"123\""  )	True
 * Tcl_IsQuotedElement("\"\"123\""  )	False	囲み終了文字の次の文字がヌル,又は,空白でないから。
 * Tcl_IsQuotedElement(  "\"123\"\"")	False	囲み終了文字の次の文字がヌル,又は,空白でないから。
 * Tcl_IsQuotedElement( " \"123\""  )	False	1文字目が囲み開始文字でないから。
 * Tcl_IsQuotedElement(  "\"123\" " )	True
 * Tcl_IsQuotedElement( "x\"123\""  )	False	1文字目が囲み開始文字でないから。
 * Tcl_IsQuotedElement(  "\"123\"x" )	False	囲み終了文字の次の文字がヌル,又は,空白でないから。
 * Tcl_IsQuotedElement("x \"123\""  )	False	1文字目が囲み開始文字でないから。
 * Tcl_IsQuotedElement(  "\"123\" x")	True
 */
char* Tcl_IsQuotedElement(const char* s, int termChar) {
	return Tcl_IsEnclosedElement(s, '"', '"', termChar);
}
/*--------------------------------------------------------------------------*/
/* 文字列をリストと見なして分割し、要素配列を作成する。
 * [in]
 *	s		分割する文字列。
 *	argvPtr		要素配列のポインタを格納する変数へのポインタ。NULLを指定すると格納しない。
 * [out]
 *	戻り値		要素数。
 * [note]
 *	- 要素配列は、NULLポインタで終端します。戻り値の要素数は、終端のNULLポインタを含みません。
 *	  (main関数の、引数argc,argvと同様です。)
 *	- 呼び出し側でメモリを開放する方法は、以下のとおりです。GCを使用する場合は、開放不要です。
 *	  const char s[]="1st \"\\x32nd \\x33rd\" {\\x34th \\x35th}";
 *	  char**argv;
 *	  int i,argc=Tcl_SplitList(s,&argv);
 *	  for(i=0;i<argc;i++){//終了条件は(argv[i])でも可
 *	    printf("[%d] %s\n",i,argv[i]);
 *	  }
 *	  for(i=0;i<argc;i++){free(argv[i]);}//┬メモリ開放処理
 *	  free(argv);                        //┘
 *	  ↓↓↓結果↓↓↓
 *	  │[0] 1st
 *	  │[1] 2nd 3rd
 *	  │[2] \x34th \x35th
 */
int Tcl_SplitList(const char* s, char*** argvPtr) {
	int    argc = 0;
	char** argv = NULL;
	for(;;) {
		char* elem = NULL;
		/* 先頭の空白を読み飛ばす。 */
		s += strspn(s, "\t\n\v\f\r ");
		/* 文字列の終端でなければ… */
		if(*s) {
			char* endp;
			/* 波括弧で囲まれた要素ならば… */
			if((endp = Tcl_IsBracedElement(s, 0))) {
				/* 波括弧の中の文字列を、エスケープを解除せずに取得する。 */
				if(!(elem = strndup(s+1, endp-s-2))) { DIE(); }
			/* 二重引用符で囲まれた要素ならば… */
			} else if((endp = Tcl_IsQuotedElement(s, 0))) {
				/* 二重引用符の中の文字列を、エスケープを解除して取得する。 */
				elem = strcompress(s+1, NULL, "\"");
			/* 囲まれた要素でなければ… */
			} else {
				/* 空白文字までの文字列を、エスケープを解除して取得する。 */
				elem = strcompress(s, &endp, "\t\n\v\f\r ");
			}
			/* 終端文字(又はヌル文字)から次の要素を検索する。 */
			s = endp;
		}
		/* 要素配列に、要素,又は,NULLポインタを格納する。 */
		if(!(argv = realloc(argv, sizeof(char*) * (argc+1)))) { DIE(); }
		argv[argc] = elem;
		/* 要素配列の終端だったならば… */
		if(!elem) {
			/* 要素配列のポインタを格納する。要求されていなければ破棄する。 */
			if(argvPtr) { *argvPtr = argv; } else { free(argvPtr); }
			/* 要素数を返す。終端のNULLポインタは要素数に含めない。 */
			return argc;
		}
		/* 要素数を増やす。 */
		argc++;
	}
}
/*--------------------------------------------------------------------------*/
//"list"コマンドに相当する。
char* Tcl_Merge(int argc, char** argv) {
	char* s = strdup("");
	int i;
	for(i = 0; i < argc; i++) {
		const char* elem = strescape(argv[i], " $;[]{}");	//各要素をトリムしない。エスケープする。
		if(!*elem) { elem = "\\0"; }				//空文字の要素も飛ばさない。「list x "" y」の結果は「x y」ではなく「x {} y」,又は,「x \0 y」になる。
		s = strjoin(*s ? " " : NULL, s, elem, NULL);		//セパレータ有り。
	}
	return s;
}
/*--------------------------------------------------------------------------*/
//"concat"コマンドに相当する。
char* Tcl_Concat(int argc, char** argv) {
	char* s = strdup("");
	int i;
	for(i = 0; i < argc; i++) {
		const char* elem = strtrim(argv[i], 0, NULL);		//各要素をトリムする。エスケープしない。
		if(!*elem) { continue; }				//トリムした結果が空文字となる要素は飛ばす。「concat x "" y」の結果は「x  y」ではなく「x y」になる。
		s = strjoin(*s ? " " : NULL, s, elem, NULL);		//セパレータ有り。
	}
	return s;
}
/*--------------------------------------------------------------------------*/
/* 文字cの種類を判別する。Tcl_ParseWords()等から使用する。
 * ネストしたコマンドの呼び出し内である場合は、(termChar=']')を指定すること。
 * それ以外の場合は、(termChar=0)を指定すること。 */
int Tcl_CharType(int c, int termChar) {
	static const char TypeTable[]={
		1,'$',				//8 TCL_DOLLAR
		1,'\\',				//7 TCL_BACKSLASH
		1,'}',				//6 TCL_CLOSE_BRACE
		1,'{',				//5 TCL_OPEN_BRACE
		1,'[',				//4 TCL_OPEN_BRACKET
		1,'"',				//3 TCL_QUOTE
		3,'\0','\n',';',		//2 TCL_COMMAND_END
		5,'\t','\v','\f','\r',' '};	//1 TCL_SPACE
	const char* p = TypeTable;
	int t = TCL_DOLLAR;
	if(c == termChar) { return TCL_COMMAND_END; }	//(c=']')&&(termChar=']')の場合はここでTCL_COMMAND_ENDと判断する。(c='\0')&&(termChar=0)の場合もここでTCL_COMMAND_ENDと判断されるが問題ない。(c='\0')&&(termChar=']')の場合は下のループの中でTCL_COMMAND_ENDと判断する。
	do {
		int n = *p++;
		do {
			if(*p++ == c) { return t; }
		} while(--n);
	} while(--t);
	return TCL_NORMAL;
}
/****************************************************************************
 *	
 ****************************************************************************/
/* 初期化 */
void Tcl_InitTable(Tcl_Table* tablePtr) {
	InitializeListHead(&tablePtr->list_head);
}
/*--------------------------------------------------------------------------*/
/* 作成 */
Tcl_TableEntry* Tcl_CreateTableEntry(Tcl_Table* tablePtr, const char* key, int* newPtr) {
	Tcl_TableEntry* entryPtr;
	int bNew = 0;
	if(!(entryPtr = Tcl_FindTableEntry(tablePtr, key))) {
		entryPtr = calloc(sizeof(Tcl_TableEntry), 1);
		InsertTailList(&tablePtr->list_head, &entryPtr->list_entry);
		entryPtr->key = strdup(key);
		bNew = 1;
	}
	if(newPtr) { *newPtr = bNew; }
	return entryPtr;
}
/*--------------------------------------------------------------------------*/
/* 検索 */
Tcl_TableEntry* Tcl_FindTableEntry(Tcl_Table* tablePtr, const char* key) {
	Tcl_TableSearch search;
	Tcl_TableEntry* entryPtr;
	for(entryPtr = Tcl_FirstTableEntry(tablePtr, &search);
	    entryPtr;
	    entryPtr = Tcl_NextTableEntry(&search)) {
		if(!strcmp(entryPtr->key, key)) { break; }
	}
	return entryPtr;
}
/*--------------------------------------------------------------------------*/
/* 削除 */
void Tcl_DeleteTableEntry(Tcl_TableEntry* entryPtr) {
	RemoveEntryList(&entryPtr->list_entry);
}
/*--------------------------------------------------------------------------*/
/* 走査開始 */
Tcl_TableEntry* Tcl_FirstTableEntry(Tcl_Table* tablePtr, Tcl_TableSearch* searchPtr) {
	searchPtr->list_head = searchPtr->list_entry = &tablePtr->list_head;
	return Tcl_NextTableEntry(searchPtr);
}
/*--------------------------------------------------------------------------*/
/* 走査 */
Tcl_TableEntry* Tcl_NextTableEntry(Tcl_TableSearch* searchPtr) {
	if((searchPtr->list_entry = searchPtr->list_entry->Flink) == searchPtr->list_head) { return NULL; }
	return CONTAINING_RECORD(searchPtr->list_entry, Tcl_TableEntry, list_entry);
}
/****************************************************************************
 *	
 ****************************************************************************/
static const struct {
	const char*			name;				//Name of command.
	Tcl_CmdProc*			proc;				//Procedure that executes command.
} TBL_TclBuiltInCmds[]={
	//Commands in the generic core:
	{"return",		Tcl_ReturnCmd},
	{"error",		Tcl_ErrorCmd},
	{"catch",		Tcl_CatchCmd},
	{"set",			Tcl_SetCmd},
	{"unset",		Tcl_UnsetCmd},
	{"append",		Tcl_AppendCmd},		//┬共通化した
	{"lappend",		Tcl_AppendCmd},		//┘
	{"proc",		Tcl_ProcCmd},
	{"rename",		Tcl_RenameCmd},
	{"uplevel",		Tcl_UplevelCmd},
	{"upvar",		Tcl_UpvarCmd},
	{"global",		Tcl_GlobalCmd},
	{"array",		Tcl_ArrayCmd},
	{"list",		Tcl_ListCmd},
	{"llength",		Tcl_LlengthCmd},
	{"lindex",		Tcl_LindexCmd},
	{"linsert",		Tcl_LinsertCmd},
	{"lrange",		Tcl_LrangeCmd},
	{"lreplace",		Tcl_LreplaceCmd},
	{"lsearch",		Tcl_LsearchCmd},
	{"lsort",		Tcl_LsortCmd},
	{"glob",		Tcl_GlobCmd},
	{"incr",		Tcl_IncrCmd},
	{"concat",		Tcl_ConcatCmd},
	{"join",		Tcl_JoinCmd},
	{"split",		Tcl_SplitCmd},
	{"eval",		Tcl_EvalCmd},
	{"expr",		Tcl_ExprCmd},
	{"break",		Tcl_BreakCmd},
	{"continue",		Tcl_ContinueCmd},
	{"if",			Tcl_IfCmd},
	{"while",		Tcl_WhileCmd},
	{"for",			Tcl_ForCmd},
	{"foreach",		Tcl_ForeachCmd},
	{"switch",		Tcl_SwitchCmd},
	{"string",		Tcl_StringCmd},
	{"format",		Tcl_FormatCmd},
	{"scan",		Tcl_ScanCmd},
	{"exit",		Tcl_ExitCmd},
	{"open",		Tcl_OpenCmd},
	{"close",		Tcl_CloseCmd},
	{"flush",		Tcl_FlushCmd},
	{"eof",			Tcl_EofCmd},
	{"tell",		Tcl_TellCmd},
	{"seek",		Tcl_SeekCmd},
	{"gets",		Tcl_GetsCmd},
	{"puts",		Tcl_PutsCmd},
	{"source",		Tcl_SourceCmd},
//	{"read",		Tcl_ReadCmd},		//対応しない
//	{"info",		Tcl_InfoCmd},		//対応しない
//	{"regexp",		Tcl_RegexpCmd},		//対応しない
//	{"regsub",		Tcl_RegsubCmd},		//対応しない
//	{"trace",		Tcl_TraceCmd},		//対応しない
//	{"cd",			Tcl_CdCmd},		//対応しない
//	{"exec",		Tcl_ExecCmd},		//対応しない
//	{"file",		Tcl_FileCmd},		//対応しない
//	{"pwd",			Tcl_PwdCmd},		//対応しない
//	{"time",		Tcl_TimeCmd},		//対応しない
};
/*--------------------------------------------------------------------------*/
Tcl_Interp* Tcl_CreateInterp() {
	Tcl_Interp* iPtr;
	int i;
	//Create a new TCL command interpreter.
	iPtr = calloc(sizeof(Tcl_Interp), 1);
	iPtr->result = "";
	Tcl_InitTable(&iPtr->commandTable);
	Tcl_InitTable(&iPtr->globalTable);
	Tcl_InitTable(&iPtr->arraySearchTable);
	Tcl_InitTable(&iPtr->fileTable);
	Tcl_CreateTableEntry(&iPtr->fileTable, "stdin",  NULL)->value = stdin;	//┐
	Tcl_CreateTableEntry(&iPtr->fileTable, "stdout", NULL)->value = stdout;	//├標準入出力を登録しておく。
	Tcl_CreateTableEntry(&iPtr->fileTable, "stderr", NULL)->value = stderr;	//┘
	//Create the built-in commands.
	for(i = 0; i < ARRAY_SIZE(TBL_TclBuiltInCmds); i++) {
		Tcl_CreateCommand(iPtr,
			TBL_TclBuiltInCmds[i].name,
			TBL_TclBuiltInCmds[i].proc, NULL);
	}
	return iPtr;
}
/*--------------------------------------------------------------------------*/
void Tcl_AppendElement(Tcl_Interp* iPtr, const char* elem) {
	elem = strescape(elem, " $;[]{}");	//エスケープする。
	if(!*elem) { elem = "\\0"; }		//空文字のリスト要素を表現するために必要。
	iPtr->result = strjoin(
		*iPtr->result ? " " : NULL,	//セパレータ有り。
		iPtr->result,
		elem,
		NULL);
}
/*--------------------------------------------------------------------------*/
void Tcl_AppendResult(Tcl_Interp* iPtr, const char* fmt, ...) {
	char* elem;
	va_list ap;
	va_start(ap, fmt);
	elem = strdup_vprintf(fmt, ap);		//エスケープしない。
	iPtr->result = strjoin(
		NULL,				//セパレータ無し。
		iPtr->result,
		elem,
		NULL);
	va_end(ap);
}
/*--------------------------------------------------------------------------*/
int Tcl_ReturnCmd(Tcl_Interp* iPtr) {
	if(iPtr->argc > 2) { goto syntaxError; }
	if(iPtr->argc == 2) { iPtr->result = iPtr->argv[1]; }
	return TCL_RETURN;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ErrorCmd(Tcl_Interp* iPtr) {
	if(iPtr->argc != 2) { goto syntaxError; }
	iPtr->result = iPtr->argv[1];
	return TCL_ERROR;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_CatchCmd(Tcl_Interp* iPtr) {
	int retCode;
	if((iPtr->argc < 2) || (iPtr->argc > 3)) { goto syntaxError; }
	retCode = Tcl_EvalString(iPtr, iPtr->argv[1]);
	if(iPtr->argc == 3) {
		if(!Tcl_SetVar(iPtr, iPtr->argv[2], iPtr->result)) {
			iPtr->result = "couldn't save command result in variable";
			return TCL_ERROR;
		}
	}
	iPtr->result = strdup_printf("%d", retCode);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
void Tcl_CreateCommand(Tcl_Interp* iPtr, const char* cmdName, Tcl_CmdProc* proc, void* data) {
	Tcl_TableEntry* tablePtr = Tcl_CreateTableEntry(&iPtr->commandTable, cmdName, NULL);
	Tcl_Command* cmdPtr = calloc(sizeof(Tcl_Command), 1);
	tablePtr->value = cmdPtr;
	cmdPtr->proc = proc;
	cmdPtr->data = data;
}
/*--------------------------------------------------------------------------*/
int Tcl_DeleteCommand(Tcl_Interp* iPtr, char* cmdName) {
	Tcl_TableEntry* tPtr = Tcl_FindTableEntry(&iPtr->commandTable, cmdName);
	if(!tPtr) { return -1; }
	Tcl_DeleteTableEntry(tPtr);
	return 0;
}
/****************************************************************************
 *	
 ****************************************************************************/
/* 文字列sが、完全なコマンドであるかを判断する。
 * 完全なコマンドとは、「(空白|;)＋(完全なワード)＋(空白|;)＋...」のことです。(←厳密な説明ではない。)
 * 完全なコマンドならば、0以外を返す。
 * 完全なコマンドでなければ、0を返す。
 * 文字列sがマルチステートメントである場合は、全ての(=最後の)ステートメントが完全であるかを判断する。 */
int Tcl_CommandComplete(const char* s) {
//{{2014/10/25変更:先行する空白を飛ばすだけでなく、コメント行も読み飛ばすように修正した。
//	for(;;) {
//		/* 先行する空白を飛ばす。 */
//		while(isspace(*s)) { s++; }
//		/* 0文字以上の空白で終端していたら、完全なコマンドである。 */
//		if(!*s) { return 1; }
//		/* ワードが完全であるかを判定する。 */
//		s = Tcl_WordEnd(s, 0);
//		/* ワードが不完全ならば、完全なコマンドでない。 */
//		if(!*s) { return 0; }
//		/* ワードの最後の文字の、次の文字から継続する。 */
//		s++;
//	}
//↓2014/10/25変更:先行する空白を飛ばすだけでなく、コメント行も読み飛ばすように修正した。
//│この処理を入れないと、「#格納」というコメント行を入力して改行したときに、完全なコマンドと見なされない。
//│なぜならば、「納」の2バイト目が'['と見なされ、改行してもコマンド継続と判断されてしまうからである。
//│元のTcl6.7のソースでは、Tcl_CommandComplete()においてはコメントを読み飛ばす処理が行われていなかったが、
//│Tcl_CommandComplete()においても、Tcl_Eval()と同様のコメントを読み飛ばす処理が必要だと思うので追加した。
//│ちなみに厳密には、日本語の2バイト目を'['と見なしてしまう問題は、コメントのみならず"～"の中でも起こり得るので、もっと問題は大きいのだが、
//│とりあえず、プログラム本体の中では日本語非対応としても、コメントで日本語を避けることは難しいので、コメントの問題のみ対処することにした。
//│尚、今回の方法で回避できるのは、「グローバルレベルのコメント」だけであり、「関数等のブロック内のコメント」の日本語の問題は回避できない。
//│「関数等のブロック内のコメント」はここではなくTcl_WordEnd()の中で解釈されるからである。
//│結局のところ、日本語は(コメントでも文字列でも)なるべく使用しないようにするのが安全だろう。
//│解決するにはstrescape(),strcompress()，ひいてはstrspn(),strcspn()等をマルチバイト対応に改造することだが、影響が大き過ぎるので行わないことにした。
//│□2014/10/25追記
//││上記の対応を行っても、***Tcl自体の仕様のために***、コメント内の括弧が見つけづらいバグに影響することは避けられない。
//││たとえば、本物のtclshで対話モードで実行し、
//││  if {1} {
//││  #if {2} {
//││    puts ok
//││  }
//││のように入力すると、二行目の括弧が閉じていないと判断されてコマンドが実行されない。(^Zを入力すると実行される。)
//││当実装では、^Zを入力しても正しく実行されず、missing close-braceエラーになる。
//││Tclのコメント内の括弧の扱いはいろいろとわかりづらいので、tclインタプリタよりも前段階で何かプリプロセッサ(cppとかm4とかsed等)を使って除去する方が安全な気がする。
//││Tclのコメント内の括弧の扱いについて、関連資料を「keep/Why_can_I_not_place_unmatched_braces_in_Tcl_comments」に保存した。
L_LineStart:
	//先行する空白,及び,セミコロンを飛ばす。
	while(isspace(*s) || (*s == ';')) { s++; }
	//0文字以上の空白で終端していたら、完全なコマンドである。
	if(!*s) { return 1; }
	//行頭,又は,マルチステートメントの先頭から見て、最初に現れた非空白文字が'#'ならばコメント行である。
	if(*s == '#') {
		for(;;) {
			s++;								//'#'の次の文字へ進める。
			if((*s == '\n') && (*(s-1) != '\\')) { goto L_LineStart; }	//エスケープされていない改行ならば、コメント終了と見なす。行頭からの処理に戻る。	行頭からの処理で'\n'も飛ばされるので、ここで進めなくて構わない。
			if(!*s) { return 0; }						//改行無しのコメントで文字列が終了した場合は、完全なコマンドでない。
		}
	//コメント行でなければ…
	} else {
		for(;;) {
			//ワードが完全であるかを判定する。
			s = Tcl_WordEnd(s, 0);
			//ワードが不完全ならば、完全なコマンドでない。
			if(!*s) { return 0; }
			//ワードがセミコロンで終端していたら、行頭からの処理に戻る。												行頭からの処理で';'も飛ばされるので、ここで進めなくて構わない。
			if(*s == ';') { goto L_LineStart; }
			//ワードの最後の文字の、次の文字から継続する。
			s++;
			//空白を飛ばす。
			while(isspace(*s)) {
				if(*s == '\n') { goto L_LineStart; }			//改行文字を見つけたら、行頭からの処理に戻る。						行頭からの処理で'\n'も飛ばされるので、ここで進めなくて構わない。
				s++;							//空白の次の文字へ進める。
			}
			//0文字以上の空白で終端していたら、完全なコマンドである。
			if(!*s) { return 1; }
		}
	}
//}}2014/10/25変更:先行する空白を飛ばすだけでなく、コメント行も読み飛ばすように修正した。
}
/*--------------------------------------------------------------------------*/
/* 文字列sの中の、最初に見つかったワードの、最後の文字へのポインタを返す。((+1)ではない。)
 * 文字列sの中に、最初に見つかったワードが不完全である場合は、ヌル文字へのポインタを返す。
 * 文字列sの中に、ワードが見つからなかった場合は、ヌル文字へのポインタを返す。 */
char* Tcl_WordEnd(const char* s, int nested) {
	char* p = (char*)s;
	/* 先行する空白を飛ばす。 */
	while(isspace(*p)) { p++; }
	/* ワードが二重引用符で開始していたら… */
	if(*p == '"') {
		/* 二重引用符が閉じる位置を取得する。 */
		p = Tcl_QuoteEnd(p + 1, '"');
		/* 二重引用符が閉じていなければ、ヌル文字へのポインタを返す。 */
		if(!*p) { return p; }
		/* 二重引用符が閉じる位置の、次の文字から継続する。
		 * 実際にはエラーであるが、当処理では継続する。Tcl_Eval()にてエラーとする。 */
		p++;
	/* ワードが左波括弧で開始していたら… */
	} else if(*p == '{') {
		/* 右波括弧の位置を取得する。 */
//{{暫定修正
//		strcompress(p, &p, "}");			//×××これでは{}のネストを見ておらず「switch 1 {{1}改行」でWordEndと見なしてしまっていた。×××
//		/* 波括弧が閉じていなければ、ヌル文字へのポインタを返す。 */
//		if(!*p) { return p; }
//		/* 右波括弧の、次の文字から継続する。
//		 * 実際にはエラーであるが、当処理では継続する。Tcl_Eval()にてエラーとする。 */
//		p++;
//↓暫定修正
		p = Tcl_IsBracedElement(p, nested ? ']' : 0);	//[～]の中ならば'}'の後に']'が続いていてもok
		/* 波括弧が閉じていなければ、ヌル文字へのポインタを返す。 */
		if(!p) { return strchr(s, '\0'); }		//Tcl_IsBracedElement()は閉じていなかった時にNULLを返すので、再度終端を探す必要が有る。暫定修正であり効率が悪いので、後でもっと効率の良い方法を検討せよ。
		//Tcl_IsBracedElement()は'}'の次の位置を返すのでp++は不要
//}}暫定修正
	}
	//Handle words that don't start with a brace or double-quote.
	//This code is also invoked if the word starts with a brace or double-quote and there is garbage after the closing brace or quote.
	//This is an error as far as Tcl_Eval is concerned, but for here the garbage is treated as part of the word.
	for(;;) {
///※?		/* 先行する空白を飛ばす。 */									//※※※※※※※※※※必要か不要か?要検討	┬この2行を有効にすると「while {1} {改行」でワード終了してしまうから不要。
///※?		while(isspace(*p)) { p++; }									//※※※※※※※※※※必要か不要か?要検討	┘
		/* 特殊文字までの文字列を、エスケープを解除して取得する。 */
		strcompress(p, &p, "\t\n\v\f\r $;[]");
		if(!*p) {
			//Nested commands can't end because of the end of the string.
			if(nested) { return p; }
			if(str_has_suffix(s, "\\\n")) { return p; } //文字列の最後に行継続(\+改行)が有る時にコマンド完成と見なさないための判定です。なおエスケープされた\+改行(\\+改行)の場合はコマンド完成と見なす必要が有りますがこの処理で判定できます。(\\+改行)の場合はここを通らずに一番下のブロックへ行き「return p-1」で改行の位置を返しTcl_CommandComplete()にてコマンド完了と判断されるからです。
			return p - 1;
		} else if(*p == '$') {
			p = Tcl_VarNameEnd(p + 1);
			if(!*p) { return p; }
			p++;
		} else if(*p == ';') {
			//Include the semi-colon in the word that is returned.
			return p;
		} else if(*p == '[') {
			do {
				p = Tcl_WordEnd(p + 1, 1);
				if(!*p) { return p; }
			} while(*p != ']');
			p++;
		} else if(*p == ']') {
			if(nested) { return p; }
			p++;
		} else /*if(isspace(*p))*/ {
			return p - 1;
		}
	}
}
/*--------------------------------------------------------------------------*/
/* 囲まれた文字列の、終了文字へのポインタを返す。((+1)ではない。)
 * 囲まれた文字列が、閉じていなかった場合は、ヌル文字へのポインタを返す。
 * sは、囲まれた文字列の、開始文字の次の文字を指定すること。
 * <例>「"ABC"」を調べる場合、s='A'の位置,termChar='"'を指定し、結果は'"'の位置となる。
 * <例>「(ABC)」を調べる場合、s='A'の位置,termChar=')'を指定し、結果は')'の位置となる。 */
char* Tcl_QuoteEnd(const char* s, int termChar) {
	char* p = (char*)s;
	char* delim = strdup_printf("$[%c", termChar);
	for(;;) {
		strcompress(p, &p, delim);
		if(*p == '$') {
			p = Tcl_VarNameEnd(p + 1);
			if(!*p) { return p; }
			p++;
		} else if(*p == '[') {
			do {
				p = Tcl_WordEnd(p + 1, 1);
				if(!*p) { return p; }
			} while(*p != ']');
			p++;
		} else /*if(!*p || (*p == termChar))*/ {
			return p;
		}
	}
}
/*--------------------------------------------------------------------------*/
/* 変数名の文字列の、最後の文字へのポインタを返す。((+1)ではない。)
 * 変数名が完全でなかった場合は、ヌル文字へのポインタを返す。
 * sは、変数名に先行する'$'の、次の文字(=変数名の一文字目)を指定すること。
 * <例>「$ABC」を調べる場合、s='A'の位置を指定し、結果は'C'の位置となる。
 * <例>「${ABC}」を調べる場合、s='{'の位置を指定し、結果は'}'の位置となる。
 * <例>「$ABC(123)」を調べる場合、s='A'の位置を指定し、結果は')'の位置となる。 */
char* Tcl_VarNameEnd(const char* s) {
	char* p = (char*)s;
	if(*p == '{') {
		while(*p && (*p != '}')) { p++; }
		return p;
	} else {
		while(iscsym(*p)) { p++; }
		if(*p == '(') { return Tcl_QuoteEnd(p + 1, ')'); }
		return p - 1;
	}
}
/****************************************************************************
 *	
 ****************************************************************************/
//文字列sに含まれる、マルチステートメントを実行する。
//又は、'['の次の文字から、']'までを実行する。
int Tcl_Eval(Tcl_Interp* iPtr, const char* s, char** termPtr, int termChar) {	//(termPtr=NULL)可
	int retCode, argc;
	char* p = (char*)s;
	char** argv;
	Tcl_TableEntry* tPtr;
	Tcl_Command* cmdPtr;
	/* 結果をクリアしておく。
	 *- こうしないと、空文字列を実行すると以下のwhileループを通らず、結果が不定になってしまう。 */
	retCode = TCL_OK;
	iPtr->result = "";
	/* 呼び出しの深さを増やす。 */
	if(iPtr->numLevels >= 99/*調整可*/) { DIE(); }
	iPtr->numLevels++;
	//There can be many sub-commands (separated by semi-colons or newlines) in one command string.
	//This outer loop iterates over individual commands.
	while(*p != termChar) {
		/* コメント行を読み飛ばす。コメント行を読み飛ばす処理はここだけである。
		 * - Tclは行の途中に有る'#'をコメントと見なさないので、コマンドの後に現れる'#'は考慮する必要が無い。
		 *   <例>「#puts ok」はコメント行である。「puts ok #xxx」は#以降をコメントと見なされずエラーとなる。 */
		while(isspace(*p) || (*p == ';')) { p++; }	//先行する空白,及び,セミコロンを飛ばす。
		if(*p == '#') {	//行頭,又は,マルチステートメントの先頭から見て、最初に現れた非空白文字が'#'ならばコメント行である。
			do {
				p++;	//次の文字へ進める。
				if((*p == '\n') && (*(p-1) != '\\')) { p++; break; }	//エスケープされていない改行ならば、コメント終了と見なす。改行の次の文字へ進め、抜ける。
			} while(*p);	//改行無しのコメントで文字列が終了した場合も抜ける。
		}
		/* コマンド文字列を分解し、引数配列を作成する。 */
		retCode = Tcl_ParseWords(iPtr, p, &p, termChar, &argc, &argv);	//正常終了ならば、pはヌル,又は,';'の位置を指す。
		if(retCode) { break; }	//エラーならば抜ける。呼び出しの深さを減らす必要が有るため、ここでreturnしてはいけない。
		//If this is an empty command (or if we're just parsing commands without evaluating them), then just skip to the next command.
		if(!argc || iPtr->noEval) { continue; }
		//Find the procedure to execute this command.
		tPtr = Tcl_FindTableEntry(&iPtr->commandTable, argv[0]);
		if(!tPtr) {
			iPtr->result = strdup_printf("invalid command name: \"%s\"", argv[0]);
			retCode = TCL_ERROR;
			break;		//エラーならば抜ける。呼び出しの深さを減らす必要が有るため、ここでreturnしてはいけない。
		}
		cmdPtr = tPtr->value;
		//At long last, invoke the command procedure.
		//Reset the result to its default empty value first (it could have gotten changed by earlier commands in the same command string).	←←←←←重要
		iPtr->result = "";
		{
			/* 呼び出しパラメータを退避する。 */
			int    save_argc = iPtr->argc;
			char** save_argv = iPtr->argv;
			void*  save_data = iPtr->data;
			/* 呼び出しパラメータを設定する。 */
			iPtr->argc = argc;
			iPtr->argv = argv;
			iPtr->data = cmdPtr->data;
			/* プロシージャ関数を呼び出す。 */
			retCode = (*cmdPtr->proc)(iPtr);
			/* 呼び出しパラメータを退避する。 */
			iPtr->argc = save_argc;
			iPtr->argv = save_argv;
			iPtr->data = save_data;
		}
		if(retCode) { break; }	//TCL_OK以外(=TCL_ERROR,TCL_RETURN,TCL_BREAK,TCL_CONTINUE,...)ならば抜ける。呼び出しの深さを減らす必要が有るため、ここでreturnしてはいけない。
	}
	/* 呼び出しの深さを減らす。 */
	iPtr->numLevels--;
	/* 呼び出しの深さが0になったら… */
	if(!iPtr->numLevels) {
		/* 戻り値によって… */
		switch(retCode) {
		case TCL_OK:
		case TCL_ERROR:
			/** no job **/
			break;
		case TCL_RETURN:
			/* トップレベルにreturnを書いた場合、正常終了とする。 */
			retCode = TCL_OK;
			break;
		case TCL_BREAK:
			/* トップレベルにbreakを書いた場合、エラー終了とする。 */
			iPtr->result = "invoked \"break\" outside of a loop";
			retCode = TCL_ERROR;
			break;
		case TCL_CONTINUE:
			/* トップレベルにcontinueを書いた場合、エラー終了とする。 */
			iPtr->result = "invoked \"continue\" outside of a loop";
			retCode = TCL_ERROR;
			break;
		default:
			/* それ以外の戻り値の場合、結果文字列を設定した上で、通常のエラー扱いとする。 */
			iPtr->result = strdup_printf("command returned bad code: %d", retCode);
			retCode = TCL_ERROR;
			break;
		}
	}
	if(termPtr) { *termPtr = p; }	//終端位置を格納する。
	return retCode;
}
/*--------------------------------------------------------------------------*/
int Tcl_EvalString(Tcl_Interp* iPtr, const char* s) {
	return Tcl_Eval(iPtr, s, NULL, 0);
}
/*--------------------------------------------------------------------------*/
int Tcl_EvalFile(Tcl_Interp* iPtr, FILE* fp) {
	int interactive = isatty(fileno(fp));	//コンソールならば対話的実行とする
	int retCode;
	do {
		const char* s = "";
		/* 対話的実行ならば… */
		if(interactive) {
			/* プロンプトを表示する。 */
			fputs("% ", stdout);
			fflush(     stdout);
		}
		do {
			do {
				char line[80/*調整可*/];
				/* 文字列を読み込む。終端ならば抜ける。 */
				if(!fgets(line, sizeof line, fp)) { break; }
				/* 文字列を連結する。 */
				s = strjoin(NULL, s, line, NULL);
			/* 行末ならば抜ける。 */
			} while(!str_has_suffix(s, "\n"));
			/* 終端ならば抜ける。 */
			if(feof(fp)) { break; }
		/* コマンドが完成するまで繰り返す。 */
		} while(!Tcl_CommandComplete(s));
		/* コマンドを実行する。 */
		retCode = Tcl_EvalString(iPtr, s);
		/* 対話的実行ならば… */
		if(interactive) {
			/* 結果,又は,エラーを表示する。 */
			if(retCode) {
				printf("Error");
				if(retCode != TCL_ERROR) { printf(" %d", retCode); }
				if(*iPtr->result) { printf(": %s", iPtr->result); }
			} else {
				if(*iPtr->result) { printf("%s", iPtr->result); }
			}
			if(retCode || *iPtr->result) { printf("\n"); }
		/* 対話的実行でなければ… */
		} else {
			if(retCode) { break; }
		}
	/* 終端まで繰り返す。 */
	} while(!feof(fp));
	/* 最後の結果を返す。 */
	return retCode;
}
/*--------------------------------------------------------------------------*/
//一個のステートメントに相当する、ワード配列をパースする。
//又は、'['の次の文字から、']'までをパースする。
int Tcl_ParseWords(Tcl_Interp* iPtr, const char *s, char** termPtr, int termChar, int* argcPtr, char*** argvPtr) {
	int retCode, type, argc = 0;
	char* p = (char*)s;
	char** argv = NULL;
	for(;;) {
		char* elem = strdup("");
		/* 先行する空白を読み飛ばす。 */
		while((type = Tcl_CharType(*p, termChar)) == TCL_SPACE) { p++; }
		/* バックスラッシュの場合… */
		if(type == TCL_BACKSLASH) {
			/* 行継続ならば、次の行の先行する空白を読み飛ばす処理を繰り返す。 */
			if(*(p+1) == '\n') {
				p += 2;
			/* 行継続以外のバックスラッシュならば、通常文字と同じ扱いとする。 */
			} else {
				type = TCL_NORMAL;
			}
		}
		if(type == TCL_COMMAND_END) {
			if(!*p && (termChar == ']')) {	//ネストしたコマンドが']'で終端する前に、文字列の終端に達した場合はエラー。
				iPtr->result = "missing close-bracket";
				return TCL_ERROR;
			}
			break;	//コマンド終了
		} else if(type == TCL_QUOTE) {
			retCode = Tcl_ParseQuotes(iPtr, p+1, &p, '"');	//正常終了ならば、pは'"'の位置を指す。
			if(retCode) { return retCode; }
			elem = strjoin(NULL, elem, iPtr->result, NULL);
			p++;						//pを'"'の次へ進める。
			/* 閉じる'"'の次に許されるのは、空白,終端文字,行継続のみである。 */
			type = Tcl_CharType(*p, termChar);
			if((type == TCL_SPACE) ||				//空白
			   (type == TCL_COMMAND_END) ||				//終端文字
			  ((type == TCL_BACKSLASH) && (*(p+2) == '\n'))) {	//行継続
				//上記のいずれかならばok。次のワードの、「先行する空白を読み飛ばす」処理で、読み飛ばされる。
			} else {
				iPtr->result = "extra characters after close-quote";
				return TCL_ERROR;
			}
			//ワード終了
		} else if(type == TCL_OPEN_BRACE) {
			retCode = Tcl_ParseBraces(iPtr, p+1, &p, termChar);	//正常終了ならば、pは'}'の位置を指す。
			if(retCode) { return retCode; }
			elem = strjoin(NULL, elem, iPtr->result, NULL);
			p++;						//pを'}'の次へ進める。
			/* 閉じる'}'の次に許されるのは、空白,終端文字,行継続のみである。 */
			type = Tcl_CharType(*p, termChar);
			if((type == TCL_SPACE) ||				//空白
			   (type == TCL_COMMAND_END) ||				//終端文字
			  ((type == TCL_BACKSLASH) && (*(p+2) == '\n'))) {	//行継続
				//上記のいずれかならばok。次のワードの、「先行する空白を読み飛ばす」処理で、読み飛ばされる。
			} else {
				iPtr->result = "extra characters after close-brace";
				return TCL_ERROR;
			}
			//ワード終了
		} else {
			for(;;) {
				/* 特殊文字の手前までエスケープ解除し、文字列に追加する。 */
				char* value = strcompress(p, &p, "\t\n\v\f\r $;[]");	//ここはネストしたコマンド外なので、終端文字(']'or'\0')の考慮不要です。
				elem = strjoin(NULL, elem, value, NULL);
				/* 特殊文字の種類によって… */
				type = Tcl_CharType(*p, termChar);
				if((type == TCL_SPACE) || (type == TCL_COMMAND_END)) {
					break;	//ワード終了
				} else if(type == TCL_OPEN_BRACKET) {
					retCode = Tcl_Eval(iPtr, p+1, &p, ']');		//正常終了ならば、pは']'の位置を指す。
					if(retCode) { return retCode; }
					elem = strjoin(NULL, elem, iPtr->result, NULL);
					p++;						//pを']'の次へ進める。
					//ワード継続
				} else if(type == TCL_DOLLAR) {
					value = Tcl_ParseVar(iPtr, p+1, &p);		//正常終了ならば、pは変数名(又は変数名を囲む'}')の次の位置を指す。
					if(!value) { return TCL_ERROR; }
					elem = strjoin(NULL, elem, value, NULL);
					//ワード継続
				} else {
					elem = strdup_printf("%s%c", elem, *p++);	//特殊文字だがこのコンテキストでは通常文字扱いする。
					//ワード継続
				}
			}
		}
		/* 要素を格納する。 */
		argv = realloc(argv, sizeof(char*) * (argc+1));
		argv[argc++] = elem;
	}
	/* 終端のNULLを格納する。 */
	argv = realloc(argv, sizeof(char*) * (argc+1));
	argv[argc] = NULL;
	/* 終端位置,要素数,要素配列を格納する。 */
	*termPtr = p;	//(termChar!=0)を指定した場合は、termCharの位置か,又は,ヌルの位置を指す。(termChar=0)を指定した場合は、ヌルの位置を指す。
	*argcPtr = argc;
	*argvPtr = argv;
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
//'"'の次の文字から、'"'までをパースする。
//又は、'('の次の文字から、')'までをパースする。
int Tcl_ParseQuotes(Tcl_Interp* iPtr, const char* s, char** termPtr, int rightChar) {
	int retCode;
	char* p = (char*)s;
	char* delim = strdup_printf("\t\n\v\f\r $;[]%c", rightChar);	//特殊文字+終端文字
	char* elem = strdup("");
	for(;;) {
		/* 特殊文字,又は,終端文字の手前までエスケープ解除し、文字列に追加する。 */
		char* value = strcompress(p, &p, delim);		//正常終了ならば、pは特殊文字,又は,終端文字,又は,ヌルの位置を指す。
		elem = strjoin(NULL, elem, value, NULL);
		if(!*p) {
			iPtr->result = strdup_printf("missing %c", rightChar);	//終端文字よりも先に、文字列の終端に達した場合はエラー
			return TCL_ERROR;
		} else if(*p == rightChar) {
			break;	//終了
		} else if(*p == '$') {
			value = Tcl_ParseVar(iPtr, p+1, &p);		//正常終了ならば、pは変数名(又は変数名を囲む'}')の次の位置を指す。
			if(!value) { return TCL_ERROR; }
			elem = strjoin(NULL, elem, value, NULL);
			//継続
		} else if(*p == '[') {
			retCode = Tcl_Eval(iPtr, p+1, &p, ']');		//正常終了ならば、pは']'の位置を指す。
			if(retCode) { return retCode; }
			elem = strjoin(NULL, elem, iPtr->result, NULL);
			p++;						//pを']'の次へ進める。
			//継続
		} else {
			elem = strdup_printf("%s%c", elem, *p++);	//特殊文字だがこのコンテキストでは通常文字扱いする。
			//継続
		}
	}
	iPtr->result = elem;	//結果を格納する。
	*termPtr = p;		//終端文字,又は,ヌルの位置を格納する。
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
//'{'の次の文字から、'}'までをパースする。
int Tcl_ParseBraces(Tcl_Interp* iPtr, const char* s, char** termPtr, int termChar) {
	char* p = (char*)s;			//'{'の次の位置
	/* 波括弧で囲まれた要素でなければエラー。 */
	char* endp = Tcl_IsBracedElement(p-1, termChar);	//正常終了ならば、endpは'}'の次の位置を指す。
	if(!endp) {
		iPtr->result = "missing close-brace";
		return TCL_ERROR;
	}
	endp--;					//endpは'}'の位置を指す。
	/* 波括弧の中の文字列を、エスケープを解除せずに取得する。 */
	iPtr->result = strndup(p, endp-p);
	*termPtr = endp;			//'}'の位置
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
//'$'の次の文字から、変数名(又は変数名を囲む'}')の次の位置まで。 */
char* Tcl_ParseVar(Tcl_Interp* iPtr, const char* s, char** termPtr) {
	int retCode;
	char *p = (char*)s, *q;
	const char *name1, *name2 = NULL;
	if(*p == '{') {
		p++;					//p='{'の次の位置
		for(q = p; *q != '}'; q++) {		//q='}'の位置まで
			if(!*q) { return NULL; }
		}
		name1 = strndup(p, q-p);		//'{'の次の位置から'}'の前の位置まで複製
		p = q+1;				//p='}'の次の位置
	} else {
		for(q = p; iscsym(*q); q++) { }		//q=変数名として有効な文字の次の位置まで
		name1 = strndup(p, q-p);		//変数名を複製
		p = q;					//p=変数名として有効な文字の次の位置
		if(*p == '(') {
			retCode = Tcl_ParseQuotes(iPtr, p+1, &q, ')');	//正常終了ならば、pは')'の位置を指す。
			if(retCode) { return NULL; }
			name2 = iPtr->result;		//配列の要素名を取得
			p = q+1;			//p=')'の次の位置
		}
	}
	*termPtr = p;					//'}'の次の位置,又は,変数名として有効な文字の次の位置,又は,')'の次の位置
	return Tcl_GetVar2(iPtr, name1, name2);
}
/****************************************************************************
 *	
 ****************************************************************************/
static void Tcl_VarErrMsg(Tcl_Interp* iPtr, const char* name1, const char* name2, const char* operation, const char* reason) {
	if(name2) {
		iPtr->result = strdup_printf("can't %s \"%s(%s)\": %s", operation, name1, name2, reason);
	} else {
		iPtr->result = strdup_printf("can't %s \"%s\": %s", operation, name1, reason);
	}
}
static const char noSuchVar[]     = "no such variable";
static const char noSuchElement[] = "no such element in array";
static const char needScalar[]    = "variable isn't scalar";
static const char needArray[]     = "variable isn't array";
/*--------------------------------------------------------------------------*/
static void Tcl_SplitVarName(const char* name, char** name1, char** name2) {
	char *lp, *rp;
	if((lp = strchr(name, '(')) &&			//'('が有り、
	   (rp = strchr(  lp, ')')) &&			//'('以降に')'が有り、
	   (!*(rp+1))) {				//')'が最後の文字ならば…
		*name1 = strndup(name, lp-name);	//   最初の文字から、'('の前の文字まで
		*name2 = strndup(lp+1, rp-lp-1);	//'('の次の文字から、')'の前の文字まで
	} else {
		*name1 = strdup( name);
		*name2 = NULL;
	}
}
char* Tcl_GetVar(Tcl_Interp* iPtr, const char* name) {
	char *name1, *name2;
	Tcl_SplitVarName(name, &name1, &name2);
	return Tcl_GetVar2(iPtr, name1, name2);
}
char* Tcl_SetVar(Tcl_Interp* iPtr, char* name, const char* value) {
	char *name1, *name2;
	Tcl_SplitVarName(name, &name1, &name2);
	return Tcl_SetVar2(iPtr, name1, name2, value);
}
int Tcl_UnsetVar(Tcl_Interp* iPtr, char* name) {
	char *name1, *name2;
	Tcl_SplitVarName(name, &name1, &name2);
	return Tcl_UnsetVar2(iPtr, name1, name2);
}
/*--------------------------------------------------------------------------*/
char* Tcl_GetVar2(Tcl_Interp* iPtr, const char* name1, const char* name2) {
	Tcl_Table* tablePtr;
	Tcl_TableEntry* tPtr;
	Tcl_Var* varPtr;
	/* 変数テーブルを取得する。 */
	tablePtr = iPtr->varFramePtr ? &iPtr->varFramePtr->varTable : &iPtr->globalTable;
	/* 変数を取得する。 */
	tPtr = Tcl_FindTableEntry(tablePtr, name1);
	if(!tPtr) {
		Tcl_VarErrMsg(iPtr, name1, name2, "read", noSuchVar);
		return NULL;
	}
	varPtr = tPtr->value;
	/* 上位プロシージャの変数ならば… */
	if(varPtr->type == TCL_VAR_UPVAR) {
		tPtr = varPtr->value.upvar;
		varPtr = tPtr->value;
	}
	/* 配列の要素名が指定されていたら… */
	if(name2) {
		/* 定義済みの配列であることを確認する。 */
		if(varPtr->type != TCL_VAR_ARRAY) {
			Tcl_VarErrMsg(iPtr, name1, name2, "read", needArray);
			return NULL;
		}
		/* 配列の要素を取得する。 */
		tPtr = Tcl_FindTableEntry(varPtr->value.array, name2);
		if(!tPtr) {
			Tcl_VarErrMsg(iPtr, name1, name2, "read", noSuchElement);
			return NULL;
		}
		varPtr = tPtr->value;
	}
	/* 定義済みの変数であることを確認する。 */
	if(varPtr->type != TCL_VAR_SCALAR) {
		Tcl_VarErrMsg(iPtr, name1, name2, "read", needScalar);
		return NULL;
	}
	/* 変数の値を返す。 */
	return varPtr->value.scalar;
}
/*--------------------------------------------------------------------------*/
char* Tcl_SetVar2(Tcl_Interp* iPtr, const char* name1, const char* name2, const char* value) {
	int bNew;
	Tcl_Table* tablePtr;
	Tcl_TableEntry* tPtr;
	Tcl_Var* varPtr;
	/* 変数テーブルを取得する。 */
	tablePtr = iPtr->varFramePtr ? &iPtr->varFramePtr->varTable : &iPtr->globalTable;
	/* 変数テーブルのエントリを作成,又は,取得する。 */
	tPtr = Tcl_CreateTableEntry(tablePtr, name1, &bNew);
	/* 新規の変数ならば… */
	if(bNew) {
		/* 変数を作成する。 */
		varPtr = calloc(sizeof(Tcl_Var), 1);
		tPtr->value = varPtr;
	/* 既存の変数ならば… */
	} else {
		/* 変数を取得する。 */
		varPtr = tPtr->value;
		/* 上位プロシージャの変数ならば… */
		if(varPtr->type == TCL_VAR_UPVAR) {
			tPtr = varPtr->value.upvar;
			/* 変数を取得する。 */
			varPtr = tPtr->value;
		}
	}
	/* 配列の要素名が指定されていたら… */
	if(name2) {
		/* 未定義の変数ならば… */
		if(!varPtr->type) {	//未定義変数へのupvar,又は,すぐ上で作成した変数 */
			varPtr->type = TCL_VAR_ARRAY;
			varPtr->value.array = calloc(sizeof(Tcl_Table), 1);
			Tcl_InitTable(varPtr->value.array);
		/* 定義済みの変数ならば、配列であることを確認する。 */
		} else if(varPtr->type != TCL_VAR_ARRAY) {
			Tcl_VarErrMsg(iPtr, name1, name2, "set", needArray);
			return NULL;
		}
		/* 配列の要素のエントリを作成,又は,取得する。 */
		tPtr = Tcl_CreateTableEntry(varPtr->value.array, name2, &bNew);
		/* 新規の要素ならば… */
		if(bNew) {
			/* 要素を作成する。 */
			varPtr = calloc(sizeof(Tcl_Var), 1);
			tPtr->value = varPtr;
		/* 既存の要素ならば… */
		} else {
			/* 要素を取得する。 */
			varPtr = tPtr->value;
		}
	}
	/* 変数,又は,配列の要素が、未定義,又は,スカラであることを確認する。 */
	if(varPtr->type && (varPtr->type != TCL_VAR_SCALAR)) {
		Tcl_VarErrMsg(iPtr, name1, name2, "set", needScalar);
		return NULL;
	}
	/* 変数の値を設定する。 */
	varPtr->type = TCL_VAR_SCALAR;
	return (varPtr->value.scalar = strdup(value));
}
/*--------------------------------------------------------------------------*/
int Tcl_UnsetVar2(Tcl_Interp* iPtr, const char* name1, const char* name2) {
	Tcl_Table* tablePtr;
	Tcl_TableEntry* tPtr;
	Tcl_Var* varPtr;
	/* 変数テーブルを取得する。 */
	tablePtr = iPtr->varFramePtr ? &iPtr->varFramePtr->varTable : &iPtr->globalTable;
	/* 変数を取得する。 */
	tPtr = Tcl_FindTableEntry(tablePtr, name1);
	if(!tPtr) {
		Tcl_VarErrMsg(iPtr, name1, name2, "read", noSuchVar);
		return -1;
	}
	varPtr = tPtr->value;
	/* 上位プロシージャの変数ならば… */
	if(varPtr->type == TCL_VAR_UPVAR) {
		tPtr = varPtr->value.upvar;
		varPtr = tPtr->value;
	}
	/* 配列の要素名が指定されていたら… */
	if(name2) {
		/* 定義済みの配列であることを確認する。 */
		if(varPtr->type != TCL_VAR_ARRAY) {
			Tcl_VarErrMsg(iPtr, name1, name2, "read", needArray);
			return -1;
		}
		/* 配列の要素を取得する。 */
		tPtr = Tcl_FindTableEntry(varPtr->value.array, name2);
		if(!tPtr) {
			Tcl_VarErrMsg(iPtr, name1, name2, "read", noSuchElement);
			return -1;
		}
		varPtr = tPtr->value;
	}
	/* 定義済みの変数,又は,定義済みの配列であることを確認する。 */
	if(!varPtr->type) {
		Tcl_VarErrMsg(iPtr, name1, name2, "read", noSuchVar);
		return -1;
	}
	/* 変数を削除する。 */
	Tcl_DeleteTableEntry(tPtr);
	return 0;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_SetCmd(Tcl_Interp* iPtr) {
	const char* s;
	if(iPtr->argc == 2) {
		s = Tcl_GetVar(iPtr, iPtr->argv[1]);
		if(!s) { return TCL_ERROR; }
		iPtr->result = s;
	} else if(iPtr->argc == 3) {
		s = Tcl_SetVar(iPtr, iPtr->argv[1], iPtr->argv[2]);
		if(!s) { return TCL_ERROR; }
		iPtr->result = s;
	} else {
		iPtr->result = "syntax error";
		return TCL_ERROR;
	}
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_UnsetCmd(Tcl_Interp* iPtr) {
	int i;
	for(i = 1; i < iPtr->argc; i++) {
		if(Tcl_UnsetVar(iPtr, iPtr->argv[i])) { return TCL_ERROR; }
	}
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_AppendCmd(Tcl_Interp* iPtr) {
	const char* s;
	int i;
	if(iPtr->argc < 2) {
		iPtr->result = "syntax error";
		return TCL_ERROR;
	}
	s = Tcl_GetVar(iPtr, iPtr->argv[1]);
	if(!s) { s = ""; }
	for(i = 2; i < iPtr->argc; i++) {
		const char* elem = iPtr->argv[i];
		if(*iPtr->argv[0] == 'l') {	//lappendの場合
			elem = strescape(elem, " $;[]{}");		//各要素をエスケープする。
			if(!*elem) { elem = "\\0"; }			//空文字のリスト要素を表現するために必要。
			s = strjoin(*s ? " " : NULL, s, elem, NULL);	//セパレータ有り。
		} else {			// appendの場合
			s = strjoin(           NULL, s, elem, NULL);	//セパレータ無し。各要素をエスケープしない。
		}
	}
	s = Tcl_SetVar(iPtr, iPtr->argv[1], s);
	if(!s) { return TCL_ERROR; }
	iPtr->result = s;
	return TCL_OK;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_GetInt(Tcl_Interp* iPtr, const char* s, int* intPtr) {
	char* p = (char*)s;
	int i = strtol(p, &p, 0);		//数値を取得する。
	while(*p && isspace(*p)) { p++; }	//数値の後の空白を読み飛ばす。
	if((p == s) || *p) {			//空文字列が指定されたか,又は,数値の後に空白以外が有ればエラー。
		iPtr->result = strdup_printf("expected integer but got \"%s\"", s);
		return TCL_ERROR;
	}
	*intPtr = i;
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_GetDouble(Tcl_Interp* iPtr, const char* s, double* doublePtr) {
	char* p = (char*)s;
	double d = strtod(p, &p);		//数値を取得する。
	while(*p && isspace(*p)) { p++; }	//数値の後の空白を読み飛ばす。
	if((p == s) || *p) {			//空文字列が指定されたか,又は,数値の後に空白以外が有ればエラー。
		iPtr->result = strdup_printf("expected floating-point number but got \"%s\"", s);
		return TCL_ERROR;
	}
	*doublePtr = d;
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_GetBoolean(Tcl_Interp* iPtr, const char* s, int* boolPtr) {
	//トリムして小文字化する。
	char* p = strlwr(strtrim(s, 0, NULL));
	//空文字でなければ…
	if(*p) {
		static const char TBL_boolStr[3][2][5/*最大長*/+1/*nul*/]={
			{"false","true"},
			{"no"   ,"yes" },
			{"off"  ,"on"  },
		};
		int i, mask = 0;
		double d;
		//論理値の名称のいずれかに前方部分一致するか?
		for(i = 0; i < ARRAY_SIZE(TBL_boolStr); i++) {
			if(str_has_prefix(TBL_boolStr[i][0], p)) { mask |= (1<<0); } //偽の名称に一致したことをマーク
			if(str_has_prefix(TBL_boolStr[i][1], p)) { mask |= (1<<1); } //真の名称に一致したことをマーク
		}
		if(mask == (1<<0)) { *boolPtr = 0; return TCL_OK; } //偽の名称のみに一致したら、偽と決定する。┬"o"は両方に一致するので除外するための対策です。
		if(mask == (1<<1)) { *boolPtr = 1; return TCL_OK; } //真の名称のみに一致したら、真と決定する。┘
		//数値か? (整数もstrtod()で変換できるのでstrtol()は不要)
		d = strtod(p, &p);	//これ以降pを参照しないので破壊して大丈夫
		if(!*p) {
			*boolPtr = !!d;
			return TCL_OK;
		}
	}
	//空文字,又は,上記の方法で判定できなければエラー。
	iPtr->result = strdup_printf("expected boolean value but got \"%s\"", s);
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
static int Tcl_InterpProc(Tcl_Interp* iPtr) {
	int retCode, argc;
	char* value;
	char** argv;
	Tcl_Proc* procPtr;
	Tcl_Arg* argPtr;
	Tcl_CallFrame frame;
	/* フレームを作成し、追加する。 */
	memset(&frame, 0, sizeof frame.varTable);
	Tcl_InitTable(&frame.varTable);
	if(iPtr->varFramePtr) { frame.level = iPtr->varFramePtr->level; }
	frame.level++;
///	frame.argc         = iPtr->argc;		//要らないんじゃないか?確認できたら削除しよう｡
///	frame.argv         = iPtr->argv;		//要らないんじゃないか?確認できたら削除しよう｡
	frame.callerPtr    = iPtr->framePtr;
	frame.callerVarPtr = iPtr->varFramePtr;
	iPtr->framePtr     = &frame;
	iPtr->varFramePtr  = &frame;
	//Match the actual arguments against the procedure's formal parameters to compute local variables.
	argc    = iPtr->argc - 1;	//実引数の残り数
	argv    = iPtr->argv + 1;
	procPtr = iPtr->data;
	for(argPtr = procPtr->argPtr; argPtr; argPtr = argPtr->nextArgPtr) {	//全ての仮引数について…
		/* 最後の仮引数で、名前がargsならば… */
		if(!argPtr->nextArgPtr && !strcmp(argPtr->name, "args")) {
			value = Tcl_Merge(argc, argv);		//実引数の残りをリストにする。
			Tcl_SetVar(iPtr, argPtr->name, value);	//実引数の残りをリストにした結果を、ローカル変数"args"に設定する。
			argc = 0;				//実引数の残りを全て消費した。
		} else {
			/* 実引数の残りが有れば… */
			if(argc) {
				         argc--;
				value = *argv++;
			/* 実引数の残りが無いが、デフォルト値が有れば… */
			} else if(argPtr->defValue) {
				value = argPtr->defValue;
			} else {
				iPtr->result = strdup_printf("no value given for parameter \"%s\" to \"%s\"", argPtr->name, iPtr->argv[0]);	//実引数が不足
				retCode = TCL_ERROR;
				goto L_RET;
			}
			Tcl_SetVar(iPtr, argPtr->name, value);	//実引数,又は,デフォルト値を、ローカル変数に設定する。
		}
	}
	if(argc) {	//仮引数よりも実引数が多ければ…
		iPtr->result = strdup_printf("called \"%s\" with too many arguments", iPtr->argv[0]);	//実引数が超過
		retCode = TCL_ERROR;
		goto L_RET;
	}
	/* コマンドを実行する。 */
	retCode = Tcl_EvalString(iPtr, procPtr->command);
	switch(retCode) {
	case TCL_RETURN:
		retCode = TCL_OK;	//プロシージャをreturnで抜けた場合、正常終了とする。
		break;
	case TCL_BREAK:
		iPtr->result = "invoked \"break\" outside of a loop";
		retCode = TCL_ERROR;	//プロシージャをbreakで抜けた場合、エラーとする。
		break;
	case TCL_CONTINUE:
		iPtr->result = "invoked \"continue\" outside of a loop";
		retCode = TCL_ERROR;	//プロシージャをcontinueで抜けた場合、エラーとする。
		break;
	}
L_RET:
	/* フレームを削除する。 */
	iPtr->framePtr    = frame.callerPtr;
	iPtr->varFramePtr = frame.callerVarPtr;
	return retCode;
}
/*--------------------------------------------------------------------------*/
int Tcl_ProcCmd(Tcl_Interp* iPtr) {
	int i, argCount, fieldCount;
	char **argArray, **fieldValues;
	Tcl_Arg *argPtr, **lastArgPtr;
	Tcl_Proc* procPtr;
	if(iPtr->argc != 4) {
		iPtr->result = "syntax error";
		return TCL_ERROR;
	}
	/* プロシージャ構造体を作成する。 */
	procPtr = calloc(sizeof(Tcl_Proc), 1);
	procPtr->command = strdup(iPtr->argv[3]);
	lastArgPtr = &procPtr->argPtr;
	/* 仮引数リストを分割する。 */
	argCount = Tcl_SplitList(iPtr->argv[2], &argArray);
	for(i = 0; i < argCount; i++) {
		/* 一個の仮引数を、仮引数名とデフォルト値(有れば)に分割する。 */
		fieldCount = Tcl_SplitList(argArray[i], &fieldValues);
		if(!fieldCount || !*fieldValues[0]) {
			iPtr->result = strdup_printf("procedure \"%s\" has argument with no name", iPtr->argv[1]);
			return TCL_ERROR;
		}
		if(fieldCount > 2) {
			iPtr->result = strdup_printf("too many fields in argument specifier \"%s\"", argArray[i]);
			return TCL_ERROR;
		}
		/* 仮引数構造体を作成する。 */
		argPtr = calloc(sizeof(Tcl_Arg), 1);
		argPtr->name = strdup(fieldValues[0]);
		if(fieldCount == 2) { argPtr->defValue = strdup(fieldValues[1]); }
		/* 仮引数構造体を追加する。 */
		*lastArgPtr = argPtr;
		lastArgPtr = &argPtr->nextArgPtr;
	}
	/* コマンドを登録する。 */
	Tcl_CreateCommand(iPtr, iPtr->argv[1], Tcl_InterpProc, procPtr);
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_RenameCmd(Tcl_Interp* iPtr) {
	Tcl_Command* cmdPtr;
	Tcl_TableEntry *tPtr1, *tPtr2;
	if(iPtr->argc != 3) { goto syntaxError; }
	if(!*iPtr->argv[2]) {	//newNameが空文字列ならばoldNameのコマンドを削除する。
		if(Tcl_DeleteCommand(iPtr, iPtr->argv[1])) { return TCL_ERROR; }
		return TCL_OK;
	}
	tPtr1 = Tcl_FindTableEntry(&iPtr->commandTable, iPtr->argv[1]);
	tPtr2 = Tcl_FindTableEntry(&iPtr->commandTable, iPtr->argv[2]);
	if(!tPtr1 || tPtr2) {	//oldNameのコマンドが存在しないか、newNameのコマンドが存在したらエラー。
		iPtr->result = "can't rename";
		return TCL_ERROR;
	}
	//oldNameのエントリを削除し、newNameのエントリを作成し、oldNameのコマンドをnewNameに付け替える。
	cmdPtr = tPtr1->value;
	Tcl_DeleteTableEntry(tPtr1);
	tPtr2 = Tcl_CreateTableEntry(&iPtr->commandTable, iPtr->argv[2], NULL);
	tPtr2->value = cmdPtr;
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
static int Tcl_GetFrame(Tcl_Interp* iPtr, const char* s, Tcl_CallFrame** pFramePtr) {
	int i, level;
	Tcl_CallFrame* framePtr = iPtr->varFramePtr;
	if(!framePtr) {
		iPtr->result = "already at top level";				//※要検討：トップレベルでも「uplevel #0」や「uplevel 0」は許可すべきではないか？
		return -1;
	}
	//Parse string to figure out which level number to go to.
	if(*s == '#') {
		if(Tcl_GetInt(iPtr, s+1, &level)) { return -1; }
		i = 1;	//レベル指定に引数要素を1個使用
	} else if(isdigit(*s)) {
		if(Tcl_GetInt(iPtr, s  , &level)) { return -1; }
		level = framePtr->level - level;
		i = 1;	//レベル指定に引数要素を1個使用
	} else {
		level = framePtr->level - 1;
		i = 0;	//レベル指定に引数要素を0個使用
	}
	//Figure out which frame to use, and modify the interpreter so its variables come from that frame.
	if(level) {
		while(framePtr->level != level) {
			if(!(framePtr = framePtr->callerVarPtr)) {
				iPtr->result = strdup_printf("bad level \"%s\"", s);
				return -1;
			}
		}
	} else {
		framePtr = NULL;
	}
	*pFramePtr = framePtr;
	return i;
}
/*--------------------------------------------------------------------------*/
int Tcl_UplevelCmd(Tcl_Interp* iPtr) {
	int i, argc = iPtr->argc, retCode;
	char** argv = iPtr->argv;
	Tcl_CallFrame *framePtr, *savedVarFramePtr;
	if(argc < 2) { goto syntaxError; }
	//Find the level to use for executing the command.
	i = Tcl_GetFrame(iPtr, argv[1], &framePtr);
	if(i == -1) { return TCL_ERROR; }
	argc -= (i+1);	//┬レベル指定に使用した引数を飛ばす。
	argv += (i+1);	//┘
	if(argc <= 0) { goto syntaxError; }	//コマンドが無い
	//Modify the interpreter state to execute in the given frame.
	 savedVarFramePtr = iPtr->varFramePtr;
	iPtr->varFramePtr = framePtr;
	//Execute the residual arguments as a command.
	retCode = Tcl_EvalString(iPtr, Tcl_Concat(argc, argv));	//コマンド以降を連結して実行する。
	//Restore the variable frame, and return.
	iPtr->varFramePtr = savedVarFramePtr;
	return retCode;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_UpvarCmd(Tcl_Interp* iPtr) {
	int i, argc = iPtr->argc;
	char** argv = iPtr->argv;
	Tcl_CallFrame* framePtr;
	Tcl_Table* upVarTablePtr;
	if(iPtr->argc < 3) { goto syntaxError; }
	//Find the table containing the variable being referenced.
	i = Tcl_GetFrame(iPtr, argv[1], &framePtr);
	if(i == -1) { return TCL_ERROR; }
	argc -= (i+1);	//┬レベル指定に使用した引数を飛ばす。
	argv += (i+1);	//┘
	if((argc <= 0) || (argc & 1)) { goto syntaxError; }	//変数名が無い,又は,変数名が二個組組みになっていない。
	//参照先の変数テーブルを取得する。
	upVarTablePtr = framePtr ? &framePtr->varTable : &iPtr->globalTable;
	//Iterate over all the pairs of (local variable, other variable) names.
	//For each pair, create a table entry in the upper context (if the name wasn't there already), then associate it with a new local variable.
	do {
		Tcl_TableEntry *tPtr1, *tPtr2;
		Tcl_Var *varPtr, *upVarPtr;
		int bNew;
		//参照先の変数のエントリを作成,又は,取得する。
		tPtr1 = Tcl_CreateTableEntry(upVarTablePtr, *(argv+0), &bNew);		//※TODO:これでは参照先が配列要素の場合に対応できていない。
		if(bNew) {
			//参照先の変数が新規エントリならば、変数を作成する。
			upVarPtr = calloc(sizeof(Tcl_Var), 1);
			tPtr1->value = upVarPtr;
		} else {
			//参照先の変数が既存エントリならば、変数を取得する。
			upVarPtr = tPtr1->value;
			//参照先の変数がupvarならば、その参照先の変数を取得する。 ←──────────────────────重要
			// - その参照先の変数がさらにupvarであることは無い。upvar変数の参照先は、必ずupvar以外である。
			//   スクリプトでupvarを多重にチェインしても、その都度upvar以外を指すように解決しているはず。(ここで行っているのがその処理です。)
			//   もし参照先の変数がさらにupvarだったならば、インタプリタのバグである。
			//□例;プロシージャlev_4にて、正しく「Ok」と表示される。
			//│proc lev_4 {x} { upvar $x y; puts $y }
			//│proc lev_3 {x} { upvar $x y; lev_4 y }
			//│proc lev_2 {x} { upvar $x y; lev_3 y }
			//│proc lev_1 {x} { upvar $x y; lev_2 y }
			//│set a Ok
			//│lev_1 a
			if(upVarPtr->type == TCL_VAR_UPVAR) {	//┐
				tPtr1 = upVarPtr->value.upvar;	//├←─────────────────────────────重要
				upVarPtr = tPtr1->value;	//┘
			}
		}
		//ローカル変数のエントリを取得する。
		tPtr2 = Tcl_CreateTableEntry(&iPtr->varFramePtr->varTable, *(argv+1), &bNew);	//(varFramePtr!=NULL)であることはTcl_GetFrame()にて確認済み。
		if(bNew) {
			//ローカル変数が無ければ、新規作成する。
			varPtr = calloc(sizeof(Tcl_Var), 1);
			tPtr2->value = varPtr;
			varPtr->type = TCL_VAR_UPVAR;
		} else {
			//ローカル変数が既存の場合、set後のupvarはエラーである。
			//global後のupvarや、upvar後のupvarはエラーではない。
			varPtr = tPtr2->value;
			if(varPtr->type != TCL_VAR_UPVAR) {
				iPtr->result = strdup_printf("variable \"%s\" already exists", *(argv+1));
				return TCL_ERROR;
			}
		}
		//ローカル変数から参照先の変数エントリへのupvarを設定,又は,変更する。
		varPtr->value.upvar = tPtr1;
		//次の二個組みへ。
		argc -= 2;
		argv += 2;
	} while(argc);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_GlobalCmd(Tcl_Interp* iPtr) {
	int i, bNew;
	Tcl_TableEntry *tPtr1, *tPtr2;
	Tcl_Var *varPtr, *gVarPtr;
	if(iPtr->argc < 2) { goto syntaxError; }
	//□「Tcl 8.4.1 Manual Command Reference」より引用:
	//│このコマンドはTclプロシージャの実行中でなければ無視されます。
	//グローバル変数テーブルにグローバル変数へのupvarエントリを作ると循環参照になってしまうので、上記の通り無視するのが正しい。
	if(!iPtr->varFramePtr) { return TCL_OK; }
	//指定された個々の変数名について…
	for(i = 1; i < iPtr->argc; i++) {
		//グローバル変数のエントリを取得する。
		tPtr1 = Tcl_CreateTableEntry(&iPtr->globalTable, iPtr->argv[i], &bNew);
		if(bNew) {
			//グローバル変数が無ければ、新規作成する。
			gVarPtr = calloc(sizeof(Tcl_Var), 1);
			tPtr1->value = gVarPtr;
		} else {
			//グローバル変数が有れば、変数を取得する。
			gVarPtr = tPtr1->value;
		}
		//ローカル変数のエントリを取得する。
		tPtr2 = Tcl_CreateTableEntry(&iPtr->varFramePtr->varTable, iPtr->argv[i], &bNew);
		if(bNew) {
			//ローカル変数が無ければ、新規作成する。
			varPtr = calloc(sizeof(Tcl_Var), 1);
			tPtr2->value = varPtr;
			varPtr->type = TCL_VAR_UPVAR;
		} else {
			//ローカル変数が既存の場合、set後のglobalはエラーである。
			//global後のglobalや、upvar後のglobalはエラーではない。
			varPtr = tPtr2->value;
			if(varPtr->type != TCL_VAR_UPVAR) {
				iPtr->result = strdup_printf("variable \"%s\" already exists", iPtr->argv[i]);
				return TCL_ERROR;
			}
		}
		//ローカル変数からグローバル変数エントリへのupvarを設定,又は,変更する。
		varPtr->value.upvar = tPtr1;
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_ArrayCmd(Tcl_Interp* iPtr) {
	Tcl_Table* tablePtr;
	Tcl_TableEntry *tPtr, *tPtr2;
	Tcl_Var *varPtr, *varPtr2;
	Tcl_ArraySearch* arraySearchPtr;
	Tcl_TableSearch search;
	if(iPtr->argc < 3) { goto syntaxError; }
	/* 変数テーブルを取得する。 */
	tablePtr = iPtr->varFramePtr ? &iPtr->varFramePtr->varTable : &iPtr->globalTable;
	/* エントリを取得する。 */
	tPtr = Tcl_FindTableEntry(tablePtr, iPtr->argv[2]);
	if(!tPtr) { goto notArray; }
	varPtr = tPtr->value;
	/* 上位プロシージャの変数ならば… */
	if(varPtr->type == TCL_VAR_UPVAR) {
		tPtr = varPtr->value.upvar;
		varPtr = tPtr->value;
	}
	/* 定義済みの配列であることを確認する。 */
	if(varPtr->type != TCL_VAR_ARRAY) { goto notArray; }
	if(!strcmp(iPtr->argv[1], "size")) {
		int size;
		if(iPtr->argc != 3) { goto syntaxError; }
		/* 定義済みの配列要素を数える。 */
		size = 0;
		for(tPtr2 = Tcl_FirstTableEntry(varPtr->value.array, &search);
		    tPtr2;
		    tPtr2 = Tcl_NextTableEntry(&search)) {
			varPtr2 = tPtr2->value;
			if(!varPtr2->type) { continue; }	//未定義の配列要素は含めない。
			size++;
		}
		iPtr->result = strdup_printf("%d", size);
	} else if(!strcmp(iPtr->argv[1], "names")) {
		if(iPtr->argc != 3) { goto syntaxError; }
		/* 定義済みの配列要素の要素名のリストを取得する。 */
		for(tPtr2 = Tcl_FirstTableEntry(varPtr->value.array, &search);
		    tPtr2;
		    tPtr2 = Tcl_NextTableEntry(&search)) {
			varPtr2 = tPtr2->value;
			if(!varPtr2->type) { continue; }	//未定義の配列要素は含めない。
			Tcl_AppendElement(iPtr, tPtr2->key);
		}
	} else if(!strcmp(iPtr->argv[1], "startsearch")) {
		if(iPtr->argc != 3) { goto syntaxError; }
		arraySearchPtr = calloc(sizeof(Tcl_ArraySearch), 1);
		tPtr2 = Tcl_CreateTableEntry(
			&iPtr->arraySearchTable,
			strdup_printf("%p", arraySearchPtr),	//アドレス値をキーとすることにした。一意なsearchIdを作成する目的でありアドレス値として解釈することは無い。
			NULL);
		tPtr2->value = arraySearchPtr;
		arraySearchPtr->nextEntryPtr = Tcl_FirstTableEntry(varPtr->value.array, &arraySearchPtr->search);
		iPtr->result = tPtr2->key;
	} else if(!strcmp(iPtr->argv[1], "nextelement")) {
		if(iPtr->argc != 4) { goto syntaxError; }
		tPtr2 = Tcl_FindTableEntry(&iPtr->arraySearchTable, iPtr->argv[3]);
		if(!tPtr2) { return TCL_ERROR; }
		arraySearchPtr = tPtr2->value;
		if(arraySearchPtr->nextEntryPtr) {
			iPtr->result = arraySearchPtr->nextEntryPtr->key;
			arraySearchPtr->nextEntryPtr = Tcl_NextTableEntry(&arraySearchPtr->search);
		}
	} else if(!strcmp(iPtr->argv[1], "donesearch")) {
		if(iPtr->argc != 4) { goto syntaxError; }
		tPtr2 = Tcl_FindTableEntry(&iPtr->arraySearchTable, iPtr->argv[3]);
		if(!tPtr2) { return TCL_ERROR; }
		Tcl_DeleteTableEntry(tPtr2);
	} else if(!strcmp(iPtr->argv[1], "anymore")) {
		if(iPtr->argc != 4) { goto syntaxError; }
		tPtr2 = Tcl_FindTableEntry(&iPtr->arraySearchTable, iPtr->argv[3]);
		if(!tPtr2) { return TCL_ERROR; }
		arraySearchPtr = tPtr2->value;
		iPtr->result = strdup_printf("%d", !!arraySearchPtr->nextEntryPtr);
	} else {
		iPtr->result = strdup_printf("bad option: %s", iPtr->argv[0]);
		return TCL_ERROR;
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
notArray:
	iPtr->result = strdup_printf("\"%s\" isn't an array", iPtr->argv[2]);
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
//Tcl6.7の仕様では、許容されるのは下記の形式である。
//・integer?[+-]integer?
//・    end?[+-]integer?
//当実装では上記に加えて、[+-]integerが何度でも出現することを許容することにした。
//・integer?[+-]integer[+-]integer...?
//・    end?[+-]integer[+-]integer...?
int Tcl_GetIndex(Tcl_Interp* iPtr, const char* s, int* indexPtr, int* endPtr) {
	int index = 0, bEnd = 0;
	//空白を読み飛ばす。
	while(isspace(*s)) { s++; }
	//空文字ならばエラー。
	if(!*s) { goto syntaxError; }
	//'end'で開始していたら…
	if(str_has_prefix(s, "end")) {
		bEnd = 1;
		s += 3;
	}
	for(;;) {
		char* t;
		//空白を読み飛ばす。
		while(isspace(*s)) { s++; }
		//終端ならば抜ける。
		if(!*s) { break; }
		//数値を変換する。
		index += strtol(s, &t, 0);
		//一文字も変換できなければエラー。
		if(s == t) { goto syntaxError; }
		//次の数値(有れば)へ。
		s = t;
	}
	//インデクスの合計と'end'の有無を格納する。
	*indexPtr = index;
	*endPtr = bEnd;
	return TCL_OK;
syntaxError:
	iPtr->result = strdup_printf("bad index: %s", iPtr->argv[0]);
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ListCmd(Tcl_Interp* iPtr) {
	iPtr->result = Tcl_Merge(iPtr->argc - 1, iPtr->argv + 1);
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_LlengthCmd(Tcl_Interp* iPtr) {
	int argc;
	if(iPtr->argc != 2) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], NULL);
	iPtr->result = strdup_printf("%d", argc);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_LindexCmd(Tcl_Interp* iPtr) {
	int retCode, argc, index, bEnd;
	char** argv;
	if(iPtr->argc != 3) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	retCode = Tcl_GetIndex(iPtr, iPtr->argv[2], &index, &bEnd);
	if(retCode) { return TCL_ERROR; }
	if(bEnd) { index += (argc - 1); }	//lindexのendはリストの最後の要素を参照する。
	if((unsigned)index < (unsigned)argc) {	//indexが負,又は,listの要素数以上である場合、空文字列を返す。
		iPtr->result = argv[index];
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_LinsertCmd(Tcl_Interp* iPtr) {
	int retCode, argc, index, bEnd, i, j;
	char** argv;
	if(iPtr->argc < 4) { goto syntaxError; }	//挿入する要素を、最低1個以上指定しなければならない。(Tcl仕様)
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	retCode = Tcl_GetIndex(iPtr, iPtr->argv[2], &index, &bEnd);
	if(retCode) { return TCL_ERROR; }
	if(bEnd) { index += argc; }	//lindexのendはリストの要素数を参照する。
	for(i = 0; i <       argc; i++) { if(index <= i) { break; } Tcl_AppendElement(iPtr,       argv[i]); }
	for(j = 3; j < iPtr->argc; j++) {                           Tcl_AppendElement(iPtr, iPtr->argv[j]); }
	for(     ; i <       argc; i++) {                           Tcl_AppendElement(iPtr,       argv[i]); }
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_LrangeCmd(Tcl_Interp* iPtr) {
	int retCode, argc, first, last, bEnd, i;
	char** argv;
	if(iPtr->argc != 4) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	retCode = Tcl_GetIndex(iPtr, iPtr->argv[2], &first, &bEnd);
	if(retCode) { return TCL_ERROR; }
	if(bEnd) { first += (argc - 1); }	//lindexのendはリストの最後の要素を参照する。
	retCode = Tcl_GetIndex(iPtr, iPtr->argv[3], &last, &bEnd);
	if(retCode) { return TCL_ERROR; }
	if(bEnd) { last += (argc - 1); }	//lindexのendはリストの最後の要素を参照する。
	for(i = 0; i < argc; i++) {
		if((i >= first) && (i <= last)) { Tcl_AppendElement(iPtr, argv[i]); }
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_LreplaceCmd(Tcl_Interp* iPtr) {
	int retCode, argc, first, last, bEnd, i, j;
	char** argv;
	if(iPtr->argc < 4) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	retCode = Tcl_GetIndex(iPtr, iPtr->argv[2], &first, &bEnd);
	if(retCode) { return TCL_ERROR; }
	if(bEnd) { first += (argc - 1); }	//lindexのendはリストの最後の要素を参照する。
	retCode = Tcl_GetIndex(iPtr, iPtr->argv[3], &last, &bEnd);
	if(retCode) { return TCL_ERROR; }
	if(bEnd) { last += (argc - 1); }	//lindexのendはリストの最後の要素を参照する。
	if(first < 0) { first = 0; }		//firstが0未満の場合、listの最初の要素を参照します。
	for(i = 0; i < argc; i++) {
		if(i == first) { for(j = 4; j < iPtr->argc; j++) { Tcl_AppendElement(iPtr, iPtr->argv[j]); } }	//┬この順番は必須。逆にすると元の要素を削除しない時の挙動が仕様と違ってしまう。
		if((i < first) || (i > last)) {                    Tcl_AppendElement(iPtr,       argv[i]); }	//┘<例>「lreplace {A B C} 1 0 x」⇒{A x B C}となるのが正しい。{A B x C}は誤り。
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_LsearchCmd(Tcl_Interp* iPtr) {
	int argc, index = -1, i;
	char** argv;
	if(iPtr->argc != 3) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	for(i = 0; i < argc; i++) {
		if(string_match(iPtr->argv[2], argv[i])) {
			index = i;
			break;
		}
	}
	iPtr->result = strdup_printf("%d", index);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
static int Tcl_LsortCmd_compare(const void* x, const void* y) {
	return strcmp(*(char**)x, *(char**)y);
}
int Tcl_LsortCmd(Tcl_Interp* iPtr) {
	int argc;
	char** argv;
	if(iPtr->argc != 2) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	qsort(argv, argc, sizeof(char*), Tcl_LsortCmd_compare);
	iPtr->result = Tcl_Merge(argc, argv);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
static const char* Tcl_GlobCmd_pattern;
static int Tcl_GlobCmd_filter(const struct dirent* e) {
	// - 厳密には、string matchには無い、glob特有のパターンとして「{a,b,...}」が定義されている。
	//   しかし「{a,b,...}」の使用頻度は低いので、当実装では対応せず、string matchをそのまま使うことにした。
	// - 厳密には、「glob *」は「.」や「..」にマッチしないが、当実装ではマッチする。
	//   この違いが問題になることは少ないと思うので、そのままにすることにした。
	return string_match(Tcl_GlobCmd_pattern, e->d_name);
}
int Tcl_GlobCmd(Tcl_Interp* iPtr) {
	int noComplain = 0;
	char** argv = iPtr->argv + 1;	//コマンド名の次の引数から
	//引数が有り、'-nocomplain'ならば…
	if(*argv && !strcmp(*argv, "-nocomplain")) {
		noComplain = 1;
		argv++;	//次の引数へ
	}
	//引数が残っている間、繰り返す。
	while((Tcl_GlobCmd_pattern = *argv++)) {
		int n;
		struct dirent** e;
		n = scandir(".", &e, Tcl_GlobCmd_filter, NULL);
		while(n--) { Tcl_AppendElement(iPtr, (*e++)->d_name); }
	}
	//'-nocomplain'が指定されておらず、一つもマッチしなければ…
	if(!noComplain && !*iPtr->result) {
		iPtr->result = "no files matched glob pattern";
		return TCL_ERROR;
	}
	return TCL_OK;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_IncrCmd(Tcl_Interp* iPtr) {
	int retCode, x = 0, y = 1;
	const char* s;
	if((iPtr->argc < 2) || (iPtr->argc > 3)) { goto syntaxError; }
	s = Tcl_GetVar(iPtr, iPtr->argv[1]);
	if(s) {
		retCode = Tcl_GetInt(iPtr, s, &x);
		if(retCode) { return retCode; }
	}
	if(iPtr->argc == 3) {
		retCode = Tcl_GetInt(iPtr, iPtr->argv[2], &y);
		if(retCode) { return retCode; }
	}
	s = strdup_printf("%d", x + y);
	s = Tcl_SetVar(iPtr, iPtr->argv[1], s);
	if(!s) { return TCL_ERROR; }
	iPtr->result = s;
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ConcatCmd(Tcl_Interp* iPtr) {
	iPtr->result = Tcl_Concat(iPtr->argc - 1, iPtr->argv + 1);
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_JoinCmd(Tcl_Interp* iPtr) {
	int argc;
	char** argv;
	if((iPtr->argc < 2) || (iPtr->argc > 3)) { goto syntaxError; }
	argc = Tcl_SplitList(iPtr->argv[1], &argv);
	iPtr->result = strjoinv(
		(iPtr->argc == 3) ? iPtr->argv[2] : " ",
		argv);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_SplitCmd(Tcl_Interp* iPtr) {
	const char* splitChars = "\t\n\v\f\r ";
	if((iPtr->argc < 2) || (iPtr->argc > 3)) { goto syntaxError; }
	if(iPtr->argc == 3) { splitChars = iPtr->argv[2]; }
	if(*splitChars) {
		char** argv = strsplit_set(iPtr->argv[1], splitChars, 0);
		iPtr->result = Tcl_Merge(strv_length(argv), argv);
	} else {
		//Handle the special case of splitting on every character.
		const char* s = iPtr->argv[1];
		while(*s) {
			char buf[2] = { *s++ };
			Tcl_AppendElement(iPtr, buf);
		}
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_EvalCmd(Tcl_Interp* iPtr) {
	const char* s;
	if(iPtr->argc < 2) { goto syntaxError; }
	s = Tcl_Concat(iPtr->argc - 1, iPtr->argv + 1);
	return Tcl_EvalString(iPtr, s);
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ExprCmd(Tcl_Interp* iPtr) {
	const char* s;
	if(iPtr->argc < 2) { goto syntaxError; }
	s = Tcl_Concat(iPtr->argc - 1, iPtr->argv + 1);
	return Tcl_ExprString(iPtr, s);
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ExprString(Tcl_Interp* iPtr, const char* s) {
	Tcl_Value value;
	int retCode = Tcl_ExprTopLevel(iPtr, s, &value);
	if(retCode) { return retCode; }
	switch(value.type) {
	case TCL_TYPE_STRING:
		iPtr->result = value.value.stringValue;
		break;
	case TCL_TYPE_INT:
		iPtr->result = strdup_printf("%d", value.value.intValue);
		break;
	case TCL_TYPE_DOUBLE:
		iPtr->result = strdup_printf("%g", value.value.doubleValue);
		break;
	default:
		DIE();
	}
	return retCode;
}
/*--------------------------------------------------------------------------*/
//現在の所どこからも使用されていないので無効化した。必要になったら有効にせよ。
#if 0
int Tcl_ExprInt(Tcl_Interp* iPtr, const char* s, int* intPtr) {
	Tcl_Value value;
	int retCode = Tcl_ExprTopLevel(iPtr, s, &value);
	if(retCode) { return retCode; }
	switch(value.type) {
	case TCL_TYPE_STRING:
		iPtr->result = "expression didn't have numeric value";
		break;
	case TCL_TYPE_INT:
		*intPtr = value.value.intValue;
		break;
	case TCL_TYPE_DOUBLE:
		*intPtr = value.value.doubleValue;
		break;
	default:
		DIE();
	}
	return retCode;
}
#endif
/*--------------------------------------------------------------------------*/
//現在の所どこからも使用されていないので無効化した。必要になったら有効にせよ。
#if 0
int Tcl_ExprDouble(Tcl_Interp* iPtr, const char* s, double* doublePtr) {
	Tcl_Value value;
	int retCode = Tcl_ExprTopLevel(iPtr, s, &value);
	if(retCode) { return retCode; }
	switch(value.type) {
	case TCL_TYPE_STRING:
		iPtr->result = "expression didn't have numeric value";
		break;
	case TCL_TYPE_INT:
		*doublePtr = value.value.intValue;
		break;
	case TCL_TYPE_DOUBLE:
		*doublePtr = value.value.doubleValue;
		break;
	default:
		DIE();
	}
	return retCode;
}
#endif
/*--------------------------------------------------------------------------*/
int Tcl_ExprBoolean(Tcl_Interp* iPtr, const char* s, int* booleanPtr) {
	Tcl_Value value;
	int retCode = Tcl_ExprTopLevel(iPtr, s, &value);
	if(retCode) { return retCode; }
	switch(value.type) {
	case TCL_TYPE_STRING:
		iPtr->result = "expression didn't have numeric value";
		break;
	case TCL_TYPE_INT:
		*booleanPtr = !!value.value.intValue;
		break;
	case TCL_TYPE_DOUBLE:
		*booleanPtr = !!value.value.doubleValue;
		break;
	default:
		DIE();
	}
	return retCode;
}
/*--------------------------------------------------------------------------*/
int Tcl_ExprTopLevel(Tcl_Interp* iPtr, const char* s, Tcl_Value* valuePtr) {
	int retCode;
	Tcl_ExprInfo info;
	info.expr = s;
	retCode = Tcl_ExprGetValue(iPtr, &info, -1, valuePtr);
	if(retCode) { return retCode; }
	if(info.token != TCL_TOKEN_END) {
		iPtr->result = strdup_printf("syntax error in expression \"%s\"", s);
		return TCL_ERROR;
	}
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
int Tcl_ExprGetValue(Tcl_Interp* iPtr, Tcl_ExprInfo* infoPtr, int prec, Tcl_Value* valuePtr) {
	static const char TBL_TokenPrec[/*(TCL_TOKEN_*)*/]={
		0,0,0,0,			//VALUE,OPEN_PAREN,CLOSE_PAREN,END
		11,11,11,			//MULT,DIVIDE,MOD
		10,10,				//PLUS,MINUS
		9,9,				//LEFT_SHIFT,RIGHT_SHIFT
		8,8,8,8,			//LESS,GREATER,LEQ,GEQ
		7,7,				//EQUAL,NEQ
		6,				//BIT_AND
		5,				//BIT_XOR
		4,				//BIT_OR
		3,				//AND
		2,				//OR
		1,1,				//QUESTY,COLON
		12,12,12,			//UNARY_MINUS,NOT,BIT_NOT
	};
	int retCode;
	int gotOp = 0;		//Non-zero means already lexed the operator (while picking up value for unary operator). Don't lex again.
	int operator;		//Current operator (either unary or binary).
	Tcl_Value value2;	//Second operand for current operator.
	Tcl_Value dummy;	//演算子を期待する場合,及び,値を読み飛ばす場合のダミー変数
	//There are two phases to this procedure.
	//First, pick off an initial value.
	//Then, parse (binary operator, value) pairs until done.
	retCode = Tcl_ExprLex(iPtr, infoPtr, valuePtr);
	if(retCode) { return retCode; }
	if(infoPtr->token == TCL_TOKEN_OPEN_PAREN) {
		//Parenthesized sub-expression.
		retCode = Tcl_ExprGetValue(iPtr, infoPtr, -1, valuePtr);
		if(retCode) { return retCode; }
		if(infoPtr->token != TCL_TOKEN_CLOSE_PAREN) {
			iPtr->result = "unmatched parentheses in expression";
			return TCL_ERROR;
		}
	} else {
		if(infoPtr->token == TCL_TOKEN_MINUS) { infoPtr->token = TCL_TOKEN_UNARY_MINUS; }
		//単項演算子ならば…
		if(infoPtr->token >= TCL_TOKEN_UNARY_MINUS) {	//TCL_TOKEN_UNARY_MINUS or TCL_TOKEN_NOT or TCL_TOKEN_BIT_NOT
			//Process unary operators.
			operator = infoPtr->token;
			retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], valuePtr);	//operatorよりも優先順位の高い範囲を評価する
			if(retCode) { return retCode; }
			switch(operator) {
			case TCL_TOKEN_UNARY_MINUS:
				if(valuePtr->type == TCL_TYPE_INT) {
					valuePtr->value.intValue = -valuePtr->value.intValue;
				} else if(valuePtr->type == TCL_TYPE_DOUBLE){
					valuePtr->value.doubleValue = -valuePtr->value.doubleValue;
				} else {
					goto illegalType;
				}
				break;
			case TCL_TOKEN_NOT:
				if(valuePtr->type == TCL_TYPE_INT) {
					valuePtr->value.intValue = !valuePtr->value.intValue;
				} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
					valuePtr->value.intValue = !valuePtr->value.doubleValue;
					valuePtr->type = TCL_TYPE_INT;
				} else {
					goto illegalType;
				}
				break;
			case TCL_TOKEN_BIT_NOT:
				if(valuePtr->type == TCL_TYPE_INT) {
					valuePtr->value.intValue = ~valuePtr->value.intValue;
				} else {
					goto illegalType;
				}
				break;
			default:
				DIE();
			}
			gotOp = 1;
		} else if(infoPtr->token != TCL_TOKEN_VALUE) {	//※'('でも単項演算子でもなければ必ず値として取得されるようだ。単独の値か,又は,二項演算子の左辺だと思うが、まだ詳しく理解できていない。要確認。
			goto syntaxError;
		}
	}
	//Got the first operand. Now fetch (operator,operand) pairs.
	if(!gotOp) {
		retCode = Tcl_ExprLex(iPtr, infoPtr, &dummy);	//infoPtr->tokenに二項演算子を取得するのが目的であり、値は不要なのでdummyを指定する。値を取得した場合は以下の処理でエラーとなる。
		if(retCode) { return retCode; }
	}
	for(;;) {
		operator = infoPtr->token;
		//二項演算子でなければ…
		if((operator < TCL_TOKEN_MULT) || (operator > TCL_TOKEN_COLON)) {
			if((operator == TCL_TOKEN_END) ||(operator == TCL_TOKEN_CLOSE_PAREN)) {
				retCode = TCL_OK;
				return retCode;
			} else {
				goto syntaxError;
			}
		}
		//呼び出し元の演算子よりも優先順位が低いか同じならば…(右結合は考慮しないのか?)
		if(TBL_TokenPrec[operator] <= prec) {
			retCode = TCL_OK;
			return retCode;
		}
		//If we're doing an AND or OR and the first operand already determines the result, don't execute anything in the second operand: just parse.
		//Same style for ?: pairs.
		if((operator == TCL_TOKEN_AND) || (operator == TCL_TOKEN_OR) || (operator == TCL_TOKEN_QUESTY)) {
			if(valuePtr->type == TCL_TYPE_INT) {
				/** no job **/
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = !!valuePtr->value.doubleValue;
				valuePtr->type = TCL_TYPE_INT;
			} else {
				goto illegalType;
			}
			if(((operator == TCL_TOKEN_AND) && !valuePtr->value.intValue) ||	//(&&)の左辺が偽ならば右辺を評価しない
			   ((operator == TCL_TOKEN_OR ) &&  valuePtr->value.intValue)) {	//(||)の左辺が真ならば右辺を評価しない
				iPtr->noEval++;
				retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], &dummy);	//右辺を読み飛ばす
				iPtr->noEval--;
				if(retCode) { return retCode; }
			} else if(operator == TCL_TOKEN_QUESTY) {										//※※※※※結合法則は大丈夫か？「set x 1;expr {$x==1?"one":$x==2?"two":"three"}」は期待通り"one"になるか？要動作確認。※※※※※
				if(valuePtr->value.intValue) {	//(?:)の第一引数が真ならば第二引数を評価し第三引数を評価しない
					retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], valuePtr);
					if(retCode) { return retCode; }
					if(infoPtr->token != TCL_TOKEN_COLON) { goto syntaxError; }
					iPtr->noEval++;
					retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], &dummy);	//第三引数を読み飛ばす
					iPtr->noEval--;
					if(retCode) { return retCode; }
				} else {			//(?:)の第一引数が偽ならば第二引数を評価せず第三引数を評価する
					iPtr->noEval++;
					retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], &dummy);	//第二引数を読み飛ばす
					iPtr->noEval--;
					if(retCode) { return retCode; }
					if(infoPtr->token != TCL_TOKEN_COLON) { goto syntaxError; }
					retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], valuePtr);
					if(retCode) { return retCode; }
				}
			} else {
				//右辺を取得する。
				retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], &value2);
				if(retCode) { return retCode; }
			}
		} else {
			//右辺を取得する。
			retCode = Tcl_ExprGetValue(iPtr, infoPtr, TBL_TokenPrec[operator], &value2);
			if(retCode) { return retCode; }
		}
		//※(OPEN_PAREN or UNKNOWN)という条件か?
		if((infoPtr->token <  TCL_TOKEN_MULT) &&
		   (infoPtr->token != TCL_TOKEN_VALUE) &&
		   (infoPtr->token != TCL_TOKEN_END) &&
		   (infoPtr->token != TCL_TOKEN_CLOSE_PAREN)) { goto syntaxError; }
		//At this point we've got two values and an operator.
		//Check to make sure that the particular data types are appropriate for the particular operator, and perform type conversion if necessary.
		switch(operator) {
		//For the operators below, no strings are allowed and ints get converted to floats if necessary.
		case TCL_TOKEN_MULT:
		case TCL_TOKEN_DIVIDE:
		case TCL_TOKEN_PLUS:
		case TCL_TOKEN_MINUS:
			if((valuePtr->type == TCL_TYPE_STRING) || (value2.type == TCL_TYPE_STRING)) { goto illegalType; }
			if(valuePtr->type == TCL_TYPE_DOUBLE) {
				if(value2.type == TCL_TYPE_INT) {
					value2.value.doubleValue = value2.value.intValue;
					value2.type = TCL_TYPE_DOUBLE;
				}
			} else if(value2.type == TCL_TYPE_DOUBLE) {
				if(valuePtr->type == TCL_TYPE_INT) {
					valuePtr->value.doubleValue = valuePtr->value.intValue;
					valuePtr->type = TCL_TYPE_DOUBLE;
				}
			}
			break;
		//For the operators below, only integers are allowed.
		case TCL_TOKEN_MOD:
		case TCL_TOKEN_LEFT_SHIFT:
		case TCL_TOKEN_RIGHT_SHIFT:
		case TCL_TOKEN_BIT_AND:
		case TCL_TOKEN_BIT_XOR:
		case TCL_TOKEN_BIT_OR:
			if((valuePtr->type != TCL_TYPE_INT) || (value2.type != TCL_TYPE_INT)) { goto illegalType; }
			break;
		//For the operators below, any type is allowed but the two operands must have the same type.
		//Convert integers to floats and either to strings, if necessary.
		case TCL_TOKEN_LESS:
		case TCL_TOKEN_GREATER:
		case TCL_TOKEN_LEQ:
		case TCL_TOKEN_GEQ:
		case TCL_TOKEN_EQUAL:
		case TCL_TOKEN_NEQ:
			if(valuePtr->type == TCL_TYPE_STRING) {
				if(value2.type != TCL_TYPE_STRING) {
					Tcl_ExprMakeString(&value2);
				}
			} else if(value2.type == TCL_TYPE_STRING) {
				if(valuePtr->type != TCL_TYPE_STRING) {
					Tcl_ExprMakeString(valuePtr);
				}
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				if(value2.type == TCL_TYPE_INT) {
					value2.value.doubleValue = value2.value.intValue;
					value2.type = TCL_TYPE_DOUBLE;
				}
			} else if(value2.type == TCL_TYPE_DOUBLE) {
				if(valuePtr->type == TCL_TYPE_INT) {
					valuePtr->value.doubleValue = valuePtr->value.intValue;
					valuePtr->type = TCL_TYPE_DOUBLE;
				}
			}
			break;
		//For the operators below, no strings are allowed, but no int->double conversions are performed.
		case TCL_TOKEN_AND:
		case TCL_TOKEN_OR:
			if((valuePtr->type == TCL_TYPE_STRING) || (value2.type == TCL_TYPE_STRING)) { goto illegalType; }
			break;
		//For the operators below, type and conversions are irrelevant: they're handled elsewhere.
		case TCL_TOKEN_QUESTY:
		case TCL_TOKEN_COLON:
			break;
		//Any other operator is an error.
		default:
			iPtr->result = "unknown operator in expression";	//※起こり得るのか?上記のcaseが全て網羅しているならここへ到達した場合はプログラムバグではないか?
			return TCL_ERROR;
		}
		//If necessary, convert one of the operands to the type of the other.
		//If the operands are incompatible with the operator (e.g. "+" on strings) then return an error.
		switch(operator) {
		case TCL_TOKEN_MULT:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue *= value2.value.intValue;
			} else {
				valuePtr->value.doubleValue *= value2.value.doubleValue;
			}
			break;
		case TCL_TOKEN_DIVIDE:
			if(valuePtr->type == TCL_TYPE_INT) {
				if(!value2.value.intValue) {
					iPtr->result = "divide by zero";
					return TCL_ERROR;
				}
				valuePtr->value.intValue /= value2.value.intValue;
			} else {
				if(!value2.value.doubleValue) {
					iPtr->result = "divide by zero";
					return TCL_ERROR;
				}
				valuePtr->value.doubleValue /= value2.value.doubleValue;
			}
			break;
		case TCL_TOKEN_MOD:
			if(!value2.value.intValue) {
				iPtr->result = "divide by zero";
				return TCL_ERROR;
			}
			valuePtr->value.intValue %= value2.value.intValue;
			break;
		case TCL_TOKEN_PLUS:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue += value2.value.intValue;
			} else {
				valuePtr->value.doubleValue += value2.value.doubleValue;
			}
			break;
		case TCL_TOKEN_MINUS:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue -= value2.value.intValue;
			} else {
				valuePtr->value.doubleValue -= value2.value.doubleValue;
			}
			break;
		case TCL_TOKEN_LEFT_SHIFT:
			valuePtr->value.intValue <<= value2.value.intValue;
			break;
		case TCL_TOKEN_RIGHT_SHIFT:
			valuePtr->value.intValue >>= value2.value.intValue;
			break;
		case TCL_TOKEN_LESS:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue = (valuePtr->value.intValue < value2.value.intValue);
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = (valuePtr->value.doubleValue < value2.value.doubleValue);
			} else {
				valuePtr->value.intValue = (strcmp(valuePtr->value.stringValue, value2.value.stringValue) < 0);
			}
			valuePtr->type = TCL_TYPE_INT;
			break;
		case TCL_TOKEN_GREATER:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue = (valuePtr->value.intValue > value2.value.intValue);
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = (valuePtr->value.doubleValue > value2.value.doubleValue);
			} else {
				valuePtr->value.intValue = (strcmp(valuePtr->value.stringValue, value2.value.stringValue) > 0);
			}
			valuePtr->type = TCL_TYPE_INT;
			break;
		case TCL_TOKEN_LEQ:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue = (valuePtr->value.intValue <= value2.value.intValue);
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = (valuePtr->value.doubleValue <= value2.value.doubleValue);
			} else {
				valuePtr->value.intValue = (strcmp(valuePtr->value.stringValue, value2.value.stringValue) <= 0);
			}
			valuePtr->type = TCL_TYPE_INT;
			break;
		case TCL_TOKEN_GEQ:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue = (valuePtr->value.intValue >= value2.value.intValue);
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = (valuePtr->value.doubleValue >= value2.value.doubleValue);
			} else {
				valuePtr->value.intValue = (strcmp(valuePtr->value.stringValue, value2.value.stringValue) >= 0);
			}
			valuePtr->type = TCL_TYPE_INT;
			break;
		case TCL_TOKEN_EQUAL:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue = (valuePtr->value.intValue == value2.value.intValue);
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = (valuePtr->value.doubleValue == value2.value.doubleValue);
			} else {
				valuePtr->value.intValue = !strcmp(valuePtr->value.stringValue, value2.value.stringValue);
			}
			valuePtr->type = TCL_TYPE_INT;
			break;
		case TCL_TOKEN_NEQ:
			if(valuePtr->type == TCL_TYPE_INT) {
				valuePtr->value.intValue = (valuePtr->value.intValue != value2.value.intValue);
			} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
				valuePtr->value.intValue = (valuePtr->value.doubleValue != value2.value.doubleValue);
			} else {
				valuePtr->value.intValue = !!strcmp(valuePtr->value.stringValue, value2.value.stringValue);
			}
			valuePtr->type = TCL_TYPE_INT;
			break;
		case TCL_TOKEN_BIT_AND:
			valuePtr->value.intValue &= value2.value.intValue;
			break;
		case TCL_TOKEN_BIT_XOR:
			valuePtr->value.intValue ^= value2.value.intValue;
			break;
		case TCL_TOKEN_BIT_OR:
			valuePtr->value.intValue |= value2.value.intValue;
			break;
		//For AND and OR, we know that the first value has already been converted to an integer.
		//Thus we need only consider the possibility of int vs. double for the second value.
		case TCL_TOKEN_AND:
			if(value2.type == TCL_TYPE_DOUBLE) {
				value2.value.intValue = !!value2.value.doubleValue;
				value2.type = TCL_TYPE_INT;
			}
			valuePtr->value.intValue = valuePtr->value.intValue && value2.value.intValue;
			break;
		case TCL_TOKEN_OR:
			if(value2.type == TCL_TYPE_DOUBLE) {
				value2.value.intValue = !!value2.value.doubleValue;
				value2.type = TCL_TYPE_INT;
			}
			valuePtr->value.intValue = valuePtr->value.intValue || value2.value.intValue;
			break;
		case TCL_TOKEN_COLON:
			iPtr->result = "can't have : operator without ? first";
			return TCL_ERROR;
		}
	}
	return retCode;
illegalType:
	iPtr->result = "illegal operand type";
	return TCL_ERROR;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ExprLex(Tcl_Interp* iPtr, Tcl_ExprInfo* infoPtr, Tcl_Value* valuePtr) {
	int retCode, c;
	const char *p, *var;
	//先行する空白を読み飛ばす。
	p = infoPtr->expr;
	while(isspace(c = *p++)) { /** no job **/ }
	infoPtr->expr = p;	//文字cの次の位置
	p--;			//文字cの位置
	//数値か?
	if(isdigit(c) || (c == '.')) {	//当関数では'-'を演算子と解釈する。数値の一部とは見なさない。
		//Number.
		//First read an integer.
		//Then if it looks like there's a floating-point number (or if it's too big a number to fit in an integer), parse it as a floating-point number.
		char *endp1, *endp2;
		int i = strtol(p, &endp1, 0);
		int d = strtod(p, &endp2);
		if((endp1 == p) && (endp2 == p)) { return TCL_ERROR; }	//整数としても実数としても解釈できなかった。(起こり得ないはずだが)
		//最長一致で解釈する。同じ長さで解釈できる場合は整数と見なす。
		if(endp1 >= endp2) {
			valuePtr->type = TCL_TYPE_INT;
			valuePtr->value.intValue = i;
			infoPtr->expr = endp1;
		} else {
			valuePtr->type = TCL_TYPE_DOUBLE;
			valuePtr->value.doubleValue = d;
			infoPtr->expr = endp2;
		}
		infoPtr->token = TCL_TOKEN_VALUE;
		return TCL_OK;
	}
	//演算子か?
	switch(c) {
	case '$':
		//Variable.
		//Fetch its value, then see if it makes sense as an integer or floating-point number.
		infoPtr->token = TCL_TOKEN_VALUE;
		var = Tcl_ParseVar(iPtr, infoPtr->expr, (char**)&infoPtr->expr);
		if(!var) { return TCL_ERROR; }
		if(!iPtr->noEval) {
			retCode = Tcl_ExprParseString(iPtr, var, valuePtr);
			if(retCode) { return retCode; }
		}
		return TCL_OK;
	case '[':
		infoPtr->token = TCL_TOKEN_VALUE;
		retCode = Tcl_Eval(iPtr, infoPtr->expr, (char**)&infoPtr->expr, ']');
		if(retCode) { return retCode; }
		infoPtr->expr++;	//']'の次の位置
		if(!iPtr->noEval) {
			retCode = Tcl_ExprParseString(iPtr, iPtr->result, valuePtr);
			if(retCode) { return retCode; }
		}
		iPtr->result = "";	//※確かにTcl_Eval()が格納した結果を捨てる必要は有るのだが、当関数の呼び出し元で上書きするからここでクリアしなくても良いのでは?
		return TCL_OK;
	case '"':
		infoPtr->token = TCL_TOKEN_VALUE;
		retCode = Tcl_ParseQuotes(iPtr, infoPtr->expr, (char**)&infoPtr->expr, '"');
		if(retCode) { return retCode; }
		infoPtr->expr++;	//'"'の次の位置
		return Tcl_ExprParseString(iPtr, iPtr->result, valuePtr);
	case '{':
		infoPtr->token = TCL_TOKEN_VALUE;
		retCode = Tcl_ParseBraces(iPtr, infoPtr->expr, (char**)&infoPtr->expr, 0);	//※これでは「expr {{1}+1}」に対応できていないのではないか？要検討。
		if(retCode) { return retCode; }
		infoPtr->expr++;	//'}'の次の位置
		return Tcl_ExprParseString(iPtr, iPtr->result, valuePtr);
	case '(':
		infoPtr->token = TCL_TOKEN_OPEN_PAREN;
		return TCL_OK;
	case ')':
		infoPtr->token = TCL_TOKEN_CLOSE_PAREN;
		return TCL_OK;
	case '*':
		infoPtr->token = TCL_TOKEN_MULT;
		return TCL_OK;
	case '/':
		infoPtr->token = TCL_TOKEN_DIVIDE;
		return TCL_OK;
	case '%':
		infoPtr->token = TCL_TOKEN_MOD;
		return TCL_OK;
	case '+':
		infoPtr->token = TCL_TOKEN_PLUS;
		return TCL_OK;
	case '-':
		infoPtr->token = TCL_TOKEN_MINUS;
		return TCL_OK;
	case '?':
		infoPtr->token = TCL_TOKEN_QUESTY;
		return TCL_OK;
	case ':':
		infoPtr->token = TCL_TOKEN_COLON;
		return TCL_OK;
	case '<':
		switch(*infoPtr->expr) {
		case '<':
			infoPtr->token = TCL_TOKEN_LEFT_SHIFT;
			infoPtr->expr++;
			break;
		case '=':
			infoPtr->token = TCL_TOKEN_LEQ;
			infoPtr->expr++;
			break;
		default:
			infoPtr->token = TCL_TOKEN_LESS;
			break;
		}
		return TCL_OK;
	case '>':
		switch(*infoPtr->expr) {
		case '>':
			infoPtr->token = TCL_TOKEN_RIGHT_SHIFT;
			infoPtr->expr++;
			break;
		case '=':
			infoPtr->token = TCL_TOKEN_GEQ;
			infoPtr->expr++;
			break;
		default:
			infoPtr->token = TCL_TOKEN_GREATER;
			break;
		}
		return TCL_OK;
	case '=':
		if(*infoPtr->expr == '=') {
			infoPtr->token = TCL_TOKEN_EQUAL;
			infoPtr->expr++;
		} else {
			return TCL_ERROR;
		}
		return TCL_OK;
	case '!':
		if(*infoPtr->expr == '=') {
			infoPtr->token = TCL_TOKEN_NEQ;
			infoPtr->expr++;
		} else {
			infoPtr->token = TCL_TOKEN_NOT;
		}
		return TCL_OK;
	case '&':
		if(*infoPtr->expr == '&') {
			infoPtr->token = TCL_TOKEN_AND;
			infoPtr->expr++;
		} else {
			infoPtr->token = TCL_TOKEN_BIT_AND;
		}
		return TCL_OK;
	case '^':
		infoPtr->token = TCL_TOKEN_BIT_XOR;
		return TCL_OK;
	case '|':
		if(*infoPtr->expr == '|') {
			infoPtr->token = TCL_TOKEN_OR;
		} else {
			infoPtr->token = TCL_TOKEN_BIT_OR;
		}
		return TCL_OK;
	case '~':
		infoPtr->token = TCL_TOKEN_BIT_NOT;
		return TCL_OK;
	case '\0':
		infoPtr->token = TCL_TOKEN_END;
		infoPtr->expr--;	//'\0'の位置
		return TCL_OK;
	default:
		return TCL_ERROR;
	}
}
/*--------------------------------------------------------------------------*/
int Tcl_ExprParseString(Tcl_Interp* iPtr, const char* s, Tcl_Value* valuePtr) {
	//空文字列でなければ…
	if(*s) {
		char* endp;
		//整数として文字列終端まで解釈できれば、整数と見なす。
		valuePtr->type = TCL_TYPE_INT;
		valuePtr->value.intValue = strtol(s, &endp, 0);
		while(isspace(*endp)) { endp++; }
		if(!*endp) { return TCL_OK; }
		//実数として文字列終端まで解釈できれば、実数と見なす。
		valuePtr->type = TCL_TYPE_DOUBLE;
		valuePtr->value.doubleValue = strtod(s, &endp);
		while(isspace(*endp)) { endp++; }
		if(!*endp) { return TCL_OK; }
	}
	//整数,又は,実数として解釈できなければ、文字列と見なす。
	valuePtr->type = TCL_TYPE_STRING;
	valuePtr->value.stringValue = s;
	return TCL_OK;
}
/*--------------------------------------------------------------------------*/
void Tcl_ExprMakeString(Tcl_Value* valuePtr) {
	if(valuePtr->type == TCL_TYPE_INT) {
		valuePtr->value.stringValue = strdup_printf("%d", valuePtr->value.intValue);
	} else if(valuePtr->type == TCL_TYPE_DOUBLE) {
		valuePtr->value.stringValue = strdup_printf("%g", valuePtr->value.doubleValue);
	}
	valuePtr->type = TCL_TYPE_STRING;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_BreakCmd(Tcl_Interp* iPtr) {
	if(iPtr->argc != 1) { goto syntaxError; }
	return TCL_BREAK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ContinueCmd(Tcl_Interp* iPtr) {
	if(iPtr->argc != 1) { goto syntaxError; }
	return TCL_CONTINUE;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_IfCmd(Tcl_Interp* iPtr) {
	int retCode, cond, i = 1;
	//Tclのifは、最後に実行したコマンドの結果を返す。ifと、while及びforの、戻り値の仕様の違いに注意せよ。
	for(;;) {
		//At this point in the loop, argv and argc refer to an expression to test, either for the main expression or an expression following an "elseif".
		//The arguments after the expression must be "then"(optional) and a script to execute if the expression is true.
		if(i >= iPtr->argc) { goto syntaxError; }
		retCode = Tcl_ExprBoolean(iPtr, iPtr->argv[i], &cond);
		if(retCode) { return retCode; }
		i++;
		if((i < iPtr->argc) && !strcmp(iPtr->argv[i], "then")) { i++; }
		if(i >= iPtr->argc) { goto syntaxError; }
		if(cond) { return Tcl_EvalString(iPtr, iPtr->argv[i]); }
		//The expression evaluated to false.
		//Skip the command, then see if there is an "else" or "elseif" clause.
		i++;
		if(i >= iPtr->argc) { return TCL_OK; }	//'elseif'節も'else'節も無し
		//if expr1 ?then? body1 elseif expr2 ?then? body2 elseif ... ?else? ?bodyN?
		//                                                           ~~~~~~elseが省略可能であることに注意せよ｡<例>｢if {0} {} else {puts ok}｣と｢if {0} {} {puts ok}｣は同じ｡
		if(!strcmp(iPtr->argv[i], "elseif")) { i++; continue; }	//'elseif'節有り。'elseif'節のbodyが足りなかった場合は次のループの先頭でエラー検出される。
		if(!strcmp(iPtr->argv[i], "else")) { i++; }		//'else'を明示した'else'節有り。'else'節のbodyが足りなかった場合はループを抜けた後にエラー検出される。
		break;							//i='else'を明示した'else'節のbody、又は、'else'を省略した'else'節のbodyを指しているはず。ループを抜ける。
	}
	if(i != (iPtr->argc - 1)) { goto syntaxError; }			//'else'節のbodyが足りないか、又は、'else'節のbodyの後に余分な引数が有る。
	return Tcl_EvalString(iPtr, iPtr->argv[i]);
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_WhileCmd(Tcl_Interp* iPtr) {
	int retCode, cond;
	if(iPtr->argc != 3) { goto syntaxError; }
	for(;;) {
		retCode = Tcl_ExprBoolean(iPtr, iPtr->argv[1], &cond);
		if(retCode) { return retCode; }
		if(!cond) { break; }
		retCode = Tcl_EvalString(iPtr, iPtr->argv[2]);
		if(retCode == TCL_BREAK) { break; }
		if(retCode == TCL_CONTINUE) { retCode = TCL_OK; }
		if(retCode) { return retCode; }
	}
	iPtr->result = "";	//Tclのwhile,for,foreachは、空文字列を返す仕様である。最後に実行したコマンドの結果を返すのではない。ifと、while,for,foreachの、戻り値の仕様の違いに注意せよ。
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_ForCmd(Tcl_Interp* iPtr) {
	int retCode, cond;
	if(iPtr->argc != 5) { goto syntaxError; }
	//start
	retCode = Tcl_EvalString(iPtr, iPtr->argv[1]);
	if(retCode) { return retCode; }
	for(;;) {
		//test
		retCode = Tcl_ExprBoolean(iPtr, iPtr->argv[2], &cond);
		if(retCode) { return retCode; }
		if(!cond) { break; }
		//body
		retCode = Tcl_EvalString(iPtr, iPtr->argv[4]);
		if(retCode == TCL_BREAK) { break; }
		if(retCode == TCL_CONTINUE) { retCode = TCL_OK; }
		if(retCode) { return retCode; }
		//next
		retCode = Tcl_EvalString(iPtr, iPtr->argv[3]);
		if(retCode == TCL_BREAK) { break; }	//Tclのforは、「for {①} {②} {③} {④}」において、④だけでなく③でもbreakを許可している。C言語のforと違うので注意せよ。
		if(retCode) { return retCode; }
	}
	iPtr->result = "";	//Tclのwhile,for,foreachは、空文字列を返す仕様である。最後に実行したコマンドの結果を返すのではない。ifと、while,for,foreachの、戻り値の仕様の違いに注意せよ。
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
//現在の実装では「foreach varname list body」形式だけに対応した。
//「foreach varlist1 list1 ?varlist2 list2 …? body」形式には未対応。
int Tcl_ForeachCmd(Tcl_Interp* iPtr) {
	int retCode;
	char **argv, *elem;
	if(iPtr->argc != 4) { goto syntaxError; }
	Tcl_SplitList(iPtr->argv[2], &argv);
	while((elem = *argv++)) {
		if(!Tcl_SetVar(iPtr, iPtr->argv[1], elem)) { return TCL_ERROR; }
		retCode = Tcl_EvalString(iPtr, iPtr->argv[3]);
		if(retCode == TCL_BREAK) { break; }
		if(retCode == TCL_CONTINUE) { retCode = TCL_OK; }
		if(retCode) { return retCode; }
	}
	iPtr->result = "";	//Tclのwhile,for,foreachは、空文字列を返す仕様である。最後に実行したコマンドの結果を返すのではない。ifと、while,for,foreachの、戻り値の仕様の違いに注意せよ。
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
//「switch ?options? string pattern body ?pattern body …?」
int Tcl_SwitchCmd(Tcl_Interp* iPtr) {
	int retCode;
	int mode = 0;	//0=exact,1=glob。regexpは未対応。
	int cond = 0;	//マッチしたら1になり、それ以降の最初に見つけた'-'以外のbodyを実行する。
	char **argv, *str, *pat, *body;
	for(argv = iPtr->argv + 1;	//コマンド名の次の引数から
	    *argv && (**argv == '-');	//引数がまだ有り、オプション指定ならば
	    argv++) {			//以下を処理して、次の引数へ進める
		if(!strcmp(*argv, "-exact")) { mode = 0; continue; }
		if(!strcmp(*argv, "-glob" )) { mode = 1; continue; }
		if(!strcmp(*argv, "--"    )) {              break; }
		iPtr->result = "bad option";
		return TCL_ERROR;
	}
	//stringを取得し、次へ進める。
	if(!(str = *argv++)) { goto syntaxError; }
	//「switch ?options? string {pattern body ?pattern body …?}」形式ならば、
	//「switch ?options? string pattern body ?pattern body …?」形式に変換する。
	if(!*argv) { goto syntaxError; }
	if(!*(argv+1)) { Tcl_SplitList(*argv, &argv); }
	//patternとbodyの組み合わせごとに繰り返す。
	while((pat = *argv++)) {
		if(!(body = *argv++)) { goto syntaxError; }
		if(!cond) {
			if(!*argv && !strcmp(pat, "default")) {	//最後のpatternが'default'の場合のみdefaultとして扱う。最後のpatternでなければ'default'というリテラルである。
				cond = 1;
			} else {
				if(!mode) {	//exact
					cond = !strcmp(pat, str);
				} else {	//glob
					cond = string_match(pat, str);
				}
			}
		}
		if(cond && strcmp(body, "-")) {
			retCode = Tcl_EvalString(iPtr, body);
			if(retCode) { return retCode; }
			break;
		}
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
int Tcl_StringCmd(Tcl_Interp* iPtr) {
	char* p;
	int retCode, i, len, index, first, last, bEnd;
	if(iPtr->argc < 2) { goto syntaxError; }
	if(!strcmp(iPtr->argv[1], "length")) {
		if(iPtr->argc != 3) { goto syntaxError; }
		len = strlen(iPtr->argv[2]);
		iPtr->result = strdup_printf("%d", len);
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "index")) {	//startIndexは未対応
		if(iPtr->argc != 4) { goto syntaxError; }
		len = strlen(iPtr->argv[2]);
		retCode = Tcl_GetIndex(iPtr, iPtr->argv[3], &index, &bEnd);
		if(retCode) { return TCL_ERROR; }
		if(bEnd) { index += (len - 1); }	//lindexのendは文字列の最後の文字を参照する。
		if((unsigned)index < (unsigned)len) {
			iPtr->result = strdup_printf("%c", iPtr->argv[2][index]);
		}
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "trim")) {
		if((iPtr->argc < 3) || (iPtr->argc > 4)) { goto syntaxError; }
		iPtr->result = strtrim(iPtr->argv[2], 0, iPtr->argv[3]);	//(iPtr->argc=3)ならば(iPtr->argv[3]=NULL)なのでstrtrim()により空白文字の指定として扱われる。
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "trimleft")) {
		if((iPtr->argc < 3) || (iPtr->argc > 4)) { goto syntaxError; }
		iPtr->result = strtrim(iPtr->argv[2], 1, iPtr->argv[3]);	//(iPtr->argc=3)ならば(iPtr->argv[3]=NULL)なのでstrtrim()により空白文字の指定として扱われる。
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "trimright")) {
		if((iPtr->argc < 3) || (iPtr->argc > 4)) { goto syntaxError; }
		iPtr->result = strtrim(iPtr->argv[2], 2, iPtr->argv[3]);	//(iPtr->argc=3)ならば(iPtr->argv[3]=NULL)なのでstrtrim()により空白文字の指定として扱われる。
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "tolower")) {
		if(iPtr->argc != 3) { goto syntaxError; }
		iPtr->result = strlwr(strdup(iPtr->argv[2]));
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "toupper")) {
		if(iPtr->argc != 3) { goto syntaxError; }
		iPtr->result = strupr(strdup(iPtr->argv[2]));
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "compare")) {
		if(iPtr->argc != 4) { goto syntaxError; }
		i = strcmp(iPtr->argv[2], iPtr->argv[3]);
		if(i < 0) { i = -1; }
		if(i > 0) { i =  1; }
		iPtr->result = strdup_printf("%d", i);
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "match")) {
		if(iPtr->argc != 4) { goto syntaxError; }
		i = string_match(iPtr->argv[2], iPtr->argv[3]);
		iPtr->result = strdup_printf("%d", i);
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "first")) {	//startIndexは未対応
		if(iPtr->argc != 4) { goto syntaxError; }
		p = strstr(iPtr->argv[3], iPtr->argv[2]);
		i = p ? (p - iPtr->argv[3]) : -1;
		iPtr->result = strdup_printf("%d", i);
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "last")) {
		if(iPtr->argc != 4) { goto syntaxError; }
		i = strlen(iPtr->argv[3]);
		while(--i >= 0) {
			if(strstr(iPtr->argv[3] + i, iPtr->argv[2])) { break; }
		}
		iPtr->result = strdup_printf("%d", i);
		return TCL_OK;
	} else if(!strcmp(iPtr->argv[1], "range")) {
		if(iPtr->argc != 5) { goto syntaxError; }
		len = strlen(iPtr->argv[2]);
		retCode = Tcl_GetIndex(iPtr, iPtr->argv[3], &first, &bEnd);
		if(retCode) { return TCL_ERROR; }
		if(bEnd) { first += (len - 1); }	//rangeのendは文字列の最後の文字を参照する。
		retCode = Tcl_GetIndex(iPtr, iPtr->argv[4], &last, &bEnd);
		if(retCode) { return TCL_ERROR; }
		if(bEnd) { last += (len - 1); }		//rangeのendは文字列の最後の文字を参照する。
		if(first < 0) { first = 0; }
		if(last > (len - 1)) { last = (len - 1); }
		if(first <= last) {
			iPtr->result = strndup(iPtr->argv[2] + first, last - first + 1);
		}
		return TCL_OK;
	} else {
		iPtr->result = "bad option";
		return TCL_ERROR;
	}
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_FormatCmd(Tcl_Interp* iPtr) {
	int retCode, intValue, len;
	double doubleValue;
	char **argv, *p, *fmt;
	if(iPtr->argc < 2) { goto syntaxError; }
	argv = iPtr->argv + 1;
	p = *argv++;
	while(*p) {
		if(*p == '%') {
			len = strcspn(p + 1/*'%'*/, "duioxXcsfeEgG%"/*変換指定子*/);
			fmt = strndup(p, 1/*'%'*/ + len/*精度等*/ + 1/*変換指定子*/);
			switch(*(p + 1/*'%'*/ + len/*精度等*/)) {
			case 'd':
			case 'u':
			case 'i':
			case 'o':
			case 'x':
			case 'X':
			case 'c':
				if(!*argv) { return TCL_ERROR; }
				retCode = Tcl_GetInt(iPtr, *argv++, &intValue);
				if(retCode) { return retCode; }
				Tcl_AppendResult(iPtr, fmt, intValue);
				break;
			case 's':
				if(!*argv) { return TCL_ERROR; }
				Tcl_AppendResult(iPtr, fmt, *argv++);
				break;
			case 'f':
			case 'e':
			case 'E':
			case 'g':
			case 'G':
				if(!*argv) { return TCL_ERROR; }
				retCode = Tcl_GetDouble(iPtr, *argv++, &doubleValue);
				if(retCode) { return retCode; }
				Tcl_AppendResult(iPtr, fmt, doubleValue);
				break;
			case '%':
				Tcl_AppendResult(iPtr, fmt);
				break;
			default:
				iPtr->result = "invalid format";
				return TCL_ERROR;
			}
			p += (1/*'%'*/ + len/*精度等*/ + 1/*変換指定子*/);
		} else {
			Tcl_AppendResult(iPtr, "%s", strcompress(p, &p, "%"));
		}
	}
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
static void Tcl_ScanCmd_callback(struct doscan_store* storePtr, void* param) {
	char*** argvPtr = param;
	int argc = strv_length(*argvPtr);
	switch(storePtr->type) {
	case 'n':
	case 'i':
	case 'd':
	case 'o':
	case 'u':
	case 'x':
	case 'X':
		(*argvPtr)[argc] = strdup_printf("%d", storePtr->value.i);
		break;
	case 'e':
	case 'E':
	case 'f':
	case 'g':
	case 'G':
		(*argvPtr)[argc] = strdup_printf("%g", storePtr->value.f);
		break;
	case 's':
	case 'c':
	case '[':
		(*argvPtr)[argc] = strdup(storePtr->value.s);
		break;
	default:
		DIE();
	}
	*argvPtr = realloc(*argvPtr, sizeof(char*)*(argc+1/*今回増えた分*/+1/*終端のNULL*/));
	(*argvPtr)[argc+1] = NULL;//終端のNULL
}
int Tcl_ScanCmd(Tcl_Interp* iPtr) {
	int argc, i;
	char** argv;
	if(iPtr->argc < 3) { goto syntaxError; }
	argv = calloc(sizeof(char*), 1);//argv[0]=終端のNULL
	doscan(iPtr->argv[1], iPtr->argv[2], Tcl_ScanCmd_callback, &argv);
	argc = strv_length(argv);
	if(iPtr->argc == 3) {
		iPtr->result = Tcl_Merge(argc, argv);
	} else {
		for(i = 0; i < argc; i++) {
			if(iPtr->argc <= (3+i)) { goto storeError; }
			if(!Tcl_SetVar(iPtr, iPtr->argv[3+i], argv[i])) { goto storeError; }
		}
		iPtr->result = strdup_printf("%d", argc);
	}
	return TCL_OK;
storeError:
	iPtr->result = "store error";
	return TCL_ERROR;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/****************************************************************************
 *	
 ****************************************************************************/
static FILE* Tcl_GetFile(Tcl_Interp* iPtr, const char* channelId) {
	Tcl_TableEntry* tPtr = Tcl_FindTableEntry(&iPtr->fileTable, channelId);
	if(!tPtr) {
		iPtr->result = "bad channelId";
		return NULL;
	}
	return tPtr->value;
}
/*--------------------------------------------------------------------------*/
int Tcl_ExitCmd(Tcl_Interp* iPtr) {
	int retCode, status;
	if(iPtr->argc == 1) {
		status = 0;
	} else if(iPtr->argc == 2) {
		retCode = Tcl_GetInt(iPtr, iPtr->argv[1], &status);
		if(retCode) { return retCode; }
	} else {
		goto syntaxError;
	}
	exit(status);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_OpenCmd(Tcl_Interp* iPtr) {
	const char* mode;
	FILE* fp;
	Tcl_TableEntry* tPtr;
	if(iPtr->argc == 2) {
		mode = "r";
	} else if(iPtr->argc == 3) {
		mode = iPtr->argv[2];
	} else {
		goto syntaxError;
	}
	fp = fopen(iPtr->argv[1], mode);
	if(!fp) {
		iPtr->result = "open error";
		return TCL_ERROR;
	}
	tPtr = Tcl_CreateTableEntry(
		&iPtr->fileTable,
		strdup_printf("%p", fp),	//アドレス値をキーとすることにした。一意なsearchIdを作成する目的でありアドレス値として解釈することは無い。
		NULL);
	tPtr->value = fp;
	iPtr->result = tPtr->key;
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_CloseCmd(Tcl_Interp* iPtr) {
	Tcl_TableEntry* tPtr;
	FILE* fp;
	if(iPtr->argc != 2) { goto syntaxError; }
	if(str_has_prefix(iPtr->argv[1], "std")) {	//標準ハンドルが閉じられると、予測できない挙動になるので、閉じられないようにした。必須ではない。
		iPtr->result = "std* shouldn't be closed";
		return TCL_ERROR;
	}
	tPtr = Tcl_FindTableEntry(&iPtr->fileTable, iPtr->argv[1]);
	if(!tPtr) {
		iPtr->result = "bad channelId";
		return TCL_ERROR;
	}
	fp = tPtr->value;
	fclose(fp);
	Tcl_DeleteTableEntry(tPtr);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_FlushCmd(Tcl_Interp* iPtr) {
	FILE* fp;
	if(iPtr->argc != 2) { goto syntaxError; }
	fp = Tcl_GetFile(iPtr, iPtr->argv[1]);
	if(!fp) { return TCL_ERROR; }
	fflush(fp);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_EofCmd(Tcl_Interp* iPtr) {
	FILE* fp;
	if(iPtr->argc != 2) { goto syntaxError; }
	fp = Tcl_GetFile(iPtr, iPtr->argv[1]);
	if(!fp) { return TCL_ERROR; }
	iPtr->result = strdup_printf("%d", !!feof(fp));
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_TellCmd(Tcl_Interp* iPtr) {
	FILE* fp;
	if(iPtr->argc != 2) { goto syntaxError; }
	fp = Tcl_GetFile(iPtr, iPtr->argv[1]);
	if(!fp) { return TCL_ERROR; }
	iPtr->result = strdup_printf("%d", ftell(fp));
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_SeekCmd(Tcl_Interp* iPtr) {
	int retCode, offset, origin;
	FILE* fp;
	if(iPtr->argc == 3) {
		origin = SEEK_SET;
	} else if(iPtr->argc == 4) {
		if(!strcmp(iPtr->argv[3], "start")) {
			origin = SEEK_SET;
		} else if(!strcmp(iPtr->argv[3], "current")) {
			origin = SEEK_CUR;
		} else if(!strcmp(iPtr->argv[3], "end")) {
			origin = SEEK_END;
		} else {
			iPtr->result = "bad origin";
			return TCL_ERROR;
		}
	} else {
		goto syntaxError;
	}
	fp = Tcl_GetFile(iPtr, iPtr->argv[1]);
	if(!fp) { return TCL_ERROR; }
	retCode = Tcl_GetInt(iPtr, iPtr->argv[2], &offset);
	if(retCode) { return retCode; }
	fseek(fp, offset, origin);
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_GetsCmd(Tcl_Interp* iPtr) {
	const char* s = "";
	FILE* fp;
	char buf[2];
	if((iPtr->argc < 2) || (iPtr->argc > 3)) { goto syntaxError; }
	fp = Tcl_GetFile(iPtr, iPtr->argv[1]);
	if(!fp) { return TCL_ERROR; }
	buf[1] = '\0';
	while((buf[0] = fgetc(fp)) != EOF) {
		if(buf[0] == '\n') { break; }
		s = strjoin(NULL, s, buf, NULL);
	}
	if(iPtr->argc == 2) {
		iPtr->result = s;
	} else {
		if(!Tcl_SetVar(iPtr, iPtr->argv[2], s)) { goto storeError; }
		iPtr->result = strdup_printf("%d", strlen(s));
	}
	return TCL_OK;
storeError:
	iPtr->result = "store error";
	return TCL_ERROR;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_PutsCmd(Tcl_Interp* iPtr) {
	int i = 1, newline = 1;
	FILE* fp;
	if((iPtr->argc >= 2) && !strcmp(iPtr->argv[i], "-nonewline")) {
		newline = 0;
		i++;
	}
	if(iPtr->argc == (i + 1)) {
		fp = stdout;
	} else if(iPtr->argc == (i + 2)) {
		fp = Tcl_GetFile(iPtr, iPtr->argv[i]);
		if(!fp) { return TCL_ERROR; }
		i++;
	} else {
		goto syntaxError;
	}
	fputs(iPtr->argv[i], fp);
	if(newline) { fputc('\n', fp); }
	return TCL_OK;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
/*--------------------------------------------------------------------------*/
int Tcl_SourceCmd(Tcl_Interp* iPtr) {
	int retCode;
	FILE* fp;
	if(iPtr->argc != 2) { goto syntaxError; }
	/* ファイルを開く。 */
	fp = fopen(iPtr->argv[1], "r");
	if(!fp) {
		iPtr->result = "open error";
		return TCL_ERROR;
	}
	/* ファイルの内容を実行する。 */
	retCode = Tcl_EvalFile(iPtr, fp);
	/* ファイルを閉じる。 */
	fclose(fp);
	return retCode;
syntaxError:
	iPtr->result = "syntax error";
	return TCL_ERROR;
}
